c ----------------------------------------------------------------------PS.F0001
c                                                                       PS.F0002
c  Windows NT / Win 95 code                                             PS.F0003
c                                                                       PS.F0004
c  Bernhard Rupp 1996 - minor modifications.                            PS.F0005
c                                                                       PS.F0006
c  1.  comment lines restricted to 72 columns                           PS.F0007
c  2.  source code lines numbered                                       PS.F0008
c  3.  to read file name of input file as parameter otherwise ask       PS.F0009
c  4.  taken apart into subroutines                                     PS.F0010
c                                                                       PS.F0011
c      Changes are annotated by WINNT at the beginning of comment lines PS.F0012
c                                                                       PS.F0013
C-----------------------------------------------------------------------PS.F0014
C                                                                       PS.F0015
C  PS.F    - PostScript subroutines                                     PS.F0016
C                                                                       PS.F0017
C            Written by Roman Laskowski, University College, London,    PS.F0018
C            November 1993.                                             PS.F0019
C                                                                       PS.F0020
C            Original version was part of v.3.0 of the PROCHECK suite   PS.F0021
C            of programs. (Previously the routines were incorporated in PS.F0022
C            pplot.f).                                                  PS.F0023
C                                                                       PS.F0024
C            Subsequent amendments will be labelled by CHECK v.m.n-->   PS.F0025
C            and CHECK v.m.n<-- where m.n is the version number         PS.F0026
C            corresponding to the change                                PS.F0027
C                                                                       PS.F0028
C  v.3.0.1 - Change of plot-file names. All plot-file names now have thePS.F0029
C            form: <filename>_nn.ps  where <filename> is the name of thePS.F0030
C            input data file, and nn is a sequential number 01, 02, ... PS.F0031
C            Roman Laskowski (29 Mar 1994)                              PS.F0032
C                                                                       PS.F0033
C  v.3.1   - Transfer of FINKEY, GETCOL and GETNAM routines used by the PS.F0034
C            plot programs to here. (Unit number of procheck.prm set to PS.F0035
C            10 to be consistent across the plot programs).             PS.F0036
C            Addition of part-circle and open-circle routines required  PS.F0037
C            by mplot.f.                                                PS.F0038
C            Addition of plot description to display of plot file name. PS.F0039
C            Roman Laskowski (8-19 Apr 1994)                            PS.F0040
C                                                                       PS.F0041
C  v.3.2   - Addition of identifying plot handle to each plot filename. PS.F0042
C            Addition of descriptive plot title to header of PostScript PS.F0043
C            file.                                                      PS.F0044
C            Addition of OPESUM routine to open the .sum summary file.  PS.F0045
C            Addition of (optional) name of PostScript file to bottom   PS.F0046
C            left-hand corner of the page for ease of reference.        PS.F0047
C            Addition of Shell-sort routine, SHSORT.                    PS.F0048
C            Roman Laskowski (22 Apr-3 May 1994)                        PS.F0049
C            Amendments to PSOPEN and PSCLOS routines, plus addition of PS.F0050
C            PSPAGE and PSENDP routines, to allow several pages to be   PS.F0051
C            written into the same PostScript file.                     PS.F0052
C            Roman Laskowski (11-18 Oct 1994)                           PS.F0053
C                                                                       PS.F0054
C  v.3.3.2 - Addition of OPEHTM routine to open the .html summary file. PS.F0055
C            Roman Laskowski (21 Aug 1995)                              PS.F0056
C  v.3.4   - Addition of footnote in PSPAGE for residue-range selection.PS.F0057
C            Roman Laskowski (25 Mar 1996)                              PS.F0058
C            Bug-fix for uncentered rotated text print.                 PS.F0059
C            Roman Laskowski (27 Mar 1996)                              PS.F0060
C            Addition of INSORT routine, being an integer version of    PS.F0061
C            SHSORT for sorting arrays of integers. Inclusion of funct. PS.F0062
C            LENSTR and subroutine ADJLIM.                              PS.F0063
C            Roman Laskowski (29 Mar 1996)                              PS.F0064
C            Addition of range-file reading and processing routines,    PS.F0065
C            GETRNG, GETOKN, INTOKN, DELTOKN, STOTOK, PRNRNG, GETWNT,   PS.F0066
C            INMODL and INRANG                                          PS.F0067
C            Roman Laskowski ( 2 Apr 1996)                              PS.F0068
C            Addition of other common plotting routines:- PINRNO, PINTICPS.F0069
C            and DHELIX.                                                PS.F0070
C            Roman Laskowski (10 Apr 1996)                              PS.F0071
C            Amendment to PostScript header routines to plot only those PS.F0072
C            colours that have been defined.                            PS.F0073
C            Removal of unused variables.                               PS.F0074
C            Roman Laskowski (25 Apr 1996)                              PS.F0075
C            Bug-fixes suggested by Dave Love (routine PSMERK removed asPS.F0076
C            never used), and Adam.                                     PS.F0077
C            Change to output PostScript filenames to deal with cases   PS.F0078
C            where over 99 files generated (eg 1HBS and 2GLS - pointed  PS.F0079
C            out by Gerard Kleywegt).                                   PS.F0080
C            Roman Laskowski (26 Apr 1996)                              PS.F0081
C                                                                       PS.F0082
C-----------------------------------------------------------------------PS.F0083
                                                                        PS.F0084
      SUBROUTINE PSNAME(FILPS,PSLEN,IPLOT,PLDESC,PLHAND,WITHAN)         PSNA0001
C-----------------------------------------------------------------------PSNA0002
C                                                                       PSNA0003
C  SUBROUTINE PSNAME  -  Determine file name for next PostScript file   PSNA0004
C                                                                       PSNA0005
C----------------------------------------------------------------------+PSNA0006
                                                                        PSNA0007
CHECK v.3.1-->                                                          PSNA0008
C      SUBROUTINE PSNAME(FILPS,PSLEN,IPLOT)                             PSNA0009
CHECK v.3.2-->                                                          PSNA0010
C      SUBROUTINE PSNAME(FILPS,PSLEN,IPLOT,PLDESC)                      PSNA0011
CHECK v.3.2<--                                                          PSNA0012
CHECK v.3.1<--                                                          PSNA0013
                                                                        PSNA0014
CHECK v.3.4-->                                                          PSNA0015
C      CHARACTER*2    CPLOT                                             PSNA0016
      CHARACTER*3    CPLOT                                              PSNA0017
CHECK v.3.4<--                                                          PSNA0018
CHECK v.3.2-->                                                          PSNA0019
      CHARACTER*9    PLHAND                                             PSNA0020
CHECK v.3.2<--                                                          PSNA0021
CHECK v.3.1-->                                                          PSNA0022
      CHARACTER*30   PLDESC                                             PSNA0023
CHECK v.3.1<--                                                          PSNA0024
      CHARACTER*(*)  FILPS                                              PSNA0025
CHECK v.3.2-->                                                          PSNA0026
C      INTEGER        IPLOT, PSLEN                                      PSNA0027
CHECK v.3.4-->                                                          PSNA0028
C      INTEGER        EXTLEN, IPLOT, PSLEN                              PSNA0029
      INTEGER        EXTLEN, IPLOT, NLEN, PSLEN                         PSNA0030
CHECK v.3.4<--                                                          PSNA0031
      LOGICAL        WITHAN                                             PSNA0032
CHECK v.3.2<--                                                          PSNA0033
                                                                        PSNA0034
C---- Increment plot-number                                             PSNA0035
      IPLOT = IPLOT + 1                                                 PSNA0036
CHECK v.3.4-->                                                          PSNA0037
C      IF (IPLOT.GT.99) IPLOT = IPLOT - 100                             PSNA0038
C      WRITE(CPLOT,100) IPLOT                                           PSNA0039
C 100  FORMAT(I2)                                                       PSNA0040
C      IF (CPLOT(1:1).EQ.' ') CPLOT(1:1) = '0'                          PSNA0041
      IF (IPLOT.LT.100) THEN                                            PSNA0042
          WRITE(CPLOT,100) IPLOT                                        PSNA0043
 100      FORMAT(I2)                                                    PSNA0044
          IF (CPLOT(1:1).EQ.' ') CPLOT(1:1) = '0'                       PSNA0045
          NLEN = 2                                                      PSNA0046
      ELSE                                                              PSNA0047
          WRITE(CPLOT,120) IPLOT                                        PSNA0048
 120      FORMAT(I3)                                                    PSNA0049
          NLEN = 3                                                      PSNA0050
      ENDIF                                                             PSNA0051
CHECK v.3.4<--                                                          PSNA0052
                                                                        PSNA0053
C---- Form plot filename                                                PSNA0054
CHECK v.3.0.1-->                                                        PSNA0055
C      FILPS = FILPS(1:PSLEN) // '.d' // CPLOT                          PSNA0056
C      PRINT*, '* Plotfile: ', FILPS(1:PSLEN + 4)                       PSNA0057
CHECK v.3.2-->                                                          PSNA0058
C      FILPS = FILPS(1:PSLEN) // '_' // CPLOT // '.ps'                  PSNA0059
      IF (WITHAN) THEN                                                  PSNA0060
CHECK v.3.4-->                                                          PSNA0061
C          FILPS = FILPS(1:PSLEN) // '_' // CPLOT // '_' //             PSNA0062
          FILPS = FILPS(1:PSLEN) // '_' // CPLOT(1:NLEN) // '_' //      PSNA0063
CHECK v.3.4<--                                                          PSNA0064
     &        PLHAND // '.ps'                                           PSNA0065
CHECK v.3.4-->                                                          PSNA0066
C          EXTLEN = 16                                                  PSNA0067
          EXTLEN = 14 + NLEN                                            PSNA0068
CHECK v.3.4<--                                                          PSNA0069
      ELSE                                                              PSNA0070
CHECK v.3.4-->                                                          PSNA0071
C          FILPS = FILPS(1:PSLEN) // '_' // CPLOT // '.ps'              PSNA0072
          FILPS = FILPS(1:PSLEN) // '_' // CPLOT(1:NLEN) // '.ps'       PSNA0073
CHECK v.3.4<--                                                          PSNA0074
CHECK v.3.4-->                                                          PSNA0075
C          EXTLEN = 6                                                   PSNA0076
          EXTLEN = 4 + NLEN                                             PSNA0077
CHECK v.3.4<--                                                          PSNA0078
      ENDIF                                                             PSNA0079
CHECK v.3.2<--                                                          PSNA0080
CHECK v.3.1-->                                                          PSNA0081
C      PRINT*, '* Plotfile: ', FILPS(1:PSLEN + 6)                       PSNA0082
CHECK v.3.2-->                                                          PSNA0083
C      PRINT*, PLDESC, '  * Plotfile: ', FILPS(1:PSLEN + 6)             PSNA0084
      PRINT*, PLDESC, '  * File: ', FILPS(1:PSLEN + EXTLEN)             PSNA0085
CHECK v.3.2<--                                                          PSNA0086
CHECK v.3.1<--                                                          PSNA0087
CHECK v.3.0.1<--                                                        PSNA0088
                                                                        PSNA0089
      RETURN                                                            PSNA0090
      END                                                               PSNA0091
                                                                        PSNA0092
      SUBROUTINE PSOPEN(FNAME,MXCOLR,RGB,NCOLOR,INCOL,PTITLE,PAGE)      PSOP0001
C-----------------------------------------------------------------------PSOP0002
C                                                                       PSOP0003
C  SUBROUTINE PSOPEN  -  Open PostScript file and write out header recorPSOP0004
C                                                                       PSOP0005
C----------------------------------------------------------------------+PSOP0006
                                                                        PSOP0007
CHECK v.3.2-->                                                          PSOP0008
C      SUBROUTINE PSOPEN(FNAME,BBOXX1,BBOXX2,BBOXY1,BBOXY2,MXCOLR,RGB,  PSOP0009
C     -    INCOL,BAKCOL)                                                PSOP0010
CHECK v.3.4-->                                                          PSOP0011
C      SUBROUTINE PSOPEN(FNAME,MXCOLR,RGB,INCOL,PTITLE,PAGE)            PSOP0012
CHECK v.3.4<--                                                          PSOP0013
CHECK v.3.2<--                                                          PSOP0014
                                                                        PSOP0015
      CHARACTER*(*)  FNAME                                              PSOP0016
      CHARACTER*2    COLNO                                              PSOP0017
CHECK v.3.2-->                                                          PSOP0018
      CHARACTER*60   PTITLE                                             PSOP0019
CHECK v.3.2<--                                                          PSOP0020
CHECK v.3.2-->                                                          PSOP0021
C      INTEGER        BAKCOL, BBOXX1, BBOXX2, BBOXY1, BBOXY2, I, ICOL,  PSOP0022
C     -               MXCOLR                                            PSOP0023
CHECK v.3.4-->                                                          PSOP0024
C      INTEGER        I, ICOL, MXCOLR, PAGE, TITLEN                     PSOP0025
      INTEGER        I, ICOL, MXCOLR, NCOLOR, PAGE, TITLEN              PSOP0026
CHECK v.3.4<--                                                          PSOP0027
CHECK v.3.2<--                                                          PSOP0028
      LOGICAL        INCOL                                              PSOP0029
      REAL           RGB(3,MXCOLR)                                      PSOP0030
                                                                        PSOP0031
C---- Open output file                                                  PSOP0032
      OPEN(UNIT=11, FILE=FNAME, STATUS='UNKNOWN',                       PSOP0033
     &     FORM='FORMATTED', ACCESS='SEQUENTIAL',                       PSOP0034
CVAX     -     CARRIAGECONTROL = 'LIST',                                PSOP0035
     &     ERR=900)                                                     PSOP0036
                                                                        PSOP0037
CHECK v.3.2-->                                                          PSOP0038
C---- Determine the title length                                        PSOP0039
      TITLEN = 61                                                       PSOP0040
 5    CONTINUE                                                          PSOP0041
          TITLEN = TITLEN - 1                                           PSOP0042
      IF (PTITLE(TITLEN:TITLEN).EQ.' ' .AND. TITLEN.GT.1) GO TO 5       PSOP0043
CHECK v.3.2<--                                                          PSOP0044
                                                                        PSOP0045
C---- Write out headings to PostScript file                             PSOP0046
CHECK v.3.2-->                                                          PSOP0047
C      WRITE(11,10)                                                     PSOP0048
      WRITE(11,10) PTITLE(1:TITLEN), PAGE                               PSOP0049
CHECK v.3.2<--                                                          PSOP0050
 10   FORMAT(                                                           PSOP0051
     &    '%!PS-Adobe-3.0',/,                                           PSOP0052
     &    '%%Creator: Procheck',/,                                      PSOP0053
     &    '%%DocumentNeededResources: font Times-Roman Symbol',/,       PSOP0054
     &    '%%BoundingBox: (atend)',/,                                   PSOP0055
     &    '%%Pages: 1',/,                                               PSOP0056
CHECK v.3.2-->                                                          PSOP0057
     &    '%%Title: ',A,', page ',I2,/,                                 PSOP0058
CHECK v.3.2<--                                                          PSOP0059
     &    '%%EndComments',/,                                            PSOP0060
     &    '%%BeginProlog')                                              PSOP0061
      WRITE(11,20)                                                      PSOP0062
 20   FORMAT(                                                           PSOP0063
     &    '/L { moveto lineto stroke } bind def',/,                     PSOP0064
     &    '/Col { setrgbcolor } bind def')                              PSOP0065
                                                                        PSOP0066
C---- Loop to define the colours                                        PSOP0067
      IF (INCOL) THEN                                                   PSOP0068
CHECK v.3.4-->                                                          PSOP0069
C          DO 100, ICOL = 1, MXCOLR                                     PSOP0070
          DO 100, ICOL = 1, NCOLOR                                      PSOP0071
CHECK v.3.4<--                                                          PSOP0072
              WRITE(COLNO,40) ICOL                                      PSOP0073
 40           FORMAT(I2.0)                                              PSOP0074
              IF (COLNO(1:1).EQ.' ') COLNO(1:1) = '0'                   PSOP0075
              WRITE(11,60) COLNO, (RGB(I,ICOL), I = 1, 3)               PSOP0076
 60           FORMAT('/Col',A2,' {gsave ',3F8.4,' setrgbcolor } def')   PSOP0077
 100      CONTINUE                                                      PSOP0078
      ENDIF                                                             PSOP0079
                                                                        PSOP0080
C---- Define commands for boxes, circles, etc.                          PSOP0081
      WRITE(11,120)                                                     PSOP0082
 120  FORMAT(                                                           PSOP0083
     &    '/Poly3 { moveto lineto lineto fill grestore } bind ',        PSOP0084
     &    'def',/,                                                      PSOP0085
     &    '/Pl3 { 6 copy Poly3 moveto moveto moveto closepath ',        PSOP0086
     &    'stroke } bind def',/,                                        PSOP0087
     &    '/Pline3 { 6 copy Poly3 moveto lineto lineto closepa',        PSOP0088
     &    'th stroke } bind def')                                       PSOP0089
      WRITE(11,250)                                                     PSOP0090
 250  FORMAT(                                                           PSOP0091
     &    '/Poly4 { moveto lineto lineto lineto fill grestore } bind ', PSOP0092
     &    'def',/,                                                      PSOP0093
     &    '/Pl4 { 8 copy Poly4 moveto moveto moveto moveto closepath ', PSOP0094
     &    'stroke } bind def',/,                                        PSOP0095
     &    '/Pline4 { 8 copy Poly4 moveto lineto lineto lineto closepa', PSOP0096
     &    'th stroke } bind def',/,                                     PSOP0097
CHECK v.3.1-->                                                          PSOP0098
C     -    '/Circle { gsave newpath 0.0 setgray 3 copy 0 360 arc fill ',PSOP0099
C     -    'stroke grestore }',/                                        PSOP0100
C     -    'bind def')                                                  PSOP0101
     &    '/Circol { 1 setgray } def',/,                                PSOP0102
     &    '/Circle { gsave newpath 0 360 arc gsave Circol fill',        PSOP0103
     &    ' grestore stroke grestore }',/                               PSOP0104
     &    ' bind def',/,                                                PSOP0105
     &    '/Ocircle { gsave newpath 0 360 arc stroke grestore } bind d',PSOP0106
     &    'ef',/,                                                       PSOP0107
     &     '/PC { moveto arc gsave Circol fill grestore } bind def',/,  PSOP0108
     &     '/Pcircle { 7 copy PC moveto arc closepath stroke } bind ',  PSOP0109
     &     'def')                                                       PSOP0110
CHECK v.3.1<--                                                          PSOP0111
      WRITE(11,300)                                                     PSOP0112
 300  FORMAT(                                                           PSOP0113
     &    '/Print { /Times-Roman findfont exch scalefont setfont show', PSOP0114
     &    ' } bind def',/,                                              PSOP0115
     &    '/Gprint { /Symbol findfont exch scalefont setfont show } b', PSOP0116
     &    'ind def',/,                                                  PSOP0117
     &    '/Center {',/,                                                PSOP0118
     &    '  dup /Times-Roman findfont exch scalefont setfont',/,       PSOP0119
     &    '  exch stringwidth pop -2 div exch -3 div rmoveto',/,        PSOP0120
CHECK v.3.4-->                                                          PSOP0121
C     -    ' } bind def',/,                                             PSOP0122
     &    ' } bind def')                                                PSOP0123
      WRITE(11,350)                                                     PSOP0124
 350  FORMAT(                                                           PSOP0125
CHECK v.3.4<--                                                          PSOP0126
     &    '/CenterRot90 {',/,                                           PSOP0127
     &    '  dup /Times-Roman findfont exch scalefont setfont',/,       PSOP0128
     &    '  exch stringwidth pop -2 div exch 3 div exch rmoveto',/,    PSOP0129
     &    ' } bind def',/,                                              PSOP0130
     &    '/UncenterRot90 {',/,                                         PSOP0131
     &    '  dup /Times-Roman findfont exch scalefont setfont',/,       PSOP0132
     &    '  exch stringwidth } bind def',/,                            PSOP0133
     &    '/Rot90 { gsave currentpoint translate 90 rotate } bind def',/PSOP0134
     &    '%%EndProlog')                                                PSOP0135
      WRITE(11,400)                                                     PSOP0136
 400  FORMAT(                                                           PSOP0137
     &    '%%BeginSetup',/,                                             PSOP0138
     &    '1 setlinecap 1 setlinejoin 1 setlinewidth 0 setgray [ ] 0 ', PSOP0139
     &    'setdash newpath',/,                                          PSOP0140
CHECK v.3.2-->                                                          PSOP0141
C     -    '%%EndSetup',/,                                              PSOP0142
C     -    '%%Page: 1 1 ')                                              PSOP0143
     &    '%%EndSetup')                                                 PSOP0144
CHECK v.3.2<--                                                          PSOP0145
                                                                        PSOP0146
