C PROTEIN DATA BANK SOURCE CODE TAPDIR TAPDIR 3 C AUTHOR. H.BERNSTEIN,F.BERNSTEIN TAPDIR 4 C ENTRY DATE. 11/79 SUPPORTED TAPDIR 5 C LAST REVISION. 11/79 TAPDIR 6 C PURPOSE. MAKE DIRECTORIES OF TAPES TAPDIR 7 C LANGUAGE. FORTRAN IV TAPDIR 8 C TAPDIR 9 C TAPDIR10 C TAPDIR11 C TAPDIR12 PROGRAM TAPDIR(INPUT,OUTPUT,TAPE1,TAPE5=INPUT,TAPE6=OUTPUT) TAPDIR13 C TAPDIR14 C THIS PROGRAM WAS WRITTEN BY TAPDIR15 C TAPDIR16 C HERBERT J. BERNSTEIN TAPDIR17 C DEPARTMENT OF CHEMISTRY TAPDIR18 C BROOKHAVEN NATIONAL LABORATORY TAPDIR19 C UPTON, NEW YORK 11973 USA TAPDIR20 C TAPDIR21 C UNDER CONTRACT WITH THE UNITED STATES DEPARTMENT OF ENERGY. TAPDIR22 C TAPDIR23 C THE PROGRAM WAS SLIGHTLY REVISED AND THOROUGHLY DOCUMENTED BY TAPDIR24 C TAPDIR25 C FRANCES C. BERNSTEIN TAPDIR26 C PROTEIN DATA BANK TAPDIR27 C DEPARTMENT OF CHEMISTRY TAPDIR28 C BROOKHAVEN NATIONAL LABORATORY TAPDIR29 C UPTON, NEW YORK 11973 USA TAPDIR30 C TAPDIR31 C THE PROTEIN DATA BANK IS SUPPORTED BY THE NATIONAL SCIENCE TAPDIR32 C FOUNDATION UNDER GRANT PCM 77-16811. TAPDIR33 C TAPDIR34 C TAPDIR35 C A. PURPOSE. TAPDIR36 C TAPDIR37 C PROGRAM TO MAKE DIRECTORIES OF THE CONTENTS OF TAPES TAPDIR38 C TAPDIR39 C TAPDIR40 C B. INPUT/OUTPUT FILES TAPDIR41 C TAPDIR42 C SYMBOLIC LOGICAL DESCRIPTION TAPDIR43 C DESIGNATION UNIT TAPDIR44 C TAPDIR45 C ICMD TAPE5 SYSTEM INPUT FILE TAPDIR46 C IPRT TAPE6 SYSTEM OUTPUT FILE TO BE PRINTED TAPDIR47 C IDAT TAPE1 FILE OF WHICH DIRECTORY IS TO BE MADE TAPDIR48 C TAPDIR49 C TAPDIR50 C C. INPUT PARAMETERS TAPDIR51 C TAPDIR52 C INPUT FROM TAPE1 TAPDIR53 C TAPDIR54 C THIS IS THE FILE OF WHICH THE DIRECTORY IS TO BE MADE. TAPDIR55 C IT CONSISTS OF RECORDS, SUCH AS CARD IMAGES, OF UP TO 90 TAPDIR56 C CHARACTERS PER RECORD SEPARATED BY FILE MARKS AND TERMINATED BY TAPDIR57 C A DOUBLE FILE MARK. WITHIN EACH SUCH PHYSICAL FILE, LOGICAL TAPDIR58 C FILES MAY BE DEFINED BY FLAG FIELDS WITHIN RECORDS. FLAGS MAY TAPDIR59 C DESIGNATE THE RECORD ON WHICH A LOGICAL FILE BEGINS, AND THAT ON TAPDIR60 C WHICH A LOGICAL FILE ENDS. FLAGS MAY ALSO DESIGNATE RECORDS TAPDIR61 C WHICH ARE ALWAYS TO BE PRINTED, AND THOSE WHICH ARE ALWAYS TO BE TAPDIR62 C SKIPPED. THIS LATTER FEATURE IS AVAILABLE FOR EFFICIENCY IN TAPDIR63 C REJECTING RECORDS. THE FLAGS ARE DEFINED AS PART OF THE INPUT TAPDIR64 C FROM TAPE5. TAPDIR65 C TAPDIR66 C TAPDIR67 C INPUT FROM TAPE5 TAPDIR68 C TAPDIR69 C CONTROL CARDS FOR A RUN ARE READ FROM THIS FILE. TAPDIR70 C TAPDIR71 C CARD 1 FORMAT(4I10) NFLAG, NCOL, NCARD, NFILE TAPDIR72 C TAPDIR73 C NFLAG NUMBER OF FLAG FIELDS, UP TO A MAXIMUM OF 100. TAPDIR74 C NCOL NUMBER OF VALID CHARACTERS PER RECORD. DEFAULT IS 72.TAPDIR75 C NCARD NUMBER OF RECORDS PER FILE TO PRINT IF THE FILE TAPDIR76 C DOES NOT BEGIN WITH A RECORD CONTAINING A BEGIN FLAG TAPDIR77 C FIELD AS DESCRIBED BELOW. DEFAULT IS 10. TAPDIR78 C NFILE NUMBER OF FILES TO PROCESS. IF THIS NUMBER IS ZERO, TAPDIR79 C BLANK, OR GREATER THAN THE ACTUAL NUMBER OF FILES, TAPDIR80 C THEN A DOUBLE FILE MARK WILL TERMINATE THE RUN. TAPDIR81 C TAPDIR82 C IF NFLAG IS NOT BLANK OR ZERO, THEN ONE CARD PER FLAG FIELD TAPDIR83 C SHOULD FOLLOW. TAPDIR84 C TAPDIR85 C CARDS 2 - NFLAG+1 FORMAT(5A1,5X,6A1,1X,I3,1X,I3) TAPDIR86 C TAPDIR87 C COLUMNS 1-5 OF EACH CARD GIVE THE TYPE OF FLAG FIELD, LEFT TAPDIR88 C JUSTIFIED, WITH THE VALID TYPES BEING - BEGIN, SKIP, TAPDIR89 C PRINT, END - . TAPDIR90 C COLUMNS 11-16 GIVE THE CONTENTS THAT THE FLAG FIELD MUST MATCH. TAPDIR91 C COLUMNS 19-20 GIVE THE START COLUMN (DEFAULT IS 1). TAPDIR92 C COLUMNS 23-24 GIVE THE STOP COLUMN (DEFAULT IS START COLUMN+5). TAPDIR93 C TAPDIR94 C UP TO 100 FLAG FIELDS MAY BE SPECIFIED BUT, TO AVOID EXCESSIVE TAPDIR95 C COMPARISONS, CARE MUST BE TAKEN WITH ORDERING. THE CARDS ARE TO TAPDIR96 C BE SUPPLIED IN GROUPS, EACH STARTING WITH BEGIN AND TERMINATING TAPDIR97 C WITH END. TAPDIR98 C TAPDIR99 C SAMPLE INPUT TO PRODUCE A DIRECTORY OF A STANDARD PROTEIN DATA TAPDI100 C BANK DISTRIBUTION TAPE (DATAPRTP) WOULD BE TAPDI101 C TAPDI102 C 6 TAPDI103 C BEGIN HEADER TAPDI104 C SKIP ATOM TAPDI105 C PRINT AUTHOR 1 6 TAPDI106 C PRINT COMPND 1 6 TAPDI107 C PRINT SOURCE 1 6 TAPDI108 C END END TAPDI109 C TAPDI110 C COLUMNS 11 THROUGH 50 OF THE PRECEDING COMMENT RECORDS REPRESENT TAPDI111 C THE INFORMATION THAT SHOULD BE IN COLUMNS 1 THROUGH 40 OF THE TAPDI112 C RECORDS ON TAPE5. TAPDI113 C TAPDI114 C TAPDI115 C D. OUTPUT. TAPDI116 C TAPDI117 C A DIRECTORY OF THE TAPE IS PRINTED ON TAPE6. TAPDI118 C TAPDI119 C TAPDI120 C E. MACHINE DEPENDENCIES TAPDI121 C TAPDI122 C THE FOLLOWING VARIABLES ARE USED TO STORE CHARACTERS AT ONE PER TAPDI123 C WORD. ALL CHARACTERS COMPARISONS ARE DONE USING THE ARITHMETIC TAPDI124 C STATEMENT FUNCTION IDENT. TAPDI125 C TAPDI126 C IB, IE, IFLAGS, IFLTYP, INLIN, IS TAPDI127 C TAPDI128 C TAPDI129 DIMENSION INLIN(90), IFLAGS(6,100), IFLCOL(2,100), IFLTYP(100) TAPDI130 DATA IB/1HB/,IE/1HE/,IS/1HS/ TAPDI131 C TAPDI132 C THE FOLLOWING ARITHMETIC STATEMENT FUNCTION WILL COMPARE TWO TAPDI133 C WORDS, EACH CONTAING ONE CHARACTER. ON NON-CDC COMPUTERS IT MAY TAPDI134 C HAVE TO BE REPLACED WITH A FUNCTION. TAPDI135 C TAPDI136 IDENT(III,JJJ)=III-JJJ TAPDI137 C TAPDI138 C INITIALIZE AND PRINT HEADING TAPDI139 C TAPDI140 ICMD=5 TAPDI141 IPRT=6 TAPDI142 IDAT=1 TAPDI143 LCUR=999 TAPDI144 NPAGE=1 TAPDI145 MFILES=0 TAPDI146 CALL LINES (IPRT,LCUR,0,NPAGE) TAPDI147 C TAPDI148 C READ CONTROL CARDS AND SET DEFAULTS TAPDI149 C TAPDI150 C *** FOR IBM SYSTEMS, CHANGE THE NEXT TWO CARDS TO TAPDI151 C READ (ICMD,100,END=20) NFLAG,NCOL,NCARD,NFILE TAPDI152 READ (ICMD,220) NFLAG,NCOL,NCARD,NFILE TAPDI153 IF (EOF(ICMD)) 20,10 TAPDI154 10 GO TO 30 TAPDI155 20 NFLAG=0 TAPDI156 NCOL=72 TAPDI157 NCARD=10 TAPDI158 NFILE=0 TAPDI159 30 CONTINUE TAPDI160 IF (NCOL.LE.0) NCOL=72 TAPDI161 IF (NCOL.GT.90) NCOL=90 TAPDI162 IF (NCARD.LE.0) NCARD=10 TAPDI163 IF (NFLAG.GT.100) NFLAG=100 TAPDI164 CALL LINES (IPRT,LCUR,2,NPAGE) TAPDI165 WRITE (IPRT,230) NFLAG,NCOL,NCARD,NFILE TAPDI166 IF (NFLAG.LE.0) GO TO 70 TAPDI167 DO 50 I=1,NFLAG TAPDI168 C *** FOR IBM SYSTEMS, CHANGE THE NEXT THREE CARDS TO TAPDI169 C READ (ICMD,240,END=60) IFLTYP(I),(INLIN(J),J=1,4),(IFLAGS(J,I),J=1TAPDI170 C 1,6),(IFLCOL(J,I),J=1,2) TAPDI171 READ (ICMD,240) IFLTYP(I),(INLIN(J),J=1,4),(IFLAGS(J,I),J=1,6),(IFTAPDI172 1LCOL(J,I),J=1,2) TAPDI173 IF (EOF(ICMD)) 60,40 TAPDI174 40 IF (IFLCOL(1,I).LE.0) IFLCOL(1,I)=1 TAPDI175 IF (IFLCOL(2,I).LT.IFLCOL(1,I)) IFLCOL(2,I)=IFLCOL(1,I)+5 TAPDI176 CALL LINES (IPRT,LCUR,1,NPAGE) TAPDI177 WRITE (IPRT,250) IFLTYP(I),(INLIN(J),J=1,4),(IFLAGS(J,I),J=1,6),(ITAPDI178 1FLCOL(J,I),J=1,2) TAPDI179 50 CONTINUE TAPDI180 GO TO 70 TAPDI181 60 NFLAG=I-1 TAPDI182 70 CONTINUE TAPDI183 CALL LINES (IPRT,LCUR,10,NPAGE) TAPDI184 WRITE (IPRT,260) TAPDI185 CALL LINES (IPRT,LCUR,999,NPAGE) TAPDI186 LCUR=0 TAPDI187 C TAPDI188 C MAIN LOOP TO READ TAPE TAPDI189 C COME HERE WHEN NEW PHYSICAL FILE IS STARTED. TAPDI190 C TAPDI191 80 MLINES=0 TAPDI192 KLINES=0 TAPDI193 MSPEC=0 TAPDI194 MFILES=MFILES+1 TAPDI195 C TAPDI196 C COME HERE WHEN NEW LOGICAL FILE IS STARTED. TAPDI197 C THIS IS THE USUAL READ OF THE TAPE. THERE IS ANOTHER READ TAPDI198 C BELOW TO CHECK FOR PHYSICAL END-OF-FILE FOLLOWING LOGICAL TAPDI199 C END-OF-FILE. TAPDI200 C TAPDI201 C *** FOR IBM SYSTEMS, CHANGE THE NEXT TWO CARDS TO TAPDI202 C READ (IDAT,220,END=210) (INLIN(I),I=1,NCOL) TAPDI203 90 READ (IDAT,270) (INLIN(I),I=1,NCOL) TAPDI204 IF (EOF(IDAT)) 210,100 TAPDI205 100 MLINES=MLINES+1 TAPDI206 KLINES=KLINES+1 TAPDI207 C TAPDI208 C CHECK FOR FIRST LINE OF LOGICAL FILE. IF THIS IS A NEW FILE, THE TAPDI209 C FILE NUMBER MUST BE PRINTED. TAPDI210 C TAPDI211 IF (MLINES.GT.1) GO TO 140 TAPDI212 CALL LINES (IPRT,LCUR,2,NPAGE) TAPDI213 WRITE (IPRT,280) MFILES TAPDI214 C TAPDI215 C IF THERE ARE ANY FLAG FIELDS, IT IS NECESSARY TO CHECK IF THIS TAPDI216 C FIRST RECORD OF THIS NEW FILE IS DEFINED AS A BEGIN RECORD. TAPDI217 C TAPDI218 IF (NFLAG.LE.0) GO TO 130 TAPDI219 DO 120 I=1,NFLAG TAPDI220 IF (IDENT(IFLTYP(I),IB).NE.0) GO TO 120 TAPDI221 ILEN=IFLCOL(2,I)-IFLCOL(1,I)+1 TAPDI222 ISC=IFLCOL(1,I) TAPDI223 IEC=IFLCOL(2,I) TAPDI224 DO 110 II=1,ILEN TAPDI225 JJ=II+ISC-1 TAPDI226 IF (INLIN(JJ).NE.IFLAGS(II,I)) GO TO 120 TAPDI227 110 CONTINUE TAPDI228 C TAPDI229 C HAVE FOUND A BEGIN FLAG TO MATCH THE FIRST RECORD. TAPDI230 C TAPDI231 MSPEC=I+1 TAPDI232 GO TO 130 TAPDI233 120 CONTINUE TAPDI234 130 CONTINUE TAPDI235 C TAPDI236 C PROCESS RECORDS TO PRINT. TAPDI237 C TAPDI238 140 IF (MSPEC.NE.0) GO TO 150 TAPDI239 C TAPDI240 C COME HERE WHEN THE FIRST RECORD OF THE LOGICAL FILE WAS NOT TAPDI241 C SPECIFIED ON A FLAG CARD. IN THIS CASE PRINT FIRST NCARD TAPDI242 C RECORDS OF THE FILE. TAPDI243 C TAPDI244 IF (MLINES.GT.NCARD) GO TO 90 TAPDI245 CALL LINES (IPRT,LCUR,1,NPAGE) TAPDI246 WRITE (IPRT,290) MLINES,(INLIN(I),I=1,NCOL) TAPDI247 GO TO 90 TAPDI248 C TAPDI249 C PROCESS LOGICAL FILE DATA TAPDI250 C TAPDI251 150 KSPEC=MSPEC TAPDI252 C TAPDI253 C ALWAYS PRINT FIRST RECORD OF A LOGICAL FILE. TAPDI254 C TAPDI255 IF (MLINES.EQ.1) GO TO 180 TAPDI256 IF (MSPEC.GT.NFLAG) GO TO 90 TAPDI257 C TAPDI258 C CHECK FLAGS FROM THE APPROPRIATE BEGIN UP TO THE NEXT BEGIN OR TAPDI259 C UNTIL THERE ARE NO MORE FLAGS. TAPDI260 C TAPDI261 DO 170 I=MSPEC,NFLAG TAPDI262 IF (IDENT(IFLTYP(I),IB).EQ.0) GO TO 90 TAPDI263 ISC=IFLCOL(1,I) TAPDI264 IEC=IFLCOL(2,I) TAPDI265 ILEN=IEC-ISC+1 TAPDI266 DO 160 II=1,ILEN TAPDI267 JJ=II+ISC-1 TAPDI268 IF (IDENT(INLIN(JJ),IFLAGS(II,I)).NE.0) GO TO 170 TAPDI269 160 CONTINUE TAPDI270 C TAPDI271 C IF RECORD MATCHES SKIP FLAG, THEN SKIP IT. TAPDI272 C TAPDI273 IF (IDENT(IFLTYP(I),IS).EQ.0) GO TO 90 TAPDI274 KSPEC=I TAPDI275 GO TO 180 TAPDI276 170 CONTINUE TAPDI277 GO TO 90 TAPDI278 C TAPDI279 C HAVE RECORD OF TYPE BEGIN, PRINT OR END. IF WITHIN FIRST NCARD TAPDI280 C RECORDS THEN PRINT IT. TAPDI281 C TAPDI282 180 IF (MLINES.LE.NCARD) CALL LINES (IPRT,LCUR,1,NPAGE) TAPDI283 IF (MLINES.LE.NCARD) WRITE (IPRT,290) KLINES,(INLIN(I),I=1,NCOL) TAPDI284 IF (IDENT(IFLTYP(KSPEC),IE).NE.0) GO TO 90 TAPDI285 C TAPDI286 C IF TYPE END THEN PRINT IT EVEN IF NCARD RECORDS HAVE ALREADY TAPDI287 C BEEN PRINTED. TAPDI288 C TAPDI289 IF (MLINES.GT.NCARD) CALL LINES (IPRT,LCUR,1,NPAGE) TAPDI290 IF (MLINES.GT.NCARD) WRITE (IPRT,290) KLINES,(INLIN(I),I=1,NCOL) TAPDI291 C TAPDI292 C HAVE REACHED END OF LOGICAL FILE. TAPDI293 C TAPDI294 MLINES=0 TAPDI295 MSPEC=0 TAPDI296 MFILES=MFILES+1 TAPDI297 C TAPDI298 C READ NEXT RECORD TO SEE IF IT IS A PHYSICAL END-OF-FILE. TAPDI299 C TAPDI300 C *** FOR IBM SYSTEMS, CHANGE THE NEXT TWO CARDS TO TAPDI301 C READ (IDAT,220,END=200) (INLIN(I),I=1,NCOL) TAPDI302 READ (IDAT,270) (INLIN(I),I=1,NCOL) TAPDI303 IF (EOF(IDAT)) 200,190 TAPDI304 190 GO TO 100 TAPDI305 200 CALL LINES (IPRT,LCUR,1,NPAGE) TAPDI306 WRITE (IPRT,300) KLINES TAPDI307 KLINES=0 TAPDI308 GO TO 90 TAPDI309 C TAPDI310 C PROCESS PHYSICAL END OF FILE TAPDI311 C TAPDI312 210 IF (MLINES.LE.0) STOP TAPDI313 IF (NFILE.EQ.MFILES) STOP TAPDI314 CALL LINES (IPRT,LCUR,1,NPAGE) TAPDI315 WRITE (IPRT,300) KLINES TAPDI316 GO TO 80 TAPDI317 C TAPDI318 C TAPDI319 220 FORMAT (4I10) TAPDI320 230 FORMAT (20X,I2,12H FLAG FIELDS,9X,I2,8H COLUMNS,1X,I10,8H RECORDS,TAPDI321 11X,I10,6H FILES/) TAPDI322 240 FORMAT (5A1,5X,6A1,1X,I3,1X,I3) TAPDI323 250 FORMAT (20X,5A1,5X,6A1,1X,I3,1X,I3) TAPDI324 260 FORMAT (//20X,50HFILE NUMBERS REFER TO PHYSICAL OR LOGICAL FILES TAPDI325 1 /20X,52HRECORD NUMBERS START WITH ONE IN EACH PHYSICAL FILE /////TAPDI326 2) TAPDI327 270 FORMAT (132A1) TAPDI328 280 FORMAT (1H0,4HFILE,I4) TAPDI329 290 FORMAT (1X,I10,9X,90A1) TAPDI330 300 FORMAT (1X,I8,23H RECORDS IN ABOVE FILE ) TAPDI331 END TAPDI332 SUBROUTINE LINES (IPRT,LCUR,LADD,NPAGE) TAPDI333 C TAPDI334 C COUNT PRINT LINES AND PRODUCE PAGE HEADING. TAPDI335 C TAPDI336 LCUR=LCUR+LADD TAPDI337 IF (LCUR.LT.55) RETURN TAPDI338 WRITE (IPRT,10) NPAGE TAPDI339 NPAGE=NPAGE+1 TAPDI340 LCUR=LADD TAPDI341 RETURN TAPDI342 C TAPDI343 C TAPDI344 10 FORMAT (12H1TAPDIR V1.0,23X,23HTAPE DIRECTORY PROGRAM ,33X,4HPAGE,TAPDI345 1I5//) TAPDI346 END TAPDI347