      SUBROUTINE SETNAM(CPSUDO,CTRUE,MAX,CNAMES,INAMES,ILISTL,ISTAT)
C
C     SETNAM IS ASSOCIATED WITH ROUTINE TRUNAM (TRUE NAME).
C     USER MUST DECLARE:
C         CHARACTER CNAMES*(*), CPSUDO*(*), CTRUE*(*)
C         DIMENSION INAMES(MAX+5)
C     ----  AND ZERO INAMES WHEN STARTING NEW LIST  ----
C         WHERE MAX IS THE MAXIMUM NUMBER OF NAMES EXPECTED
C         (THE FIRST CELL OF INAMES CONTAINS ARRAY INFORMATION  -
C         INAMES(-1) = MAX,          INAMES(-3) = CURRENT LIST LENGTH
C         INAMES(-2) = # TRUE NAMES, INAMES(-1) = # PSEUDO NAMES
C         INAMES(0) = # FIRST FREE BLOCK
C        THE REST OF THE CELLS CONTAIN THE CELL NUMBER OF THE TRUE NAME
C        ASSOCIATED WITH THAT CELL, OR IF CNAMES IS A BLANK, AND THUS
C        UNUSED, IT POINTS TO THE NEXT FREE CELL.
C     WHEN CPSUDO = CTRUE, SET A TRUE NAME
C     WHEN CPSUDO .NE. CTRUE, SET A PSUEDO NAME TO CTRU
C     WHEN CTRUE IS BLANK, REMOVE CPSUDO.
C     WHEN CPSUDO IS BLANK, REMOVE CTRUE AND ALL ASSOCIATED PSUEDO'S.
C     USER PROVIDES MAX
C     ROUTINE PROVIDES ILISTL - CURRENT LIST LENGTH
C     AND ISTAT - ERROR FLAG
C
      CHARACTER CNAMES*(*)
      DIMENSION CNAMES(*)
      CHARACTER CPSUDO*(*), CTRUE*(*)
      DIMENSION INAMES(-4:MAX)
C
      INAMES(-4) = MAX
      IF (INAMES(-3).EQ.0) THEN
C
C        INITAILIZE POINTERS TO POINT TO NEXT FREE LOCATION
C        AND NAMES TO BE EMPTY
C
         DO 10 I=1,MAX-1
            INAMES(I) = I+1
            CALL CHRBLK(CNAMES(I))
10       CONTINUE
         INAMES(MAX) = -1
         INAMES(-3) = 1
         INAMES(0) = 1
      ENDIF
C
      ISTAT = 0
C        Compare CPSUDO and CTRUE
      ILEN = LEN(CPSUDO)
      IANS = -1
      IF (CPSUDO(1:ILEN).EQ.CTRUE(1:ILEN)) IANS = 0
C        If they are the same then set a true value.
      IF (IANS.EQ.0) GO TO 100
C        If CTRUE is blank then delete CPSUDO
      IF (CTRUE(1:4).EQ.'    ') GO TO 200
C        If CPSUDO is blank then delete CTRUE and all associated TRUE names
      IF (CPSUDO(1:4).EQ.'    ') GO TO 300
C
C
C *****  CPSUDO NE CTRUE, THEREFORE SET CPSUDO IN CNAMES
C
 5    CONTINUE
C     *****  REACHED MAX VALUE?  *****
      IF (INAMES(-4).LE.INAMES(-3)) GO TO 940
C     *****  IS NAME ALREADY IN LIST?  *****
      CALL NSERCH(CPSUDO,LOCT,CNAMES,INAMES)
      IF (LOCT.NE.-1) GO TO 930
C        Does the true name already exist? If not, then set it first.
      CALL NSERCH(CTRUE,LOCT,CNAMES,INAMES)
      IF (LOCT.LT.0) GO TO 150
      INAMES(-3) = INAMES(-3) + 1
      CNAMES(INAMES(0)) = CPSUDO
      INXT = INAMES(INAMES(0))
      INAMES(INAMES(0)) = LOCT
      INAMES(0) = INXT
      INAMES(-1) = INAMES(-1) + 1
      ILISTL = INAMES(-3)
      RETURN
C
C *****  SET A NEW TRUE NAME  *****
C
 100  IF (INAMES(-4).LE.INAMES(-3)) GO TO 940
C     *****  IS NAME ALREADY IN LIST?  *****
      CALL NSERCH(CTRUE,LOCT,CNAMES,INAMES)
C     *****  DOES IT ALREADY EXIST? *****
      IF (LOCT.EQ.-1) GO TO 150
C     *****  DOES IT ALREADY EXIST AS A PSEUDO NAME ? *****
      IF (LOCT.NE.INAMES(LOCT)) GO TO 930
      RETURN
C
 150  INAMES(-3) = INAMES(-3) + 1
      CNAMES(INAMES(0)) = CTRUE
      INXT = INAMES(INAMES(0))
      INAMES(INAMES(0)) = INAMES(0)
      INAMES(0) = INXT
      INAMES(-2) = INAMES(-2) + 1
      ILISTL = INAMES(-3)
C        If we are inserting from setting a pseudo name then go back
      IF (IANS.NE.0) GO TO 5
      RETURN
C
C *****  REMOVE A PSEUDO NAME  *****
C
 200  CALL NSERCH(CPSUDO,LOCT,CNAMES,INAMES)
      IF(LOCT.LT.0)GO TO 920
C     *****  MAKE SURE NAME IS A CPSUDO  *****
      IF (LOCT.EQ.INAMES(LOCT)) GO TO 920
      CALL CHRBLK(CNAMES(LOCT))
      INAMES(LOCT) = INAMES(0)
      INAMES(0) = LOCT
C
      INAMES(-3) = INAMES(-3) - 1
      INAMES(-1) = INAMES(-1) - 1
      ILISTL = INAMES(-3)
      RETURN
C
C *****  REMOVE A TRUE NAME, AND ALL PSUDOS ASSOCIATED  *****
C
 300  CALL NSERCH(CTRUE,LOCT,CNAMES,INAMES)
      IF(LOCT.LT.0)GO TO 910
C     *****  MAKE SURE NAME IS A CTRUE *****
      IF (LOCT.NE.INAMES(LOCT)) GO TO 910
      INAMES(-2) = INAMES(-2) -1
C  *****  FIND CNAMES WITH CTRUE'S LOCATION, AND REMOVE THEM *****
      KK = MAX
      DO 330 I=2,KK
         IF (INAMES(I).NE.LOCT) GO TO 330
         IF (NINDXR(CNAMES(I),' ') .NE. 0) THEN
            INAMES(I) = INAMES(0)
            INAMES(0) = I
            CALL CHRBLK(CNAMES(I))
            IF (I.NE.LOCT) INAMES(-1) = INAMES(-1) -1
            INAMES(-3) = INAMES(-3) - 1
         ENDIF
 330  CONTINUE
C
      ILISTL = INAMES(-3)
      RETURN
C
C   *****  ERROR STATEMENTS  *****
C
C         ISTAT = 0  -  NO ERRORS
C         ISTAT = 1  -  COULD NOT FIND CTRUE
C         ISTAT = 2  -  COULD NOT FIND CPSUDO
C         ISTAT = 3  -  NAME GIVEN ALREADY EXISTS
C         ISTAT = 4  -  LIST HAS REACHED MAXIMUM VALUE
C
910   ISTAT = 1
      RETURN
920   ISTAT = 2
      RETURN
930   ISTAT = 3
      RETURN
940   ISTAT = 4
      RETURN
      END