CHECK v.3.2-->                                                          PSOP0147
C      WRITE(11,500) REAL(BBOXX1), REAL(BBOXY1), REAL(BBOXX2),          PSOP0148
C     -     REAL(BBOXY1), REAL(BBOXX2), REAL(BBOXY2), REAL(BBOXX1),     PSOP0149
C     -     REAL(BBOXY2)                                                PSOP0150
C 500  FORMAT(                                                          PSOP0151
C     -    '/ProcheckSave save def',/,                                  PSOP0152
C     -    2F6.2,' moveto',2(2F7.2,' lineto'),/,                        PSOP0153
C     -    2F7.2,' lineto closepath gsave',/,                           PSOP0154
C     -    'gsave 1.0000 setgray fill grestore',/,                      PSOP0155
C     -    'clip newpath')                                              PSOP0156
C                                                                       PSOP0157
CC---- Draw in the background colour                                    PSOP0158
C      IF (INCOL) THEN                                                  PSOP0159
C          CALL PSHADE(0.0,BAKCOL,RGB,MXCOLR,INCOL)                     PSOP0160
C          CALL PSUBOX(REAL(BBOXX1), REAL(BBOXY1), REAL(BBOXX2),        PSOP0161
C     -        REAL(BBOXY1), REAL(BBOXX2), REAL(BBOXY2), REAL(BBOXX1),  PSOP0162
C     -        REAL(BBOXY2))                                            PSOP0163
C      ENDIF                                                            PSOP0164
CHECK v.3.2<--                                                          PSOP0165
                                                                        PSOP0166
      GO TO 999                                                         PSOP0167
                                                                        PSOP0168
C---- Errors on parameter file                                          PSOP0169
 900  CONTINUE                                                          PSOP0170
      PRINT*, '**** WARNING. Unable to open Postscript file'            PSOP0171
      GO TO 999                                                         PSOP0172
                                                                        PSOP0173
 999  CONTINUE                                                          PSOP0174
      RETURN                                                            PSOP0175
      END                                                               PSOP0176
                                                                        PSOP0177
      SUBROUTINE PSPAGE(FNAME,BBOXX1,BBOXX2,BBOXY1,BBOXY2,MXCOLR,RGB,   PSPA0001
C-----------------------------------------------------------------------PSPA0002
C                                                                       PSPA0003
C  SUBROUTINE PSPAGE  -  Write out records for the start of a new       PSPA0004
C                        PostScript page                                PSPA0005
C                                                                       PSPA0006
C----------------------------------------------------------------------+PSPA0007
                                                                        PSPA0008
CHECK v.3.4-->                                                          PSPA0009
C     -    INCOL,BAKCOL,PAGE,PLABEL)                                    PSPA0010
     &    INCOL,BAKCOL,PAGE,PLABEL,RSELEC)                              PSPA0011
CHECK v.3.4<--                                                          PSPA0012
                                                                        PSPA0013
      CHARACTER*(*)  FNAME                                              PSPA0014
      INTEGER        BAKCOL, BBOXX1, BBOXX2, BBOXY1, BBOXY2, MXCOLR,    PSPA0015
     &               NLEN, PAGE                                         PSPA0016
CHECK v.3.4-->                                                          PSPA0017
C      LOGICAL        INCOL, PLABEL                                     PSPA0018
      LOGICAL        INCOL, PLABEL, RSELEC                              PSPA0019
CHECK v.3.4<--                                                          PSPA0020
      REAL           RGB(3,MXCOLR)                                      PSPA0021
                                                                        PSPA0022
C---- Write out page-number                                             PSPA0023
      WRITE(11,400) PAGE, PAGE                                          PSPA0024
 400  FORMAT('%%Page: ',2I4)                                            PSPA0025
                                                                        PSPA0026
C---- Draw the border around the plot area                              PSPA0027
      WRITE(11,500) REAL(BBOXX1), REAL(BBOXY1), REAL(BBOXX2),           PSPA0028
     &     REAL(BBOXY1), REAL(BBOXX2), REAL(BBOXY2), REAL(BBOXX1),      PSPA0029
     &     REAL(BBOXY2)                                                 PSPA0030
 500  FORMAT(                                                           PSPA0031
     &    '/ProcheckSave save def',/,                                   PSPA0032
     &    2F6.2,' moveto',2(2F7.2,' lineto'),/,                         PSPA0033
     &    2F7.2,' lineto closepath',/,                                  PSPA0034
     &    '  gsave 1.0000 setgray fill grestore',/,                     PSPA0035
     &    '  stroke gsave')                                             PSPA0036
                                                                        PSPA0037
C---- If required, write the name of this PostScript file in the bottom PSPA0038
C     left-hand corner of the page for reference                        PSPA0039
      IF (PLABEL) THEN                                                  PSPA0040
          NLEN = INDEX(FNAME,' ') - 1                                   PSPA0041
          WRITE(11,450) REAL(BBOXX1), REAL(BBOXY1 - 10), FNAME(1:NLEN), PSPA0042
     &        10.0                                                      PSPA0043
 450      FORMAT(2F5.1,' moveto',/,'(',A,')',/,F4.1,' Print')           PSPA0044
      ENDIF                                                             PSPA0045
                                                                        PSPA0046
C---- If plot covers only a selected subset of residues, then show footnPSPA0047
C     in bottom right of plot                                           PSPA0048
      IF (RSELEC) THEN                                                  PSPA0049
          WRITE(11,480) REAL(BBOXX2 - 108), REAL(BBOXY1 - 10),          PSPA0050
     &        '** Selected residues only', 10.0                         PSPA0051
 480      FORMAT(2F5.1,' moveto',/,'(',A,')',/,F4.1,' Print')           PSPA0052
      ENDIF                                                             PSPA0053
                                                                        PSPA0054
C---- Draw in the background colour if required                         PSPA0055
      IF (INCOL) THEN                                                   PSPA0056
          CALL PSHADE(0.0,BAKCOL,RGB,MXCOLR,INCOL)                      PSPA0057
          CALL PSBBOX(REAL(BBOXX1), REAL(BBOXY1), REAL(BBOXX2),         PSPA0058
     &        REAL(BBOXY1), REAL(BBOXX2), REAL(BBOXY2), REAL(BBOXX1),   PSPA0059
     &        REAL(BBOXY2))                                             PSPA0060
      ENDIF                                                             PSPA0061
      CALL PSLWID(0.1)                                                  PSPA0062
                                                                        PSPA0063
      RETURN                                                            PSPA0064
      END                                                               PSPA0065
                                                                        PSPA0066
      SUBROUTINE PSCLOS(BBOXX1,BBOXX2,BBOXY1,BBOXY2)                    PSCL0001
C-----------------------------------------------------------------------PSCL0002
C                                                                       PSCL0003
C  SUBROUTINE PSCLOS  -  Write final lines to PostScript file and close PSCL0004
C                                                                       PSCL0005
C----------------------------------------------------------------------+PSCL0006
                                                                        PSCL0007
      INTEGER       BBOXX1, BBOXX2, BBOXY1, BBOXY2                      PSCL0008
                                                                        PSCL0009
C---- Write out closing lines to PostScript file                        PSCL0010
      WRITE(11,100) BBOXX1 - 1, BBOXY1 - 1, BBOXX2 + 1, BBOXY2 + 1      PSCL0011
 100  FORMAT(                                                           PSCL0012
CHECK v.3.2-->                                                          PSCL0013
C     -    'grestore stroke',/,                                         PSCL0014
C     -    'ProcheckSave restore',/,                                    PSCL0015
C     -    'showpage',/,                                                PSCL0016
CHECK v.3.2<--                                                          PSCL0017
     &    '%%Trailer',/,                                                PSCL0018
     &    '%%BoundingBox:',4I4,/,                                       PSCL0019
     &    '%%EOF')                                                      PSCL0020
                                                                        PSCL0021
                                                                        PSCL0022
C---- Close the file                                                    PSCL0023
      CLOSE(11)                                                         PSCL0024
                                                                        PSCL0025
      RETURN                                                            PSCL0026
      END                                                               PSCL0027
                                                                        PSCL0028
      SUBROUTINE PSENDP                                                 PSEN0001
C-----------------------------------------------------------------------PSEN0002
C                                                                       PSEN0003
C  SUBROUTINE PSENDP  -  Write final lines for the current page to      PSEN0004
C                        the PostScript file                            PSEN0005
C                                                                       PSEN0006
C----------------------------------------------------------------------+PSEN0007
                                                                        PSEN0008
C---- Write out closing lines for this page                             PSEN0009
      WRITE(11,100)                                                     PSEN0010
 100  FORMAT(                                                           PSEN0011
     &    'ProcheckSave restore',/,                                     PSEN0012
     &    'showpage')                                                   PSEN0013
                                                                        PSEN0014
      RETURN                                                            PSEN0015
      END                                                               PSEN0016
                                                                        PSEN0017
      SUBROUTINE PSBBOX(X1,Y1,X2,Y2,X3,Y3,X4,Y4)                        PSBB0001
C-----------------------------------------------------------------------PSBB0002
C                                                                       PSBB0003
C  SUBROUTINE PSBBOX  -  Write out bounded box to PostScript file       PSBB0004
C                                                                       PSBB0005
C----------------------------------------------------------------------+PSBB0006
                                                                        PSBB0007
      REAL          X1, X2, Y1, Y2, X3, Y3, X4, Y4                      PSBB0008
                                                                        PSBB0009
      WRITE(11,100) X1, Y1, X2, Y2, X3, Y3, X4, Y4                      PSBB0010
 100  FORMAT(8F7.2,' Pline4')                                           PSBB0011
                                                                        PSBB0012
      RETURN                                                            PSBB0013
      END                                                               PSBB0014
                                                                        PSBB0015
      SUBROUTINE PSCCOL(R,G,B)                                          PSCC0001
C-----------------------------------------------------------------------PSCC0002
C                                                                       PSCC0003
C  SUBROUTINE PSCCOL  -  Define colour for filled circle                PSCC0004
C                                                                       PSCC0005
C----------------------------------------------------------------------+PSCC0006
                                                                        PSCC0007
      REAL          R, G, B                                             PSCC0008
                                                                        PSCC0009
      WRITE(11,100) R, G, B                                             PSCC0010
 100  FORMAT('/Circol { ',3F7.4,' setrgbcolor } def')                   PSCC0011
                                                                        PSCC0012
      RETURN                                                            PSCC0013
      END                                                               PSCC0014
                                                                        PSCC0015
      SUBROUTINE PSCSHD(SHADE)                                          PSCS0001
C-----------------------------------------------------------------------PSCS0002
C                                                                       PSCS0003
C  SUBROUTINE PSCSHD  -  Define shade for filled circle                 PSCS0004
C                                                                       PSCS0005
C----------------------------------------------------------------------+PSCS0006
                                                                        PSCS0007
      REAL          SHADE                                               PSCS0008
                                                                        PSCS0009
      WRITE(11,100) SHADE                                               PSCS0010
 100  FORMAT('/Circol { ',F7.4,' setgray } def')                        PSCS0011
                                                                        PSCS0012
      RETURN                                                            PSCS0013
      END                                                               PSCS0014
                                                                        PSCS0015
      SUBROUTINE PSCIRC(X,Y,RADIUS)                                     PSCI0001
C-----------------------------------------------------------------------PSCI0002
C                                                                       PSCI0003
C  SUBROUTINE PSCIRC  -  Write out a black circle to PostScript file    PSCI0004
C                                                                       PSCI0005
C----------------------------------------------------------------------+PSCI0006
                                                                        PSCI0007
      REAL          X, Y, RADIUS                                        PSCI0008
                                                                        PSCI0009
      WRITE(11,100) X, Y, RADIUS                                        PSCI0010
 100  FORMAT(3F7.2,' Circle')                                           PSCI0011
                                                                        PSCI0012
      RETURN                                                            PSCI0013
      END                                                               PSCI0014
                                                                        PSCI0015
      SUBROUTINE PSCOLB(R,G,B)                                          PSCO0001
C-----------------------------------------------------------------------PSCO0002
C                                                                       PSCO0003
C  SUBROUTINE PSCOLB  -  Write background colour level                  PSCO0004
C                                                                       PSCO0005
C----------------------------------------------------------------------+PSCO0006
                                                                        PSCO0007
      REAL          R, G, B                                             PSCO0008
                                                                        PSCO0009
      WRITE(11,100) R, G, B                                             PSCO0010
 100  FORMAT(3F8.4,' Col')                                              PSCO0011
                                                                        PSCO0012
      RETURN                                                            PSCO0013
      END                                                               PSCO0014
                                                                        PSCO0015
      SUBROUTINE PSCOLR(R,G,B)                                          PSCO0001
C-----------------------------------------------------------------------PSCO0002
C                                                                       PSCO0003
C  SUBROUTINE PSCOLR  -  Write colour level                             PSCO0004
C                                                                       PSCO0005
C----------------------------------------------------------------------+PSCO0006
                                                                        PSCO0007
      REAL          R, G, B                                             PSCO0008
                                                                        PSCO0009
      WRITE(11,100) R, G, B                                             PSCO0010
 100  FORMAT('gsave ',3F8.4,' Col')                                     PSCO0011
                                                                        PSCO0012
      RETURN                                                            PSCO0013
      END                                                               PSCO0014
                                                                        PSCO0015
      SUBROUTINE PSCTXT(X,Y,SIZE,TEXT)                                  PSCT0001
C-----------------------------------------------------------------------PSCT0002
C                                                                       PSCT0003
C  SUBROUTINE PSCTXT  -  Write out centred text to PostScript file      PSCT0004
C                                                                       PSCT0005
C----------------------------------------------------------------------+PSCT0006
                                                                        PSCT0007
      CHARACTER*(*) TEXT                                                PSCT0008
CXXX      CHARACTER*158 IREC                                            PSCT0009
      REAL          SIZE, X, Y                                          PSCT0010
                                                                        PSCT0011
      WRITE(11,100) X, Y                                                PSCT0012
 100  FORMAT(2F7.2,' moveto')                                           PSCT0013
CXXX      WRITE(IREC,150) TEXT                                          PSCT0014
CXXX 150  FORMAT('(',A,')')                                             PSCT0015
CXXX      IF (IREC(80:).EQ.' ') THEN                                    PSCT0016
          WRITE(11,200) TEXT, SIZE                                      PSCT0017
 200      FORMAT('(',A,')',/,F4.1,' Center')                            PSCT0018
          WRITE(11,300) TEXT, SIZE                                      PSCT0019
 300      FORMAT('(',A,')',/,F4.1,' Print')                             PSCT0020
CXXX      ELSE                                                          PSCT0021
CXXX          WRITE(11,320) IREC(1:79)                                  PSCT0022
CXXX 320      FORMAT(A)                                                 PSCT0023
CXXX          WRITE(11,320) IREC(80:)                                   PSCT0024
CXXX          WRITE(11,350) SIZE                                        PSCT0025
CXXX 350      FORMAT(F4.1,' Center')                                    PSCT0026
CXXX          WRITE(IREC,150) TEXT                                      PSCT0027
CXXX          WRITE(11,320) IREC(1:79)                                  PSCT0028
CXXX          WRITE(11,320) IREC(80:)                                   PSCT0029
CXXX          WRITE(11,400) SIZE                                        PSCT0030
CXXX 400      FORMAT(F4.1,' Print')                                     PSCT0031
CXXX      ENDIF                                                         PSCT0032
                                                                        PSCT0033
      RETURN                                                            PSCT0034
      END                                                               PSCT0035
                                                                        PSCT0036
      SUBROUTINE PSLINE(X1,Y1,X2,Y2)                                    PSLI0001
C-----------------------------------------------------------------------PSLI0002
C                                                                       PSLI0003
C  SUBROUTINE PSLINE  -  Write line out to PostScript file              PSLI0004
C                                                                       PSLI0005
C----------------------------------------------------------------------+PSLI0006
                                                                        PSLI0007
      REAL          X1, X2, Y1, Y2                                      PSLI0008
                                                                        PSLI0009
      WRITE(11,100) X1, Y1, X2, Y2                                      PSLI0010
 100  FORMAT(4F7.2,' L')                                                PSLI0011
                                                                        PSLI0012
      RETURN                                                            PSLI0013
      END                                                               PSLI0014
                                                                        PSLI0015
      SUBROUTINE PSLWID(LWIDTH)                                         PSLW0001
C-----------------------------------------------------------------------PSLW0002
C                                                                       PSLW0003
C  SUBROUTINE PSLWID  -  Write line-width out to PostScript file        PSLW0004
C                                                                       PSLW0005
C----------------------------------------------------------------------+PSLW0006
                                                                        PSLW0007
      REAL          LWIDTH                                              PSLW0008
                                                                        PSLW0009
      WRITE(11,100) LWIDTH                                              PSLW0010
 100  FORMAT(F5.2,' setlinewidth')                                      PSLW0011
                                                                        PSLW0012
      RETURN                                                            PSLW0013
      END                                                               PSLW0014
                                                                        PSLW0015
      SUBROUTINE PSMARK(X,Y,MARKER,HWIDX,HWIDY)                         PSMA0001
C-----------------------------------------------------------------------PSMA0002
C                                                                       PSMA0003
C  SUBROUTINE PSMARK  -  Write point-marker to PostScript file          PSMA0004
C                                                                       PSMA0005
C----------------------------------------------------------------------+PSMA0006
                                                                        PSMA0007
      INTEGER       MARKER                                              PSMA0008
      REAL          HWIDX, HWIDY, X, Y                                  PSMA0009
                                                                        PSMA0010
C---- Print appropriate marker                                          PSMA0011
                                                                        PSMA0012
C---- Oridnary residue                                                  PSMA0013
      IF (MARKER.EQ.1) THEN                                             PSMA0014
           CALL PSBBOX(X - HWIDX,Y - HWIDY,X - HWIDX,Y + HWIDY,         PSMA0015
     &                 X + HWIDX,Y + HWIDY,X + HWIDX,Y - HWIDY)         PSMA0016
                                                                        PSMA0017
C---- Glycine                                                           PSMA0018
      ELSE IF (MARKER.EQ.2) THEN                                        PSMA0019
          CALL PSTRIA(X - HWIDX,Y - 0.6 * HWIDY,X + HWIDX,              PSMA0020
     &        Y - 0.6 * HWIDY,X,Y + 1.2 * HWIDY)                        PSMA0021
                                                                        PSMA0022
C---- Residue in disallowed region                                      PSMA0023
      ELSE IF (MARKER.EQ.3) THEN                                        PSMA0024
           CALL PSBBOX(X - HWIDX,Y - HWIDY,X - HWIDX,Y + HWIDY,         PSMA0025
     &                 X + HWIDX,Y + HWIDY,X + HWIDX,Y - HWIDY)         PSMA0026
      ENDIF                                                             PSMA0027
                                                                        PSMA0028
      RETURN                                                            PSMA0029
      END                                                               PSMA0030
                                                                        PSMA0031
      SUBROUTINE PSOCIR(X,Y,RADIUS)                                     PSOC0001
C-----------------------------------------------------------------------PSOC0002
C                                                                       PSOC0003
C  SUBROUTINE PSOCIR  -  Write out an open (ie uncoloured, unshaded)    PSOC0004
C                        circle to PostScript file                      PSOC0005
C                                                                       PSOC0006
C----------------------------------------------------------------------+PSOC0007
                                                                        PSOC0008
      REAL          X, Y, RADIUS                                        PSOC0009
                                                                        PSOC0010
      WRITE(11,100) X, Y, RADIUS                                        PSOC0011
 100  FORMAT(3F7.2,' Ocircle')                                          PSOC0012
                                                                        PSOC0013
      RETURN                                                            PSOC0014
      END                                                               PSOC0015
                                                                        PSOC0016
      SUBROUTINE PSPCIR(X,Y,RADIUS,ANGBEG,ANGEND)                       PSPC0001
C-----------------------------------------------------------------------PSPC0002
C                                                                       PSPC0003
C  SUBROUTINE PSPCIR  -  Write out a shaded/coloured part-circle to     PSPC0004
C                        PostScript file (start and end-angles supplied PSPC0005
C                        in degrees). The shading goes anti-clockwise frPSPC0006
C                        ANGBEG round to ANGEND, where zero is at 3 o'clPSPC0007
C                                                                       PSPC0008
C----------------------------------------------------------------------+PSPC0009
                                                                        PSPC0010
      REAL          ANGBEG, ANGEND, X, Y, RADIUS                        PSPC0011
                                                                        PSPC0012
      WRITE(11,100) X, Y, RADIUS, ANGBEG, ANGEND, X, Y                  PSPC0013
 100  FORMAT(7F7.2,' Pcircle')                                          PSPC0014
                                                                        PSPC0015
      RETURN                                                            PSPC0016
      END                                                               PSPC0017
                                                                        PSPC0018
      SUBROUTINE PSRCTX(X,Y,SIZE,TEXT)                                  PSRC0001
C-----------------------------------------------------------------------PSRC0002
C                                                                       PSRC0003
C  SUBROUTINE PSRCTX  -  Write out text centred and rotated through 90  PSRC0004
C                        degrees to PostScript file                     PSRC0005
C                                                                       PSRC0006
C----------------------------------------------------------------------+PSRC0007
                                                                        PSRC0008
      CHARACTER*(*) TEXT                                                PSRC0009
      REAL          SIZE, X, Y                                          PSRC0010
                                                                        PSRC0011
      WRITE(11,100) X, Y                                                PSRC0012
 100  FORMAT(2F7.2,' moveto')                                           PSRC0013
      WRITE(11,200) TEXT, SIZE                                          PSRC0014
 200  FORMAT('(',A,') ',F4.1,' CenterRot90 Rot90')                      PSRC0015
      WRITE(11,300) TEXT, SIZE                                          PSRC0016
 300  FORMAT('(',A,') ',F4.1,' Print')                                  PSRC0017
      WRITE(11,400)                                                     PSRC0018
 400  FORMAT('grestore')                                                PSRC0019
                                                                        PSRC0020
      RETURN                                                            PSRC0021
      END                                                               PSRC0022
                                                                        PSRC0023
      SUBROUTINE PSRTXT(X,Y,SIZE,TEXT)                                  PSRT0001
