



      SUBROUTINE COL001 (DONE)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'OPTION.INC'
      LOGICAL       DONE

      RETURN
      END
      SUBROUTINE COL002 (IFT1,IFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2, IAA, IAT, IERR
      LOGICAL       FIRST
      CHARACTER*1   FIRSTCHARAT







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTB ('?COLB01')
         CALL MOL010 ('?M4663')
         CALL GVSKIL
         GOTO 998
      END IF
      IF (NUMSOU.LE.0) THEN
         CALL GVSTTB ('?COLB02')
         CALL MOL010 ('?M4664')
         GOTO 998
      END IF
      IF (WIFPAR(1865).EQ.1) GOTO 998







      FIRST=.TRUE.
      DO 20 IAA=1,NUMAAT



         IF (.NOT.LOCWTF(IAA)) GOTO 20
         IF (FIRST.AND.CHAINN(2,IAA).LE.0) THEN
            CALL GVSKIL
            FIRST=.FALSE.
         END IF



         DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)



            IF (FIRSTCHARAT(IAT).EQ.'C') THEN
               ATCOLR(IAT)=WIFPAR(1117)
            ELSE IF (FIRSTCHARAT(IAT).EQ.'N') THEN
               ATCOLR(IAT)=WIFPAR(1118)
            ELSE IF (FIRSTCHARAT(IAT).EQ.'O') THEN
               ATCOLR(IAT)=WIFPAR(1119)
            ELSE IF (FIRSTCHARAT(IAT).EQ.'S') THEN
               ATCOLR(IAT)=WIFPAR(1120)
            ELSE IF (FIRSTCHARAT(IAT).EQ.'P') THEN
               ATCOLR(IAT)=WIFPAR(1121)
            ELSE
               ATCOLR(IAT)=WIFPAR(1122)
            END IF
   10    CONTINUE
         CALL COL102 (IAA,IAA)
   20 CONTINUE



      IF (IFT1.EQ.0) CALL SETHIS ('?COLBAT')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE COL002A 

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT
      CHARACTER*1   FIRSTCHARAT







      IF (NUMAAT.LE.0) THEN
         CALL GVSTTB ('?COLB01')
         CALL MOL010 ('COL002A')
         CALL GVSKIL
         GOTO 998
      END IF
      IF (WIFPAR(1865).EQ.1) GOTO 998      



      DO 20 IAA=1,NUMAAT



         DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (.NOT.ISATOK(IAT).OR.PROTON(IAT)) GOTO 10
            IF (ATCOLR(IAT).GT.0) GOTO 10



            IF (FIRSTCHARAT(IAT).EQ.'C') THEN
               ATCOLR(IAT)=240
            ELSE IF (FIRSTCHARAT(IAT).EQ.'N') THEN
               ATCOLR(IAT)=340
            ELSE IF (FIRSTCHARAT(IAT).EQ.'O') THEN
               ATCOLR(IAT)=120
            ELSE IF (FIRSTCHARAT(IAT).EQ.'S') THEN
               ATCOLR(IAT)=180
            ELSE IF (FIRSTCHARAT(IAT).EQ.'P') THEN
               ATCOLR(IAT)=60
            ELSE
               ATCOLR(IAT)=300
            END IF
   10    CONTINUE
         CALL COL102 (IAA,IAA)
   20 CONTINUE



  998 CONTINUE


      RETURN
      END

      SUBROUTINE COL008 (IFT1,IFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'IRIGRA.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       IFT1, IFT2, IAA, IERR
      LOGICAL       WIFIRA







      CALL DSP001 (.FALSE.)







      DO 10 IAA=1,NUMAAT



         IF ((.NOT.WRK1TF(IAA)).OR.(.NOT.WIFIRA(IAA))) GOTO 10



         IF (LOCHST(IAA).EQ.'H') CALL COL101 (IAA,WIFPAR(31),IERR)
         IF (LOCHST(IAA).EQ.'3') CALL COL101 (IAA,WIFPAR(32),IERR)
         IF (LOCHST(IAA).EQ.'S') CALL COL101 (IAA,WIFPAR(33),IERR)
         IF (LOCHST(IAA).EQ.'B') CALL COL101 (IAA,WIFPAR(34),IERR)
         IF (LOCHST(IAA).EQ.'T') CALL COL101 (IAA,WIFPAR(35),IERR)
         IF (LOCHST(IAA).EQ.' ') CALL COL101 (IAA,WIFPAR(36),IERR)
   10 CONTINUE



      IF (WIFPAR(279).EQ.0) THEN
         CALL GVSTT6 ('?COLSCH')
         CALL GVSNL6 (1)
         CALL GVSTTI ('  H :',WIFPAR(31))
         CALL GVSTTI ('  3 :',WIFPAR(32))
         CALL GVSTTI ('  S :',WIFPAR(33))
         CALL GVSTTI ('  T :',WIFPAR(35))
         CALL GVSTTI ('  C :',WIFPAR(36))
      END IF



      CALL SETHIS ('?COLDST')



  998 CONTINUE


      RETURN
      END

      SUBROUTINE COL020 (ICOL,TEXT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ICOL, I, GVFLFI, IERR, GVFLEN
      LOGICAL       GVFIBN
      CHARACTER*(*) TEXT







      ICOL=0



   10 CONTINUE
      IF (GVFLEN(TEXT).GT.0) THEN
         CALL IPROMPT (TEXT)
      ELSE
         CALL IPROMPT ('?COLGCO')
      END IF
      CALL GETWORD (LINE,IERR)
      IF (IERR.EQ.1) THEN
         ICOL=360
         GOTO 998
      END IF
      CALL GVSCUC (LINE)



      CALL GVSSTX (LINE2,LINE)
      CALL COL020A (LINE2,ICOL)
      IF (ICOL.NE.0) GOTO 998



      I=GVFLFI(1,ICOL,LINE)



      IF (I.EQ.1.AND.ICOL.EQ.-1) THEN
         ICOL=0
         GOTO 998
      END IF



      IF (I.EQ.0) THEN
         CALL GVSTT6 ('?WIFBO-')
         CALL SHOWTEXT ('?COLCOL')
         GOTO 10
      END IF
      IF (.NOT.GVFIBN(ICOL,0,360)) THEN
         CALL GVSTTE ('?COLB19')
         CALL SHOWTEXT ('?COLCOL')
         GOTO 10
      END IF




      IF (ICOL.LE.0) ICOL=360
      IF (ICOL.GT.360) ICOL=360



  998 CONTINUE


      RETURN
      END
      SUBROUTINE COL020A (TEXT,ICOL)

















      IMPLICIT      NONE
      INTEGER       ICOL, GVFPOS
      CHARACTER*(*) TEXT







      ICOL=0



      IF (GVFPOS(TEXT,'BLUE').NE.0) THEN
         TEXT(1:4)='    '
         ICOL=10
      ELSE IF (GVFPOS(TEXT,'RED').NE.0) THEN
         TEXT(1:3)='   '
         ICOL=120
      ELSE IF (GVFPOS(TEXT,'GREEN').NE.0) THEN
         TEXT(1:5)='     '
         ICOL=240
      ELSE IF (GVFPOS(TEXT,'YELLOW').NE.0) THEN
         TEXT(1:6)='      '
         ICOL=180
      ELSE IF (GVFPOS(TEXT,'PURPLE').NE.0) THEN
         TEXT(1:6)='      '
         ICOL=50
      ELSE IF (GVFPOS(TEXT,'CYAN').NE.0) THEN
         TEXT(1:4)='    '
         ICOL=310
      ELSE IF (GVFPOS(TEXT,'MAGENTA').NE.0) THEN
         TEXT(1:7)='    '
         ICOL=80
      ELSE IF (GVFPOS(TEXT,'ORANGE').NE.0) THEN
         TEXT(1:6)='      '
         ICOL=150
      END IF





      RETURN
      END

      SUBROUTINE COL101 (IAA,ICOL,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR, IAA, IAT, ICOL, JCOL, IBND, JAT, JAA, KAT
      LOGICAL       WIFIRI, WIFIRO







      IF (.NOT.WIFIRI(IAA)) THEN
         CALL GVSTTI ('?COLB26',IAA)
         IERR=1
         CALL GVSKIL
         GOTO 998
      END IF



      IERR=0
      JCOL=ICOL
      IF (JCOL.EQ.0) JCOL=360
      IF (JCOL.GT.360) JCOL=MOD(JCOL,360)
      IF (JCOL.LT.0) JCOL=MOD(JCOL+36000,360)



      DO 30 IAT=PNTAAS(IAA),PNTAAE(IAA)
         ATCOLR(IAT)=JCOL
         IF (IAT.EQ.PNTAAS(IAA)+2) THEN
            DO 20 IBND=1,8
               JAT=BOUND_TO(1,IAT)
               IF (JAT.NE.0) THEN
                  JAA=ATIAA(JAT)
                  IF (.NOT.WRK1TF(JAA).AND.WIFIRO(IAA)) THEN
                     DO 10 KAT=PNTAAS(JAA),PNTAAE(JAA)
                        ATCOLR(KAT)=ATCOLR(IAT)
 10                  CONTINUE
                  END IF
               END IF
 20         CONTINUE
         END IF
 30   CONTINUE



      CALL COL102 (IAA,IAA)



 998  CONTINUE

      
      RETURN
      END
      SUBROUTINE COL102 (JFT1,JFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2, JFT1, JFT2, IAA, IAT, JAT, ILOOP,
     +              IPNT, IBND
      LOGICAL       WIFIRI, WIFIRW, WIFIRR







      IF (.NOT.WIFIRI(JFT1)) CALL GVSKIL
      IF (.NOT.WIFIRI(JFT2)) CALL GVSKIL



      CALL SETIFT (IFT1,IFT2,JFT1,JFT2)
      IF (IFT1.EQ.0) GOTO 998



      DO 40 IAA=IFT1,IFT2



         DO 30 IAT=PNTAAS(IAA),PNTAAE(IAA)



            DO 5 ILOOP=1,8
               JAT=BOUND_TO(ILOOP,IAT)
               IF (JAT.NE.0) THEN
                  IF (PROTON(JAT)) THEN
                     IF (WIFPAR(1011).EQ.0) THEN
                        ATCOLR(JAT)=ATCOLR(IAT)+10
                     ELSE
                        ATCOLR(JAT)=WIFPAR(1011)
                     END IF
                  END IF
               END IF
 5          CONTINUE



            IF (PROTON(IAT)) THEN



               IF (WIFIRR(IAA)) THEN
                  DO 10 IPNT=1,MAXTAT
                     IF (MUTCON(1,IPNT,RESTYP(IAA)).EQ.0) THEN
                        IF (WIFPAR(1011).EQ.0) THEN
                           ATCOLR(IAT)=310
                        ELSE
                           ATCOLR(IAT)=WIFPAR(1011)
                        END IF
                        GOTO 30
                     END IF
                     IF (MUTCON(2,IPNT,RESTYP(IAA)).EQ.PINIAA(IAT)) THEN
                        IF (WIFPAR(1011).EQ.0) THEN
                           ATCOLR(IAT)=ATCOLR(PNTAAS(IAA)+
     +                      MUTCON(1,IPNT,RESTYP(IAA))-1)+10
                        ELSE
                           ATCOLR(IAT)=WIFPAR(1011)
                        END IF
                        GOTO 30
                     END IF
   10             CONTINUE



               ELSE IF (PNTAAE(IAA).GT.PNTAAS(IAA)) THEN
                  IF (WIFIRW(IAA)) THEN
                     IF (.NOT.PROTON(IAT-1)) THEN
                        ATCOLR(IAT)=ATCOLR(IAT-1)+10
                     ELSE IF (.NOT.PROTON(IAT-2)) THEN
                        ATCOLR(IAT)=ATCOLR(IAT-2)+10
                     END IF
                  ELSE
                     DO 20 IBND=1,8
                        JAT=BOUND_TO(IBND,IAT)
                        IF (JAT.GT.0) THEN
                           IF (WIFPAR(1011).EQ.0) THEN
                              ATCOLR(IAT)=ATCOLR(JAT)+10
                           ELSE
                              ATCOLR(IAT)=WIFPAR(1011)
                           END IF
                        END IF
   20                CONTINUE
                  END IF



               ELSE
                  ATCOLR(IAT)=340
                  IF (BOUND_TO(1,IAT).NE.0) THEN
                     IF (WIFPAR(1011).EQ.0) THEN
                        ATCOLR(IAT)=ATCOLR(BOUND_TO(1,IAT))+10
                     ELSE
                        ATCOLR(IAT)=WIFPAR(1011)
                     END IF
                  END IF
               END IF
            END IF
 30      CONTINUE
 40   CONTINUE



      DO 50 IAT=PNTAAS(IFT1),PNTAAE(IFT2)
         ATCOLR(IAT)=MOD(ATCOLR(IAT)+3600,360)
         IF (ATCOLR(IAT).EQ.0) ATCOLR(IAT)=360
 50   CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE COL103 (IFT1,IFT2,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2, IAA, IAT, KAT, LAT, ILOOP, IERR







      IERR=0
      IF (IFT1.LE.0) THEN
         CALL WIFWTF (' ',IERR)
         IF (IERR.NE.0) GOTO 998
      ELSE
         CALL GVSBTF (WRK1TF,NUMAAT)
         DO 10 IAA=IFT1,IFT2
            WRK1TF(IAA)=.TRUE.
   10    CONTINUE
      END IF



      DO 100 IAA=1,NUMAAT
         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            DO 80 ILOOP=1,8
               KAT=BOUND_TO(ILOOP,IAT)
               IF (KAT.GT.IAT) THEN
                  DO 70 LAT=PNTAAS(ATIAA(KAT)),PNTAAE(ATIAA(KAT))
                     ATCOLR(LAT)=ATCOLR(IAT)
                     IF (PROTON(LAT)) ATCOLR(LAT)=ATCOLR(LAT)+10
                     ATCOLR(LAT)=MOD(ATCOLR(LAT),360)
   70             CONTINUE
               END IF
   80       CONTINUE
   90    CONTINUE
  100 CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE COL104 (IFT1,IFT2,ICOL,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR, IAA, IFT1, IFT2, IAT, ICOL, JCOL
      LOGICAL       WIFIRI







      IF (.NOT.WIFIRI(IFT1)) THEN
         CALL GVSTTI ('?COLB26',IFT1)
         IERR=1
         GOTO 998
      END IF
      IF (.NOT.WIFIRI(IFT2)) THEN
         CALL GVSTTI ('?COLB26',IFT2)
         IERR=1
         GOTO 998
      END IF



      IERR=0
      JCOL=ICOL
      IF (JCOL.EQ.0) JCOL=360
      IF (JCOL.GT.360) JCOL=MOD(JCOL,360)
      IF (JCOL.LT.0) JCOL=MOD(JCOL+3600,360)



      DO 20 IAA=IFT1,IFT2
         DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
            ATCOLR(IAT)=JCOL
   10    CONTINUE
   20 CONTINUE



      CALL COL102 (IFT1,IFT2)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE COL105 (IAA,IAT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       MAXNUM
      PARAMETER     (MAXNUM=2)
      INTEGER       IAA, IAT, JAT, JATARR(MAXNUM), NUM, ONECOL
      LOGICAL       FIRST, SAME, WIFITI
      CHARACTER*1   FIRSTCHARAT







      IF (.NOT.WIFITI(IAT)) THEN
         CALL GVSTTB ('?M1750')
         GOTO 998
      END IF



      ATCOLR(IAT)=WIFPAR(1122)



      IF (WIFPAR(84).NE.0) THEN
         IF (PROTON(IAT)) THEN
            CALL FBONDA (IAT,JATARR,MAXNUM,NUM)
            IF (NUM.GT.1) CALL GVSTTB ('?M1749')
            IF (NUM.LE.0) THEN
               CALL GVSTTE ('?M1751')
               CALL SHOIAA (IAA)
               CALL SHOIAA (ATIAA(IAT))
               CALL GVSKIL
               GOTO 998
            END IF
            ATCOLR(IAT)=ATCOLR(JATARR(1))+10
            GOTO 998
         END IF
      END IF



      FIRST=.FALSE.
      SAME=.FALSE.
      ONECOL=-1
      DO 10 JAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (IAT.EQ.JAT) GOTO 10
         IF (.NOT.ISATOK(JAT).OR.PROTON(JAT)) GOTO 10
         IF (FIRST) THEN
            FIRST=.FALSE.
            ONECOL=ATCOLR(JAT)
         END IF
         IF (ATCOLR(JAT).NE.ONECOL) GOTO 20
   10 CONTINUE



      ATCOLR(IAT)=ONECOL
      GOTO 998



   20 CONTINUE
      SAME=.TRUE.
      DO 30 JAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (IAT.EQ.JAT) GOTO 30
         IF (ATCOLR(JAT).NE.WIFPAR(1117).AND.
     +    ATCOLR(JAT).NE.WIFPAR(1118).AND.
     +    ATCOLR(JAT).NE.WIFPAR(1119).AND.
     +    ATCOLR(JAT).NE.WIFPAR(1120).AND.
     +    ATCOLR(JAT).NE.WIFPAR(1121).AND.
     +    ATCOLR(JAT).NE.WIFPAR(1122)) SAME=.FALSE.
   30 CONTINUE



      IF (SAME) THEN
         IF (FIRSTCHARAT(IAT).EQ.'C') THEN
            ATCOLR(IAT)=WIFPAR(1117)
         ELSE IF (FIRSTCHARAT(IAT).EQ.'N') THEN
            ATCOLR(IAT)=WIFPAR(1118)
         ELSE IF (FIRSTCHARAT(IAT).EQ.'O') THEN
            ATCOLR(IAT)=WIFPAR(1119)
         ELSE IF (FIRSTCHARAT(IAT).EQ.'S') THEN
            ATCOLR(IAT)=WIFPAR(1120)
         ELSE IF (FIRSTCHARAT(IAT).EQ.'P') THEN
            ATCOLR(IAT)=WIFPAR(1121)
         ELSE
            ATCOLR(IAT)=WIFPAR(1122)
         END IF
      END IF



  998 CONTINUE


      RETURN
      END   
