



      SUBROUTINE WIF330 (IAA,NEWTYP)




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CHIANG.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       IAT, JAT, IAA, JAA, NUMOLD, IANG, NEWTYP, OLDTYP,
     +              NUMNEW, OLDFUT, IADD, IBND
      REAL          GVFRTD, OLDCHI(8)
      LOGICAL       GVFYON, CH4EQCH4, GVFIBN, WIFIRH, WIFIRO, MUTATE







      IF (.NOT.GVFIBN(NEWTYP,1,WIFPAR(276))) THEN
         CALL GVSTTI2 ('?M3552',NEWTYP,WIFPAR(276))
         CALL GVSKIL
         GOTO 998
      END IF



      IF (FAMTYP(NEWTYP).NE.1.AND.FAMTYP(NEWTYP).NE.3) THEN
         CALL GVSTTI ('?MUTNOR',NEWTYP)
         CALL GVSKIL
         IF (.NOT.GVFYON('?MUTWTS',' ')) GOTO 998
      END IF



      IF (NUMAAF.LE.0.OR.IAA.GT.NUMAAF) THEN
         CALL GVSTTB ('?MUTBG1')
         CALL GVSKIL
         GOTO 998
      END IF



      IF (FAMTYP(NEWTYP).EQ.1) THEN
         IF ((.NOT.ISATOK(PNTAAS(IAA))).OR.
     +       (.NOT.ISATOK(PNTAAS(IAA)+1)).OR.
     +       (.NOT.ISATOK(PNTAAS(IAA)+2)).OR.
     +       (.NOT.ISATOK(PNTAAS(IAA)+3))) THEN
            CALL GVSTTE ('?M1359')
            GOTO 998
         END IF
      END IF




      IF (FAMTYP(RESTYP(IAA)).EQ.1) THEN
         IADD=3
      ELSE IF (FAMTYP(RESTYP(IAA)).EQ.3) THEN
         IADD=10
      ELSE
         CALL GVSTTE ('?M1607')
         GOTO 998
      END IF




      IF (WIFPAR(40).EQ.0) THEN
         IF (NEWTYP.EQ.RESTYP(IAA)) GOTO 998
      END IF



      OLDFUT=FUTURE(IAA)
      MUTATE=RESTYP(IAA).NE.NEWTYP



      ISSHIT(IAA)=.TRUE.



      DO 20 IAT=PNTAAS(IAA),PNTAAS(IAA)+IADD
         DO 10 IBND=1,8
            JAT=BOUND_TO(IBND,IAT)
            IF (JAT.NE.0) THEN
               JAA=ATIAA(JAT)
               IF (CH4EQCH4(ONESA3(IAA),ONESA3(JAA))) THEN
                  CALL GVSSTX (ONESA3(JAA),AANAME(NEWTYP))
               END IF
            END IF
 10      CONTINUE
 20   CONTINUE



      IF (PNTAAE(IAA).GT.PNTAAS(IAA)+3) THEN
         DO 30 IAT=PNTAAS(IAA)+4,PNTAAE(IAA)
            DO 25 IBND=1,8
               JAT=BOUND_TO(IBND,IAT)
               IF (JAT.NE.0) THEN
                  JAA=ATIAA(JAT)
                  CALL GVSTTI ('?MUTAGD',JAA)
                  CALL MOL101 (CHAINN(2,ATIAA(JAT)))
                  BOUND_TO(IBND,IAT)=0
                  CALL MOL200
               END IF
 25         CONTINUE
 30      CONTINUE
      END IF



      CALL CHI012 (IAA)
      IF (CHIUSE(RESTYP(IAA)).GT.0) THEN
         CALL GVSCPR (OLDCHI,CHIANG(1,IAA),8)
         NUMOLD=CHIUSE(RESTYP(IAA))
      ELSE
         NUMOLD=0
      END IF



      OLDTYP=RESTYP(IAA)
      CALL WIF332 (IAA,NEWTYP)
      IF (WIFPAR(715).EQ.0) CALL COL002 (IAA,IAA)



      IF (FAMTYP(NEWTYP).EQ.1) THEN
         NUMNEW=CHIUSE(NEWTYP)
         IF (NUMNEW.GT.0.AND.NUMOLD.GT.0) THEN
            CALL CHI012 (IAA)





            DO 50 IANG=4,3+MIN(NUMNEW,NUMOLD)
               IF (NEWTYP.EQ.18.AND.IANG.EQ.4) THEN
                  IF (WIFPAR(390).EQ.0) CALL CHI010
     +             (IAA,IANG,GVFRTD(OLDCHI(IANG))+240.0)
               ELSE IF (OLDTYP.EQ.18.AND.IANG.EQ.4) THEN
                  IF (WIFPAR(390).EQ.0) CALL CHI010
     +             (IAA,IANG,GVFRTD(OLDCHI(IANG))-240.0)
               ELSE
                  IF (WIFPAR(390).EQ.0) CALL CHI010
     +             (IAA,IANG,GVFRTD(OLDCHI(IANG)))
               END IF
   50       CONTINUE
         END IF
      END IF



      DO 70 IAT=PNTAAS(IAA),PNTAAS(IAA)+3
         DO 60 IBND=1,8
            JAT=BOUND_TO(IBND,IAT)
            IF (JAT.NE.0) THEN
               JAA=ATIAA(JAT)
               IF (WIFIRH(JAA).OR.WIFIRO(JAA)) THEN 
                  ONESA3(JAA)=AANAME(NEWTYP)
               END IF
            END IF
   60    CONTINUE
   70 CONTINUE



      DO 80 IAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (MUTATE) THEN
            ALTATM(IAT)=' '
            ALALAT(IAT)=' '
            CALL GVSCTB (ORGNAM(IAT),5)
         END IF
 80   CONTINUE



      FUTURE(IAA)=OLDFUT



  998 CONTINUE
      CALL MOL200
      IF (WIFPAR(715).EQ.0) CALL HBO010


      RETURN
      END
      SUBROUTINE WIF330A (IAA,NEWTYP)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, NEWTYP, IERR
      REAL          DUMMY







      CALL WIF330 (IAA,NEWTYP)



      IF (RESTYP(IAA).LE.20.AND.RESTYP(IAA).NE.1.AND.
     +    RESTYP(IAA).NE.6) THEN
         IF (IAA.GT.SOUADM(1,CHAINN(2,IAA))+1.AND.IAA.LT.
     +       SOUADM(2,CHAINN(2,IAA))-1) THEN
            CALL DGM004A (IAA,NEWTYP,DUMMY)
            IF (WIFPAR(54).LE.0) THEN
               CALL SHOWTEXT ('?M4190')
            ELSE
               CALL WIF424B (1,1,IAA,IERR)
            END IF
         END IF
      END IF



      CALL MOL200





      RETURN
      END
      SUBROUTINE WIF030B (TEXT,IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, JAT
      LOGICAL       GVFRIN
      CHARACTER*(*) TEXT







      CALL DIF008 (TEXT,IAA)



      DO 20 IAT=PNTAAS(IAA),PNTAAE(IAA)-1
         IF (.NOT.GVFRIN(XCOORD(IAT),-1000.0,2000.0)) THEN
            CALL SHOIAA (IAA)
            GOTO 998
         ELSE IF (.NOT.GVFRIN(YCOORD(IAT),-1000.0,2000.0)) THEN
            CALL SHOIAA (IAA)
            GOTO 998
         ELSE IF (.NOT.GVFRIN(ZCOORD(IAT),-1000.0,2000.0)) THEN
            CALL SHOIAA (IAA)
            GOTO 998
         END IF               
         DO 10 JAT=IAT+1,PNTAAE(IAA)
            IF (ABS(XCOORD(IAT)-XCOORD(JAT)).GT.0.1) GOTO 10
            IF (ABS(YCOORD(IAT)-YCOORD(JAT)).GT.0.1) GOTO 10
            IF (ABS(ZCOORD(IAT)-ZCOORD(JAT)).GT.0.1) GOTO 10
            CALL SHOIAA (IAA)
            GOTO 998
 10      CONTINUE
 20   CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE WIF331



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'IRIGRA.INC'
      INCLUDE       'JUNIOR.INC'
      INTEGER       IAA, NEWTYP, INDAA3
      LOGICAL       AHEAD
      CHARACTER*4   AACID







      IF (NUMAAF.LE.0) THEN
         CALL GVSTT6 ('?SOUSML')
         GOTO 998
      END IF



      CALL GVSCTB (TPTXLN,LENTPT)
      CALL WIFGRS (IAA,'?M0265')
      IF (IAA.EQ.0) GOTO 998



      IF (SOUADM(5,CHAINN(2,IAA)).NE.1.AND.
     +    SOUADM(5,CHAINN(2,IAA)).NE.3) THEN
         CALL GVSTT6 ('?MUTRON')
         GOTO 998
      END IF



      IF (.NOT.AHEAD()) CALL DIF008 ('?M0253',IAA)



      CALL WIFPUSHPPP (141,FAMTYP(RESTYP(IAA)))
      CALL WIFGAA (AACID,'?MUTGNT')
      CALL WIFPOPPPP (141)



      IF (AACID.EQ.'0   ') GOTO 998
      IF (AACID.EQ.ONESA3(IAA)) THEN
         CALL GVSTT6 ('?MUTBG2')
         GOTO 998
      END IF



      NEWTYP=INDAA3(AACID)
      CALL WIF330A (IAA,NEWTYP)
      CALL GVSTT6 ('?M0072')



      CALL COL002 (IAA,IAA)
      CALL LAB011 (PNTAAC(IAA))



      IF (JUNIOR) THEN
         PREVSHOW(IAA)=0
         JUNIAA(IAA)=1
      END IF
      CALL JUN001



      CALL GRA102A (PNTAAC(IAA))



  998 CONTINUE


      RETURN
      END
      SUBROUTINE WIF332 (IAA,NEWTYP)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CHIANG.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IAA, NEWTYP, IAT, JAT, LOCIAT, IADD, JATARR(2), 
     +              NUM, NUMSTORED, ISUP, IBND
      REAL          OLDBB(3,6), NEWBB(3,6), RMAT(3,3), TVEC(3),
     +              QRMS, QMAX, O2STAR(3,4), WIFVDW, OLDXYZ(3,MAXTAT)
      LOGICAL       DNATORNA, ISPROTON, CH5EQCH5
      CHARACTER*5   OLDATT(MAXTAT)
      CHARACTER*1   OLDCHA
      DATA O2STAR   /-1.806, -0.362, -3.338,
     +               -3.256,  0.848, -1.848,
     +               -1.905,  0.957, -2.567,
     +               -1.821,  2.121, -3.369/











      IF (IAA.LE.0) THEN
         CALL GVSKIL
         GOTO 998
      END IF



      OLDCHA=CHANAM(IAA)
      DNATORNA=.FALSE.



      IF (FAMTYP(NEWTYP).EQ.3) THEN
         CALL GVSRT0 (O2STAR,3*4)
         IF (ONESA3(IAA)(1:1).NE.AANAME(NEWTYP)(1:1)) THEN
            CALL SHOWTEXT ('?M0884')
            DNATORNA=(ONESA3(IAA)(1:1).EQ.'D'.AND.
     +       AANAME(NEWTYP)(1:1).EQ.'O') 
         END IF
      END IF



      IF (FAMTYP(NEWTYP).EQ.1) THEN



         IF (RESTYP(IAA).NE.6.AND.NEWTYP.NE.6) THEN
            DO 5 IAT=1,3
               LOCIAT=PNTAAS(IAA)+IAT-1
               OLDBB(1,IAT)=XCOORD(LOCIAT)
               OLDBB(2,IAT)=YCOORD(LOCIAT)
               OLDBB(3,IAT)=ZCOORD(LOCIAT)
               CALL GVSCPR (NEWBB(1,IAT),STDCRD(1,IAT,NEWTYP),3)
 5          CONTINUE
            ISUP=3



            IF (ISATOK(PNTAAS(IAA)+4)) THEN
               DO 6 IAT=4,6
                  OLDBB(1,IAT)=XCOORD(PNTAAS(IAA)+4)
                  OLDBB(2,IAT)=YCOORD(PNTAAS(IAA)+4)
                  OLDBB(3,IAT)=ZCOORD(PNTAAS(IAA)+4)
                  CALL GVSCPR (NEWBB(1,IAT),STDCRD(1,5,NEWTYP),3)
 6             CONTINUE
               ISUP=6
            END IF



            CALL GVSSPN (ISUP,OLDBB,NEWBB,RMAT,TVEC,QRMS,QMAX)
         ELSE
            DO 10 IAT=1,3
               LOCIAT=PNTAAS(IAA)+IAT-1
               OLDBB(1,IAT)=XCOORD(LOCIAT)
               OLDBB(2,IAT)=YCOORD(LOCIAT)
               OLDBB(3,IAT)=ZCOORD(LOCIAT)
               CALL GVSCPR (NEWBB(1,IAT),STDCRD(1,IAT,NEWTYP),3)
 10         CONTINUE



            CALL GVSSPN (3,OLDBB,NEWBB,RMAT,TVEC,QRMS,QMAX)
         END IF



      ELSE IF (FAMTYP(NEWTYP).EQ.3) THEN
         DO 11 IAT=1,3
            LOCIAT=PNTAAS(IAA)+IAT+10
            OLDBB(1,IAT)=XCOORD(LOCIAT)
            OLDBB(2,IAT)=YCOORD(LOCIAT)
            OLDBB(3,IAT)=ZCOORD(LOCIAT)
            CALL GVSCPR (NEWBB(1,IAT),STDCRD(1,IAT+11,NEWTYP),3)
   11    CONTINUE



         CALL GVSSPN (3,OLDBB,NEWBB,RMAT,TVEC,QRMS,QMAX)
      END IF



      IF (IAA.LT.NUMAAT) THEN
         CALL MOL111 (IAA+1,NUMAAT,ATPRAA(NEWTYP)-ATPRAA(RESTYP(IAA)),0)
      END IF
      NUMATF=NUMATF+ATPRAA(NEWTYP)-ATPRAA(RESTYP(IAA))
      PNTAAE(IAA)=PNTAAE(IAA)+ATPRAA(NEWTYP)-ATPRAA(RESTYP(IAA))
      SOUADM(4,CHAINN(2,IAA))=SOUADM(4,CHAINN(2,IAA))+ATPRAA(NEWTYP)-
     + ATPRAA(RESTYP(IAA))




      NUMSTORED=0
      IF (FAMTYP(NEWTYP).EQ.1) THEN
         IADD=4
      ELSE
         IADD=11
      END IF
      DO 15 IAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (PROTON(IAT)) THEN
            CALL FBONDA (IAT,JATARR,2,NUM)
            IF (NUM.NE.0.AND.JATARR(1).LE.PNTAAS(IAA)+IADD-1) THEN
               NUMSTORED=NUMSTORED+1
               CALL GVSSTX (OLDATT(NUMSTORED),ONESAT(IAT))
               OLDXYZ(1,NUMSTORED)=XCOORD(IAT)
               OLDXYZ(2,NUMSTORED)=YCOORD(IAT)
               OLDXYZ(3,NUMSTORED)=ZCOORD(IAT)
            END IF
         END IF
 15   CONTINUE



      RESTYP(IAA)=NEWTYP
      CALL GVSSTX (ONESA3(IAA),AANAME(NEWTYP))



      DO 20 IAT=PNTAAS(IAA)+IADD,PNTAAE(IAA)
         LOCIAT=IAT-PNTAAS(IAA)+1
         CALL GVSCPR (CV,STDCRD(1,LOCIAT,NEWTYP),3)
         CALL GVSMPV (CV,RMAT,TVEC)
         CALL GVSSTX (ONESAT(IAT),MUTROW4(LOCIAT,RESTYP(IAA)))
         XCOORD(IAT)=CV(1)
         YCOORD(IAT)=CV(2)
         ZCOORD(IAT)=CV(3)
         XBFACT(IAT)=FLOAT(WIFPAR(57))
         WEIGHT(IAT)=1.0
         USEAT(IAT)=USEAT(PNTAAC(IAA))
         PROTON(IAT)=ISPROTON(IAT)
         ISATOK(IAT)=.TRUE.
         ACCESS(IAT)=0.0
         VDWRAD(IAT)=WIFVDW(ONESAT(IAT))
         PINIAA(IAT)=LOCIAT
         ATIAA(IAT)=IAA
         ATTVAL(IAT)=0.0
         CALL GVSSTX (ORGNAM(IAT),ONESAT(IAT))
         DO 17 IBND=1,8
            BOUND_TO(IBND,IAT)=0
 17      CONTINUE



         IF (ISATOK(IAT).AND.PROTON(IAT)) THEN
            DO 8 JAT=1,NUMSTORED
               IF (CH5EQCH5(ONESAT(IAT),OLDATT(JAT))) THEN
                  XCOORD(IAT)=OLDXYZ(1,JAT)
                  YCOORD(IAT)=OLDXYZ(2,JAT)
                  ZCOORD(IAT)=OLDXYZ(3,JAT)
                  GOTO 20
               END IF
    8       CONTINUE
         END IF
   20 CONTINUE



      SUMACC(IAA)=0.0
      ACCDON(IAA)=.FALSE.
      CHANAM(IAA)=OLDCHA



      IF (DNATORNA) THEN
         OLDBB(1,1)=XCOORD(PNTAAS(IAA)+1)
         OLDBB(2,1)=YCOORD(PNTAAS(IAA)+1)
         OLDBB(3,1)=ZCOORD(PNTAAS(IAA)+1)
         OLDBB(1,2)=XCOORD(PNTAAS(IAA)+9)
         OLDBB(2,2)=YCOORD(PNTAAS(IAA)+9)
         OLDBB(3,2)=ZCOORD(PNTAAS(IAA)+9)
         OLDBB(1,3)=XCOORD(PNTAAS(IAA)+10)
         OLDBB(2,3)=YCOORD(PNTAAS(IAA)+10)
         OLDBB(3,3)=ZCOORD(PNTAAS(IAA)+10)
         CALL GVSSPN (3,OLDBB,O2STAR,RMAT,TVEC,QRMS,QMAX)
         CALL GVSCPR (CV,O2STAR(1,4),3)
         CALL GVSMPV (CV,RMAT,TVEC)
         XCOORD(PNTAAS(IAA)+HATPRA(RESTYP(IAA))-1)=CV(1)
         YCOORD(PNTAAS(IAA)+HATPRA(RESTYP(IAA))-1)=CV(2)
         ZCOORD(PNTAAS(IAA)+HATPRA(RESTYP(IAA))-1)=CV(3)
         WEIGHT(PNTAAS(IAA)+HATPRA(RESTYP(IAA))-1)=1.0
         XBFACT(PNTAAS(IAA)+HATPRA(RESTYP(IAA))-1)=12.0
         ISATOK(PNTAAS(IAA)+HATPRA(RESTYP(IAA))-1)=.TRUE.
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE WIF334




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2, IAA, NEWTYP, INDAA3
      CHARACTER*4   AACID







      CALL WIFGRN (IFT1,IFT2,' ')
      IF (IFT1.EQ.0) GOTO 998



      CALL WIFPUSHPPP (141,FAMTYP(RESTYP(IFT1)))
      CALL WIFGAA (AACID,'?MUTGNW')
      CALL WIFPOPPPP (141)
      IF (AACID.EQ.'0   ') GOTO 998
      NEWTYP=INDAA3(AACID)



      DO 10 IAA=IFT1,IFT2
         CALL WIF330A (IAA,NEWTYP)
   10 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE WIF335 

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IAA, NEWTYP, ILOOP, IL, INDMAX, I, GVFFFI, 
     +              OLDTYP, IERR, GVFFIP
      REAL          SCOMAX, SCORE
      LOGICAL       GVFIBN, INTERRUPTED, TODO(MAXAA)












      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998
      CALL GVSCPB (TODO,WRK1TF,NUMAAT)



   10 CONTINUE
      CALL IPROMPT ('?NUMCYC')
      I=GVFFFI(1,ILOOP)
      IF (I.EQ.1.AND.ILOOP.EQ.0) GOTO 998
      IF (.NOT.GVFIBN(ILOOP,1,10)) THEN
         CALL GVSTTE ('?M0166')
         GOTO 10
      END IF



      DO 100 IL=1,ILOOP



         DO 90 IAA=1,NUMAAF

            IF (.NOT.TODO(IAA)) GOTO 90
            IF (IAA.LE.SOUADM(1,CHAINN(2,IAA))+1.OR.
     +       IAA.GE.SOUADM(2,CHAINN(2,IAA))-1) GOTO 90
            IF (NUMCYS.GT.0) THEN
               IF (GVFFIP(CYSCYS,IAA,NUMCYS).NE.0) GOTO 90
            END IF



            OLDTYP=RESTYP(IAA)
            SCOMAX=-999.9
            INDMAX=0
            CALL WIFPUSHRES (IAA,IERR)
            IF (IERR.NE.0) GOTO 998



            CALL WIFPUSHPPP (609,1)
            DO 80 NEWTYP=1,20
               IF (INTERRUPTED()) GOTO 81
               IF (NEWTYP.EQ.6) GOTO 80
               CALL WIF330 (IAA,NEWTYP)
               CALL DGM004A (IAA,NEWTYP,SCORE)
               IF (SCORE.GT.SCOMAX) THEN
                  SCOMAX=SCORE
                  INDMAX=NEWTYP
               END IF
   80       CONTINUE
   81       CONTINUE
            CALL WIFPOPPPP (609)
            CALL WIFPOPRES (IERR)
            IF (INTERRUPTED()) GOTO 998



            IF (INDMAX.NE.OLDTYP) THEN
               CALL GVSFMT ('?FMT188')
               CALL GVSCTB (LINE,80)
               WRITE (LINE,FMT,ERR=999) IAA,AANAME(INDMAX),SCOMAX
               CALL GVSTT6 (LINE)
               CALL WIF330 (IAA,INDMAX)
               IF (RESTYP(IAA).EQ.6) THEN
                  CALL WIF330 (IAA,6)
               ELSE
                  CALL DGM004A (IAA,INDMAX,SCORE)
               END IF
            ELSE
               IF (IERR.NE.0) GOTO 998
               CALL DIF008 ('?M0979',IAA)
            END IF
   90    CONTINUE
  100 CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('WIF335')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE WIF336

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, NEWTYP, INDMAX, IERR, OLDRTP
      REAL          SCOMAX, SCORE, WTSCOR
      LOGICAL       INTERRUPTED, GVFYON, TODO(MAXAA)
      CHARACTER*4   OLDTYP







      IF (WIFPAR(84).NE.0) THEN
         CALL GVSTT6 ('?M2843')
         IF (.NOT.GVFYON('?M2386A',' ')) GOTO 998
      END IF



      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998
      CALL GVSCPB (TODO,WRK1TF,NUMAAT)



      DO 90 IAA=1,NUMAAF
         IF (INTERRUPTED()) GOTO 998
         IF (.NOT.TODO(IAA)) GOTO 90



         OLDRTP=RESTYP(IAA)
         CALL GVSSTX (OLDTYP,ONESA3(IAA))
         CALL WIFPUSHRES (IAA,IERR)
         IF (IERR.NE.0) GOTO 998



         IF (IAA.LE.SOUADM(1,CHAINN(2,IAA))+1.OR.
     +    IAA.GE.SOUADM(2,CHAINN(2,IAA))-1) GOTO 80



         SCOMAX=-999.9
         INDMAX=0
         WTSCOR=0.0



         DO 20 NEWTYP=1,20
            IF (NEWTYP.EQ.6.OR.NEWTYP.EQ.1.OR.NEWTYP.EQ.13) GOTO 20
            CALL WIFPUSHPPP (40,1)
            CALL WIF330 (IAA,NEWTYP)
            CALL WIFPOPPPP (40)
            CALL WIFPUSHPPP (609,1)
            CALL DGM004A (IAA,NEWTYP,SCORE)
            CALL WIFPOPPPP (609)
            IF (NEWTYP.EQ.OLDRTP) WTSCOR=SCORE
            IF (SCORE.GT.SCOMAX) THEN
               SCOMAX=SCORE
               INDMAX=NEWTYP
            END IF
   20    CONTINUE



         CALL GVSFMT ('?FMT190')
         CALL GVSCTB (LINE,80)
         WRITE (LINE,FMT,ERR=999) IAA,OLDTYP,AANAME(INDMAX),
     +    WTSCOR,SCOMAX
         CALL GVSTT6 (LINE)



   80    CONTINUE
         CALL WIFPOPRES (IERR)
         IF (IERR.NE.0) GOTO 998
   90 CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('WIF336')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE WIF337 (IFT1,IFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'JUNIOR.INC'
      INTEGER       IAA, NEWTYP, IERR, OLDTYP, I, IFT1, IFT2, GVFCBT
      REAL          SCORE, NOWACC, PSCORE(MAXAA)
      CHARACTER*10  ASTERIX
      LOGICAL       INTERRUPTED, TODO(MAXAA)
      EQUIVALENCE   (PSCORE(1),PREVCOL(1))







      CALL WIFPUSHPPP (825,0)
      CALL WIFPUSHPPP (609,0)
      CALL WIFPUSHPPP (1907,0)



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



      DO 20 IAA=1,NUMAAF
         IF (IAA.LE.SOUADM(1,CHAINN(2,IAA))+1.OR.
     +    IAA.GE.SOUADM(2,CHAINN(2,IAA))-1) WRK1TF(IAA)=.FALSE.
 20   CONTINUE




      CALL GVSCPB (TODO,WRK1TF,NUMAAT)
      IF (GVFCBT(WRK1TF,NUMAAF).GT.10) WIFPAR(609)=1



      HSTDON=.FALSE.
      CALL DSP001 (.FALSE.)



      DO 90 IAA=1,NUMAAF
         IF (.NOT.TODO(IAA)) THEN
            PSCORE(IAA)=-999.9
            GOTO 90
         END IF



         CALL WIFPUSHRES (IAA,IERR)
         IF (IERR.NE.0) GOTO 998



         ACCDON(IAA)=.FALSE.
         SUMACC (IAA)=0.0
         CALL ENVNOWAT
         CALL WIF041 (IAA)
         NOWACC=SUMACC(IAA)



         NEWTYP=13
         OLDTYP=RESTYP(IAA)
         CALL WIF330 (IAA,NEWTYP)
         CALL DGM004A (IAA,NEWTYP,SCORE)



         IF (WIFPAR(493).EQ.0) THEN
            CALL GVSNL6 (1)
            CALL GVSFMT ('?FMT836')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=999) (MUTSCO(I),I=1,4),SUMACC(IAA)
            CALL GVSTT6 (LINE)



            CALL GVSCTB (ASTERIX,10)
            IF (NINT(SCORE).GE.0) THEN
               DO 70 I=1,MIN(10,NINT(SCORE)+1)
                  ASTERIX(I:I)='*'
 70            CONTINUE
            END IF



            CALL GVSFMT ('?FMT190A')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=999) IAA,NUMNAM(IAA),AANAME(OLDTYP),
     +        LOCHST(IAA),NOWACC,SCORE,ASTERIX
            CALL GVSTT6 (LINE)
         ELSE
            PSCORE(IAA)=SCORE
            PRINT*,IAA,ONESA3(IAA),SCORE,PSCORE(IAA)
         END IF



         CALL WIFPOPRES (IERR)
         IF (IERR.NE.0) GOTO 998
         IF (INTERRUPTED()) GOTO 998
   90 CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('WIF336')



  998 CONTINUE
      CALL WIFPOPPPP (1907)
      CALL WIFPOPPPP (609)
      CALL WIFPOPPPP (825)


      RETURN
      END
      SUBROUTINE WIF338

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       IAA, NEWTYP, IERR, OLDTYP, I
      REAL          SCORE, NOWACC
      CHARACTER*10  ASTERIX
      LOGICAL       INTERRUPTED







      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998
      CALL GVSCPB (WRK4TF,WRK1TF,NUMAAT)



      HSTDON=.FALSE.
      CALL DSP001 (.TRUE.)
      CALL WIFPUSHPPP (825,0)
      CALL WIFPUSHPPP (609,1)
      CALL WIFPUSHPPP (1907,1)



      CALL SHOWTEXT ('?M2904')



      DO 90 IAA=1,NUMAAF
         IF (.NOT.WRK4TF(IAA)) GOTO 90



         CALL WIFPUSHRES (IAA,IERR)
         IF (IERR.NE.0) GOTO 100



         ACCDON(IAA)=.FALSE.
         SUMACC (IAA)=0.0
         CALL ENVNOWAT
         CALL WIF041 (IAA)
         NOWACC=SUMACC(IAA)



         IF (IAA.LE.SOUADM(1,CHAINN(2,IAA))+1.OR.
     +    IAA.GE.SOUADM(2,CHAINN(2,IAA))-1) GOTO 80



         NEWTYP=RESTYP(IAA)
         OLDTYP=RESTYP(IAA)
         CALL WIF330 (IAA,NEWTYP)
         CALL DGM004A (IAA,NEWTYP,SCORE)



         CALL GVSNL6 (1)
         CALL GVSFMT ('?FMT836')
         CALL GVSCTB (LINE,80)
         WRITE (LINE,FMT,ERR=999) (MUTSCO(I),I=1,5)
         CALL GVSTT6 (LINE)



         CALL GVSCTB (ASTERIX,10)
         IF (NINT(SCORE).LE.0.AND.NINT(SCORE).GT.-50) THEN
            SCORE=-SCORE-FLOAT(WIFPAR(1906))/100.0
            DO 70 I=1,MIN(10,NINT(SCORE)+1)
               ASTERIX(I:I)='*'
   70       CONTINUE
            SCORE=-SCORE
         END IF



         CALL GVSFMT ('?FMT190A')
         CALL GVSCTB (LINE,80)
         WRITE (LINE,FMT,ERR=999) IAA,NUMNAM(IAA),AANAME(OLDTYP),
     +    LOCHST(IAA),NOWACC,SCORE,ASTERIX
         CALL GVSTT6 (LINE)



   80    CONTINUE
         CALL WIFPOPRES (IERR)
         IF (IERR.NE.0) GOTO 100
         IF (INTERRUPTED()) GOTO 100
   90 CONTINUE
      GOTO 100



  999 CONTINUE
      CALL GVSEIW ('WIF336')



  100 CONTINUE
      CALL WIFPOPPPP (1907)
      CALL WIFPOPPPP (609)
      CALL WIFPOPPPP (825)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE WIF339

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IFT1, IFT2







      CALL WIFGRN (IFT1,IFT2,' ')
      IF (IFT1.EQ.0) GOTO 998
      CALL WIFPUSHPPP (40,1)



      DO 10 IAA=IFT1,IFT2
         CALL WIF330A (IAA,RESTYP(IAA))
   10 CONTINUE
      CALL WIFPOPPPP (40)



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE WIF340

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DGLOOP.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IAA, NEWTYP, IERR, BMPCNT(20), I
      REAL          SCORE(20), SCO, SLFSCO, GVFMAX, SUMMEM
      LOGICAL       INTERRUPTED, TODO(MAXAA), BOOLS(NUMUA), ACCMEM,
     +              WIFIRA









      CALL WIFPUSHPPP (196,1)
      CALL WIFPUSHPPP (524,1)
      CALL WIFPUSHPPP (564,1)
      CALL WIFPUSHPPP (603,1)
      CALL WIFPUSHPPP (609,1)
      CALL GVSBTF (BOOLS,NUMUA)



      IF (DEFALL) THEN
         CALL GVSBTT (TODO,NUMAAF)
      ELSE
         CALL WIFWTF (' ',IERR)
         IF (IERR.NE.0) GOTO 998
         CALL GVSCPB (TODO,WRK1TF,NUMAAT)
      END IF



      HSTDON=.FALSE.
      CALL DSP001 (.FALSE.)



      DO 90 IAA=3,NUMAAF-2
         IF (INTERRUPTED()) GOTO 998



         IF (.NOT.ACCDON(IAA)) THEN
            CALL ACC001
            CALL WIF039
            IF (.NOT.ACCDON(IAA)) GOTO 998
         END IF



         CALL GVSRT0 (SCORE,20)
         CALL GVSIT0 (BMPCNT,20)



         IF (.NOT.TODO(IAA)) GOTO 90
         IF (.NOT.WIFIRA(IAA)) GOTO 90
         IF (IAA.LE.SOUADM(1,CHAINN(2,IAA))+1.OR.
     +    IAA.GE.SOUADM(2,CHAINN(2,IAA))-1) GOTO 90



         ACCMEM=ACCDON(IAA)
         SUMMEM=SUMACC(IAA)
         CALL WIFPUSHRES (IAA,IERR)
         IF (IERR.NE.0) GOTO 998
         DO 80 NEWTYP=1,20
            IF (NEWTYP.EQ.6) GOTO 80
            CALL GVSBTF (BOOLS,20)
            BOOLS(NEWTYP)=.TRUE.
            CALL DGM003 (IAA,BOOLS)
            SCORE(NEWTYP)=FLOAT(WIFPAR(54))/FLOAT(WIFPAR(55))
            BMPCNT(NEWTYP)=WIFPAR(967)
 80      CONTINUE
         CALL WIFPOPRES (IERR)
         IF (INTERRUPTED()) GOTO 998
         ACCDON(IAA)=ACCMEM
         SUMACC(IAA)=SUMMEM



         CALL GVSFMT ('?FMT1534')
         CALL GVSCTB (BIGLIN,132)
         WRITE (BIGLIN,FMT,ERR=999) (AANAME(I),I=1,20)
         CALL GVSTT6 (BIGLIN)
         CALL GVSFMT ('?FMT1533')
         CALL GVSCTB (BIGLIN,132)
         WRITE (BIGLIN,FMT,ERR=999) IAA,ONESA3(IAA),NUMNAM(IAA),
     +    SUMACC(IAA),LOCHST(IAA),SCORE
         CALL GVSTT6 (BIGLIN)
         CALL GVSFMT ('?FMT1532')
         CALL GVSCTB (BIGLIN,132)
         WRITE (BIGLIN,FMT,ERR=999) BMPCNT
         CALL GVSTT6 (BIGLIN)



         SCO=SCORE(RESTYP(IAA))
         IF (SCO.LT.0.01) THEN
            SLFSCO=-999.9
         ELSE
            SLFSCO=SCORE(RESTYP(IAA))/GVFMAX(SCORE,20)
         END IF
         CALL GVSTTR ('?M5131',SLFSCO)
         CALL GVSNL6 (1)
 90   CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('WIF340')



  998 CONTINUE
      CALL WIFPOPPPP (609)
      CALL WIFPOPPPP (603)
      CALL WIFPOPPPP (564)
      CALL WIFPOPPPP (524)
      CALL WIFPOPPPP (196)


      RETURN
      END



