



      SUBROUTINE ACC000 (DONE)


















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







      IF (OPTIN.EQ.MEN6COD(3)) GOTO 998
      CALL MEN001 (OPTIN,DONE)



      IF (OPTIN.EQ.'HIDDEN') THEN
         CALL SHOWTEXT ('?M0040')
         DONE=.TRUE.



      ELSE IF (OPTIN.EQ.'DEBUG ') THEN
         IF (WIFPAR(488).EQ.0) THEN
            WIFPAR(488)=1
            CALL GVSTT6 ('?ACCDON')
         ELSE
            WIFPAR(488)=0
            CALL GVSTT6 ('?ACCDOF')
         END IF
         DONE=.TRUE.
      ELSE IF (OPTIN.EQ.'HIDE01') THEN
         CALL ACC014
         DONE=.TRUE.
      ELSE IF (OPTIN.EQ.'VAC3DM') THEN
         CALL ACC002A
         DONE=.TRUE.



      ELSE IF (OPTIN.EQ.'SHOPAR') THEN
         CALL ACC013
         DONE=.TRUE.
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE ACC001


















      IMPLICIT      NONE







      CALL GVSNL6 (1)
      CALL SHOWTEXT ('?ACCB02')
      CALL GVSNL6 (1)





      RETURN
      END

      SUBROUTINE ACC001A


















      IMPLICIT      NONE







      CALL GVSNL6 (1)
      CALL SHOWTEXT ('?ACCB03')
      CALL GVSNL6 (1)
      CALL WIF039





      RETURN
      END
      SUBROUTINE ACC002 (JFT1,JFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CHIANG.INC'
      INCLUDE       'CLUFAM.INC'
      INTEGER       IFT1, IFT2, IAA, ICLU, IFAM, ICHI,
     +              IAT, ITAB, IERR, JFT1, JFT2
      REAL          VACVAL(MAXTAT), ACCSM1, ACCSM2, VACOUT, GVFRTD
      LOGICAL       WIF051, GETPORT, GVFIBN, BVAL, WIFIRW,
     +              DOTAB, GVFYON, WIFIRR, WIFIRI
      CHARACTER*1   USEFLG, ATFLAG
      CHARACTER*4   T4, CHAR4







      CALL GVSBTF (WRK1TF,NUMAAT)



      CALL GETTEXTP (GETPORT)



      DOTAB=.FALSE.
      DOTAB=GVFYON('?TABSST',' ')
      IF (DOTAB) THEN
         CALL TAB016 (ITAB,0,IFT1,IFT2,IERR)
         IF (IFT1.EQ.0) GOTO 998
      ELSE
         CALL SETIFT (IFT1,IFT2,JFT1,JFT2)
         IF (IFT1.EQ.0) GOTO 998
      END IF
      IF ((.NOT.WIFIRI(IFT1)).OR.(.NOT.WIFIRI(IFT2))) THEN
         CALL GVSTTB ('?M0205')
         GOTO 998
      END IF



      CALL CHI004



      CALL GVSNL6 (2)
      DO 100 IAA=IFT1,IFT2



         IF (WIFIRW(IAA)) GOTO 100



         CALL ACC003 (IAA,VACVAL)



         CALL DIF028 (6,IAA)



         IF (WIFIRR(IAA)) THEN



            CALL GVSFMT ('?FMT471')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=999) 
     +       (GVFRTD(CHIANG(ICHI,IAA)),ICHI=1,3)
            CALL GVSTT6 (LINE)













            IF (NUMFAM.GT.0) THEN
               DO 20 IFAM=1,MAXFAM
                  IF (GVFIBN(IAA,FAMILY(1,IFAM),FAMILY(2,IFAM))) 
     +             CALL DIF005 (6,IAA,IFAM,LINE)
   20          CONTINUE
            END IF
         END IF



         CALL GVSTT6 ('?ACCHD1')
         ACCSM1=0.0
         ACCSM2=0.0
         DO 30 IAT=PNTAAS(IAA),PNTAAE(IAA)



            IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 30



            ATFLAG='-'
            IF (ISATOK(IAT)) ATFLAG='+'
            USEFLG='-'
            IF (USEAT(IAT)) USEFLG='+'
            IF (VACVAL(PINIAA(IAT)).LT.0.0001) THEN
               VACOUT=100.0
            ELSE
               VACOUT=100.0*ACCESS(IAT)/VACVAL(PINIAA(IAT))
            END IF



            CALL GVSFMT ('?FMT472')
            CALL GVSCTB (BIGLIN,132)
            CHAR4=T4(ONESAT(IAT))
            WRITE (BIGLIN,FMT,ERR=999) CHAR4,XCOORD(IAT),
     +       YCOORD(IAT),ZCOORD(IAT),ACCESS(IAT),XBFACT(IAT),
     +       WEIGHT(IAT),VDWRAD(IAT),ATCOLR(IAT),
     +       ATFLAG,USEFLG,VACVAL(PINIAA(IAT)),VACOUT
            CALL GVSTT6 (BIGLIN)
            ACCSM1=ACCSM1+ACCESS(IAT)
            ACCSM2=ACCSM2+VACVAL(PINIAA(IAT))
   30    CONTINUE



         IF (ABS(ACCSM2).LT.0.001) THEN
            CALL GVSTTB ('?ACCB04')
            IF (DOTAB) CALL TAB104 (IAA,ITAB,0.0,0,'    ',BVAL,IERR)
         ELSE
            CALL GVSFMT ('?FMT470')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=999) ACCSM1,ACCSM2,100.0*ACCSM1/ACCSM2
            CALL GVSTT6 (LINE)
            IF (DOTAB) CALL TAB104 
     +       (IAA,ITAB,100.0*ACCSM1/ACCSM2,0,'    ',BVAL,IERR)
            CALL GVSNL6 (1)
         END IF
  100 CONTINUE



      CALL KILLTEXTP (GETPORT)
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('ACC002')
      CALL KILLTEXTP (GETPORT)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC002A

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CHIANG.INC'
      INCLUDE       'CLUFAM.INC'
      INTEGER       IAA, IAT, IERR
      REAL          VACVAL(MAXTAT), ACCSM1, ACCSM2, VACOUT, ACCSS1,
     +              ACCSS2
      LOGICAL       WIFIRW, WIFIRA
      CHARACTER*1   USEFLG, ATFLAG
      CHARACTER*4   T4, CHAR4







      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998
      CALL GVSNL6 (2)



      DO 100 IAA=1,NUMAAT



         IF (.NOT.WRK1TF(IAA).OR.WIFIRW(IAA)) GOTO 100



         CALL ACC003 (IAA,VACVAL)



         CALL DIF028 (6,IAA)



         CALL GVSTT6 ('?ACCHD1')
         ACCSM1=0.0
         ACCSM2=0.0
         ACCSS1=0.0
         ACCSS2=0.0
         DO 30 IAT=PNTAAS(IAA),PNTAAE(IAA)



            IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 30



            ATFLAG='-'
            IF (ISATOK(IAT)) ATFLAG='+'
            USEFLG='-'
            IF (USEAT(IAT)) USEFLG='+'
            IF (VACVAL(PINIAA(IAT)).LT.0.0001) THEN
               VACOUT=100.0
            ELSE
               VACOUT=100.0*ACCESS(IAT)/VACVAL(PINIAA(IAT))
            END IF



            CALL GVSFMT ('?FMT472')
            CALL GVSCTB (BIGLIN,132)
            CHAR4=T4(ONESAT(IAT))
            WRITE (BIGLIN,FMT,ERR=999) CHAR4,XCOORD(IAT),
     +       YCOORD(IAT),ZCOORD(IAT),ACCESS(IAT),XBFACT(IAT),
     +       WEIGHT(IAT),VDWRAD(IAT),ATCOLR(IAT),
     +       ATFLAG,USEFLG,VACVAL(PINIAA(IAT)),VACOUT
            CALL GVSTT6 (BIGLIN)
            ACCSM1=ACCSM1+ACCESS(IAT)
            ACCSM2=ACCSM2+VACVAL(PINIAA(IAT))
            IF (WIFIRA(IAA)) THEN
               IF (IAT.GE.PNTAAS(IAA)+4) THEN
                  ACCSS1=ACCSS1+ACCESS(IAT)
                  ACCSS2=ACCSS2+VACVAL(PINIAA(IAT))
               END IF
            END IF
   30    CONTINUE




         IF (ABS(ACCSM2).LT.0.001) THEN
            CALL GVSTTB ('?ACCB04')
         ELSE
            CALL GVSFMT ('?FMT470')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=999) ACCSM1,ACCSM2,100.0*ACCSM1/ACCSM2
            CALL GVSTT6 (LINE)
            IF (WIFIRA(IAA)) THEN
               CALL GVSCTB (LINE,80)
               WRITE (LINE,FMT,ERR=999)ACCSS1,ACCSS2,100.0*ACCSS1/ACCSS2
               CALL GVSTT6 (LINE)
            END IF
            CALL GVSNL6 (1)
         END IF
  100 CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('ACC002A')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC003 (IAA,VALACC)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, JAA, JAT, JFT1, GVFISM,
     +              JFT2, NAC, K
      REAL          VALACC(MAXTAT), V1LIM, V2LIM2, DX, DY, DZ, 
     +              D12, WATRAD, PX, PY, PZ, GVFMPI
      LOGICAL       GVFIBN








      CALL WIF083



      IF ((.NOT.GVFIBN(PNTAAS(IAA),1,NUMATF)).OR.
     +    (.NOT.GVFIBN(PNTAAE(IAA),1,NUMATF))) THEN
         CALL GVSTTB ('?ACCB05')
         GOTO 998
      END IF



      WATRAD=FLOAT(WIFPAR(29))/100.0
      CALL GVSRT0 (VALACC,MAXTAT)



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



         IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 35



         CALL GVSITC (LOGA,1,WIFPAR(68))



         V1LIM=VDWRAD(IAT)+WATRAD
         JFT1=MAX(1,IAA-1)
         JFT2=MIN(NUMAAF,IAA+1)
         IF (CHAINN(2,IAA).NE.CHAINN(2,JFT1)) JFT1=IAA
         IF (CHAINN(2,IAA).NE.CHAINN(2,JFT2)) JFT2=IAA
         DO 16 JAA=JFT1,JFT2
            DO 15 JAT=PNTAAS(JAA),PNTAAE(JAA)
               IF (PROTON(JAT).OR.(.NOT.ISATOK(JAT))) GOTO 15
               IF (IAT.EQ.JAT) GOTO 15
               IF (JAA.NE.IAA.AND.PINIAA(JAT).GT.4) GOTO 15







               DX=XCOORD(JAT)-XCOORD(IAT)
               DY=YCOORD(JAT)-YCOORD(IAT)
               DZ=ZCOORD(JAT)-ZCOORD(IAT)
               D12=DX**2+DY**2+DZ**2
               IF (D12.GT.(VDWRAD(IAT)+VDWRAD(JAT)+2.0*WATRAD)**2)
     +          GOTO 15



               V2LIM2=(VDWRAD(JAT)+WATRAD)**2
               DO 30 K=1,WIFPAR(68)
                  IF (LOGA(K).EQ.1) THEN
                     PX=DX-V1LIM*XUACC(K)
                     PY=DY-V1LIM*YUACC(K)
                     PZ=DZ-V1LIM*ZUACC(K)
                     IF (PX**2+PY**2+PZ**2.LT.V2LIM2) LOGA(K)=0
                  END IF
   30          CONTINUE
   15       CONTINUE
   16    CONTINUE



         NAC=GVFISM(LOGA,WIFPAR(68))
         IF (WIFPAR(79).EQ.0) THEN
            VALACC(PINIAA(IAT))=
     +       GVFMPI(4.0*(VDWRAD(IAT)**2)*FLOAT(NAC)/FLOAT(WIFPAR(68)))
         ELSE
            VALACC(PINIAA(IAT))=GVFMPI(4.0*((VDWRAD(IAT)+WATRAD)**2)*
     +       FLOAT(NAC)/FLOAT(WIFPAR(68)))
         END IF
   35 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC003A (IAA,VACPCT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, JAA, JAT, JFT1, GVFISM, JFT2, NAC, K
      REAL          VALACC(MAXTAT), V1LIM, V2LIM2, DX, DY, DZ, D12,
     +              WATRAD, PX, PY, PZ, GVFMPI, VACPCT, GVFRSM
      LOGICAL       GVFIBN, WIFIRR, T54EQUAL








      CALL WIF083



      IF ((.NOT.GVFIBN(PNTAAS(IAA),1,NUMATF)).OR.
     +    (.NOT.GVFIBN(PNTAAE(IAA),1,NUMATF))) THEN
         CALL GVSTTB ('?ACCB05')
         GOTO 998
      END IF
      IF (.NOT.ACCDON(IAA)) THEN
         VACPCT=-1.0
         GOTO 998
      END IF
      IF (.NOT.WIFIRR(IAA)) THEN
         CALL GVSTTE ('?RNGNPN')
         GOTO 998
      END IF



      WATRAD=FLOAT(WIFPAR(29))/100.0
      CALL GVSRT0 (VALACC,MAXTAT)



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



         IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 35



         CALL GVSITC (LOGA,1,WIFPAR(68))



         V1LIM=VDWRAD(IAT)+WATRAD
         JFT1=MAX(1,IAA-1)
         JFT2=MIN(NUMAAF,IAA+1)
         IF (CHAINN(2,IAA).NE.CHAINN(2,JFT1)) JFT1=IAA
         IF (CHAINN(2,IAA).NE.CHAINN(2,JFT2)) JFT2=IAA
         DO 16 JAA=JFT1,JFT2
            DO 15 JAT=PNTAAS(JAA),PNTAAE(JAA)
               IF (PROTON(JAT).OR.(.NOT.ISATOK(JAT))) GOTO 15
               IF (IAT.EQ.JAT) GOTO 15
               IF (JAA.LT.IAA.AND.T54EQUAL(ONESAT(JAT),' C  ')) GOTO 15
               IF (JAA.GT.IAA.AND.T54EQUAL(ONESAT(JAT),' N  ')) GOTO 15







               DX=XCOORD(JAT)-XCOORD(IAT)
               DY=YCOORD(JAT)-YCOORD(IAT)
               DZ=ZCOORD(JAT)-ZCOORD(IAT)
               D12=DX**2+DY**2+DZ**2
               IF (D12.GT.(VDWRAD(IAT)+VDWRAD(JAT)+2.0*WATRAD)**2)
     +          GOTO 15



               V2LIM2=(VDWRAD(JAT)+WATRAD)**2
               DO 30 K=1,WIFPAR(68)
                  IF (LOGA(K).EQ.1) THEN
                     PX=DX-V1LIM*XUACC(K)
                     PY=DY-V1LIM*YUACC(K)
                     PZ=DZ-V1LIM*ZUACC(K)
                     IF (PX**2+PY**2+PZ**2.LT.V2LIM2) LOGA(K)=0
                  END IF
   30          CONTINUE
   15       CONTINUE
   16    CONTINUE



         NAC=GVFISM(LOGA,WIFPAR(68))
         IF (WIFPAR(79).EQ.0) THEN
            VALACC(PINIAA(IAT))=GVFMPI(4.0*(VDWRAD(IAT)**2)*
     +       FLOAT(NAC)/FLOAT(WIFPAR(68)))
         ELSE
            VALACC(PINIAA(IAT))=GVFMPI(4.0*((VDWRAD(IAT)+WATRAD)**2)*
     +       FLOAT(NAC)/FLOAT(WIFPAR(68)))
         END IF
   35 CONTINUE
      VACPCT=100.0*SUMACC(IAA)/GVFRSM(VALACC,MAXTAT)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC003B (IAA,BURPHI,ACCPHI,BURPHO,ACCPHO)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, JAA, JAT, GVFISM, NAC, K
      REAL          V1LIM, V2LIM2, DX, DY, DZ, D12,
     +              WATRAD, PX, PY, PZ, GVFMPI, BURPHI, ACCPHI, 
     +              BURPHO, ACCPHO, VALACC
      LOGICAL       GVFIBN, WIFIRR
      CHARACTER*1   FIRSTCHARAT








      CALL WIF083
      BURPHI=0.0
      ACCPHI=0.0
      BURPHO=0.0
      ACCPHO=0.0



      IF ((.NOT.GVFIBN(PNTAAS(IAA),1,NUMATF)).OR.
     +    (.NOT.GVFIBN(PNTAAE(IAA),1,NUMATF))) THEN
         CALL GVSTTB ('?ACCB05')
         GOTO 998
      END IF
      IF (.NOT.WIFIRR(IAA)) THEN
         CALL GVSTTE ('?RNGNPN')
         GOTO 998
      END IF



      WATRAD=FLOAT(WIFPAR(29))/100.0



      DO 35 IAT=PNTAAS(IAA)+4,PNTAAE(IAA)



         IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 35



         CALL GVSITC (LOGA,1,WIFPAR(68))



         V1LIM=VDWRAD(IAT)+WATRAD
         DO 16 JAA=1,NUMAAF
            IF (JAA.EQ.IAA) GOTO 16
            DO 15 JAT=PNTAAS(JAA),PNTAAE(JAA)
               IF (PROTON(JAT).OR.(.NOT.ISATOK(JAT))) GOTO 15
               IF (IAT.EQ.JAT) GOTO 15







               DX=XCOORD(JAT)-XCOORD(IAT)
               DY=YCOORD(JAT)-YCOORD(IAT)
               DZ=ZCOORD(JAT)-ZCOORD(IAT)
               D12=DX**2+DY**2+DZ**2
               IF (D12.GT.(VDWRAD(IAT)+VDWRAD(JAT)+2.0*WATRAD)**2)
     +          GOTO 15



               V2LIM2=(VDWRAD(JAT)+WATRAD)**2
               DO 30 K=1,WIFPAR(68)
                  IF (LOGA(K).EQ.1) THEN
                     PX=DX-V1LIM*XUACC(K)
                     PY=DY-V1LIM*YUACC(K)
                     PZ=DZ-V1LIM*ZUACC(K)
                     IF (PX**2+PY**2+PZ**2.LT.V2LIM2) LOGA(K)=0
                  END IF
   30          CONTINUE
   15       CONTINUE
   16    CONTINUE



         NAC=GVFISM(LOGA,WIFPAR(68))
         VALACC=GVFMPI(4.0*(VDWRAD(IAT)**2)*
     +    FLOAT(NAC)/FLOAT(WIFPAR(68)))
         IF (FIRSTCHARAT(IAT).EQ.'C'.OR.
     +       FIRSTCHARAT(IAT).EQ.'S') THEN
            BURPHO=VALACC-ACCESS(IAT)
            ACCPHO=VALACC-BURPHO
         ELSE
            BURPHI=VALACC-ACCESS(IAT)
            ACCPHI=VALACC-BURPHI
         END IF
   35 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC003C (IAA,VACACC)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       MX2
      PARAMETER     (MX2=200)
      INTEGER       IAA, IAT, NAC, JAT, K, CONIAT(MX2),
     +              JATPRV, IAP, ONE, GVFISM, ICON, NUM
      REAL          DXL, DYL, DZL, PX, D12, ADDRAD, PP(4,MX2), VWR,  
     +              VWR2, R2VWR, MIND12, GVFMPI, TMP(3), 
     +              VACACC(MAXTAT)
      LOGICAL       WIFIRA







      DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
         VACACC(PINIAA(IAT))=0.0
   10 CONTINUE
      CALL WIF083
      CALL WIFPUSHPPP (11,1)
      ADDRAD=FLOAT(WIFPAR(29))/100.0
      CALL GVSRT0 (VACACC,MAXTAT)



      IF (.NOT.WIFIRA(IAA)) THEN
         CALL GVSTTB ('?RNGNAA')
         CALL GVSKIL
         GOTO 100
      END IF
      IF (HATPRA(RESTYP(IAA)).LE.5) GOTO 100



      NUM=0
      DO 20 IAT=PNTAAS(IAA),PNTAAE(IAA)
         NUM=NUM+1
         CONIAT(NUM)=IAT
   20 CONTINUE
      IF (IAA.GT.1) THEN
         IF (CHAINN(2,IAA).EQ.CHAINN(2,IAA-1)) THEN
            DO 30 IAT=PNTAAS(IAA-1),PNTAAS(IAA-1)+3
               NUM=NUM+1
               CONIAT(NUM)=IAT
   30       CONTINUE
         END IF
      END IF
      IF (IAA.LT.NUMAAF) THEN
         IF (CHAINN(2,IAA).EQ.CHAINN(2,IAA+1)) THEN
            DO 40 IAT=PNTAAS(IAA+1),PNTAAS(IAA+1)+3
               NUM=NUM+1
               CONIAT(NUM)=IAT
   40       CONTINUE
         END IF
      END IF



      DO 95 IAT=PNTAAS(IAA)+5,PNTAAE(IAA)



         IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) THEN
            VACACC(PINIAA(IAT))=0.0
            GOTO 95
         END IF



         VWR=VDWRAD(IAT)+ADDRAD
         VWR2=VWR**2
         R2VWR=1.0/(2.0*VWR)



         IF (NUM.EQ.0) THEN
            CALL GVSITC (LOGA, 1, WIFPAR(68))
            GOTO 90
         END IF
         MIND12=100.0
         ONE=0



         DO 50 ICON=1,NUM



            JAT=CONIAT(ICON)



            IF (PROTON(JAT).OR.(.NOT.ISATOK(JAT))) GOTO 50



            TMP(1)=XCOORD(JAT)
            TMP(2)=YCOORD(JAT)
            TMP(3)=ZCOORD(JAT)
            DXL=TMP(1)-XCOORD(IAT)
            DYL=TMP(2)-YCOORD(IAT)
            DZL=TMP(3)-ZCOORD(IAT)
            D12=DXL**2+DYL**2+DZL**2



            PP(1,ICON)=DXL
            PP(2,ICON)=DYL
            PP(3,ICON)=DZL
            PP(4,ICON)=(VWR2-(VDWRAD(JAT)+ADDRAD)**2+D12)*R2VWR



            IF (D12.LT.MIND12) THEN
               ONE=ICON
               MIND12=D12
            END IF
 50      CONTINUE



         IF (ONE.GT.1) THEN
            PX=PP(1,ONE)
            PP(1,ONE)=PP(1,1)
            PP(1,1)=PX
            PX=PP(2,ONE)
            PP(2,ONE)=PP(2,1)
            PP(2,1)=PX
            PX=PP(3,ONE)
            PP(3,ONE)=PP(3,1)
            PP(3,1)=PX
            PX=PP(4,ONE)
            PP(4,ONE)=PP(4,1)
            PP(4,1)=PX
         END IF



         JATPRV=1
         DO 80 K=1,WIFPAR(68)



            IF (PP(1,JATPRV)*XUACC(K)+PP(2,JATPRV)*YUACC(K)+
     +          PP(3,JATPRV)*ZUACC(K).GT.PP(4,JATPRV)) THEN
               LOGA(K)=0
               GOTO 80
            END IF



            DO 60 IAP=1,NUM
               IF (PP(1,IAP)*XUACC(K)+PP(2,IAP)*YUACC(K)+
     +             PP(3,IAP)*ZUACC(K).GT.PP(4,IAP)) THEN
                  LOGA(K)=0
                  JATPRV=IAP
                  GOTO 80
               END IF
   60       CONTINUE
            LOGA(K)=1
   80    CONTINUE



   90    CONTINUE
         NAC=GVFISM(LOGA,WIFPAR(68))
         IF (WIFPAR(79).EQ.0) THEN
            VACACC(PINIAA(IAT))=GVFMPI(4.0*(VDWRAD(IAT)**2)*
     +       FLOAT(NAC)/FLOAT(WIFPAR(68)))
         ELSE
            VACACC(PINIAA(IAT))=GVFMPI(4.0*((VDWRAD(IAT)+ADDRAD)**2)*
     +       FLOAT(NAC)/FLOAT(WIFPAR(68)))
         END IF
   95 CONTINUE



  100 CONTINUE
      CALL WIFPOPPPP (11)





      RETURN
      END
      SUBROUTINE ACC004 (AAREAD)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      REAL          SUMACA(NUMUA), ACBACK, ACSIDE, AVE, ADEV, SDEV, VAR,
     +              SKEW, CURT, AVERAC
      INTEGER       ISUMAC(NUMUA), IAA, IAT, IAATYP, IATYPE, INUMBR,
     +              IFIRST, ISOUP, IERR, IERCNT
      LOGICAL       WIFIRR, WIFIRW, AAREAD, GETPORT
      CHARACTER*2   WIF054, CHAR2
      EQUIVALENCE   (SUMACA(1),ESPACE(6001))
      EQUIVALENCE   (ISUMAC(1),ESPACE(7001))







      CALL ESPSET (6001,7000+NUMUA,10)




      IF (.NOT.AAREAD) THEN
         CALL WIFWTF (' ',IERR)
         CALL GVSCPB (WRK3TF,WRK1TF,NUMAAF)
         IF (IERR.NE.0) GOTO 998
      END IF



      IERCNT=0
      DO 15 IAA=1,NUMAAF
         IF (WRK3TF(IAA)) THEN
            IF (.NOT.ACCDON(IAA)) THEN
               IERCNT=IERCNT+1
               IF (IERCNT.GT.2) GOTO 998
               CALL ACC001
               CALL WIF039
            END IF
         END IF
   15 CONTINUE



      IF (IERCNT.NE.0) THEN
         CALL GVSNL6 (1)
         CALL SHOWTEXT ('?M0568')
         CALL GVSNL6 (1)
      END IF



      CALL GETTEXTP (GETPORT)



      CALL SHOWTEXT ('?ACCHDOB')
      CALL SHOWTEXT ('?ACCHD6')
      DO 30 IAA=1,NUMAAF
         IF (.NOT.WRK3TF(IAA)) GOTO 30
         IF (WIFIRW(IAA)) GOTO 30
         ACBACK=0.0
         ACSIDE=0.0
         DO 28 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 28
            IF (IAT.LE.PNTAAS(IAA)+3) THEN
               ACBACK=ACBACK+ACCESS(IAT)
            ELSE
               ACSIDE=ACSIDE+ACCESS(IAT)
            END IF
   28    CONTINUE
         CHAR2=WIF054(IAA)
         CALL DIF006D (6,IAA,SUMACC(IAA),ACBACK,ACSIDE,CHAR2)
   30 CONTINUE



      CALL GVSRT0 (SUMACA,NUMUA)
      CALL GVSIT0 (ISUMAC,NUMUA)
      DO 40 IAA=1,NUMAAF
         IF (.NOT.WRK3TF(IAA)) GOTO 40
         IF (.NOT.WIFIRR(IAA)) GOTO 40
         IAATYP=RESTYP(IAA)
         SUMACA(IAATYP)=SUMACA(IAATYP)+SUMACC(IAA)
         ISUMAC(IAATYP)=ISUMAC(IAATYP)+1
   40 CONTINUE
      CALL GVSNL6 (4)
      CALL SHOWTEXT ('?ACCHD7')
      CALL GVSNL6 (1)
      CALL GVSFMT ('?FMT473')
      DO 50 IATYPE=1,20
         IF (ISUMAC(IATYPE).GT.0) THEN
            AVERAC=SUMACA(IATYPE)/FLOAT(ISUMAC(IATYPE))
         ELSE
            AVERAC=0.0
         END IF
         CALL GVSCTB (LINE,80)
         WRITE (LINE,FMT,ERR=50) AANAME(IATYPE),ISUMAC(IATYPE),AVERAC
         CALL GVSTT6 (LINE)
   50 CONTINUE



      DO 60 IAA=1,NUMAAF
         IF (.NOT.WRK1TF(IAA)) GOTO 60
         IF (.NOT.WIFIRW(IAA)) GOTO 60
         ISOUP=CHAINN(2,IAA)
         IFIRST=PNTAAS(SOUADM(1,ISOUP))
         INUMBR=PNTAAE(SOUADM(2,ISOUP))-PNTAAS(SOUADM(1,ISOUP))+1
         CALL GVSTTI ('?ACCWUS',INUMBR)
         CALL GVSRAV (ACCESS(IFIRST),INUMBR,AVE,ADEV,SDEV,VAR,SKEW,CURT)
         CALL GVSTT6 ('?ACCWST')
         CALL GVSPRS (AVE,ADEV,SDEV,SKEW,CURT)
   60 CONTINUE



      CALL KILLTEXTP (GETPORT)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC005



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       ISUMAC(NUMUA), IAA, IAT, IAATYP, IATYPE, ISOUP,
     +              IERR, ISOU, GVFCBT
      REAL          SUMACA(NUMUA), ACBACK, ACSIDE, AVERAC, 
     +              OLDACC(MAXAT), OLDSAC(MAXAA)
      LOGICAL       WIFIRA, GVFIBN
      EQUIVALENCE   (SUMACA(1),ESPACE(106001))
      EQUIVALENCE   (ISUMAC(1),ESPACE(107001))
      EQUIVALENCE   (OLDACC(1),ESPACE(1010001))
      EQUIVALENCE   (OLDSAC(1),ESPACE(1010001+MAXAT))







      IF (WIFPAR(837).EQ.1) THEN
         CALL SHOWTEXT ('?M1590')
         GOTO 998
      END IF



      CALL ESPSET (106001,1010000+MAXAT,10)



      CALL SHOWTEXTIF ('?M1960')
      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998



      CALL WIF080



      CALL ENVWTF
      IF (GVFCBT(WRK1TF,NUMAAT).LE.0) GOTO 998



      DO 21 ISOU=1,NUMSOU
         IF (USESOU(ISOU).NE.0) THEN
            DO 11 IAA=SOUADM(1,ISOU),SOUADM(2,ISOU)
               CALL WIF041 (IAA)
               ACCDON(IAA)=.TRUE.
   11       CONTINUE
         END IF
   21 CONTINUE



      CALL GVSCPR (OLDACC,ACCESS,MAXAT)
      CALL GVSCPR (OLDSAC,SUMACC,MAXAA)



      CALL WIF080
      CALL MOL310 (ISOUP,-1,'?M1589')
      CALL GVSTTI ('?M1981',ISOUP)
      IF (ISOUP.LE.0) GOTO 998
      DO 25 IAA=1,NUMAAT
         IF (GVFIBN(IAA,SOUADM(1,ISOUP),SOUADM(2,ISOUP))) THEN
            CALL SHOIAA (IAA)
            WRK1TF(IAA)=.FALSE.
         END IF
   25 CONTINUE
      CALL ENVWTF
      IF (GVFCBT(WRK1TF,NUMAAT).LE.0) GOTO 998



      USESOU(ISOUP)=0
      DO 41 ISOU=1,NUMSOU
         IF (USESOU(ISOU).NE.0) THEN
            DO 31 IAA=SOUADM(1,ISOU),SOUADM(2,ISOU)
               CALL WIF041 (IAA)
               ACCDON(IAA)=.TRUE.
   31       CONTINUE
         END IF
   41 CONTINUE



      CALL GVSIT0 (USESOU,MAXMOL)
      USESOU(ISOUP)=ISOUP
      DO 51 IAA=SOUADM(1,ISOUP),SOUADM(2,ISOUP)
         CALL WIF041 (IAA)
         ACCDON(IAA)=.TRUE.
   51 CONTINUE



      CALL GVSVMV (ACCESS,OLDACC,MAXAT)
      CALL GVSVMV (SUMACC,OLDSAC,MAXAA)



      CALL SHOWTEXT ('?ACCHD6')
      DO 30 IAA=1,NUMAAT
         ACBACK=0.0
         ACSIDE=0.0
         DO 28 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 28
            IF (IAT.LE.PNTAAS(IAA)+3) THEN
               ACBACK=ACBACK+ACCESS(IAT)
            ELSE
               ACSIDE=ACSIDE+ACCESS(IAT)
            END IF
   28    CONTINUE
         IF (SUMACC(IAA).GT.0.0001) THEN
            IF (WIFIRA(IAA)) THEN
               CALL DIF006 (6,IAA,SUMACC(IAA),ACBACK,ACSIDE)
            ELSE
               CALL DIF002 (6,IAA,SUMACC(IAA))
            END IF
         END IF
   30 CONTINUE



      CALL GVSRT0 (SUMACA,NUMUA)
      CALL GVSIT0 (ISUMAC,NUMUA)
      DO 40 IAA=1,NUMAAF
         IAATYP=RESTYP(IAA)
         SUMACA(IAATYP)=SUMACA(IAATYP)+SUMACC(IAA)
         ISUMAC(IAATYP)=ISUMAC(IAATYP)+1
   40 CONTINUE
      CALL GVSNL6 (4)
      CALL SHOWTEXT ('?ACCHD7A')
      CALL GVSNL6 (1)
      CALL GVSFMT ('?FMT466')
      DO 50 IATYPE=1,20
         IF (ISUMAC(IATYPE).GT.0) THEN
            AVERAC=SUMACA(IATYPE)
         ELSE
            AVERAC=0.0
         END IF
         CALL GVSCTB (LINE,80)
         WRITE (LINE,FMT,ERR=50) AANAME(IATYPE),ISUMAC(IATYPE),AVERAC
         CALL GVSTT6 (LINE)
   50 CONTINUE



      CALL WIFPUSHPPP (1212,1)
      CALL ACC006 (1,NUMAAF,OLDACC,IERR)
      CALL WIFPOPPPP (1212)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC006 (IFT1,IFT2,OLDACC,IERR)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       CNT(11), IAA, IFT1, IFT2, IATSS, IAT, IATBB,
     +              ISTART, IERR, GVFISM
      REAL          BUR(11), SRF(11), OLDACC(MAXAT), GVFRSM
      LOGICAL       GETPORT, WIFIRA, ISPROT
      CHARACTER*1   FIRSTCHARAT, CH







      CALL GVSRT0 (BUR,11)
      CALL GVSRT0 (SRF,11)
      CALL GVSIT0 (CNT,11)
      IERR=0
      ISPROT=.FALSE.



      CALL SHOSOU
      DO 100 IAA=IFT1,IFT2



         IF (WIFIRA(IAA)) THEN
            ISPROT=.TRUE.
            DO 20 IAT=PNTAAS(IAA),PNTAAS(IAA)+3
               IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 20
               IATBB=IAT-PNTAAS(IAA)+1
               BUR(IATBB)=BUR(IATBB)+ACCESS(IAT)
               SRF(IATBB)=SRF(IATBB)+OLDACC(IAT)+ACCESS(IAT)
               CNT(IATBB)=CNT(IATBB)+1
   20       CONTINUE
         ELSE
            DO 25 IAT=PNTAAS(IAA),PNTAAS(IAA)+3
               BUR(10)=BUR(10)+ACCESS(IAT)
               SRF(10)=SRF(10)+OLDACC(IAT)+ACCESS(IAT)
               CNT(10)=CNT(10)+1
   25       CONTINUE
         END IF




         IF (RESTYP(IAA).EQ.6) GOTO 100
         IF (WIFIRA(IAA)) THEN
            ISTART=PNTAAS(IAA)+4
         ELSE
            ISTART=PNTAAS(IAA)
         END IF
         DO 30 IAT=ISTART,PNTAAE(IAA)
            IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 30
            CH=FIRSTCHARAT(IAT)
            IF (CH.EQ.'N') THEN
               IATSS=5
            ELSE IF (CH.EQ.'C') THEN
               IATSS=6
            ELSE IF (CH.EQ.'O') THEN
               IATSS=7
            ELSE IF (CH.EQ.'S') THEN
               IATSS=8
            ELSE IF (CH.EQ.'P') THEN
               IATSS=9
            ELSE 
               IATSS=6
               CALL GVSTTB ('?R00084')
               CALL GVSTT6 (ONESA3(IAA))
               CALL GVSTT6 (ONESAT(IAT))
            END IF
            BUR(IATSS)=BUR(IATSS)+ACCESS(IAT)
            SRF(IATSS)=SRF(IATSS)+OLDACC(IAT)+ACCESS(IAT)
            CNT(IATSS)=CNT(IATSS)+1
   30    CONTINUE
  100 CONTINUE



      CALL GVSNL6 (1)
      CALL SHOWTEXT ('?ACCHD5B')
      CALL GVSNL6 (1)
      CALL GVSFMT ('?FMT474')
      IF (ISPROT) THEN
         CALL GVSSTX (LINE,'?ACCS01')
         WRITE (LINE(21:80),FMT,ERR=999) CNT(1),SRF(1),SRF(1)-BUR(1),
     +    BUR(1)
         CALL GVSTT6 (LINE)
         CALL GVSSTX (LINE,'?ACCS02')
         WRITE (LINE(21:80),FMT,ERR=999) CNT(2),SRF(2),SRF(2)-BUR(2),
     +    BUR(2)
         CALL GVSTT6 (LINE)
         CALL GVSSTX (LINE,'?ACCS03')
         WRITE (LINE(21:80),FMT,ERR=999) CNT(3),SRF(3),SRF(3)-BUR(3),
     +    BUR(3)
         CALL GVSTT6 (LINE)
         CALL GVSSTX (LINE,'?ACCS04')
         WRITE (LINE(21:80),FMT,ERR=999) CNT(4),SRF(4),SRF(4)-BUR(4),
     +    BUR(4)
         CALL GVSTT6 (LINE)
      END IF



      CALL GVSSTX (LINE,'?ACCS05')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(5),SRF(5),SRF(5)-BUR(5),
     + BUR(5)
      CALL GVSTT6 (LINE)



      CALL GVSSTX (LINE,'?ACCS06')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(6),SRF(6),SRF(6)-BUR(6),
     + BUR(6)
      CALL GVSTT6 (LINE)



      CALL GVSSTX (LINE,'?ACCS07')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(7),SRF(7),SRF(7)-BUR(7),
     + BUR(7)
      CALL GVSTT6 (LINE)



      CALL GVSSTX (LINE,'?ACCS08')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(8),SRF(8),SRF(8)-BUR(8),
     + BUR(8)
      CALL GVSTT6 (LINE)



      CALL GVSSTX (LINE,'?ACCS09')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(9),SRF(9),SRF(9)-BUR(9),
     + BUR(9)
      CALL GVSTT6 (LINE)



      CALL GVSSTX (LINE,'?ACCS10')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(10),SRF(10),SRF(10)-BUR(10),
     + BUR(11)
      CALL GVSTT6 (LINE)



      CNT(11)=GVFISM(CNT,10)
      SRF(11)=GVFRSM(SRF,10)
      BUR(11)=GVFRSM(BUR,10)
      CALL GVSSTX (LINE,'?ACCS11')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(11),SRF(11),SRF(11)-BUR(11),
     + BUR(10)



  999 CONTINUE
      CALL KILLTEXTP (GETPORT)





      RETURN
      END
      SUBROUTINE ACC007 (IFT1,IFT2,IERR)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'IRIGRA.INC'
      REAL          BUR(9), SRF(9), VALACC(MAXTAT), GVFRSM
      INTEGER       CNT(9), IAA, IFT1, IFT2, IATSS, IAT, IATBB,
     +              ISTART, IERR, GVFISM
      LOGICAL       GETPORT, WIFIRA, ISPROT
      CHARACTER*1   FIRSTCHARAT, CH







      CALL GVSRT0 (BUR,9)
      CALL GVSRT0 (SRF,9)
      CALL GVSIT0 (CNT,9)
      IERR=0
      ISPROT=.TRUE.



      IF (IFT1.EQ.0) THEN
         CALL WIFWTF ('?ACCSRA',IERR)
         CALL GVSCPB (WRK4TF,WRK1TF,MAXAA)
         IF (IERR.NE.0) GOTO 998
      ELSE IF (IFT1.GT.0) THEN
         CALL GVSBTF (WRK1TF,MAXAA)
         DO 5 IAA=IFT1,IFT2
            WRK4TF(IAA)=.TRUE.
    5    CONTINUE
      END IF



      DO 10 IAA=1,NUMAAF
         IF (WRK4TF(IAA).AND.(.NOT.ACCDON(IAA))) THEN
            CALL ACC001
            IERR=1
            GOTO 998
         END IF
   10 CONTINUE



      CALL GETTEXTP (GETPORT)



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



         IRSTAT(10)=5*IAA/NUMAAF



         CALL ACC003 (IAA,VALACC)



         IF (WIFIRA(IAA)) THEN
            DO 20 IAT=PNTAAS(IAA),PNTAAS(IAA)+3
               IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 20
               IATBB=IAT-PNTAAS(IAA)+1
               BUR(IATBB)=BUR(IATBB)+ACCESS(IAT)
               SRF(IATBB)=SRF(IATBB)+VALACC(IATBB)
               CNT(IATBB)=CNT(IATBB)+1
   20       CONTINUE
         ELSE
            ISPROT=.FALSE.
         END IF




         IF (RESTYP(IAA).EQ.6) GOTO 100
         IF (WIFIRA(IAA)) THEN
            ISTART=PNTAAS(IAA)+4
         ELSE
            ISTART=PNTAAS(IAA)
         END IF
         DO 30 IAT=ISTART,PNTAAE(IAA)
            IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 30
            CH=FIRSTCHARAT(IAT)
            IF (CH.EQ.'N') THEN
               IATSS=5
            ELSE IF (CH.EQ.'C') THEN
               IATSS=6
            ELSE IF (CH.EQ.'O') THEN
               IATSS=7
            ELSE IF (CH.EQ.'S') THEN
               IATSS=8
            ELSE IF (CH.EQ.'P') THEN
               IATSS=9
            ELSE
               IATSS=6
               CALL GVSTTB ('?R00085')
            END IF
            BUR(IATSS)=BUR(IATSS)+ACCESS(IAT)
            SRF(IATSS)=SRF(IATSS)+VALACC(IAT-PNTAAS(IAA)+1)
            CNT(IATSS)=CNT(IATSS)+1
   30    CONTINUE
  100 CONTINUE



      CALL GVSNL6 (1)
      CALL SHOWTEXT ('?ACCHD5A')
      CALL GVSNL6 (1)
      CALL GVSFMT ('?FMT474')
      IF (ISPROT) THEN
         CALL GVSSTX (LINE,'?ACCS01')
         WRITE (LINE(21:80),FMT,ERR=999) CNT(1),SRF(1),BUR(1),
     +    SRF(1)-BUR(1)
         CALL GVSTT6 (LINE)
         CALL GVSSTX (LINE,'?ACCS02')
         WRITE (LINE(21:80),FMT,ERR=999) CNT(2),SRF(2),BUR(2),
     +    SRF(2)-BUR(2)
         CALL GVSTT6 (LINE)
         CALL GVSSTX (LINE,'?ACCS03')
         WRITE (LINE(21:80),FMT,ERR=999) CNT(3),SRF(3),BUR(3),
     +    SRF(3)-BUR(3)
         CALL GVSTT6 (LINE)
         CALL GVSSTX (LINE,'?ACCS04')
         WRITE (LINE(21:80),FMT,ERR=999) CNT(4),SRF(4),BUR(4),
     +    SRF(4)-BUR(4)
         CALL GVSTT6 (LINE)
      END IF
      CALL GVSSTX (LINE,'?ACCS05')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(5),SRF(5),BUR(5),
     + SRF(5)-BUR(5)
      CALL GVSTT6 (LINE)
      CALL GVSSTX (LINE,'?ACCS06')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(6),SRF(6),BUR(6),
     + SRF(6)-BUR(6)
      CALL GVSTT6 (LINE)
      CALL GVSSTX (LINE,'?ACCS07')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(7),SRF(7),BUR(7),
     + SRF(7)-BUR(7)
      CALL GVSTT6 (LINE)
      CALL GVSSTX (LINE,'?ACCS08')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(8),SRF(8),BUR(8),
     + SRF(8)-BUR(8)
      CALL GVSTT6 (LINE)
      CALL GVSSTX (LINE,'?ACCS09')
      WRITE (LINE(21:80),FMT,ERR=999) CNT(9),SRF(9),BUR(9),
     + SRF(9)-BUR(9)
      CALL GVSTT6 (LINE)
      IF (WIFPAR(837).NE.1) THEN
         CALL GVSSTX (LINE,'?ACCS11')
         WRITE (LINE(21:80),FMT,ERR=999) GVFISM(CNT,9),
     +    GVFRSM(SRF,9),GVFRSM(BUR,9),GVFRSM(SRF,9)-GVFRSM(BUR,9)
         CALL GVSTT6 (LINE)
      END IF



  999 CONTINUE
      CALL KILLTEXTP (GETPORT)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC008 (IFT1,IFT2,IERR)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IFT1, IFT2, IERR
      REAL          AVEACC(20), WATRAD
      LOGICAL       WIFIRA, GETPORT
      SAVE          AVEACC
      DATA AVEACC  /11.0, 5.0,19.0,22.0,10.0, 9.0,20.0,10.0,33.0,20.0,
     +              13.0,19.0,17.0,25.0,31.0,12.0,17.0, 8.0,12.0,16.0/







      WATRAD=FLOAT(WIFPAR(29))/100.0
      IF (ABS(WATRAD-1.4).GT.0.1) THEN
         CALL GVSTTE ('?ACCB34')
         CALL GVSTTR ('?ACCB35',WATRAD)
         CALL SHOWTEXT ('?ACCB36')
         IERR=1
      END IF



      IERR=0



      IF (IFT1.EQ.0) THEN
         CALL WIFWTF ('?ACCRAN',IERR)
         CALL GVSCPB (WRK4TF,WRK1TF,MAXAA)
         IF (IERR.NE.0) GOTO 998
      ELSE IF (IFT1.GT.0) THEN
         CALL GVSBTF (WRK1TF,MAXAA)
         DO 15 IAA=IFT1,IFT2
            WRK4TF(IAA)=.TRUE.
   15    CONTINUE
      END IF



      DO 20 IAA=1,NUMAAF
         IF (.NOT.WRK1TF(IAA)) GOTO 20
         IF (.NOT.ACCDON(IAA)) THEN
            CALL ACC001
            IERR=1
            GOTO 998
         END IF
         IF (.NOT.WIFIRA(IAA)) THEN
            CALL GVSTTE ('?RNGNAA')
            IERR=1
            GOTO 998
         END IF
   20 CONTINUE



      CALL GETTEXTP (GETPORT)
      CALL GVSNL6 (1)
      CALL GVSTT6 ('?ACCHD3')
      CALL GVSNL6 (1)
      CALL SHOWTEXT ('?ACCHD4')
      CALL GVSNL6 (1)
      DO 30 IAA=1,NUMAAF
         IF (WRK4TF(IAA)) CALL DIF004 (6,IAA,SUMACC(IAA),
     +    AVEACC(RESTYP(IAA)))
   30 CONTINUE



      CALL KILLTEXTP (GETPORT)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC009 (JFT1,JFT2,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'RESULT.INC'
      INTEGER       IAA, IAATYP, I, JFT1, JFT2, IUSED, GVFPOS,
     +              GVFLFR, IERR
      REAL          ACCEVA(3,20), TOTVAL, FACTOR, TOTNOR, TOTABS
      LOGICAL       FIRST, GETPORT, WIFIRA, GVFYON, GVFIBN, GVFRIN
      CHARACTER*23  IAAS, DIF001
      SAVE          ACCEVA, FIRST
      DATA FIRST    /.TRUE./







      GETPORT=.FALSE.



      CALL GVSRT0 (ACCEVA,3*20)
      FIRST=.FALSE.



      CALL SETFILNAM (LINE,'EVAACC.ACC',IERR)
      IF (IERR.NE.0) GOTO 997
      CALL GETFILE (11,' ',LINE,IERR)
      IF (IERR.NE.0) GOTO 997



 10   CONTINUE
      CALL GVSFMT ('?FMT111')
      CALL GVSCTB (LINE,80)
      READ (11,FMT,ERR=999,END=30) LINE
      IF (GVFPOS(LINE,'AA').EQ.0) GOTO 10
      DO 20 IAATYP=1,20
         IF (GVFPOS(LINE,AANAME(IAATYP)).NE.0) THEN
            I=GVFLFR(3,ACCEVA(1,IAATYP),LINE)
            IF (I.NE.3) THEN
               CALL GVSTTB ('?ACCB30')
               CALL GVSTT6 (LINE)
            END IF
            GOTO 10
         END IF
 20   CONTINUE
      GOTO 10
 30   CONTINUE
      CALL GVSCLF (11)



      IF (JFT1.EQ.0.OR.JFT2.EQ.0) THEN
         CALL WIFWTF ('?ACCRSC',IERR)
         CALL GVSCPB (WRK4TF,WRK1TF,MAXAA)
         IF (IERR.NE.0) GOTO 997
      ELSE IF (JFT1.GT.0) THEN
         CALL GVSBTF (WRK1TF,MAXAA)
         DO 60 IAA=JFT1,JFT2
            WRK4TF(IAA)=.TRUE.
   60    CONTINUE
      END IF



   70 CONTINUE
      DO 80 IAA=1,NUMAAF
         IF (.NOT.WRK4TF(IAA).OR.ACCDON(IAA)) GOTO 80
         CALL GVSNL6 (1)
         CALL SHOWTEXT ('?ACCB02')
         IF (.NOT.GVFYON('?ACCCOP',' ')) GOTO 997
         CALL SHOWTEXT ('?ACCB03')
         CALL WIF039
         GOTO 70
   80 CONTINUE



      CALL GETTEXTP (GETPORT)
      CALL GVSNL6 (1)



      CALL SHOWTEXT ('?ACCHD8')



      TOTVAL=0.0
      IUSED=0
      DO 130 IAA=1,NUMAAF
         IF (.NOT.WIFIRA(IAA)) GOTO 130
         IF (.NOT.WRK4TF(IAA)) GOTO 130
         IAATYP=RESTYP(IAA)
         IF (.NOT.GVFIBN(IAATYP,1,20)) GOTO 130
         IF (.NOT.GVFRIN(SUMACC(IAA),ACCEVA(2,IAATYP)-ACCEVA(3,IAATYP),
     +       ACCEVA(2,IAATYP)+ACCEVA(3,IAATYP))) THEN
            FACTOR=ABS(ACCEVA(2,IAATYP)-SUMACC(IAA))/ACCEVA(3,IAATYP)
         ELSE
            FACTOR=0.0
         END IF
         TOTVAL=TOTVAL+FACTOR
         IUSED=IUSED+1



         IAAS=DIF001(IAA)
         CALL GVSFMT ('?FMT475')
         WRITE (LINE,FMT,ERR=998) IAAS,
     +    SUMACC(IAA),NINT(ACCEVA(1,IAATYP)),ACCEVA(2,IAATYP),
     +    ACCEVA(3,IAATYP),FACTOR
         CALL GVSTT6 (LINE)



         IF (FACTOR.GT.0.999) THEN



               CALL GVSFMT ('?FMT651')

            WRITE (LINE,FMT,ERR=998) IAA,ONESA3(IAA),NUMNAM(IAA),
     +       SUMACC(IAA),NINT(ACCEVA(1,IAATYP)),ACCEVA(2,IAATYP),
     +       ACCEVA(3,IAATYP),FACTOR
            CALL PDBTT6 (LINE)
         END IF
  130 CONTINUE
      TOTNOR=TOTVAL/FLOAT(IUSED)
      TOTABS=(TOTNOR-0.97)/0.45



      GENRVL(2)=TOTVAL
      GENRVL(3)=TOTNOR
      GENRVL(4)=TOTABS



      CALL GVSTTR ('?ACCSC1A',TOTVAL)
      CALL GVSTTR ('?ACCSC2A',TOTNOR)
      CALL GVSTTR ('?ACCSC3A',TOTABS)
      CALL GVSTT6 ('?ACCSC4')



      CALL KILLTEXTP (GETPORT)



  997 CONTINUE

      RETURN



  999 CONTINUE
      CALL GVSTTE ('?ACCB31')
      CALL KILLTEXTP (GETPORT)
      CALL GVSCLF (11)
      GOTO 997



  998 CONTINUE
      CALL GVSEIW ('ACC009')
      CALL KILLTEXTP (GETPORT)
      CALL GVSCLF (11)
      GOTO 997

      END
      SUBROUTINE ACC010

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ENVIRO.INC'
      INTEGER       ISOUP, IPRINT







      IPRINT=0



      CALL GVSNL6 (1)
      CALL GVSTT6 ('?M0547')



      DO 10 ISOUP=1,MAXMOL
         IF (USESOU(ISOUP).NE.0) THEN
            CALL GVSNL6 (1)
            CALL GVSTTI ('?M0548',USESOU(ISOUP))
            CALL GVST6C ('?M1022',SOUNAM(SOUPNT(SOUADM(1,ISOUP))),
     +       .TRUE.)
            IPRINT=IPRINT+1
         END IF
   10 CONTINUE



      IF (IPRINT.LE.0) CALL GVSTTE ('?NOENVY')





      RETURN
      END   
      SUBROUTINE ACC011 (JFT1,JFT2)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'TABLES.INC'
      INTEGER       JFT1, JFT2, IAA, ITAB, IVAL, IERR
      CHARACTER*4   CVAL
      LOGICAL       DOTAB, GVFYON, BVAL
      REAL          ACCALA







      CALL GVSNL6 (1)
      CALL GVSTT6 ('?ACCALA')
      CALL GVSNL6 (1)
      CALL GVSCTB (CVAL,4)
      IVAL=0
      DOTAB=.FALSE.



      IF (JFT1.EQ.0) THEN
         CALL WIFWTF (' ',IERR)
         IF (IERR.NE.0) GOTO 998
      ELSE
         CALL GVSBTF (WRK1TF,MAXAA)
         DO 10 IAA=JFT1,JFT2
            WRK1TF(IAA)=.TRUE.
   10    CONTINUE
      END IF
      CALL GVSCPB (WRK2TF,WRK1TF,NUMAAT)



      IF (GVFYON('?XRARTA',' ')) THEN
         DOTAB=.TRUE.
         CALL TAB016A (ITAB,0,IERR)
         IF (ITAB.EQ.0.OR.IERR.NE.0) GOTO 998
         CALL TAB029A (ITAB)
      END IF



      CALL WIFPUSHPPP (710,1)
      CALL WIFPUSHPPP (715,1)
      DO 20 IAA=1,NUMAAT
         IF (WRK2TF(IAA)) THEN
            CALL ACC012 (IAA,ACCALA,.TRUE.)
            IF (DOTAB) THEN
               CALL TAB104 (IAA,ITAB,ACCALA,IVAL,CVAL,BVAL,IERR)
               TABLEN(ITAB)=IAA
            END IF
         END IF
   20 CONTINUE
      CALL WIFPOPPPP (715)
      CALL WIFPOPPPP (710)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC012 (IAA,CBACC,PRINT)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IERR
      REAL          CBACC
      LOGICAL       PRINT, WIFIRI







      IF (.NOT.WIFIRI(IAA)) THEN
         CALL GVSTTI ('?ACCB26',IAA)
         GOTO 998
      END IF



      ACCDON(IAA)=.FALSE.
      CALL ENVIAA (IAA)



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



      CALL WIF330 (IAA,1)



      CALL WIF041 (IAA)
      CBACC=ACCESS(PNTAAS(IAA)+4)



      CALL WIFPOPRES (IERR)
      IF (IERR.NE.0) GOTO 998



      IF (PRINT) CALL DIF002 (6,IAA,CBACC)



      ACCDON(IAA)=.FALSE.



  998 CONTINUE


      RETURN
      END
      SUBROUTINE ACC013

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'







      CALL GVSNL6 (1)
      CALL GVSTT6 ('?ACCPHD')
      CALL GVSNL6 (1)
      CALL GVSTTI ('?ACCP06',WIFPAR(6))
      CALL GVSTTR ('?ACCP29',FLOAT(WIFPAR(29))/100.0)
      CALL GVSTTI ('?ACCP18',WIFPAR(298))
      CALL GVSTTI ('?ACCP79',WIFPAR(79))
      CALL GVSTTI ('?ACCP59',WIFPAR(59))
      CALL GVSTTI ('?ACCP461',WIFPAR(461))





      RETURN
      END
      SUBROUTINE ACC014

















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







      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998



      CALL SHOWTEXT ('?M1845')



      DO 10 IAA=1,NUMAAF
         IF (.NOT.WRK1TF(IAA)) GOTO 10
         CALL ACC015 (IAA,VALUE,IERR)
         IF (IERR.NE.0) GOTO 10
         CALL DIF002 (6,IAA,VALUE)
   10 CONTINUE



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE ACC015 (IAA,VALUE,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, JAA, JAT, GVFISM, NAC, K, IERR
      REAL          V1LIM, V2LIM2, DX, DY, DZ, D12, SPCACC, VALUE,
     +              WATRAD, PX, PY, PZ, GVFMPI, VALACC(MAXTAT),
     +              NEARDST, WIFDST, FE1, FE2, FE3
      LOGICAL       TOUCH, ACC016







      IERR=0
      VALUE=0.0
      CALL GVSRT0 (VALACC,MAXTAT)
      FE1=0.0
      FE2=0.0
      FE3=0.0



      CALL ACC003 (IAA,VALACC)




      CALL WIF083



      WATRAD=FLOAT(WIFPAR(29))/100.0



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



         IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) GOTO 35



         CALL GVSITC (LOGA,1,WIFPAR(68))
         V1LIM=VDWRAD(IAT)+WATRAD
         DO 30 K=1,WIFPAR(68)



            NEARDST=99999.9
            DO 16 JAA=1,NUMAAF
               DO 15 JAT=PNTAAS(JAA),PNTAAE(JAA)
                  IF (PROTON(JAT).OR.(.NOT.ISATOK(JAT))) GOTO 15
                  IF (IAT.EQ.JAT) GOTO 15
                  DX=XCOORD(JAT)-XCOORD(IAT)
                  DY=YCOORD(JAT)-YCOORD(IAT)
                  DZ=ZCOORD(JAT)-ZCOORD(IAT)
                  D12=DX**2+DY**2+DZ**2
                  IF (D12.GT.(VDWRAD(IAT)+VDWRAD(JAT)+
     +             2.0*WATRAD)**2) GOTO 15



                  V2LIM2=(VDWRAD(JAT)+WATRAD)**2
                  PX=DX-V1LIM*XUACC(K)
                  PY=DY-V1LIM*YUACC(K)
                  PZ=DZ-V1LIM*ZUACC(K)
                  TOUCH=PX**2+PY**2+PZ**2.LT.V2LIM2
                  IF (.NOT.TOUCH) GOTO 15



                  IF (IAA.EQ.JAA.OR.
     +               (ABS(IAA-JAA).EQ.1.AND.PINIAA(JAT).LE.4)) THEN
                     LOGA(K)=0
                     GOTO 30
                  END IF



                  IF (WIFDST(IAT,JAT).LT.NEARDST) THEN
                     NEARDST=WIFDST(IAT,JAT)
                  ELSE
                     GOTO 15
                  END IF



                  IF (ACC016(JAT)) THEN
                     IF (TOUCH) LOGA(K)=0
                  ELSE
                     IF (TOUCH) LOGA(K)=1
                  END IF
   15          CONTINUE
   16       CONTINUE
   30    CONTINUE



         NAC=GVFISM(LOGA,WIFPAR(68))
         IF (WIFPAR(79).EQ.0) THEN
            SPCACC=GVFMPI(4.0*(VDWRAD(IAT)**2)*
     +       FLOAT(NAC)/FLOAT(WIFPAR(68)))
         ELSE
            SPCACC=GVFMPI(4.0*((VDWRAD(IAT)+WATRAD)**2)*
     +       FLOAT(NAC)/FLOAT(WIFPAR(68)))
         END IF



         FE1=FE1+VALACC(PINIAA(IAT))
         FE2=FE2+SPCACC
         FE3=FE3+ACCESS(IAT)
   35 CONTINUE
      VALUE=(FE1-FE2+FE3)/(FE1+0.00001)





      RETURN
      END
      LOGICAL FUNCTION ACC016 (IAT)

















      IMPLICIT      NONE
      INTEGER       IAT
      CHARACTER*1   FIRSTCHARAT







      ACC016=FIRSTCHARAT(IAT).EQ.'N' .OR. FIRSTCHARAT(IAT).EQ.'O'





      RETURN
      END   
      SUBROUTINE ACC017 (IERR)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IERR, JAA







      IERR=0
      CALL GVSBTF (ACCDON,MAXAA)
      CALL ENVINI
      CALL WIF080



      CALL GVSTT6 ('?M1884')



      IF (WIFPAR(1503).EQ.0) THEN
         CALL ENVNOWAT
         DO 5 IAA=1,NUMAAF
            CALL WIF041 (IAA)
            IF (.NOT.ACCDON(IAA)) THEN
               CALL SHOWTEXT ('?NEWE25')
               GOTO 5
            END IF
    5    CONTINUE



      ELSE
         IF (MODNMB(1).NE.0) THEN
            CALL GVSTTB ('?M1939')
            GOTO 998
         END IF
         DO 7 IAA=1,NUMAAF
            IF (RESTYP(IAA).NE.2) GOTO 7
            IF (ACCDON(IAA)) GOTO 7
            CALL ENVMOD (IAA)
            DO 6 JAA=1,NUMAAF
               IF (.NOT.ACCDON(JAA).AND.MODNMB(JAA).EQ.MODNMB(IAA)) THEN
                  CALL WIF041 (JAA)
                  IF (.NOT.ACCDON(JAA)) THEN
                     CALL SHOWTEXT ('?NEWE25')
                     GOTO 7
                  END IF
               END IF
    6       CONTINUE
    7    CONTINUE
      END IF



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE ACC018

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IERR, ICNT, ACNT







      ICNT=0
      ACNT=0



      CALL WIFWTF (' ',IERR)
      IF (IERR.NE.0) GOTO 998



      DO 10 IAA=1,NUMAAT
         IF (WRK1TF(IAA)) THEN
            IF (ACCDON(IAA)) THEN
               PRPVAL(IAA)=SUMACC(IAA)
               ACNT=ACNT+1
            ELSE
               ICNT=ICNT+1
            END IF
         END IF
   10 CONTINUE



      IF (WIFPAR(1105).EQ.0) THEN
         CALL GVSTTI ('?M2061',ACNT)
         CALL GVSTTI ('?M2062',ICNT)
      END IF



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE WIF039























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'IRIGRA.INC'
      INTEGER       IAA, INEW, IOLD, GVFFBT, IERR, IFT1







      IF (WIFPAR(126).EQ.0) CALL WIF080




      IF (WIFPAR(126).EQ.0) THEN

      END IF




      IF (WIFPAR(126).EQ.0) THEN





      END IF







      IOLD=0
      INEW=0
      DO 20 IAA=1,NUMAAT
         IF (.NOT.WRK1TF(IAA)) GOTO 20
         IF (ACCDON(IAA)) THEN
            IOLD=IOLD+1
         ELSE
            INEW=INEW+1
            ACCDON(IAA)=.FALSE.
            CALL WIF041 (IAA)
            ACCDON(IAA)=.TRUE.
         END IF
   20 CONTINUE



      IF (WIFPAR(126).EQ.0.AND.WIFPAR(1105).EQ.0) THEN
         CALL GVSTTI ('?M0041',IOLD)
         CALL GVSTTI ('?M0042',INEW)
      END IF
      IF (WIFPAR(1105).NE.0) CALL GVSNL6 (1)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE WIF041X

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, ISOUP
      LOGICAL       WIFISW 







      CALL ENVNOWAT



      DO 30 ISOUP=1,NUMSOU
         IF (.NOT.WIFISW(ISOUP)) THEN
            DO 20 IAA=SOUADM(1,ISOUP),SOUADM(2,ISOUP)
               CALL WIF041 (IAA)
 20         CONTINUE
         END IF
 30   CONTINUE





      RETURN
      END   
      SUBROUTINE WIF041 (IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT
      REAL          ADDRAD







      ADDRAD=FLOAT(WIFPAR(29))/100.0
      IF (IAA.LE.0) THEN
         CALL GVSTTB ('?M2345')
         GOTO 998
      END IF
      IF (WIFPAR(68).LE.0) CALL WIF083
      CALL WIF041I (IAA,ADDRAD,.FALSE.,.FALSE.)
      ACCDON(IAA)=.TRUE.
      DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
         IF (PROTON(IAT)) ACCESS(IAT)=0.0
 10   CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE WIF041A (IAA)

















      IMPLICIT      NONE
      INTEGER       IAA







      CALL WIF041I (IAA,0.0,.TRUE.,.FALSE.)





      RETURN
      END
      SUBROUTINE WIF041B (IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      REAL          ADDRAD
      INTEGER       IAA







      ADDRAD=FLOAT(WIFPAR(29))/100.0
      CALL WIF041I (IAA,ADDRAD,.TRUE.,.FALSE.)





      RETURN
      END
      SUBROUTINE WIF041C (IAA)

















      IMPLICIT      NONE
      INTEGER       IAA







      CALL WIFPUSHPPP (133,1)
      CALL WIF041I (IAA,0.0,.TRUE.,.FALSE.)
      CALL WIFPOPPPP (133)





      RETURN
      END
      SUBROUTINE WIF041I (IAA,ADDRAD,DOVECT,DOOUT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INTEGER       MX2
      PARAMETER     (MX2=2000)
      INTEGER       IAA, IAT, NAC, JAT, K, IDOT, CONIAT(MX2),
     +              CONSYM(MX2), IERR, IADD, IS
      REAL          DXL, DYL, DZL, PX, D12, WR2, ADDRAD,
     +              PP(4,MX2), VWR, VWR2, R2VWR, MIND12, GVFMPI, TMP(3),
     +              CONDST(MX2)
      INTEGER       JATPRV, IAP, ONE, GVFISM, ICON, ISYM, NUM
      LOGICAL       DOVECT, DOOUT, WIFIRA, WIFIRN, WIFIRZ,
     +              WIFITW







      IF (IAA.LE.0) THEN
         CALL GVSTT6 ('?M2029')
         CALL WIFDUMPSTK ('WIF041I')
         CALL WIFDUMPPPP (' ')
         CALL GVSKIL
         GOTO 998
      END IF




      CALL WIF083
      CALL WIFPUSHPPP (11,1)



      SUMACC(IAA)=0.0
      WR2=2.0*ADDRAD



      IF (WIFIRA(IAA)) THEN
         IADD=3
      ELSE IF (WIFIRN(IAA)) THEN
         IADD=10
      ELSE IF (WIFIRZ(IAA)) THEN
         IADD=-1
      ELSE
         IADD=0
      END IF



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



         IF (PROTON(IAT).OR.(.NOT.ISATOK(IAT))) THEN
            ACCESS(IAT)=0.0
            GOTO 60
         END IF



         IF (WIFPAR(133).GE.1) THEN
            IF (IAT.LE.PNTAAS(IAA)+IADD) GOTO 60
         END IF



         VWR=VDWRAD(IAT)+ADDRAD
         VWR2=VWR**2
         R2VWR=1.0/(2.0*VWR)



         CALL FCONATI (IAT,WR2,CONIAT,CONSYM,CONDST,NUM,MX2)
         ATTVAL(IAT)=FLOAT(NUM)
         IS=PNTAAS(SOUADM(1,CHAINN(2,ATIAA(IAT))))



         IF (NUM.EQ.0) THEN
            CALL GVSITC (LOGA,1,WIFPAR(68))
            GOTO 11
         END IF
         MIND12=100.0
         ONE=0



         DO 55 ICON=1,NUM



            JAT=CONIAT(ICON)



            IF (WIFITW(JAT).OR.PROTON(JAT).OR.(.NOT.ISATOK(JAT)))GOTO 55
            IF (MODNMB(IAA).NE.MODNMB(ATIAA(JAT)))CALL DIF016(6,IAT,JAT)



            ISYM=CONSYM(ICON)
            TMP(1)=XCOORD(JAT)
            TMP(2)=YCOORD(JAT)
            TMP(3)=ZCOORD(JAT)
            IF (ISYM.NE.1) 
     +       CALL GVSMPV (TMP,SYMMAT(1,1,ISYM),SYMVEC(1,ISYM))
            DXL=TMP(1)-XCOORD(IAT)
            DYL=TMP(2)-YCOORD(IAT)
            DZL=TMP(3)-ZCOORD(IAT)
            D12=DXL**2+DYL**2+DZL**2



            PP(1,ICON)=DXL
            PP(2,ICON)=DYL
            PP(3,ICON)=DZL
            PP(4,ICON)=(VWR2-(VDWRAD(JAT)+ADDRAD)**2+D12)*R2VWR



            IF (D12.LT.MIND12) THEN
               ONE=ICON
               MIND12=D12
            END IF
 55      CONTINUE



         IF (ONE.GT.1) THEN
            PX=PP(1,ONE)
            PP(1,ONE)=PP(1,1)
            PP(1,1)=PX
            PX=PP(2,ONE)
            PP(2,ONE)=PP(2,1)
            PP(2,1)=PX
            PX=PP(3,ONE)
            PP(3,ONE)=PP(3,1)
            PP(3,1)=PX
            PX=PP(4,ONE)
            PP(4,ONE)=PP(4,1)
            PP(4,1)=PX
         END IF



         JATPRV=1
         DO 10 K=1,WIFPAR(68)



            IF (PP(1,JATPRV)*XUACC(K)+PP(2,JATPRV)*YUACC(K)+
     +          PP(3,JATPRV)*ZUACC(K).GT.PP(4,JATPRV)) THEN
               LOGA(K)=0
               GOTO 10
            END IF



            DO 5 IAP=1,NUM
               IF (PP(1,IAP)*XUACC(K)+PP(2,IAP)*YUACC(K)+
     +             PP(3,IAP)*ZUACC(K).GT.PP(4,IAP)) THEN
                  LOGA(K)=0
                  JATPRV=IAP
                  GOTO 10
               END IF
 5          CONTINUE
            LOGA(K)=1
 10      CONTINUE



 11      CONTINUE
         NAC=GVFISM(LOGA,WIFPAR(68))
         IF (WIFPAR(79).EQ.0) THEN
            ACCESS(IAT)=GVFMPI(4.0*(VDWRAD(IAT)**2)*FLOAT(NAC)/
     +       FLOAT(WIFPAR(68)))
         ELSE
            ACCESS(IAT)=GVFMPI(4.0*((VDWRAD(IAT)+ADDRAD)**2)*
     +       FLOAT(NAC)/FLOAT(WIFPAR(68)))
         END IF
         SUMACC(IAA)=SUMACC(IAA)+ACCESS(IAT)

 60   CONTINUE
      CALL WIFPOPPPP (11)



 998  CONTINUE


      RETURN
      END
      SUBROUTINE WIF080



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'







      CALL ENVINI
      CALL GVSBTF (ACCDON,MAXAA)
      CALL GVSRT0 (SUMACC,MAXAA)
      CALL GVSRT0 (ACCESS,MAXAT)





      RETURN
      END
      SUBROUTINE WIF083





















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       NKO, IQA, IQB, IQC, JJ, K, I, J, KMIN
      REAL          XB, YB, PH, CT, ST, MINDST, DST, TMP,
     +              GVFCOS, GVFSIN, GVFMPI, GVFSQR













      IF (WIFPAR(6).EQ.WIFPAR(445)) GOTO 998
      WIFPAR(445)=WIFPAR(6)
      NKO=10+WIFPAR(6)
      IQA=0
      IQB=1
      DO 10 I=1,NKO
         IQC=IQA+IQB
         IQA=IQB
         IQB=IQC
   10 CONTINUE
      WIFPAR(68)=IQB



      JJ=0
      DO 20 K=1,IQB
         XB=FLOAT(K)/FLOAT(IQB)
         JJ=JJ+IQA
         IF (JJ.GT.IQB) JJ=JJ-IQB
         YB=FLOAT(JJ)/FLOAT(IQB)
         PH=GVFMPI(2.0*YB)
         CT=1.0-2.0*XB
         ST=GVFSQR(1.0-CT*CT)
         XUACC(K)=ST*GVFCOS(PH)
         YUACC(K)=ST*GVFSIN(PH)
         ZUACC(K)=CT
   20 CONTINUE



      DO 30 K=3,IQB
         MINDST=(XUACC(K)-XUACC(K-1))**2+(YUACC(K)-YUACC(K-1))**2+
     +          (ZUACC(K)-ZUACC(K-1))**2+(XUACC(K)-XUACC(K-2))**2+
     +          (YUACC(K)-YUACC(K-2))**2+(ZUACC(K)-ZUACC(K-2))**2
         KMIN=K
         DO 35 J=K+1,MIN(IQB,K+80)
            DST=(XUACC(J)-XUACC(K-1))**2+(YUACC(J)-YUACC(K-1))**2+
     +           (ZUACC(J)-ZUACC(K-1))**2+(XUACC(J)-XUACC(K-2))**2+
     +           (YUACC(J)-YUACC(K-2))**2+(ZUACC(J)-ZUACC(K-2))**2
            IF (DST.LT.MINDST) THEN
               MINDST=DST
               KMIN=J
            END IF
 35      CONTINUE
         IF (KMIN.GT.K) THEN
            TMP=XUACC(K)
            XUACC(K)=XUACC(KMIN)
            XUACC(KMIN)=TMP
            TMP=YUACC(K)
            YUACC(K)=YUACC(KMIN)
            YUACC(KMIN)=TMP
            TMP=ZUACC(K)
            ZUACC(K)=ZUACC(KMIN)
            ZUACC(KMIN)=TMP
         END IF
 30   CONTINUE



  998 CONTINUE

      
      RETURN
      END
      INTEGER FUNCTION WIF148(NUMDOT)

















      IMPLICIT      NONE
      INTEGER       GVFFIP, NUMDOT, IQBROW(5)
      LOGICAL       GVFIBN
      SAVE          IQBROW
      DATA IQBROW   /89,144,233,377,610/







      WIF148=0



      IF (.NOT.GVFIBN(NUMDOT,89,610)) THEN
         CALL GVSTTB ('?ACCB07')
         GOTO 998
      END IF



      WIF148=GVFFIP(IQBROW,NUMDOT,5)-1



      IF (WIF148.EQ.-1) THEN
         CALL GVSTTB ('?ACCB06')
         WIF148=0
      END IF



  998 CONTINUE


      RETURN
      END
