



      SUBROUTINE PDB000 (DONE)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'OPTION.INC'
      INTEGER       IFT1, IFT2, IAA
      REAL          Q
      LOGICAL       DONE







      IF (OPTIN.EQ.MEN6COD(33)) THEN
         WIFPAR(279)=2
         WIFPAR(1)=1
         GOTO 998
      END IF



      CALL MEN054 (OPTIN,DONE)



      IF (OPTIN(1:5).EQ.'PAUL '.OR.OPTIN(1:5).EQ.'COOT ') THEN
         CALL WIFPUSHPPP (435,1)
         CALL PDBCHECK (.FALSE.)
         CALL WIFPOPPPP (435)
         DONE=.TRUE.
      END IF
      IF (OPTIN.EQ.'HIDE01') THEN
         CALL WIFGRN (IFT1,IFT2,' ')
         IF (IFT1.NE.0) THEN
            DO 20 IAA=IFT1,IFT2
               CALL DGM004C (IAA,RESTYP(IAA),Q)
   20       CONTINUE
         END IF
         DONE=.TRUE.
      ELSE IF (OPTIN.EQ.'HIDE02') THEN
         CALL PDBC02
         DONE=.TRUE.
      ELSE IF (OPTIN.EQ.'HIDE02') THEN
         CALL PLN012
         DONE=.TRUE.
      ELSE IF (OPTIN.EQ.'HIDE04') THEN
         WIFPAR(562)=0
         CALL WIFGRN (IFT1,IFT2,' ')
         IF (IFT1.GT.0) CALL QUA028 (IFT1,IFT2)
         DONE=.TRUE.
      ELSE IF (OPTIN.EQ.'HIDE05') THEN
         CALL ALT005 (.TRUE.)
         DONE=.TRUE.
      ELSE IF (OPTIN.EQ.'SC1015') THEN
         CALL SC1015
         DONE=.TRUE.
      END IF



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBSCO (SCO,WHICH)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'RESULT.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IAT, IAA
      REAL          SCO(25)
      LOGICAL       WIFIRA, WIFIRN, WIFIRW
      CHARACTER*3   WHICH








      CALL WIFPUSHPPP (279,1)
      CALL WIFPUSHPPP (318,1)
      CALL GVSRT0 (SCO,25)





         IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'QUA') THEN
            CALL WIFPUSHPPP (590,0)
            CALL QUA028 (1,NUMAAF)
            CALL WIFPOPPPP (590)
            SCO(1)=GENRVL(1)
         END IF
         CALL MOL200




      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'RAM') THEN
         CALL SC6002
         SCO(2)=GENRVL(29)
         CALL MOL200
      END IF



      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'C12') THEN
         CALL SC6004
         SCO(4)=GENRVL(31)
         CALL MOL200
      END IF



      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'HND') THEN
         CALL SC5008
         SCO(5)=-GENRVL(35)
         CALL MOL200
      END IF



      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'BND') THEN
         CALL BND003
         SCO(6)=GENRVL(8)
         CALL MOL200
      END IF



      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'BBC') THEN
         CALL SC6007
         SCO(7)=GENRVL(34)
         CALL MOL200
      END IF



      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'WAT') THEN
         CALL SC9004
         SCO(8)=-FLOAT(WIFPAR(442))
         CALL MOL200
      END IF



      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'ANG') THEN
         CALL SC5002
         SCO(9)=GENRVL(20)
         CALL MOL200
      END IF




         IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'NQU') THEN
            CALL WIFPUSHPPP (590,0)
            DO 10 IAT=1,NUMATF
               IF (PROTON(IAT)) ISATOK(IAT)=.FALSE.
 10         CONTINUE
            CALL NQA017 (1,NUMAAF)
            DO 20 IAT=1,NUMATF
               IF (PROTON(IAT)) ISATOK(IAT)=.TRUE.
 20         CONTINUE
            CALL WIFPOPPPP (590)
            SCO(10)=GENRVL(44)
            CALL MOL200
         END IF




      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'HEN') THEN
         CALL MOL200
         CALL HBO010
         CALL HB2INI
         CALL HB2RED
         CALL SC9009
         SCO(11)=-FLOAT(WIFPAR(443))
         HB2IDN=.FALSE.
         SCO(12)=TOTVAL/FLOAT(NUMAAF)
         CALL MOL200
      END IF



      IF (WHICH.EQ.'BUR'.OR.WHICH.EQ.'BOR') THEN
         CALL MOL200
         CALL HBO010
         CALL HB2INI
         CALL HB2RED
      END IF
      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'BUR'.OR.WHICH.EQ.'BOR') THEN
         IF (WHICH.EQ.'BOR') THEN
            CALL SC9007A
         ELSE
            PRINT*,'******* CALL SC9007 *******'
            CALL SC9007
         END IF
         IF (GENIVL(14).LE.0) THEN
            SCO(3)=0.0
         ELSE
            SCO(3)=100.0-100.0*FLOAT(GENIVL(11))/FLOAT(GENIVL(14))
         END IF
         CALL MOL200
      END IF



      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'OME') THEN
         CALL SC6003
         SCO(13)=ABS(GENRVL(30))
         CALL MOL200
      END IF



      IF (WHICH.EQ.'ALL'.OR.WHICH.EQ.'BMP') THEN
         CALL MOL200
         CALL SC7002
         SCO(14)=GENRVL(47)
      END IF



      DO 30 IAA=1,NUMAAT
         IF (WIFIRA(IAA)) THEN
            SCO(15)=SCO(15)+1.0
         ELSE IF (WIFIRN(IAA)) THEN
            SCO(16)=SCO(16)+1.0
         ELSE IF (WIFIRW(IAA)) THEN
            SCO(17)=SCO(17)+FLOAT(PNTAAE(IAA)-PNTAAS(IAA)+1)
         ELSE
            SCO(18)=SCO(18)+FLOAT(PNTAAE(IAA)-PNTAAS(IAA)+1)
         END IF
 30   CONTINUE



      CALL WIFPOPPPP (318)
      CALL WIFPOPPPP (279)


      RETURN
      END   
      SUBROUTINE PDBSYM

















      IMPLICIT      NONE







      CALL MOL100
      CALL RESETP



      CALL KLONKCLEAN
      CALL MOL001





      RETURN
      END
      SUBROUTINE PDBCLN

















      IMPLICIT      NONE







      CALL GVSDEL ('check.db')
      CALL GVSDEL ('PDBFILE.PDB')
      CALL GVSDEL ('PDBFILE')
      CALL GVSDEL ('eps*.eps')
      CALL GVSDEL ('sct*.eps')
      CALL GVSDEL ('SCATTER.*')
      CALL GVSDEL ('DSSPOUT')
      CALL GVSDEL ('ALTERR.LOG')
      CALL GVSDEL ('MOVED_H2O.pdb')
      CALL GVSDEL ('PRODRUG.*')
      CALL GVSDEL ('DAVADRUG.*')





      RETURN
      END   
      SUBROUTINE PDBWHICH

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'PDBINC.INC'
      LOGICAL       GVFISF, GVFFOP
      INTEGER       GVFPOS, L







      CALL GVSCLF (11)
      CALL GVSCTB (LINE,80)
      L=0
      CALL GVSCTB (TODOSTR,160)



      IF (GVFISF('TODO.CHK')) THEN
         CALL GVSSTX (LINE,'TODO.CHK')
      ELSE
         CALL GVSCCC (LINE,WHERIS,'TODO.CHK')
      END IF



      IF (.NOT.GVFISF(LINE)) THEN
         CALL GVSTTB ('?M0198')
         CHKALL=.TRUE.
         GOTO 998
      END IF



      CALL GVSOPF (LINE,11,'OLD')
      CALL GVSBOX (LINE)
      IF (.NOT.GVFFOP(11)) THEN
         CALL GVSTTB ('?M0199')
         GOTO 998
      END IF



 10   CONTINUE
         CALL GVSFMT ('?FMT027A')
         READ (11,FMT,END=998) LINE
         IF (GVFPOS(LINE,' YES ').NE.0) THEN
            IF (LEN(TODOSTR).LT.L+3) THEN
               CALL GVSTTE ('?R00299')
            ELSE
               CALL GVSSTX (TODOSTR(L+1:L+3),LINE(1:3))
               L=L+4
            END IF
         END IF
      GOTO 10



  998 CONTINUE

         
      RETURN
      END
      LOGICAL FUNCTION CHKTODO(ID)



















      IMPLICIT      NONE
      INCLUDE       'PDBINC.INC'
      CHARACTER*3   ID







      IF (CHKALL) THEN
         IF (ID.EQ.'ZZZ') THEN
            CHKTODO=.FALSE.
         ELSE
            CHKTODO=.TRUE.
         END IF
      ELSE
         IF (INDEX(TODOSTR,ID).NE.0) THEN
            CHKTODO=.TRUE.
         ELSE
            CHKTODO=.FALSE.
         END IF
      END IF





      RETURN
      END
      SUBROUTINE PDBCCAT

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, ICAA, ICCA
      REAL          CCA
      LOGICAL       WIFIRA, WIFIRC







      CCA=100.0
      ICAA=0
      ICCA=0



      DO 10 IAA=1,NUMAAF
         IF (WIFIRA(IAA)) THEN
            ICAA=ICAA+1
            IF (WIFIRC(IAA)) ICCA=ICCA+1
         END IF
 10   CONTINUE



      CALL CDB013 ('M2783D',' ','M2784D')



      DO 20 IAA=1,NUMAAF
         IF (WIFIRA(IAA)) THEN
            IF (WIFIRC(IAA)) THEN
               CALL PDBC92 (IAA,0)
            END IF
         END IF
 20   CONTINUE



      CALL CDB012



      CCA=100.0*FLOAT(ICCA)/FLOAT(ICAA)





      RETURN
      END   
      SUBROUTINE PDBCHECK (QUICK)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'PDBINC.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IAMB, IAA, IERR, IAT, LOCIAT, ISOUP
      LOGICAL       SKIPIT, QUICK, CHKTODO, WIFROK, WIFISW, HB2FNK, 
     +              MEMORY(MAXTAT), WATDONE, GVFYON, HASPROTEIN,
     +              INTERRUPTED, HASPROTON, GVFFOP, GVFISF
      EXTERNAL      PDBC52, PDBC53, PDBC55, PDBC57, PDBC59







      IF (NUMAAT.GT.0.AND.WIFPAR(1105).EQ.0) THEN
         IF (.NOT.GVFYON('?ERASOU',' ')) GOTO 998
      END IF



      IF (PDBUNT.GE.1) THEN
         IF (GVFFOP(PDBUNT)) CALL GVSCLF (PDBUNT)
      END IF
      IF (GVFISF('pdbout.txt')) THEN
         CALL GVSDEL ('pdbout.txt')

      END IF
      IF (TEXUNT.GE.1) THEN
         IF (GVFFOP(TEXUNT)) CALL GVSCLF (TEXUNT)
      END IF
      IF (GVFISF('pdbout.tex')) THEN
         CALL GVSDEL ('pdbout.tex')

      END IF
      CALL PDBOUT_OPEN (IERR)
      IF (IERR.NE.0) GOTO 998



      CALL PDBCLN
      IF (WIFPAR(279).LE.0) WIFPAR(279)=2
      WIFPAR(1)=1
      CALL MOL100
      WIFPAR(436)=2
      WIFPAR(622)=0
      USEALT=.TRUE.
      SKIPIT=.FALSE.
      FULTRG=.FALSE.
      CALL GVSRT0 (FIXRES,MAXAA)
      CALL GVSRT0 (FIXLST,100)



      CALL GVSCCC (LINE,WHERIS,'supertab.sty')
      CALL GVSCOP (LINE,LINE2)



      WIFPAR(942)=0



      WIFPAR(1071)=1



      WIFPAR(847)=MAXAA



      WIFPAR(1505)=1



      WIFPAR(710)=1



      WIFPAR(368)=1000



      WIFPAR(1052)=1



      CHKALL=.NOT.QUICK
      IF (QUICK) CALL PDBWHICH



      CALL KLONKCLEAN
      CALL MOL001
      IF (WIFPAR(84).GE.1) THEN
         IF (.NOT.HASPROTON()) THEN
            CALL GVSTTE('Validating with protons requires them present')
            GOTO 998
         END IF
      END IF




      IF (NUMAAF.LE.0) THEN
         CALL CDB001 ('NEW')
         CALL CDBEND
         GOTO 998
      END IF



      CALL MOL199 (1,NUMAAF)
      CALL TEXSTORE (FILNMS(62))




      CALL SECTSY
      CALL SC1002




      IF (INTERRUPTED()) GOTO 998
      CALL SC1001 (IERR)
      IF (IERR.NE.0) GOTO 20



      IF (INTERRUPTED()) GOTO 998
      CALL SC2001



      IF (INTERRUPTED()) GOTO 998
      CALL SC3001



      IF (INTERRUPTED()) GOTO 998
      CALL SC4001



      WIFPAR(1504)=WIFPAR(1504)+1



      IF (INTERRUPTED()) GOTO 998
      CALL SC5001



      IF (INTERRUPTED()) GOTO 998
      CALL SC6001



      IF (INTERRUPTED()) GOTO 998
      CALL SC7001



      IF (INTERRUPTED()) GOTO 998
      CALL SC8001



      IF (CHKTODO('H2O')) CALL SC9001



      IF (CHKTODO('SCO')) CALL SCOLST



      IF (CHKTODO('BVA')) CALL BVALST



      IF (CHKTODO('ACL')) CALL ACCLST



      IF (CHKTODO('LST')) CALL PDBLST



      IF (WIFPAR(435).NE.0) THEN
         CALL COOAXA
         CALL COOBMP
      END IF



      CALL CDBEND
      IF (SKIPIT) GOTO 20
      IF (INTERRUPTED()) GOTO 998



      CALL TEXSECT ('?CHKM07')
      IF (HASPROTEIN()) THEN
         CALL PDBMES ('PDBSUM')
         IF (WIFPAR(941).GT.0) THEN
            CALL PDBMES ('PDBXSUM')
         ELSE
            WIFPAR(942)=-999999
         END IF
      ELSE
         CALL PDBMES ('PDBNPSUM')
      END IF
















      CALL PDBSUG



   20 CONTINUE
      IF (WIFPAR(1105).GE.1) THEN

            CALL TEXCLOSE
            CALL GVSCTB (BIGLIN,132)
            CALL GVSCCC (BIGLIN,WHERIS,'pdbout2html')
            CALL GVSTT6 (BIGLIN)
            CALL SYSTEM (BIGLIN)

      END IF




      IF (INTERRUPTED()) GOTO 998
      IF (WIFPAR(253).GT.2) THEN
         DO 60 IAA=1,NUMAAF
            IF (WIFROK(IAA)) GOTO 60
            CALL GVSBTF (MEMORY,MAXTAT)
            DO 40 IAT=PNTAAS(IAA),PNTAAE(IAA)
               LOCIAT=IAT-PNTAAS(IAA)+1
               MEMORY(LOCIAT)=ISATOK(IAT)
   40       CONTINUE
            CALL WIFPUSHPPP (40,1)
            IF (RESTYP(IAA).GT.20) THEN
               CALL DIF008 ('Correct non-canonical:',IAA)
               CALL WIF330 (IAA,RESTYP)
            ELSE
               CALL WIF330A (IAA,RESTYP(IAA))
            END IF
            CALL WIFPOPPPP (40)
            DO 50 IAT=PNTAAS(IAA),PNTAAE(IAA)
               LOCIAT=IAT-PNTAAS(IAA)+1
               ISATOK(IAT)=MEMORY(LOCIAT)
               IF (.NOT.ISATOK(IAT)) XBFACT(IAT)=100.0
   50       CONTINUE
   60    CONTINUE
      END IF



      IF (WIFPAR(253).GT.3) THEN
         DO 70 ISOUP=1,NUMSOU
            IF (WIFISW(ISOUP)) THEN
               WATDONE=.TRUE.
               CALL ENVNOWAT
               CALL WIF225 (ISOUP,.TRUE.)
            END IF
 70      CONTINUE
         CALL GVSRT0 (ATTVAL,NUMATF)
         CALL PDBC09
      END IF



  998 CONTINUE
      CALL INIALL








      RETURN
      END
      SUBROUTINE SECTSY

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      LOGICAL       CHKTODO







      CALL SYMAGR



      CALL SYMINI



      IF (SYMALT) WIFPAR(942)=WIFPAR(942)+1
      IF (SYMALT) CALL SYMAMB



      IF (WIFPAR(1102).EQ.0) THEN
         IF (CHKTODO('NCS').AND.SYMHAS) CALL CELNEW
      END IF



      IF (WIFPAR(1102).EQ.0) THEN
         IF (SYMHAS.AND.CHKTODO('MVM')) CALL CHKMVM
      END IF



      IF (CHKTODO('AXA').AND.SYMHAS) THEN
         CALL WIFPUSHPPP (590,1)
         CALL SC1012
         CALL SC1012A
         CALL WIFPOPPPP (590)
      END IF





      RETURN
      END   
      SUBROUTINE PDBC01

















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







      CALL GVSBTF (ACCDON,NUMAAT)
      CALL GVSRT0 (SUMACC,NUMAAT)
      CALL GVSBTF (ACCDON,NUMAAT)
      CALL GVSRT0 (SUMACC,NUMAAT)
      CALL GVSIT0 (USESOU,MAXMOL)



      CALL GVSTT6 ('?CHKM25')
      CALL TEXSECT ('?CHKM25')
      CALL PDBTAB ('rl@{ (}r@{) }rrrrr')



      CALL MOL311



      CALL GVSBOX ('?CHKM10')



      CALL ENVNOWAT



      DO 40 IAA=1,NUMAAF
         CALL WIF041 (IAA)
   40 CONTINUE



      CALL ACC007 (1,NUMAAF,IERR)
      IF (IERR.EQ.0) CALL ACC008 (1,NUMAAF,IERR)
      IF (IERR.EQ.0) CALL ACC009 (1,NUMAAF,IERR)



      CALL PDBTND (IERR)
      IF (IERR.EQ.0) THEN
         CALL PDBMES ('ACCNOK')
      ELSE
         CALL PDBMES ('ACCOK')
      END IF



      CALL MOL312





      RETURN
      END
      SUBROUTINE PDBC02

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       IAA, IAATYP, IUNIT, I, J, IHS, IERR
      REAL          WIFANG, TAU, CNT(2,3,20), Z
      LOGICAL       GRTFILE, GVFIBN







      IUNIT=0
      CALL GVSCCC (LINE,WHERIS,'TAU.VAL')
      IF (.NOT.GRTFILE(IUNIT,LINE)) GOTO 999



      DO 10 IAATYP=1,20
         READ (IUNIT,'(6F8.3)',ERR=999) ((CNT(I,J,IAATYP),I=1,2),J=1,3)
 10   CONTINUE
      CALL GVSCLF (IUNIT)



      CALL DSP001 (.FALSE.)
      CALL GHS021 (0,0,IERR)
      IF (IERR.NE.0) GOTO 999



      DO 20 IAA=2,NUMAAF-1
         IF (.NOT.GVFIBN(RESTYP(IAA),1,20)) GOTO 20
         IF (.NOT.ISATOK(PNTAAS(IAA))) GOTO 20
         IF (.NOT.ISATOK(PNTAAC(IAA))) GOTO 20
         IF (.NOT.ISATOK(PNTAAC(IAA)+1)) GOTO 20
         TAU=WIFANG(PNTAAS(IAA),PNTAAC(IAA),PNTAAC(IAA)+1)
         IF (LOCHST(IAA).EQ.'H') THEN
            IHS=1
         ELSE IF (LOCHST(IAA).EQ.'S') THEN
            IHS=2
         ELSE
            IHS=3
         END IF
         Z=(TAU-CNT(1,IHS,RESTYP(IAA)))/CNT(2,IHS,RESTYP(IAA))
         CALL GHS022 (0,Z,IERR)
         IF (IERR.NE.0) GOTO 999
 20   CONTINUE



      CALL GHS028 ('Z-score distribution',0,0,IERR)
      IF (IERR.NE.0) GOTO 999
      CALL GHS024 (IERR)
      IF (IERR.EQ.0) GOTO 998



  999 CONTINUE
      CALL GVSEIW ('PDBC02')



  998 CONTINUE
      IF (IUNIT.NE.0) CALL GVSCLF (IUNIT)


      RETURN
      END   
      SUBROUTINE PDBC041AA (IAA,BUMPS)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'CNTINC.INC'
      INTEGER       IAA, JAA, IAT, JAT, ISYM, JSYM, ICONT, 
     +              SYMNEG
      REAL          TMP(3), ERROR, NUCDST, BUMPS
      LOGICAL       ISBUMP, ISHBO, WIFIRW, IS13, IS14







      BUMPS=0.0
      CALL WIFPUSHPPP (590,0)



      CALL ENVTOT



      CALL PDBC04B



      CALL HBO010
      CALL FCONAA (IAA,2.0,.TRUE.)
      DO 95 ICONT=1,NUMCONIAA
         JAA=CONIAA(ICONT)
         IF (JAA.GT.NUMAAT) GOTO 95
         JSYM=CONSYMAA(ICONT)
         ISYM=SYMNEG(JSYM)




         IF (.NOT.WIFIRW(IAA).AND.JSYM.EQ.1.AND.IAA.EQ.JAA) GOTO 95



         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (.NOT.ISATOK(IAT)) GOTO 90
            TMP(1)=XCOORD(IAT)
            TMP(2)=YCOORD(IAT)
            TMP(3)=ZCOORD(IAT)
            IF (ISYM.GT.1) CALL GVSMPV (TMP,SYMMAT(1,1,ISYM),
     +       SYMVEC(1,ISYM))
            DO 85 JAT=PNTAAS(JAA),PNTAAE(JAA)
               IF (.NOT.ISATOK(JAT)) GOTO 85
               IF (JAT.LT.IAT) GOTO 85
               IF (ISYM.EQ.1.AND.JAT.EQ.IAT) GOTO 85



               CALL PDBC04A (IAT,JAT,TMP,ISYM,JSYM,ERROR,NUCDST,ISBUMP,
     +          ISHBO,IS13,IS14)



               IF (ISBUMP) BUMPS=BUMPS+ERROR
   85       CONTINUE
   90    CONTINUE
   95 CONTINUE



      CALL WIFPOPPPP (590)





      RETURN
      END
      SUBROUTINE PDBC04A (IAT,JAT,TMP,ISYM,JSYM,ERROR,NUCDST,ISBUMP,
     + ISHBO,IS13,IS14)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HBONDS.INC'
      INCLUDE       'CRDINC.INC'
      INTEGER       IAA, IAT, JAT, LOCIAT, LOCJAT, LISYM,
     +              ISYM, JSYM, JAA, LIAT, LJAT, ICRD, SYMNEG,
     +              KATARR(6), NKAT, IKAT, XDUM, YDUM
      REAL          ERROR, TMP(3), D12, D12LIM, ELMCHG, W908, NUCDST
      LOGICAL       ISBUMP, AREBOUNDS, AREB13, ISHBO, ISMETAL,
     +              AREB14, IS13, IS14, WIFIRA







      ERROR=0.0
      D12=0.0
      ISBUMP=.FALSE.
      ISHBO=.FALSE.
      IS13=.FALSE.
      IS14=.FALSE.
      IAA=ATIAA(IAT)
      JAA=ATIAA(JAT)



      IF (IAT.LE.0.OR.JAT.LE.0) THEN
         CALL GVSTTI3 ('PDBC04A 1: IAT, JAT, NUMATF',IAT,JAT,NUMATF)
         CALL GVSKIL
         GOTO 998
      END IF
      IF (IAT.GT.NUMATF.OR.JAT.GT.NUMATF) THEN
         CALL GVSTTI3 ('PDBC04A 2: IAT, JAT, NUMATF',IAT,JAT,NUMATF)
         CALL GVSKIL
         GOTO 998
      END IF
      IF (IAA.LE.0.OR.JAA.LE.0) THEN
         CALL GVSTTI4 ('PDBC04A 3: I/JAA, AAF/T',IAA,JAA,NUMAAF,NUMAAT)
         CALL GVSKIL
         GOTO 998
      END IF
      IF (IAA.GT.NUMAAT.OR.JAA.GT.NUMAAT) THEN
         CALL GVSTTI4 ('PDBC04A 4: I/JAA, AAF/T',IAA,JAA,NUMAAF,NUMAAT)
         CALL GVSKIL
         GOTO 998
      END IF         
      IF (IAT.EQ.JAT) THEN
         PRINT*,'BUG in PDBC04A: IAT=JAT=',IAT,ONESAT(IAT)
         GOTO 998
      END IF
      IF ((.NOT.ISATOK(IAT).OR.PROTON(IAT)).OR.(.NOT.ISATOK(JAT).OR.
     + PROTON(JAT))) GOTO 998



      NUCDST=SQRT((TMP(1)-XCOORD(JAT))**2+(TMP(2)-YCOORD(JAT))**2+
     +            (TMP(3)-ZCOORD(JAT))**2)
      D12=NUCDST-VDWRAD(IAT)-VDWRAD(JAT)



      IAA=ATIAA(IAT)
      JAA=ATIAA(JAT)
      IF (WIFPAR(60).GE.1.AND.SOUPNT(IAA).NE.SOUPNT(JAA)) GOTO 998



      W908=FLOAT(WIFPAR(908))/100.0
      IF (D12.GT.(-W908)) GOTO 998



      IF (WEIGHT(IAT)+WEIGHT(JAT).LT.1.001.OR.WEIGHT(IAT).LT.0.33.OR.
     +    WEIGHT(JAT).LT.0.33.OR.AREBOUNDS(IAT,JAT,JSYM)) GOTO 998



      LOCIAT=PINIAA(IAT)
      LOCJAT=PINIAA(JAT)




      IF (IAA.EQ.JAA) W908=MAX(0.60,W908)
      IF (ABS(IAA-JAA).EQ.1) THEN
         IF (LOCIAT.LE.5.AND.LOCJAT.LE.5) THEN
            W908=MAX(0.60,W908)
         ELSE IF (LOCIAT.LE.5.OR.LOCJAT.LE.5) THEN
            W908=MAX(0.50,W908)
         ELSE
            W908=MAX(0.40,W908)
         END IF
      END IF



      IF (DONACC(IAT)*DONACC(JAT).EQ.1)  THEN
         D12LIM=-W908-0.15
         ISHBO=.TRUE.
      ELSE



         D12LIM=-W908
         IF (ELMCHG(IAT).GT.0.0.AND.USABLE(JAT).AND.
     +       DONACC(JAT).NE.1) THEN



            D12LIM=D12LIM-1.3
         ELSE IF (ELMCHG(JAT).GT.0.0.AND.USABLE(IAT).AND.
     +       DONACC(IAT).NE.1) THEN



            D12LIM=D12LIM-1.3
         END IF
      END IF



      IF (D12.GT.D12LIM) GOTO 998




      IF (AREB13(IAT,JAT,JSYM)) THEN
         D12LIM=-1.3
         IS13=.TRUE.
      ELSE IF (JSYM.EQ.1) THEN
         IF (AREB14(IAT,JAT,JSYM,XDUM,YDUM)) THEN



            D12LIM=-0.8
            IS14=.TRUE.
         ELSE IF (CHAINN(2,IAA).EQ.CHAINN(2,JAA).AND.JAA.EQ.IAA+1) THEN



            IF ((RESTYP(JAA).EQ.13.OR.RESTYP(JAA).EQ.21).AND.
     +           LOCIAT.EQ.1.AND.LOCJAT.EQ.7) THEN
               D12LIM=-0.50
            END IF
         ELSE IF (CHAINN(2,IAA).EQ.CHAINN(2,JAA).AND.JAA.EQ.IAA+2) THEN



            IF (WIFIRA(IAA)) THEN
               IF (LOCIAT.EQ.1.AND.LOCJAT.EQ.2) THEN
                  D12LIM=-0.60
               ELSE IF (LOCIAT.EQ.3.AND.LOCJAT.EQ.1) THEN
                  D12LIM=-0.60
               ELSE IF (LOCIAT.EQ.4.AND.LOCJAT.EQ.3) THEN
                  D12LIM=-0.60
               END IF
            END IF
         END IF
      END IF



      IF (D12.GT.D12LIM) GOTO 998



      IF (WIFPAR(908).EQ.1001) THEN
         IF (NUCDST.GT.1.6.AND.(PROTON(IAT).OR.PROTON(JAT))) GOTO 998
         IF (IS13.OR.IS14) GOTO 998
      END IF




      IF (ISMETAL(IAT).OR.ISMETAL(JAT)) THEN
         IF (ISMETAL(IAT)) THEN
            LIAT=IAT
            LJAT=JAT
            LISYM=SYMNEG(ISYM)
         ELSE
            LJAT=IAT
            LIAT=JAT
            LISYM=ISYM
         END IF



         DO 100 ICRD=1,NCRD
            IF (CRD(1,ICRD).EQ.LIAT.AND.CRD(2,ICRD).EQ.LJAT.AND.
     +       CRD(3,ICRD).EQ.LISYM) GOTO 998
  100    CONTINUE



         CALL FBONDA (LJAT,KATARR,6,NKAT)
         DO 200 ICRD=1,NCRD
            IF (CRD(1,ICRD).EQ.LIAT.AND.CRD(3,ICRD).EQ.LISYM) THEN
               DO 190 IKAT=1,NKAT
                  IF (CRD(2,ICRD).EQ.KATARR(IKAT)) GOTO 998
  190          CONTINUE
            END IF
  200    CONTINUE
      END IF



      ERROR=D12LIM-D12
      ISBUMP=.TRUE.



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBC04B



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CRDINC.INC'
      INTEGER       MX2
      PARAMETER     (MX2=200)
      LOGICAL       WIFIRW, ISMETAL
      INTEGER       ICON, IAA, IAT, NUM, JATSYM(MX2), JATARR(MX2),
     +              Z, ELMZ, OLD1504
      REAL          JATDST(MX2)
      SAVE          OLD1504
      DATA OLD1504  /-1/







      IF (WIFPAR(1504).EQ.OLD1504) GOTO 998
      OLD1504=WIFPAR(1504)



      NCRD=0



      DO 100 IAA=NUMAAF+1,NUMAAT



         IF (WIFIRW(IAA)) GOTO 100



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



            IF (.NOT.ISMETAL(IAT)) GOTO 90




            CALL FCONATI (IAT,1.8,JATARR,JATSYM,JATDST,NUM,MX2)



            DO 80 ICON=1,NUM



               IF (JATDST(ICON).GT.VDWRAD(JATARR(ICON))+VDWRAD(IAT)-0.5)
     +              GOTO 80
               Z=ELMZ(JATARR(ICON))
               IF (Z.NE.7.AND.Z.NE.8.AND.Z.NE.16) GOTO 80



               IF (NCRD.GE.MAXCRD) THEN
                  CALL GVSTTE ('?R00280')
                  GOTO 998
               END IF
               NCRD=NCRD+1
               CRD(1,NCRD)=IAT
               CRD(2,NCRD)=JATARR(ICON)
               CRD(3,NCRD)=JATSYM(ICON)
   80       CONTINUE
   90    CONTINUE
  100 CONTINUE



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBC04C (IAT,METAL,ISYM)



















      IMPLICIT      NONE
      INCLUDE       'CRDINC.INC'
      INTEGER       IAT, ICRD, METAL, ISYM





      CALL PDBC04B
      DO 100 ICRD=1,NCRD
         IF (IAT.EQ.CRD(2,ICRD)) THEN
            METAL=CRD(1,ICRD)
            ISYM=CRD(3,ICRD)
            GOTO 998
         END IF
  100 CONTINUE
      METAL=0
      ISYM=1



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBC09

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       MAXPAI, H2OES0, H2OESZ
      PARAMETER     (MAXPAI=2*MAXAT)
      INTEGER       ISOUP, IPAI, H2OPAI(2,MAXPAI), IAT, JAT, ICONT, 
     +              NUMPAI
      LOGICAL       DONE, WIFISW, WIFIRW, HASWATER
      PARAMETER     (H2OES0=20001)
      EQUIVALENCE   (H2OPAI(1,1),ESPACE(H2OES0))
      PARAMETER     (H2OESZ=H2OES0+2*MAXPAI)







      IF (.NOT.HASWATER()) THEN
         CALL PDBMES ('NOWAT')
         GOTO 998
      END IF



      CALL ESPSET (H2OES0,H2OESZ-1,6)
      CALL GVSBTF (USEAT,MAXAT)
      CALL GVSIT0 (H2OPAI,2*MAXPAI)
      CALL GVSRT0 (ATTVAL,MAXAT)
      NUMPAI=0



      CALL WIFPUSHPPP (590,1)



      CALL ENVTOT



      DO 100 ISOUP=1,NUMSOU
         IF (.NOT.WIFISW(ISOUP)) GOTO 100



         DO 90 IAT=PNTAAS(SOUADM(1,ISOUP)),PNTAAE(SOUADM(2,ISOUP))



            CALL FCONAT (IAT,5.0)



            DO 80 ICONT=1,NUMCONIAT
               JAT=CONIAT(ICONT)
               IF (.NOT.WIFIRW(ATIAA(JAT))) THEN
                  USEAT(IAT)=.TRUE.
               ELSE
                  IF (NUMPAI.LT.MAXPAI) THEN
                     NUMPAI=NUMPAI+1
                     H2OPAI(1,NUMPAI)=IAT
                     H2OPAI(2,NUMPAI)=JAT
                  ELSE
                     CALL GVSTTE ('?M0438')
                     GOTO 998
                  END IF
               END IF
   80       CONTINUE
   90    CONTINUE
  100 CONTINUE



      CALL WIFPOPPPP (590)



  110 CONTINUE
      DONE=.FALSE.
      DO 120 IPAI=1,NUMPAI
         IF (USEAT(H2OPAI(1,IPAI))) THEN
            IF (.NOT.USEAT(H2OPAI(2,IPAI))) THEN
               USEAT(H2OPAI(2,IPAI))=.TRUE.
               DONE=.TRUE.
            END IF
         END IF
  120 CONTINUE
      IF (DONE) GOTO 110




      DONE=.FALSE.
      DO 210 ISOUP=1,NUMSOU
         IF (.NOT.WIFISW(ISOUP)) GOTO 210
         DO 200 IAT=PNTAAS(SOUADM(1,ISOUP)),PNTAAE(SOUADM(2,ISOUP))
            IF (USEAT(IAT)) THEN
               ATTVAL(IAT)=0.0
            ELSE
               ATTVAL(IAT)=1.0
               DONE=.TRUE.
               CALL DIF015 (6,'?M3903',IAT)
            END IF
  200    CONTINUE
  210 CONTINUE
      IF (DONE) CALL WAT_KILL_AT



      CALL ESPKIL (H2OES0,H2OESZ-1,6,'PDBC09')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBC16 (ISOUP1,ISOUP2,RMAT,TVEC)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CHIANG.INC'
      INCLUDE       'RESULT.INC'
      INTEGER       ISOUP1, ISOUP2, IAA, JAA, IAT, JAT, ND2, ND1, IERR,
     +              IFT1, IFT2, JFT1, JFT2
      REAL          RMAT(3,3), TVEC(3), SD2, SD1, V, MAXV,
     +              V1I, V2I, V2J, V1J, GVFRTD, V1, V2, TURN, PDBC16A
      LOGICAL       GVFRIN, HASPROTEIN, WIFCOK







      IERR=1
      IFT1=SOUADM(1,ISOUP1)
      IFT2=SOUADM(2,ISOUP1)
      JFT1=SOUADM(1,ISOUP2)
      JFT2=SOUADM(2,ISOUP2)
      IF (IFT2-IFT1.LE.0) GOTO 997
      IF (JFT2-JFT1.LE.0) GOTO 997
      IF (.NOT.GVFRIN(FLOAT(SOUADM(3,ISOUP1))/
     + FLOAT(SOUADM(3,ISOUP2)),0.7,1.3)) GOTO 997
      IERR=0



      CALL SUP025 (IFT1,IFT2,JFT1,JFT2,IERR)



      SD1=0.0
      ND1=0
      MAXV=0
      DO 100 IAA=IFT1,IFT2
         JAA=JFT1-IFT1+IAA
         SD2=0.0
         ND2=0
         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (.NOT.ISATOK(IAT)) GOTO 90
            IF (PROTON(IAT)) GOTO 90
            JAT=IAT-PNTAAS(IAA)+PNTAAS(JAA)
            IF (.NOT.ISATOK(JAT)) GOTO 90
            SD2=SD2+PDBC16A(IAT,JAT,RMAT,TVEC)
            ND2=ND2+1
   90    CONTINUE



         IF (RESTYP(IAA).EQ.5.OR.RESTYP(IAA).EQ.20) THEN
            IF (WIFCOK(IAA).AND.WIFCOK(JAA)) THEN
               TURN=PDBC16A(PNTAAS(IAA)+6,PNTAAS(JAA)+7,RMAT,TVEC)+
     +              PDBC16A(PNTAAS(IAA)+7,PNTAAS(JAA)+6,RMAT,TVEC)+
     +              PDBC16A(PNTAAS(IAA)+8,PNTAAS(JAA)+9,RMAT,TVEC)+
     +              PDBC16A(PNTAAS(IAA)+9,PNTAAS(JAA)+8,RMAT,TVEC)-
     +              PDBC16A(PNTAAS(IAA)+6,PNTAAS(JAA)+6,RMAT,TVEC)-
     +              PDBC16A(PNTAAS(IAA)+7,PNTAAS(JAA)+7,RMAT,TVEC)-
     +              PDBC16A(PNTAAS(IAA)+8,PNTAAS(JAA)+8,RMAT,TVEC)-
     +              PDBC16A(PNTAAS(IAA)+9,PNTAAS(JAA)+9,RMAT,TVEC)
               IF (TURN.LT.0.0) SD2=SD2+TURN
            END IF



         ELSE IF (RESTYP(IAA).EQ.3) THEN
            IF (WIFCOK(IAA).AND.WIFCOK(JAA).AND.
     +           BOUND_TO(1,PNTAAS(IAA)+6).LE.0.AND.
     +           BOUND_TO(1,PNTAAS(JAA)+6).LE.0) THEN
               TURN=PDBC16A(PNTAAS(IAA)+6,PNTAAS(JAA)+7,RMAT,TVEC)+
     +              PDBC16A(PNTAAS(IAA)+7,PNTAAS(JAA)+6,RMAT,TVEC)-
     +              PDBC16A(PNTAAS(IAA)+6,PNTAAS(JAA)+6,RMAT,TVEC)-
     +              PDBC16A(PNTAAS(IAA)+7,PNTAAS(JAA)+7,RMAT,TVEC)
               IF (TURN.LT.0.0) SD2=SD2+TURN
            END IF



         ELSE IF (RESTYP(IAA).EQ.4) THEN
            IF (WIFCOK(IAA).AND.WIFCOK(JAA).AND.
     +           BOUND_TO(1,PNTAAS(IAA)+7).LE.0.AND.
     +           BOUND_TO(1,PNTAAS(JAA)+7).LE.0) THEN
               TURN=PDBC16A(PNTAAS(IAA)+7,PNTAAS(JAA)+8,RMAT,TVEC)+
     +              PDBC16A(PNTAAS(IAA)+8,PNTAAS(JAA)+7,RMAT,TVEC)-
     +              PDBC16A(PNTAAS(IAA)+7,PNTAAS(JAA)+7,RMAT,TVEC)-
     +              PDBC16A(PNTAAS(IAA)+8,PNTAAS(JAA)+8,RMAT,TVEC)
               IF (TURN.LT.0.0) SD2=SD2+TURN
            END IF
         END IF
         IF (ND2.GT.0) THEN
            V=SD2/FLOAT(ND2)
            PRPVAL(IAA)=SQRT(V)
            IF (PRPVAL(IAA).GT.1.0) THEN
               CALL DIF008 ('?R00282',IAA)
            END IF
            ND1=ND1+1
            SD1=SD1+V
            IF (V.GT.MAXV) MAXV=V
         ELSE
            PRPVAL(IAA)=0.0
         END IF
  100 CONTINUE



      GENRVL(37)=SQRT(SD1/FLOAT(ND1))



      SD2=0.0
      ND2=0
      DO 300 IAA=IFT1,IFT2
         JAA=JFT1-IFT1+IAA
         IAT=PNTAAC(IAA)
         IF (.NOT.ISATOK(IAT)) GOTO 300
         JAT=IAT-PNTAAS(IAA)+PNTAAS(JAA)
         IF (.NOT.ISATOK(JAT)) GOTO 300
         SD2=SD2+PDBC16A(IAT,JAT,RMAT,TVEC)
         ND2=ND2+1
  300 CONTINUE
      GENRVL(43)=SQRT(SD2/FLOAT(ND2))



      IF (MAXV.GT.0.3) THEN
         CALL PDBC19 (IFT1,IFT2,CHANAM(IFT1),CHANAM(JFT1))
      ELSE
         FILNMS(72)(1:1)=CHANAM(IFT1)
         FILNMS(72)(2:2)=CHANAM(JFT1)
         CALL PDBMES ('NONCSPLOT')
      END IF



      IF (.NOT.HASPROTEIN()) GOTO 500
      CALL CHI004
      SD1=0.0
      ND1=0
      MAXV=0.0
      DO 200 IAA=IFT1,IFT2
         JAA=JFT1-IFT1+IAA
         V1I=CHIANG(1,IAA)
         V1J=CHIANG(1,JAA)
         IF (V1I.GT.5.OR.V1J.GT.5) THEN
            V1I=0.0
            V1J=0.0
         END IF
         V1=GVFRTD(V1I-V1J)
         IF (V1.GT.180.0) V1=V1-360.0
         IF (V1.LT.-180.0) V1=V1+360.0
         V2I=CHIANG(2,IAA)
         V2J=CHIANG(2,JAA)
         IF (V2I.GT.5.OR.V2J.GT.5) THEN
            V2I=0.0
            V2J=0.0
         END IF
         V2=GVFRTD(V2I-V2J)
         IF (V2.GT.180.0) V2=V2-360.0
         IF (V2.LT.-180.0) V2=V2+360.0
         V=SQRT(V1**2+V2**2)
         IF (V.GT.MAXV) MAXV=V
         SD1=SD1+V
         ND1=ND1+1
         PRPVAL(IAA)=V
  200 CONTINUE



      IF (MAXV.GT.25.0) THEN
         CALL PDBC20 (IFT1,IFT2,CHANAM(IFT1),CHANAM(JFT1))
      ELSE
         FILNMS(72)(1:1)=CHANAM(IFT1)
         FILNMS(72)(2:2)=CHANAM(JFT1)
         CALL PDBMES ('NODPPLOT')
      END IF
  500 CONTINUE



      GOTO 998



  997 CONTINUE
      CALL GVSTTE ('?R00220')



  998 CONTINUE


      RETURN
      END
      REAL FUNCTION PDBC16A (IAT,JAT,RMAT,TVEC)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, JAT
      REAL          TMP(3), RMAT(3,3), TVEC(3)







      TMP(1)=XCOORD(JAT)
      TMP(2)=YCOORD(JAT)
      TMP(3)=ZCOORD(JAT)
      CALL GVSMPV (TMP, RMAT, TVEC)



      PDBC16A=(XCOORD(IAT)-TMP(1))**2+
     +        (YCOORD(IAT)-TMP(2))**2+
     +        (ZCOORD(IAT)-TMP(3))**2





      RETURN
      END
      SUBROUTINE PDBC19 (IFT1,IFT2,OLDCH1,OLDCH2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2
      LOGICAL       WIFIRA
      CHARACTER*1   OLDCH1, OLDCH2







      IF (IFT2-IFT1.LT.2) GOTO 998
      IF (.NOT.WIFIRA(IFT1)) GOTO 998
      IF (.NOT.WIFIRA(IFT2)) GOTO 998




      CALL GRTVIN
      FILNMS(72)(1:1)=OLDCH1
      FILNMS(72)(2:2)=OLDCH2



      CALL SCTPRP (IFT1,IFT2,'Residue RMS (A)',
     +  'LIN 1 DOT 0 SY 0 MARG 0.15')
      CALL PDBMES ('NCSPLOT')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBC20 (IFT1,IFT2,OLDCH1,OLDCH2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2
      LOGICAL       WIFIRA
      CHARACTER*1   OLDCH1, OLDCH2







      IF (IFT2-IFT1.LT.2) GOTO 998
      IF (.NOT.WIFIRA(IFT1)) GOTO 998
      IF (.NOT.WIFIRA(IFT2)) GOTO 998




      CALL GRTVIN
      FILNMS(72)(1:1)=OLDCH1
      FILNMS(72)(2:2)=OLDCH2
      IF (OLDCH1.EQ.OLDCH2) THEN
         CALL GVSTTE ('?R00283')
      END IF



      CALL SCTPRP (IFT1,IFT2,'sqrt(dphi**2+dpsi**2) (degrees)',
     + 'LIN 1 DOT 0 SY 0 MARG 0.15')
      CALL PDBMES ('DPPLOT')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE MOLC41

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'GETMOL.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IAA
      LOGICAL       CH4EQCH4







      UNKDEL=0
      CALL GVSRT0 (PRPVAL,NUMAAT)



      DO 5 IAA=1,NUMAAT
         IF (CH4EQCH4(ONESA3(IAA),'UNK ')) THEN
            UNKDEL=UNKDEL+1
         END IF
 5    CONTINUE
      IF (UNKDEL.LE.0) GOTO 998




      CALL CDB013 ('DELUNK','DELUNKNEU','DELUNKOK')



      DO 10 IAA=1,NUMAAT
         IF (CH4EQCH4(ONESA3(IAA),'UNK ')) THEN
            PRPVAL(IAA)=1.0
            CALL PDBC92 (IAA,0)
         END IF
 10   CONTINUE



      CALL CDB012




      DO 20 IAA=NUMAAT,1,-1
         IF (CH4EQCH4(ONESA3(IAA),'UNK ')) THEN
            CALL GVSTT6 ('?M4593')
            CALL SHOIAA (IAA)
            CALL MOL105 (IAA)
         END IF
 20   CONTINUE



  998 CONTINUE


      RETURN
      END   
      REAL FUNCTION PDBC71(IAT)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAT, NUM
      REAL          GVFRTD, CHI001







      CALL FBONDA (IAT,WIFPAR(396),4,NUM)



      IF (NUM.NE.3) THEN
         PDBC71=-999.99
         GOTO 998
      END IF



      IF (.NOT.(ISATOK(IAT).AND.ISATOK(WIFPAR(396)).AND.
     +     ISATOK(WIFPAR(397)).AND.ISATOK(WIFPAR(398)))) THEN
         PDBC71=-999.99
         GOTO 998
      END IF



      IF (WIFPAR(396).GT.WIFPAR(397)) CALL GVSWIP (WIFPAR(396),
     + WIFPAR(397))
      IF (WIFPAR(397).GT.WIFPAR(398)) CALL GVSWIP (WIFPAR(397),
     + WIFPAR(398))
      IF (WIFPAR(396).GT.WIFPAR(397)) CALL GVSWIP (WIFPAR(396),
     + WIFPAR(397))



      PDBC71=GVFRTD(CHI001(IAT,WIFPAR(396),WIFPAR(397),WIFPAR(398)))



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBC92A (IAA,IAT)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IAT, I, J, GVFPOS
      CHARACTER*28  DIF000
      CHARACTER*23  DIF001







      CALL GVSCTB (LINE92,92)



      IF (IAT.GT.0) THEN
         LINE92=DIF000(IAT)



      ELSE
         LINE92=DIF001(IAA)
      END IF



      I=GVFPOS(LINE92,'(')
      J=GVFPOS(LINE92,')')
      IF (I.NE.8.AND.I.NE.11) THEN
         PRINT*,'C92 PROBLEM. I,J=',I,J
         GOTO 999
      END IF



      LINE92(5:5)='&'
      LINE92(I:I)='&'
      LINE92(J:J)='&'
      LINE92(J+3:J+3)='&'
      IF (IAT.NE.0) LINE92(J+6:J+6)='&'
      GOTO 998



 999  CONTINUE
      CALL GVSEIW ('PDBC92A')
      CALL GVSKIL



 998  CONTINUE


      RETURN
      END
      SUBROUTINE PDBC92 (IAA,IAT)

















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







      CALL PDBC92A (IAA,IAT)



      CALL PDBC93 (LINE92)





      RETURN
      END
      SUBROUTINE PDBC93 (LOCLIN)



















      IMPLICIT      NONE
      INTEGER       LENLIN, GVFLEN
      CHARACTER*(*) LOCLIN







      LENLIN=GVFLEN(LOCLIN)



         LOCLIN(LENLIN+1:LENLIN+2)='\\\\'

      CALL PDBTT6 (LOCLIN)





      RETURN
      END
      SUBROUTINE PDBC51 (PLOTSUB)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IAA
      CHARACTER*1   OLDCHA
      INTEGER       OLDMOD
      EXTERNAL      PLOTSUB







      OLDCHA=CHANAM(1)
      OLDMOD=MODNMB(1)
      CALL DSP001 (.FALSE.)



      IFT1=1
      DO 10 IAA=1,NUMAAF
         IF (CHANAM(IAA).NE.OLDCHA.OR.MODNMB(IAA).NE.OLDMOD) THEN
            IF (IAA-IFT1.GT.7) CALL PLOTSUB (IFT1,IAA-1,OLDCHA,OLDMOD)
            OLDCHA=CHANAM(IAA)
            OLDMOD=MODNMB(IAA)
            IFT1=IAA
         END IF
   10 CONTINUE
      IF (NUMAAF-IFT1.GT.6) CALL PLOTSUB (IFT1,NUMAAF,OLDCHA,OLDMOD)





      RETURN
      END   
      SUBROUTINE PDBC52 (IFT1,IFT2,OLDCHA,OLDMOD)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CHIANG.INC'
      INCLUDE       'VECTOR.INC'
      INTEGER       IERR, IAA, IFT1, IFT2, ITYP, OLDMOD, OLD1504
      REAL          TVEC(3), XPOS, YPOS, GVFRTD
      CHARACTER*1   OLDCHA
      LOGICAL       WIFIRA
      SAVE          OLD1504
      DATA          OLD1504 /-1/







      IF (.NOT.WIFIRA(IFT1)) GOTO 998
      IF (.NOT.WIFIRA(IFT2)) GOTO 998



      CALL GRTVIN
      FILNMS(72)(1:1)=OLDCHA
      WIFPAR(846)=OLDMOD



      CALL CHI004



      CALL COL008 (IFT1, IFT2)
      DO 10 IAA=IFT1,IFT2
         XPOS=GVFRTD(CHIANG(1,IAA))/20.0
         YPOS=GVFRTD(CHIANG(2,IAA))/20.0
         IF (RESTYP(IAA).EQ.6) THEN
            ITYP=2
         ELSE IF (RESTYP(IAA).EQ.13.OR.RESTYP(IAA).EQ.21) THEN
            ITYP=3
         ELSE 
            ITYP=1
         END IF
         CALL GRTPLS (XPOS,YPOS,0.0,ITYP,0.2,ATCOLR(PNTAAC(IAA)),IERR)
   10 CONTINUE



      CALL GVSRT0 (TVEC,3)



      CALL GRA518 (TVEC)





      CALL GRA520 (TVEC)


      CALL GRA521 (TVEC)




      IF (OLD1504.NE.WIFPAR(1504)) THEN
         OLD1504=WIFPAR(1504)
         CALL PDBMES ('RAMAPLOT')
      ELSE



         CALL PDBMES ('RAMAPLOT2')
      END IF



      WIFPAR(846)=0



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBC53 (IFT1,IFT2,OLDCHA,OLDMOD)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, IFT1, IFT2, IUSE, IAT, OLDMOD, OLD1504
      REAL          YMAX, YMIN
      LOGICAL       WIFIRA
      CHARACTER*1   OLDCHA
      SAVE          OLD1504
      DATA          OLD1504 /-1/







      IF (WIFPAR(1102).NE.0) GOTO 998
      IF (IFT2-IFT1.LT.2) GOTO 998
      IF (.NOT.WIFIRA(IFT1)) GOTO 998
      IF (.NOT.WIFIRA(IFT2)) GOTO 998



      CALL GRTVIN
      FILNMS(72)(1:1)=OLDCHA
      WIFPAR(846)=OLDMOD
      YMAX=-9999.9
      YMIN=9999.9



      DO 6 IAA=IFT1,IFT2
         PRPVAL(IAA)=0.0
         IUSE=0
         DO 5 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (ISATOK(IAT)) THEN
               PRPVAL(IAA)=PRPVAL(IAA)+XBFACT(IAT)
               IUSE=IUSE+1
            END IF
    5    CONTINUE
         IF (IUSE.GT.0) THEN
            PRPVAL(IAA)=PRPVAL(IAA)/FLOAT(IUSE)
            YMAX=MAX(YMAX,PRPVAL(IAA))
            YMIN=MIN(YMIN,PRPVAL(IAA))
         END IF
    6 CONTINUE



      IF (YMAX.LT.0.001) THEN
         CALL PDBMES ('XBFBAD')
      ELSE IF (YMIN.GE.YMAX-0.01) THEN
         CALL PDBMES ('NODIFB')
      ELSE
         CALL SCTPRP (IFT1,IFT2,'Average B factor',
     +    'LIN 1 DOT 0 SY 0 MARG 0.15')
         IF (OLD1504.NE.WIFPAR(1504)) THEN
            OLD1504=WIFPAR(1504)
            CALL PDBMES ('XBFPLOT')
         ELSE



            CALL PDBMES ('XBFPLOT2')
         END IF
      END IF



      WIFPAR(846)=0



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBC55 (IFT1,IFT2,OLDCHA,OLDMOD)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2, OLDMOD
      LOGICAL       WIFIRA
      CHARACTER*1   OLDCHA







      IF (IFT2-IFT1.LT.12) GOTO 998
      IF (.NOT.WIFIRA(IFT1)) GOTO 998
      IF (.NOT.WIFIRA(IFT2)) GOTO 998



      CALL GRTVIN
      FILNMS(72)(1:1)=OLDCHA
      WIFPAR(846)=OLDMOD



      CALL SCTPRP (IFT1,IFT2,'Qualty score',
     + 'LIN 1 DOT 0 SY -5 EY 5 Y=0 MARG 0.15 SMOOTH 10')
      CALL PDBMES ('QUAPLOT')



      WIFPAR(846)=0



  998 CONTINUE

         
      RETURN
      END
      SUBROUTINE PDBC57 (IFT1,IFT2,OLDCHA,OLDMOD)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2, OLDMOD, OLD1504
      LOGICAL       WIFIRA
      CHARACTER*1   OLDCHA
      SAVE          OLD1504
      DATA          OLD1504 /-1/







      IF (IFT2-IFT1.LT.12) GOTO 998
      IF (.NOT.WIFIRA(IFT1)) GOTO 998
      IF (.NOT.WIFIRA(IFT2)) GOTO 998



      CALL GRTVIN
      FILNMS(72)(1:1)=OLDCHA
      WIFPAR(846)=OLDMOD



      CALL SCTPRP (IFT1,IFT2,'New Quality Z-score',
     + 'LIN 1 DOT 0 SY -2 EY 2 Y=0 MARG 0.15 SMOOTH 10')
      IF (OLD1504.NE.WIFPAR(1504)) THEN
         OLD1504=WIFPAR(1504)
         CALL PDBMES ('NQAPLOT')
      ELSE



         CALL PDBMES ('NQAPLOT2')
      END IF



      WIFPAR(846)=0



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBC59 (IFT1,IFT2,OLDCHA,OLDMOD)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IFT1, IFT2, OLDMOD, OLD1504
      LOGICAL       WIFIRA
      CHARACTER*1   OLDCHA
      SAVE          OLD1504
      DATA          OLD1504 /-1/







      IF (IFT2-IFT1.LT.12) GOTO 998
      IF (.NOT.WIFIRA(IFT1)) GOTO 998
      IF (.NOT.WIFIRA(IFT2)) GOTO 998



      CALL GRTVIN
      FILNMS(72)(1:1)=OLDCHA
      WIFPAR(846)=OLDMOD




      CALL PDBC60 (IFT1,IFT2,15)



      CALL SCTPRP (IFT1,IFT2,'Inside/Outside Z-score',
     + 'LIN 1 DOT 0 SY 0.0 EY 2.0 MARG 0.15')
      IF (OLD1504.NE.WIFPAR(1504)) THEN
         OLD1504=WIFPAR(1504)
         CALL PDBMES ('INOPLOT')
      ELSE



         CALL PDBMES ('INOPLOT2')
      END IF



      WIFPAR(846)=0



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBC60 (IN1,IN2,ISMT)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      REAL          SUM
      INTEGER       NUM, IAA, ISM, IERR, IN1, IN2, ISMT, IFT1, IFT2, JAA
      REAL          NPRP(MAXAA)







      ISM=ISMT

      CALL SETIFT (IFT1,IFT2,IN1,IN2)



      SUM=0.0
      NUM=0
      DO 100 IAA=IFT1,IFT2
         NUM=0
         SUM=0.0
         DO 90 JAA=MAX(IFT1,IAA-(ISM-1)/2),MIN(IFT2,IAA+(ISM-1)/2)
            NUM=NUM+1
            SUM=SUM+PRPVAL(JAA)**2
   90    CONTINUE
         NPRP(IAA)=SQRT(SUM/FLOAT(NUM))
  100 CONTINUE
      
      CALL GVSCPR (PRPVAL(IFT1),NPRP(IFT1),IFT2-IFT1+1)



  998 CONTINUE


      RETURN
      END
      SUBROUTINE BONDOK (IAA,JAA,IAATYP,IAT,JAT,ICON,DIJREAL,
     + DIJPREF,ERROR,IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IERR, IAT, JAT, IAA, JAA, ICON, IAATYP, JCON
      REAL          DIJREAL, DIJPREF, ERROR, WIFDST
      LOGICAL       AREBOUND, WIFIRA, WIFIRN
      CHARACTER*1   FIRSTCHARAT







      ERROR=0.0
      DIJREAL=WIFDST(IAT,JAT)
      DIJPREF=1.5
      IERR=1



      IF (.NOT.ISATOK(IAT)) GOTO 998
      IF (.NOT.ISATOK(JAT)) GOTO 998
      IF (.NOT.AREBOUND(IAT,JAT)) GOTO 998



      IF (IAA.EQ.JAA) THEN
         DO 10 JCON=1,MAXTAT
            ICON=JCON
            IF (MUTCON(1,ICON,IAATYP).EQ.0) GOTO 998
            IF (MUTCON(1,ICON,IAATYP).EQ.PINIAA(IAT).AND.
     +          MUTCON(2,ICON,IAATYP).EQ.PINIAA(JAT)) THEN
               DIJPREF=DSTCON(ICON,IAATYP)
               GOTO 20
            END IF
   10    CONTINUE
         GOTO 998



      ELSE
         IF (FIRSTCHARAT(IAT).EQ.'S') THEN
            DIJPREF=2.04
            GOTO 20
         ELSE
            IF (WIFIRA(IAA)) THEN
               DIJPREF=1.325
            ELSE IF (WIFIRN(IAA)) THEN
               DIJPREF=1.607
            ELSE
               DIJPREF=1.5
            END IF
            GOTO 20
         END IF
      END IF



   20 CONTINUE
      ERROR=ABS(DIJPREF-DIJREAL)
      IERR=0



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CHKMVM



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ELMINC.INC'
      INCLUDE       'PDBINC.INC'
      INCLUDE       'SYMINC.INC'
      INCLUDE       'RESULT.INC'
      INTEGER       IAT, ELMZ, FOUND(MAXMOL), MAXFOU, GVFIMX, IERR,
     +              ISOUP1, ISOUP2, IAA, IFT1, IFT2, ISOUP,
     +              JFT1, JFT2, JAA, IFT1A, IFT2A, JFT1A, JFT2A, KAA
      REAL          MOLWT, VOLUME, GVFDET, VM
      LOGICAL       WIFIRW







      IF (.NOT.SYMHAS) THEN
         CALL GVSTTE ('?R00295')
         GOTO 998
      END IF
      IF (NUMAAF.LT.1) THEN
         CALL GVSTTE ('?R00296')
         GOTO 998
      END IF
      IF (WIFPAR(1102).NE.0) GOTO 998



      MOLWT=0.0
      CALL GVSITC (FOUND,1,MAXMOL)



      DO 60 ISOUP=1,NUMSOU
         IF (.NOT.WIFIRW(SOUADM(1,ISOUP))) THEN
            DO 50 IAA=SOUADM(1,ISOUP),SOUADM(2,ISOUP)
               IF (RESTYP(IAA).GT.0) THEN
                  IF (AAWGT(RESTYP(IAA)).GT.0.01) THEN
                     MOLWT=MOLWT+AAWGT(RESTYP(IAA))
                  END IF
               ELSE
                  DO 10 IAT=PNTAAS(IAA),PNTAAE(IAA)
                     MOLWT=MOLWT+EMAS(ELMZ(IAT))
 10               CONTINUE
               END IF
 50         CONTINUE
         END IF
 60   CONTINUE
      MOLWT=MOLWT-2*NUMCYS*EMAS(1)



      IAA=1
  100 CONTINUE
         CALL CHNEXT (IAA,IFT1,IFT2)
         IF (IFT1.NE.IAA) THEN
            CALL GVSTTB ('OOPS1 in MVMCHK')
            CALL GVSTTI ('IAA=',IAA)
            CALL GVSTTI2 ('IFT=',IFT1,IFT2)
         END IF
         ISOUP1=CHAINN(2,IFT1)
         IF (IFT2.GE.NUMAAF) GOTO 91
         JAA=IFT2+1
   90    CONTINUE
            CALL CHNEXT (JAA,JFT1,JFT2)
            IF (JFT1.NE.JAA) THEN
               CALL GVSTTB ('OOPS2 in MVMCHK')
               CALL GVSTTI ('JAA=',JAA)
               CALL GVSTTI2 ('JFT=',JFT1,JFT2)
            END IF
            ISOUP2=CHAINN(2,JFT1)
            IF (IFT2-IFT1.GT.20.AND.JFT2-JFT1.GT.20.AND.
     +           ABS(IFT2-IFT1-JFT2+JFT1).LT.10.AND.
     +           SOUADM(5,ISOUP1).EQ.SOUADM(5,ISOUP2)) THEN



               IFT1A=IFT1
               IFT2A=IFT2
               JFT1A=JFT1
               JFT2A=JFT2
               CALL SUP025 (IFT1A,IFT2A,JFT1A,JFT2A,IERR)
               IF (IERR.EQ.0) THEN
                  FOUND(ISOUP1)=FOUND(ISOUP1)+1
                  FOUND(ISOUP2)=FOUND(ISOUP2)+1
               END IF
            ELSE IF (IFT2-IFT1.EQ.JFT2-JFT1.AND.
     +           SOUADM(5,ISOUP1).EQ.SOUADM(5,ISOUP2)) THEN



               IERR=0
               DO 110 KAA=IFT1,IFT2
                  IF (RESTYP(KAA).NE.RESTYP(KAA+JFT1-IFT1)) IERR=1
  110          CONTINUE
               IF (IERR.EQ.0) THEN
                  FOUND(ISOUP1)=FOUND(ISOUP1)+1
                  FOUND(ISOUP2)=FOUND(ISOUP2)+1
               END IF
            END IF
            JAA=JFT2+1
         IF (JFT2.LT.NUMAAF) GOTO 90
   91    CONTINUE
         IAA=IFT2+1
      IF (IFT2.LT.NUMAAF-1) GOTO 100
      MAXFOU=GVFIMX(FOUND,NUMSOU)



      GENIVL(3)=MAXFOU



      IF ((SYMZ/MAXFOU)*MAXFOU.NE.SYMZ.OR.
     +    (CELMUL.GE.1.AND.SYMZ.NE.CELMUL)) THEN
         CALL PDBMES ('POLYMULT')
         FIXLST(2)=1.0
      END IF



      CALL SYMINI
      CALL SYMSPG (IERR)
      IF (IERR.EQ.0) THEN
         GENIVL(4)=NUMSYM



         IF (SYMZ/NUMSYM*NUMSYM.NE.SYMZ) THEN
            CALL PDBMES ('NUMSYMZ')
            FIXLST(2)=1.0
         END IF
      END IF



      VOLUME=ABS(GVFDET(SYMINV))
      IF (SYMZ.GT.0) THEN
         VM=MAXFOU*VOLUME/SYMZ/MOLWT
      ELSE
         VM=MAXFOU*VOLUME/MOLWT
      END IF
      GENRVL(24)=VM
      GENRVL(25)=MOLWT
      IF (VM.LT.1.5) THEN
         CALL PDBMES ('MVMLOW')
         FIXLST(2)=1.0
      ELSE IF (VM.GT.7.0) THEN
         CALL PDBMES ('MVM2HIGH')
         FIXLST(2)=1.0
      ELSE IF (VM.GT.4.0) THEN
         CALL PDBMES ('MVMHIGH')
         FIXLST(2)=1.0
      ELSE
         CALL PDBMES ('MVMOK')
      END IF
      IF (.NOT.HAS_Z) CALL PDBMES ('MVMMIS')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE CHNEXT (IAA,IFT1,IFT2)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA, ITYP, IFT1, IFT2, ITMP, ISOUP
      CHARACTER*1   ICHN
      LOGICAL       WIFIRR







      IF (.NOT.WIFIRR(IAA)) THEN
         CALL GVSTTB ('?R00297')
         CALL GVSTTI ('IAA=',IAA)
         IFT1=1
         IFT2=1
         GOTO 998
      END IF



      IFT1=IAA
      IFT2=IAA
      ISOUP=CHAINN(2,IAA)
      ITYP=SOUADM(5,ISOUP)
      ICHN=CHANAM(IAA)



      IF (IFT2.EQ.NUMAAF) GOTO 20
      DO 10 ITMP=IAA,NUMAAF-1
         IF (CHANAM(ITMP+1).NE.ICHN.OR.
     +        SOUADM(5,CHAINN(2,ITMP+1)).NE.ITYP) THEN
            IFT2=ITMP
            GOTO 20
         END IF
   10 CONTINUE
      IFT2=NUMAAF
   20 CONTINUE



      IF (IFT1.EQ.1) GOTO 40
      DO 30 ITMP=IAA,2,-1
         IF (CHANAM(ITMP-1).NE.ICHN.OR.
     +        SOUADM(5,CHAINN(2,ITMP-1)).NE.ITYP) THEN
            IFT1=ITMP
            GOTO 40
         END IF
   30 CONTINUE
      IFT1=1
   40 CONTINUE



  998 CONTINUE


      RETURN
      END
      LOGICAL FUNCTION JACKIT (ISEQ,PURPOS)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       ISEQ, PURPOS, LAST
      LOGICAL       TMP
      SAVE          LAST
      DATA  LAST    /-1/




      IF (WIFPAR(912).LT.0.OR.WIFPAR(913).LT.0.OR.WIFPAR(917).LE.0.OR.
     +     WIFPAR(918).NE.PURPOS) THEN
         JACKIT=.FALSE.
      ELSE
         TMP=(WIFPAR(913).EQ.0).EQV.
     +        (MOD(ISEQ,WIFPAR(917)).EQ.WIFPAR(912))
         IF (TMP.AND.ISEQ.NE.LAST) THEN
            CALL GVSTTI ('?R00298',ISEQ)
            LAST=ISEQ
         END IF
         JACKIT=TMP
      END IF





      RETURN
      END
      INTEGER FUNCTION AANUMN (IAA,IERR)



















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





      READ (NUMNAM(IAA),'(I4)',ERR=900) AANUMN
      IERR=0
      GOTO 998

  900 AANUMN=0
      IERR=1



  998 CONTINUE


      RETURN
      END
      SUBROUTINE PDBLST


























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA







      IF (NUMAAT.LE.0) GOTO 998



      CALL GVSRT0 (PRPVAL,NUMAAT)



      CALL CDB013 ('PDBLSTERR','PDBLSTNEU',' ')
      CALL CDB014 (1,'PRESENT','N/A')



      DO 10 IAA=1,SOUADM(9,1)
         PRPVAL(IAA)=1.0
   10 CONTINUE



      CALL CDB012



 998  CONTINUE


      RETURN
      END
      SUBROUTINE SCOLST




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CNTINC.INC'
      INTEGER       IAA, ICON
      LOGICAL       WIFISR







      IF (.NOT.WIFISR(1)) GOTO 999



      CALL GVSRT0 (PRPVAL,NUMAAT)
      CALL ENVRNG (1,SOUADM(9,1))
      CALL WIFPUSHPPP (590,1)



      CALL WIFPUSHPPP (437,1)
      CALL CDB013 ('SCOLSTERR','SCOLSTNEU',' ')
      CALL WIFPOPPPP (437)
      CALL CDB014 (1,'SYMCONTACT','N/A')



      DO 40 IAA=1,SOUADM(9,1)
         CALL FCONAA (IAA,FLOAT(WIFPAR(56))/100.0,.FALSE.)
         IF (NUMCONIAA.GT.0) THEN
            DO 30 ICON=1,NUMCONIAA
               IF (CONSYMAA(ICON).GT.1) PRPVAL(IAA)=1.0
   30       CONTINUE
         END IF
   40 CONTINUE



      CALL CDB012
      CALL WIFPOPPPP (590)



  999 CONTINUE




      RETURN
      END
      SUBROUTINE BVALST



















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







      CALL GVSRTC (PRPVAL,-999.9,NUMAAT)



      CALL CDB013 ('BVALSTERR','BVALSTNEU',' ')




      DO 10 IAA=1,NUMAAF
         NUM=0
         SUM=0.0
         DO 20 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (ISATOK(IAT).AND..NOT.PROTON(IAT)) THEN
               NUM=NUM+1
               SUM=SUM+XBFACT(IAT)
            END IF
   20    CONTINUE
         IF (NUM.NE.0) PRPVAL(IAA)=SUM/NUM
   10 CONTINUE



      CALL CDB012




      RETURN
      END
      SUBROUTINE ACCLST




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAA,IAT
      REAL          SUMA,SUMV,ACCVAC(MAXTAT)
      LOGICAL       ACCVALID,WIFIRA







      CALL GVSRTC (PRPVAL,-999.9,NUMAAT)



      CALL CDB013 ('ACCLSTERR','ACCLSTNEU',' ')



      CALL ENVNOWAT



      CALL WIFPUSHPPP (590,0)



      DO 10 IAA=1,NUMAAF
         IF (WIFIRA(IAA)) THEN



            IF (.NOT.ACCDON(IAA)) CALL WIF041(IAA)
            CALL ACC003 (IAA,ACCVAC)



            SUMA=0.0
            SUMV=0.0
            ACCVALID=.FALSE.
            IF (PNTAAS(IAA)+4.LE.PNTAAE(IAA)) THEN
               DO 20 IAT=PNTAAS(IAA)+4,PNTAAE(IAA)
                  IF (.NOT.PROTON(IAT).AND.ISATOK(IAT)) THEN
                     ACCVALID=.TRUE.
                     SUMA=SUMA+ACCESS(IAT)
                     SUMV=SUMV+ACCVAC(IAT-PNTAAS(IAA)+1)
                  END IF
 20            CONTINUE
            END IF
            IF (ACCVALID) THEN
               IF (SUMV.EQ.0) THEN
                  CALL GVSTTE ('?ACCVACERR')
               ELSE
                  PRPVAL(IAA)=SUMA/SUMV
               END IF
            ELSE

              PRPVAL(IAA)=1.0
            END IF
         END IF
         IF (WIFPAR(279).EQ.0) THEN
            CALL DIF002 (6,IAA,PRPVAL(IAA))
         END IF
   10 CONTINUE



      CALL WIFPOPPPP (590)



      CALL CDB012





      RETURN
      END
      SUBROUTINE PRP014A (IFT1,IFT2,AVER,SDEV,NUMHIT)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'DGLOOP.INC'
      INTEGER       ISOUP, IAA, IFT1, IFT2, IHST, IRT, NUMHIT(MAXAA)
      LOGICAL       GVFIBN
      REAL          AVER(20,3), SDEV(20,3), TMP







      CALL GVSRT0 (PRPVAL,MAXAA)



      CALL WIF019 (5)
      CALL WIFPUSHPPP (564,0)



      CALL MOL200
      CALL DSP003



      CALL WIF412
      CALL WIF412



      DO 10 IAA=IFT1,IFT2
         ISOUP=CHAINN(2,IAA)



         IF (ABS(SOUADM(1,ISOUP)-IAA).LT.2) GOTO 10
         IF (ABS(SOUADM(2,ISOUP)-IAA).LT.2) GOTO 10



         IRT=RESTYP(IAA)
         IF (.NOT.GVFIBN(IRT,1,20)) GOTO 10






         WIFPAR(54)=0
         WIFPAR(196)=1
         WIFPAR(524)=1
         CALL GVSBTF (LOCPAA,NUMUA)
         LOCPAA(RESTYP(IAA))=.TRUE.
         CALL DGM003 (IAA,LOCPAA)
         NUMHIT(IAA)=WIFPAR(54)



         CALL GRTVIN



         IF (WIFPAR(54).GE.WIFPAR(55)) THEN
            PRPVAL(IAA)=0.0
         ELSE IF (WIFPAR(54).LT.3) THEN
            PRPVAL(IAA)=0.5
         ELSE
            CALL GVSRT1 (QFCSTR,WIFPAR(54))
            PRPVAL(IAA)=MIN(1.0,QFCSTR(3,1))
         END IF
         PRPVAL(IAA)=1.0-PRPVAL(IAA)



         IF (LOCHST(IAA).EQ.'S') THEN
            IHST=1
         ELSE IF (LOCHST(IAA).EQ.'H') THEN
            IHST=2
         ELSE
            IHST=3
         END IF
         TMP=PRPVAL(IAA)
         PRPVAL(IAA)=(PRPVAL(IAA)-AVER(IRT,IHST))/SDEV(IRT,IHST)
         IF (IAA.LE.10) THEN
            CALL GVSCTB (LINE,80)
            WRITE (LINE,123,ERR=10) IAA,ONESA3(IAA),LOCHST(IAA),
     +       WIFPAR(54),QFCSTR(1,1),QFCSTR(2,1),QFCSTR(3,1),TMP,
     +       PRPVAL(IAA),AVER(IRT,IHST),SDEV(IRT,IHST)
 123        FORMAT ('IAA, INISCO, NORMSCO=',I4,1X,A4,1X,A1,I4,8F6.2)
            CALL PRP206 (LINE)
         END IF
 10   CONTINUE



      CALL WIF413
      CALL WIF413



      CALL WIFPOPPPP (564)


      RETURN
      END
      SUBROUTINE PRP014B (IFT1,IFT2,NUMHIT)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'DGLOOP.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'RESULT.INC'
      INTEGER       IAA, IFT1, IFT2, NUM, NUMHIT(MAXAA)
      REAL          AVER(20,3), SDEV(20,3), SUM







      CALL GVSIT0 (NUMHIT,MAXAA)
      WIFPAR(564)=0
      SUM=0.0
      NUM=0



      CALL PRP014C (AVER,SDEV)
      CALL PRP014A (IFT1,IFT2,AVER,SDEV,NUMHIT)



      DO 30 IAA=IFT1,IFT2
         IF (ABS(PRPVAL(IAA)).GT.0.0001) THEN
            NUM=NUM+1
            SUM=SUM+PRPVAL(IAA)
         END IF
 30   CONTINUE



      IF (NUM.GT.0) THEN
         GENRVL(34)=SUM/FLOAT(NUM)
      ELSE
         GENRVL(34)=-999.9
      END IF
      GENRVL(34)=(GENRVL(34)-SIGMAP(5))/SIGMAP(6)





      RETURN
      END
      SUBROUTINE PRP014C (AVER,SDEV)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IUNIT, IHST, IRT, I1, I2, IERR
      REAL          AVER(20,3), SDEV(20,3)
      LOGICAL       GVFISF







      IUNIT=0



      CALL GVSROF (IUNIT,IERR)
      IF (IERR.NE.0) GOTO 998
      CALL GVSCCC (LINE,FILDIR(27),'BBCDAT.DAT')
      IF (.NOT.GVFISF(LINE)) CALL GVSCCC (LINE,WHERIS,'BBCDAT.DAT')
      CALL GETFILE (IUNIT,' ',LINE,IERR)
      IF (IERR.NE.0) GOTO 998



      CALL GVSFMT ('?FMT576')
      DO 20 IHST=1,3
         DO 10 IRT=1,20
            READ (IUNIT,FMT,ERR=999) I1,I2,AVER(IRT,IHST),SDEV(IRT,IHST)
            SDEV(IRT,IHST)=MAX(SDEV(IRT,IHST),0.01)
 10      CONTINUE
 20   CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIR ('PRP014C')



  998 CONTINUE
      IF (IUNIT.NE.0) CALL GVSCLF (IUNIT)


      RETURN
      END   
