



      SUBROUTINE QUA001 (DONE)


















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







      IF (OPTIN.EQ.MEN6COD(37)) GOTO 998
      CALL MEN052 (OPTIN,DONE)





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





      ELSE IF (OPTIN.EQ.'QUAFMT') THEN
         CALL QUA047
         DONE=.TRUE.





      ELSE IF (OPTIN.EQ.'QUADFT') THEN
         CALL QUA048
         DONE=.TRUE.
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE QUA002

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'







      WRITE (6,1010,ERR=999) WIFPAR(280),WIFPAR(284)

 1010 FORMAT (/' QUALITY CONTROL RELATED PARAMETERS:',//' ',
     + ' LEVOUT : LEVEL OF OUTPUT IN QUALITY CONTROL (0-2).',/
     + '          THE HIGHER THE NUMBER, THE MORE OUTPUT IS GIVEN',/
     + ' ACTUAL VALUE=',I4,/' ',/
     + ' SKPNEI : SKIP NEIGHBOUR MAIN CHAIN FLAG (0-1).',/
     + '      0 : SKIP NOTHING',/
     + '      1 : SKIP MAINCHAIN ATOMS OF COVALENT NEIGHBOUR',/
     + ' ACTUAL VALUE=',I4)
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('QUA002')



  998 CONTINUE


      RETURN
      END   
      SUBROUTINE QUA018 (AACID,IAT,INDBOX)






















































































































      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IBHASH(20), IBTAB(167), IAT, INDBOX, IAA, INDAA3,
     +              IAATYP
      CHARACTER*4   AACID
      LOGICAL       FIRST, GVFIBN
      SAVE          IBHASH,FIRST,IBTAB
      DATA IBTAB   /1,4,7,10, 13,
     +              1,4,7,10, 14,15,
     +              1,4,7,10, 16,17,18,18,
     +              1,4,7,10, 16,19,17,18,18,
     +              1,4,7,10, 20,21,22,22,22,22,22,
     +              3,6,9,12,
     +              1,4,7,10, 23,24,25,26,26,25,
     +              1,4,7,10, 27,28,29,29,
     +              1,4,7,10, 30,30,30,31,32,
     +              1,4,7,10, 33,27,29,29,
     +              1,4,7,10, 34,35,36,37,
     +              1,4,7,10, 16,38,39,40,
     +              2,5,8,11, 41,41,42,
     +              1,4,7,10, 16,19,38,39,40,
     +              1,4,7,10, 30,30,43,44,45,46,46,
     +              1,4,7,10, 47,48,
     +              1,4,7,10, 47,48,49,
     +              1,4,7,10, 27,29,29,
     +              1,4,7,10, 20,50,51,52,53,54,22,22,22,22,
     +              1,4,7,10, 20,21,22,22,55,55,56,57/
      DATA FIRST    /.TRUE./







      IF (FIRST) THEN
         FIRST=.FALSE.
         CALL GVSIT0 (IBHASH,20)
         DO 10 IAA=2,20
            IBHASH(IAA)=IBHASH(IAA-1)+HATPRA(IAA-1)
   10    CONTINUE
      END IF



      IAATYP=INDAA3(AACID)
      IF (.NOT.GVFIBN(IAATYP,1,20)) THEN
         CALL GVSTTB ('?NEWB225')
         INDBOX=1
         CALL GVST6C ('?M3633',AACID,.TRUE.)
         CALL GVSKIL
         GOTO 998
      END IF



      INDBOX=IBTAB(IBHASH(IAATYP)+IAT)



 998  CONTINUE


      RETURN
      END
      SUBROUTINE QUA028 (JFT1,JFT2)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'TABLES.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'RESULT.INC'
      INCLUDE       'PDBINC.INC'
      INTEGER       GVFCBT, IERR, IFT1, IFT2, NUMQUA,
     +              JFT1, JFT2, IAA, ITAB, ISOUP, IAT, IATNOW, 
     +              IHSTYP, IAATYP, INDACC, INDVAL, MAXIAA,
     +              ISTART, ISTOP, JAA, NORMAA, STRANGEAA, BADAA,
     +              GVFLEN
      REAL          DIFFSUM(MAXAA), VNORML(3,40), QUATFC, QUAFAC,
     +              SIGNOW, DIFFSG, VALNOW, MAXVAL, AVQUA
      CHARACTER*1   HSTTYP
      CHARACTER*23  IAAS, JAAS
      LOGICAL       AATODO(2,20), WIFIRA, WIFROK, WIFIRC, DONT,
     +              ISSOUPCA, DOTAB,  GVFYON, BVAL, GVFIBN, ISSOUPUNK,
     +              INTERRUPTED, WIFIR3
      EQUIVALENCE   (DIFFSUM(1),ESPACE(300001))
      SAVE          VNORML
      DATA VNORML  /4796.6, 1318.4,  -77.4,  3231.7,  948.4,  -26.9,
     +              3031.1,  701.0,  -24.9,  2923.6,  560.2,  -27.5,
     +              2918.5,  540.4,  -12.1,  5805.5, 1312.6, -208.6,
     +              2657.5,  392.6,  -25.1,  3876.1,  920.3,  -23.8,
     +              2534.0,  574.1,  -17.1,  3200.0,  730.0,  -32.6,
     +              3501.6,  767.8,  -41.7,  3449.5,  613.7,  -81.8,
     +              3988.6,  698.6,    5.5,  3061.0,  515.4,  -46.2,
     +              2810.0,  461.5,  -17.8,  3432.8,  754.2,  -84.0,
     +              3602.7,  862.7,  -47.1,  4172.6, 1188.9,  -33.3,
     +              2892.8,  436.2,  -11.2,  2308.0,  438.3,  -16.5,
     +              1259.3,  274.9,  -22.0,  1982.4,  304.0,  -37.9,
     +              1433.1,  275.9,  -27.6,  1122.5,  164.4,  -15.1,
     +              1786.7,  214.9,  -24.1,  1181.6,  241.8,  -28.6,
     +              1705.9,  231.5,  -23.1,  2399.5,  366.9,  -40.5,
     +              1228.7,  164.4,  -14.9,  1702.8,  220.5,  -26.7,
     +              1873.5,  218.8,  -27.5,  1297.5,  202.3,  -21.6,
     +              1208.2,  273.7,  -18.2,  1231.5,  148.7,  -18.4,
     +              1299.4,  138.8,  -15.2,  1301.5,  247.3,  -26.0,
     +              1597.9,  313.5,  -30.7,  2148.3,  367.7,  -40.0,
     +              2324.1,  380.9,  -24.2,  1901.0,  190.9,  -26.3/







      IF (WIFPAR(931).EQ.0) THEN
         CALL GVSTTE ('?R00209')
         GOTO 997
      END IF



      CALL ESPSET (1,167*16*16*16,30)
      CALL ESPSET (300001,300000+MAXAA,30)



      IF (NUMAAF.LT.1) THEN
         CALL GVSTT6 ('?SOULOW')
         GOTO 997
      END IF



      QUATFC=0.0
      NUMQUA=0
      WIFPAR(561)=-99999
      CALL GVSRT0 (DIFFSUM,MAXAA)



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



      DONT=ISSOUPCA()
      IF (DONT) THEN
         CALL GVSTTE ('?NEWE579')
         GOTO 997
      END IF



      IF (WIFPAR(599).GT.0) THEN
         DONT=ISSOUPUNK()
         IF (DONT) THEN
            CALL GVSTTE ('?R00003')
            GOTO 997
         END IF
      END IF



      BADAA=0
      NORMAA=0
      STRANGEAA=0
      DO 3 IAA=IFT1,IFT2
         IF (.NOT.WIFROK(IAA)) BADAA=BADAA+1
         IF (WIFIRA(IAA)) THEN
            IF (RESTYP(IAA).LE.20) THEN
               NORMAA=NORMAA+1
            ELSE
               STRANGEAA=STRANGEAA+1
            END IF
         END IF
    3 CONTINUE
      IF (NORMAA.EQ.0) THEN
         CALL PDBMES ('R00007')
         GOTO 997
      ELSE IF (10*BADAA.GT.NORMAA) THEN
         CALL PDBMES ('R00007A')
         GOTO 997
      ELSE IF (20*STRANGEAA.GT.NORMAA) THEN
         CALL PDBMES ('R00008')
         GOTO 997
      END IF



      CALL WIF080
      CALL DSP001 (.FALSE.)
      CALL GVSBTF (AATODO,2*20)



      DO 5 IAA=IFT1,IFT2
         IF (.NOT.GVFIBN(RESTYP(IAA),1,20)) GOTO 5
         IF (WIFIRA(IAA)) THEN
            IF (LOCHST(IAA).EQ.'H'.OR.LOCHST(IAA).EQ.'3') THEN
               AATODO(1,RESTYP(IAA))=.TRUE.
            ELSE
               AATODO(2,RESTYP(IAA))=.TRUE.
            END IF
         END IF
    5 CONTINUE
      IF (GVFCBT(AATODO,40).LE.0) THEN
         CALL GVSTTE ('?NEWE580')
         GOTO 999
      END IF



      DOTAB=.FALSE.




      CALL ENVINI
      DO 6 ISOUP=CHAINN(2,IFT1),CHAINN(2,IFT2)
         USESOU(ISOUP)=ISOUP
    6 CONTINUE
      DO 7 IAA=IFT1,IFT2
         CALL WIF041 (IAA)
    7 CONTINUE



      DO 35 IHSTYP=1,2
         IF (IHSTYP.EQ.1) THEN
            HSTTYP='H'
         ELSE
            HSTTYP='S'
         END IF



         DO 30 IAATYP=1,20
            IF (.NOT.AATODO(IHSTYP,IAATYP)) GOTO 30



            CALL QUA032A (AANAME(IAATYP),HSTTYP)
            IF (WIFPAR(280).GE.2) CALL QUA033 (AANAME(IAATYP))



            DO 20 IAT=1,HATPRA(IAATYP)
               IF (WIFPAR(838).EQ.0.AND.WIFPAR(492).EQ.0) THEN
                  CALL GVSFMT ('?FMT317')
                  CALL GVSCTB (LINE,80)
                  WRITE (LINE,FMT,ERR=998) AANAME(IAATYP),
     +             MUTROW4(IAT,IAATYP),HSTTYP
                  IF (WIFPAR(279).EQ.0) CALL GVSTO6 (LINE)
               END IF



               IF (IAT.EQ.1.OR.FILNMS(20+IAT).NE.FILNMS(20+IAT-1)) THEN
                  CALL QUA034 (FILNMS(20+IAT),IERR)
               END IF



               DO 10 IAA=IFT1,IFT2
                  IF (RESTYP(IAA).NE.IAATYP) GOTO 10
                  IF (.NOT.WRK1TF(IAA).AND.WIFPAR(562).EQ.1) GOTO 10
                  IF (.NOT.WIFROK(IAA)) GOTO 10
                  IF (.NOT.WIFIRA(IAA)) GOTO 10
                  IF (WIFIRC(IAA)) GOTO 10
                  IF (LOCHST(IAA).EQ.'H'.OR.LOCHST(IAA).EQ.'3') THEN
                     IF (HSTTYP.NE.'H') GOTO 10
                  ELSE
                     IF (HSTTYP.EQ.'H') GOTO 10
                  END IF



                  IF (.NOT.ACCDON(IAA)) THEN
                     CALL WIF041 (IAA)
                  END IF
                  IATNOW=PNTAAS(IAA)+IAT-1
                  CALL QUA035 (IAA,IATNOW,QUAFAC)
                  DIFFSUM(IAA)=DIFFSUM(IAA)+QUAFAC
                  ATTVAL(PNTAAS(IAA)+IAT-1)=QUAFAC
                  IF (INTERRUPTED()) GOTO 999
   10          CONTINUE
   20       CONTINUE
   30    CONTINUE
   35 CONTINUE



      DO 40 IAA=IFT1,IFT2
         IF (.NOT.GVFIBN(RESTYP(IAA),1,20)) GOTO 40



         IF ((.NOT.WIFROK(IAA)).OR.(.NOT.WIFIRA(IAA)).OR.
     +       (WIFIRC(IAA))) THEN
            IF (WIFPAR(838).EQ.0.AND.WIFPAR(492).EQ.0) THEN
               CALL GVSCTB (LINE,80)
               CALL GVSFMT ('?FMT315')
               WRITE (LINE,FMT,ERR=998) IAA
               CALL GVSTT6 (LINE)
            END IF
            GOTO 40
         END IF
         IF (.NOT.WRK1TF(IAA).AND.WIFPAR(562).EQ.1) THEN
            IF (WIFPAR(838).EQ.0.AND.WIFPAR(492).EQ.0) THEN
               CALL GVSFMT ('?FMT316')
               CALL GVSCTB (LINE,80)
               WRITE (LINE,FMT,ERR=998) IAA
               CALL GVSTT6 (LINE)
            END IF
            GOTO 40
         END IF



         INDVAL=RESTYP(IAA)
         IF (LOCHST(IAA).NE.'H'.AND.LOCHST(IAA).NE.'3')
     +    INDVAL=INDVAL+20
         INDACC=INT(SUMACC(IAA)/4.0)+1
         VALNOW=VNORML(1,INDVAL)+INDACC*VNORML(3,INDVAL)
         SIGNOW=VNORML(2,INDVAL)*VALNOW/VNORML(1,INDVAL)
         DIFFSG=(DIFFSUM(IAA)-VALNOW)/SIGNOW
         DIFFSUM(IAA)=DIFFSG



         NUMQUA=NUMQUA+HATPRA(RESTYP(IAA))
         QUATFC=QUATFC+DIFFSG*FLOAT(HATPRA(RESTYP(IAA)))



         IF (DOTAB.AND.WIFPAR(279).EQ.0) THEN
            CALL TAB104 (IAA,ITAB,DIFFSG,0,'    ',BVAL,IERR)
         END IF



         IF (WIFPAR(838).EQ.0.AND.WIFPAR(492).EQ.0) THEN
            CALL GVSFMT ('?FMT1189')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=998) IAA,ONESA3(IAA),NUMNAM(IAA),DIFFSG
            IF (WIFPAR(279).LE.0) THEN
               CALL GVSTT6 (LINE)
            ELSE
               IF (DIFFSG.LE.-5.0) THEN
                  CALL GVSTT6 (LINE)
               END IF
            END IF
         END IF
   40 CONTINUE




      IF (NUMQUA.GT.0) THEN
         QUATFC=QUATFC/FLOAT(NUMQUA)
      ELSE
         QUATFC=-9999.9
      END IF
      WIFPAR(561)=NINT(100.0*QUATFC)
      GENRVL(1)=QUATFC
      GENIVL(1)=IFT1
      GENIVL(2)=IFT2



      IF (WIFPAR(838).NE.0) THEN
         GOTO 999
      END IF



      CALL CDB013 ('BADQUA','NEUQUA','GOODQUA')



      CALL GVSRTC (PRPVAL,-1000.0,MAXAA)
      DO 45 IAA=IFT1,IFT2
         IF (GVFIBN(RESTYP(IAA),1,20)) THEN
            PRPVAL(IAA)=DIFFSUM(IAA)
         END IF
 45   CONTINUE



      CALL GVSBTT (WRK1TF,NUMAAF)
 60   CONTINUE
      MAXIAA=0
      MAXVAL=-5.0
      DO 50 IAA=IFT1,IFT2
         IF (WRK1TF(IAA).AND.DIFFSUM(IAA).LT.MAXVAL) THEN
            MAXVAL=DIFFSUM(IAA)
            MAXIAA=IAA
         END IF
 50   CONTINUE
      IF (MAXIAA.GT.0) THEN
         IAA=MAXIAA
         WRK1TF(IAA)=.FALSE.
         CALL PDBS51 (IAA,(-1.0)*DIFFSUM(IAA),5.0,0.5)



         IF (CHAINN(1,IAA).EQ.2.AND.WIFROK(IAA)) THEN
            CALL PDBC92A (IAA,0)
            CALL GVSFMT ('?FMT635')
            WRITE (BIGLIN,FMT,ERR=998) LINE92(1:GVFLEN(LINE92)),
     +       DIFFSUM(IAA)
            CALL PDBC93 (BIGLIN)
         ELSE



            DIFFSUM(IAA)=0.0
         END IF
         GOTO 60
      END IF



      CALL CDB012



      CALL CDB013 ('BADSQUA',' ','GOODSQUA')



      ISTART=IFT1
      ISTOP=IFT1
      DO 300 IAA=IFT1,IFT2
         IF (DIFFSUM(IAA).LT.-4.0) THEN
            ISTOP=IAA
         END IF




         IF (WIFIR3(IAA).OR.IAA.EQ.IFT2.OR.
     +        DIFFSUM(IAA).GT.-4.0) THEN



            IF (ISTOP-ISTART.GT.1) THEN



               AVQUA=0
               DO 290 JAA=ISTART,ISTOP
                  AVQUA=AVQUA+DIFFSUM(JAA)
  290          CONTINUE
               AVQUA=AVQUA/FLOAT(ISTOP-ISTART+1)



               CALL PDBC92A (ISTART,0)
               CALL GVSSTX (IAAS,LINE92(1:23))
               CALL PDBC92A (ISTOP,0)
               CALL GVSSTX (JAAS,LINE92(1:23))
               CALL GVSFMT ('?FMT1416')
               WRITE (LINE,FMT,ERR=998) IAAS,JAAS,AVQUA
               CALL PDBC93 (LINE)
            END IF



            ISTART=IAA+1
         END IF
  300 CONTINUE




      CALL CDB012



      IF (GENIVL(2).GT.GENIVL(1)+5) THEN
         IF (QUATFC.LT.-2.0) THEN
            CALL PDBMES ('BADMQUA')
         ELSE IF (QUATFC.LT.-1.4) THEN
            CALL PDBMES ('MEDMQUA')
         ELSE
            CALL PDBMES ('GOODMQUA')
         END IF
      END IF



      IF (WIFPAR(279).LT.1.OR.GENIVL(2).LE.GENIVL(1)+5) THEN
         CALL GVSNL6 (1)
         CALL GVSFMT ('?FMT314')
         CALL GVSCTB (LINE,80)
         WRITE (LINE,FMT,ERR=998) IFT1,IFT2,QUATFC
         CALL GVSTT6 (LINE)
      END IF

      GOTO 999



 998  CONTINUE
      CALL GVSEIW ('QUA028')



 999  CONTINUE
 997  CONTINUE


      RETURN
      END
      SUBROUTINE QUA028NMR 

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'QUALTY.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       IFT1, IFT2, NUMQUA, MODNOW, IAA, IAT, IATNOW, 
     +              IHSTYP, IAATYP, INDACC, INDVAL, IERR
      CHARACTER*1   HSTTYP
      REAL          DIFFSUM(MAXAA), VNORML(3,40), QUATFC, QUAFAC,
     +              SIGNOW, DIFFSG, VALNOW, RMSROW(100)
      LOGICAL       AATODO(2,20), WIFIRA, WIFROK, WIFIRC, DONT,
     +              ISSOUPCA, GVFIBN, ISSOUPUNK, INTERRUPTED
      EQUIVALENCE   (DIFFSUM(1),ESPACE(300001))
      SAVE          VNORML
      DATA VNORML  /4796.6, 1318.4,  -77.4,  3231.7,  948.4,  -26.9,
     +              3031.1,  701.0,  -24.9,  2923.6,  560.2,  -27.5,
     +              2918.5,  540.4,  -12.1,  5805.5, 1312.6, -208.6,
     +              2657.5,  392.6,  -25.1,  3876.1,  920.3,  -23.8,
     +              2534.0,  574.1,  -17.1,  3200.0,  730.0,  -32.6,
     +              3501.6,  767.8,  -41.7,  3449.5,  613.7,  -81.8,
     +              3988.6,  698.6,    5.5,  3061.0,  515.4,  -46.2,
     +              2810.0,  461.5,  -17.8,  3432.8,  754.2,  -84.0,
     +              3602.7,  862.7,  -47.1,  4172.6, 1188.9,  -33.3,
     +              2892.8,  436.2,  -11.2,  2308.0,  438.3,  -16.5,
     +              1259.3,  274.9,  -22.0,  1982.4,  304.0,  -37.9,
     +              1433.1,  275.9,  -27.6,  1122.5,  164.4,  -15.1,
     +              1786.7,  214.9,  -24.1,  1181.6,  241.8,  -28.6,
     +              1705.9,  231.5,  -23.1,  2399.5,  366.9,  -40.5,
     +              1228.7,  164.4,  -14.9,  1702.8,  220.5,  -26.7,
     +              1873.5,  218.8,  -27.5,  1297.5,  202.3,  -21.6,
     +              1208.2,  273.7,  -18.2,  1231.5,  148.7,  -18.4,
     +              1299.4,  138.8,  -15.2,  1301.5,  247.3,  -26.0,
     +              1597.9,  313.5,  -30.7,  2148.3,  367.7,  -40.0,
     +              2324.1,  380.9,  -24.2,  1901.0,  190.9,  -26.3/







      CALL ESPSET (1,167*16*16*16,30)
      CALL ESPSET (300001,300000+MAXAA,30)



      DONT=ISSOUPCA()
      IF (DONT) THEN
         CALL GVSTTE ('?NEWE579')
         GOTO 998
      END IF



      IF (WIFPAR(599).GT.0) THEN
         DONT=ISSOUPUNK()
         IF (DONT) THEN
            CALL GVSTTE ('?R00003')
            GOTO 998
         END IF
      END IF



      CALL DSP001 (.FALSE.)
      CALL GVSRTC (RMSROW,9999.9,100)
      CALL GVSRT0 (PRPVAL,MAXAA)
      IFT1=0
      IFT2=0



 1    CONTINUE
      DO 500 MODNOW=1,WIFPAR(846)



         QUATFC=0.0
         NUMQUA=0
         WIFPAR(561)=-99999
         CALL GVSRT0 (DIFFSUM,MAXAA)
         CALL WIF080
         CALL GVSBTF (AATODO,2*20)



         DO 3 IAA=1,NUMAAF
            IF (MODNMB(IAA).EQ.MODNOW) IFT2=IAA
    3    CONTINUE
         DO 4 IAA=NUMAAF,1,-1
            IF (MODNMB(IAA).EQ.MODNOW) IFT1=IAA
    4    CONTINUE
         CALL GVSBTF (ISATOK,NUMATF)
         DO 5 IAT=PNTAAS(IFT1),PNTAAE(IFT2)
            ISATOK(IAT)=.TRUE.
    5    CONTINUE



         DO 6 IAA=1,NUMAAF
            IF (.NOT.GVFIBN(RESTYP(IAA),1,20)) GOTO 6
            IF (WIFIRA(IAA)) THEN
               IF (LOCHST(IAA).EQ.'H'.OR.LOCHST(IAA).EQ.'3') THEN
                  AATODO(1,RESTYP(IAA))=.TRUE.
               ELSE
                  AATODO(2,RESTYP(IAA))=.TRUE.
               END IF
            END IF
    6    CONTINUE



         CALL ENVINI
         USESOU(MODNOW)=MODNOW
         DO 7 IAA=IFT1,IFT2
            CALL WIF041 (IAA)
    7    CONTINUE



         DO 35 IHSTYP=1,2
            IF (IHSTYP.EQ.1) THEN
               HSTTYP='H'
            ELSE
               HSTTYP='S'
            END IF



            DO 30 IAATYP=1,20
               IF (.NOT.AATODO(IHSTYP,IAATYP)) GOTO 30



               CALL QUA032A (AANAME(IAATYP),HSTTYP)
               IF (WIFPAR(280).GE.2) CALL QUA033 (AANAME(IAATYP))



               DO 20 IAT=1,HATPRA(IAATYP)



                  IF (IAT.EQ.1.OR.FILNMS(20+IAT).NE.
     +                FILNMS(20+IAT-1)) THEN



                     CALL QUA034 (FILNMS(20+IAT),IERR)
                     IF (IERR.EQ.1) THEN
                        IF (EXTION.EQ.'box') THEN
                           CALL GVSSTX (EXTION,'new')
                           GOTO 1
                        ELSE
                           STOP 'QUALITY CONTROL BOX MISINSTALLATION'
                        END IF
                     END IF
                  END IF



                  DO 10 IAA=IFT1,IFT2
                     IF (RESTYP(IAA).NE.IAATYP) GOTO 10
                     IF (.NOT.WRK1TF(IAA).AND.WIFPAR(562).EQ.1) GOTO 10
                     IF (.NOT.WIFROK(IAA)) GOTO 10
                     IF (.NOT.WIFIRA(IAA)) GOTO 10
                     IF (WIFIRC(IAA)) GOTO 10
                     IF (LOCHST(IAA).EQ.'H'.OR.LOCHST(IAA).EQ.'3') THEN
                        IF (HSTTYP.NE.'H') GOTO 10
                     ELSE
                        IF (HSTTYP.EQ.'H') GOTO 10
                     END IF



                     IF (.NOT.ACCDON(IAA)) CALL WIF041 (IAA)
                     IATNOW=PNTAAS(IAA)+IAT-1
                     CALL QUA035 (IAA,IATNOW,QUAFAC)
                     DIFFSUM(IAA)=DIFFSUM(IAA)+QUAFAC
                     ATTVAL(PNTAAS(IAA)+IAT-1)=QUAFAC
   10             CONTINUE
   20          CONTINUE
               IF (INTERRUPTED()) GOTO 999
   30       CONTINUE
   35    CONTINUE



         DO 40 IAA=IFT1,IFT2
            IF (.NOT.GVFIBN(RESTYP(IAA),1,20)) GOTO 40



            INDVAL=RESTYP(IAA)
            IF (LOCHST(IAA).NE.'H'.AND.LOCHST(IAA).NE.'3')
     +        INDVAL=INDVAL+20
            INDACC=INT(SUMACC(IAA)/4.0)+1
            VALNOW=VNORML(1,INDVAL)+INDACC*VNORML(3,INDVAL)
            SIGNOW=VNORML(2,INDVAL)*VALNOW/VNORML(1,INDVAL)
            DIFFSG=(DIFFSUM(IAA)-VALNOW)/SIGNOW
            DIFFSUM(IAA)=DIFFSG
            PRPVAL(IAA-IFT1+1)=PRPVAL(IAA-IFT1+1)+
     +       DIFFSG/FLOAT(WIFPAR(846))



            NUMQUA=NUMQUA+HATPRA(RESTYP(IAA))
            QUATFC=QUATFC+DIFFSG*FLOAT(HATPRA(RESTYP(IAA)))
   40    CONTINUE



         IF (NUMQUA.GT.0) THEN
            QUATFC=QUATFC/FLOAT(NUMQUA)
         ELSE
            QUATFC=9999.9
         END IF
         RMSROW(MODNOW)=QUATFC
  500 CONTINUE



      CALL GVSBOX ('?M1327')
      DO 600 MODNOW=1,WIFPAR(846)
         PRINT*,MODNOW,RMSROW(MODNOW)
  600 CONTINUE
      CALL GVSBOX ('?M1328')
      DO 700 IAA=1,NUMAAF
         IF (MODNMB(IAA).EQ.1) CALL DIF002 (6,IAA,PRPVAL(IAA))
  700 CONTINUE



 999  CONTINUE
 998  CONTINUE

         
      RETURN
      END
      SUBROUTINE QUA028A (IAA,DIFFSG)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'QUALTY.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       NUMQUA, IAA, IAT, IATNOW, IHSTYP, IAATYP, INDACC,
     +              INDVAL, IERR
      CHARACTER*1   HSTTYP
      REAL          DIFFSUM(MAXAA), VNORML(3,40), QUATFC, QUAFAC,
     +              SIGNOW, DIFFSG, VALNOW
      LOGICAL       AATODO(2,20), INTERRUPTED
      EQUIVALENCE   (DIFFSUM(1),ESPACE(300001))
      SAVE          VNORML
      DATA VNORML  /4796.6, 1318.4,  -77.4,  3231.7,  948.4,  -26.9,
     +              3031.1,  701.0,  -24.9,  2923.6,  560.2,  -27.5,
     +              2918.5,  540.4,  -12.1,  5805.5, 1312.6, -208.6,
     +              2657.5,  392.6,  -25.1,  3876.1,  920.3,  -23.8,
     +              2534.0,  574.1,  -17.1,  3200.0,  730.0,  -32.6,
     +              3501.6,  767.8,  -41.7,  3449.5,  613.7,  -81.8,
     +              3988.6,  698.6,    5.5,  3061.0,  515.4,  -46.2,
     +              2810.0,  461.5,  -17.8,  3432.8,  754.2,  -84.0,
     +              3602.7,  862.7,  -47.1,  4172.6, 1188.9,  -33.3,
     +              2892.8,  436.2,  -11.2,  2308.0,  438.3,  -16.5,
     +              1259.3,  274.9,  -22.0,  1982.4,  304.0,  -37.9,
     +              1433.1,  275.9,  -27.6,  1122.5,  164.4,  -15.1,
     +              1786.7,  214.9,  -24.1,  1181.6,  241.8,  -28.6,
     +              1705.9,  231.5,  -23.1,  2399.5,  366.9,  -40.5,
     +              1228.7,  164.4,  -14.9,  1702.8,  220.5,  -26.7,
     +              1873.5,  218.8,  -27.5,  1297.5,  202.3,  -21.6,
     +              1208.2,  273.7,  -18.2,  1231.5,  148.7,  -18.4,
     +              1299.4,  138.8,  -15.2,  1301.5,  247.3,  -26.0,
     +              1597.9,  313.5,  -30.7,  2148.3,  367.7,  -40.0,
     +              2324.1,  380.9,  -24.2,  1901.0,  190.9,  -26.3/







      CALL ESPSET (300001,300000+MAXAA,30)



      IF (NUMAAF.LT.1) THEN
         CALL GVSTT6 ('?SOULOW')
         GOTO 998
      END IF



      QUATFC=0.0
      NUMQUA=0
      WIFPAR(561)=-99999
      DIFFSUM(IAA)=0.0
      CALL WIFPUSHPPP (279,0)
      CALL DSP001 (.FALSE.)
      CALL WIFPUSHPPP (56,800)










      CALL WIFPOPPPP (56)
      CALL WIFPOPPPP (279)
      CALL GVSBTF (AATODO,2*20)



      IF (LOCHST(IAA).EQ.'H'.OR.LOCHST(IAA).EQ.'3') THEN
         AATODO(1,RESTYP(IAA))=.TRUE.
      ELSE
         AATODO(2,RESTYP(IAA))=.TRUE.
      END IF



 1    CONTINUE
      DO 35 IHSTYP=1,2
         IF (IHSTYP.EQ.1) THEN
            HSTTYP='H'
         ELSE
            HSTTYP='S'
         END IF



         DO 30 IAATYP=1,20
            IF (.NOT.AATODO(IHSTYP,IAATYP)) GOTO 30



            CALL QUA032A (AANAME(IAATYP),HSTTYP)
            IF (WIFPAR(280).GE.2) CALL QUA033 (AANAME(IAATYP))



            DO 20 IAT=1,HATPRA(IAATYP)



               IF (IAT.EQ.1.OR.FILNMS(20+IAT).NE.FILNMS(20+IAT-1)) THEN



                  CALL QUA034 (FILNMS(20+IAT),IERR)
                  IF (IERR.EQ.1) THEN
                     IF (EXTION.EQ.'box') THEN
                        CALL GVSSTX (EXTION,'new')
                        GOTO 1
                     ELSE
                        STOP 'QUALITY CONTROL BOX MISINSTALLATION'
                     END IF
                  END IF
               END IF



               IF (LOCHST(IAA).EQ.'H'.OR.LOCHST(IAA).EQ.'3') THEN
                  IF (HSTTYP.NE.'H') GOTO 10
               ELSE
                  IF (HSTTYP.EQ.'H') GOTO 10
               END IF



               IF (.NOT.ACCDON(IAA)) CALL WIF041 (IAA)
               IATNOW=PNTAAS(IAA)+IAT-1
               CALL QUA035 (IAA,IATNOW,QUAFAC)
               DIFFSUM(IAA)=DIFFSUM(IAA)+QUAFAC
               ATTVAL(PNTAAS(IAA)+IAT-1)=QUAFAC
   10          CONTINUE
   20       CONTINUE
            IF (INTERRUPTED()) GOTO 999
   30    CONTINUE
   35 CONTINUE



      INDVAL=RESTYP(IAA)
      IF (LOCHST(IAA).NE.'H'.AND.LOCHST(IAA).NE.'3')
     + INDVAL=INDVAL+20
      INDACC=INT(SUMACC(IAA)/4.0)+1
      VALNOW=VNORML(1,INDVAL)+INDACC*VNORML(3,INDVAL)
      SIGNOW=VNORML(2,INDVAL)*VALNOW/VNORML(1,INDVAL)
      DIFFSG=(DIFFSUM(IAA)-VALNOW)/SIGNOW
      DIFFSUM(IAA)=DIFFSG



      NUMQUA=NUMQUA+HATPRA(RESTYP(IAA))
      QUATFC=QUATFC+DIFFSG*FLOAT(HATPRA(RESTYP(IAA)))



 999  CONTINUE
 998  CONTINUE


      RETURN
      END
      SUBROUTINE QUA031 (IFT1,DIFFSG)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       INDVAL, IFT1, IAT, IAATYP, IATNOW, INDACC, IERR
      REAL          VNORML(3,40), DIFFSG, QUATOT, QUAFAC, SIGNOW,
     +              VALNOW
      LOGICAL       WIFIRR, WIFROK
      CHARACTER*4   T4, CHAR4
      SAVE          VNORML
      DATA VNORML  /4796.6, 1318.4,  -77.4,  3231.7,  948.4,  -26.9,
     +              3031.1,  701.0,  -24.9,  2923.6,  560.2,  -27.5,
     +              2918.5,  540.4,  -12.1,  5805.5, 1312.6, -208.6,
     +              2657.5,  392.6,  -25.1,  3876.1,  920.3,  -23.8,
     +              2534.0,  574.1,  -17.1,  3200.0,  730.0,  -32.6,
     +              3501.6,  767.8,  -41.7,  3449.5,  613.7,  -81.8,
     +              3988.6,  698.6,    5.5,  3061.0,  515.4,  -46.2,
     +              2810.0,  461.5,  -17.8,  3432.8,  754.2,  -84.0,
     +              3602.7,  862.7,  -47.1,  4172.6, 1188.9,  -33.3,
     +              2892.8,  436.2,  -11.2,  2308.0,  438.3,  -16.5,
     +              1259.3,  274.9,  -22.0,  1982.4,  304.0,  -37.9,
     +              1433.1,  275.9,  -27.6,  1122.5,  164.4,  -15.1,
     +              1786.7,  214.9,  -24.1,  1181.6,  241.8,  -28.6,
     +              1705.9,  231.5,  -23.1,  2399.5,  366.9,  -40.5,
     +              1228.7,  164.4,  -14.9,  1702.8,  220.5,  -26.7,
     +              1873.5,  218.8,  -27.5,  1297.5,  202.3,  -21.6,
     +              1208.2,  273.7,  -18.2,  1231.5,  148.7,  -18.4,
     +              1299.4,  138.8,  -15.2,  1301.5,  247.3,  -26.0,
     +              1597.9,  313.5,  -30.7,  2148.3,  367.7,  -40.0,
     +              2324.1,  380.9,  -24.2,  1901.0,  190.9,  -26.3/







      IF (NUMAAF.LT.1) THEN
         CALL GVSTT6 ('?SOULOW')
         GOTO 998
      END IF



      IF (WIFPAR(931).EQ.0) THEN
         IF (WIFPAR(492).EQ.0) CALL GVSTTE ('?R00209')
         GOTO 998
      END IF
      IF (.NOT.WIFIRR(IFT1)) THEN
         IF (WIFPAR(492).EQ.0) CALL GVSTTB ('BGQ31A')
         GOTO 998
      END IF
      IF (.NOT.WIFROK(IFT1)) THEN
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?BGQ31B')
         QUATOT=0.001
         GOTO 998
      END IF



      IF (.NOT.HSTDON) THEN
         CALL DSP001 (.FALSE.)
      END IF
      IF (.NOT.HSTDON) CALL GVSTTB ('?BGQ31C')



      IAATYP=RESTYP(IFT1)
      QUATOT=0.0
      QUAFAC=0.0



      IF (WIFPAR(79).EQ.1) THEN
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT560')
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT561')
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT562')
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT563')
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT564')
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT565')
         WIFPAR(79)=0
         CALL WIF080
         CALL WIF039
      END IF
      IF (.NOT.ACCDON(IFT1)) THEN
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT560')
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT561')
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT568')
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT564')
         IF (WIFPAR(492).EQ.0) CALL GVSTT6 ('?NEWT565')
         WIFPAR(79)=0
         CALL WIF080
         CALL WIF039
      END IF



      CALL QUA032 (ONESA3(IFT1),IFT1)
      IF (WIFPAR(280).GE.2) CALL QUA033 (ONESA3(IFT1))



      DO 100 IAT=1,HATPRA(IAATYP)
         IATNOW=IAT-1+PNTAAS(IFT1)
         IF (WIFPAR(280).GE.1) THEN
            IF (WIFPAR(492).EQ.0) CALL GVSTT6 (FILNMS(20+IAT))
            CHAR4=T4(ONESAT(IATNOW))
            CALL GVSFMT ('?FMT1181')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=999) IFT1,ONESA3(IFT1),NUMNAM(IFT1),
     +       CHAR4
            CALL GVSTT6 (LINE)
         END IF



         IF (IAT.EQ.1.OR.FILNMS(20+IAT).NE.FILNMS(20+IAT-1)) THEN



            CALL QUA034 (FILNMS(20+IAT),IERR)
         END IF



         CALL QUA035 (IFT1,IATNOW,QUAFAC)
         QUATOT=QUATOT+QUAFAC
  100 CONTINUE



      INDVAL=IAATYP
      IF (LOCHST(IFT1).NE.'H'.AND.LOCHST(IFT1).NE.'3') INDVAL=INDVAL+20
      INDACC=INT(SUMACC(IFT1)/4.0)+1
      VALNOW=VNORML(1,INDVAL)+INDACC*VNORML(3,INDVAL)
      SIGNOW=VNORML(2,INDVAL)*VALNOW/VNORML(1,INDVAL)
      DIFFSG=(QUATOT-VALNOW)/SIGNOW
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('QUA031')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE QUA032 (AACID,IFT1)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'QUALTY.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       GVFPLS, INDAA3, IFIL, IPOS, IFT1
      CHARACTER*4   AACID
      LOGICAL       FOUND, GVFFOP, GVFIBN, GVFISF







      IF (.NOT.GVFIBN(INDAA3(AACID),1,20)) THEN
         CALL GVSTTB ('?NEWB213')
         GOTO 997
      END IF



      CALL GVSCTB (FILNMS(21),14*80)
      FOUND=.FALSE.



      CALL GVSCTB (LINE,80)
      CALL GVSCCC (LINE,WHERIS,'QUALITY.LUP')



      IF (.NOT.GVFISF(LINE)) THEN
         CALL GVSTTE ('?NEWE581')
         GOTO 997
      END IF
      CALL GVSCLF (1)
      CALL GVSOPF (LINE,1,'OLD')
      IF (.NOT.GVFFOP(1)) THEN
         CALL GVSTTE ('?NEWE582')
         GOTO 997
      END IF



      IFIL=20
   10 CONTINUE
         CALL GVSCTB (LINE,80)



         READ (1,'(A80)',ERR=999,END=998) LINE
         IF (FOUND.AND.LINE(1:3).NE.AACID(1:3)) GOTO 997
      IF (LINE(1:3).NE.AACID(1:3)) GOTO 10
      FOUND=.TRUE.
      IFIL=IFIL+1



      CALL GVSCTB (FILNMS(IFIL),80)
      CALL GVSCTB (LINE2,80)
      READ (LINE,'(9X,A60)',ERR=999,END=999) LINE2(1:60)
      CALL GVSCPC (FILNMS(IFIL)(1:60),QUAFLC)



      IPOS=GVFPLS(FILNMS(IFIL),'/')+1
      IF (IPOS.EQ.0) THEN
         CALL GVSTTB ('?NEWB214')
         CALL GVSTT6 (QUAFLC)
         CALL GVSTT6 (FILNMS(IFIL))
         GOTO 997
      END IF
      FILNMS(IFIL)(IPOS:IPOS+4)='     '



      IF (LOCHST(IFT1).EQ.'H'.OR.LOCHST(IFT1).EQ.'3') THEN
         CALL GVSCPC (FILNMS(IFIL),'helix/')
      ELSE
         CALL GVSCPC (FILNMS(IFIL),'rest/')
      END IF



      CALL GVSCPC (FILNMS(IFIL),LINE2)
      CALL GVSCLC (FILNMS(IFIL))
      CALL GVSCPC (FILNMS(IFIL),EXTION)
      IF (.NOT.GVFISF(FILNMS(IFIL))) THEN
         CALL GVSTTE ('?NEWE583')
         CALL GVSTT6 (FILNMS(IFIL))
      END IF



      GOTO 10



  999 CONTINUE
      CALL GVSTTE ('?NEWE584')
      GOTO 997



  998 CONTINUE
      CALL GVSTT6 ('?NEWT571')
      GOTO 997



 997  CONTINUE
      CALL GVSCLF (1)


      RETURN
      END
      SUBROUTINE QUA032A (AACID,HSTTYP)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'QUALTY.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       GVFPLS, INDAA3, IFIL, IPOS
      LOGICAL       GVFFOP, GVFIBN, GVFISF
      CHARACTER*1   HSTTYP
      CHARACTER*4   AACID
      LOGICAL       FOUND







      IF (.NOT.GVFIBN(INDAA3(AACID),1,20)) THEN
         CALL GVSTTB ('?NEWB215')
         GOTO 997
      END IF



      CALL GVSCTB (FILNMS(21),14*80)



      CALL GVSCTB (LINE,80)
      CALL GVSCCC (LINE,WHERIS,'QUALITY.LUP')



      IF (.NOT.GVFISF(LINE)) THEN
         CALL GVSTTE ('?NEWE581')
         GOTO 997
      END IF
      CALL GVSCLF (1)
      CALL GVSOPF (LINE,1,'OLD')
      IF (.NOT.GVFFOP(1)) THEN
         CALL GVSTTE ('?NEWE582')
         GOTO 997
      END IF



      IFIL=20
      FOUND=.FALSE.
   10 CONTINUE
         CALL GVSCTB (LINE,80)



         READ (1,'(A80)',ERR=999,END=998) LINE
         IF (FOUND.AND.LINE(1:3).NE.AACID(1:3)) GOTO 997
         IF (LINE(1:3).NE.AACID(1:3)) GOTO 10
         FOUND=.TRUE.
         IFIL=IFIL+1



         CALL GVSCTB (FILNMS(IFIL),80)
         CALL GVSCTB (LINE2,80)
         READ (LINE,'(9X,A60)',ERR=999,END=999) LINE2(1:60)
         CALL GVSCLC (LINE2)
         CALL GVSCPC (FILNMS(IFIL)(1:60),QUAFLC)




         IPOS=GVFPLS(FILNMS(IFIL),'/')+1
         IF (IPOS.EQ.0) THEN
            CALL GVSTTB ('?NEWB214')
            CALL GVSTT6 (QUAFLC)
            CALL GVSTT6 (FILNMS(IFIL))
            GOTO 997
         END IF
         FILNMS(IFIL)(IPOS:IPOS+4)='     '



         IF (HSTTYP.EQ.'H'.OR.HSTTYP.EQ.'3') THEN
            CALL GVSCPC (FILNMS(IFIL),'helix/')
         ELSE
            CALL GVSCPC (FILNMS(IFIL),'rest/')
         END IF



         CALL GVSCPC (FILNMS(IFIL),LINE2)
         CALL GVSCPC (FILNMS(IFIL),EXTION)




         IF (.NOT.GVFISF(FILNMS(IFIL))) THEN
            CALL GVSTTE ('?NEWE583')
            CALL GVSTT6 (FILNMS(IFIL))
         END IF



      GOTO 10



  999 CONTINUE
      CALL GVSTTE ('?NEWE584')
      GOTO 997



  998 CONTINUE
      CALL GVSTT6 ('?NEWT571')



  997 CONTINUE
      CALL GVSCLF (1)


      RETURN
      END
      SUBROUTINE QUA033 (AACID)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       INDAA3, IAATYP, IAT
      LOGICAL       GVFIBN
      CHARACTER*4   AACID







      IF (.NOT.GVFIBN(INDAA3(AACID),1,20)) THEN
         CALL GVSTTB ('?NEWB217')
         GOTO 998
      END IF



      IAATYP=INDAA3(AACID)



      CALL GVSNL6 (2)
      CALL GVSTT6 ('?NEWT573')
      CALL GVSNL6 (2)
      CALL GVSFMT ('?FMT317A')
      DO 10 IAT=1,HATPRA(IAATYP)
         WRITE (6,FMT,ERR=999) MUTROW4(IAT,IAATYP),FILNMS(20+IAT)(1:60)
   10 CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('QUA033')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE QUA034 (FILE,IERR)



















      IMPLICIT      NONE
      INCLUDE       'ESPACE.INC'
      INCLUDE       'QUALTY.INC'
      INTEGER       IAT, IERR
      LOGICAL       FIRST, GVFFOP, GVFISF
      CHARACTER*80  OLDFILE
      CHARACTER*(*) FILE
      SAVE          OLDFILE, FIRST
      DATA FIRST    /.TRUE./







      IF (FIRST) THEN
         FIRST=.FALSE.
         CALL GVSCTB (OLDFILE,80)
      END IF
      IERR=0



      IF (FILE.EQ.OLDFILE) RETURN
      CALL GVSSTX (OLDFILE,FILE)
      IF (.NOT.GVFISF(FILE)) THEN
         CALL GVSTT6 ('?NEWT340')
         CALL GVSTT6 (FILE)
         CALL GVSKIL
         GOTO 997
      END IF



      CALL GVSCLF (1)
      CALL GVSOUF (FILE,1,'OLD')
      IF (.NOT.GVFFOP(1)) THEN
         CALL GVSTTE ('?NEWE589')
         GOTO 998
      END IF



      CALL GVSREW (1)
      READ (1,ERR=999,END=998) QUACID
      READ (1,ERR=999,END=998) QUATAG
      READ (1,ERR=999,END=998) QUAIAT
      READ (1,ERR=999,END=998) MAXQUA
      READ (1,ERR=999,END=998) QUALBL



      CALL GVSBTF (LOCQAT,14)
      DO 10 IAT=1,14
         LOCQAT(IAT)=QUATAG(IAT).EQ.1
 10   CONTINUE
      GOTO 997



 999  CONTINUE
      IERR=1
      IF (EXTION.EQ.'new') THEN
         CALL GVSTTE ('?NEWE590')
         CALL GVSTT6 (FILE)
      END IF
      GOTO 997



 998  CONTINUE
      CALL GVSTTE ('?NEWE591')
      CALL GVSTT6 (FILE)



 997  CONTINUE
      CALL GVSCLF (1)


      RETURN
      END
      SUBROUTINE QUA035 (IAAQ,IATQ,QUAFAC)
























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'QUALTY.INC'
      INTEGER       GVFCBT, IAAQ, IATQ, IUSE, IAT, JAASYM(100), 
     +              JAAARR(100), NUM, IERR
      REAL          GVFDET, LOCSUP(3,14), RMAT(3,3), TVEC(3),
     +              QUAFAC, DUMMY, RINV(3,3), TINV(3)
      LOGICAL       WIFIRR
      COMMON /QUANEI/ NUM, JAAARR







      IF (GVFCBT(LOCQAT,14).LT.3) THEN
         CALL GVSTTB ('?NEWB218')
         GOTO 998
      END IF
      IF (.NOT.WIFIRR(IAAQ)) THEN
         QUAFAC=0.0
         GOTO 998
      END IF



      QUAFAC=0.0



      IUSE=0
      DO 10 IAT=1,HATPRA(RESTYP(IAAQ))
         IF (LOCQAT(IAT)) THEN
            IUSE=IUSE+1
            LOCSUP(1,IUSE)=XCOORD(PNTAAS(IAAQ)+IAT-1)
            LOCSUP(2,IUSE)=YCOORD(PNTAAS(IAAQ)+IAT-1)
            LOCSUP(3,IUSE)=ZCOORD(PNTAAS(IAAQ)+IAT-1)
         END IF
   10 CONTINUE
      WIFPAR(453)=1
      CALL GVSSUP (IUSE,QUAIAT,LOCSUP,RMAT,TVEC,DUMMY)
      WIFPAR(453)=0



      IF (ABS(GVFDET(RMAT)-1.0).GT.0.001) THEN
         CALL GVSTT6 ('?NEWT575')
         CALL GVSWM4 (RMAT,TVEC)
         CALL GVSTTR ('?NEWZ89',GVFDET(RMAT))
         CALL GVSTT6 ('?NEWT576')
         CALL SHOIAA (IAAQ)
         CALL GVSKIL
         QUAFAC=0.0
         GOTO 998
      END IF
      CALL WIFPUSHPPP (590,0)
      CALL FCONAAI (IAAQ,1.5,.FALSE.,JAAARR,JAASYM,NUM,99)
      CALL WIFPOPPPP (590)




      CALL GVSMI2 (RINV,RMAT,3,IERR)
      IF (ABS(GVFDET(RINV)-1.0).GT.0.000001.OR.IERR.NE.0) THEN
         QUAFAC=0.0
         GOTO 998
      END IF



      CALL GVSMV3 (TINV,RINV,TVEC)
      TINV(1)=-TINV(1)
      TINV(2)=-TINV(2)
      TINV(3)=-TINV(3)
      CALL WIF092A (JAAARR,NUM,RMAT,TVEC)



      CALL WIFPUSHPPP (56,WIFPAR(56))
      CALL QUA036 (IAAQ,IATQ,QUAFAC)
      CALL WIFPOPPPP (56)



      CALL WIF092A (JAAARR,NUM,RINV,TINV)



 998  CONTINUE


      RETURN
      END
      SUBROUTINE QUA036 (IAAQ,IATQ,QUAFAC)























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'QUALTY.INC'
      INTEGER       IAAQ, IATQ, IAA, IATNOW, INDBOX, IAT, ICONT,
     +              NUM, JAAARR(100)
      REAL          QUAFAC, OLDQUA, WFACT, TFACT, TEMP, FLTMXQ
      LOGICAL       WIFROK, WIFIRA, GVFIBN
      CHARACTER*4   T4, CHAR4
      CHARACTER*23  DIF001, IAAS, IAAQS
      COMMON /QUANEI/ NUM, JAAARR







      DO 100 ICONT=1,NUM
         IAA=JAAARR(ICONT)
         IF (.NOT.GVFIBN(RESTYP(IAA),1,20)) GOTO 100



         IF (.NOT.WIFIRA(IAA)) GOTO 100
         IF (IAA.EQ.IAAQ) GOTO 100
         IF (.NOT.WIFROK(IAA)) GOTO 100



         CALL WIFRDS (IAAQ,IATQ,IAA,TFACT)



         OLDQUA=QUAFAC
         DO 90 IAT=PNTAAS(IAA),PNTAAE(IAA)
            IF (.NOT.ISATOK(IAT).OR.PROTON(IAT)) GOTO 90
            IF (TFACT.LT.0.0001) GOTO 90
            WFACT=TFACT
            IATNOW=PINIAA(IAT)
            IF (WIFPAR(284).NE.0.AND.IATNOW.LE.4.AND.
     +          ABS(IAAQ-IAA).LE.1) GOTO 90



            IF (XCOORD(IAT).LT.-7.0.OR.XCOORD(IAT).GT.7.0.OR.
     +          YCOORD(IAT).LT.-7.0.OR.YCOORD(IAT).GT.7.0.OR.
     +          ZCOORD(IAT).LT.-7.0.OR.ZCOORD(IAT).GT.7.0) GOTO 90



            CALL QUA018 (ONESA3(IAA),IATNOW,INDBOX)



            CV(1)=XCOORD(IAT)
            CV(2)=YCOORD(IAT)
            CV(3)=ZCOORD(IAT)
            CALL QUA040 (INDBOX,CV,TEMP)



            FLTMXQ=FLOAT(MAXQUA)/100.0
            QUAFAC=QUAFAC+WFACT*TEMP*FLTMXQ/1000.0



            IF (WIFPAR(280).GE.2) THEN
               CALL GVSCTB (LINE,80)
               CHAR4=T4(ONESAT(IAT))
               CALL GVSFMT ('?FMT1452')
               CALL GVSCTB (LINE,80)
               WRITE (LINE,FMT,ERR=999) INDBOX,CHAR4,TEMP,WFACT,FLTMXQ
               CALL GVSTT6 (LINE)
            END IF
   90    CONTINUE



         IF (WIFPAR(280).GE.1) THEN
            IAAQS=DIF001(IAAQ)
            IAAS=DIF001(IAA)
            CALL GVSFMT ('?FMT1453')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=999) IAAQS,IAAS,QUAFAC-OLDQUA
            CALL GVSTT6 (LINE)
         END IF
  100 CONTINUE
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('QUA036')



 998  CONTINUE


      RETURN
      END
      SUBROUTINE WIFRDS (IAAQ,IATQ,IAA,TFACT)



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INTEGER       IAAQ, IATQ, IAA, IATX, JATX
      REAL          TFACT, DISTM, CNOW, CTOT, DIST, WIFDST, FACTOR
      CHARACTER*4   T4, CHAR4I, CHAR4J







      DISTM=100000.0
      CNOW=0.0
      CTOT=0.0
      TFACT=0.0






      DO 100 IATX=PNTAAS(IAAQ),PNTAAE(IAAQ)
         IF (.NOT.ISATOK(IATX).OR.PROTON(IATX)) GOTO 100



         DO 90 JATX=PNTAAS(IAA),PNTAAE(IAA)
            IF (.NOT.ISATOK(JATX).OR.PROTON(JATX)) GOTO 90
            DIST=SQRT((XCOORD(IATX)-XCOORD(JATX))**2+
     +                (YCOORD(IATX)-YCOORD(JATX))**2+
     +                (ZCOORD(IATX)-ZCOORD(JATX))**2)



            DISTM=MIN((DIST-VDWRAD(IATX)-VDWRAD(JATX)),DISTM)
            IF (DIST.LT.0.0001) THEN
               CHAR4I=T4(ONESAT(IATX))
               CHAR4J=T4(ONESAT(JATX))
               CALL GVSTT6 ('?NEIBG4')
               CALL GVSFMT ('?FMT1180')
               CALL GVSCTB (LINE,80)
               WRITE (LINE,FMT,ERR=999) IAAQ,ONESA3(IAAQ),NUMNAM(IAAQ),
     +          CHAR4I,XCOORD(IATX),YCOORD(IATX),ZCOORD(IATX),IAA,
     +          ONESA3(IAA),NUMNAM(IAA),CHAR4J,XCOORD(JATX),
     +          YCOORD(JATX),ZCOORD(JATX),WIFDST(IATX,JATX)
               CALL SHOIAA (IAAQ)
               CALL SHOIAA (IAA)
               TFACT=0.0
               GOTO 998
            END IF



            CTOT=CTOT+1.0/DIST
            IF (IATX.EQ.IATQ) THEN
               DIST=MAX(1.0,DIST)
               CNOW=CNOW+1.0/DIST
            END IF

   90    CONTINUE
  100 CONTINUE



      IF (DISTM.GT.1.5) THEN
         TFACT=0.0
         GOTO 998
      ELSE IF (DISTM.LT.0.0) THEN
         TFACT=1.0
      ELSE
         TFACT=(1.5-DISTM)/1.5
      END IF



      IF (TFACT.LT.0.01) THEN
         FACTOR=1.0
      ELSE
         IF (CTOT.LT.0.01) THEN
            FACTOR=0.01
         ELSE
            FACTOR=CNOW/CTOT
         END IF
      END IF
      TFACT=TFACT*FACTOR
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('WIFRDS')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE QUA040 (INDBOX,QXYZ,QUAVAL)


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'QUALTY.INC'
      INTEGER       INDBOX, IX, IY, IZ
      LOGICAL       GVFIBN, GVFRIN
      REAL          QXYZ(3), XM, YM, ZM, DX, DY, DZ, DX2, DY2, DZ2,
     +              XG, YG, ZG, XMDX2, YMDY2, ZMDZ2, FU, REX2, QUAVAL







      IF ((.NOT.GVFRIN(QXYZ(1),-7.5,7.5)).OR.
     +    (.NOT.GVFRIN(QXYZ(2),-7.5,7.5)).OR.
     +    (.NOT.GVFRIN(QXYZ(3),-7.5,7.5))) THEN
         CALL GVSTTB ('?NEWB220')
         GOTO 998
      END IF
      IF (.NOT.GVFIBN(INDBOX,1,58)) THEN
         CALL GVSTTB ('?NEWB221')
         GOTO 998
      END IF




      XM=QXYZ(1)
      YM=QXYZ(2)
      ZM=QXYZ(3)
      REX2=(FLOAT(WIFPAR(283))/100.0)**2
      DX=1.0
      DY=1.0
      DZ=1.0
      DX2=DX**2
      DY2=DY**2
      DZ2=DZ**2
      IX=NINT((XM+7.5)/DX)
      IY=NINT((YM+7.5)/DY)
      IZ=NINT((ZM+7.5)/DZ)
      XG=-7.5+IX*DX
      YG=-7.5+IY*DY
      ZG=-7.5+IZ*DZ
      XMDX2=2*XM*DX
      YMDY2=2*YM*DY
      ZMDZ2=2*ZM*DZ



      FU=(XM-XG)**2+(YM-YG)**2+(ZM-ZG)**2
      IF (FU.GT.REX2) THEN
         CALL GVSTT6 ('?NEWT578')
      END IF
      QUAVAL=0.0
      IF (IX.GE.0.AND.IX.LE.15.AND.IY.GE.0.AND.IY.LE.15.AND.
     +    IZ.GE.0.AND.IZ.LE.15) THEN
         QUAVAL=QUAVAL+QUALBY(IX+1,IY+1,IZ+1,INDBOX)*
     +   NINT(50*(REX2-FU)/REX2)
      ELSE
         IF (WIFPAR(280).GE.2) CALL GVSTT6 ('?M5076')
         GOTO 998
      END IF



      CALL QUA041 (FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2,
     + QUALBY(1,1,1,INDBOX),QUAVAL)
      CALL QUA042 (FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2,
     + QUALBY(1,1,1,INDBOX),QUAVAL)
      CALL QUA043 (FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,DX,DY,
     + DX2,DY2,REX2,QUALBY(1,1,1,INDBOX),QUAVAL)
      CALL QUA044 (FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,DX,DY,
     + DX2,DY2,REX2,QUALBY(1,1,1,INDBOX),QUAVAL)
      CALL QUA045 (FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,DX,DY,DZ,
     + DX2,DY2,DZ2,REX2,QUALBY(1,1,1,INDBOX),QUAVAL)
      CALL QUA046 (FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,DX,DY,DZ,
     + DX2,DY2,DZ2,REX2,QUALBY(1,1,1,INDBOX),QUAVAL)



 998  CONTINUE


      RETURN
      END
      SUBROUTINE QUA041 (FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2,QUALBY,QUAVAL)









      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX, IQUATMP
      REAL          FU, XG, XMDX2, FFX, DX, DX2, REX2, QUAVAL, XR



         BYTE          QUALBY(16,16,16)






      FFX=FU-XMDX2+DX2+2*DX*XG
      XR=XG+DX
      IIX=IX+1
   10 CONTINUE
      IF (FFX.LT.REX2) THEN
         IF (IIX.GE.0.AND.IIX.LE.15.AND.IY.GE.0.AND.IY.LE.15.AND.
     +       IZ.GE.0.AND.IZ.LE.15) THEN
            IQUATMP=QUALBY(IIX+1,IY+1,IZ+1)
            QUAVAL=QUAVAL+FLOAT(IQUATMP)
         END IF
         FFX=FFX-XMDX2+DX2+2*DX*XR
         XR=XR+DX
         IIX=IIX+1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE QUA042 (FU,XG,IX,IY,IZ,XMDX2,DX,DX2,REX2,QUALBY,QUAVAL)









      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX, IQUATMP
      REAL          FU, XG, XMDX2, FFX, DX, DX2, REX2, QUAVAL, XR



         BYTE          QUALBY(16,16,16)






      FFX=FU+XMDX2+DX2-2*DX*XG
      XR=XG-DX
      IIX=IX-1
   10 CONTINUE
      IF (FFX.LT.REX2) THEN
         IF (IIX.GE.0.AND.IIX.LE.15.AND.IY.GE.0.AND.IY.LE.15.AND.
     +       IZ.GE.0.AND.IZ.LE.15) THEN
            IQUATMP=QUALBY(IIX+1,IY+1,IZ+1)
            QUAVAL=QUAVAL+FLOAT(IQUATMP)
         END IF
         FFX=FFX+XMDX2+DX2-2*DX*XR
         XR=XR-DX
         IIX=IIX-1
         GOTO 10
      END IF





      RETURN
      END
      SUBROUTINE QUA043 (FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,DX,DY,DX2,DY2,
     + REX2,QUALBY,QUAVAL)









      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX, I, IQUATMP
      REAL          FU, XG, YG, XMDX2, YMDY2, FFX, F,
     +              DX, DY, DX2, DY2, REX2, QUAVAL, XR, YR



         BYTE          QUALBY(16,16,16)

      LOGICAL       TWICE
      SAVE          F,YR,I





      F=FU-YMDY2+DY2+2*DY*YG
      YR=YG+DY
      I=IY+1
      TWICE=.FALSE.
   10 CONTINUE
      IF (F.LT.REX2) THEN
         IF (IX.GE.0.AND.IX.LE.15.AND.I.GE.0.AND.I.LE.15.AND.
     +       IZ.GE.0.AND.IZ.LE.15) THEN
            IQUATMP=QUALBY(IX+1,I+1,IZ+1)
            QUAVAL=QUAVAL+FLOAT(IQUATMP)
         END IF
      ELSE
         IF (TWICE) GOTO 998
         TWICE=.TRUE.
      END IF







      FFX=F-XMDX2+DX2+2*DX*XG
      XR=XG+DX
      IIX=IX+1
   20 CONTINUE
      IF (FFX.LT.REX2) THEN
         IF (IIX.GE.0.AND.IIX.LE.15.AND.I.GE.0.AND.I.LE.15.AND.
     +       IZ.GE.0.AND.IZ.LE.15) THEN
            IQUATMP=QUALBY(IIX+1,I+1,IZ+1)
            QUAVAL=QUAVAL+FLOAT(IQUATMP)
         END IF
         FFX=FFX-XMDX2+DX2+2*DX*XR
         XR=XR+DX
         IIX=IIX+1
         GOTO 20
      END IF







      FFX=F+XMDX2+DX2-2*DX*XG
      XR=XG-DX
      IIX=IX-1
   30 CONTINUE
      IF (FFX.LT.REX2) THEN
         IF (IIX.GE.0.AND.IIX.LE.15.AND.I.GE.0.AND.I.LE.15.AND.
     +       IZ.GE.0.AND.IZ.LE.15) THEN
            IQUATMP=QUALBY(IIX+1,I+1,IZ+1)
            QUAVAL=QUAVAL+FLOAT(IQUATMP)
         END IF
         FFX=FFX+XMDX2+DX2-2*DX*XR
         XR=XR-DX
         IIX=IIX-1
         GOTO 30
      END IF



      F=F-YMDY2+DY2+2*DY*YR
      YR=YR+DY
      I=I+1
      GOTO 10



 998  CONTINUE


      END
      SUBROUTINE QUA044 (FU,XG,YG,IX,IY,IZ,XMDX2,YMDY2,
     +    DX,DY,DX2,DY2,REX2,QUALBY,QUAVAL)









      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, IIX, I, IQUATMP
      REAL          FU, XG, YG, XMDX2, YMDY2, FFX, F,
     +              DX, DY, DX2, DY2, REX2, QUAVAL, XR, YR



      BYTE          QUALBY(16,16,16)

      LOGICAL       TWICE
      SAVE          F,YR,I





      F=FU+YMDY2+DY2-2*DY*YG
      YR=YG-DY
      I=IY-1
      TWICE=.FALSE.
   10 CONTINUE
      IF (F.LT.REX2) THEN
         IF (IX.GE.0.AND.IX.LE.15.AND.I.GE.0.AND.I.LE.15.AND.
     +       IZ.GE.0.AND.IZ.LE.15) THEN
            IQUATMP=QUALBY(IX+1,I+1,IZ+1)
            QUAVAL=QUAVAL+FLOAT(IQUATMP)
         END IF
      ELSE
         IF (TWICE) GOTO 998
         TWICE=.TRUE.
      END IF







      FFX=F-XMDX2+DX2+2*DX*XG
      XR=XG+DX
      IIX=IX+1
   20 CONTINUE
      IF (FFX.LT.REX2) THEN
         IF (IIX.GE.0.AND.IIX.LE.15.AND.I.GE.0.AND.I.LE.15.AND.
     +       IZ.GE.0.AND.IZ.LE.15) THEN
            IQUATMP=QUALBY(IIX+1,I+1,IZ+1)
            QUAVAL=QUAVAL+FLOAT(IQUATMP)
         END IF
         FFX=FFX-XMDX2+DX2+2*DX*XR
         XR=XR+DX
         IIX=IIX+1
         GOTO 20
      END IF







      FFX=F+XMDX2+DX2-2*DX*XG
      XR=XG-DX
      IIX=IX-1
   30 CONTINUE
      IF (FFX.LT.REX2) THEN
         IF (IIX.GE.0.AND.IIX.LE.15.AND.I.GE.0.AND.I.LE.15.AND.
     +       IZ.GE.0.AND.IZ.LE.15) THEN
            IQUATMP=QUALBY(IIX+1,I+1,IZ+1)
            QUAVAL=QUAVAL+FLOAT(IQUATMP)
         END IF
         FFX=FFX+XMDX2+DX2-2*DX*XR
         XR=XR-DX
         IIX=IIX-1
         GOTO 30
      END IF
      F=F+YMDY2+DY2-2*DY*YR
      YR=YR-DY
      I=I-1
      GOTO 10



 998  CONTINUE


      END
      SUBROUTINE QUA045 (FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2,QUALBY,QUAVAL)









      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, I, IQUATMP
      REAL          FU, XG, YG, ZG, XMDX2, YMDY2, ZMDZ2, F,
     +              DX, DY, DZ, DX2, DY2, DZ2, REX2, QUAVAL, ZR



      BYTE          QUALBY(16,16,16)

      LOGICAL       TWICE
      SAVE          F,ZR,I





      F=FU-ZMDZ2+DZ2+2*DZ*ZG
      ZR=ZG+DZ
      I=IZ+1
      TWICE=.FALSE.
   10 CONTINUE
      IF (F.LT.REX2) THEN
         IF (IX.GE.0.AND.IX.LE.15.AND.IY.GE.0.AND.IY.LE.15.AND.
     +       I.GE.0.AND.I.LE.15) THEN
            IQUATMP=QUALBY(IX+1,IY+1,I+1)
            QUAVAL=QUAVAL+FLOAT(IQUATMP)
         END IF
      ELSE
         IF (TWICE) GOTO 998
         TWICE=.TRUE.
      END IF




      CALL QUA041 (F,XG,IX,IY,I,XMDX2,DX,DX2,REX2,QUALBY,QUAVAL)
      CALL QUA042 (F,XG,IX,IY,I,XMDX2,DX,DX2,REX2,QUALBY,QUAVAL)
      CALL QUA043 (F,XG,YG,IX,IY,I,XMDX2,YMDY2,DX,DY,DX2,DY2,
     + REX2,QUALBY,QUAVAL)
      CALL QUA044 (F,XG,YG,IX,IY,I,XMDX2,YMDY2,DX,DY,DX2,DY2,
     + REX2,QUALBY,QUAVAL)
      F=F-ZMDZ2+DZ2+2*DZ*ZR
      ZR=ZR+DZ
      I=I+1
      GOTO 10



 998  CONTINUE


      END
      SUBROUTINE QUA046 (FU,XG,YG,ZG,IX,IY,IZ,XMDX2,YMDY2,ZMDZ2,
     +    DX,DY,DZ,DX2,DY2,DZ2,REX2,QUALBY,QUAVAL)









      IMPLICIT      NONE
      INTEGER       IX, IY, IZ, I, IQUATMP
      REAL          FU, XG, YG, ZG, XMDX2, YMDY2, ZMDZ2, F,
     +              DX, DY, DZ, DX2, DY2, DZ2, REX2, QUAVAL, ZR



      BYTE          QUALBY(16,16,16)

      LOGICAL       TWICE
      SAVE          F,ZR,I





      F=FU+ZMDZ2+DZ2-2*DZ*ZG
      ZR=ZG-DZ
      I=IZ-1
      TWICE=.FALSE.
   10 CONTINUE
      IF (F.LT.REX2) THEN
         IF (IX.GE.0.AND.IX.LE.15.AND.IY.GE.0.AND.IY.LE.15.AND.
     +       I.GE.0.AND.I.LE.15) THEN
            IQUATMP=QUALBY(IX+1,IY+1,I+1)
            QUAVAL=QUAVAL+FLOAT(IQUATMP)
         END IF
      ELSE
         IF (TWICE) GOTO 998
         TWICE=.TRUE.
      END IF




      CALL QUA041 (F,XG,IX,IY,I,XMDX2,DX,DX2,REX2,QUALBY,QUAVAL)
      CALL QUA042 (F,XG,IX,IY,I,XMDX2,DX,DX2,REX2,QUALBY,QUAVAL)
      CALL QUA043 (F,XG,YG,IX,IY,I,XMDX2,YMDY2,
     + DX,DY,DX2,DY2,REX2,QUALBY,QUAVAL)
      CALL QUA044 (F,XG,YG,IX,IY,I,XMDX2,YMDY2,
     + DX,DY,DX2,DY2,REX2,QUALBY,QUAVAL)
      F=F+ZMDZ2+DZ2-2*DZ*ZR
      ZR=ZR-DZ
      I=I-1
      GOTO 10



 998  CONTINUE


      END
      SUBROUTINE QUA047


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'QUALTY.INC'
      INTEGER       GVFPOS, I, J, K, L, IERR
      LOGICAL       GVFFOP, GVFISF







      CALL IPROMPT ('?NEWP187')
      CALL NEEDWORD (LINE,' ',IERR)
      IF (IERR.NE.0) THEN
         CALL GVSTT6 ('Error reading file name file name')
         GOTO 100
      END IF



      IF (.NOT.GVFISF(LINE)) THEN
         CALL GVSTT6 ('?NEWT340')
         CALL GVSTT6 (LINE)
         CALL GVSKIL
         GOTO 100
      END IF



      CALL GVSCLF (11)
      CALL GVSOPF (LINE,11,'OLD')
      IF (.NOT.GVFFOP(11)) THEN
         CALL GVSTTE ('?NEWE593')
         GOTO 100
      END IF



   20 CONTINUE
         CALL GVSCTB (LINE,80)
         READ (11,'(A80)',END=100,ERR=999) LINE
         CALL GVSTT6 (LINE)



         IF (.NOT.GVFISF(LINE)) THEN
            CALL GVSTT6 ('?NEWT340')
            CALL GVSTT6 (LINE)
            CALL GVSKIL
            GOTO 100
         END IF



         CALL GVSCLF (1)
         CALL GVSOUF (LINE,1,'OLD')
         IF (.NOT.GVFFOP(1)) THEN
            CALL GVSTTE ('?NEWE589')
            GOTO 100
         END IF



         READ (1,ERR=999,END=998) QUACID
         CALL GVST6C ('QUACID =',QUACID,.TRUE.)
         READ (1,ERR=999,END=998) QUATAG
         READ (1,ERR=999,END=998) QUAIAT
         READ (1,ERR=999,END=998) MAXQUA
         READ (1,ERR=999,END=998) QUALBL



         CALL GVSCLF (3)
         I=GVFPOS(LINE,'box')
         IF (I.EQ.0) THEN
            CALL GVSTT6 ('?NEWT581')
            GOTO 100
         END IF
         LINE(I:I+2)='fmt'
         CALL GVSDEL (LINE)
         CALL GVSOPF (LINE,3,'NEW')
         IF (.NOT.GVFFOP(3)) THEN
            CALL GVSTTE ('?NEWE595')
            GOTO 100
         END IF



         WRITE (3,'(A4)',ERR=999) QUACID
         WRITE (3,'(14I5)',ERR=999) QUATAG
         WRITE (3,'(3F10.5)',ERR=999) QUAIAT
         WRITE (3,'(I10)',ERR=999) MAXQUA
         WRITE (3,'(16I4)',ERR=999) ((((QUALBL(I,J,K,L),L=1,MXQUAT),
     +    K=1,MXQBSZ),J=1,MXQBSZ),I=1,MXQBSZ)
      GOTO 20



 999  CONTINUE
      CALL GVSEIR ('QUA047')
      GOTO 100



 998  CONTINUE
      CALL GVSTTE ('?NEWE591')



 100  CONTINUE
      CALL GVSCLF (1)
      CALL GVSCLF (3)
      CALL GVSCLF (11)


      RETURN
      END
      SUBROUTINE QUA048


















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'QUALTY.INC'
      INTEGER       GVFPOS, IERR, I, J, K, L
      LOGICAL       GVFFOP, GVFISF







      IF (.NOT.GVFISF('FILES.LIST')) THEN
         CALL GVSTT6 ('?M5077')
         CALL GVSKIL
         GOTO 100
      END IF



      CALL GETFILE (11,' ','FILES.LIST',IERR)
      IF (IERR.NE.0) GOTO 100
      CALL GVSTT6 ('?M5078')



   20 CONTINUE
         CALL GVSCTB (LINE,80)



         CALL GETLINE (11,LINE,IERR)
         IF (IERR.NE.0) GOTO 100
         CALL GVSTT6 (LINE)



         CALL GETFILE (1,' ',LINE,IERR)
         IF (IERR.NE.0) THEN
            CALL GVSTTE ('?NEWE599')
            GOTO 100
         END IF



         CALL GVSCLF (3)
         I=GVFPOS(LINE,'fmt')
         IF (I.EQ.0) THEN
            CALL GVSTT6 ('?NEWT581')
            GOTO 100
         END IF
         LINE(I:I+2)='new'
         CALL GVSOUF (LINE,3,'NEW')
         IF (.NOT.GVFFOP(3)) THEN
            CALL GVSTTE ('?NEWE600')
            GOTO 100
         END IF



         READ (1,'(A4)',ERR=997) QUACID
         READ (1,'(14I5)',ERR=997) QUATAG
         READ (1,'(3F10.5)',ERR=997) QUAIAT
         READ (1,'(I10)',ERR=997) MAXQUA
         READ (1,'(16I4)',ERR=999) ((((QUALBL(I,J,K,L),L=1,MXQUAT),
     +    K=1,MXQBSZ),J=1,MXQBSZ),I=1,MXQBSZ)



         WRITE (3,ERR=996) QUACID
         WRITE (3,ERR=996) QUATAG
         WRITE (3,ERR=996) QUAIAT
         WRITE (3,ERR=996) MAXQUA
         WRITE (3,ERR=996) QUALBL
      GOTO 20



  999 CONTINUE
      CALL GVSTTE ('?NEWE596')
      GOTO 100



  997 CONTINUE
      CALL GVSTTE ('?NEWE602')
      GOTO 100



  996 CONTINUE
      CALL GVSTTE ('?NEWE603')
      GOTO 100



  100 CONTINUE
      CALL GVSCLF (1)
      CALL GVSCLF (3)
      CALL GVSCLF (11)


      RETURN
      END
      SUBROUTINE QUA071

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INTEGER       ISOUP1, ISOUP2, ISOUP
      REAL          DROW(101), D1(3), D2(3), CEN1(3), CEN2(3), GVFDV3
      LOGICAL       WIFISA
      EQUIVALENCE   (DROW(1),ESPACE(1001))
      EQUIVALENCE   (D1(1),ESPACE(4001))
      EQUIVALENCE   (D2(1),ESPACE(4101))
      EQUIVALENCE   (CEN1(1),ESPACE(4201))
      EQUIVALENCE   (CEN2(1),ESPACE(4301))







      CALL ESPSET (1001,5000,30)



      IF (NUMSOU.LE.1) GOTO 998



      CALL SHOSOU
      CALL GVSTTI ('?NEWZ93',NUMSOU)



    4 CONTINUE
      DO 5 ISOUP=1,NUMSOU
         IF (.NOT.WIFISA(ISOUP).OR.SOUADM(3,ISOUP).LT.10) THEN
            CALL MOL101 (ISOUP)
            CALL MOL200
            GOTO 4
         END IF
    5 CONTINUE



   15 CONTINUE
      DO 20 ISOUP1=1,NUMSOU-1
         CALL WIFMMX (SOUADM(1,ISOUP1),SOUADM(2,ISOUP1),D1,D2,CEN1)



         DO 10 ISOUP2=ISOUP1+1,NUMSOU
            CALL WIFMMX (SOUADM(1,ISOUP2),SOUADM(2,ISOUP2),D1,D2,CEN2)



            IF (GVFDV3(CEN1,CEN2).LT.10.0) THEN
               CALL MOL101 (ISOUP2)
               CALL MOL200
               GOTO 15
            END IF
   10    CONTINUE
   20 CONTINUE



      CALL SHOSOU



 998  CONTINUE


      RETURN
      END
      SUBROUTINE QUA099



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'QUALTY.INC'
      INCLUDE       'ESPACE.INC'
      LOGICAL       GVFISF
      CHARACTER*80  FILNAM







      CALL GVSCCC (FILNAM,QUAFLC,'helix/val_side2.box')
      IF (.NOT.GVFISF(FILNAM)) THEN
         CALL GVST6C ('?M4597',FILNAM,.TRUE.)
         GOTO 999
      END IF
      CALL GVSCCC (FILNAM,QUAFLC,'rest/val_side2.box')
      IF (.NOT.GVFISF(FILNAM)) THEN
         CALL GVST6C ('?M4597',FILNAM,.TRUE.)
         GOTO 999
      END IF



      WIFPAR(931)=1
      GOTO 998



  999 CONTINUE
      WIFPAR(931)=0
      CALL GVSTT6 ('?R00208')



 998  CONTINUE


      RETURN
      END
