C   ASUBS89
C   SUBROUTINES FOR ANALYSIS PROGRAMS ANALYSEQ AND ANALYSEP
C   AUTHOR RODGER STADEN
C   11-1-90 GETNAM changed use of inflag=2 to set idnlst to 0
C           Added sqpf7, sepf7 sqpf5 and removed them from anals89, 
C           analps89
C   6-7-90  Added showfu
C   5-11-90 Changed rdwmt to show/not show title, changed mkwt accordingly
C   7-11-90 Changed iopt in mkwt to fit with changes in analps89 and 
C           anals89 (means adding 1 to old values)
C           added new routine gstrnd
C  18-4-91  added new weight matrix routines (initially for splice search)
C   BUBDEL
C   GETNAM
C   PSRCHX
C   BUBBLE
C   PLTMAP
C   IEMBL
C   SEPFIT
C   SPFIT
C   GETSCR
C   EDITSQ ETC
      SUBROUTINE SQPF7(SEQNCE,IDIM1,STRING,IDIM2,MATCH,
     +ITOT,ITOTEL,ITOTID,
     +ITOTP,KSTART,J1,J2,ISS,PR,IDEV,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
      CHARACTER SEQNCE(IDIM1),STRING(IDIM2),MATCH(IDIM2),HELPF*(*)
      INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
      IOK = 1
      CALL BPAUSE(KBIN,KBOUT,IOK)
      IF(IOK.NE.0) RETURN
      WRITE(KBOUT,1013)PR,ITOTP
1013  FORMAT(/,' Total scoring positions above',F7.3,' percent =',I4)
      IF(ITOTP.GT.0) THEN
        IF(ITOTP.GT.1)CALL BUBDEL(ITOT,ITOTEL,ITOTP)
        WRITE(KBOUT,1002)(ITOT(K),K=1,MIN(10,ITOTP))
        WRITE(KBOUT,1006)(ITOTEL(K),K=1,MIN(10,ITOTP))
1002    FORMAT( ' Scores   ',10I7)
1006    FORMAT( ' Positions',10I7)
        NSEE = 0
        CALL GETINT(0,ITOTP,NSEE,'Display',IVAL,KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
        NSEE = IVAL
        IF(NSEE.GT.0)THEN
          DO 300 I=1,NSEE
            K=ITOTEL(I)-KSTART+1
            WRITE(IDEV,1008)
1008        FORMAT( )
            CALL SQMTCH( SEQNCE(K),STRING,MATCH,IDIM2)
            CALL FMT4LN(SEQNCE(K),STRING,MATCH,IDIM2,K,ISS,IDEV)
300       CONTINUE
        END IF
      END IF
      IOK = 0
      END
      SUBROUTINE SEPF7(SEQNCE,IDIM1,STRING,IDIM2,MATCH,
     +ITOT,ITOTEL,ITOTID,
     +ITOTP,MINP,KSTART,J1,J2,ISS,IDEV,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT,IOK)
      CHARACTER SEQNCE(IDIM1),STRING(IDIM2),MATCH(IDIM2),HELPF*(*)
      INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
      IOK = 1
      CALL BPAUSE(KBIN,KBOUT,IOK)
      IF(IOK.NE.0) RETURN
      WRITE(KBOUT,1013)MINP,ITOTP
1013  FORMAT(/,' For score',I6,' the number of matches=',I6)
      IF(ITOTP.GT.0) THEN
        IF(ITOTP.GT.1)CALL BUBDEL(ITOT,ITOTEL,ITOTP)
        WRITE(KBOUT,1002)(ITOT(K),K=1,MIN(10,ITOTP))
        WRITE(KBOUT,1006)(ITOTEL(K),K=1,MIN(10,ITOTP))
1002    FORMAT( ' Scores   ',10I7)
1006    FORMAT( ' Positions',10I7/)
        NSEE = 0
        CALL GETINT(0,ITOTP,NSEE,'Display',IVAL,KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
        NSEE = IVAL
        IF(NSEE.GT.0)THEN
          DO 300 I=1,NSEE
            K=ITOTEL(I)-KSTART+1
            WRITE(IDEV,1008)
1008        FORMAT( )
            CALL SQMTCH( SEQNCE(K),STRING,MATCH,IDIM2)
            CALL FMT4LN(SEQNCE(K),STRING,MATCH,IDIM2,K,ISS,IDEV)
300       CONTINUE
        END IF
      END IF
      IOK = 0
      END
      SUBROUTINE SQPF5(IDIM2,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,PR,MINP,IOK)
      CHARACTER HELPF*(*)
      REAL MININ,MAXIN
      IOK = 1
      MININ = 1.
      MAXIN = 100.
      CALL GETRL(MININ,MAXIN,PR,'Percent match',VALUE,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      PR = VALUE
      PRR = PR/100.
      XIDIM2 = REAL(IDIM2)
      XIDIM2 = XIDIM2 * PRR
      MINP = NINT(XIDIM2)
      IOK = 0
      END
      SUBROUTINE GETRKB(SEQ,ID,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,
     +IOK)
C   AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*)
      CHARACTER SEQ(ID),A
      IOK = 1
      WRITE(KBOUT,1004)
1004  FORMAT(' Define search strings by typing a string name',
     +/,' followed by the string(s)')
      JD = 1
1     CONTINUE
      L = 0
      CALL GETSTR('Name',A,SEQ(JD),20,L,KBOUT,KBIN,INFLAG)
      IF(INFLAG.EQ.1) THEN
         CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
         GO TO 1
      END IF
      IF(INFLAG.EQ.2) RETURN
      IF(INFLAG.EQ.3) GO TO 50
      JD = JD + L
      SEQ(JD) = '/'
      JD = JD + 1
2       CONTINUE
         L = 0
         CALL GETSTR('String(s)',A,SEQ(JD),75,L,KBOUT,KBIN,INFLAG)
         IF(INFLAG.EQ.1) THEN
           CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
           GO TO 2
        END IF
        IF(INFLAG.EQ.2) RETURN
        IF(INFLAG.EQ.3) GO TO 50
C        IF(L.EQ.0) GO TO 2
        DO 40 I = JD, JD + L - 1
          IF(SEQ(I).EQ.' ') SEQ(I) = '/'
40      CONTINUE
        JD = JD + L
        SEQ(JD) = '/'
        SEQ(JD+1) = '/'
        JD = JD + 2
      GO TO 1
50    CONTINUE
      ID = JD - 1
      IOK = 0
      END
      SUBROUTINE BUBDEL(LIST,LISTEL,IDIM)
C   AUTHOR: RODGER STADEN
      INTEGER LIST(IDIM),LISTEL(IDIM)
      I=0
      J=0
10    CONTINUE
      IF(J.GT.I)I=J
      I=I+1
      IF(I.EQ.IDIM)RETURN
20    CONTINUE
      IF(LIST(I).GE.LIST(I+1))GO TO 10
      IF(J.LT.I)J=I
      ITEMP=LIST(I)
      LIST(I)=LIST(I+1)
      LIST(I+1)=ITEMP
      ITEMP=LISTEL(I)
      LISTEL(I)=LISTEL(I+1)
      LISTEL(I+1)=ITEMP
      IF(I.GT.1)I=I-1
      GO TO 20
      END
      SUBROUTINE GETNAM(NAMLST,IDNLST,NAMES,IDNAML,NAMEP,NAMLEN,
     +MAXEN,KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH)
C   AUTHOR: RODGER STADEN
C 2-9-91 Added tupper to deal with lower case enzyme names
C   routine to return namlst with numbers of wanted enzymes
      CHARACTER NAMES(IDNAML),NAME*20,NEWNAM*20,HELPF*(*),TUPPER
      INTEGER NAMLST(IDNLST),NAMEP(MAXEN),NAMLEN(MAXEN)
      EXTERNAL TUPPER
      NENZ=0
10    CONTINUE
      LENNAM = 0
      CALL GTSTR('Name',NAME,NEWNAM,LENNAM,KBOUT,KBIN,INFLAG)
      IF(LENNAM.EQ.0) GO TO 50
      CALL CCASE(NEWNAM,1)
      IF(INFLAG.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(INFLAG.EQ.2) THEN
        IDNLST = 0
        RETURN
      END IF
      NAME = NEWNAM
C   search for it in names
      DO 20 I=1,MAXEN
        IF(NAMLEN(I).NE.LENNAM)GO TO 20
C  name of correct length, do its chars match?
        DO 19 J=1,LENNAM
         IF(TUPPER(NAMES(NAMEP(I)+J-1)).NE.NAME(J:J))GO TO 20
19      CONTINUE
C   must match
        NENZ=NENZ+1
        IF(NENZ.GT.IDNLST)THEN
          WRITE(KBOUT,1003)
1003      FORMAT(' Too many names selected')
          RETURN
        END IF
        NAMLST(NENZ)=I
        GO TO 10
20    CONTINUE
C   no name match
      WRITE(KBOUT,1004)NAME(1:LENNAM)
1004  FORMAT(' ',A,' not found in file')
      GO TO 10
50    CONTINUE
      IDNLST=NENZ
      END
      SUBROUTINE PLSRCH(J1,J2,
     +PSAVE,IFOUND,IBH,LEVEL,NAME,NAMLEN,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
C   AUTHOR: RODGER STADEN
      CHARACTER NAME*(*)
      INTEGER PSAVE(IFOUND)
      CALL VECTOM
      XMAX=J2
      XMIN=J1
      YMAX=MARGT
      YMIN=0.
      Y=LEVEL
      YP=Y+IBH
      CALL TEXT(XMIN,Y,NAME,NAMLEN,0
     +,XMAX,XMIN,YMAX,YMIN,8,MARGR,MARGB,MARGT,
     +ISXMAX,ISYMAX)
      CALL LINE(XMIN,XMAX,Y,Y,XMAX,XMIN,YMAX,YMIN,
     +MARGL,MARGR,MARGB,MARGT,
     +ISXMAX,ISYMAX)
      DO 10 I=1,IFOUND
        X=PSAVE(I)
        CALL LINE(X,X,Y,YP,XMAX,XMIN,YMAX,YMIN,MARGL,MARGR,MARGB,
     +MARGT,ISXMAX,ISYMAX)
10    CONTINUE
C   now increase level ready for next entry
      LEVEL=LEVEL+IBH
      END
C    PSRCHX
      SUBROUTINE PSRCHX(LEVEL1,LEVEL,KBIN,KBOUT,IQUIT,
     +IHELPS,IHELPE,HELPF,IDEVH)
      CHARACTER HELPF*(*)
C   AUTHOR: RODGER STADEN
      CALL VT100M
      CALL BPAUSE(KBIN,KBOUT,IQUIT)
      IF(IQUIT.NE.0) RETURN
      CALL YESNO(IQUIT,'Restart plotting from bottom of frame',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      CALL VECTOM
      CALL CLEARV
      IF(IQUIT.EQ.1)RETURN
      CALL BPAUSE(KBIN,KBOUT,IQUIT)
      IF(IQUIT.NE.0) RETURN
      CALL CLEARG
      LEVEL=LEVEL1
      END
      SUBROUTINE BUBBLE(LIST,IDIM)
C   AUTHOR: RODGER STADEN
      INTEGER LIST(IDIM)
      I=0
      J=0
10    CONTINUE
      IF(J.GT.I)I=J
      I=I+1
      IF(I.EQ.IDIM)RETURN
20    CONTINUE
      IF(LIST(I).LE.LIST(I+1))GO TO 10
      IF(J.LT.I)J=I
      ITEMP=LIST(I)
      LIST(I)=LIST(I+1)
      LIST(I+1)=ITEMP
      IF(I.GT.1)I=I-1
      GO TO 20
      END
C    PLOTMAP
      SUBROUTINE PLTMAP(IDEV,FILNAM,IDIM,
     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX,IS,IE,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH)
      CHARACTER HELPF*(*)
C   AUTHOR: RODGER STADEN
      CHARACTER FILNAM*(*),FEATUR*8,STRAND,DESCRP(38)
      CHARACTER ATOS*38
      EXTERNAL IEMBL
      EXTERNAL ATOS
      PARAMETER (IBLIPH=256)
      CALL SHOWFU(KBOUT,
     +'Display a map using an EMBL feature table file')
      XMAX=IE
      XMIN=IS
      YMIN=0.
      YMAX=ISYMAX
      CALL OPENF1(IDEV,FILNAM,0,IOK,KBIN,KBOUT,
     +'Map file name',
     +IHELPS,IHELPE,HELPF,IDEVH)
      IF(IOK.NE.0)RETURN
10    CONTINUE
      REWIND IDEV
      LIN = 3
      CALL GTSTR('Feature code','CDS',FEATUR,LIN,
     +KBOUT,KBIN,INFLAG)
      IF(LIN.EQ.0) FEATUR(1:3) = 'CDS'
      CALL CCASE(FEATUR,1)
      IF(INFLAG.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(INFLAG.EQ.2) GO TO 900
1006  FORMAT(A)
      IF(FEATUR.EQ.' ') GO TO 900
      ISTRND = 1
      CALL GSTRND(ISTRND,IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      ISTRND = ISTRND - 1
      IF(ISTRND.LT.0) GO TO 900
      STRAND=' '
      IF(ISTRND.EQ.1)STRAND='C'
      IF(ISTRND.EQ.2)STRAND='B'
C7     WRITE(KBOUT,1001)
C1001  FORMAT(' ? SEQUENCE LEVEL IN DRAWING BOARD UNITS(DEF=0)=',$)
C      READ(KBIN,1002,ERR=7)IBASE
C      IF(IBASE.EQ.-99)THEN
C        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
C        GO TO 7
C      END IF
C      IF(IBASE.LT.0)RETURN
C      IF(IBASE.GT.MARGT)IBASE=0
      IY = IBLIPH
      MININ = 0
      MAXIN = MARGT
      CALL GETINT(MININ,MAXIN,IY,
     +'level',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) GO TO 900
      IY = IVAL
C      YBASE=IBASE
      YF=IY
      CALL CLEARV
      CALL VECTOM
C   NEED BARS AT ENDS OF FEATURES FROM BLIPB TO BLIPT
      BLIPB=YF-IBLIPH/2
      BLIPT=YF+IBLIPH/2
C   FEATURE NAME PUT AT YT
      YT=YF+IBLIPH/2
C      CALL LINE(XMIN,XMAX,YBASE,YBASE,XMAX,XMIN,YMAX,YMIN,
C     +MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
20    CONTINUE
      LEMBL=IEMBL(IDEV,'FT',FEATUR,STRAND,IS,IE,IPOSNL,IPOSNR,0,
     +DESCRP,KBOUT,JSTRAN)
      IF(LEMBL.EQ.0)THEN
        POSNL=IPOSNL
        POSNR=IPOSNR
        XMID=POSNL+(POSNR-POSNL)/2.
        CALL LINE(POSNL,POSNR,YF,YF,XMAX,XMIN,YMAX,YMIN,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
        CALL LINE(POSNL,POSNL,BLIPB,BLIPT,XMAX,XMIN,YMAX,YMIN,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
        CALL LINE(POSNR,POSNR,BLIPB,BLIPT,XMAX,XMIN,YMAX,YMIN,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
        CALL TEXT(XMID,YT,ATOS(DESCRP,1),1,
     +  0,XMAX,XMIN,YMAX,YMIN,
     +  MARGL,MARGR,MARGB,MARGT,ISXMAX,ISYMAX)
        GO TO 20
      END IF
      CALL VT100M
      GO TO 10
900   CONTINUE
      CLOSE(UNIT=IDEV)
      END
C    IEMBL
      INTEGER FUNCTION IEMBL(IDEV,SCODE,FEATUR,STRAND,IS,IE,
     +POSNL,POSNR,IWRITE,DESCR,KBOUT,JSTRAN)
C   AUTHOR: RODGER STADEN
      CHARACTER LINE(80),FEATUR*(*),STRAND,DESCR(38)
      CHARACTER KEYNAM(8),LFTEND(6),RITEND(6),DIR(3),DESCRP(38)
      CHARACTER*2 CODE,SCODE
      INTEGER POSNL,POSNR,IWRITE
      EQUIVALENCE (LINE(1),CODE)
      EQUIVALENCE (LINE(6),KEYNAM)
      EQUIVALENCE (LINE(15),LFTEND)
      EQUIVALENCE (LINE(22),RITEND)
      EQUIVALENCE (LINE(29),DIR)
      EQUIVALENCE (LINE(35),DESCRP)
C
C   READS UNTIL FINDS WANTED LINE TYPE (SCODE)
C  OR END OF TEXT THIS SEQUENCE, OR END OF FILE
C  RETURN CODES ARE 0,1,2 RESPECTIVELY
C  WRITES ALL LINES, WANTED LINE, OR NONE CODE IWRITE=2,1,0 RESPECTIVELY
C  JSTRAN IS A NUMBER DENOTING THE STRAND FOUND (0,1, (3=ERROR IN LIB))
C   SET FLAG FOR MORE DATA
      IEMBL=0
10    CONTINUE
      READ(IDEV,1000,END=600)LINE
1000  FORMAT(80A1)
      IF(IWRITE.EQ.2)WRITE(KBOUT,2000)LINE
2000  FORMAT(' ',80A1)
      IF(CODE.EQ.'SQ')GO TO 550
      IF(CODE.NE.SCODE)GO TO 10
      IF(IWRITE.EQ.1)WRITE(KBOUT,2000)LINE
      IF(SCODE.NE.'FT')RETURN
50    CONTINUE
      DO 51 J=1,8
        IF(KEYNAM(J).NE.FEATUR(J:J))GO TO 10
51    CONTINUE
      IF(STRAND.NE.'B')THEN
        IF(DIR(2).NE.STRAND)GO TO 10
      END IF
C  SET FOUND STRAND
      JSTRAN=3
      IF(DIR(2).EQ.'C')JSTRAN=1
      IF(DIR(2).EQ.' ')JSTRAN=0
      DO 52 J=1,38
        DESCR(J)=DESCRP(J)
52    CONTINUE
C   GET POSITIONS
C   <1 ?
      IF(LFTEND(5).EQ.'<')THEN
        POSNL=1
      ELSE
        POSNL=IFROMC(LFTEND,6,KBOUT)
      END IF
C   MAY CONTAIN > SO NEED TO CHECK EACH POSITION!
      DO 56 K=1,6
        KK=7-K
        IF(RITEND(KK).EQ.'>')GO TO 57
56    CONTINUE
      KK=0
57    CONTINUE
C   MAY CONTAIN < !
      IF(RITEND(5).EQ.'<')THEN
        POSNR=1
      ELSE
C   THE > IS AT POSITION KK
        POSNR=IFROMC(RITEND(KK+1),6-KK,KBOUT)
      END IF
C   COMPLEMENTARY STRAND?
      IF(DIR(2).EQ.'C')THEN
        I=POSNL
        POSNL=POSNR
        POSNR=I
      END IF
C   in range?
      IF(POSNR.LT.IS)GO TO 10
      IF(POSNL.GT.IE)GO TO 10
      RETURN
550   CONTINUE
C   SET FLAG FOR END OF THIS SEQUENCE'S HEADING
      IEMBL=1
      RETURN
600   CONTINUE
C   SET FLAG FOR END OF THIS LIBRARY
      IEMBL=2
      END
C      SQFIT
      SUBROUTINE SPFIT(SEQ,IDIM1,STRING,IDIM2,ITOT,ITOTEL,ITOTID,
     +IS,IE,MINP,ITOTP,SCORES,IDSCOR,KSTART)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ(IDIM1),STRING(IDIM2)
      INTEGER ITOT(ITOTID),ITOTEL(ITOTID)
      INTEGER SCORES(IDSCOR,IDSCOR)
      INTEGER DTONUM
      EXTERNAL DTONUM
C
      IDIF=(IE-IS+2)-IDIM2
C   IDIF IS THE NUMBER OF POSNS TO TRY
C   IPSTR GOES FROM 1 TO IDIM2 IDIF TIMES
      IPSEQ=IS-KSTART+1
      ITOTP=0
      DO 200 I=1,IDIF
        NTOT=0
        IP=IPSEQ
        DO 100 J=1,IDIM2
          NTOT=NTOT+SCORES(DTONUM(SEQ(IP)),DTONUM(STRING(J)))
          IP=IP+1
100     CONTINUE
        IF(NTOT.GE.MINP)THEN
          ITOTP=ITOTP+1
          IF(ITOTP.GT.ITOTID)RETURN
          ITOT(ITOTP)=NTOT
          ITOTEL(ITOTP)=IP-IDIM2+KSTART-1
        END IF
        IPSEQ=IPSEQ+1
200   CONTINUE
      END
      SUBROUTINE GETSCR(STRING,IDIM2,SCORES,IDSCOR,SMAX,SMIN)
C   AUTHOR: RODGER STADEN
      CHARACTER STRING(IDIM2)
      INTEGER SCORES(IDSCOR,IDSCOR),SMAX,SMIN,DTONUM
      EXTERNAL DTONUM
      SMAX=0
      SMIN=IDIM2*SCORES(IDSCOR,IDSCOR)
      DO 2 I=1,IDIM2
         SMAX=SMAX+SCORES(DTONUM(STRING(I)),DTONUM(STRING(I)))
2     CONTINUE
      END
      SUBROUTINE GETC(TOT,SUM,LINE,IDM,MAXLEN,IDEV,KBOUT,LENGTH,
     +IOK)
      INTEGER TOT(MAXLEN),SUM(IDM,MAXLEN)
      CHARACTER LINE(MAXLEN)
      INTEGER CTONUM
      EXTERNAL CTONUM
      IOK = 1
      DO 2 I=1,MAXLEN
        TOT(I)=0
        DO 1 J=1,IDM
          SUM(J,I)=0
1       CONTINUE
2     CONTINUE
      N=0
10    CONTINUE
1003  FORMAT(1X,120A1)
1004  FORMAT(' ',I6,' ',120A1)
      READ(IDEV,1003,END=100)LINE
      N=N+1
      WRITE(KBOUT,1004)N,LINE
      DO 20 I=1,MAXLEN
        IF(LINE(I).EQ.' ')GO TO 10
        SUM(CTONUM(LINE(I)),I)=SUM(CTONUM(LINE(I)),I)+1
20    CONTINUE
      GO TO 10
100   CONTINUE
      IF(N.EQ.0)THEN
        WRITE(KBOUT,*)' Empty file of aligned sequences'
        RETURN
      END IF
C   NOW FIND LENGTH OF MOTIF
      DO 40 I=1,MAXLEN
        K=0
        L=I
        DO 30 J=1,IDM
          K=K+SUM(J,I)
30      CONTINUE
        IF(K.EQ.0)GO TO 50
        TOT(I)=TOT(I)+K
40    CONTINUE
50    CONTINUE
      LENGTH=L-1
      IOK = 0
      END
      SUBROUTINE GETW(TOT,SUM,FREQ,LENGTH,MAXCHR,MAXLEN)
      INTEGER TOT(LENGTH),SUM(MAXCHR,MAXLEN)
      REAL FREQ(MAXCHR,MAXLEN)
      DO 70 I=1,LENGTH
        DO 60 J=1,MAXCHR
          FREQ(J,I)=LOG((REAL(SUM(J,I)+1)/REAL(TOT(I)+MAXCHR)))
60      CONTINUE
70    CONTINUE
      END
      SUBROUTINE GETW2(SUM,FREQ,LENGTH,MAXCHR,MAXLEN)
      INTEGER SUM(MAXCHR,MAXLEN)
      REAL FREQ(MAXCHR,MAXLEN)
      DO 70 I=1,LENGTH
        DO 60 J=1,MAXCHR
          FREQ(J,I)=REAL(SUM(J,I))
60      CONTINUE
70    CONTINUE
      END
      SUBROUTINE WRTSCM(TITLE,LENGTH,MIDDLE,BOT,TOP,IDM,
     +TOT,SUM,CHRSET,IDEV,MAXLEN)
      INTEGER TOT(LENGTH),SUM(IDM,MAXLEN)
      CHARACTER CHRSET(IDM),TITLE*(*)
C   PROTEIN MATRICES DONT WRITE ROWS FOR -X? AND SPACE SO SET DIMENSION
C   TO IDM-4
      MINUS = 1
      IF(IDM.EQ.26)MINUS = 4
      WRITE(IDEV,1018)TITLE
1018  FORMAT(' ',A)
1019  FORMAT(' P',20I4)
1020  FORMAT(' N',20I4)
1021  FORMAT(' ',A,20I4)
1022  FORMAT(' ',2I6,2F10.3)
      WRITE(IDEV,1022)LENGTH,MIDDLE,BOT,TOP
      NLINES=1+(LENGTH-1)/20
      K1=1
      DO 400 J=1,NLINES
        K2=MIN((K1+19),LENGTH)
        WRITE(IDEV,1019)(K,K=K1-MIDDLE,K2-MIDDLE)
        WRITE(IDEV,1020)(TOT(K),K=K1,K2)
        DO 390 I=1,IDM-MINUS
          WRITE(IDEV,1021)CHRSET(I),(SUM(I,K),K=K1,K2)
390     CONTINUE
        K1=K1+20
        IF(K1.GT.LENGTH)K1=LENGTH
400   CONTINUE
      CLOSE(UNIT=IDEV)
      END
      SUBROUTINE RDWMTN(TOT,WT,MIDDLE,
     +LENGTH,MAXLEN,YMIN,YMAX,IDEV,IFAIL,IDM,KBOUT,IPROB)
C   AUTHOR: RODGER STADEN
C  Same as rdwmt except for file closing
      INTEGER WT(IDM,MAXLEN),TOT(MAXLEN)
      CHARACTER LINE*79
C   PROTEIN MATRICES DONT READ ROWS FOR -X? AND SPACE SO SET DIMENSION
C   TO IDM-4
      MINUS = 1
      IF(IDM.EQ.26)MINUS = 4
C   SET FAIL FLAG
      IFAIL=1
1000  FORMAT( )
1001  FORMAT(2X,20I4)
1003  FORMAT(A)
1002  FORMAT(2X,2I6,2F10.3)
1004  FORMAT(' ',A)
      DO 10 I = 1,MAXLEN
        TOT(I) = 0
        DO 5 J = 1,IDM
          WT(J,I) = 0
5       CONTINUE
10    CONTINUE
C   READ TITLE
      READ(IDEV,1003,END=100,ERR=100)LINE
      IF(IPROB.EQ.0) WRITE(KBOUT,1004)LINE
C   READ PLOT VALUES ETC
      READ(IDEV,1002,ERR=100,END=100)
     +LENGTH,MIDDLE,YMIN,YMAX
C   HOW MANY LINES TO READ?
      NLINES=1+(LENGTH-1)/20
      K1=1
      DO 50 J=1,NLINES
C   READ POSITION
        READ(IDEV,1000,END=100,ERR=100)
        K2=MIN((K1+19),LENGTH)
C   READ TOTALS
C        READ(IDEV,1001,ERR=100,END=100)(TOT(K),K=K1,K2)
        READ(IDEV,1001,ERR=100,END=100)
C   READ COUNTS
        DO 25 I=1,IDM-MINUS
          READ(IDEV,1001,ERR=100,END=100)(WT(I,K),K=K1,K2)
C  ALLOW TOTALS IN FILE TO BE WRONG!
          DO 24 K = K1,K2
            TOT(K) = TOT(K) + WT(I,K)
24        CONTINUE
25      CONTINUE
        K1=K1+20
        IF(K1.GT.LENGTH)K1=LENGTH
50    CONTINUE
C   SET FAIL FLAG TO GOOD
      IFAIL=0
      RETURN
100   CONTINUE
      END
      SUBROUTINE GETWC(TOT,SUM,LENGTH,MAXCHR,MAXLEN,
     +CEXACT,PEXACT,IEXACT)
      INTEGER TOT(LENGTH),SUM(MAXCHR,MAXLEN)
      INTEGER PEXACT(MAXLEN),CEXACT(MAXLEN)
C routine to find 100% conserved residues in wt matrices
      IEXACT = 0
      DO 70 I=1,LENGTH
        IF(TOT(I).NE.0) THEN
          DO 60 J=1,MAXCHR
            IF(TOT(I).EQ.SUM(J,I)) THEN
              IEXACT = IEXACT + 1
              CEXACT(IEXACT) = J
              PEXACT(IEXACT) = I
              GO TO 61
            END IF
60        CONTINUE
61        CONTINUE
        END IF
70    CONTINUE
      END
      INTEGER FUNCTION MATWTC(SEQ,IDSEQ,J1,J2,K1,
     +CEXACT,PEXACT,IEXACT)
C find first position in seq where the chars (in index form)
C contained in cexact, and with relative positions pexact, is found
C else return end +1
      CHARACTER SEQ(IDSEQ)
      INTEGER PEXACT(IEXACT),CEXACT(IEXACT)
      INTEGER CTONUM
      EXTERNAL CTONUM
      MATWTC = J2 + 1
      DO 100 I=K1,J2-PEXACT(IEXACT)+1
        DO 50 J=1,IEXACT
          IF(CTONUM(SEQ(I+PEXACT(J)-1)).NE.CEXACT(J)) GO TO 51
50      CONTINUE
        MATWTC = I
        RETURN
51      CONTINUE
100   CONTINUE
      END
      SUBROUTINE RDWMT(TOT,WT,MIDDLE,
     +LENGTH,MAXLEN,YMIN,YMAX,IDEV,IFAIL,IDM,KBOUT,IPROB)
C   AUTHOR: RODGER STADEN
      INTEGER WT(IDM,MAXLEN),TOT(MAXLEN)
      CHARACTER LINE*79
C   PROTEIN MATRICES DONT READ ROWS FOR -X? AND SPACE SO SET DIMENSION
C   TO IDM-4
      MINUS = 1
      IF(IDM.EQ.26)MINUS = 4
C   SET FAIL FLAG
      IFAIL=1
1000  FORMAT( )
1001  FORMAT(2X,20I4)
1003  FORMAT(A)
1002  FORMAT(2X,2I6,2F10.3)
1004  FORMAT(' ',A)
      DO 10 I = 1,MAXLEN
        TOT(I) = 0
        DO 5 J = 1,IDM
          WT(J,I) = 0
5       CONTINUE
10    CONTINUE
C   READ TITLE
      READ(IDEV,1003,END=100,ERR=100)LINE
      IF(IPROB.EQ.0) WRITE(KBOUT,1004)LINE
C   READ PLOT VALUES ETC
      READ(IDEV,1002,ERR=100,END=100)
     +LENGTH,MIDDLE,YMIN,YMAX
C   HOW MANY LINES TO READ?
      NLINES=1+(LENGTH-1)/20
      K1=1
      DO 50 J=1,NLINES
C   READ POSITION
        READ(IDEV,1000,END=100,ERR=100)
        K2=MIN((K1+19),LENGTH)
C   READ TOTALS
C        READ(IDEV,1001,ERR=100,END=100)(TOT(K),K=K1,K2)
        READ(IDEV,1001,ERR=100,END=100)
C   READ COUNTS
        DO 25 I=1,IDM-MINUS
          READ(IDEV,1001,ERR=100,END=100)(WT(I,K),K=K1,K2)
C  ALLOW TOTALS IN FILE TO BE WRONG!
          DO 24 K = K1,K2
            TOT(K) = TOT(K) + WT(I,K)
24        CONTINUE
25      CONTINUE
        K1=K1+20
        IF(K1.GT.LENGTH)K1=LENGTH
50    CONTINUE
      CLOSE(UNIT=IDEV)
C   SET FAIL FLAG TO GOOD
      IFAIL=0
      RETURN
100   CONTINUE
      CLOSE(UNIT=IDEV)
      END
      SUBROUTINE MKWT(FREQ,SUM,TOT,CHRSET,IDM,MAXLEN,
     +IDEV2,IDEV3,KBIN,KBOUT,LINE,
     +FILNAM,IOPT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
C   AUTHOR RODGER STADEN
      CHARACTER FILNAM*(*),HELPF*(*)
      CHARACTER LINE(MAXLEN),TITLE*60,CHRSET(IDM)
      INTEGER SUM(IDM,MAXLEN),TOT(MAXLEN)
      REAL FREQ(IDM,MAXLEN)
      IOK = 1
      IF(IOPT.EQ.3)THEN
        CALL OPENF1(IDEV2,FILNAM,0,IOK,KBIN,KBOUT,
     +  'Name of existing weight matrix file',
     +  IHELPS,IHELPE,HELPF,IDEVH)
        IF(IOK.NE.0) RETURN
        CALL RDWMT(TOT,SUM,MIDDLE,LENGTH,MAXLEN,
     +  CUTMIN,CUTMAX,IDEV2,
     +  IOK,IDM,KBOUT,0)
        IF(IOK.NE.0) RETURN
      END IF
      CALL OPENF1(IDEV2,FILNAM,0,IOK,KBIN,KBOUT,
     +'Name of aligned sequences file',
     +IHELPS,IHELPE,HELPF,IDEVH)
      IF(IOK.NE.0)RETURN
      IF(IOPT.EQ.2) THEN
        CALL GETC(TOT,SUM,LINE,IDM,MAXLEN,IDEV2,
     +  KBOUT,LENGTH,IOK)
        IF(IOK.NE.0)RETURN
      END IF
      WRITE(KBOUT,1006)LENGTH
1006  FORMAT(' Length of motif',I6)
      IOK = 1
      CALL YESNO(IOPT,'Sum logs of weights',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IOPT.LT.0) RETURN
      CUTMIN = -10.0
      IF(IOPT.EQ.1)CUTMIN = 10.
      CALL MASKW(SUM,LENGTH,IDM,MAXLEN,KBIN,KBOUT,TITLE,
     +IOPT,IHELPS,IHELPE,HELPF,IDEVH)
      IF(IOPT.LT.0) RETURN
C     NOW CALC WEIGHTS
      IF(CUTMIN.LT.0.0)CALL GETW(TOT,SUM,FREQ,LENGTH,IDM,MAXLEN)
      IF(CUTMIN.GE.0.0)CALL GETW2(SUM,FREQ,LENGTH,IDM,MAXLEN)
C     NOW APPLY THE WEIGHTS
      REWIND IDEV2
      CALL APPLWT(FREQ,IDM,LENGTH,IDEV2,IDEV3,KBIN,KBOUT,LINE,MAXLEN,
     +BOT,TOP,TITLE,MIDDLE,IOK)
      CLOSE(UNIT=IDEV2)
      IF(IOK.NE.0) RETURN
      CALL OPENF1(IDEV2,FILNAM,1,IOK,KBIN,KBOUT,
     +'Name for new weight matrix file',
     +IHELPS,IHELPE,HELPF,IDEVH)
      IF(IOK.NE.0) RETURN
      CALL WRTSCM(TITLE,LENGTH,MIDDLE,BOT,TOP,IDM,
     +TOT,SUM,CHRSET,IDEV2,MAXLEN)
      CLOSE(UNIT=IDEV2)
      RETURN
      END
      SUBROUTINE MASKW(SUM,LENGTH,IDM,MAXLEN,KBIN,KBOUT,MASK,
     +IOPT,IHELPS,IHELPE,HELPF,IDEVH)
      INTEGER SUM(IDM,MAXLEN)
      CHARACTER MASK*(*),HELPF*(*)
      CALL YESNO(IOPT,'Use all motif positions',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(IOPT.LT.0) RETURN
5     CONTINUE
      IF(IOPT.EQ.1)THEN
        WRITE(KBOUT,1002)
1002    FORMAT(' x means use, - means ignore',/,
     +         ' e.g. xx-x---x-x means use positions 1,2,4,8,10')
        LIN = 0
        CALL GTSTR('Mask',' ',MASK,LIN,KBOUT,KBIN,INFLAG)
        IF(INFLAG.EQ.1) THEN
          CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
          GO TO 5
        END IF
        IF(INFLAG.EQ.2) RETURN
        IF(LIN.EQ.0) RETURN
        DO 70 I=1,LENGTH
          IF(MASK(I:I).EQ.'-')THEN
            DO 60 J=1,IDM
              SUM(J,I) = 0
60          CONTINUE
          END IF
70      CONTINUE
      END IF
      END
      SUBROUTINE APPLWT(FREQ,IDM,LENGTH,IDEV,IDEV3,KBIN,KBOUT,
     +LINE,MAXLEN,BOT,TOP,TITLE,MIDDLE,IOK)
      REAL FREQ(IDM,MAXLEN)
      CHARACTER LINE(MAXLEN),TITLE*(*)
      INTEGER CTONUM
      EXTERNAL CTONUM
      IOK = 1
      N=0
      TOP=-99999.
      BOT=9999999.
      WRITE(KBOUT,*)' Applying weights to input sequences'
      SMEAN = 0.
      SUMSQ = 0.
1003  FORMAT(1X,120A1)
1004  FORMAT(' ',I4,' ',F12.3,' ',120A1)
200   CONTINUE
      READ(IDEV,1003,END=300)LINE
      N=N+1
      SCORE=0.
      DO 210 I=1,LENGTH
        SCORE=SCORE+FREQ(CTONUM(LINE(I)),I)
210   CONTINUE
      WRITE(IDEV3,1004)N,SCORE,(LINE(K),K=1,LENGTH)
      IF(SCORE.GT.TOP)TOP=SCORE
      IF(SCORE.LT.BOT)BOT=SCORE
      SMEAN=SMEAN+SCORE
      SUMSQ=SUMSQ+SCORE*SCORE
      GO TO 200
300   CONTINUE
      IF(N.LT.1)THEN
        WRITE(KBOUT,*)' Error: empty sequence file'
        RETURN
      END IF
      SMEAN=SMEAN/N
      SM=SMEAN
      SMEAN=SMEAN*SMEAN
      SUMSQ=SUMSQ/N
      SD = 0.
      T = SUMSQ - SMEAN
      IF(T.GT.0.)SD = SQRT(T)
      SMM3=SM-3*SD
      SMP3=SM+3*SD
      WRITE(KBOUT,1000)TOP,BOT
1000  FORMAT(' Top score',F12.3,'  Bottom score',F12.3)
      WRITE(KBOUT,1001)SM,SD
1001  FORMAT(' Mean',F12.3,'  Standard deviation',F12.3)
      WRITE(KBOUT,1002)SMM3,SMP3
1002  FORMAT(' Mean minus 3.sd',F12.3,'  Mean plus 3.sd',F12.3)
      BOT=SMM3
      TOP=SMP3
      XMN = -999.
      XMX = 9999.
      CALL GETRL(XMN,XMX,BOT,'Cutoff score',VAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      BOT = VAL
      XMN = BOT
      XMX = 999.
      CALL GETRL(XMN,XMX,TOP,'Top score for scaling plots',
     +VAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      TOP = VAL
      MN = 0
      MX = LENGTH
      MIDDLE = 1
      CALL GETINT(MN,MX,MIDDLE,'Position to identify',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
       MIDDLE = IVAL
305   CONTINUE 
      LIN = 0
      CALL GTSTR('Title',' ',TITLE,LIN,KBOUT,KBIN,INFLAG)
      IF(INFLAG.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 305
      END IF
      IF(INFLAG.EQ.2) RETURN
      IOK = 0
      END
      SUBROUTINE GETWM(TOT,SUM,FREQ,LENGTH,MATRIX,MAXCHR,MAXLEN)
      INTEGER TOT(LENGTH),SUM(MAXCHR,MAXLEN),MATRIX(MAXCHR,MAXCHR)
      REAL FREQ(MAXCHR,MAXLEN)
      DO 70 I=1,LENGTH
        IPROD = 0
        DO 60 J=1,MAXCHR
          DO 50 K = 1,MAXCHR
            IPROD = IPROD + MATRIX(J,K) * (SUM(J,I)+1)
50        CONTINUE
60      CONTINUE
        TOT(I) = IPROD
70    CONTINUE
      DO 170 I=1,LENGTH
        DO 160 J=1,MAXCHR
          IPROD = 0
          DO 150 K = 1,MAXCHR
            IPROD = IPROD + MATRIX(J,K) * (SUM(J,I)+1)
150       CONTINUE
          FREQ(J,I)=LOG(REAL(IPROD)/REAL(TOT(I)))
160     CONTINUE
170   CONTINUE
      END
      SUBROUTINE GETW1(SUM,FREQ,LENGTH,MAXCHR,MAXLEN)
      INTEGER SUM(MAXCHR,MAXLEN)
      REAL FREQ(MAXCHR,MAXLEN)
      DO 70 I=1,LENGTH
        DO 60 J=1,MAXCHR
          FREQ(J,I) = 0.
          IF(SUM(J,I).GT.0)FREQ(J,I) = 1.
60      CONTINUE
70    CONTINUE
      END
      SUBROUTINE MARGC(ISXMAX,ISYMAX,MARGL,MARGR,MARGB,MARGT,
     +HELPS,HELPE,MAXOPT,HELPF,IDEVH,KBIN,KBOUT)
C   AUTHOR RODGER STADEN
      INTEGER MARGB(MAXOPT),MARGT(MAXOPT),HELPS,HELPE
      CHARACTER HELPF*(*)
      CALL SHOWFU(KBOUT,'Reset plot positions')
      NOPT = 0
      CALL GETINT(0,MAXOPT,NOPT,'Number of option to reposition',
     +IVAL,KBIN,KBOUT,HELPS,HELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      IF(IVAL.EQ.0) RETURN
      NOPT = IVAL
      CALL MARGC1(ISXMAX,ISYMAX,MARGL,MARGR,MARGB(NOPT),MARGT(NOPT),
     +HELPS,HELPE,HELPF,IDEVH,KBIN,KBOUT)
      RETURN
      END
      SUBROUTINE SQPF3(STRING,NEW,MAXSTR,LENGTH,
     +KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      CHARACTER HELPF*(*)
C   AUTHOR: RODGER STADEN
      CHARACTER STRING(MAXSTR),NEW(MAXSTR)
      IOK = 1
10    CONTINUE
      LIN = LENGTH
      CALL GETSTR('String',STRING,NEW,MAXSTR,LIN,KBOUT,KBIN,INFLAG)
      IF((LIN.LT.1).AND.(LENGTH.LT.1)) RETURN
      IF(INFLAG.EQ.1) THEN
        CALL HELP2(IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
        GO TO 10
      END IF
      IF(INFLAG.EQ.2) RETURN
      IF(LIN.GT.0)THEN
        CALL SQCOPY(NEW,STRING,LIN)
        LENGTH = LIN
      END IF
      IOK = 0
      END
      SUBROUTINE SQPF2(SEQ2,IDIM3,STRING,IDIM2I,IDIM2,I1,I2,
     +KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      CHARACTER HELPF*(*)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ2(IDIM3),STRING(IDIM2I)
      IOK = 1
      MININ = 1
      MAXIN = IDIM3
      WRITE(KBOUT,1000)
1000  FORMAT(' Define string ends')
      CALL GETINT(MININ,MAXIN,I1,'Start',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      IF(IVAL.NE.I1) THEN
        I2 = IVAL + 10
      END IF
      I1 = IVAL
      MININ = I1 + 1
      MAXIN = I1 + IDIM2I - 1
      CALL GETINT(MININ,MAXIN,I2,'End',IVAL,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      IF(IOK.NE.0) RETURN
      I2 = IVAL
      IDIM2 =I2 - I1 + 1
      CALL SQCOPY(SEQ2(I1),STRING,IDIM2)
      WRITE(KBOUT,1001)(STRING(K),K=1,IDIM2)
1001  FORMAT(' string=',50A1)
      IOK = 0
      END
      SUBROUTINE SQPF1(SEQ2,IDIM3I,IDIM3,
     +IDEV,FILNAM,KBIN,KBOUT,
     +IHELPS,IHELPE,HELPF,IDEVH,IOK)
      CHARACTER HELPF*(*)
C   AUTHOR: RODGER STADEN
      CHARACTER SEQ2(IDIM3I),FILNAM*(*)
      IDIM3 = IDIM3I
      CALL OPENF1(IDEV,FILNAM,0,IOK,KBIN,KBOUT,
     +'String file',
     +IHELPS,IHELPE,HELPF,IDEVH)
      IF(IOK.NE.0) RETURN
      IOK = 1
      CALL ARRFIL(IDEV,SEQ2,IDIM3,KBOUT)
      CLOSE(UNIT=IDEV)
      IF(IDIM3.LT.1)RETURN
      IOK = 0
      END
      SUBROUTINE SQPFD1(SEQ2,IDIM3I,IDIM3,ANSTY,IDEVIN,FILE2,
     +KBIN,KBOUT,IHELPS,IHELPE,HELPF,IDEVH,IOK)
C   AUTHOR: RODGER STADEN
      CHARACTER HELPF*(*),FILE2*(*)
      CHARACTER SEQ2(IDIM3I)
      INTEGER ANSTY,CHOICE
      CHOICE = ANSTY
      IOK = 1
      CALL YESONO(CHOICE,'Type in string','Extract string from file',
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      IF(CHOICE.LT.0) RETURN
      ANSTY = CHOICE
      IF(ANSTY.EQ.1)THEN
        CALL SQPF1(SEQ2,IDIM3I,IDIM3,
     +  IDEVIN,FILE2,KBIN,KBOUT,
     +  IHELPS,IHELPE,HELPF,IDEVH,IOK)
        IF(IOK.NE.0) RETURN
      END IF  
      IOK = 0
      END
      SUBROUTINE GSTRND(IVAL,IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      CHARACTER HELPF*(*)
      PARAMETER (MAXPRM = 13)
      CHARACTER PROMPT(3)*(MAXPRM)
      PROMPT(1) = '+ strand only'
      PROMPT(2) = '- strand only'
      PROMPT(3) = 'Both strands'
      CALL RADION('Select strands',PROMPT,3,IVAL,
     +IHELPS,IHELPE,HELPF,IDEVH,KBIN,KBOUT)
      END
