



      SUBROUTINE DSP000 (DONE)


















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







      IF (OPTIN.EQ.MEN6COD(94)) GOTO 998
      CALL MEN070 (OPTIN,DONE)
      IF (DONE) GOTO 998



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




  998 CONTINUE


      RETURN
      END
      SUBROUTINE DSP001 (PRINT)


























      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'IRIGRA.INC'
      INCLUDE       'PDBINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       ISOUP, I, IS, IE, J, IAA, LOCIAA, IADD, NCL, IERR,
     +              LINENR
      LOGICAL       WASIR6, GVFIBN, PRINT, HASPROTEIN, WIFISA, BIGIE
      CHARACTER*3   TEXSAV







      IF ((.NOT.PRINT).AND.HSTDON) GOTO 997
      IF (.NOT.HASPROTEIN()) GOTO 997




      WASIR6=IRSTAT(6).EQ.1
      IF (WASIR6.AND.USE300) CALL GRTKON
      TEXSAV=TEXLEVEL
      TEXLEVEL=' '



      IF (.NOT.HSTDON) THEN
         CALL DSP011
         IF (.NOT.PRINT.OR.WIFPAR(609).NE.0) GOTO 40
      END IF




      IADD=59



      LINENR=0
      IF (TEXSAV.NE.' ') WRITE (TEXUNT,1200,ERR=998)



      DO 30 ISOUP=1,NUMSOU
         IF (.NOT.WIFISA(ISOUP)) GOTO 30
         IF (LINENR.GT.10.AND.TEXSAV.NE.' ') THEN
            WRITE (TEXUNT,1210,ERR=998)
            WRITE (TEXUNT,1200,ERR=998)
            LINENR=0
         END IF
         DO 20 I=SOUADM(1,ISOUP),SOUADM(2,ISOUP),IADD+1



            LINENR=LINENR+1
            IS=I
            IE=MIN(I+IADD,SOUADM(2,ISOUP))
            IF (SOUADM(2,ISOUP)-IE.LE.4) THEN
               BIGIE=.TRUE.
               IE=SOUADM(2,ISOUP)
            ELSE
               BIGIE=.FALSE.
            END IF



            CALL GVSCTB (LINE,80)
            DO 5 IAA=IS,IE
               LOCIAA=IAA-IS+14
               IF (MOD(IAA,10).EQ.0) THEN
                  IF (GVFIBN(IAA,10,99)) THEN
                     CALL GVSFMT ('?FMT119')
                     WRITE (LINE(LOCIAA-1:LOCIAA),FMT,ERR=5) IAA
                  ELSE IF (GVFIBN(IAA,100,999)) THEN
                     CALL GVSFMT ('?FMT090')
                     WRITE (LINE(LOCIAA-2:LOCIAA),FMT,ERR=5) IAA
                  ELSE IF (GVFIBN(IAA,1000,9999)) THEN
                     CALL GVSFMT ('?FMT024')
                     WRITE (LINE(LOCIAA-3:LOCIAA),FMT,ERR=5) IAA
                  ELSE IF (GVFIBN(IAA,10000,99999)) THEN
                     CALL GVSFMT ('?FMT022')
                     WRITE (LINE(LOCIAA-4:LOCIAA),FMT,ERR=5) IAA
                  END IF
                  IF (TEXSAV.NE.' ') THEN
                     NCL=IAA-IS+1
                     IF (NCL.GT.13) NCL=10
                     IF (NCL.GT.3) THEN
                        IF (IAA.LT.IE) THEN
                           WRITE (TEXUNT,1220,ERR=998) NCL,IAA
                        ELSE
                           WRITE (TEXUNT,1221,ERR=998) NCL,IAA
                        END IF
                     END IF
                  END IF
               END IF
    5       CONTINUE
            CALL GVSTT6 (LINE)
            IF (TEXSAV.NE.' ') WRITE (TEXUNT,1230,ERR=998)



            CALL GVSCTB (LINE,80)
            DO 10 IAA=IS,IE
               LOCIAA=IAA-IS+14
               IF (MOD(IAA,10).EQ.0) LINE(LOCIAA:LOCIAA)='|'
   10       CONTINUE
            CALL GVSTT6 (LINE)



            CALL GVSFMT ('?FMT490')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=999) IS,IE,(A1NAME(RESTYP(J)),J=IS,IE)
            CALL GVSTT6 (LINE)
            IF (TEXSAV.NE.' ') THEN
               CALL GVSCTB (LINE,80)
               CALL GVSFMT ('?FMT493')
               WRITE (TEXUNT,FMT,ERR=998) (A1NAME(RESTYP(J)),J=IS,IE)
               WRITE (TEXUNT,1230,ERR=998)
            END IF



            CALL GVSFMT ('?FMT490B')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=999) NUMNAM(IS),NUMNAM(IE),
     +       (LOCHST(J),J=IS,IE)
            CALL GVSTT6 (LINE)
            IF (TEXSAV.NE.' ') THEN
               CALL GVSCTB (LINE,80)



               CALL GVSFMT ('?FMT493')
               IF (IS.EQ.IE.AND.LOCHST(IS).EQ.' ') THEN
                  WRITE (TEXUNT,FMT,ERR=998) '%'
               ELSE
                  WRITE (TEXUNT,FMT,ERR=998) (LOCHST(J),J=IS,IE)
               END IF
            END IF
            IF (TEXSAV.NE.' ') WRITE (TEXUNT,1230,ERR=998)
            IF (BIGIE) THEN
               CALL GVSNL6 (1)
               GOTO 30
            END IF
   20    CONTINUE
   30 CONTINUE
      IF (TEXSAV.NE.' ') WRITE (TEXUNT,1210,ERR=998)



   40 CONTINUE
      IF (PRINT.AND.WIFPAR(609).EQ.0) CALL GVSNL6 (3)
      IF (WASIR6.AND.USE300) CALL GRTKOF



      TEXLEVEL=TEXSAV



      CALL SETHSTTAB (IERR)
      GOTO 997



  998 CONTINUE
      CALL GVSTTE ('?M0103')
      GOTO 997
  999 CONTINUE
      CALL GVSTTE ('?DSPB01')



  997 CONTINUE









 1200   FORMAT ('\\fullpage{\\tt\\begin{tabular}{',65('r@{}'),'r}')
 1210   FORMAT ('\\end{tabular}}')
 1220   FORMAT ('\\multicolumn{',i2,'}{r@{}}{',i4,'}&')
 1221   FORMAT ('\\multicolumn{',i2,'}{r}{',i4,'}')
 1230   FORMAT ('\\\\')


      RETURN
      END

      SUBROUTINE DSP003




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       IAA







      CALL DSP001 (.FALSE.)



      DO 100 IAA=1,NUMAAF
         IF (LOCHST(IAA).EQ.'S') THEN
            LOCHST(IAA)='S'
         ELSE IF (LOCHST(IAA).EQ.'E') THEN
            LOCHST(IAA)='S'
         ELSE IF (LOCHST(IAA).EQ.'H') THEN
            LOCHST(IAA)='H'
         ELSE IF (LOCHST(IAA).EQ.'3') THEN
            LOCHST(IAA)='H'
         ELSE IF (LOCHST(IAA).EQ.'G') THEN
            LOCHST(IAA)='H'
         ELSE IF (LOCHST(IAA).EQ.'T') THEN
            LOCHST(IAA)=' '
         ELSE IF (LOCHST(IAA).EQ.' ') THEN
            LOCHST(IAA)=' '
         ELSE
            LOCHST(IAA)=' '
         END IF
 100  CONTINUE



      HSTDON=.FALSE.





      RETURN
      END
      SUBROUTINE DSP003A (ILHST)



















      IMPLICIT      NONE
      INCLUDE       'DATBAS.INC'
      INTEGER       ISEQ, IAA, ILHST(MAXADB,MAXSEQ)







      DO 20 ISEQ=1,NBINDB
         DO 30 IAA=1,NAAFIL(ISEQ)
            IF (ALLHST(IAA,ISEQ).EQ.'S') THEN
               ILHST(IAA,ISEQ)=1
            ELSE IF (ALLHST(IAA,ISEQ).EQ.'E') THEN
               ILHST(IAA,ISEQ)=1
            ELSE IF (ALLHST(IAA,ISEQ).EQ.'H') THEN
               ILHST(IAA,ISEQ)=2
            ELSE IF (ALLHST(IAA,ISEQ).EQ.'3') THEN
               ILHST(IAA,ISEQ)=2
            ELSE IF (ALLHST(IAA,ISEQ).EQ.'G') THEN
               ILHST(IAA,ISEQ)=2
            ELSE IF (ALLHST(IAA,ISEQ).EQ.'T') THEN
               ILHST(IAA,ISEQ)=3
            ELSE IF (ALLHST(IAA,ISEQ).EQ.' ') THEN
               ILHST(IAA,ISEQ)=3
            ELSE
               ILHST(IAA,ISEQ)=3
            END IF
   30    CONTINUE
   20 CONTINUE





      RETURN
      END
      SUBROUTINE DSP003B 

















      IMPLICIT      NONE
      INCLUDE       'DATBAS.INC'
      INTEGER       ISEQ, IAA







      DO 20 ISEQ=1,NBINDB



         DO 10 IAA=1,NAAFIL(ISEQ)



            IF (ALLHST(IAA,ISEQ).EQ.'3') THEN
               ALLHST(IAA,ISEQ)='H'
            ELSE IF (ALLHST(IAA,ISEQ).EQ.'T') THEN
               ALLHST(IAA,ISEQ)=' '
            END IF
   10    CONTINUE
   20 CONTINUE





      RETURN
      END

      SUBROUTINE DSP005

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       IAA







      DO 10 IAA=1,NUMAAF
         IF (LOCHST(IAA).EQ.'?') LOCHST(IAA)=' '
   10 CONTINUE





      RETURN
      END   
      CHARACTER*1 FUNCTION DSP006(IAA)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       IAA







      IF (.NOT.HSTDON) CALL DSP001 (.FALSE.)



      DSP006=LOCHST(IAA)





      RETURN
      END   

      SUBROUTINE DSP010



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'CHIANG.INC'
      INCLUDE       'CNTINC.INC'
      INCLUDE       'ENVIRO.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HB2INC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       IAA, IAT, JAT, JAA, ICON, BESTJ(MAXAA), 
     +              SAVUSE(MAXMOL)
      REAL          GVFRTD, BESTV(MAXAA), VAL, HBOQVAL
      LOGICAL       T54EQUAL








      IF (NUMAAF.LT.4) THEN
         CALL GVSTTE ('?DSPB03')
         GOTO 998
      END IF



      HSTDON=.TRUE.
      CALL GVSCTB (LOCHST,MAXAA)



      CALL WIFPUSHPPP (590,0)



      CALL HBO010



      CALL HB2INI9



      CALL HB2DAT



      CALL GVSCPI (SAVUSE,USESOU,MAXMOL)
      CALL ENVPROT



      CALL GVSIT0 (BESTJ,MAXAA)
      CALL GVSRT0 (BESTV,MAXAA)



      DO 10 IAA=1,NUMAAF
         IAT=PNTAAS(IAA)
         IF (ISATOK(IAT)) THEN
            CALL FCONAT (IAT,1.0)
            DO 12 ICON=1,NUMCONIAT
               JAT=CONIAT (ICON)
               IF (T54EQUAL(ONESAT(JAT),' O  ')) THEN
                  VAL=HBOQVAL(IAT,JAT,1)
                  IF (VAL.GT.BESTV(IAA)) THEN
                     JAA=ATIAA(JAT)
                     BESTJ(IAA)=JAA
                     BESTV(IAA)=VAL
                  END IF
               END IF
 12         CONTINUE
         END IF
 10   CONTINUE



      CALL WIFPOPPPP (590)
      CALL GVSCPI (USESOU,SAVUSE,MAXMOL)



      HB2IDN=.FALSE.



      DO 14 IAA=1,NUMAAF
         IF (BESTJ(IAA).GT.0) THEN
            JAA=BESTJ(BESTJ(IAA))
            IF (JAA.GT.0) THEN
               IF (CHAINN(2,IAA).EQ.CHAINN(2,JAA)) THEN
                  IF (IAA-JAA.EQ.2.OR.JAA-IAA.EQ.0) THEN
                     LOCHST(IAA)='S'
                     LOCHST(BESTJ(IAA))='S'
                     LOCHST(JAA)='S'
                  END IF
               END IF
            END IF
         END IF
         IF (BESTJ(IAA).EQ.IAA-3) THEN
            IF (IAA-3.GT.0) THEN
               IF (CHAINN(2,IAA).EQ.CHAINN(2,IAA-3)) THEN
                  LOCHST(IAA-3)='3'
                  LOCHST(IAA)='3'
               END IF
            END IF
         END IF
         IF (BESTJ(IAA).EQ.IAA-4) THEN
            IF (IAA-4.GT.0) THEN
               IF (CHAINN(2,IAA).EQ.CHAINN(2,IAA-4)) THEN
                  LOCHST(IAA-4)='H'
                  LOCHST(IAA)='H'
               END IF
            END IF
         END IF
 14   CONTINUE



      DO 20 IAA=2,NUMAAF-1
         IF (LOCHST(IAA).EQ.' '.AND.LOCHST(IAA-1).EQ.'S'.AND.
     +    LOCHST(IAA+1).EQ.'S') LOCHST(IAA)='S'
         IF (LOCHST(IAA).EQ.'3'.AND.LOCHST(IAA-1).EQ.'H'.AND.
     +    LOCHST(IAA+1).EQ.'H') LOCHST(IAA)='H'
 20   CONTINUE



      CALL CHI004



      DO 42 IAA=2,NUMAAF-1
         IF (GVFRTD(CHIANG(1,IAA)).GT.0.0) THEN
            IF (GVFRTD(CHIANG(2,IAA)).LT.120.0.AND.
     +           GVFRTD(CHIANG(2,IAA)).GT.-60.0) THEN
               LOCHST(IAA)='T'
            ELSE
               LOCHST(IAA)=' '
            END IF
         END IF
         IF (GVFRTD(CHIANG(2,IAA)).GT.15.0) THEN
            IF (LOCHST(IAA).EQ.'3'.OR.LOCHST(IAA).EQ.'H')
     +           LOCHST(IAA)='T'
         END IF
         IF (GVFRTD(CHIANG(2,IAA)).LT.90.0.AND.
     +        GVFRTD(CHIANG(2,IAA)).GT.-160.0) THEN
            IF (LOCHST(IAA).EQ.'S') LOCHST(IAA)=' '
         END IF
 42   CONTINUE



      WIFPAR(828)=2
      HSTDON=.TRUE.



  998 CONTINUE



      RETURN
      END
      SUBROUTINE DSP011



















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       ISOUP
      LOGICAL       GVFISF, WIFISA







      IF (NUMAAF.GT.9999) THEN
         CALL GVSTTE ('?M4484D')
         CALL DSP010
         GOTO 998
      END IF



      CALL GVSCTB (LOCHST,MAXAA)
      WIFPAR(828)=0



      CALL GVSCCC (LINE,FILDIR(3),'DSSP.EXE')
      IF (.NOT.GVFISF(LINE)) THEN
         CALL GVSTT6 ('?DSPB04')
         CALL GVSTT6 (LINE)
         CALL SHOWTEXT ('?DSPEMU')
         CALL DSP010
         GOTO 998
      END IF






      DO 20 ISOUP=1,NUMSOU
         IF (WIFISA(ISOUP)) THEN
            CALL DSP011A (SOUADM(1,ISOUP),SOUADM(2,ISOUP))
         END IF
 20   CONTINUE



      WIFPAR(828)=1



  998 CONTINUE
      HSTDON=.TRUE.


      RETURN
      END
      SUBROUTINE DSP011A (IFT1,IFT2)




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'HSTINC.INC'
      INCLUDE       'GRPINC.INC'
      INTEGER       IAA, IFT1,IFT2, ISCA, IERR, BBOK, FUTMEM(MAXAA)
      LOGICAL       WIFIRC, WIFIRK, GVFFOP, WIFIRA
      CHARACTER*1   FNDHST(MAXAA)
      CHARACTER*4   CHAR4, RESI
      CHARACTER*120 LOCLIN
      EQUIVALENCE   (FNDHST,ESPACE(10001+3*MAXAA))
      EQUIVALENCE   (FUTMEM(1),GRPNT2(1,1))







      ISCA=0
      BBOK=0



      CALL ESPSET (10001+3*MAXAA,10000+4*MAXAA,61)



      DO 5 IAA=IFT1,IFT2
         LOCHST(IAA)='?'
         IF (WIFIRC(IAA)) ISCA=ISCA+1
         IF (WIFIRK(IAA)) BBOK=BBOK+1
    5 CONTINUE
      IF (ISCA.GT.10) THEN
         CALL GVSTTE ('?DSPB05')
         GOTO 998
      END IF
      IF (IFT2-IFT1-ISCA.LT.5.OR.BBOK.EQ.0) THEN
         IF (WIFPAR(279).EQ.0) CALL SHOWTEXT ('?DSPNOK')
         GOTO 998
      END IF



      CALL WIFPUSHPPP (1020,1)
      IF (GVFFOP(57)) CALL GVSCLF (57)
      CALL MOL330 (57)
      CALL WIFPOPPPP (1020)



      DO 7 IAA=1,NUMAAF
         WRITE (NUMNAM(IAA),'(I4.0)',ERR=31) IAA+1000
    7 CONTINUE



      DO 8 IAA=IFT1,IFT2
         IF (WIFIRA(IAA).AND.RESTYP(IAA).GT.20) THEN
            NOBOND(IAA)=.TRUE.
            CALL WIF330 (IAA,1)
         END IF
 8    CONTINUE



      CALL GVSCLF (11)
      CALL GVSDEL ('?TAPEIN')
      CALL GVSDEL ('?TAPEOUT')



      CALL GVSBTF (WRK1TF,NUMAAT)
      DO 9 IAA=IFT1,IFT2
         WRK1TF(IAA)=WIFIRA(IAA)
 9    CONTINUE



      CALL GVSCTB (LOCLIN,80)
      CALL GVSCCC (LOCLIN,WHERIS,'DUMMY.HED')
      CALL WIFPUSHPPP (87,1)
      CALL WIFPUSHPPP (366,1)
      CALL WIFPUSHPPP (1820,1)
      CALL WIF508 (LOCLIN(1:80),'?TAPEIN',IFT1,IFT2)
      CALL WIFPOPPPP (1820)
      CALL WIFPOPPPP (366)
      CALL WIFPOPPPP (87)



      CALL GVSCCC (LOCLIN,FILDIR(3),'?M4733')
      CALL GVSSTX (LOCLIN(96:120),'?M4734')
      CALL GVSRDB (LOCLIN)
      CALL GVSSTX (LOCLIN(95:120),'?M4735')
      CALL GVSRDB (LOCLIN)
      CALL GVSSPL (LOCLIN)



      CALL GETFILE (11,' ','?TAPEOUT',IERR)
      IF (IERR.NE.0) GOTO 31



   10 CONTINUE
         CALL GVSFMT ('?FMT111')
         READ (11,FMT,END=31,ERR=31) LOCLIN
      IF (LOCLIN(4:10).NE.'  RESID') GOTO 10



      DO 30 IAA=IFT1,IFT2
   20    CONTINUE
         CALL GVSFMT ('?FMT111')
         READ (11,FMT,END=31,ERR=31) LOCLIN



         IF (LOCLIN(14:14).EQ.'!') GOTO 20



         CALL GVSSTX (CHAR4,LOCLIN(7:10))
         CALL GVSSHL (CHAR4)
         RESI=NUMNAM(IAA)
         CALL GVSSHL (RESI)
         IF (RESI.GT.CHAR4) THEN
            CALL GVSFMT ('?FMT488')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=31) CHAR4,IAA,ONESA3(IAA),NUMNAM(IAA)
            CALL GVSTO6 (LINE)
            GOTO 20
         END IF
         IF (RESI.LT.CHAR4) THEN
            CALL GVSFMT ('?FMT489')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=31) IAA,ONESA3(IAA),NUMNAM(IAA)
            CALL GVSTO6 (LINE)
            BACKSPACE 11
            GOTO 30
         END IF



         LOCHST(IAA)=LOCLIN(17:17)
         IF (WIFPAR(278).EQ.0) THEN
            IF (LOCHST(IAA).EQ.'L') LOCHST(IAA)='T'
            IF (LOCHST(IAA).EQ.'S') LOCHST(IAA)='T'
            IF (LOCHST(IAA).EQ.'C') LOCHST(IAA)='T'
            IF (LOCHST(IAA).EQ.'B') LOCHST(IAA)=' '
            IF (LOCHST(IAA).EQ.'E') LOCHST(IAA)='S'
            IF (LOCHST(IAA).EQ.'I') LOCHST(IAA)='H'
            IF (LOCHST(IAA).EQ.'G') LOCHST(IAA)='3'
         END IF
         FNDHST(IAA)=LOCHST(IAA)
 30   CONTINUE
 31   CONTINUE



      CALL GVSCPI (FUTMEM,FUTURE,NUMAAT)
      CALL MOL100
      CALL WIFPUSHPPP (1020,1)
      CALL MOL331 (57)
      CALL WIFPOPPPP (1020)
      CALL GVSCPI (FUTURE,FUTMEM,NUMAAT)



      DO 40 IAA=IFT1,IFT2
         LOCHST(IAA)=FNDHST(IAA)
 40   CONTINUE



 998  CONTINUE
      IF (GVFFOP(11)) CALL GVSCLF (11)


      RETURN
      END
      SUBROUTINE DSP012




















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       ISOUP
      LOGICAL       GVFISF, WIFISA







      CALL GVSCTB (LOCHST,MAXAA)



      CALL GVSCTB (LINE,80)
      CALL GVSCCC (LINE,FILDIR(3),'DSSP.EXE')
      IF (.NOT.GVFISF(LINE)) THEN
         CALL GVSTT6 ('?DSPB04')
         CALL GVSTT6 (LINE)
         CALL SHOWTEXT ('?DSPEMU')
         CALL DSP010
         GOTO 998
      END IF




      CALL WIFPUSHPPP (278,1)
      DO 10 ISOUP=1,NUMSOU
         IF (WIFISA(ISOUP)) THEN
            CALL DSP011A (SOUADM(1,ISOUP),SOUADM(2,ISOUP))
         END IF
   10 CONTINUE
      CALL WIFPOPPPP (278)



  998 CONTINUE
      HSTDON=.TRUE.


      RETURN
      END

      SUBROUTINE SETHSTTAB (IERR)

















      IMPLICIT      NONE
      INCLUDE       'BIGINC.INC'
      INCLUDE       'ESPACE.INC'
      INCLUDE       'GRPINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       IERR, IAA, JAA, IFRG, I
      CHARACTER*1   OLDHST(MAXAA)
      EQUIVALENCE   (OLDHST(1),GRPNT2(1,1))







      IERR=0
      NUMFRG=0
      CALL GVSIT0 (HSTTAB,4*MAXHST)
      IF (WIFPAR(621).NE.0) CALL DSP005
      DO 15 IAA=1,MAXAA
         OLDHST(IAA)=LOCHST(IAA)
   15 CONTINUE



      IAA=0
   10 CONTINUE
      IAA=IAA+1
      IF (IAA.LT.NUMAAF) THEN
         IF (LOCHST(IAA).NE.'H'.AND.LOCHST(IAA).NE.'3') GOTO 10



         JAA=IAA
   20    CONTINUE
         JAA=JAA+1
         IF ((LOCHST(JAA).EQ.'3'.OR.LOCHST(JAA).EQ.'H') .AND.
     +    JAA.LT.NUMAAF.AND.CHAINN(2,IAA).EQ.CHAINN(2,JAA)) GOTO 20
         IF (JAA.LT.NUMAAF) JAA=JAA-1
         IF (IAA.EQ.2) IAA=1
         IF (JAA.EQ.NUMAAF-1) IAA=NUMAAF



         CALL SETHSTTAB1 (IAA,JAA,4)
         IAA=JAA+1
         GOTO 10
      ENDIF



      IAA=0
   30 CONTINUE
      IAA=IAA+1
      IF (IAA.LT.NUMAAF) THEN
         IF (LOCHST(IAA).NE.'S') GOTO 30



         JAA=IAA
   40    CONTINUE
         JAA=JAA+1
         IF (LOCHST(JAA).EQ.'S'.AND.JAA.LT.NUMAAF.AND.
     +    CHAINN(2,IAA).EQ.CHAINN(2,JAA)) GOTO 40
         IF (JAA.LT.NUMAAF) JAA=JAA-1
         IF (JAA.EQ.NUMAAF-1) IAA=NUMAAF



         CALL SETHSTTAB1 (IAA,JAA,2)
         IAA=JAA+1
         GOTO 30
      END IF



      IAA=0
   50 CONTINUE
      IAA=IAA+1
      IF (IAA.LT.NUMAAF) THEN
         IF (LOCHST(IAA).NE.' '.AND.LOCHST(IAA).NE.'T') GOTO 50



         JAA=IAA
   60    CONTINUE
         JAA=JAA+1
         IF ((LOCHST(JAA).EQ.' '.OR.LOCHST(JAA).EQ.'T').AND.
     +    CHAINN(2,IAA).EQ.CHAINN(2,JAA).AND.JAA.LT.NUMAAF) GOTO 60
         IF (JAA.LT.NUMAAF) JAA=JAA-1



         CALL SETHSTTAB1 (IAA,JAA,6)
         IAA=JAA+1
         GOTO 50
      END IF



      IF (NUMFRG.LE.0) THEN
         IERR=1
         GOTO 998
      END IF



      DO 90 IAA=1,MAXAA
         LOCHST(IAA)=OLDHST(IAA)
   90 CONTINUE



      IF (WIFPAR(815).NE.0) THEN
         CALL GVSTTI ('?M4638',NUMFRG)
         DO 100 IFRG=1,NUMFRG
            IF (HSTTAB(3,IFRG).EQ.2) CALL GVSFMT ('?FMT309')
            IF (HSTTAB(3,IFRG).EQ.4) CALL GVSFMT ('?FMT310')
            IF (HSTTAB(3,IFRG).EQ.6) CALL GVSFMT ('?FMT311')
            CALL GVSCTB (LINE,80)
            WRITE (LINE,FMT,ERR=999) IFRG,(HSTTAB(I,IFRG),I=1,4)
            CALL GVSTT6 (LINE)
  100    CONTINUE
      END IF
      GOTO 998



  999 CONTINUE
      CALL GVSEIW ('HSTTAB')



  998 CONTINUE


      RETURN
      END
      SUBROUTINE SETHSTTAB1 (IAA,JAA,TYPE)



















      IMPLICIT      NONE 
      INCLUDE       'BIGINC.INC'
      INCLUDE       'HSTINC.INC'
      INTEGER       IAA, JAA, TYPE, IFRG







      IF (WIFPAR(1274).NE.0.AND.TYPE.NE.WIFPAR(1274)) GOTO 998
      IF (JAA-IAA.LE.0) GOTO 998
      IF (NUMFRG.GE.1) THEN
         DO 10 IFRG=1,NUMFRG
            IF (HSTTAB(1,IFRG).EQ.IAA.AND.HSTTAB(2,IFRG).EQ.JAA)GOTO 998
 10      CONTINUE
      END IF



      IF (NUMFRG.LT.MAXHST) THEN
         NUMFRG=NUMFRG+1
         HSTTAB(1,NUMFRG)=IAA
         HSTTAB(2,NUMFRG)=JAA
         HSTTAB(3,NUMFRG)=TYPE
         HSTTAB(4,NUMFRG)=JAA-IAA+1
      END IF



 998  CONTINUE


      RETURN
      END
      SUBROUTINE HSTRED

















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







      CALL SETHSTTAB (IERR)
      IF (NUMFRG.LE.1) GOTO 998



      IF (LOCHST(1).EQ.' '.AND.LOCHST(2).NE.' ') LOCHST(1)=LOCHST(2)
      IF (LOCHST(NUMAAF).EQ.' '.AND.LOCHST(NUMAAF-1).NE.' ') 
     + LOCHST(NUMAAF)=LOCHST(NUMAAF-1)
      CALL SETHSTTAB (IERR)



      DO 100 IFRG=1,NUMFRG
         IF (HSTTAB(3,IFRG).EQ.4.AND.HSTTAB(4,IFRG).LE.3) THEN
            DO 10 IAA=HSTTAB(1,IFRG),HSTTAB(2,IFRG)
               LOCHST(IAA)=' '
   10       CONTINUE
         ELSE IF (HSTTAB(3,IFRG).EQ.2.AND.HSTTAB(4,IFRG).LE.2) THEN
            DO 20 IAA=HSTTAB(1,IFRG),HSTTAB(2,IFRG)
               LOCHST(IAA)=' '
   20       CONTINUE
         END IF
  100 CONTINUE



      CALL SETHSTTAB (IERR)



  998 CONTINUE


      RETURN
      END   
