CAINDMFOIP -- INITIALIZE AND WRITE CARDS TO PARAMETER FILE 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CTITLE FOIP -- INITIALIZE AND WRITE CARDS TO PARAMETER FILE 00020000 CA AUTHOR D.D.REED 00030000 CA DESIGNER J.MENDEKE 00040000 CA LANGUAGE FORTRAN 00050000 CA SYSTEM IBM AND CRAY 00060000 CA WRITTEN 12-12-74 00070000 C REVISED MO-DA-YR 00080000 C REVISED 11-30-83 CMP. SEND 20 BYTE EBCDIC TO USPHD. 00090000 C REVISED 07-16-84 GRAY. ADDED WRITE STMTS TO LABEL CARD COLUMNS ON00100000 C THE PRINTOUT. 00110000 C REVISED 09-12-84 LBL. DUAL PATH FOR IBM AND CRAY 00120000 C REVISED 02-27-85 LBL. SKIP BLANK DATA CARDS IN CRAY ROUTE. 00130000 C REVISED 10-02-85 RKG. SKIP PRINTOUT FOR INTERACTIVE SPARC. 00140000 C REVISED 12-17-85 ESN. SKIP COLUMN PRINTOUT IN JOBGEN AND SKIP 00150000 C PRINTOUT FOR CRAY JOBS. 00160000 C REVISED 6-25-86 ESN. CHANGE COMPARE OF 'SYSTEM' FROM 'IBM ' TO 00170000 C 'IBM'. 00180000 C REVISED 07-23-86 JGM. PRINT 'COMM' CARD ON FIRST USPHD CALL 00190000 C REVISED 07-23-86 JGM. FORCED NON VECTOR AT ISN 280 00200000 C REVISED 08-04-86 REM. FIX ENDING DISK ADDRESS FOR DATA CARD PRINT00210000 C REVISED 12-15-86 REP - INITIALIZE ADDEND ON FOIP ENTRY TO MAKE 00220000 C FOIP REENTRANT & LOOK FOR 'ONLP' IN STEPNAME.00230000 C REVISED 06-03-87 DJP - CHANGED THE PRINT UNIT FROM 6 TO 98. 00240000 C REVISED 03-16-88 REM. OPTIMIZE COMPARISONS ON SYSTEM VARIABLE AND00250000 C ADD ENTRY POINT FOWC. 00260000 C REVISED 03-06-89 ESN. PRINT CARDS TO UNIT 97. 00270000 C REVISED 11-13-89 RDK. REMOVE EXTERNAL FOR FOPARM. 00280000 C REVISED 09-30-91 ESN. CHECK 3 CHARS OF JOBID WITH 'TSU'. 00290000 C REVISED 04-08-92 ESN. CHANGE LCTMAX FROM 57 TO 55 FOR THE LASER. 00300000 CA 00310000 CA 00320000 CA CALL FOIP 00330000 CA NO PARAMETERS 00340000 CA 00350000 CA 00360000 CA FOIP INTIALIZES THE PARAMETER FILE BY CALLING ENTRIES 00370000 CA IN FOPARM (ALC). FOIP MUST BE CALLED BEFORE ATTEMPTING ANY 00380000 CA OTHER OPERATIONS ON THE PARAMETER FILE. FOIP OPENS THE DCB, SETS 00390000 CA UP THE DIRECTORY AND READS THE INPUT CARDS AND WRITES THEM TO 00400000 CA THE FILE. 00410000 CAEND 00420000 CTITLE FORC -- READ A CARD IMAGE FROM THE PARAMETER FILE 00430000 CA AUTHOR D.D.REED 00440000 CA DESIGNER J.MENDEKE 00450000 CA LANGUAGE FORTRAN 00460000 CA SYSTEM IBM & CRAY 00470000 CA WRITTEN 12-12-74 00480000 C REVISED 3-24-76 BY R. MCMILLAN TO CALL FORDCD 00490000 C INSTEAD OF FOREAD BECAUSE OF 00500000 C CHANGES TO FOPARM. 00510000 C REVISED MO-DA-YR 00520000 C 00530000 CA 00540000 CA 00550000 CA CALL FORC (KPNA, KPRNO, DA, CARD, &STMT) 00560000 CA 00570000 CA INPUT KPNA = PROCESS NAME. I4 00580000 CA KPRNO = PROCESS NUMBER. I4 00590000 CA DA = DISK ADDRESS RELATIVE TO THE FIRST CARD I4 00600000 CA RECORD WITH NAME KPNA AND NUMBER KPRNO. 00610000 CA OUTPUT CARD = ARRAY TO RECEIVE 80-BYTE CARD IMAGE. ANY 00620000 CA STMT = ERROR RETURN. I4 00630000 CA DA = DA + 1. I4 00640000 CA 00650000 CA FORC READS AN INPUT CARD WHICH WAS WRITTEN TO THE PARAMETER FILE 00660000 CA BY FOIP. KPNA IS THE PROCESS NAME, KPRNO THE PROCESS NUMBER. 00670000 CA DA IS THE DISK ADDRESS RELATIVE TO THE FIRST CARD IN THE FILE 00680000 CA WITH THE GIVEN NAME AND NUMBER. THE 80-CHARACTER CARD IMAGE 00690000 CA WHICH IS READ WILL BE PLACED IN THE ARRAY "CARD". IF THE RECORD 00700000 CA CANNOT BE FOUND THE ERROR RETURN WILL BE TAKEN. 00710000 CAEND 00720000 CTITLE FOWC -- WRITE A CARD IMAGE TO THE PARAMETER FILE 00730000 CA AUTHOR RALPH MCMILLAN 00740000 CA DESIGNER RALPH MCMILLAN 00750000 CA LANGUAGE FORTRAN 00760000 CA SYSTEM IBM & CRAY 00770000 CA WRITTEN 03-16-88 00780000 C 00790000 CA 00800000 CA 00810000 CA CALL FOWC (KPNA, KPRNO, DA, CARD, &STMT) 00820000 CA 00830000 CA INPUT KPNA = PROCESS NAME. I4 00840000 CA KPRNO = PROCESS NUMBER. I4 00850000 CA DA = DISK ADDRESS RELATIVE TO THE FIRST CARD I4 00860000 CA RECORD WITH NAME KPNA AND NUMBER KPRNO. 00870000 CA CARD = ARRAY CONTAINING 80-BYTE CARD IMAGE. ANY 00880000 CA OUTPUT STMT = ERROR RETURN. I4 00890000 CA DA = DA + 1. I4 00900000 CA 00910000 CA FOWC WRITES A CARD TO THE PARAMETER FILE. DA IS THE DISK 00920000 CA ADDRESS RELATIVE TO THE FIRST CARD IN THE FILE WITH THE GIVEN 00930000 CA NAME AND NUMBER. THE ERROR RETURN WILL BE TAKEN IF DA IS 00940000 CA OUTSIDE THE RANGE FOR THE GIVEN NAME AND NUMBER. NO CHECK CAN 00950000 CA BE MADE THAT THE CARD BEING WRITTEN WAS JUST READ; THAT IS THE 00960000 CA RESPONSIBILITY OF THE CALLING PROGRAM. 00970000 CAEND 00980000 CTITLE FOWP -- WRITE A PARAMETER RECORD TO THE PARAMETER FILE 00990000 CA AUTHOR D.D.REED 01000000 CA DESIGNER J.MENDEKE 01010000 CA LANGUAGE FORTRAN 01020000 CA SYSTEM IBM & CRAY 01030000 CA WRITTEN 12-12-74 01040000 C REVISED MO-DA-YR 01050000 C 01060000 CA 01070000 CA 01080000 CA CALL FOWP (KPNA, KPRNO, DA, LEN, CARD, &STMT) 01090000 CA 01100000 CA INPUT KPNA = PROCESS NAME. I4 01110000 CA KPRNO = PROCESS NUMBER. IR 01120000 CA DA = DISK ADDRESS RELATIVE TO THE FIRST I4 01130000 CA PARAMETER RECORD WITH NAME KPNA AND 01140000 CA NUMBER KPRNO. 01150000 CA LEN = LEN OF RECORD TO WRITE FILE (WORDS). I4 01160000 CA OUTPUT CARD = ARRAY OF LENGTH LEN WHICH CONTAINS ANY 01170000 CA THE RECORD TO BE WRITTEN. 01180000 CA STMT = ERROR RETURN. I4 01190000 CA DA = DA + 1. I4 01200000 CA 01210000 CA ENTRY FOWP WRITES PARAMETER RECORDS TO THE FILE. RECORDS MUST 01220000 CA FIRST BE WRITTEN SEQUENTIALLY BEFORE THEY CAN BE WRITTEN OR 01230000 CA READ RANDOMLY. FOWP SEARCHES THE DIRECTORY FOR A PARAMETER RECORD01240000 CA WITH NAME "KPNA" AND NUMBER "KPRNO". IF A RECORD WITH THIS NAME 01250000 CA AND NUMBER IS NOT FOUND AND DA=1 THE RECORD IS WRITTEN TO THE 01260000 CA FILE SEQUENTIALLY. IF A RECORD IS FOUND WITH KPNA AND KPRNO 01270000 CA DA IS ADDED TO THE ADDRESS OF THE RECORD FOUND AND THIS IS 01280000 CA COMPARED TO THE ADDRESS OF THE NEXT RECORD WITH A DIFFERENT 01290000 CA NAME AND NUMBER. IF LESS, THE RECORD IS REPLACED BY "CARD", 01300000 CA IF GREATER, THE ERROR RETURN IS TAKEN. IF THERE IS NOT ANOTHER 01310000 CA RECORD WITH A NAME AND NUMBER DIFFERENT THAN KPNA AND KPRNO, 01320000 CA DA IS COMPARED WITH THE ADDRESS OF THE LAST RECORD IN THE FILE. 01330000 CA IF DA IS ONE GREATER, "CARD" IS WRITTEN SEQUENTIALLY TO THE FILE. 01340000 CA OTHERWISE THE ERROR RETURN IS TAKEN. 01350000 CAEND 01360000 CTITLE FORP -- READ A PARAMETER RECORD FROM THE PARAMETER FILE 01370000 CA AUTHOR D.D.REED 01380000 CA DESIGNER J.MENDEKE 01390000 CA LANGUAGE FORTRAN 01400000 CA SYSTEM IBM & CRAY 01410000 CA WRITTEN 12-12-74 01420000 C REVISED MO-DA-YR 01430000 C 01440000 C 01450000 CA 01460000 CA 01470000 CA CALL FORP (KPNA, KPRNO, DA, LEN, CARD, &ERR) 01480000 CA 01490000 CA INPUT KPNA = PROCESS NAME. I4 01500000 CA KPRNO = PROCESS NUMBER. I4 01510000 CA DA = DISK ADDRESS RELATIVE TO THE FIRST I4 01520000 CA PARAMETER RECORD WITH NAME KPNA AND 01530000 CA NUMBER KPRNO. 01540000 CA LEN = LENGTH (WORDS) OF RECORD TO READ. I4 01550000 CA OUTPUT CARD = ARRAY TO READ RECORD INTO. ANY 01560000 CA ERR = ERROR RETURN. I4 01570000 CA DA = DA + 1. I4 01580000 CA 01590000 CA FORP READS PARAMETER RECORDS WHICH WERE WRITTEN TO THE FILE BY 01600000 CA FOWP. FORP SEARCHES THE DIRECTORY FOR KPNA AND KPRNO AND TAKES 01610000 CA THE ERROR RETURN IF NOT FOUND. IF FOUND, DA IS ADDED TO THE 01620000 CA ADDRESS OF THE RECORD FOUND AND THIS IS COMPARED TO THE ADDRESS 01630000 CA OF THE NEXT RECORD WITH A DIFFERENT NAME AND NUMBER OR THE END 01640000 CA OF THE FILE. IF GREATER, THE ERROR RETURN IS TAKEN. OTHERWISE, 01650000 CA THE RECORD IS READ AND STORED IN CARD. 01660000 CAEND 01670000 CTITLE FOCP -- CLOSE THE PARAMETER FILE 01680000 CA AUTHOR D.D.REED 01690000 CA DESIGNER J.MENDEKE 01700000 CA LANGUAGE FORTRAN 01710000 CA SYSTEM IBM & CRAY 01720000 CA WRITTEN 12-12-74 01730000 C REVISED MO-DA-YR 01740000 C 01750000 C 01760000 CA 01770000 CA 01780000 CA CALL FOCP 01790000 CA NO PARAMETERS 01800000 CA 01810000 CA 01820000 CA FOCP WRITES OUT THE DIRECTORY TO THE FILE AND CLOSES THE DCBS. 01830000 CA IT MUST BE CALLED BEFORE CALLING FOWDMP. 01840000 CAEND 01850000 CTITLE FOWDMP -- DUMP THE PARAMETER FILE 01860000 CA AUTHOR D.D.REED 01870000 CA DESIGNER J.MENDEKE 01880000 CA LANGUAGE FORTRAN 01890000 CA SYSTEM IBM & CRAY 01900000 CA WRITTEN 12-12-74 01910000 C REVISED MO-DA-YR 01920000 CA 01930000 CA 01940000 CA CALL FOWDMP 01950000 CA NO PARAMETERS 01960000 CA 01970000 CA 01980000 CA FOWDMP DUMPS THE PARAMETER FILE TO FT06F001. 01990000 CAEND 02000000 C ********************************************************************* 02010000 C EJECT 02020000 C LOCAL ARRAYS (INTERNAL TO SUBROUTINE). 02030000 C 02040000 C CARD (104) = I/O BUFFER. I4 02050000 C JAPNMS ( 2)= JOB NAME AND PROCEDURE NAME. R8 02060000 C TKTAB (200,2)= DIRECTORY. TKTAB(X,1) = NAME. I4 02070000 C TKTAB(X,2) = NUMBER. I4 02080000 C TKRDAD ( 200) = DIRECTORY. TKRDAD(X) = RELATIVE DISK ADDRESS. I4 02090000 C 02100000 C 02110000 C LOCAL VARIABLES AND CONSTANTS (INTERNAL TO SUBROUTINE). 02120000 C 02130000 C ADDEND = ADDRESS OF END OF RECORDS. I4 02140000 C BLNK = BLANKS. I4 02150000 C CEND = END OF INPUT CARD RECORDS. I4 02160000 C DCBRF = RANDOM FLAG. TRUE = DCB OPEN FOR RANDOM OPERATIONS. L4 02170000 C DCBSF = SEQUENTIAL FLAG. TRUE = SEQUENTIAL DCB OPEN. L4 02180000 C DIRLOC = DIRECTORY LOCATION. TRUE = DIRECTORY MUST BE READ. L4 02190000 C DIRPTR = POINTER TO LAST DIRECTORY ENTRY. I4 02200000 C DIRT = "DIRT". USED FOR NAME OF DIRECTORY RECORDS. I4 02210000 C END = POINTER TO LAST DIRECTORY ENTRY FOR CARDS OR PARMS. I4 02220000 C EOF = "EOF ". USED FOR END OF FILE RECORD. I4 02230000 C IDUMMY = USED IN PROPERLY ADDRESSING WORDS ON IBM AND CRAY. I4 02240000 C ALSO USED AS A LOCAL FLAG FOR WHICH SYSTEM. 02250000 C =20 IF IBM AND =10 IF CRAY. 02260000 C NUMENT = NUMBER OF DIRECTORY ENTRIES IN THIS DIRECTORY RECORD.I4 02270000 C PPTR = POINTER TO A PARAMETER RECORD. I4 02280000 C PRMDIR = POINTER TO FIRST DIRECTORY ENTRY FOR A PARM RECORD. I4 02290000 C PRMREC = RELATIVE DISK ADDRESS OF FIRST PARAMETER RECORD. I4 02300000 C PRNTIN = PRINT INPUT DATA CARDS FLAG. L4 02310000 C RAD = RELATIVE DISK ADDRESS OF RECORD TO READ OR WRITE. I4 02320000 C RDEND = REL. DISK ADDRESS OF LAST INPUT CARD OR PARM RECORD. I4 02330000 C RDSKAD = POINTER TO NEXT RELATIVE DISK ADDRESS TO WRITE TO. I4 02340000 C SEIS = 'SEIS ' = CODE FOR TESTING PROCEDURE STEP NAME. R8 02350000 C WRTDIR = WRITE DIRECTORY FLAG. TRUE = WRITE OUT DIRECTORY. L4 02360000 C EJECT 02370000 C 02380000 C 02390000 CP DISK SEISPARM CARDS, PROCESSING PARAMETERS, TRACE HEADERS. 02400000 CP ******FIRST RECORD * DIRECTORY POINTER RECORD * CONTAINS THE RELA- 02410000 CP TIVE ADDRESS OF THE FIRST DIRECTORY RECORD AND THE DIRECTORY 02420000 CP POINTER TO THE FIRST PARAMETER RECORD. 02430000 CP 02440000 CP | WORD 1 | WORD 2 | WRDS 3-8| WORD 9 | WORD 10 | WRDS 11-104 | 02450000 CP |_________|_________|_________|_________|_________|_______________| 02460000 CP | DIRT | 0 | NOT | PRMDIR | RDSKAD | NOT | 02470000 CP |_________|_________|___USED__|_________|_________|______USED_____| 02480000 CP 02490000 CP 02500000 CP ******INPUT CARD RECORDS * FOLLOW FIRST RECORD * INPUT CARD IMAGES. 02510000 CP 02520000 CP | WORD 1 | WORD 2 | WRDS 3-8| WRDS 9-28 |WRDS 29-104| 02530000 CP |_________|_________|_________|_______________________|___________| 02540000 CP | PROCESS | PROCESS | NOT | CARD IMAGE | NOT | 02550000 CP |__NAME___|_NUMBER__|___USED__|_______________________|____USED___| 02560000 CP 02570000 CP 02580000 CP ******PARAMETER RECORDS * FOLLOW INPUT CARD RECORDS * CONTAIN 02590000 CP PROCESSING PARAMETERS. 02600000 CP 02610000 CP | WORD 1 | WORD 2 | WORD 3 | WORD 4 | WORD 5 | WORD 6 | 02620000 CP |_________|_________|_________|_________|_________|_________| 02630000 CP | PROCESS | PROCESS |DATA TYPE|SHOTPOINT|RESERVED |NUMBER OF| 02640000 CP |__NAME___|_NUMBER__|__ALPHA__|_CDP, FN_|_________|PARAMETRS| 02650000 CP 02660000 CP | WORD 7 | WORD 8 | WORDS 9 TO 104 | 02670000 CP |_________|_________|_______________________________________| 02680000 CP |INT. TYPE|LOCATION | PARAMETERS COMPUTED BY PRE-PROCESSORS | 02690000 CP |PROC_MODE|NO.(GEOM)|_______________________________________| 02700000 CP || 02710000 CP |BYTE 2 = PROCESSING MODE = D, F, OR S. 02720000 CP | 02730000 CP BYTE 1 = INTERPOLATION TYPE = L OR N. 02740000 CP EJECT 02750000 CP ******DIRECTORY RECORDS * FOLLOW PARAMETER RECORDS * CONTAIN ENTRIES02760000 CP FOR THE DIRECTORY, EACH ENTRY CONSISTING OF A PROCESS NAME, 02770000 CP PROCESS NUMBER, AND A RELATIVE DISK ADDRESS. EACH RECORD 02780000 CP MAY CONTAIN UP TO 8 ENTRIES. 02790000 CP 02800000 CP | WORD 1 | WORD 2 | WORD 3 | WRDS 4-8 | 02810000 CP |_________|_________|_________|___________________________| 02820000 CP | DIRT | 0 | # OF | NOT | 02830000 CP |_________|_________|_ENTRIES_|____________USED___________| 02840000 CP 02850000 CP | WORD 9 | WORD 10 | WORD 11 | 02860000 CP |_________|_________|_________| 02870000 CP | PROCESS | PROCESS | RELATIVE| 02880000 CP |__NAME___|__NUMBER_|_ADDRESS_| 02890000 CP . . . . 02900000 CP . . . . 02910000 CP . . . . 02920000 CP 02930000 CP | WORD 30 | WORD 31 | WORD 32 | 02940000 CP |_________|_________|_________| 02950000 CP | PROCESS | PROCESS | RELATIVE| 02960000 CP |__NAME___|__NUMBER_|_ADDRESS_| 02970000 CP 02980000 CP | WORD 33 | ... | WORD 104| 02990000 CP |_____NOT_|_USED AT_|_PRESENT_| 03000000 CP 03010000 CP 03020000 CP ******END OF FILE RECORD * LAST RECORD **************************** 03030000 CP 03040000 CP | WORD 1 | WRDS 2-104 | 03050000 CP |_________|_______________________________________________________| 03060000 CP | EOF | NOT | 03070000 CP |_________|______________________USED_____________________________| 03080000 C 03090000 C EJECT 03100000 SUBROUTINE FOIP 03110000 C 03120000 IMPLICIT INTEGER (A-Z) 03130000 C EXTERNAL FOPARM 03140000 C 03150000 C ARRAYS--LOCAL (INTERNAL TO SUBROUTINE). 03160000 INTEGER CARD (104) 03170000 INTEGER CARDSV(20) 03180000 INTEGER CARD9 (20) 03190000 INTEGER TKTAB (200, 2) 03200000 INTEGER TKRDAD(200) 03210000 CHARACTER*16 JAPNMS 03220000 C 03230000 C INTEGER ARRAYS IN PARAMETER LIST. 03240000 C 03250000 INTEGER CARD20(20) 03260000 C 03270000 C VARIABLES AND CONSTANTS--LOCAL (INTERNAL TO SUBROUTINE). 03280000 C 03290000 CHARACTER*8 JOBCLS 03300000 CHARACTER*8 JOBNAM 03310000 CHARACTER*8 JOBNUM 03320000 CHARACTER*4 SEIS 03330000 CHARACTER*4 STEP 03340000 C 03350000 C LOGICAL VARIABLES 03360000 C 03370000 LOGICAL DCBRF 03380000 LOGICAL DCBSF 03390000 LOGICAL DIRLOC 03400000 LOGICAL PRNTIN 03410000 LOGICAL WRTDIR 03420000 C 03430000 C--------- DUAL PATH FOR IBM AND CRAY 03440000 C 03450000 COMMON /SYSTEM/ SYSTEM 03460000 C 03470000 DATA ADDEND / 0 / 03480000 DATA BLNK /' '/ 03490000 DATA DIRT /'DIRT'/ 03500000 DATA EOF /'EOF' / 03510000 DATA IDUMMY / 0 / 03520000 DATA JPPRNT / 97 / 03530000 DATA KPPRNT / 98 / 03540000 DATA LCOUNT / 62 / 03550000 DATA LCTMAX / 55 / 03560000 DATA SEIS /'SEIS'/ 03570000 DATA STEP /'STEP'/ 03580000 DATA DCBRF /.FALSE./ 03590000 DATA DCBSF /.FALSE./ 03600000 DATA DIRLOC /.TRUE. / 03610000 DATA PRNTIN /.TRUE. / 03620000 DATA WRTDIR /.FALSE./ 03630000 C 03640000 C SET PRNTIN FLAG--DON'T PRINT DATA CARD IN JOBGEN (SPARC PROCEDURE)03650000 C 03660000 IF(1.EQ.2) CALL FOPARM 03670000 C 03680000 CALL JPSNAM (JAPNMS) 03690000 IF (S1CPCH(JAPNMS,9,SEIS,1,4) .EQ. 0) PRNTIN = .FALSE. 03700000 IF (S1CPCH(JAPNMS,9,STEP,1,4) .EQ. 0) PRNTIN = .FALSE. 03710000 IF (S1CPCH(JAPNMS,9,'ONLP',1,4) .EQ. 0) PRNTIN = .FALSE. 03720000 IF (S1CPCH(SYSTEM,1,'IBMF',1,4) .EQ. 0) PRNTIN = .FALSE. 03730000 C 03740000 CALL JOBINF (JOBNAM, JOBNUM, JOBCLS) 03750000 IF (S1CPCH(JOBNUM,1,'TSU',1,3) .EQ. 0) JPPRNT = 0 03760000 C 03770000 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) THEN 03780000 IDUMMY = 20 03790000 ELSE IF (S1CPCH(SYSTEM,1,'CRAY',1,4) .EQ. 0) THEN 03800000 IDUMMY = 10 03810000 ELSE 03820000 WRITE(KPPRNT, 9000) 03830000 STOP 500 03840000 END IF 03850000 C 03860000 2 CONTINUE 03870000 IF (IDUMMY .EQ. 20) THEN 03880000 C IBM VERSION 03890000 READ (5, 9010, END=8) (CARD9(I), I = 1, 20) 03900000 ELSE 03910000 C CRAY VERSION 03920000 READ (5, 9020, END=8) (CARD9(I), I = 1, 10) 03930000 ENDIF 03940000 IF (S1CPCH(CARD9(1),1,'LINE',1,4) .NE. 0) GO TO 2 03950000 IF (S1CPCH(CARD9(1),77,'PROC',1,4) .NE. 0) JPPRNT = 0 03960000 8 CONTINUE 03970000 REWIND 5 03980000 C 03990000 C CLEAR UNUSED WORDS IN BUFFER 04000000 C 04010000 DO 10 I = 3, 8 04020000 CARD(I)= 0 04030000 10 CONTINUE 04040000 C 04050000 DO 20 I = IDUMMY+9, 104 04060000 CARD(I) = BLNK 04070000 20 CONTINUE 04080000 C 04090000 C INITIALIZE POINTER TO DIRECTORY AND RELATIVE DISK ADDRESS 04100000 C 04110000 DIRPTR = 1 04120000 RDSKAD = 2 04130000 ADDEND = 0 04140000 WRTDIR = .TRUE. 04150000 DIRLOC = .FALSE. 04160000 ICOM = 0 04170000 C 04180000 C OPEN PARAMETER DISK FILE 04190000 C 04200000 CALL FOPENS 04210000 DCBSF = .TRUE. 04220000 C 04230000 C WRITE DUMMY RECORD TO FILL IN WITH DIRECTORY ADDRESS LATER 04240000 C 04250000 CARD(1) = DIRT 04260000 CARD(2) = 0 04270000 CALL FOWRTS (CARD) 04280000 C 04290000 C MAKE DIRECTORY ENTRY FOR DUMMY 04300000 C 04310000 TKTAB(1,1) = DIRT 04320000 TKTAB(1,2) = 0 04330000 TKRDAD(1) = 1 04340000 C 04350000 C 04360000 C READ A SEISMIC DATA CARD INTO BUFFER, AND PRINT THE CARD. 04370000 C 04380000 30 CONTINUE 04390000 C 04400000 IF (IDUMMY .EQ. 20) THEN 04410000 C IBM VERSION 04420000 READ (5, 9010, END=200) (CARD(I), I = 9, 28) 04430000 ELSE 04440000 C CRAY VERSION 04450000 READ (5, 9020, END=200) (CARD(I), I = 9, 18) 04460000 IF (S1CPCH(CARD(9),1,BLNK,1,4) .EQ. 0) GO TO 30 04470000 ENDIF 04480000 C 04490000 C MOVE PROCESS NAME AND NUMBER TO FIRST TWO WORDS OF RECORD 04500000 C 04510000 C CHECK FOR CRAY 04520000 IF (IDUMMY .EQ. 10) CALL S1MVCH (BLNK, 1, CARD(1), 5,4) 04530000 C 04540000 CALL S1MVCH (CARD(9), 1, CARD(1), 1, 4) 04550000 CARD(2) = 0 04560000 C 04570000 IF(S1CPCH(CARD,1,'COMM',1,4) .NE. 0) GO TO 50 04580000 C 04590000 C SAVE THE 'COMM' CARD TO PRINT LATER 04600000 C 04610000 DO 40 I = 1, IDUMMY 04620000 CARDSV(I) = CARD (I+8) 04630000 40 CONTINUE 04640000 C 04650000 CALL S1MVCH (' ',1,CARDSV(1),1,5) 04660000 ICOM = 1 04670000 C 04680000 50 IF (IDUMMY .EQ. 20) THEN 04690000 C IBM VERSION 04700000 IF ( S1CPCH(CARD(10), 1, ' ', 1, 1) .EQ. 0) GO TO 60 04710000 CARD(2) = S1CVBN (CARD(10), 1, 1) 04720000 ELSE 04730000 C CRAY VERSION 04740000 IF ( S1CPCH(CARD( 9), 5, ' ', 1, 1) .EQ. 0) GO TO 60 04750000 CARD(2) = S1CVBN (CARD( 9), 5, 1) 04760000 END IF 04770000 C 04780000 C IS THERE A DIRECTORY ENTRY FOR THIS NAME AND NUMBER? 04790000 C 04800000 60 IF (TKTAB(DIRPTR, 1) .EQ. CARD(1) .AND. 04810000 1 TKTAB(DIRPTR, 2) .EQ. CARD(2)) GO TO 100 04820000 C 04830000 C NO - UPDATE DIRECTORY POINTER 04840000 C 04850000 DIRPTR = DIRPTR + 1 04860000 C 04870000 C DIRECTORY OVERFLOWN? 04880000 C 04890000 IF (DIRPTR .GT. 200) GO TO 600 04900000 C 04910000 C NO - CREATE DIRECTORY ENTRY 04920000 C 04930000 TKTAB(DIRPTR,1) = CARD(1) 04940000 TKTAB(DIRPTR,2) = CARD(2) 04950000 TKRDAD(DIRPTR) = RDSKAD 04960000 C 04970000 C WRITE RECORD TO PARAMETER FILE 04980000 100 CALL FOWRTS (CARD) 04990000 C 05000000 C UPDATE RELATIVE DISK ADDRESS 05010000 C 05020000 RDSKAD = RDSKAD + 1 05030000 GO TO 30 05040000 C 05050000 C END OF FILE - SAVE POINTER TO FIRST ENTRY IN DIRECTORY FOR 05060000 C PARAMETER DATA RECORDS 05070000 C 05080000 200 CONTINUE 05090000 C 05100000 PRMDIR = DIRPTR + 1 05110000 PRMREC = RDSKAD 05120000 C 05130000 C SHOULD WE PRINT THE INPUT DATA CARDS 05140000 IF (.NOT. PRNTIN) GO TO 2560 05150000 C 05160000 C IS FILE OPEN FOR READ? 05170000 C 05180000 IF (DCBRF) GO TO 2500 05190000 CALL FOPEND 05200000 DCBRF = .TRUE. 05210000 C 05220000 C IS DIRECTORY IN MEMORY 05230000 C 05240000 2500 IF (.NOT. DIRLOC) GO TO 2510 05250000 ASSIGN 2510 TO BRN 05260000 GO TO 500 05270000 C 05280000 2510 CEND = RDSKAD - 1 05290000 C WRITE PAGE HEADING FOR LIST OF INPUT DATA CARDS. 05300000 IF(ICOM .EQ. 0) THEN 05310000 CALL USPHD(1, 'SEE CARD ', 'EXEC', 0, 05320000 * 'SORTED SEISMIC DATA CARDS, JUSTIFIED',36, KPPRNT) 05330000 IF (JPPRNT .GT. 0) 05340000 * CALL USPHD(1, 'SEE CARD ', 'EXEC', 0, 05350000 * 'SORTED SEISMIC DATA CARDS, JUSTIFIED',36, JPPRNT) 05360000 ENDIF 05370000 C 05380000 IF(ICOM .EQ. 1) THEN 05390000 CALL USPHD(1, 'SEE CARD ', 'EXEC', 0, 05400000 * CARDSV(1),80, KPPRNT) 05410000 IF (JPPRNT .GT. 0) 05420000 * CALL USPHD(1, 'SEE CARD ', 'EXEC', 0, 05430000 * CARDSV(1),80, JPPRNT) 05440000 ENDIF 05450000 LCOUNT = 10 05460000 C 05470000 WRITE(KPPRNT,9030) 05480000 IF (JPPRNT .GT. 0) WRITE(JPPRNT,9030) 05490000 C 05500000 C 05510000 C READ A SEISMIC DATA CARD INTO BUFFER, AND PRINT THE CARD. 05520000 C 05530000 C 05540000 DO 2550 I = 1, CEND 05550000 CALL FOREAD (CARD,I) 05560000 C 05570000 IF (LCOUNT .GE. LCTMAX) THEN 05580000 WRITE (KPPRNT,9040) 05590000 IF (JPPRNT .GT. 0) WRITE (JPPRNT,9040) 05600000 LCOUNT = 3 05610000 END IF 05620000 C 05630000 IF (IDUMMY .EQ. 20) THEN 05640000 C IBM VERSION 05650000 WRITE (KPPRNT,9050) (CARD(J), J=9, 32) 05660000 IF (JPPRNT .GT. 0) WRITE (JPPRNT,9050) (CARD(J), J=9, 32) 05670000 ELSE 05680000 C CRAY VERSION 05690000 WRITE (KPPRNT,9060) (CARD(J), J=9, 20) 05700000 IF (JPPRNT .GT. 0) WRITE (JPPRNT,9060) (CARD(J), J=9, 20) 05710000 END IF 05720000 C 05730000 LCOUNT = LCOUNT + 1 05740000 C 05750000 2550 CONTINUE 05760000 C 05770000 IF (PRNTIN) THEN 05780000 WRITE (KPPRNT, 9030) 05790000 IF (JPPRNT .GT. 0) WRITE (JPPRNT, 9030) 05800000 ENDIF 05810000 C 05820000 2560 RETURN 05830000 C 05840000 C***********************************************************************05850000 C 05860000 ENTRY FORC (KPNA, KPRNO, DA, CARD20, *) 05870000 C 05880000 C***********************************************************************05890000 C 05900000 C IS THE DIRECTORY IN MEMORY ? 05910000 C 05920000 IF (.NOT. DIRLOC) GO TO 250 05930000 C 05940000 C NO - READ IN DIRECTORY 05950000 C 05960000 ASSIGN 250 TO BRN 05970000 GO TO 500 05980000 C 05990000 C SEARCH DIRECTORY FOR KPNA AND KPRNO 06000000 C 06010000 250 END = PRMDIR - 1 06020000 RDEND = PRMREC - 1 06030000 DO 260 I = 2, END 06040000 IF (KPNA .EQ. TKTAB(I,1) .AND. 06050000 1 KPRNO .EQ. TKTAB(I,2)) GO TO 270 06060000 260 CONTINUE 06070000 RETURN1 06080000 C 06090000 C GET RELATIVE ADDRESS OF CORRECT RECORD 06100000 C 06110000 270 RAD = TKRDAD(I) + DA - 1 06120000 IF (RAD .GT. RDEND) RETURN1 06130000 IF (RAD .LE. RDEND .AND. I .EQ. END) GO TO 275 06140000 IF (RAD .GE. TKRDAD(I+1)) RETURN1 06150000 C 06160000 C READ RECORD 06170000 C 06180000 C 06190000 275 IF (DCBRF) GO TO 278 06200000 CALL FOPEND 06210000 DCBRF = .TRUE. 06220000 278 CALL FORDCD (CARD,RAD) 06230000 C 06240000 C RETURN ONLY CARD IMAGE 06250000 C 06260000 I =1 06270000 C 06280000 280 CARD20(I) = CARD(I+8) 06290000 I = I +1 06300000 IF (I .LE. IDUMMY) GO TO 280 06310000 C 06320000 C UPDATE DISK ADDRESS 06330000 C 06340000 DA = DA + 1 06350000 RETURN 06360000 C 06370000 C***********************************************************************06380000 C 06390000 ENTRY FOWC (KPNA, KPRNO, DA, CARD20, *) 06400000 C 06410000 C***********************************************************************06420000 C 06430000 C IS THE DIRECTORY IN MEMORY ? 06440000 C 06450000 IF (.NOT. DIRLOC) GO TO 2250 06460000 C 06470000 C NO - READ IN DIRECTORY 06480000 C 06490000 ASSIGN 2250 TO BRN 06500000 GO TO 500 06510000 C 06520000 C SEARCH DIRECTORY FOR KPNA AND KPRNO 06530000 C 06540000 2250 END = PRMDIR - 1 06550000 RDEND = PRMREC - 1 06560000 DO 2260 I = 2, END 06570000 IF (KPNA .EQ. TKTAB(I,1) .AND. 06580000 1 KPRNO .EQ. TKTAB(I,2)) GO TO 2270 06590000 2260 CONTINUE 06600000 RETURN1 06610000 C 06620000 C GET RELATIVE ADDRESS OF CORRECT RECORD 06630000 C 06640000 2270 RAD = TKRDAD(I) + DA - 1 06650000 IF (RAD .GT. RDEND) RETURN1 06660000 IF (RAD .LE. RDEND .AND. I .EQ. END) GO TO 2275 06670000 IF (RAD .GE. TKRDAD(I+1)) RETURN1 06680000 C 06690000 C MOVE CARD INTO OUTPUT BUFFER 06700000 C 06710000 2275 CARD(1) = KPNA 06720000 CARD(2) = KPRNO 06730000 C 06740000 DO 2276 I = 1, IDUMMY 06750000 CARD(I+8) = CARD20(I) 06760000 2276 CONTINUE 06770000 C 06780000 C WRITE RECORD 06790000 C 06800000 C 06810000 IF (DCBRF) GO TO 2278 06820000 CALL FOPEND 06830000 DCBRF = .TRUE. 06840000 2278 CALL FOWRTD (CARD,RAD) 06850000 C 06860000 C UPDATE DISK ADDRESS 06870000 C 06880000 DA = DA + 1 06890000 RETURN 06900000 C 06910000 C***********************************************************************06920000 C 06930000 ENTRY FOWP (KPNA, KPRNO, DA, LEN, CARD20, *) 06940000 C 06950000 C***********************************************************************06960000 C 06970000 C IS THE DIRECTORY IN MEMORY? 06980000 C 06990000 IF (.NOT. DIRLOC) GO TO 300 07000000 C 07010000 C GO READ IN DIRECTORY 07020000 C 07030000 ASSIGN 300 TO BRN 07040000 GO TO 500 07050000 C 07060000 C SEARCH DIRECTORY FOR KPNA AND KPRNO 07070000 C 07080000 300 END = DIRPTR 07090000 RDEND = RDSKAD - 1 07100000 C 07110000 DO 320 I = PRMDIR, END 07120000 IF (KPNA .EQ. TKTAB (I,1) .AND. 07130000 1 KPRNO .EQ. TKTAB (I,2) ) GO TO 350 07140000 320 CONTINUE 07150000 C 07160000 C WRITING SEQUENTIALLY? 07170000 C 07180000 IF (DA .NE. 1) RETURN1 07190000 C 07200000 C ADD AN ENTRY TO THE DIRECTORY 07210000 C 07220000 330 DIRPTR = DIRPTR + 1 07230000 IF (DIRPTR .GT. 200) GO TO 600 07240000 TKTAB(DIRPTR,1) = KPNA 07250000 TKTAB(DIRPTR,2) = KPRNO 07260000 TKRDAD(DIRPTR) = RDSKAD 07270000 RAD = RDSKAD 07280000 340 RDSKAD = RDSKAD + 1 07290000 C 07300000 DO 346 I = 1,LEN 07310000 CARD(I) = CARD20(I) 07320000 346 CONTINUE 07330000 C 07340000 IF (LEN.EQ.104) GO TO 348 07350000 J = LEN + 1 07360000 C 07370000 DO 347 I = J, 104 07380000 CARD(I) = 0 07390000 347 CONTINUE 07400000 C 07410000 348 IF (RAD .LE. ADDEND) GO TO 390 07420000 IF (DCBSF) GO TO 349 07430000 CALL FOPENS 07440000 DCBSF = .TRUE. 07450000 349 CALL FOWRTS(CARD) 07460000 DA = DA + 1 07470000 RETURN 07480000 350 RAD = TKRDAD(I) + DA - 1 07490000 IF (I .NE. END) GO TO 355 07500000 IF (RAD .GT. RDSKAD) RETURN1 07510000 IF (RAD .EQ. RDSKAD) GO TO 340 07520000 GO TO 360 07530000 355 IF (RAD .GT. RDEND) RETURN1 07540000 IF (RAD .GE. TKRDAD(I+1)) RETURN1 07550000 C 07560000 C MOVE RECORD OF LENGTH LEN TO BUFFER 07570000 C 07580000 360 DO 370 I = 1, LEN 07590000 CARD(I) = CARD20(I) 07600000 370 CONTINUE 07610000 C 07620000 IF (LEN.EQ.104) GO TO 390 07630000 J = LEN + 1 07640000 C 07650000 DO 380 I = J, 104 07660000 CARD(I) = 0 07670000 380 CONTINUE 07680000 C 07690000 390 IF (DCBRF) GO TO 395 07700000 CALL FOPEND 07710000 DCBRF = .TRUE. 07720000 395 CALL FOWRTD (CARD,RAD) 07730000 DA = DA + 1 07740000 RETURN 07750000 C 07760000 C***********************************************************************07770000 C 07780000 ENTRY FORP (KPNA, KPRNO, DA, LEN, CARD20, *) 07790000 C 07800000 C***********************************************************************07810000 C 07820000 C IS THE DIRECTORY IN MEMORY? 07830000 C 07840000 IF (.NOT. DIRLOC) GO TO 400 07850000 ASSIGN 400 TO BRN 07860000 GO TO 500 07870000 C 07880000 C SEARCH DIRECTORY FOR KPNA AND KPRNO 07890000 C 07900000 400 END = DIRPTR 07910000 RDEND = RDSKAD - 1 07920000 C 07930000 DO 420 I = PRMDIR,END 07940000 IF (KPNA .EQ. TKTAB(I,1) .AND. 07950000 1 KPRNO .EQ. TKTAB(I,2) ) GO TO 450 07960000 420 CONTINUE 07970000 C 07980000 RETURN1 07990000 C 08000000 C GET RELATIVE ADDRESS OF CORRECT RECORD 08010000 C 08020000 450 RAD = TKRDAD(I) + DA -1 08030000 IF (RAD .GT. RDEND) RETURN1 08040000 IF (RAD .LE. RDEND .AND. I .EQ. END) GO TO 475 08050000 IF (RAD .GE. TKRDAD(I+1))RETURN1 08060000 C 08070000 C READ RECORD 08080000 C 08090000 475 IF (DCBRF) GO TO 478 08100000 CALL FOPEND 08110000 DCBRF = .TRUE. 08120000 478 CALL FOREAD (CARD,RAD) 08130000 DA = DA + 1 08140000 LEN2 = MIN0 (LEN, 104) 08150000 480 DO 485 I = 1, LEN2 08160000 CARD20(I) = CARD(I) 08170000 485 CONTINUE 08180000 IF (LEN .LE. 104) RETURN 08190000 C 08200000 DO 490 I = 105, LEN 08210000 CARD20(I) = 0 08220000 490 CONTINUE 08230000 C 08240000 RETURN 08250000 C 08260000 C***********************************************************************08270000 C 08280000 ENTRY FOCP 08290000 C 08300000 C***********************************************************************08310000 C 08320000 C NEED TO WRITE OUT DIRECTORY? 08330000 C 08340000 IF (.NOT. WRTDIR) GO TO 499 08350000 IF (DCBRF) GO TO 486 08360000 CALL FOPEND 08370000 DCBRF = .TRUE. 08380000 486 CARD( 1) = DIRT 08390000 CARD( 9) = PRMDIR 08400000 CARD(10) = RDSKAD 08410000 CALL FOWRTD (CARD,1) 08420000 C 08430000 DO 491 I = 2, 8 08440000 CARD(I) = 0 08450000 491 CONTINUE 08460000 C 08470000 C WRITE OUT A DIRECTORY RECORD 08480000 C 08490000 IF (DCBSF) GO TO 492 08500000 CALL FOPENS 08510000 DCBSF = .TRUE. 08520000 492 I = 0 08530000 493 NUMENT = DIRPTR - I 08540000 IF (NUMENT .EQ. 0) GO TO 497 08550000 IF (NUMENT .LE. 8) GO TO 494 08560000 NUMENT = 8 08570000 494 CARD(3) = NUMENT 08580000 K = 9 08590000 C 08600000 DO 496 J = 1, NUMENT 08610000 CARD(K) = TKTAB(I + J, 1) 08620000 CARD(K+1) = TKTAB(I + J,2) 08630000 CARD(K+2) = TKRDAD(I + J) 08640000 K = K + 3 08650000 496 CONTINUE 08660000 C 08670000 CALL FOWRTS (CARD) 08680000 I = I + NUMENT 08690000 RDSKAD = RDSKAD + 1 08700000 IF (I .GE. DIRPTR) GO TO 497 08710000 GO TO 493 08720000 C 08730000 C PUT IN END OF FILE RECORD 08740000 C 08750000 497 CARD(1) = EOF 08760000 C 08770000 DO 498 I = 2, 32 08780000 CARD(I) = BLNK 08790000 498 CONTINUE 08800000 C 08810000 CALL FOWRTS (CARD) 08820000 499 CALL FOCS 08830000 DCBSF = .FALSE. 08840000 CALL FOCD 08850000 DCBRF = .FALSE. 08860000 RETURN 08870000 C 08880000 C 08890000 C READ IN DIRECTORY 08900000 C 08910000 500 IF (DCBRF) GO TO 510 08920000 CALL FOPEND 08930000 DCBRF = .TRUE. 08940000 510 CALL FOREAD (CARD,1) 08950000 518 PRMDIR = CARD(9) 08960000 RDSKAD = CARD(10) 08970000 DIRTAD = RDSKAD - 1 08980000 DIRPTR = 0 08990000 520 DIRTAD = DIRTAD + 1 09000000 CALL FOREAD (CARD,DIRTAD) 09010000 IF (CARD(1) .EQ. EOF) GO TO 550 09020000 NUMENT = CARD(3) 09030000 K = 0 09040000 C 09050000 DO 530 I = 1, NUMENT 09060000 TKTAB(DIRPTR + I, 1) = CARD(9 + K) 09070000 TKTAB(DIRPTR + I, 2) = CARD(9 + K + 1) 09080000 TKRDAD(DIRPTR + I) = CARD(9 + K + 2) 09090000 K = K + 3 09100000 530 CONTINUE 09110000 C 09120000 DIRPTR = DIRPTR + NUMENT 09130000 GO TO 520 09140000 C 09150000 C END OF DIRECTORY 09160000 C 09170000 550 PRMREC = TKRDAD(PRMDIR) 09180000 DIRLOC = .FALSE. 09190000 ADDEND = DIRTAD 09200000 C 09210000 C SET SYSTEM FLAG AND WORD ADDRESSING BEFORE RETURNING 09220000 C 09230000 IF (S1CPCH(SYSTEM,1,'IBM',1,3) .EQ. 0) THEN 09240000 IDUMMY = 20 09250000 ELSE IF (S1CPCH(SYSTEM,1,'CRAY',1,4) .EQ. 0) THEN 09260000 IDUMMY = 10 09270000 ELSE 09280000 WRITE(KPPRNT, 9000) 09290000 IF (JPPRNT .GT. 0) WRITE(JPPRNT, 9000) 09300000 STOP 500 09310000 END IF 09320000 C 09330000 GO TO BRN, (250, 300, 400, 1510, 2250, 2510) 09340000 C 09350000 600 WRITE (KPPRNT,9070) 09360000 IF (JPPRNT .GT. 0) WRITE (JPPRNT,9070) 09370000 STOP 501 09380000 C 09390000 C***********************************************************************09400000 C 09410000 ENTRY FOWDMP 09420000 C 09430000 C***********************************************************************09440000 C 09450000 C IS FILE OPEN FOR READ? 09460000 C 09470000 IF (DCBRF) GO TO 1500 09480000 CALL FOPEND 09490000 DCBRF = .TRUE. 09500000 C 09510000 C IS DIRECTORY IN MEMORY 09520000 C 09530000 1500 IF (.NOT. DIRLOC) GO TO 1510 09540000 ASSIGN 1510 TO BRN 09550000 GO TO 500 09560000 C 09570000 C READ CARD ENTRIES FROM FILE AND PRINT 09580000 C 09590000 1510 WRITE (KPPRNT,9100) 09600000 IF (JPPRNT .GT. 0) WRITE (JPPRNT,9100) 09610000 CEND = TKRDAD(PRMDIR) - 1 09620000 C 09630000 DO 1550 I = 1, CEND 09640000 CALL FOREAD (CARD,I) 09650000 C 09660000 IF (IDUMMY .EQ. 20) THEN 09670000 C IBM VERSION 09680000 WRITE (KPPRNT,9080) CARD(1), CARD(2), (CARD(J), J=9, 32) 09690000 IF (JPPRNT .GT. 0) 09700000 * WRITE (JPPRNT,9080) CARD(1), CARD(2), (CARD(J), J=9, 32) 09710000 ELSE 09720000 C CRAY VERSION 09730000 WRITE (KPPRNT,9090) CARD(1), CARD(2), (CARD(J), J=9, 20) 09740000 IF (JPPRNT .GT. 0) 09750000 * WRITE (JPPRNT,9090) CARD(1), CARD(2), (CARD(J), J=9, 20) 09760000 END IF 09770000 C 09780000 1550 CONTINUE 09790000 C 09800000 C READ PARAMETER ENTRIES FROM FILE AND PRINT 09810000 C 09820000 PPTR = TKRDAD(PRMDIR) 09830000 1560 CALL FOREAD (CARD,PPTR) 09840000 IF (CARD(1) .EQ. DIRT) GO TO 1580 09850000 WRITE (KPPRNT,9110) (CARD(J), J = 1, 32) 09860000 IF (JPPRNT .GT. 0) 09870000 * WRITE (JPPRNT,9110) (CARD(J), J = 1, 32) 09880000 PPTR = PPTR + 1 09890000 GO TO 1560 09900000 C 09910000 C READ AND WRITE DIRECTORY 09920000 C 09930000 1580 WRITE (KPPRNT,9120) CARD(1), CARD(2), CARD(3), (CARD(J), J=9, 32) 09940000 IF (JPPRNT .GT. 0) 09950000 *WRITE (JPPRNT,9120) CARD(1), CARD(2), CARD(3), (CARD(J), J=9, 32) 09960000 IF (CARD(1) .EQ. EOF) GO TO 2000 09970000 PPTR = PPTR + 1 09980000 CALL FOREAD (CARD,PPTR) 09990000 GO TO 1580 10000000 2000 CALL FOCD 10010000 DCBRF = .FALSE. 10020000 RETURN 10030000 C 10040000 9000 FORMAT(1X,'ERROR IN "FOIP"-- SYSTEM MUST BE IBM OR CRAY') 10050000 C 10060000 9010 FORMAT (20A4) 10070000 C 10080000 9020 FORMAT (10A8) 10090000 C 10100000 9030 FORMAT(5X,/, 10110000 * 5X, '----------------------------------------', 10120000 * '----------------------------------------', / , 10130000 * 5X, '....5...10....5...20....5...30....5...40', 10140000 * '....5...50....5...60....5...70....5...80', / , 10150000 * 5X, '----------------------------------------', 10160000 * '----------------------------------------', / ) 10170000 C 10180000 9040 FORMAT(5X, '----------------------------------------', 10190000 * '----------------------------------------', / , 10200000 * 5X, '....5...10....5...20....5...30....5...40', 10210000 * '....5...50....5...60....5...70....5...80', / , 10220000 * 5X, '----------------------------------------', 10230000 * '----------------------------------------', / , 10240000 * 5X,'CONTINUED',/,'1', 10250000 * 4X, '----------------------------------------', 10260000 * '----------------------------------------', / , 10270000 * 5X, '....5...10....5...20....5...30....5...40', 10280000 * '....5...50....5...60....5...70....5...80', / , 10290000 * 5X, '----------------------------------------', 10300000 * '----------------------------------------', / ) 10310000 C 10320000 9050 FORMAT (5X, 24A4) 10330000 C 10340000 9060 FORMAT (5X, 12A8) 10350000 C 10360000 9070 FORMAT ( / ' ***** PARAMETER FILE DIRECTORY OVERFLOWN') 10370000 C 10380000 9080 FORMAT (' ', A4, I1, 10X, 24A4) 10390000 C 10400000 9090 FORMAT (' ', A4, I1, 10X, 12A8) 10410000 C 10420000 9100 FORMAT ('1') 10430000 C 10440000 9110 FORMAT (' ', A4, I1, A4, 3I5, 1X, A4, 10I5 / 15I5) 10450000 C 10460000 9120 FORMAT (' ', A4, 2I1, 5X, 8(A4, I1, I5, 1X)) 10470000 END 10480000