C-----------------------------------------------------------------------PSRT0002
C                                                                       PSRT0003
C  SUBROUTINE PSRTXT  -  Write out text rotated through 90 degrees to   PSRT0004
C                        PostScript file                                PSRT0005
C                                                                       PSRT0006
C----------------------------------------------------------------------+PSRT0007
                                                                        PSRT0008
      CHARACTER*(*) TEXT                                                PSRT0009
      REAL          SIZE, X, Y                                          PSRT0010
                                                                        PSRT0011
      WRITE(11,100) X, Y                                                PSRT0012
 100  FORMAT(2F7.2,' moveto')                                           PSRT0013
CHECK v.3.4-->                                                          PSRT0014
C      WRITE(11,200) TEXT, SIZE                                         PSRT0015
C 200  FORMAT('(',A,') ',F4.1,' UncenterRot90 Rot90')                   PSRT0016
      WRITE(11,200)                                                     PSRT0017
 200  FORMAT('Rot90')                                                   PSRT0018
CHECK v.3.4<--                                                          PSRT0019
      WRITE(11,300) TEXT, SIZE                                          PSRT0020
 300  FORMAT('(',A,') ',F4.1,' Print')                                  PSRT0021
      WRITE(11,400)                                                     PSRT0022
 400  FORMAT('grestore')                                                PSRT0023
                                                                        PSRT0024
      RETURN                                                            PSRT0025
      END                                                               PSRT0026
                                                                        PSRT0027
      SUBROUTINE PSDASH(ONOFF)                                          PSDA0001
C-----------------------------------------------------------------------PSDA0002
C                                                                       PSDA0003
C  SUBROUTINE PSDASH  -  Switch dashed lines on/off                     PSDA0004
C                                                                       PSDA0005
C----------------------------------------------------------------------+PSDA0006
                                                                        PSDA0007
      INTEGER       ONOFF                                               PSDA0008
                                                                        PSDA0009
      IF (ONOFF.EQ.0) THEN                                              PSDA0010
          WRITE(11,100)                                                 PSDA0011
 100      FORMAT('[]  0 setdash')                                       PSDA0012
      ELSE                                                              PSDA0013
          WRITE(11,120) ONOFF, ONOFF                                    PSDA0014
 120      FORMAT('[ ', I2, ' ', I2, ' ]  0 setdash')                    PSDA0015
      ENDIF                                                             PSDA0016
                                                                        PSDA0017
      RETURN                                                            PSDA0018
      END                                                               PSDA0019
                                                                        PSDA0020
      SUBROUTINE PSCALE(SHADE,INCOL,MXCOLR,RGB,MINCOL,MAXCOL)           PSCA0001
C-----------------------------------------------------------------------PSCA0002
C                                                                       PSCA0003
C  SUBROUTINE PSCALE  -  Write out colour or black-and-white shading    PSCA0004
C                        level to PostScript file                       PSCA0005
C                                                                       PSCA0006
C----------------------------------------------------------------------+PSCA0007
                                                                        PSCA0008
      INTEGER       ICOL, MAXCOL, MINCOL, MXCOLR                        PSCA0009
      LOGICAL       INCOL                                               PSCA0010
      REAL          COLOUR(3), RGB(3,MXCOLR), SHADE                     PSCA0011
                                                                        PSCA0012
C---- If black-and-white PostScript file, then write out grey-level     PSCA0013
      IF (.NOT.INCOL) THEN                                              PSCA0014
          WRITE(11,100) SHADE                                           PSCA0015
 100      FORMAT('gsave',F7.4,' setgray')                               PSCA0016
                                                                        PSCA0017
C---- Otherwise, if in colour, determine the right mix of colours       PSCA0018
      ELSE                                                              PSCA0019
          DO 200, ICOL = 1, 3                                           PSCA0020
              COLOUR(ICOL) = RGB(ICOL,MINCOL) + (1.0 - SHADE)           PSCA0021
     &            * (RGB(ICOL,MAXCOL) - RGB(ICOL,MINCOL))               PSCA0022
 200      CONTINUE                                                      PSCA0023
                                                                        PSCA0024
C----     Write out the 3 RGB values                                    PSCA0025
          WRITE(11,220) (COLOUR(ICOL), ICOL = 1, 3)                     PSCA0026
 220      FORMAT('gsave ',3F8.4,' Col')                                 PSCA0027
      ENDIF                                                             PSCA0028
                                                                        PSCA0029
      RETURN                                                            PSCA0030
      END                                                               PSCA0031
                                                                        PSCA0032
      SUBROUTINE PSHADE(SHADE,COLOUR,RGB,MXCOLR,INCOL)                  PSHA0001
C-----------------------------------------------------------------------PSHA0002
C                                                                       PSHA0003
C  SUBROUTINE PSHADE  -  Write shading level or colour out to PostScriptPSHA0004
C                        file                                           PSHA0005
C                                                                       PSHA0006
C----------------------------------------------------------------------+PSHA0007
                                                                        PSHA0008
WINNT - Warning FOR4269: unused dummy argument RGB                      PSHA0009
                                                                        PSHA0010
      CHARACTER*2   COLNO                                               PSHA0011
      INTEGER       COLOUR, MXCOLR                                      PSHA0012
      LOGICAL       INCOL                                               PSHA0013
      REAL          RGB(3,MXCOLR), SHADE                                PSHA0014
                                                                        PSHA0015
      IF (.NOT.INCOL) THEN                                              PSHA0016
          WRITE(11,100) SHADE                                           PSHA0017
 100      FORMAT('gsave',F7.4,' setgray')                               PSHA0018
      ELSE                                                              PSHA0019
          WRITE(COLNO,140) COLOUR                                       PSHA0020
 140      FORMAT(I2.0)                                                  PSHA0021
          IF (COLNO(1:1).EQ.' ') COLNO(1:1) = '0'                       PSHA0022
          WRITE(11,200) COLNO                                           PSHA0023
 200      FORMAT('Col',A2)                                              PSHA0024
      ENDIF                                                             PSHA0025
                                                                        PSHA0026
      RETURN                                                            PSHA0027
      END                                                               PSHA0028
                                                                        PSHA0029
      SUBROUTINE PSTEXT(X,Y,SIZE,TEXT)                                  PSTE0001
C-----------------------------------------------------------------------PSTE0002
C                                                                       PSTE0003
C  SUBROUTINE PSTEXT  -  Write out text to PostScript file              PSTE0004
C                                                                       PSTE0005
C----------------------------------------------------------------------+PSTE0006
                                                                        PSTE0007
      CHARACTER*(*) TEXT                                                PSTE0008
CXXX      CHARACTER*158 IREC                                            PSTE0009
      REAL          SIZE, X, Y                                          PSTE0010
                                                                        PSTE0011
      WRITE(11,100) X, Y - SIZE / 4.0                                   PSTE0012
 100  FORMAT(2F7.2,' moveto')                                           PSTE0013
CXXX      WRITE(IREC,250) TEXT                                          PSTE0014
CXXX 250  FORMAT('(',A,')')                                             PSTE0015
CXXX      IF (IREC(80:).EQ.' ') THEN                                    PSTE0016
          WRITE(11,300) TEXT, SIZE                                      PSTE0017
 300      FORMAT('(',A,')',/,F4.1,' Print')                             PSTE0018
CXXX      ELSE                                                          PSTE0019
CXXX          WRITE(11,320) IREC(1:79)                                  PSTE0020
CXXX 320      FORMAT(A)                                                 PSTE0021
CXXX          WRITE(11,320) IREC(80:)                                   PSTE0022
CXXX          WRITE(11,350) SIZE                                        PSTE0023
CXXX 350      FORMAT(F4.1,' Print')                                     PSTE0024
CXXX      ENDIF                                                         PSTE0025
                                                                        PSTE0026
      RETURN                                                            PSTE0027
      END                                                               PSTE0028
                                                                        PSTE0029
      SUBROUTINE PSTRIA(X1,Y1,X2,Y2,X3,Y3)                              PSTR0001
C-----------------------------------------------------------------------PSTR0002
C                                                                       PSTR0003
C  SUBROUTINE PSTRIA  -  Write out bounded triangle to PostScript file  PSTR0004
C                                                                       PSTR0005
C----------------------------------------------------------------------+PSTR0006
                                                                        PSTR0007
      REAL          X1, X2, Y1, Y2, X3, Y3                              PSTR0008
                                                                        PSTR0009
      WRITE(11,100) X1, Y1, X2, Y2, X3, Y3                              PSTR0010
 100  FORMAT(6F7.2,' Pline3')                                           PSTR0011
                                                                        PSTR0012
      RETURN                                                            PSTR0013
      END                                                               PSTR0014
                                                                        PSTR0015
      SUBROUTINE PSUBOX(X1,Y1,X2,Y2,X3,Y3,X4,Y4)                        PSUB0001
C-----------------------------------------------------------------------PSUB0002
C                                                                       PSUB0003
C  SUBROUTINE PSUBOX  -  Write out unbounded box to PostScript file     PSUB0004
C                                                                       PSUB0005
C----------------------------------------------------------------------+PSUB0006
                                                                        PSUB0007
      REAL          X1, X2, Y1, Y2, X3, Y3, X4, Y4                      PSUB0008
                                                                        PSUB0009
      WRITE(11,100) X1, Y1, X2, Y2, X3, Y3, X4, Y4                      PSUB0010
 100  FORMAT(8F7.2,' Pl4')                                              PSUB0011
                                                                        PSUB0012
      RETURN                                                            PSUB0013
      END                                                               PSUB0014
                                                                        PSUB0015
      SUBROUTINE PSUTRI(X1,Y1,X2,Y2,X3,Y3)                              PSUT0001
C-----------------------------------------------------------------------PSUT0002
C                                                                       PSUT0003
C  SUBROUTINE PSUTRI  -  Write out unbounded triangle to PostScript filePSUT0004
C                                                                       PSUT0005
C----------------------------------------------------------------------+PSUT0006
                                                                        PSUT0007
      REAL          X1, X2, X3, Y1, Y2, Y3                              PSUT0008
                                                                        PSUT0009
      WRITE(11,100) X1, Y1, X2, Y2, X3, Y3                              PSUT0010
 100  FORMAT(6F7.2,' Pl3')                                              PSUT0011
                                                                        PSUT0012
      RETURN                                                            PSUT0013
      END                                                               PSUT0014
                                                                        PSUT0015
      SUBROUTINE AXES(XLIM1,XLIM2,YLIM1,YLIM2,NPTSX,NPTSY,XMIN,XMAX,    AXES0001
     &    YMIN,YMAX,SIZLAB,INTRLX,INTRLY,TSIZE,NUMBEX,NUMBEY,ZEROS,     AXES0002
     &    NOEND,FULTIC)                                                 AXES0003
C-----------------------------------------------------------------------AXES0004
C                                                                       AXES0005
C  SUBROUTINE AXES  -  Draw graph axes and axis-labels, writing out to  AXES0006
C                      PostScript file                                  AXES0007
C                                                                       AXES0008
C----------------------------------------------------------------------+AXES0009
                                                                        AXES0010
      CHARACTER*5    LABEL                                              AXES0011
      INTEGER        IFROM, IMARK, INTRLX, INTRLY, IVALUE, NPTSX, NPTSY AXES0012
      LOGICAL        FULTIC, NOEND, NUMBEX, NUMBEY, ZEROS               AXES0013
      REAL           SIZLAB, TSIZE, UGAP, VALUE, VGAP, X, XCENTR, XGAP, AXES0014
     &               XLIM1, XLIM2, XMAX, XMIN, X1, X2, Y, YCENTR, YGAP, AXES0015
     &               YLIM1, YLIM2, YMAX, YMIN, Y1, Y2                   AXES0016
                                                                        AXES0017
