staden-lg/src/staden/splitp1.f

59 lines
1.8 KiB
Fortran

C ROUTINE TO TRANSLATE PROSITE DATABASE
C 2-3-92 set filnam = ' '
SUBROUTINE FMAIN()
PARAMETER (MAXSTR = 80, MAXDEV = 4)
INTEGER DEVNOS(MAXDEV)
CHARACTER*(MAXSTR) AMOS,IDLINE,TITLE
CHARACTER*40 PATNAM,HELPF,FILNAM
CALL UNITNO(KBIN,KBOUT,DEVNOS,MAXDEV)
WRITE(KBOUT,*)'SPLITP1 splits prosite.dat into one file per entry'
WRITE(KBOUT,*)' and creates and index'
IDEV1 = DEVNOS(1)
IDEV2 = DEVNOS(2)
IDEV4 = DEVNOS(4)
FILNAM = ' '
CALL OPENF1(DEVNOS(1),FILNAM,0,IOK,KBIN,KBOUT,
+'Prosite library file',
+IHELPS,IHELPE,HELPF,DEVNOS(3))
IF(IOK.NE.0) STOP
FILNAM = ' '
CALL OPENF1(DEVNOS(4),FILNAM,1,IOK,KBIN,KBOUT,
+'Index file',
+IHELPS,IHELPE,HELPF,DEVNOS(3))
IF(IOK.NE.0) STOP
IPAT = 0
5 CONTINUE
READ(IDEV1,1000,ERR=200,END=100)AMOS
1000 FORMAT(A)
IF(AMOS(1:2).EQ.'ID') THEN
IDLINE = AMOS
GO TO 5
END IF
IF(AMOS(1:2).EQ.'AC') THEN
IPAT = IPAT + 1
NAMLEN = INDEX(AMOS(1:),';') - 1
PATNAM = AMOS(6:NAMLEN)//'.DAT'
1005 FORMAT(' ',A)
CALL OPENRS(IDEV2,PATNAM,IOK,LRECL,1)
IF(IOK.NE.0) WRITE(*,*)'SCREAM, FILE OPENING'
1009 FORMAT(' ',A)
WRITE(IDEV2,1009,ERR=200)IDLINE
WRITE(IDEV2,1009,ERR=200)AMOS
END IF
6 CONTINUE
READ(IDEV1,1000,ERR=200,END=100)AMOS
WRITE(IDEV2,1009,ERR=200)AMOS
IF(AMOS(1:2).EQ.'DE') TITLE = AMOS(6:)
IF(AMOS(1:2).EQ.'DO') THEN
TITLE(70:80) = PATNAM(3:7)//','//AMOS(10:14)
WRITE(IDEV4,1009,ERR=200)TITLE
END IF
IF(AMOS(1:2).NE.'//') GO TO 6
GO TO 5
100 CONTINUE
WRITE(KBOUT,*)IPAT,' files created. Normal termination'
STOP
200 CONTINUE
WRITE(KBOUT,*)IPAT,' files created. Abnormal termination'
END