C Routine parameters:-                                                  AXES0018
C ------------------                                                    AXES0019
C XLIM1, XLIM2, YLIM1, YLIM2 - x- and y-extent of graph area (ie coords AXES0020
C          of graph-box). In PostScript coords.                         AXES0021
C NPTSX, NPTSY - Numbers of ticks along x- and y-axes                   AXES0022
C XMIN, XMAX, YMIN, YMAX - Minimum and maximum x- and y-values on       AXES0023
C          plotted axes                                                 AXES0024
C SIZLAB - Label-size for numbers on the axis (in PostScript coords).   AXES0025
C INTRLX, INTRLY - Integer values indicating how the numbers on the     AXES0026
C          axes are to be formatted. (O=format as integer,1=format as   AXES0027
C          real with number after decimal point,2=real with 2 numbers   AXES0028
C          after decimal point.                                         AXES0029
C TSIZE  - A measure of the distance of axis labels from the axis (in   AXES0030
C          PostScript coords).                                          AXES0031
C NUMBEX, NUMBEY - Flags indicating whether numbers are actually        AXES0032
C          required on the x- and y-axes                                AXES0033
C ZEROS  - Flag indicating whether zero value on the y-axis is required AXES0034
C NOEND  - Flag indicating whether the last numbers on the x-and y-axes AXES0035
C          are required                                                 AXES0036
C FULTIC - Flag indicating whether axis ticks are to be full-ticks,     AXES0037
C          extending a little to the other side of the axis, or half-   AXES0038
C          ticks only.                                                  AXES0039
                                                                        AXES0040
C---- Initialise variables                                              AXES0041
      IF (NPTSX.GT.0) THEN                                              AXES0042
          XGAP = (XLIM2 - XLIM1) / NPTSX                                AXES0043
          UGAP = (XMAX - XMIN) / NPTSX                                  AXES0044
      ENDIF                                                             AXES0045
      IF (NPTSY.GT.0) THEN                                              AXES0046
          YGAP = (YLIM2 - YLIM1) / NPTSY                                AXES0047
          VGAP = (YMAX - YMIN) / NPTSY                                  AXES0048
      ENDIF                                                             AXES0049
      XCENTR = (XLIM1 + XLIM2) / 2.0                                    AXES0050
      YCENTR = (YLIM1 + YLIM2) / 2.0                                    AXES0051
                                                                        AXES0052
C---- Draw box round graph                                              AXES0053
      CALL PSLWID(0.6)                                                  AXES0054
      CALL PSLINE(XLIM1,YLIM1,XLIM1,YLIM2)                              AXES0055
      CALL PSLINE(XLIM1,YLIM2,XLIM2,YLIM2)                              AXES0056
      CALL PSLINE(XLIM2,YLIM2,XLIM2,YLIM1)                              AXES0057
      CALL PSLINE(XLIM2,YLIM1,XLIM1,YLIM1)                              AXES0058
                                                                        AXES0059
C---- x-axis point markers and labels                                   AXES0060
      X = XLIM1                                                         AXES0061
      Y = YLIM1 - TSIZE / 2.0                                           AXES0062
      IF (NPTSX.GT.0) THEN                                              AXES0063
          DO 100, IMARK = 1, NPTSX + 1                                  AXES0064
              VALUE = XMIN + (IMARK - 1) * UGAP                         AXES0065
              IF (VALUE.GE.0.0) THEN                                    AXES0066
                  IVALUE = VALUE + 0.5                                  AXES0067
              ELSE                                                      AXES0068
                  IVALUE = VALUE - 0.5                                  AXES0069
              ENDIF                                                     AXES0070
              IF (INTRLX.EQ.0) THEN                                     AXES0071
                  WRITE(LABEL,20) IVALUE                                AXES0072
 20               FORMAT(I5)                                            AXES0073
              ELSE IF (INTRLX.EQ.1) THEN                                AXES0074
                  WRITE(LABEL,40) VALUE                                 AXES0075
 40               FORMAT(F5.1)                                          AXES0076
              ELSE IF (INTRLX.EQ.2) THEN                                AXES0077
                  WRITE(LABEL,60) VALUE                                 AXES0078
 60               FORMAT(F5.2)                                          AXES0079
              ENDIF                                                     AXES0080
              IFROM = 1                                                 AXES0081
              IF (LABEL(1:1).EQ.' ') IFROM = 2                          AXES0082
              IF (LABEL(2:2).EQ.' ') IFROM = 3                          AXES0083
              IF (LABEL(3:3).EQ.' ') IFROM = 4                          AXES0084
              IF (LABEL(4:4).EQ.' ') IFROM = 5                          AXES0085
              IF (NUMBEX) THEN                                          AXES0086
                  IF (.NOT.(NOEND .AND. IMARK.EQ.NPTSX + 1)) THEN       AXES0087
                      Y1 = YLIM1                                        AXES0088
                      Y2 = YLIM1 - SIZLAB / 3.0                         AXES0089
                      IF (FULTIC) Y1 = Y1 + SIZLAB / 6.0                AXES0090
                      CALL PSCTXT(X,Y,SIZLAB,LABEL(IFROM:5))            AXES0091
                      CALL PSLINE(X,Y1,X,Y2)                            AXES0092
                  ENDIF                                                 AXES0093
              ENDIF                                                     AXES0094
              X = X + XGAP                                              AXES0095
 100      CONTINUE                                                      AXES0096
      ENDIF                                                             AXES0097
                                                                        AXES0098
C---- y-axis point markers and labels                                   AXES0099
      X = XLIM1 - TSIZE                                                 AXES0100
      Y = YLIM1                                                         AXES0101
      IF (NPTSY.GT.0) THEN                                              AXES0102
          DO 200, IMARK = 1, NPTSY + 1                                  AXES0103
              VALUE = YMIN + (IMARK - 1) * VGAP                         AXES0104
              IF (VALUE.GE.0.0) THEN                                    AXES0105
                  IVALUE = VALUE + 0.5                                  AXES0106
              ELSE                                                      AXES0107
                  IVALUE = VALUE - 0.5                                  AXES0108
              ENDIF                                                     AXES0109
              IF (INTRLY.EQ.0) THEN                                     AXES0110
                  WRITE(LABEL,20) IVALUE                                AXES0111
              ELSE IF (INTRLY.EQ.1) THEN                                AXES0112
                  WRITE(LABEL,40) VALUE                                 AXES0113
              ELSE                                                      AXES0114
                  WRITE(LABEL,60) VALUE                                 AXES0115
              ENDIF                                                     AXES0116
              IFROM = 1                                                 AXES0117
              IF (NUMBEY .AND. (ZEROS .OR. IMARK.GT.1)) THEN            AXES0118
                  IF (.NOT.(NOEND .AND. IMARK.EQ.NPTSY + 1)) THEN       AXES0119
                      X1 = XLIM1 - SIZLAB / 3.0                         AXES0120
                      X2 = XLIM1                                        AXES0121
                      IF (FULTIC) X2 = X2 + SIZLAB / 6.0                AXES0122
                      CALL PSCTXT(X,Y,SIZLAB,LABEL(1:5))                AXES0123
                      CALL PSLINE(X1,Y,X2,Y)                            AXES0124
                  ENDIF                                                 AXES0125
              ENDIF                                                     AXES0126
              Y = Y + YGAP                                              AXES0127
 200      CONTINUE                                                      AXES0128
      ENDIF                                                             AXES0129
                                                                        AXES0130
      RETURN                                                            AXES0131
      END                                                               AXES0132
                                                                        AXES0133
      SUBROUTINE FINKEY(KEY,LEN,LINE,FINERR)                            FINK0001
C-----------------------------------------------------------------------FINK0002
C                                                                       FINK0003
C  SUBROUTINE FINKEY  -  Find the required keyword in the parameter fileFINK0004
C                                                                       FINK0005
C----------------------------------------------------------------------+FINK0006
                                                                        FINK0007
      CHARACTER*(*) KEY                                                 FINK0008
      CHARACTER*80  IREC                                                FINK0009
      INTEGER       LEN, LINE                                           FINK0010
      LOGICAL       FINERR                                              FINK0011
                                                                        FINK0012
C---- Search through the file until find the keyword                    FINK0013
      REWIND(10)                                                        FINK0014
      FINERR = .FALSE.                                                  FINK0015
      LINE = 0                                                          FINK0016
 100  CONTINUE                                                          FINK0017
          LINE = LINE + 1                                               FINK0018
          READ(10,110,END=900) IREC                                     FINK0019
 110      FORMAT(A)                                                     FINK0020
      IF (IREC(1:LEN).NE.KEY) GO TO 100                                 FINK0021
                                                                        FINK0022
C---- Skip the next line                                                FINK0023
      LINE = LINE + 1                                                   FINK0024
      READ(10,110,END=900) IREC                                         FINK0025
                                                                        FINK0026
      GO TO 999                                                         FINK0027
                                                                        FINK0028
C---- Unable to find keyword                                            FINK0029
 900  CONTINUE                                                          FINK0030
CHECK v.3.2-->                                                          FINK0031
C      PRINT*, '*** ERROR. Unable to find keyword in procheck.prm: ',   FINK0032
      PRINT*, '* Unable to find keyword in parameter file: ',           FINK0033
CHECK v.3.2<--                                                          FINK0034
     &    KEY                                                           FINK0035
      FINERR = .TRUE.                                                   FINK0036
                                                                        FINK0037
 999  CONTINUE                                                          FINK0038
      RETURN                                                            FINK0039
      END                                                               FINK0040
                                                                        FINK0041
      SUBROUTINE GETCOL(ICOL,LINE,COLNAM,MXCOLR)                        GETC0001
C-----------------------------------------------------------------------GETC0002
C                                                                       GETC0003
C  SUBROUTINE GETCOL  -  Determine the colour-number of this item       GETC0004
C                                                                       GETC0005
C----------------------------------------------------------------------+GETC0006
                                                                        GETC0007
      INTEGER       MXCOLR                                              GETC0008
                                                                        GETC0009
      CHARACTER*12  COLIN, COLNAM(MXCOLR)                               GETC0010
      INTEGER       ICOL, ILOOP, LINE                                   GETC0011
                                                                        GETC0012
                                                                        GETC0013
C---- Read in the next colour                                           GETC0014
      COLIN = ' '                                                       GETC0015
      LINE = LINE + 1                                                   GETC0016
      READ(10,20,END=100,ERR=100) COLIN                                 GETC0017
 20   FORMAT(A)                                                         GETC0018
      ILOOP = 0                                                         GETC0019
                                                                        GETC0020
C---- Loop through all the colour names until find the required one     GETC0021
 100  CONTINUE                                                          GETC0022
          ILOOP = ILOOP + 1                                             GETC0023
      IF (COLIN.NE.COLNAM(ILOOP) .AND. ILOOP.LT.MXCOLR) GO TO 100       GETC0024
                                                                        GETC0025
C---- If have found the appropriate colour, store its number            GETC0026
      IF (ILOOP.NE.0) THEN                                              GETC0027
          ICOL = ILOOP                                                  GETC0028
      ELSE                                                              GETC0029
          PRINT*, '* Colour-type unknown: [', COLIN, '] at line',       GETC0030
     &        LINE, ' in procheck.prm file'                             GETC0031
      ENDIF                                                             GETC0032
                                                                        GETC0033
      RETURN                                                            GETC0034
      END                                                               GETC0035
                                                                        GETC0036
      SUBROUTINE GETNAM(PDBFIL,ISTART,IEND,IERROR)                      GETN0001
C-----------------------------------------------------------------------GETN0002
C                                                                       GETN0003
C  SUBROUTINE GETNAM  -  Peel off the directory path and extension from GETN0004
C                        full name of the .pdb file                     GETN0005
C                                                                       GETN0006
C----------------------------------------------------------------------+GETN0007
                                                                        GETN0008
      CHARACTER*1   BSLASH, CLOSEB, OPENB, PCHAR, SLASH                 GETN0009
      CHARACTER*78  PDBFIL                                              GETN0010
      INTEGER       IEND, IPOS, ISTART, ISTATE                          GETN0011
      LOGICAL       FINISH, GOTDOT, IERROR                              GETN0012
                                                                        GETN0013
      OPENB = '['                                                       GETN0014
      CLOSEB = ']'                                                      GETN0015
      BSLASH = '$$'                                                     GETN0016
      SLASH = '/'                                                       GETN0017
                                                                        GETN0018
C---- Initialise variables                                              GETN0019
      FINISH = .FALSE.                                                  GETN0020
      IEND = 0                                                          GETN0021
      IERROR = .FALSE.                                                  GETN0022
      ISTART = 1                                                        GETN0023
      ISTATE = 1                                                        GETN0024
      IPOS = 78                                                         GETN0025
      GOTDOT = .FALSE.                                                  GETN0026
                                                                        GETN0027
C---- Check through the filename from right to left                     GETN0028
100   CONTINUE                                                          GETN0029
                                                                        GETN0030
C----     Pick off next character                                       GETN0031
          PCHAR = PDBFIL(IPOS:IPOS)                                     GETN0032
                                                                        GETN0033
C----     State 1: Searching for first non-blank character              GETN0034
          IF (ISTATE.EQ.1) THEN                                         GETN0035
              IF (PCHAR.EQ.SLASH .OR. PCHAR.EQ.BSLASH .OR.              GETN0036
     &            PCHAR.EQ.CLOSEB) THEN                                 GETN0037
                  GO TO 900                                             GETN0038
              ENDIF                                                     GETN0039
              IF (PCHAR.NE.' ' .AND. PCHAR.NE.'.') THEN                 GETN0040
                  IEND = IPOS                                           GETN0041
                  ISTATE = 2                                            GETN0042
              ENDIF                                                     GETN0043
                                                                        GETN0044
C----     State 2: Searching for end of extension, or end of directory pGETN0045
          ELSE IF (ISTATE.EQ.2) THEN                                    GETN0046
                                                                        GETN0047
C----         If character is a dot, and is the first dot, then note posGETN0048
              IF (PCHAR.EQ.'.' .AND. .NOT.GOTDOT) THEN                  GETN0049
                  IEND = IPOS - 1                                       GETN0050
                  GOTDOT = .TRUE.                                       GETN0051
                                                                        GETN0052
C----         If character signifies the end of a directory path, note pGETN0053
              ELSE IF (PCHAR.EQ.SLASH .OR. PCHAR.EQ.BSLASH              GETN0054
     &            .OR. PCHAR.EQ.CLOSEB) THEN                            GETN0055
                  ISTART = IPOS + 1                                     GETN0056
                  FINISH = .TRUE.                                       GETN0057
              ENDIF                                                     GETN0058
          ENDIF                                                         GETN0059
                                                                        GETN0060
C----     Step back a character                                         GETN0061
          IPOS = IPOS - 1                                               GETN0062
                                                                        GETN0063
C---- Loop back for next character                                      GETN0064
      IF (.NOT.FINISH .AND. IPOS.GT.0) GO TO 100                        GETN0065
                                                                        GETN0066
C---- Check whether file name is sensible                               GETN0067
      IF (ISTART.GT.IEND) GO TO 900                                     GETN0068
                                                                        GETN0069
      GO TO 999                                                         GETN0070
                                                                        GETN0071
C---- Error in file name                                                GETN0072
900   CONTINUE                                                          GETN0073
      IEND = 40                                                         GETN0074
      IF (PDBFIL(41:78).NE.' ') IEND = 78                               GETN0075
      PRINT*,' *** ERROR in supplied name of file: [', PDBFIL(1:IEND),  GETN0076
     &    ']'                                                           GETN0077
      IERROR = .TRUE.                                                   GETN0078
                                                                        GETN0079
999   CONTINUE                                                          GETN0080
      RETURN                                                            GETN0081
      END                                                               GETN0082
                                                                        GETN0083
      SUBROUTINE RAMREG(PHI,PSI,REGION,REGNO,REGTYP)                    RAMR0001
C----------------------------------------------------------------------+RAMR0002
C                                                                       RAMR0003
C  SUBROUTINE RAMREG  -  Determine which part of the Ramachandran plot  RAMR0004
C                        this residue is in                             RAMR0005
C                                                                       RAMR0006
C----------------------------------------------------------------------+RAMR0007
                                                                        RAMR0008
      SAVE                                                              RAMR0009
                                                                        RAMR0010
      INTEGER        MAPSIZ                                             RAMR0011
      PARAMETER     (MAPSIZ = 36)                                       RAMR0012
                                                                        RAMR0013
      CHARACTER*1    CHAR                                               RAMR0014
      CHARACTER*2    REGION                                             RAMR0015
      CHARACTER*12   CODE                                               RAMR0016
      CHARACTER*24   NEWCOD                                             RAMR0017
      CHARACTER*36   MAPSTR(MAPSIZ)                                     RAMR0018
                                                                        RAMR0019
      INTEGER        I, J, K, MAP(MAPSIZ,MAPSIZ), REGNO, REGTYP,        RAMR0020
     &               RTYPE(12)                                          RAMR0021
      LOGICAL        FIRST                                              RAMR0022
      REAL           GAP, PHI, PSI                                      RAMR0023
                                                                        RAMR0024
      DATA FIRST   / .TRUE. /                                           RAMR0025
                                                                        RAMR0026
      DATA CODE    / 'oBbAaLlexyzw' /                                   RAMR0027
      DATA NEWCOD  / 'XXB b A a L l p ~b~a~l~p' /                       RAMR0028
      DATA RTYPE   /  1,4,3,4,3,4,3,3,2,2,2,2 /                         RAMR0029
                                                                        RAMR0030
      DATA MAPSTR( 1) / 'bBBBBBBBBBBbbbxxooooowwwwwoooooxxxxb' /        RAMR0031
      DATA MAPSTR( 2) / 'bBBBBBBBBBBBbbbxxooooooooooooooxxxbb' /        RAMR0032
      DATA MAPSTR( 3) / 'bBBBBBBBBBBBbbbxxxxooooooooooooxxbbb' /        RAMR0033
      DATA MAPSTR( 4) / 'bbBBBBBBBBBBBbbbbxxooooooooooooxxxbb' /        RAMR0034
      DATA MAPSTR( 5) / 'bbBBBBBBBBBBBBbbxxxooooooooooooxxxxb' /        RAMR0035
      DATA MAPSTR( 6) / 'bbBBBBBBBBBBBbbbxxxoooooooooooooxxxb' /        RAMR0036
      DATA MAPSTR( 7) / 'bbbBBBBBBBBBbbbbxxxooozzzzzzoooooxxb' /        RAMR0037
      DATA MAPSTR( 8) / 'bbbbBBBBBBBbbbbbbxxzzzzzzzzzoooooxxb' /        RAMR0038
      DATA MAPSTR( 9) / 'bbbbbBbbBbbbbbbbbxxzzzzzllzzoooooxxb' /        RAMR0039
      DATA MAPSTR(10) / 'bbbbbbbbbbbbbbxxxxxzzllllzzzoooooxxx' /        RAMR0040
      DATA MAPSTR(11) / 'bbbbbbbbbbbbxxxxxxxzzllllzzzoooooxxx' /        RAMR0041
      DATA MAPSTR(12) / 'xbbbbbbbbbbbbxxoooozzzlllzzzzooooxxx' /        RAMR0042
      DATA MAPSTR(13) / 'xxbbbbbbbbbbbxxoooozzllllllzzooooxxx' /        RAMR0043
      DATA MAPSTR(14) / 'yyaaaaaaaaaayyyoooozzllLllzzzooooxxx' /        RAMR0044
      DATA MAPSTR(15) / 'yaaaaaaaaaaayyyoooozzzlLLlzzzooooxxx' /        RAMR0045
      DATA MAPSTR(16) / 'yaaaaaaAaaaaayyyooozzzlllllzzooooxxx' /        RAMR0046
      DATA MAPSTR(17) / 'yaaaaaAAAAaaayyyyooozzzlllzzzooooxxx' /        RAMR0047
      DATA MAPSTR(18) / 'yaaaaaAAAAAaaayyyooozzzzlllzzooooxxx' /        RAMR0048
      DATA MAPSTR(19) / 'yaaaaAAAAAAAaaayyyoozzzlzllzzooooxxx' /        RAMR0049
      DATA MAPSTR(20) / 'yaaaaaAAAAAAAaayyyyozzzzzzzzzooooxxx' /        RAMR0050
      DATA MAPSTR(21) / 'yyaaaaAAAAAAAAaayyyozzzzzzzzzooooxxx' /        RAMR0051
      DATA MAPSTR(22) / 'yyaaaaaAAAAAAAaaayyyoooooooooooooxxx' /        RAMR0052
      DATA MAPSTR(23) / 'yyyaaaaaAAAAAAAaayyyoooooooooooooxxx' /        RAMR0053
      DATA MAPSTR(24) / 'yaaaaaaaaAAAAAAaaayyyooooooooooooxxx' /        RAMR0054
      DATA MAPSTR(25) / 'aayaaaaaaaaAAAAaaayyyooooooooooooxxx' /        RAMR0055
      DATA MAPSTR(26) / 'yyyaaaaaaaaaaaaaaaayyooooooooooooxxx' /        RAMR0056
      DATA MAPSTR(27) / 'yyyyyaaaaaaaaaaaaayyyooooooooooooxxx' /        RAMR0057
      DATA MAPSTR(28) / 'oyyyyaaaaaaaaaayyyyyyooooooooooooooo' /        RAMR0058
      DATA MAPSTR(29) / 'oooyyyyyyyyayyyyyyyyoooooooooooooooo' /        RAMR0059
      DATA MAPSTR(30) / 'oooxxxxbbxxxxxxxxooooooooooooooooooo' /        RAMR0060
      DATA MAPSTR(31) / 'xxxxxbbxxxxxxxooooooowwwwwoooooooooo' /        RAMR0061
      DATA MAPSTR(32) / 'xxxxxxbbbbxxxxooooooowwwwwoooooooooo' /        RAMR0062
      DATA MAPSTR(33) / 'xbbbxbbbbbxxxxxoooooowwewwwooooooooo' /        RAMR0063
      DATA MAPSTR(34) / 'xbbbbbbbbbbxxxxoooooowwewwwooooooxxx' /        RAMR0064
      DATA MAPSTR(35) / 'xbbbbbbbbbbbbxxoooooowweewwooooooxxx' /        RAMR0065
      DATA MAPSTR(36) / 'bbbbbbbbbbbbbxxoooooowwwwwwooooooxxb' /        RAMR0066
                                                                        RAMR0067
                                                                        RAMR0068
C---- If this is the first call to this routine, initialise the MAP arraRAMR0069
      IF (FIRST) THEN                                                   RAMR0070
          FIRST = .FALSE.                                               RAMR0071
          DO 300, I = 1, MAPSIZ                                         RAMR0072
              DO 200, J = 1, MAPSIZ                                     RAMR0073
                  CHAR = MAPSTR(I)(J:J)                                 RAMR0074
                  DO 100, K = 1, 12                                     RAMR0075
                      IF (CHAR.EQ.CODE(K:K)) MAP(MAPSIZ - I + 1,J) = K  RAMR0076
 100              CONTINUE                                              RAMR0077
 200          CONTINUE                                                  RAMR0078
 300      CONTINUE                                                      RAMR0079
          GAP = 360.0 / MAPSIZ                                          RAMR0080
      ENDIF                                                             RAMR0081
                                                                        RAMR0082
C---- Determine which part of the Ramachandran plot the residue is in   RAMR0083
      IF (PHI.GT.180.0 .OR. PSI.GT.180.0) THEN                          RAMR0084
          REGNO = 1                                                     RAMR0085
          REGION = 'XX'                                                 RAMR0086
          REGTYP = 0                                                    RAMR0087
      ELSE                                                              RAMR0088
          I = (PSI + 180.0) / GAP + 1                                   RAMR0089
          IF (I.LT.1) I = 1                                             RAMR0090
          IF (I.GT.MAPSIZ) I = MAPSIZ                                   RAMR0091
          J = (PHI + 180.0) / GAP + 1                                   RAMR0092
          IF (J.LT.1) J = 1                                             RAMR0093
          IF (J.GT.MAPSIZ) J = MAPSIZ                                   RAMR0094
          REGNO = MAP(I,J)                                              RAMR0095
          I = 2 * REGNO - 1                                             RAMR0096
          REGION = NEWCOD(I:I+1)                                        RAMR0097
          REGTYP = RTYPE(REGNO)                                         RAMR0098
      ENDIF                                                             RAMR0099
                                                                        RAMR0100
      RETURN                                                            RAMR0101
      END                                                               RAMR0102
                                                                        RAMR0103
      SUBROUTINE GETPSN(IPLOT)                                          GETP0001
C-----------------------------------------------------------------------GETP0002
C                                                                       GETP0003
C  SUBROUTINE GETPSN  -  Read in the next PostScript file number from   GETP0004
C                        ps.number file                                 GETP0005
C                                                                       GETP0006
C----------------------------------------------------------------------+GETP0007
                                                                        GETP0008
      INTEGER       IPLOT                                               GETP0009
                                                                        GETP0010
C---- Open the ps.number file holding the last-used PostScript number   GETP0011
      OPEN(UNIT=12, FILE='ps.number', STATUS='OLD', FORM='FORMATTED',   GETP0012
     &    ACCESS='SEQUENTIAL',                                          GETP0013
CVAX     -    READONLY,                                                 GETP0014
     &    ERR=900)                                                      GETP0015
                                                                        GETP0016
C---- Read in the PostScript number                                     GETP0017
      READ(12,*,END=900,ERR=900) IPLOT                                  GETP0018
                                                                        GETP0019
      GO TO 999                                                         GETP0020
                                                                        GETP0021
C---- File not found, or empty                                          GETP0022
 900  CONTINUE                                                          GETP0023
      IPLOT = 0                                                         GETP0024
                                                                        GETP0025
999   CONTINUE                                                          GETP0026
      CLOSE(12)                                                         GETP0027
                                                                        GETP0028
      RETURN                                                            GETP0029
      END                                                               GETP0030
                                                                        GETP0031
      SUBROUTINE PUTPSN(IPLOT)                                          PUTP0001
C-----------------------------------------------------------------------PUTP0002
C                                                                       PUTP0003
C  SUBROUTINE PUTPSN  -  Write out the next PostScript file number from PUTP0004
C                        ps.number file                                 PUTP0005
C                                                                       PUTP0006
C----------------------------------------------------------------------+PUTP0007
                                                                        PUTP0008
      INTEGER       IPLOT                                               PUTP0009
                                                                        PUTP0010
C---- Open the ps.number file holding the last-used PostScript number   PUTP0011
      OPEN(UNIT=12,FILE='ps.number',STATUS='UNKNOWN',FORM='FORMATTED',  PUTP0012
     &    ACCESS='SEQUENTIAL',                                          PUTP0013
CVAX     -    CARRIAGECONTROL='LIST',                                   PUTP0014
     &    ERR=999)                                                      PUTP0015
                                                                        PUTP0016
C---- Write out the PostScript number                                   PUTP0017
      WRITE(12,*) IPLOT                                                 PUTP0018
                                                                        PUTP0019
C---- Close the file                                                    PUTP0020
      CLOSE(12)                                                         PUTP0021
                                                                        PUTP0022
999   CONTINUE                                                          PUTP0023
      RETURN                                                            PUTP0024
      END                                                               PUTP0025
                                                                        PUTP0026
                                                                        PUTP0027
      SUBROUTINE SHSORT(NSIZE,RARRAY,NINDEX,INDEX)                      SHSO0001
C----------------------------------------------------------------------+SHSO0002
C                                                                       SHSO0003
C  SUBROUTINE SHSORT  -  Sort routine using the SHELL sort method.      SHSO0004
C                        Sorts the real array RARRAY, of size NSIZE, as SHSO0005
C                        indexed by the array INDEX. The latter array   SHSO0006
C                        has pointers to only NINDEX of the elements in SHSO0007
C                        RARRAY. The routine returns the indices in     SHSO0008
C                        INDEX rearranged in descending order of the    SHSO0009
C                        corresponding values in RARRAY.                SHSO0010
C                        [Adapted from Numerical Recipes, Press et al.] SHSO0011
C                                                                       SHSO0012
C-----------------------------------------------------------------------SHSO0013
                                                                        SHSO0014
CVAX      IMPLICIT NONE                                                 SHSO0015
                                                                        SHSO0016
      REAL          ALN2I, TINY                                         SHSO0017
      PARAMETER (ALN2I=1.4426950, TINY=1.E-5)                           SHSO0018
                                                                        SHSO0019
      INTEGER       NSIZE, NINDEX                                       SHSO0020
      INTEGER       INDEX(NINDEX)                                       SHSO0021
      REAL          RARRAY(NSIZE)                                       SHSO0022
                                                                        SHSO0023
      INTEGER       I, ISWAP, J, K, L, LOGNB2, M, N, NN                 SHSO0024
                                                                        SHSO0025
      N = NINDEX                                                        SHSO0026
      LOGNB2 = INT(ALOG(FLOAT(N)) * ALN2I + TINY)                       SHSO0027
      M = N                                                             SHSO0028
      DO 12, NN = 1, LOGNB2                                             SHSO0029
          M = M / 2                                                     SHSO0030
          K = N - M                                                     SHSO0031
          DO 11, J = 1, K                                               SHSO0032
              I = J                                                     SHSO0033
3             CONTINUE                                                  SHSO0034
              L = I + M                                                 SHSO0035
              IF (RARRAY(INDEX(L)).GT.RARRAY(INDEX(I))) THEN            SHSO0036
                  ISWAP = INDEX(I)                                      SHSO0037
                  INDEX(I) = INDEX(L)                                   SHSO0038
                  INDEX(L) = ISWAP                                      SHSO0039
                  I = I - M                                             SHSO0040
                  IF (I.GE.1) GO TO 3                                   SHSO0041
              ENDIF                                                     SHSO0042
11        CONTINUE                                                      SHSO0043
12    CONTINUE                                                          SHSO0044
                                                                        SHSO0045
      RETURN                                                            SHSO0046
      END                                                               SHSO0047
                                                                        SHSO0048
      SUBROUTINE INSORT(NSIZE,IARRAY,NINDEX,INDEX)                      INSO0001
C-----------------------------------------------------------------------INSO0002
C                                                                       INSO0003
C  SUBROUTINE INSORT  -  Sort routine using the SHELL sort method.      INSO0004
C                        Sorts the integer array IARRAY, of size NSIZE, INSO0005
C                        as indexed by the array INDEX. The latter      INSO0006
C                        array has pointers to only      NINDEX of the  INSO0007
C                        elements in IARRAY. The routine returns the    INSO0008
C                        indices in INDEX rearranged in ascending       INSO0009
C                        order of the corresponding values in IARRAY.   INSO0010
C                        [Adapted from Numerical Recipes, Press et al.] INSO0011
C                                                                       INSO0012
C-----------------------------------------------------------------------INSO0013
                                                                        INSO0014
CVAX      IMPLICIT NONE                                                 INSO0015
                                                                        INSO0016
      REAL          ALN2I, TINY                                         INSO0017
      PARAMETER (ALN2I=1.4426950, TINY=1.E-5)                           INSO0018
                                                                        INSO0019
      INTEGER       NSIZE, NINDEX                                       INSO0020
      INTEGER       INDEX(NINDEX)                                       INSO0021
      INTEGER       IARRAY(NSIZE)                                       INSO0022
                                                                        INSO0023
      INTEGER       I, ISWAP, J, K, L, LOGNB2, M, N, NN                 INSO0024
                                                                        INSO0025
      N = NINDEX                                                        INSO0026
      LOGNB2 = INT(ALOG(FLOAT(N)) * ALN2I + TINY)                       INSO0027
      M = N                                                             INSO0028
      DO 12, NN = 1, LOGNB2                                             INSO0029
          M = M / 2                                                     INSO0030
          K = N - M                                                     INSO0031
          DO 11, J = 1, K                                               INSO0032
              I = J                                                     INSO0033
3             CONTINUE                                                  INSO0034
              L = I + M                                                 INSO0035
              IF (IARRAY(INDEX(L)).LT.IARRAY(INDEX(I))) THEN            INSO0036
                  ISWAP = INDEX(I)                                      INSO0037
                  INDEX(I) = INDEX(L)                                   INSO0038
                  INDEX(L) = ISWAP                                      INSO0039
                  I = I - M                                             INSO0040
                  IF (I.GE.1) GO TO 3                                   INSO0041
              ENDIF                                                     INSO0042
11        CONTINUE                                                      INSO0043
12    CONTINUE                                                          INSO0044
                                                                        INSO0045
      RETURN                                                            INSO0046
      END                                                               INSO0047
                                                                        INSO0048
      INTEGER FUNCTION LENSTR(CHARS)                                    LENS0001
C-----------------------------------------------------------------------LENS0002
C                                                                       LENS0003
C  FUNCTION LENSTR  -  Return length of string 'CHARS' excluding        LENS0004
C                      trailing blanks                                  LENS0005
C                                                                       LENS0006
C----------------------------------------------------------------------+LENS0007
                                                                        LENS0008
      CHARACTER*(*) CHARS                                               LENS0009
      INTEGER J, MVAL                                                   LENS0010
                                                                        LENS0011
      MVAL = LEN(CHARS)                                                 LENS0012
      DO 10, J = MVAL, 1, -1                                            LENS0013
          IF (CHARS(J:J).NE.' ') GO TO 20                               LENS0014
   10 CONTINUE                                                          LENS0015
      J = 0                                                             LENS0016
   20 CONTINUE                                                          LENS0017
      LENSTR = J                                                        LENS0018
                                                                        LENS0019
      RETURN                                                            LENS0020
      END                                                               LENS0021
                                                                        LENS0022
      SUBROUTINE ADJLIM(VALMIN,VALMAX,NGAPS,MUSTIN)                     ADJL0001
C-----------------------------------------------------------------------ADJL0002
C                                                                       ADJL0003
C  SUBROUTINE ADJLIM  -  Adjust the maximum and minimum limits for use  ADJL0004
C                        on the graphs                                  ADJL0005
C                                                                       ADJL0006
C----------------------------------------------------------------------+ADJL0007
                                                                        ADJL0008
      INTEGER       MXSPAN                                              ADJL0009
      PARAMETER    (MXSPAN = 40)                                        ADJL0010
                                                                        ADJL0011
      INTEGER       ACTGAP, IGAPS, ISPAN, NBEST(MXSPAN), NFINT(MXSPAN), ADJL0012
     &              NGAPS                                               ADJL0013
      LOGICAL       DONE, HAVGAP, MUSTIN                                ADJL0014
      REAL          GAP, VALTOP(MXSPAN), VALMAX, VALMIN, OTHER, SPAN    ADJL0015
                                                                        ADJL0016
      DATA VALTOP / 0.2, 0.3, 0.4, 0.5, 0.6, 0.8, 1.0, 1.2, 1.5, 2.0,   ADJL0017
     &              2.5, 3.0, 4.0, 5.0, 6.0, 7.5, 8.0, 10.0, 15.0, 20.0,ADJL0018
     &              30.0, 40.0, 50.0, 60.0, 80.0, 100.0, 125.0, 150.0,  ADJL0019
     &              200.0, 250.0, 300.0, 400.0, 500.0, 600.0, 750.0,    ADJL0020
     &              800.0, 1000.0, 1200.0, 1500.0, 2000.0 /             ADJL0021
                                                                        ADJL0022
      DATA NBEST  /   2,   3,   4,   5,   3,   4,   5,   6,   3,   4,   ADJL0023
     &                5,   6,   4,   5,   6,   3,   4,   5,     5,    4,ADJL0024
     &                 6,    4,    5,    6,    4,     5,     5,     3,  ADJL0025
     &                  4,     5,     6,     4,     5,     6,     3,    ADJL0026
     &                  4,     5,       6,      3,      4 /             ADJL0027
                                                                        ADJL0028
      DATA NFINT  /   0,   0,   0,   0,   0,   0,   0,   0,   0,  -1,   ADJL0029
     &                0,  -1,   1,   1,   1,   0,   1,   1,     1,    1,ADJL0030
     &                 1,    1,    1,    1,    1,     1,     1,     1,  ADJL0031
     &                  1,     1,     1,     1,     1,     1,     1,    ADJL0032
     &                  1,     1,       1,      1,      1 /             ADJL0033
                                                                        ADJL0034
C---- Calculate y-extents above and below the y=0 line                  ADJL0035
      SPAN = MAX(ABS(VALMIN),ABS(VALMAX))                               ADJL0036
      OTHER = MIN(ABS(VALMIN),ABS(VALMAX))                              ADJL0037
      DONE = .FALSE.                                                    ADJL0038
      DO 100, ISPAN = 1, MXSPAN                                         ADJL0039
          IF (.NOT.DONE .AND. SPAN.LE.VALTOP(ISPAN)) THEN               ADJL0040
                                                                        ADJL0041
C----         Get the number of gaps for this span                      ADJL0042
              IGAPS = NBEST(ISPAN)                                      ADJL0043
              HAVGAP = .TRUE.                                           ADJL0044
                                                                        ADJL0045
C----         Check whether have to have integral gaps on the axis      ADJL0046
C             and whether this is possible                              ADJL0047
              IF (MUSTIN) THEN                                          ADJL0048
                                                                        ADJL0049
C----             If this is gives gaps with integer labels, then OK    ADJL0050
                  IF (NFINT(ISPAN).EQ.1) THEN                           ADJL0051
                      HAVGAP = .TRUE.                                   ADJL0052
                                                                        ADJL0053
C----             Otherwise, if can force integral labels, then do so   ADJL0054
                  ELSE IF (NFINT(ISPAN).EQ.-1) THEN                     ADJL0055
                      IGAPS = NINT(VALTOP(ISPAN))                       ADJL0056
                      HAVGAP = .TRUE.                                   ADJL0057
                                                                        ADJL0058
                  ELSE                                                  ADJL0059
                      HAVGAP = .FALSE.                                  ADJL0060
                  ENDIF                                                 ADJL0061
              ENDIF                                                     ADJL0062
                                                                        ADJL0063
C----         If have a suitable set of gaps, then store                ADJL0064
              IF (HAVGAP) THEN                                          ADJL0065
                  ACTGAP = IGAPS                                        ADJL0066
                  SPAN = VALTOP(ISPAN)                                  ADJL0067
                  DONE = .TRUE.                                         ADJL0068
              ENDIF                                                     ADJL0069
          ENDIF                                                         ADJL0070
 100  CONTINUE                                                          ADJL0071
                                                                        ADJL0072
C---- Calculate gap size and maximum value for the other side of zero   ADJL0073
      IF (OTHER.NE.0.0) THEN                                            ADJL0074
          GAP = SPAN / ACTGAP                                           ADJL0075
          NGAPS = OTHER / GAP + 1                                       ADJL0076
          OTHER = NGAPS * GAP                                           ADJL0077
          NGAPS = NGAPS + ACTGAP                                        ADJL0078
      ELSE                                                              ADJL0079
          NGAPS = ACTGAP                                                ADJL0080
      ENDIF                                                             ADJL0081
                                                                        ADJL0082
C---- Replace maximum and minimum values by adjusted values             ADJL0083
      IF (ABS(VALMIN).LT.ABS(VALMAX)) THEN                              ADJL0084
          VALMIN = - OTHER                                              ADJL0085
          VALMAX = SPAN                                                 ADJL0086
      ELSE                                                              ADJL0087
          VALMIN = - SPAN                                               ADJL0088
          VALMAX = OTHER                                                ADJL0089
      ENDIF                                                             ADJL0090
                                                                        ADJL0091
      RETURN                                                            ADJL0092
      END                                                               ADJL0093
                                                                        ADJL0094
      SUBROUTINE GETRNG(FNAME,MODFRM,MODTO,RESFRM,RESTO,MAXRNG,MRANGE,  GETR0001
     &    NRANGE,BOTHND,IFAIL)                                          GETR0002
C-----------------------------------------------------------------------GETR0003
C                                                                       GETR0004
C  SUBROUTINE GETRNG  -  Read in the list of residue ranges to be       GETR0005
C                        included in the outputs                        GETR0006
C                                                                       GETR0007
C----------------------------------------------------------------------+GETR0008
                                                                        GETR0009
      INTEGER       MXTOKN, RECLEN, TOKLEN                              GETR0010
      PARAMETER    (MXTOKN = 6, RECLEN = 80, TOKLEN = 5)                GETR0011
                                                                        GETR0012
      INTEGER       MAXRNG                                              GETR0013
                                                                        GETR0014
      CHARACTER*1   CH, TOKCHN(MXTOKN)                                  GETR0015
      CHARACTER*(TOKLEN) DUMMY, TOKEN(MXTOKN)                           GETR0016
      CHARACTER*6   RESFRM(MAXRNG), RESTO(MAXRNG)                       GETR0017
      CHARACTER*(RECLEN) IREC                                           GETR0018
      CHARACTER*(*) FNAME                                               GETR0019
      INTEGER       IPOS, LENSTR, LINE, MODFRM(MAXRNG), MODTO(MAXRNG),  GETR0020
     &              MRANGE, NRANGE, NTOKEN                              GETR0021
      LOGICAL       BOTHND, IFAIL, MODEL                                GETR0022
                                                                        GETR0023
C---- Initialise variables                                              GETR0024
      BOTHND = .FALSE.                                                  GETR0025
      IFAIL = .FALSE.                                                   GETR0026
      LINE = 0                                                          GETR0027
      MRANGE = 0                                                        GETR0028
      NRANGE = 0                                                        GETR0029
                                                                        GETR0030
C---- Open input file defining the ranges of residue of interest        GETR0031
      OPEN(UNIT=16, FILE=FNAME, STATUS='OLD', FORM='FORMATTED',         GETR0032
     &     ACCESS='SEQUENTIAL',                                         GETR0033
CVAX     -     CARRIAGECONTROL = 'LIST', READONLY,                      GETR0034
     &     ERR=900)                                                     GETR0035
                                                                        GETR0036
C---- Read through the file                                             GETR0037
 100  CONTINUE                                                          GETR0038
                                                                        GETR0039
C----     Read in the next residue range and interpret                  GETR0040
          READ(16,120,END=1500,ERR=902) IREC                            GETR0041
 120      FORMAT(A)                                                     GETR0042
          LINE = LINE + 1                                               GETR0043
                                                                        GETR0044
C----     Get first character to check that line hasn't been commented oGETR0045
          CH = IREC(1:1)                                                GETR0046
          IF (CH.NE.'%' .AND. CH.NE.'#') THEN                           GETR0047
                                                                        GETR0048
C----         Check whether this line contains the BOTH keyword         GETR0049
              IPOS = INDEX(IREC,'BOTH')                                 GETR0050
                                                                        GETR0051
C----         If keyword found, then set flag to include only those     GETR0052
C             restraints for which both residues are present in the     GETR0053
C             selected residue ranges                                   GETR0054
              IF (IPOS.GT.0) THEN                                       GETR0055
                  BOTHND = .TRUE.                                       GETR0056
                  CH = '%'                                              GETR0057
              ENDIF                                                     GETR0058
          ENDIF                                                         GETR0059
                                                                        GETR0060
C----     Process the line to extract the model- and residue-ranges     GETR0061
          IF (CH.NE.'%' .AND. CH.NE.'#') THEN                           GETR0062
                                                                        GETR0063
C----         Extract all the tokens (ie separate character-strings) froGETR0064
C             line just read in                                         GETR0065
              CALL GETOKN(IREC,RECLEN,TOKEN,TOKCHN,MXTOKN,TOKLEN,NTOKEN)GETR0066
                                                                        GETR0067
C----         Interpret the tokens, modifying them accordingly          GETR0068
              CALL INTOKN(TOKEN,TOKCHN,MXTOKN,TOKLEN,NTOKEN,DUMMY,MODEL)GETR0069
                                                                        GETR0070
C----         Delete any unwanted tokens (marked for deletion with XXXXXGETR0071
              CALL DELTOK(TOKEN,TOKCHN,MXTOKN,NTOKEN)                   GETR0072
                                                                        GETR0073
C----         Store all the tokens representing current model- or       GETR0074
C             residue-range                                             GETR0075
              CALL STOTOK(TOKEN,TOKCHN,MXTOKN,NTOKEN,MODEL,FNAME,IREC,  GETR0076
     &            LINE,MODFRM,MODTO,RESFRM,RESTO,MAXRNG,NRANGE,MRANGE,  GETR0077
     &            IFAIL)                                                GETR0078
              IF (IFAIL) GO TO 999                                      GETR0079
          ENDIF                                                         GETR0080
                                                                        GETR0081
C---- Loop back for the next record                                     GETR0082
      GO TO 100                                                         GETR0083
                                                                        GETR0084
C---- Close the residue ranges file                                     GETR0085
1500  CONTINUE                                                          GETR0086
      CLOSE(16)                                                         GETR0087
                                                                        GETR0088
C---- If no model ranges defined, assume that all models wanted         GETR0089
      IF (MRANGE.EQ.0) THEN                                             GETR0090
          MRANGE = 1                                                    GETR0091
          MODFRM(MRANGE) = -99999                                       GETR0092
          MODTO(MRANGE) = 99999                                         GETR0093
      ENDIF                                                             GETR0094
                                                                        GETR0095
C---- If no residue ranges defined, assume that all residues wanted     GETR0096
      IF (NRANGE.EQ.0) THEN                                             GETR0097
          NRANGE = 1                                                    GETR0098
          RESFRM(NRANGE) = '*ALL  '                                     GETR0099
          RESTO(NRANGE) = 'XXXXXX'                                      GETR0100
      ENDIF                                                             GETR0101
                                                                        GETR0102
C---- Print the model- and residue-ranges selected                      GETR0103
      CALL PRNRNG(FNAME,MODFRM,MODTO,RESFRM,RESTO,MAXRNG,NRANGE,        GETR0104
     &    MRANGE,BOTHND)                                                GETR0105
                                                                        GETR0106
      GO TO 999                                                         GETR0107
                                                                        GETR0108
C---- Fatal errors                                                      GETR0109
 900  CONTINUE                                                          GETR0110
      PRINT*, '**** Unable to open input file: ', FNAME(1:LENSTR(FNAME))GETR0111
      GO TO 990                                                         GETR0112
                                                                        GETR0113
 902  CONTINUE                                                          GETR0114
      PRINT*, '**** File error reading file ', FNAME(1:LENSTR(FNAME)),  GETR0115
     &    ' at line', LINE + 1                                          GETR0116
      GO TO 990                                                         GETR0117
                                                                        GETR0118
 990  CONTINUE                                                          GETR0119
      IFAIL = .TRUE.                                                    GETR0120
                                                                        GETR0121
 999  CONTINUE                                                          GETR0122
      RETURN                                                            GETR0123
      END                                                               GETR0124
                                                                        GETR0125
      SUBROUTINE GETOKN(IREC,RECLEN,TOKEN,TOKCHN,MXTOKN,TOKLEN,NTOKEN)  GETO0001
C-----------------------------------------------------------------------GETO0002
C                                                                       GETO0003
C  SUBROUTINE GETOKN  -  Extract all the tokens (ie separate            GETO0004
C                        character-strings) from the line just read in  GETO0005
C                                                                       GETO0006
C----------------------------------------------------------------------+GETO0007
                                                                        GETO0008
      INTEGER       MXTOKN, RECLEN, TOKLEN                              GETO0009
                                                                        GETO0010
      CHARACTER*1   CH, TOKCHN(MXTOKN)                                  GETO0011
      CHARACTER*(*) TOKEN(MXTOKN)                                       GETO0012
      CHARACTER*52  LETTER                                              GETO0013
      CHARACTER*(*) IREC                                                GETO0014
      INTEGER       IPOS, IPSTN, ITOKEN, IVALUE, NTOKEN                 GETO0015
                                                                        GETO0016
      DATA LETTER( 1:26) / 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'/                GETO0017
      DATA LETTER(27:52) / 'abcdefghijklmnopqrstuvwxyz'/                GETO0018
                                                                        GETO0019
C---- Initialise variables for extraction of information from           GETO0020
C     the line just read in                                             GETO0021
      IPSTN = 0                                                         GETO0022
      IPOS = 0                                                          GETO0023
      DO 200, ITOKEN = 1, MXTOKN                                        GETO0024
          TOKEN(ITOKEN) = ' '                                           GETO0025
          TOKCHN(ITOKEN) = ' '                                          GETO0026
 200  CONTINUE                                                          GETO0027
      ITOKEN = 0                                                        GETO0028
                                                                        GETO0029
C---- Search the line for each token and store                          GETO0030
 400  CONTINUE                                                          GETO0031
          IPOS = IPOS + 1                                               GETO0032
                                                                        GETO0033
C----     If have a space, then check if have just ended a token        GETO0034
          IF (IREC(IPOS:IPOS).EQ.' ') THEN                              GETO0035
                                                                        GETO0036
C----         If currently saving a token, then have reached its end    GETO0037
              IPSTN = 0                                                 GETO0038
                                                                        GETO0039
C----     Otherwise, if this is a character, then store in the          GETO0040
C         current token                                                 GETO0041
          ELSE                                                          GETO0042
                                                                        GETO0043
C----         If this is the start of a new token, increment            GETO0044
C             token-count                                               GETO0045
              IF (IPSTN.EQ.0) THEN                                      GETO0046
                  ITOKEN = ITOKEN + 1                                   GETO0047
              ENDIF                                                     GETO0048
                                                                        GETO0049
C----         Process providing we haven't exceeded number of tokens    GETO0050
C             allowed                                                   GETO0051
              IF (ITOKEN.LE.MXTOKN) THEN                                GETO0052
                                                                        GETO0053
C----             Increment position in the current token               GETO0054
                  IPSTN = IPSTN + 1                                     GETO0055
                                                                        GETO0056
C----             Convert the character into upper-case if necessary    GETO0057
                  CH = IREC(IPOS:IPOS)                                  GETO0058
                  IF (LGE(CH,'a') .AND. LLE(CH,'z')) THEN               GETO0059
                      IVALUE = INDEX(LETTER,CH) - 26                    GETO0060
                      CH = LETTER(IVALUE:IVALUE)                        GETO0061
                  ENDIF                                                 GETO0062
                                                                        GETO0063
C----             Store the current character in the token              GETO0064
                  IF (IPSTN.LE.TOKLEN) THEN                             GETO0065
                      TOKEN(ITOKEN)(IPSTN:IPSTN) = CH                   GETO0066
                  ENDIF                                                 GETO0067
              ENDIF                                                     GETO0068
          ENDIF                                                         GETO0069
      IF (IPOS.LT.RECLEN) GO TO 400                                     GETO0070
                                                                        GETO0071
C---- Save the number of tokens read in fom this line                   GETO0072
      NTOKEN = MIN(ITOKEN,MXTOKN)                                       GETO0073
                                                                        GETO0074
      RETURN                                                            GETO0075
      END                                                               GETO0076
                                                                        GETO0077
      SUBROUTINE INTOKN(TOKEN,TOKCHN,MXTOKN,TOKLEN,NTOKEN,DUMMY,MODEL)  INTO0001
C-----------------------------------------------------------------------INTO0002
C                                                                       INTO0003
C  SUBROUTINE INTOKN  -  Interpret the current line's tokens            INTO0004
C                                                                       INTO0005
C----------------------------------------------------------------------+INTO0006
                                                                        INTO0007
      INTEGER       MXTOKN, TOKLEN                                      INTO0008
                                                                        INTO0009
      CHARACTER*1   CH, CHAIN, TOKCHN(MXTOKN)                           INTO0010
      CHARACTER*(*) DUMMY, TOKEN(MXTOKN)                                INTO0011
      INTEGER       ILEN, ITOKEN, JTOKEN, LENSTR, LTOKEN,               INTO0012
     &              NTOKEN                                              INTO0013
      LOGICAL       MODEL                                               INTO0014
                                                                        INTO0015
C---- Initialise variables for interpretation of tokens                 INTO0016
      CHAIN = ' '                                                       INTO0017
      LTOKEN = 0                                                        INTO0018
      MODEL = .FALSE.                                                   INTO0019
                                                                        INTO0020
C---- Check whether this is a MODEL range                               INTO0021
      IF (TOKEN(1).EQ.'MODEL') THEN                                     INTO0022
          MODEL = .TRUE.                                                INTO0023
          TOKCHN(1) = 'X'                                               INTO0024
          TOKEN(1) = 'XXXXX'                                            INTO0025
      ENDIF                                                             INTO0026
                                                                        INTO0027
C---- If this is a residue line, then mark token for deletion           INTO0028
      IF (TOKEN(1)(1:3).EQ.'RES') THEN                                  INTO0029
          TOKCHN(1) = 'X'                                               INTO0030
          TOKEN(1) = 'XXXXX'                                            INTO0031
      ENDIF                                                             INTO0032
                                                                        INTO0033
C---- Process all the stored tokens                                     INTO0034
      DO 800, ITOKEN = 1, NTOKEN                                        INTO0035
                                                                        INTO0036
C----     Check if this is a chain identifier                           INTO0037
          CH = TOKEN(ITOKEN)(1:1)                                       INTO0038
          IF (TOKEN(ITOKEN)(2:2).EQ.' ' .AND.                           INTO0039
     &        LGE(CH,'A') .AND. LLE(CH,'Z')) THEN                       INTO0040
              CHAIN = CH                                                INTO0041
                                                                        INTO0042
C----         If this is the first token of this chain, treat           INTO0043
C             as though an "ALL" entry                                  INTO0044
              IF (ITOKEN - LTOKEN.EQ.1) THEN                            INTO0045
                  TOKEN(ITOKEN) = 'ALL'                                 INTO0046
                  TOKCHN(ITOKEN) = CHAIN                                INTO0047
                                                                        INTO0048
C----         Otherwise, update all prior tokens with this chain        INTO0049
              ELSE                                                      INTO0050
                  DO 600, JTOKEN = LTOKEN + 1, ITOKEN - 1               INTO0051
                      IF (TOKCHN(JTOKEN).EQ.' ')                        INTO0052
     &                    TOKCHN(JTOKEN) = CHAIN                        INTO0053
 600              CONTINUE                                              INTO0054
                                                                        INTO0055
C----             Mark the current token for deletion                   INTO0056
                  TOKCHN(ITOKEN) = 'X'                                  INTO0057
                  TOKEN(ITOKEN) = 'XXXXX'                               INTO0058
              ENDIF                                                     INTO0059
              LTOKEN = ITOKEN                                           INTO0060
                                                                        INTO0061
C----     If it is one of the Reserved words, then leave alone          INTO0062
          ELSE IF (TOKEN(ITOKEN).EQ.'ALL  ' .OR.                        INTO0063
     &        TOKEN(ITOKEN).EQ.'FIRST' .OR.                             INTO0064
     &        TOKEN(ITOKEN).EQ.'LAST ') THEN                            INTO0065
                                                                        INTO0066
C----     If this is a 'TO' string, then just mark for deletion         INTO0067
          ELSE IF (TOKEN(ITOKEN).EQ.'TO   ') THEN                       INTO0068
              TOKCHN(ITOKEN) = 'X'                                      INTO0069
              TOKEN(ITOKEN) = 'XXXXX'                                   INTO0070
                                                                        INTO0071
C----     Otherwise, assume this is a residue- or model-number, so      INTO0072
C         shift it into the correct column positions                    INTO0073
          ELSE                                                          INTO0074
                                                                        INTO0075
C----         Right-justify the token string                            INTO0076
              ILEN = LENSTR(TOKEN(ITOKEN))                              INTO0077
              DUMMY = ' '                                               INTO0078
              DUMMY(TOKLEN - ILEN + 1:) = TOKEN(ITOKEN)                 INTO0079
              TOKEN(ITOKEN) = DUMMY                                     INTO0080
                                                                        INTO0081
C----         If this is not a model-number, or the last character is   INTO0082
C             a letter of an insertion code, take that to be an         INTO0083
C             insertion code, so keep whole token right-justified       INTO0084
              CH = TOKEN(ITOKEN)(TOKLEN:TOKLEN)                         INTO0085
              IF (MODEL .OR. (LGE(CH,'A') .AND. LLE(CH,'Z'))) THEN      INTO0086
                                                                        INTO0087
C----         Otherwise, shift back a character                         INTO0088
              ELSE                                                      INTO0089
                  DUMMY = TOKEN(ITOKEN)(2:)                             INTO0090
                  TOKEN(ITOKEN) = DUMMY                                 INTO0091
              ENDIF                                                     INTO0092
          ENDIF                                                         INTO0093
 800   CONTINUE                                                         INTO0094
                                                                        INTO0095
      RETURN                                                            INTO0096
      END                                                               INTO0097
                                                                        INTO0098
      SUBROUTINE DELTOK(TOKEN,TOKCHN,MXTOKN,NTOKEN)                     DELT0001
C-----------------------------------------------------------------------DELT0002
C                                                                       DELT0003
C  SUBROUTINE DELTOK  -  Delete unwanted tokens                         DELT0004
C                                                                       DELT0005
C----------------------------------------------------------------------+DELT0006
                                                                        DELT0007
      INTEGER       MXTOKN                                              DELT0008
                                                                        DELT0009
      CHARACTER*1   TOKCHN(MXTOKN)                                      DELT0010
      CHARACTER*(*) TOKEN(MXTOKN)                                       DELT0011
      INTEGER       ITOKEN, JTOKEN, NTOKEN                              DELT0012
                                                                        DELT0013
C---- Initialise location of next free token                            DELT0014
      JTOKEN = 0                                                        DELT0015
                                                                        DELT0016
C---- Loop through all the tokens, overwriting any deleted ones         DELT0017
      DO 1000, ITOKEN = 1, NTOKEN                                       DELT0018
                                                                        DELT0019
C----     If token a valid one, then move to next available spot        DELT0020
          IF (TOKEN(ITOKEN).NE.'XXXXX') THEN                            DELT0021
              JTOKEN = JTOKEN + 1                                       DELT0022
              IF (JTOKEN.LT.ITOKEN) THEN                                DELT0023
                  TOKEN(JTOKEN) = TOKEN(ITOKEN)                         DELT0024
                  TOKCHN(JTOKEN) = TOKCHN(ITOKEN)                       DELT0025
              ENDIF                                                     DELT0026
          ENDIF                                                         DELT0027
 1000 CONTINUE                                                          DELT0028
                                                                        DELT0029
C---- Save the adjusted number of tokens stored                         DELT0030
      NTOKEN = MIN(JTOKEN,MXTOKN)                                       DELT0031
                                                                        DELT0032
      RETURN                                                            DELT0033
      END                                                               DELT0034
                                                                        DELT0035
      SUBROUTINE STOTOK(TOKEN,TOKCHN,MXTOKN,NTOKEN,MODEL,FNAME,IREC,    STOT0001
     &    LINE,MODFRM,MODTO,RESFRM,RESTO,MAXRNG,NRANGE,MRANGE,IFAIL)    STOT0002
C-----------------------------------------------------------------------STOT0003
C                                                                       STOT0004
C  SUBROUTINE STOTOK  -  Store all the tokens representing current modelSTOT0005
C                        or residue-range                               STOT0006
C                                                                       STOT0007
C----------------------------------------------------------------------+STOT0008
                                                                        STOT0009
      INTEGER       MAXRNG, MXTOKN                                      STOT0010
                                                                        STOT0011
      CHARACTER*1   TOKCHN(MXTOKN)                                      STOT0012
      CHARACTER*6   RESFRM(MAXRNG), RESTO(MAXRNG)                       STOT0013
      CHARACTER*(*) FNAME, IREC, TOKEN(MXTOKN)                          STOT0014
      INTEGER       IVAL1, IVAL2, LENSTR, LINE, MODFRM(MAXRNG),         STOT0015
     &              MODTO(MAXRNG), MRANGE, NRANGE,                      STOT0016
     &              NTOKEN                                              STOT0017
      LOGICAL       IFAIL, MODEL, VALID                                 STOT0018
                                                                        STOT0019
C---- If the tokens are for a model range, then store first and last    STOT0020
C     model numbers                                                     STOT0021
      IF (MODEL .AND. NTOKEN.GT.0) THEN                                 STOT0022
          VALID = .TRUE.                                                STOT0023
                                                                        STOT0024
C----     If all models required, then set range as all-encompassing    STOT0025
          IF (TOKEN(1).EQ.'ALL  ') THEN                                 STOT0026
              IVAL1 = -99999                                            STOT0027
              IVAL2 = 99999                                             STOT0028
              MODFRM(1) = IVAL1                                         STOT0029
              MODTO(1) = IVAL2                                          STOT0030
                                                                        STOT0031
C----     Otherwise, interpret model-number range                       STOT0032
          ELSE                                                          STOT0033
                                                                        STOT0034
C----         If FIRST model defined, store start                       STOT0035
              IF (TOKEN(1).EQ.'FIRST') THEN                             STOT0036
                  IVAL1 = -99999                                        STOT0037
              ELSE                                                      STOT0038
                  READ(TOKEN(1),1020,ERR=1060) IVAL1                    STOT0039
 1020             FORMAT(I5)                                            STOT0040
                  GO TO 1100                                            STOT0041
 1060             CONTINUE                                              STOT0042
                  PRINT*, '*** Warning. Invalid model number: [',       STOT0043
     &                TOKEN(1), '] in line', LINE, '  of file',         STOT0044
     &                FNAME(1:LENSTR(FNAME))                            STOT0045
                  PRINT*, '***          Line ignored: [',               STOT0046
     &                IREC(1:LENSTR(IREC))                              STOT0047
                  VALID = .FALSE.                                       STOT0048
              ENDIF                                                     STOT0049
                                                                        STOT0050
C----         Interpret end model-number of range                       STOT0051
 1100         CONTINUE                                                  STOT0052
                                                                        STOT0053
C----         If LAST model defined, store end                          STOT0054
              IF (TOKEN(2).EQ.'LAST') THEN                              STOT0055
                  IVAL2 = 99999                                         STOT0056
                                                                        STOT0057
C----         If no second model number, then range consists of a       STOT0058
C             single model number                                       STOT0059
              ELSE IF (TOKEN(2).EQ.'XXXXX') THEN                        STOT0060
                  IVAL2 = IVAL1                                         STOT0061
                                                                        STOT0062
C----         Otherwise assume it is a model number                     STOT0063
              ELSE                                                      STOT0064
                  READ(TOKEN(2),1020,ERR=1160) IVAL2                    STOT0065
                  GO TO 1200                                            STOT0066
 1160             CONTINUE                                              STOT0067
                  PRINT*, '*** Warning. Invalid model number: [',       STOT0068
     &                TOKEN(2), '] in line', LINE, '  of file',         STOT0069
     &                FNAME(1:LENSTR(FNAME))                            STOT0070
                  PRINT*, '***          Line ignored: [',               STOT0071
     &                IREC(1:LENSTR(IREC))                              STOT0072
                  VALID = .FALSE.                                       STOT0073
 1200             CONTINUE                                              STOT0074
              ENDIF                                                     STOT0075
          ENDIF                                                         STOT0076
                                                                        STOT0077
C----     If have a valid range, then store                             STOT0078
          IF (VALID) THEN                                               STOT0079
              MRANGE = MRANGE + 1                                       STOT0080
              IF (MRANGE.GT.MAXRNG) GO TO 910                           STOT0081
              MODFRM(MRANGE) = IVAL1                                    STOT0082
              MODTO(MRANGE) = IVAL2                                     STOT0083
          ENDIF                                                         STOT0084
                                                                        STOT0085
C---- Otherwise, store the residue range                                STOT0086
      ELSE IF (NTOKEN.GT.0) THEN                                        STOT0087
          NRANGE = NRANGE + 1                                           STOT0088
          IF (NRANGE.GT.MAXRNG) GO TO 908                               STOT0089
          RESFRM(NRANGE) = TOKCHN(1) // TOKEN(1)                        STOT0090
          RESTO(NRANGE) = TOKCHN(2) // TOKEN(2)                         STOT0091
      ENDIF                                                             STOT0092
                                                                        STOT0093
      GO TO 999                                                         STOT0094
                                                                        STOT0095
C---- Fatal errors                                                      STOT0096
 908  CONTINUE                                                          STOT0097
      PRINT*, '**** Maximum number of residue ranges exceeded in file ',STOT0098
     &    FNAME(1:LENSTR(FNAME)), '  MAXRNG =', MAXRNG                  STOT0099
      GO TO 990                                                         STOT0100
                                                                        STOT0101
 910  CONTINUE                                                          STOT0102
      PRINT*, '**** Maximum number of model ranges exceeded in file ',  STOT0103
     &    FNAME(1:LENSTR(FNAME)), '  MAXRNG =', MAXRNG                  STOT0104
      GO TO 990                                                         STOT0105
                                                                        STOT0106
 990  CONTINUE                                                          STOT0107
      IFAIL = .TRUE.                                                    STOT0108
                                                                        STOT0109
 999  CONTINUE                                                          STOT0110
      RETURN                                                            STOT0111
      END                                                               STOT0112
                                                                        STOT0113
      SUBROUTINE PRNRNG(FNAME,MODFRM,MODTO,RESFRM,RESTO,MAXRNG,NRANGE,  PRNR0001
     &    MRANGE,BOTHND)                                                PRNR0002
C-----------------------------------------------------------------------PRNR0003
C                                                                       PRNR0004
C  SUBROUTINE PRNRNG  -  Print out the model- and residue ranges        PRNR0005
C                                                                       PRNR0006
C----------------------------------------------------------------------+PRNR0007
                                                                        PRNR0008
      INTEGER       MAXRNG                                              PRNR0009
                                                                        PRNR0010
      CHARACTER*6   RESFRM(MAXRNG), RESTO(MAXRNG)                       PRNR0011
      CHARACTER*(*) FNAME                                               PRNR0012
      CHARACTER*80  IREC                                                PRNR0013
      INTEGER       ILEN, IRANGE, LENSTR, MODFRM(MAXRNG), MODTO(MAXRNG),PRNR0014
     &              MRANGE, NRANGE                                      PRNR0015
      LOGICAL       BOTHND,VALID                                        PRNR0016
                                                                        PRNR0017
C---- Print heading                                                     PRNR0018
      PRINT 20, FNAME(1:LENSTR(FNAME))                                  PRNR0019
 20   FORMAT('*',/,'*',/,                                               PRNR0020
     &    '*  Model and residue ranges selected in file: ',A,/,         PRNR0021
     &    '*  ------------------------------------------',/,'*')        PRNR0022
                                                                        PRNR0023
C---- Model-number range                                                PRNR0024
      IF (MODFRM(1).EQ.-99999 .AND. MODTO(1).EQ.99999) THEN             PRNR0025
          PRINT 120, '*      ALL models in the ensemble'                PRNR0026
 120      FORMAT(A)                                                     PRNR0027
      ELSE                                                              PRNR0028
          DO 400, IRANGE = 1, MRANGE                                    PRNR0029
                                                                        PRNR0030
C----         Retrieve start of model-number range                      PRNR0031
              IF (MODFRM(IRANGE).EQ.-99999) THEN                        PRNR0032
                  IREC = 'From FIRST model'                             PRNR0033
              ELSE                                                      PRNR0034
                  WRITE(IREC,140) MODFRM(IRANGE)                        PRNR0035
 140              FORMAT('From model ',I5)                              PRNR0036
              ENDIF                                                     PRNR0037
                                                                        PRNR0038
C----         Retrieve end of model-number range                        PRNR0039
              IF (MODTO(IRANGE).EQ.99999) THEN                          PRNR0040
                  IREC(17:) = ' to LAST model'                          PRNR0041
              ELSE                                                      PRNR0042
                  WRITE(IREC(17:),160) MODTO(IRANGE)                    PRNR0043
 160              FORMAT(' to model ',I5)                               PRNR0044
              ENDIF                                                     PRNR0045
                                                                        PRNR0046
C----         Show the interpreted range                                PRNR0047
              PRINT 180, '*      ', IREC(1:31)                          PRNR0048
 180          FORMAT(2A)                                                PRNR0049
 400      CONTINUE                                                      PRNR0050
      ENDIF                                                             PRNR0051
      PRINT 120, '* '                                                   PRNR0052
                                                                        PRNR0053
C---- Residue-number range                                              PRNR0054
      IF (RESFRM(1).EQ.'*ALL  ') THEN                                   PRNR0055
          PRINT 120, '*      ALL residues'                              PRNR0056
      ELSE                                                              PRNR0057
          DO 800, IRANGE = 1, NRANGE                                    PRNR0058
                                                                        PRNR0059
C----         Retrieve start of residue-number range                    PRNR0060
              IF (RESFRM(IRANGE)(2:).EQ.'ALL  ') THEN                   PRNR0061
                  IREC = 'All residues'                                 PRNR0062
                  ILEN = 12                                             PRNR0063
              ELSE IF (RESFRM(IRANGE)(2:).EQ.'FIRST') THEN              PRNR0064
                  IREC = 'From FIRST residue'                           PRNR0065
                  ILEN = 18                                             PRNR0066
              ELSE                                                      PRNR0067
                  WRITE(IREC,640) RESFRM(IRANGE)(2:)                    PRNR0068
 640              FORMAT('From residue ',A5)                            PRNR0069
                  ILEN = 18                                             PRNR0070
              ENDIF                                                     PRNR0071
                                                                        PRNR0072
C----         Add chain identifier, if required                         PRNR0073
              IF (RESFRM(IRANGE)(1:1).NE.' ') THEN                      PRNR0074
                  IREC(ILEN + 1:) = ' in chain [' //                    PRNR0075
     &                RESFRM(IRANGE)(1:1) // ']'                        PRNR0076
                  ILEN = ILEN + 13                                      PRNR0077
              ENDIF                                                     PRNR0078
                                                                        PRNR0079
C----         Retrieve end of residue-number range                      PRNR0080
              VALID = .FALSE.                                           PRNR0081
              IF (RESTO(IRANGE)(2:).EQ.'LAST ') THEN                    PRNR0082
                  IREC(ILEN + 1:) = ' to LAST residue'                  PRNR0083
                  ILEN = ILEN + 16                                      PRNR0084
                  VALID = .TRUE.                                        PRNR0085
              ELSE IF (RESTO(IRANGE)(2:).NE.'XXXXX') THEN               PRNR0086
                  WRITE(IREC(ILEN + 1:),660) RESTO(IRANGE)(2:)          PRNR0087
 660              FORMAT(' to residue ',A5)                             PRNR0088
                  ILEN = ILEN + 17                                      PRNR0089
                  VALID = .TRUE.                                        PRNR0090
              ENDIF                                                     PRNR0091
                                                                        PRNR0092
C----         Add chain identifier, if required                         PRNR0093
              IF (VALID .AND. RESTO(IRANGE)(1:1).NE.' ') THEN           PRNR0094
                  IREC(ILEN + 1:) = ' in chain [' //                    PRNR0095
     &                RESTO(IRANGE)(1:1) // ']'                         PRNR0096
                  ILEN = ILEN + 13                                      PRNR0097
              ENDIF                                                     PRNR0098
                                                                        PRNR0099
C----         Show the interpreted range                                PRNR0100
              PRINT 180, '*      ', IREC(1:ILEN)                        PRNR0101
 800      CONTINUE                                                      PRNR0102
      ENDIF                                                             PRNR0103
      PRINT 120, '* '                                                   PRNR0104
      IF (BOTHND) THEN                                                  PRNR0105
          PRINT 120, '* Restraints only where both residues are sele' //PRNR0106
     &        'cted'                                                    PRNR0107
          PRINT 120, '* '                                               PRNR0108
      ENDIF                                                             PRNR0109
                                                                        PRNR0110
      RETURN                                                            PRNR0111
      END                                                               PRNR0112
                                                                        PRNR0113
      SUBROUTINE GETWNT(MXFILE,NFILE,FILRIN,FFILE,MAXRNG,MODFRM,MODTO,  GETW0001
     &    MRANGE,RSELEC,MWANT,NMODEL,MODNUM,ACTNUM,TOPMOD,TITLE,NAMLEN, GETW0002
     &    TLEN,IFAIL)                                                   GETW0003
C-----------------------------------------------------------------------GETW0004
C                                                                       GETW0005
C  SUBROUTINE GETWNT  -  For an NMR ensemble, identify which files      GETW0006
C                        contain the wanted models (ie those specified  GETW0007
C                        by the user in the ranges file)                GETW0008
C                                                                       GETW0009
C----------------------------------------------------------------------+GETW0010
                                                                        GETW0011
      INTEGER       MAXRNG, MXFILE, NFILE                               GETW0012
                                                                        GETW0013
      CHARACTER*3   NUMBER                                              GETW0014
      CHARACTER*78  TITLE                                               GETW0015
      CHARACTER*80  FILRIN(MXFILE), IREC                                GETW0016
      INTEGER       ACTNUM(MXFILE), FFILE, IERR, IFAIL, IFILE, IMODEL,  GETW0017
     &              IPOS, MODFRM(MAXRNG), MODNUM(MXFILE), MODTO(MAXRNG),GETW0018
     &              MRANGE, NAMLEN, NMODEL, TLEN, TOPMOD                GETW0019
      LOGICAL       FOUND, INMODL, MWANT(MXFILE), RSELEC, WANTED        GETW0020
                                                                        GETW0021
C---- Initialise file number                                            GETW0022
      FOUND = .FALSE.                                                   GETW0023
      FFILE = 0                                                         GETW0024
      NMODEL = 0                                                        GETW0025
      TOPMOD = -99                                                      GETW0026
                                                                        GETW0027
C---- Loop through all the .rin files                                   GETW0028
      DO 500, IFILE = 1, NFILE                                          GETW0029
                                                                        GETW0030
C----     Open the corresponding file                                   GETW0031
          OPEN(UNIT=4,FILE=FILRIN(IFILE),STATUS='OLD',                  GETW0032
     &        ACCESS='SEQUENTIAL',                                      GETW0033
CVAX     -        READONLY,                                             GETW0034
     &        FORM='FORMATTED',ERR=900)                                 GETW0035
                                                                        GETW0036
C----     Read the first record                                         GETW0037
          READ(4,220,END=900) IREC                                      GETW0038
 220      FORMAT(A)                                                     GETW0039
                                                                        GETW0040
C----     Check whether the first record contains the actual model      GETW0041
C         number                                                        GETW0042
          READ(4,320,END=902) IREC                                      GETW0043
 320      FORMAT(A)                                                     GETW0044
          IF (IREC(1:5).EQ.'MODEL') THEN                                GETW0045
             READ(IREC,360,IOSTAT=IERR) IMODEL                          GETW0046
 360         FORMAT(9X,I5)                                              GETW0047
             IF (IERR.NE.0) THEN                                        GETW0048
                IMODEL = IFILE                                          GETW0049
             ENDIF                                                      GETW0050
          ELSE                                                          GETW0051
             IMODEL = IFILE                                             GETW0052
          ENDIF                                                         GETW0053
                                                                        GETW0054
C----     Check whether this model is one of the ones wanted            GETW0055
          WANTED = INMODL(IMODEL,MODFRM,MODTO,MAXRNG,MRANGE)            GETW0056
          MWANT(IFILE) = WANTED                                         GETW0057
          IF (WANTED) THEN                                              GETW0058
              FOUND = .TRUE.                                            GETW0059
              IF (FFILE.EQ.0) FFILE = IFILE                             GETW0060
              NMODEL = NMODEL + 1                                       GETW0061
              MODNUM(NMODEL) = IFILE                                    GETW0062
              ACTNUM(NMODEL) = IMODEL                                   GETW0063
              TOPMOD = MAX(IMODEL,TOPMOD)                               GETW0064
          ENDIF                                                         GETW0065
                                                                        GETW0066
C----     Close the file                                                GETW0067
          CLOSE(4)                                                      GETW0068
                                                                        GETW0069
C---- Loop back if no hits found                                        GETW0070
 500  CONTINUE                                                          GETW0071
                                                                        GETW0072
C---- If still no hits found, then don't have anything to plot!         GETW0073
      IF (.NOT.FOUND) GO TO 904                                         GETW0074
                                                                        GETW0075
C---- If have selected fewer models than there are in the ensemble, thenGETW0076
C     modify general plot subtitle                                      GETW0077
      IF (NMODEL.LT.NFILE) THEN                                         GETW0078
          WRITE(NUMBER,520) NMODEL                                      GETW0079
 520      FORMAT(I3)                                                    GETW0080
          IPOS = 1                                                      GETW0081
          IF (NUMBER(1:1).EQ.' ') IPOS = 2                              GETW0082
          IF (NUMBER(2:2).EQ.' ') IPOS = 3                              GETW0083
          TITLE = TITLE(1:NAMLEN + 2) // NUMBER(IPOS:) // ' of ' //     GETW0084
     &         TITLE(NAMLEN + 3:)                                       GETW0085
          TLEN = TLEN + 8 - IPOS                                        GETW0086
      ENDIF                                                             GETW0087
                                                                        GETW0088
C---- If there is a selection on the residue ranges, then identify this GETW0089
C     also on the general plot subtitle                                 GETW0090
      IF (RSELEC) THEN                                                  GETW0091
          TITLE = TITLE(1:TLEN) // '**'                                 GETW0092
          TLEN = TLEN + 2                                               GETW0093
      ENDIF                                                             GETW0094
                                                                        GETW0095
      GO TO 999                                                         GETW0096
                                                                        GETW0097
 900  CONTINUE                                                          GETW0098
      PRINT*, '*** Error opening .rin file.'                            GETW0099
      PRINT*, FILRIN(IFILE)                                             GETW0100
      GO TO 990                                                         GETW0101
                                                                        GETW0102
 902  CONTINUE                                                          GETW0103
      PRINT*, '*** Data error reading .rin file.'                       GETW0104
      PRINT*, FILRIN(IFILE)                                             GETW0105
      GO TO 990                                                         GETW0106
                                                                        GETW0107
 904  CONTINUE                                                          GETW0108
      PRINT*, '*** ERROR. No models within supplied ranges found!'      GETW0109
      GO TO 990                                                         GETW0110
                                                                        GETW0111
990   CONTINUE                                                          GETW0112
      IFAIL = .TRUE.                                                    GETW0113
                                                                        GETW0114
999   CONTINUE                                                          GETW0115
      RETURN                                                            GETW0116
      END                                                               GETW0117
                                                                        GETW0118
      LOGICAL FUNCTION INMODL(IMODEL,MODFRM,MODTO,MAXRNG,MRANGE)        INMO0001
C-----------------------------------------------------------------------INMO0002
C                                                                       INMO0003
C  FUNCTION INMODL  -  Check whether supplied model-number is within    INMO0004
C                      one or more of the ranges defined by the user    INMO0005
C                                                                       INMO0006
C----------------------------------------------------------------------+INMO0007
                                                                        INMO0008
      INTEGER       MAXRNG                                              INMO0009
                                                                        INMO0010
      INTEGER       IMODEL, IRANGE, MODFRM(MAXRNG), MODTO(MAXRNG),      INMO0011
     &              MRANGE                                              INMO0012
      LOGICAL       MATCHF, MATCHL, WANTED                              INMO0013
                                                                        INMO0014
                                                                        INMO0015
C---- Initialise                                                        INMO0016
      WANTED = .FALSE.                                                  INMO0017
                                                                        INMO0018
C---- Loop through all the defined model ranges and check model number  INMO0019
C     against each one                                                  INMO0020
      DO 500, IRANGE = 1, MRANGE                                        INMO0021
                                                                        INMO0022
C----     Initialise flags for this range (first and last parameters)   INMO0023
          MATCHF = .FALSE.                                              INMO0024
          MATCHL = .FALSE.                                              INMO0025
                                                                        INMO0026
C----     Check for lower-bound                                         INMO0027
          IF (IMODEL.GE.MODFRM(IRANGE)) THEN                            INMO0028
              MATCHF = .TRUE.                                           INMO0029
          ENDIF                                                         INMO0030
                                                                        INMO0031
C----     Check for upper-bound                                         INMO0032
          IF (IMODEL.LE.MODTO(IRANGE)) THEN                             INMO0033
              MATCHL = .TRUE.                                           INMO0034
          ENDIF                                                         INMO0035
                                                                        INMO0036
C----     If model satisfies both the first and last parameters, then   INMO0037
C         it is wanted                                                  INMO0038
          IF (MATCHF .AND. MATCHL) WANTED = .TRUE.                      INMO0039
500   CONTINUE                                                          INMO0040
                                                                        INMO0041
C---- Return the result                                                 INMO0042
      INMODL = WANTED                                                   INMO0043
                                                                        INMO0044
      RETURN                                                            INMO0045
      END                                                               INMO0046
                                                                        INMO0047
      LOGICAL FUNCTION INRANG(RESNUM,CHAIN,RESFRM,RESTO,MAXRNG,NRANGE)  INRA0001
C-----------------------------------------------------------------------INRA0002
C                                                                       INRA0003
C  FUNCTION INRANG  -  Check whether supplied residue is within one or  INRA0004
C                      more of the ranges defined by the user           INRA0005
C                                                                       INRA0006
C----------------------------------------------------------------------+INRA0007
                                                                        INRA0008
      INTEGER       MAXRNG                                              INRA0009
                                                                        INRA0010
      CHARACTER*1   CH, CHAIN                                           INRA0011
      CHARACTER*5   DUMMY, RESNUM                                       INRA0012
      CHARACTER*6   RESFRM(MAXRNG), RESID, RESTO(MAXRNG)                INRA0013
      INTEGER       ILEN, IRANGE, LENSTR, NRANGE                        INRA0014
      LOGICAL       MATCHF, MATCHL, WANTED                              INRA0015
                                                                        INRA0016
                                                                        INRA0017
C---- If all residues selected, then don't need to perform any more testINRA0018
      IF (RESFRM(1).EQ.'*ALL  ') THEN                                   INRA0019
          WANTED = .TRUE.                                               INRA0020
                                                                        INRA0021
C---- Otherwise, test whether this residue is required                  INRA0022
      ELSE                                                              INRA0023
                                                                        INRA0024
C----     Right-justify the entered number                              INRA0025
          ILEN = LENSTR(RESNUM)                                         INRA0026
          DUMMY = ' '                                                   INRA0027
          DUMMY(5 - ILEN + 1:) = RESNUM                                 INRA0028
          RESNUM = DUMMY                                                INRA0029
                                                                        INRA0030
C----     If the last character is a letter of an insertion code, take  INRA0031
C         that to be an insertion code, so keep whole token right-justifINRA0032
          CH = RESNUM(5:5)                                              INRA0033
          IF (LGE(CH,'A') .AND. LLE(CH,'Z')) THEN                       INRA0034
                                                                        INRA0035
C----     Otherwise, shift back a character                             INRA0036
          ELSE                                                          INRA0037
              DUMMY = RESNUM(2:)                                        INRA0038
              RESNUM = DUMMY                                            INRA0039
          ENDIF                                                         INRA0040
                                                                        INRA0041
C----     Initialise                                                    INRA0042
          WANTED = .FALSE.                                              INRA0043
          RESID = CHAIN // RESNUM                                       INRA0044
                                                                        INRA0045
C----     Loop through all the defined residue ranges and check residue INRA0046
C         number and chain against each one                             INRA0047
          DO 500, IRANGE = 1, NRANGE                                    INRA0048
                                                                        INRA0049
C----         Initialise flags for this range (first and last parametersINRA0050
              MATCHF = .FALSE.                                          INRA0051
              MATCHL = .FALSE.                                          INRA0052
                                                                        INRA0053
C----         Check for ALL of a given chain                            INRA0054
              IF (RESFRM(IRANGE)(2:6).EQ.'ALL  ') THEN                  INRA0055
                                                                        INRA0056
C----             Check that is the correct chain                       INRA0057
                  IF (CHAIN.EQ.RESFRM(IRANGE)(1:1)) THEN                INRA0058
                      MATCHF = .TRUE.                                   INRA0059
                      MATCHL = .TRUE.                                   INRA0060
                  ENDIF                                                 INRA0061
                                                                        INRA0062
C----         Otherwise, check whether range is from FIRST residue      INRA0063
              ELSE IF (RESFRM(IRANGE)(2:6).EQ.'FIRST') THEN             INRA0064
                                                                        INRA0065
C----             Check that this residue is of a higher chain than thatINRA0066
C                 stated                                                INRA0067
                  IF (LGE(CHAIN,RESFRM(IRANGE)(1:1))) THEN              INRA0068
                      MATCHF = .TRUE.                                   INRA0069
                  ENDIF                                                 INRA0070
                                                                        INRA0071
C----         Otherwise check that the residue number is indeed higher  INRA0072
C             than (or equal to) the number defining the start of the   INRA0073
C             range                                                     INRA0074
              ELSE                                                      INRA0075
                  IF (LGE(RESID,RESFRM(IRANGE))) THEN                   INRA0076
                      MATCHF = .TRUE.                                   INRA0077
                  ENDIF                                                 INRA0078
              ENDIF                                                     INRA0079
                                                                        INRA0080
C----         Check whether range-end is from LAST residue              INRA0081
              IF (RESTO(IRANGE)(2:6).EQ.'LAST ') THEN                   INRA0082
                                                                        INRA0083
C----             Check that this residue is of a lower chain than that INRA0084
C                 stated                                                INRA0085
                  IF (LLE(CHAIN,RESTO(IRANGE)(1:1))) THEN               INRA0086
                      MATCHL = .TRUE.                                   INRA0087
                  ENDIF                                                 INRA0088
                                                                        INRA0089
C----         If only a single residue defined, check whether this is thINRA0090
C             one                                                       INRA0091
              ELSE IF (RESTO(IRANGE)(2:6).EQ.'XXXXX') THEN              INRA0092
                  IF (LLE(RESID,RESFRM(IRANGE))) THEN                   INRA0093
                      MATCHL = .TRUE.                                   INRA0094
                  ENDIF                                                 INRA0095
                                                                        INRA0096
C----         Otherwise check that the residue number is lower          INRA0097
C             than (or equal to) the number defining the end of the     INRA0098
C             range                                                     INRA0099
              ELSE                                                      INRA0100
                  IF (LLE(RESID,RESTO(IRANGE))) THEN                    INRA0101
                      MATCHL = .TRUE.                                   INRA0102
                  ENDIF                                                 INRA0103
              ENDIF                                                     INRA0104
                                                                        INRA0105
C----         If residue satisfies both the first and last parameters,  INRA0106
C             then it is wanted                                         INRA0107
              IF (MATCHF .AND. MATCHL) WANTED = .TRUE.                  INRA0108
500       CONTINUE                                                      INRA0109
      ENDIF                                                             INRA0110
                                                                        INRA0111
C---- Return the result                                                 INRA0112
      INRANG = WANTED                                                   INRA0113
                                                                        INRA0114
      RETURN                                                            INRA0115
      END                                                               INRA0116
                                                                        INRA0117
      SUBROUTINE PINTIC(XPORIG,YPORIG,YDIFF,XPWID,MXPINS,NPIN,TSIZE,    PINT0001
     &    TICPOS,BRKPOS,NOTICK)                                         PINT0002
C-----------------------------------------------------------------------PINT0003
C                                                                       PINT0004
C  SUBROUTINE PINTIC  -  Show ticks every so many residues              PINT0005
C                                                                       PINT0006
C----------------------------------------------------------------------+PINT0007
                                                                        PINT0008
      INTEGER       IRES, IMARK, MXPINS, NPIN                           PINT0009
      LOGICAL       BRKPOS(MXPINS), NOTICK, TICPOS(MXPINS)              PINT0010
      REAL          SCALEX, TSIZE, X, XGAP, XL, XPORIG, XPWID, XR, Y,   PINT0011
     &              YDIFF, YPORIG                                       PINT0012
                                                                        PINT0013
C---- Plot the ticks                                                    PINT0014
      XGAP = XPWID / MXPINS                                             PINT0015
      SCALEX = XPWID / MXPINS                                           PINT0016
      X = XPORIG                                                        PINT0017
      Y = YPORIG - YDIFF                                                PINT0018
      IRES = 0                                                          PINT0019
      CALL PSLWID(0.2)                                                  PINT0020
                                                                        PINT0021
C---- Plot ticks at appropriate positions                               PINT0022
      XL = X                                                            PINT0023
      XR = X                                                            PINT0024
      X = X + XGAP / 2.0                                                PINT0025
      DO 100, IMARK = 1, NPIN                                           PINT0026
                                                                        PINT0027
C----     Draw tick at this position, if required                       PINT0028
          IF (.NOT.NOTICK .AND. TICPOS(IMARK)) THEN                     PINT0029
              CALL PSLINE(X,Y,X,Y + TSIZE)                              PINT0030
          ENDIF                                                         PINT0031
                                                                        PINT0032
C----     Increment x-position                                          PINT0033
          X = X + XGAP                                                  PINT0034
                                                                        PINT0035
C----     Build up line up to break                                     PINT0036
          IF (.NOT.BRKPOS(IMARK)) THEN                                  PINT0037
              XR = XR + XGAP                                            PINT0038
                                                                        PINT0039
C----     If have come to line-break, draw line so far                  PINT0040
          ELSE                                                          PINT0041
              IF (XL.NE.XR) CALL PSLINE(XL,Y,XR,Y)                      PINT0042
              XL = XR + XGAP                                            PINT0043
              XR = XL                                                   PINT0044
          ENDIF                                                         PINT0045
 100  CONTINUE                                                          PINT0046
                                                                        PINT0047
C---- Draw last bit of line                                             PINT0048
      IF (XR.GT.XL) THEN                                                PINT0049
          CALL PSLINE(XL,Y,XR,Y)                                        PINT0050
      ENDIF                                                             PINT0051
                                                                        PINT0052
      RETURN                                                            PINT0053
      END                                                               PINT0054
                                                                        PINT0055
      SUBROUTINE PINRNO(XLIM1,XLIM2,YLIM1,PINSNO,MXPINS,NPIN,FPIN,      PINR0001
     &    TICPOS,TICLAB,TICLEN,SIZLAB,TSIZE)                            PINR0002
C-----------------------------------------------------------------------PINR0003
C                                                                       PINR0004
C  SUBROUTINE PINRNO  -  Draw residue numbers along x-axis every 5 or soPINR0005
C                        residues                                       PINR0006
C                                                                       PINR0007
C----------------------------------------------------------------------+PINR0008
                                                                        PINR0009
      INTEGER        MXPINS                                             PINR0010
      CHARACTER*5    LABEL, PINSNO(MXPINS), TICLAB(MXPINS)              PINR0011
      INTEGER        FPIN, IFROM, IPIN, ITO, LASTNO, LSTPOS, NBLANK,    PINR0012
     &               NPIN, NUMBER, PGAP, PSTEP, TICLEN(MXPINS)          PINR0013
      LOGICAL        LPRINT, TICPOS(MXPINS)                             PINR0014
      REAL           SIZLAB, TSIZE, X, XGAP, XLIM1, XLIM2, Y,           PINR0015
     &               YLIM1                                              PINR0016
                                                                        PINR0017
      DATA  PSTEP  / 5 /                                                PINR0018
                                                                        PINR0019
C---- Initialise variables                                              PINR0020
      LASTNO = FPIN                                                     PINR0021
      LSTPOS = -999                                                     PINR0022
      NBLANK = 0                                                        PINR0023
      PGAP = PSTEP                                                      PINR0024
      DO 100, IPIN = 1, MXPINS                                          PINR0025
          TICLAB(IPIN) = ' '                                            PINR0026
          TICLEN(IPIN) = 0                                              PINR0027
          TICPOS(IPIN) = .FALSE.                                        PINR0028
 100  CONTINUE                                                          PINR0029
      XGAP = (XLIM2 - XLIM1) / MXPINS                                   PINR0030
      X = XLIM1 + XGAP / 2.0                                            PINR0031
      Y = YLIM1 - TSIZE / 2.0                                           PINR0032
                                                                        PINR0033
C---- Loop through all the residues in the current graph                PINR0034
      DO 200, IPIN = 1, NPIN                                            PINR0035
                                                                        PINR0036
C----     Increment count of blanks                                     PINR0037
          NBLANK = IPIN - LSTPOS                                        PINR0038
          NUMBER = -999                                                 PINR0039
                                                                        PINR0040
C----     Initialise flag determining whether to print this residue numbPINR0041
C         not                                                           PINR0042
          LPRINT = .FALSE.                                              PINR0043
                                                                        PINR0044
C----     If have gone given number of residues without printing, then pPINR0045
          IF (NBLANK.EQ.PSTEP) THEN                                     PINR0046
              LPRINT = .TRUE.                                           PINR0047
                                                                        PINR0048
C----     Otherwise, pick off the residue number, if can                PINR0049
          ELSE                                                          PINR0050
              READ(PINSNO(IPIN),120,ERR=130) NUMBER                     PINR0051
 120          FORMAT(1X,I3,1X)                                          PINR0052
                                                                        PINR0053
C----         If sequence number is a multiple of the required gap, thenPINR0054
C             want to print it                                          PINR0055
              IF (MOD(NUMBER,PSTEP).EQ.0) THEN                          PINR0056
                                                                        PINR0057
C----             Check that not too close to last one                  PINR0058
                  IF (NBLANK.GE.PGAP) THEN                              PINR0059
                      LPRINT = .TRUE.                                   PINR0060
                                                                        PINR0061
C----             If too close, then reset last position printed        PINR0062
                  ELSE                                                  PINR0063
                      LSTPOS = IPIN                                     PINR0064
                  ENDIF                                                 PINR0065
                                                                        PINR0066
C----         Otherwise, if odd gap in sequence numbering, then print   PINR0067
              ELSE IF (NUMBER.NE.LASTNO + 1) THEN                       PINR0068
                                                                        PINR0069
C----             Check that not too close to last one                  PINR0070
                  IF (NBLANK.GE.PGAP) THEN                              PINR0071
                      LPRINT = .TRUE.                                   PINR0072
                  ENDIF                                                 PINR0073
              ENDIF                                                     PINR0074
              LASTNO = NUMBER                                           PINR0075
 130          CONTINUE                                                  PINR0076
          ENDIF                                                         PINR0077
                                                                        PINR0078
C----     Check that not at chain-break                                 PINR0079
          IF (PINSNO(IPIN)(2:4).EQ.' ') THEN                            PINR0080
              LPRINT = .FALSE.                                          PINR0081
              LASTNO = 0                                                PINR0082
          ENDIF                                                         PINR0083
                                                                        PINR0084
C----     If residue number is to be printed, print it                  PINR0085
          IF (LPRINT) THEN                                              PINR0086
              LABEL = PINSNO(IPIN)(2:5)                                 PINR0087
              IFROM = 1                                                 PINR0088
              ITO = 4                                                   PINR0089
              IF (LABEL(1:1).EQ.' ') IFROM = 2                          PINR0090
              IF (LABEL(2:2).EQ.' ') IFROM = 3                          PINR0091
              IF (LABEL(4:4).EQ.' ') ITO = 3                            PINR0092
              CALL PSCTXT(X,Y,SIZLAB,LABEL(IFROM:ITO))                  PINR0093
              CALL PSLINE(X,YLIM1,X,YLIM1 - SIZLAB / 3.0)               PINR0094
                                                                        PINR0095
C----         Reset counts                                              PINR0096
              NBLANK = 0                                                PINR0097
              LSTPOS = IPIN                                             PINR0098
              TICPOS(IPIN) = .TRUE.                                     PINR0099
              TICLAB(IPIN) = LABEL(IFROM:ITO)                           PINR0100
              TICLEN(IPIN) = ITO - IFROM + 1                            PINR0101
          ENDIF                                                         PINR0102
          X = X + XGAP                                                  PINR0103
 200  CONTINUE                                                          PINR0104
                                                                        PINR0105
      RETURN                                                            PINR0106
      END                                                               PINR0107
                                                                        PINR0108
      SUBROUTINE DHELIX(LENRUN,X,Y,IRES,DX,HWIDTH,HEIGHT,SHOWAC,INCOLR, DHEL0001
     &    MXCOLR,RGB,COLOUR)                                            DHEL0002
C-----------------------------------------------------------------------DHEL0003
C                                                                       DHEL0004
C  SUBROUTINE DHELIX  -  Draw the helix segment                         DHEL0005
C                                                                       DHEL0006
C----------------------------------------------------------------------+DHEL0007
                                                                        DHEL0008
      SAVE                                                              DHEL0009
                                                                        DHEL0010
      INTEGER       BLANK, COIL, HELIX, STRAND                          DHEL0011
      PARAMETER    (                                                    DHEL0012
     &              BLANK  =   0,                                       DHEL0013
     &              COIL   =   3,                                       DHEL0014
     &              HELIX  =   1,                                       DHEL0015
     &              STRAND =   2                                        DHEL0016
     &             )                                                    DHEL0017
                                                                        DHEL0018
      REAL          DSHADE, HSHADE                                      DHEL0019
      PARAMETER    (                                                    DHEL0020
     &              DSHADE = 0.3,                                       DHEL0021
     &              HSHADE = 0.7                                        DHEL0022
     &             )                                                    DHEL0023
                                                                        DHEL0024
      INTEGER       COLOUR, IHALF, IRES, ITURN, LENRUN, MXCOLR, NHALF,  DHEL0025
     &              UPDOWN                                              DHEL0026
      LOGICAL       INCOLR, SHOWAC                                      DHEL0027
      REAL          DH, DX, HWIDTH, HEIGHT, RGB(3,MXCOLR), TWIDTH, X,   DHEL0028
     &              X1, X2, X3, X4, X5, X6, X7, X8, XM1, XM2, XTRA, Y,  DHEL0029
     &              Y1, Y2, Y3, Y4, Y5, Y6, Y7, Y8, YM                  DHEL0030
                                                                        DHEL0031
C---- Helix representation:                                             DHEL0032
C                                                                       DHEL0033
C   Half-turns                          5_____7 4                       DHEL0034
C                                     2 /$     $                        DHEL0035
C                                      /  $     $                       DHEL0036
C   UPDOWN = 0                     YM /_ _ $     $                      DHEL0037
C                                    /     /$     $                     DHEL0038
C      Y   1 ______3  6______ 8     /_____/  $_____$                    DHEL0039
C            $     $  /     /      1      3  6     8                    DHEL0040
C             $     $/ _ _ / YM     XM1   XM2                           DHEL0041
C              $     $    /                    UPDOWN = 1               DHEL0042
C               $     $  /                                              DHEL0043
C              2 $_____$/4                                              DHEL0044
C                5     7                                                DHEL0045
C                   XM1   XM2                                           DHEL0046
C                                                                       DHEL0047
C  Triangle defined by XM1, XM2, YM has slightly darker shading (DSHADE)DHEL0048
C  than the remainder of the inside of the helix                        DHEL0049
                                                                        DHEL0050
C---- Calculate the length of each half-turn so that get approximately  DHEL0051
C     3.5 residues per turn for given run-length                        DHEL0052
      NHALF = 2.0 * REAL(LENRUN) / 3.5 + 0.5                            DHEL0053
      IF (NHALF.LT.1) NHALF = 1                                         DHEL0054
      TWIDTH = HWIDTH                                                   DHEL0055
      DH = (DX * REAL(LENRUN) - HWIDTH) / REAL(NHALF)                   DHEL0056
      IF (TWIDTH.GT.DH) THEN                                            DHEL0057
          DH = DX / 2.0                                                 DHEL0058
          TWIDTH = DH                                                   DHEL0059
      ENDIF                                                             DHEL0060
      ITURN = IRES                                                      DHEL0061
      XTRA = HEIGHT * TWIDTH / DH                                       DHEL0062
      X = X + TWIDTH / 2.0                                              DHEL0063
                                                                        DHEL0064
C---- Loop through the given number of turns                            DHEL0065
      DO 500, IHALF = 1, NHALF                                          DHEL0066
                                                                        DHEL0067
C----     Initialise direction of helix                                 DHEL0068
          ITURN = ITURN + 1                                             DHEL0069
          UPDOWN = 2 * MOD(ITURN,2) - 1                                 DHEL0070
                                                                        DHEL0071
C----     Draw middle portion of turn                                   DHEL0072
C----     First segment - calculate coordinates                         DHEL0073
          X1 = X - TWIDTH / 2.0                                         DHEL0074
          X2 = X + (DH - TWIDTH) / 2.0                                  DHEL0075
          Y1 = Y                                                        DHEL0076
          Y2 = Y + REAL(UPDOWN) * HEIGHT                                DHEL0077
          X3 = X + TWIDTH / 2.0                                         DHEL0078
          X4 = X + DH - (DH - TWIDTH) / 2.0                             DHEL0079
          Y3 = Y                                                        DHEL0080
          Y4 = Y + REAL(UPDOWN) * HEIGHT                                DHEL0081
                                                                        DHEL0082
C----     Second segment - calculate coordinates                        DHEL0083
          X5 = X + (DH - TWIDTH) / 2.0                                  DHEL0084
          X6 = X + DH - TWIDTH / 2.0                                    DHEL0085
          Y5 = Y + REAL(UPDOWN) * HEIGHT                                DHEL0086
          Y6 = Y                                                        DHEL0087
          X7 = X + DH - (DH - TWIDTH) / 2.0                             DHEL0088
          X8 = X + DH + TWIDTH / 2.0                                    DHEL0089
          Y7 = Y + REAL(UPDOWN) * HEIGHT                                DHEL0090
          Y8 = Y                                                        DHEL0091
                                                                        DHEL0092
C----     Adjust for cover-up of nearest bit of turn over furthest bit  DHEL0093
          IF (UPDOWN.GT.0) THEN                                         DHEL0094
              X4 = X + DH / 2.0                                         DHEL0095
              Y4 = Y + HEIGHT - XTRA                                    DHEL0096
              XM1 = X4 - TWIDTH                                         DHEL0097
              XM2 = X4                                                  DHEL0098
              YM = Y4                                                   DHEL0099
          ELSE                                                          DHEL0100
              X5 = X + DH / 2.0                                         DHEL0101
              Y5 = Y - HEIGHT + XTRA                                    DHEL0102
              XM2 = X5 + TWIDTH                                         DHEL0103
              XM1 = X5                                                  DHEL0104
              YM = Y5                                                   DHEL0105
          ENDIF                                                         DHEL0106
                                                                        DHEL0107
CTESTING                                                                DHEL0108
C      X1 = 6.0 * X1 - 400.0                                            DHEL0109
C      X2 = 6.0 * X2 - 400.0                                            DHEL0110
C      X3 = 6.0 * X3 - 400.0                                            DHEL0111
C      X4 = 6.0 * X4 - 400.0                                            DHEL0112
C      X5 = 6.0 * X5 - 400.0                                            DHEL0113
C      X6 = 6.0 * X6 - 400.0                                            DHEL0114
C      X7 = 6.0 * X7 - 400.0                                            DHEL0115
C      X8 = 6.0 * X8 - 400.0                                            DHEL0116
C      XM1 = 6.0 * XM1 - 400.0                                          DHEL0117
C      XM2 = 6.0 * XM2 - 400.0                                          DHEL0118
C      Y1 = 6.0 * Y1 - 300.0                                            DHEL0119
C      Y2 = 6.0 * Y2 - 300.0                                            DHEL0120
C      Y3 = 6.0 * Y3 - 300.0                                            DHEL0121
C      Y4 = 6.0 * Y4 - 300.0                                            DHEL0122
C      Y5 = 6.0 * Y5 - 300.0                                            DHEL0123
C      Y6 = 6.0 * Y6 - 300.0                                            DHEL0124
C      Y7 = 6.0 * Y7 - 300.0                                            DHEL0125
C      Y8 = 6.0 * Y8 - 300.0                                            DHEL0126
C      YM = 6.0 * YM - 300.0                                            DHEL0127
CTESTING                                                                DHEL0128
                                                                        DHEL0129
C----     Blank out the region that contains this turn of the helix     DHEL0130
          CALL PSHADE(1.0,COLOUR,RGB,MXCOLR,INCOLR)                     DHEL0131
          CALL PSUBOX(X1,Y1,X2,Y2,X4,Y4,X3,Y3)                          DHEL0132
          CALL PSHADE(1.0,COLOUR,RGB,MXCOLR,INCOLR)                     DHEL0133
          CALL PSUBOX(X5,Y5,X6,Y6,X8,Y8,X7,Y7)                          DHEL0134
                                                                        DHEL0135
C----     Shade in inside of helix                                      DHEL0136
          IF (UPDOWN.GT.0) THEN                                         DHEL0137
              IF (.NOT.SHOWAC) THEN                                     DHEL0138
                  CALL PSHADE(HSHADE,COLOUR,RGB,MXCOLR,INCOLR)          DHEL0139
              ELSE                                                      DHEL0140
                  CALL PSHADE(1.0,COLOUR,RGB,MXCOLR,INCOLR)             DHEL0141
              ENDIF                                                     DHEL0142
              CALL PSUBOX(X1,Y1,X3,Y3,XM2,YM,XM1,YM)                    DHEL0143
              IF (.NOT.SHOWAC) THEN                                     DHEL0144
                  CALL PSHADE(DSHADE,COLOUR,RGB,MXCOLR,INCOLR)          DHEL0145
              ELSE                                                      DHEL0146
                  CALL PSHADE(1.0,COLOUR,RGB,MXCOLR,INCOLR)             DHEL0147
              ENDIF                                                     DHEL0148
              CALL PSUBOX(XM1,YM,XM2,YM,X4,Y4,X2,Y2)                    DHEL0149
          ELSE                                                          DHEL0150
              IF (.NOT.SHOWAC) THEN                                     DHEL0151
                  CALL PSHADE(DSHADE,COLOUR,RGB,MXCOLR,INCOLR)          DHEL0152
              ELSE                                                      DHEL0153
                  CALL PSHADE(1.0,COLOUR,RGB,MXCOLR,INCOLR)             DHEL0154
              ENDIF                                                     DHEL0155
              CALL PSUBOX(X5,Y5,XM1,YM,XM2,YM,X7,Y7)                    DHEL0156
              IF (.NOT.SHOWAC) THEN                                     DHEL0157
                  CALL PSHADE(HSHADE,COLOUR,RGB,MXCOLR,INCOLR)          DHEL0158
              ELSE                                                      DHEL0159
                  CALL PSHADE(1.0,COLOUR,RGB,MXCOLR,INCOLR)             DHEL0160
              ENDIF                                                     DHEL0161
              CALL PSUBOX(XM1,YM,XM2,YM,X8,Y8,X6,Y6)                    DHEL0162
          ENDIF                                                         DHEL0163
                                                                        DHEL0164
C----     Draw start of helix                                           DHEL0165
          IF (IHALF.EQ.1) THEN                                          DHEL0166
              CALL PSLINE(X1,Y1,X3,Y3)                                  DHEL0167
          ENDIF                                                         DHEL0168
                                                                        DHEL0169
C----     Draw helix edges                                              DHEL0170
          CALL PSLINE(X1,Y1,X2,Y2)                                      DHEL0171
          CALL PSLINE(X3,Y3,X4,Y4)                                      DHEL0172
          CALL PSLINE(X5,Y5,X6,Y6)                                      DHEL0173
          CALL PSLINE(X7,Y7,X8,Y8)                                      DHEL0174
          CALL PSLINE(X2,Y2,X7,Y7)                                      DHEL0175
                                                                        DHEL0176
C----     Increment x-coordinate                                        DHEL0177
          X = X + DH                                                    DHEL0178
 500  CONTINUE                                                          DHEL0179
                                                                        DHEL0180
C---- Draw the helix end                                                DHEL0181
      CALL PSLINE(X - TWIDTH / 2.0,Y,X + TWIDTH / 2.0,Y)                DHEL0182
      X = X + TWIDTH / 2.0                                              DHEL0183
      RETURN                                                            DHEL0184
      END                                                               DHEL0185
                                                                        DHEL0186
      SUBROUTINE OPEHTM(FNAME,NEWFIL,IFAIL)                             OPEH0001
C-----------------------------------------------------------------------OPEH0002
C                                                                       OPEH0003
C  SUBROUTINE OPEHTM  -  Open the html file, reading through to the     OPEH0004
C                        end if the file already exists                 OPEH0005
C                                                                       OPEH0006
C----------------------------------------------------------------------+OPEH0007
                                                                        OPEH0008
      CHARACTER*80   IREC                                               OPEH0009
      CHARACTER*(*)  FNAME                                              OPEH0010
      LOGICAL        IFAIL, NEWFIL                                      OPEH0011
                                                                        OPEH0012
C---- Initialise variables                                              OPEH0013
      IFAIL = .FALSE.                                                   OPEH0014
                                                                        OPEH0015
WINNT - need to change file access type to append records --            OPEH0016
C---- If this is an existing file, then read through all its records    OPEH0017
      IF (.NOT.NEWFIL) THEN                                             OPEH0018
        OPEN(UNIT=15,FILE=FNAME,STATUS='OLD',ACCESS='APPEND',           OPEH0019
     &  FORM='FORMATTED',ACTION='readwrite',ERR=900)                    OPEH0020
C----     Loop through the file until reach the end                     OPEH0021
          do i=1,100000                                                 OPEH0022
             if (.not.eof(15)) READ(15,'(a)') IREC                      OPEH0023
          end do                                                        OPEH0024
C---- If this is a new file, then write the header records to it        OPEH0025
      ELSE                                                              OPEH0026
          OPEN(UNIT=15,FILE=FNAME,STATUS='UNKNOWN',ERR=900)             OPEH0027
          WRITE(15,120)                                                 OPEH0028
 120      FORMAT(/,'<h2>PROCHECK statistics</h2>')                      OPEH0029
      ENDIF                                                             OPEH0030
WINNT - end                                                             OPEH0031
C---- End of file reached                                               OPEH0032
C---- Open the summary file                                             OPEH0033
c      OPEN(UNIT=15,FILE=FNAME,STATUS='UNKNOWN',ACCESS='SEQUENTIAL',    OPEH0034
CVAX     -    CARRIAGECONTROL='LIST',                                   OPEH0035
c     &    ERR=900)                                                     OPEH0036
c                                                                       OPEH0037
C---- If this is an existing file, then read through all its records    OPEH0038
C     until get to the end of file                                      OPEH0039
c      IF (.NOT.NEWFIL) THEN                                            OPEH0040
c                                                                       OPEH0041
C----     Loop through the file until reach the end                     OPEH0042
c 100      CONTINUE                                                     OPEH0043
c             READ(15,110,END=500) IREC                                 OPEH0044
c 110         FORMAT(A)                                                 OPEH0045
c          GO TO 100                                                    OPEH0046
c                                                                       OPEH0047
C---- If this is a new file, then write the header records to it        OPEH0048
c      ELSE                                                             OPEH0049
c          WRITE(15,120)                                                OPEH0050
c 120      FORMAT(/,'<h2>PROCHECK statistics</h2>')                     OPEH0051
c      ENDIF                                                            OPEH0052
                                                                        OPEH0053
C---- End of file reached                                               OPEH0054
 500  CONTINUE                                                          OPEH0055
                                                                        OPEH0056
      GO TO 999                                                         OPEH0057
                                                                        OPEH0058
 900  CONTINUE                                                          OPEH0059
      PRINT*, '*** ERROR opening summary file'                          OPEH0060
      PRINT*, '* ', FNAME                                               OPEH0061
      GO TO 990                                                         OPEH0062
                                                                        OPEH0063
 990  CONTINUE                                                          OPEH0064
      IFAIL = .TRUE.                                                    OPEH0065
      GO TO 999                                                         OPEH0066
                                                                        OPEH0067
 999  CONTINUE                                                          OPEH0068
      RETURN                                                            OPEH0069
      END                                                               OPEH0070
                                                                        OPEH0071
      SUBROUTINE OPESUM(FNAME,NEWFIL,IFAIL)                             OPES0001
C-----------------------------------------------------------------------OPES0002
C                                                                       OPES0003
C  SUBROUTINE OPESUM  -  Open the summary file, reading through to the  OPES0004
C                        end if the file already exists                 OPES0005
C                                                                       OPES0006
C----------------------------------------------------------------------+OPES0007
                                                                        OPES0008
      CHARACTER*80   IREC                                               OPES0009
      CHARACTER*(*)  FNAME                                              OPES0010
      LOGICAL        IFAIL, NEWFIL                                      OPES0011
                                                                        OPES0012
C---- Initialise variables                                              OPES0013
      IFAIL = .FALSE.                                                   OPES0014
                                                                        OPES0015
WINNT - need to change file access type to append records --            OPES0016
C---- Open the summary file                                             OPES0017
c      OPEN(UNIT=14,FILE=FNAME,STATUS='UNKNOWN',ACCESS='SEQUENTIAL',    OPES0018
CVAX     -    CARRIAGECONTROL='LIST',                                   OPES0019
c     &    ERR=900)                                                     OPES0020
                                                                        OPES0021
C---- If this is an existing file, then read through all its records untOPES0022
C     get to the end of file                                            OPES0023
      IF (.NOT.NEWFIL) THEN                                             OPES0024
        OPEN(UNIT=14,FILE=FNAME,STATUS='OLD',ACCESS='APPEND',           OPES0025
     &  FORM='FORMATTED',ACTION='readwrite',ERR=900)                    OPES0026
C----     Loop through the file until reach the end                     OPES0027
          do i=1,100000                                                 OPES0028
             if (.not.eof(14)) READ(14,'(a)') IREC                      OPES0029
          end do                                                        OPES0030
C---- If this is a new file, then write the header records to it        OPES0031
      ELSE                                                              OPES0032
          OPEN(UNIT=14,FILE=FNAME,STATUS='UNKNOWN',ERR=900)             OPES0033
          WRITE(14,120)                                                 OPES0034
 120      FORMAT(/,                                                     OPES0035
     &        ' +----------<<<  P  R  O  C  H  E  C  K     S  U  M ',   OPES0036
     &        ' M  A  R  Y  >>>----------+',/,                          OPES0037
     &           ' |                                                  ',OPES0038
     &        '                          |')                            OPES0039
      ENDIF                                                             OPES0040
WINNT - end                                                             OPES0041
C---- End of file reached                                               OPES0042
 500  CONTINUE                                                          OPES0043
      GO TO 999                                                         OPES0044
                                                                        OPES0045
 900  CONTINUE                                                          OPES0046
      PRINT*, '*** ERROR opening summary file'                          OPES0047
      PRINT*, '* ', FNAME                                               OPES0048
      GO TO 990                                                         OPES0049
                                                                        OPES0050
 990  CONTINUE                                                          OPES0051
      IFAIL = .TRUE.                                                    OPES0052
      GO TO 999                                                         OPES0053
                                                                        OPES0054
 999  CONTINUE                                                          OPES0055
      RETURN                                                            OPES0056
      END                                                               OPES0057
