CAINDMFPARAL -- PARALLEL DIRECT ACCESS OPERATIONS 00010000 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CTITLE FPARAL -- PARALLEL DIRECT ACCESS OPERATIONS, SUMMARY 00020000 C AUTHOR STU NELAN 00030000 C DESIGNER STU NELAN 00040000 C LANGUAGE FORTRAN 00050000 C SYSTEM IBM ONLY 00060002 C WRITTEN 06-04-90 00070000 C REVISED MM-DD-YY III. .... 00080000 C 00090000 C 00100000 C CALL FPAWRK (NPARA, PARBUF, STRLEN, NREC, LREC, 00110000 C NUNPAK, CHAR, NBLK, DDNAME, ERR, ERIN) 00120000 C INPUT NPARA = NUMBER OF PARALLEL FILES I4 00130000 C INPUT PARBUF = BUFFER TO USE FOR PARALLEL WORK I4 00140000 C OUTPUT STRLEN = LENGTH OF PARBUF (WORDS) I4 00150000 C INPUT NREC = NUMBER OF RECORDS I4 00160000 C INPUT LREC = RECORD LENGTH (BYTES) I4 00170000 C INPUT NUNPAK = LENGTH OF DATA AT FRONT OF EACH RECORD I4 00180000 C TO NOT PACK, IBM BYTES 00190000 C INPUT CHAR = LAST CHARACTER OF ASSIGNED NAME C1 00200000 C INPUT NBLK = NUMBER OF 512-WORD MEMORY BLOCKS TO I4 00210000 C USE IN FOSCDK 00220000 C OUTPUT DDNAME = DDNAME ASSIGNED TO WORKFILE C8 00230000 C OUTPUT ERR = RETURN ERROR STATUS I4 00240000 C 1 = OK 00250000 C 2 = NUMBER OF SUBFLIES <= 0 00260000 C OUTPUT ERIN = ERROR INFORMATION I4 00270000 C ALLOCATE THE DISK FILES AND INITIALIZE PARBUF ARRAY. 00280000 C 00290000 C CALL FPISSD (PARBUF, ERR, ERIN) 00300000 C I/O PARBUF = BUFFER TO USE FOR PARALLEL DISKS I4 00310000 C OUTPUT ERR = RETURN ERROR STATUS I4 00320000 C 1 = OK 00330000 C 2 = NUMBER OF SUBFLIES <= 0 00340000 C OUTPUT ERIN = ERROR INFORMATION I4 00350000 C OPEN THE DISK FILES FOR SEQUENTIAL WRITES. 00360000 C 00370000 C CALL FPWSSD (PARBUF, SEQDA, DATA, ERR, ERIN) 00380000 C INPUT PARBUF = BUFFER TO USE FOR PARALLEL DISKS I4 00390000 C I/O SEQDA = SEQUENTIAL DISK ADDRESS. I4 00400000 C SEQDA IS INCREMENTED BY 1 ON OUTPUT. 00410000 C INPUT DATA = RECORD TO BE WRITTEN. ANY 00420000 C OUTPUT ERR = RETURN ERROR STATUS I4 00430000 C 1 = OK 00440000 C 2 = NUMBER OF SUBFLIES <= 0 00450000 C OUTPUT ERIN = ERROR INFORMATION I4 00460000 C BUILD FILE BY WRITING SEQUENTIALLLY. 00470000 C 00480000 C CALL FPCSD (PARBUF, ERR, ERIN) 00490000 C INPUT PARBUF = BUFFER TO USE FOR PARALLEL DISKS I4 00500000 C OUTPUT ERR = RETURN ERROR STATUS I4 00510000 C 1 = OK 00520000 C 2 = NUMBER OF SUBFLIES <= 0 00530000 C OUTPUT ERIN = ERROR INFORMATION I4 00540000 C CLOSE THE SEQUENTIAL FILE. 00550000 C 00560000 C CALL FPIDSD (PARBUF, ERR, ERIN) 00570000 C INPUT PARBUF = BUFFER TO USE FOR PARALLEL DISKS I4 00580000 C OUTPUT ERR = RETURN ERROR STATUS I4 00590000 C 1 = OK 00600000 C 2 = NUMBER OF SUBFLIES <= 0 00610000 C OUTPUT ERIN = ERROR INFORMATION I4 00620000 C SEPARATE OPEN FOR DIRECT ACCESS. 00630000 C 00640000 C CALL FPRDSD (PARBUF, INIT, DA, DATA, ERR, ERIN) 00650000 C INPUT PARBUF = BUFFER TO USE FOR PARALLEL DISKS I4 00660000 C INPUT INIT = INITIALIZATION SWITCH I4 00670000 C 0 = START UP ALL READS 00680000 C 0 <> CONTINUE WITH READS 00690000 C INPUT DA = ARRAY OF RECORD NUMBERS TO READ. I4 00700000 C ARRAY IS NPARA LONG, OR TERMINATED 00710000 C BY A NEGATIVE NUMBER. 00720000 C DA IS NOT INCREMENTED BY 1 ON OUTPUT. 00730000 C OUTPUT DATA = RECORD NUMBER DA READ FROM FILE. ANY 00740000 C OUTPUT ERR = RETURN ERROR STATUS I4 00750000 C 1 = OK 00760000 C 2 = NUMBER OF SUBFLIES <= 0 00770000 C OUTPUT ERIN = ERROR INFORMATION I4 00780000 C INITIATE READ OF RECORDS AND STORE FIRST IN DATA. 00790000 C 00800000 C CALL FPWDSD (PARBUF, RECNO, DATA, ERR, ERIN) 00810000 C INPUT PARBUF = BUFFER TO USE FOR PARALLEL DISKS I4 00820000 C INPUT RECNO = RECORD NUMBER IN FILE (1, 2, 3, ...) I4 00830000 C RECNO IS NOT INCREMENTED BY 1 ON OUTPUT. 00840000 C INPUT DATA = RECORD TO BE WRITTEN. ANY 00850000 C OUTPUT ERR = RETURN ERROR STATUS I4 00860000 C 1 = OK 00870000 C 2 = NUMBER OF SUBFLIES <= 0 00880000 C OUTPUT ERIN = ERROR INFORMATION I4 00890000 C WRITE RECORD GIVEN IN DATA AT LOCATION GIVEN BY RECNO 00900000 C 00910000 C CALL FPCDD (PARBUF, ERR, ERIN) 00920000 C INPUT PARBUF = BUFFER TO USE FOR PARALLEL DISKS I4 00930000 C OUTPUT ERR = RETURN ERROR STATUS I4 00940000 C 1 = OK 00950000 C 2 = NUMBER OF SUBFLIES <= 0 00960000 C OUTPUT ERIN = ERROR INFORMATION I4 00970000 C CLOSE THE FILE. 00980000 C 00990000 C CALL FPUWRK (PARBUF, ERR, ERIN) 01000000 C INPUT PARBUF = BUFFER TO USE FOR PARALLEL DISKS I4 01010000 C OUTPUT ERR = RETURN ERROR STATUS I4 01020000 C 1 = OK 01030000 C OUTPUT ERIN = ERROR INFORMATION I4 01040000 C UNALLOCATE THE DISK FILES. 01050000 C 01060000 C 01070000 C THE FILE IS CREATED SEQUENTIALLY WITH FPISSD AND FPWSSD. THEN 01080000 C IT CAN BE ACCESSED DIRECTLY WITH FPIDSD, FPRDSD, AND FPWDSD. 01090000 C 01100000 CTITLE FPAWRK -- ALLOCATE DISK FILES FOR PARALLEL I/O 01110000 CA AUTHOR STU NELAN 01120000 CA DESIGNER STU NELAN 01130000 CA LANGUAGE FORTRAN 01140000 CA SYSTEM IBM (SEE CRAY) 01150000 CA WRITTEN 6-04-90 01160000 CA 01170000 CA 01180000 CA CALL FPAWRK (NPARA, PARBUF, STRLEN, NREC, LREC, 01190000 CA NUNPAK, CHAR, NBLK, DDNAME, ERR, ERIN) 01200000 CA INPUT NPARA = NUMBER OF PARALLEL FILES I4 01210000 CA INPUT PARBUF = BUFFER TO USE FOR PARALLEL WORK I4 01220000 CA OUTPUT STRLEN = LENGTH OF PARBUF (WORDS) I4 01230000 CA INPUT NREC = NUMBER OF RECORDS I4 01240000 CA INPUT LREC = RECORD LENGTH (BYTES) I4 01250000 CA INPUT NUNPAK = LENGTH OF DATA AT FRONT OF EACH RECORD I4 01260000 CA TO NOT PACK, IBM BYTES 01270000 CA INPUT CHAR = LAST CHARACTER OF ASSIGNED NAME C1 01280000 CA INPUT NBLK = NUMBER OF 512-WORD MEMORY BLOCKS TO I4 01290000 CA USE IN FOSCDK 01300000 CA OUTPUT DDNAME = DDNAME ASSIGNED TO WORKFILE C8 01310000 CA OUTPUT ERR = RETURN ERROR STATUS I4 01320000 CA 1 = OK 01330000 CA 2 = NUMBER OF SUBFILES <= 0 01340000 CA OUTPUT ERIN = ERROR INFORMATION I4 01350000 CA 01360000 CA 01370000 CA THIS SUBROUTINE ALLOCATES THE PARALLEL FILES AND INITIALIZES 01380000 CA THE PARBUF AREA FOR USE IN THE VARIOUS ENTRY POINTS. 01390000 CA 01400000 CA THE FILE IS CREATED SEQUENTIALLY WITH FPISSD AND FPWSSD. THEN 01410000 CA IT CAN BE ACCESSED DIRECTLY WITH FPIDSD, FPRDSD, AND FPWDSD. 01420000 CA 01430000 CAEND 01440000 C 01450000 C 01460000 C 01470000 CTITLE FPISSD -- OPEN DISK FILES FOR SEQUENTIAL PARALLEL I/O 01480000 CA AUTHOR STU NELAN 01490000 CA DESIGNER STU NELAN 01500000 CA LANGUAGE FORTRAN 01510000 CA SYSTEM IBM (SEE CRAY) 01520000 CA WRITTEN 6-04-90 01530000 CA 01540000 CA 01550000 CA CALL FPISSD (PARBUF, ERR, ERIN) 01560000 CA I/O PARBUF = BUFFER TO USE FOR PARALLEL WORK I4 01570000 CA OUTPUT ERR = RETURN ERROR STATUS I4 01580000 CA 1 = OK 01590000 CA .NE. 1 = ERROR 01600000 CA OUTPUT ERIN = ERROR INFORMATION I4 01610000 CA 01620000 CA 01630000 CA OPEN THE FILE FOR SEQUENTIAL WRITES (USING FPWSSD). 01640000 CA 01650000 CA THE FILE IS CREATED SEQUENTIALLY WITH FPISSD AND FPWSSD. THEN 01660000 CA IT CAN BE ACCESSED DIRECTLY WITH FPIDSD, FPRDSD, AND FPWDSD. 01670000 CA 01680000 CAEND 01690000 C 01700000 C 01710000 C 01720000 CTITLE FPWSSD -- WRITE SEQUENTIALLY TO PARALLEL FILES 01730000 CA AUTHOR STU NELAN 01740000 CA DESIGNER STU NELAN 01750000 CA LANGUAGE FORTRAN 01760000 CA SYSTEM IBM (SEE CRAY) 01770000 CA WRITTEN 6-04-90 01780000 CA 01790000 CA 01800000 CA CALL FPWSSD (PARBUF, SEQDA, DATA, ERR, ERIN) 01810000 CA I/O PARBUF = BUFFER TO USE FOR PARALLEL WORK I4 01820000 CA INPUT SEQDA = SEQUENTIAL DISK ADDRESS I4 01830000 CA INPUT DATA = RECORD TO BE WRITTEN ANY 01840000 CA OUTPUT ERR = RETURN ERROR STATUS I4 01850000 CA 1 = OK 01860000 CA .NE. 1 = ERROR 01870000 CA OUTPUT ERIN = ERROR INFORMATION I4 01880000 CA 01890000 CA 01900000 CA BUILD FILE BY WRITING SEQUENTIALLLY. 01910000 CA 01920000 CA THE FILE IS CREATED SEQUENTIALLY WITH FPISSD AND FPWSSD. THEN 01930000 CA IT CAN BE ACCESSED DIRECTLY WITH FPIDSD, FPRDSD, AND FPWDSD. 01940000 CA 01950000 CAEND 01960000 C 01970000 C 01980000 C 01990000 CTITLE FPCSD -- CLOSE SEQUENTIAL PARALLEL FILES 02000000 CA AUTHOR STU NELAN 02010000 CA DESIGNER STU NELAN 02020000 CA LANGUAGE FORTRAN 02030000 CA SYSTEM IBM (SEE CRAY) 02040000 CA WRITTEN 6-04-90 02050000 CA 02060000 CA 02070000 CA 02080000 CA CALL FPCSD (PARBUF, ERR, ERIN) 02090000 CA I/O PARBUF = BUFFER TO USE FOR PARALLEL WORK I4 02100000 CA OUTPUT ERR = RETURN ERROR STATUS I4 02110000 CA 1 = OK 02120000 CA .NE. 1 = ERROR 02130000 CA OUTPUT ERIN = ERROR INFORMATION I4 02140000 CA 02150000 CA CLOSE THE SEQUENTIAL FILE. 02160000 CA 02170000 CAEND 02180000 C 02190000 C 02200000 C 02210000 CTITLE FPIDSD -- OPEN DISK FILES FOR DIRECT PARALLEL I/O 02220000 CA AUTHOR STU NELAN 02230000 CA DESIGNER STU NELAN 02240000 CA LANGUAGE FORTRAN 02250000 CA SYSTEM IBM (SEE CRAY) 02260000 CA WRITTEN 6-04-90 02270000 CA 02280000 CA 02290000 CA CALL FPIDSD (PARBUF, ERR, ERIN) 02300000 CA I/O PARBUF = BUFFER TO USE FOR PARALLEL WORK I4 02310000 CA OUTPUT ERR = RETURN ERROR STATUS I4 02320000 CA 1 = OK 02330000 CA .NE. 1 = ERROR 02340000 CA OUTPUT ERIN = ERROR INFORMATION I4 02350000 CA 02360000 CA OPEN FILE FOR DIRECT ACCESS, AFTER FILE HAS BEEN BUILT WITH 02370000 CA FPISSD AND FPWSSD. 02380000 CA 02390000 CA THE FILE IS CREATED SEQUENTIALLY WITH FPISSD AND FPWSSD. THEN 02400000 CA IT CAN BE ACCESSED DIRECTLY WITH FPIDSD, FPRDSD, AND FPWDSD. 02410000 CA 02420000 CAEND 02430000 C 02440000 C 02450000 C 02460000 CTITLE FPRDSD -- READ DIRECT FROM PARALLEL FILES 02470000 CA AUTHOR STU NELAN 02480000 CA DESIGNER STU NELAN 02490000 CA LANGUAGE FORTRAN 02500000 CA SYSTEM IBM (SEE CRAY) 02510000 CA WRITTEN 6-04-90 02520000 CA 02530000 CA 02540000 CA CALL FPRDSD (PARBUF, INIT, DA, DATA, ERR, ERIN) 02550000 CA I/O PARBUF = BUFFER TO USE FOR PARALLEL WORK I4 02560000 CA INPUT INIT = INITIALIZATION SWITCH I4 02570000 CA 0 = START UP ALL READS 02580000 CA 0 <> CONTINUE WITH READS 02590000 CA INPUT DA = ARRAY OF RECORD NUMBERS TO READ. I4 02600000 CA ARRAY IS NPARA LONG, OR TERMINATED 02610000 CA BY A NEGATIVE NUMBER. 02620000 CA DA IS NOT INCREMENTED BY 1 ON OUTPUT. 02630000 CA OUTPUT DATA = RECORD NUMBER DA READ FROM FILE. ANY 02640000 CA OUTPUT ERR = RETURN ERROR STATUS I4 02650000 CA 1 = OK 02660000 CA .NE. 1 = ERROR 02670000 CA OUTPUT ERIN = ERROR INFORMATION I4 02680000 CA 02690000 CA 02700000 CA READ RECORD NUMBER DA AND STORE IN DATA. 02710000 CA 02720000 CA THE FILE IS CREATED SEQUENTIALLY WITH FPISSD AND FPWSSD. THEN 02730000 CA IT CAN BE ACCESSED DIRECTLY WITH FPIDSD, FPRDSD, AND FPWDSD. 02740000 CA 02750000 CAEND 02760000 C 02770000 C 02780000 C 02790000 CTITLE FPWDSD -- WRITE DIRECT TO PARALLEL FILES 02800000 CA AUTHOR STU NELAN 02810000 CA DESIGNER STU NELAN 02820000 CA LANGUAGE FORTRAN 02830000 CA SYSTEM IBM (SEE CRAY) 02840000 CA WRITTEN 6-04-90 02850000 CA 02860000 CA 02870000 CA CALL FPWDSD (PARBUF, RECNO, DATA, ERR, ERIN) 02880000 CA I/O PARBUF = BUFFER TO USE FOR PARALLEL WORK I4 02890000 CA INPUT RECNO = RECORD NUMBER IN FILE. I4 02900000 CA RECNO IS NOT INCREMENTED BY 1 ON OUTPUT. 02910000 CA INPUT DATA = RECORD NUMBER DA READ FROM FILE. ANY 02920000 CA OUTPUT ERR = RETURN ERROR STATUS I4 02930000 CA 1 = OK 02940000 CA .NE. 1 = ERROR 02950000 CA OUTPUT ERIN = ERROR INFORMATION I4 02960000 CA 02970000 CA 02980000 CA WRITE RECORD GIVEN IN DATA AT LOCATION GIVEN BY RECNO. 02990000 CA 03000000 CA THE FILE IS CREATED SEQUENTIALLY WITH FPISSD AND FPWSSD. THEN 03010000 CA IT CAN BE ACCESSED DIRECTLY WITH FPIDSD, FPRDSD, AND FPWDSD. 03020000 CA 03030000 CAEND 03040000 C 03050000 C 03060000 C 03070000 CTITLE FPCDD -- CLOSE DIRECT PARALLEL FILES 03080000 CA AUTHOR STU NELAN 03090000 CA DESIGNER STU NELAN 03100000 CA LANGUAGE FORTRAN 03110000 CA SYSTEM IBM (SEE CRAY) 03120000 CA WRITTEN 6-04-90 03130000 CA 03140000 CA 03150000 CA 03160000 CA CALL FPCDD (PARBUF, ERR, ERIN) 03170000 CA I/O PARBUF = BUFFER TO USE FOR PARALLEL WORK I4 03180000 CA OUTPUT ERR = RETURN ERROR STATUS I4 03190000 CA 1 = OK 03200000 CA .NE. 1 = ERROR 03210000 CA OUTPUT ERIN = ERROR INFORMATION I4 03220000 CA 03230000 CA CLOSE THE DIRECT FILE. 03240000 CA 03250000 CA THE FILE IS CREATED SEQUENTIALLY WITH FPISSD AND FPWSSD. THEN 03260000 CA IT CAN BE ACCESSED DIRECTLY WITH FPIDSD, FPRDSD, AND FPWDSD. 03270000 CA 03280000 CAEND 03290000 C 03300000 C 03310000 C 03320000 CTITLE FPUWRK -- UNALLOCATE THE PARALLEL DISK FILES 03330000 CA AUTHOR STU NELAN 03340000 CA DESIGNER STU NELAN 03350000 CA LANGUAGE FORTRAN 03360000 CA SYSTEM IBM (SEE CRAY) 03370000 CA WRITTEN 6-04-90 03380000 CA 03390000 CA 03400000 CA 03410000 CA CALL FPUWRK (PARBUF, ERR, ERIN) 03420000 CA I/O PARBUF = BUFFER TO USE FOR PARALLEL WORK I4 03430000 CA OUTPUT ERR = RETURN ERROR STATUS I4 03440000 CA 1 = OK 03450000 CA OUTPUT ERIN = ERROR INFORMATION I4 03460000 CA 03470000 CA UNALLOCATE THE PARALLEL DISK FILES. 03480000 CA 03490000 CAEND 03500000 SUBROUTINE FPARAL 03510000 C 03520000 IMPLICIT INTEGER (A-Z) 03530000 C 03540000 COMMON /P/ STARTP( 2), M00004( 102) 03550000 COMMON /P/ KPNA 03560000 COMMON /P/ KPRNO 03570000 COMMON /P/ KPOCUR , M00508( 31) 03580000 COMMON /P/ KPWKIO 03590000 C 03600000 COMMON COM(1) 03610000 C 03620000 INTEGER DA ( *) 03630000 INTEGER DATA ( *) 03640000 INTEGER PARBUF ( *) 03650000 INTEGER LOCVAR ( 12) 03660000 C 03670000 CHARACTER*1 CHAR 03680000 CHARACTER*8 DDNAME 03690000 CHARACTER*9 DEVICE 03700000 CHARACTER*44 FILE 03710000 CHARACTER*8 JOBNAM 03720000 CHARACTER*28 USERID 03730000 C 03740000 REAL TOTAL 03750000 C 03760000 EQUIVALENCE (LOCVAR(1) , NPARAL ) 03770000 C EQUIVALENCE (LOCVAR(2) , DDNAME ) 03780000 C EQUIVALENCE (LOCVAR(3) , DDNAME ) 03790000 EQUIVALENCE (LOCVAR(4) , LENGTH ) 03800000 EQUIVALENCE (LOCVAR(5) , PUNIT ) 03810000 EQUIVALENCE (LOCVAR(6) , ENDRD ) 03820000 EQUIVALENCE (LOCVAR(7) , PAINDS ) 03830000 EQUIVALENCE (LOCVAR(8) , PAINDX ) 03840000 EQUIVALENCE (LOCVAR(9) , PADATA ) 03850000 EQUIVALENCE (LOCVAR(10), PAWCNT ) 03860000 EQUIVALENCE (LOCVAR(11), PARCNT ) 03870000 EQUIVALENCE (LOCVAR(12), LENSTR ) 03880000 C 03890000 DATA DEVICE / 'SYSALLDA' / 03900000 CESN DATA DEVICE / '3380' / 03910000 DATA FILE / '/' / 03920000 CESN DATA FILE / '/DBGESN.PIOAM.DATA' / 03930000 CESN DATA FILE / '/SYSM.PIOAM.DATA' / 03940000 DATA IPR / 6 / 03950000 DATA LENVAR / 12 / 03960000 DATA NDISKS / 12 / 03970000 C 03980000 C 03990000 C 04000000 C************************************************************** 04010000 C ALLOCATE PARALLEL SCRATCH DISKS 04020000 C************************************************************** 04030000 C 04040000 ENTRY FPAWRK (NPARA, PARBUF, STRLEN, NREC, LREC, 04050000 * NUNPAK, CHAR, NBLKS, DDNAME, ERR, ERIN) 04060000 C 04070000 C INITIALIZATION 04080000 C 04090000 ERR = 0 04100000 ERIN = 0 04110000 C 04120000 NPARAL = NPARA 04130000 IF (NPARAL .LE. 0) GO TO 1010 04140000 C 04150000 PUNIT = 6 04160000 PAWCNT = 0 04170000 PARCNT = 0 04180000 ENDRD = 0 04190000 C 04200000 C RETRIEVE USERID 04210000 C 04220000 USERID = ' ' 04230000 CALL JGPASS (USERID) 04240000 DO 30 I = 1, 6 04250000 IF (USERID(I:I) .EQ. ' ') GO TO 40 04260000 N = I 04270000 30 CONTINUE 04280000 40 CONTINUE 04290000 FILE(2:9) = USERID 04300000 FILE(N+2:N+2) = '.' 04310000 C 04320000 C RETRIEVE JOBNAME 04330000 C 04340000 JOBNAM = ' ' 04350000 CALL S1JOB (JOBNAM) 04360000 DO 50 I = 1, 8 04370000 IF (JOBNAM(I:I) .EQ. ' ') GO TO 60 04380000 M = I 04390000 50 CONTINUE 04400000 60 CONTINUE 04410000 FILE(N+3:N+10) = JOBNAM 04420000 FILE(N+M+3:N+M+3) = '.' 04430000 C 04440000 C BUILD DDNAME 04450000 C 04460000 CALL S1MVCH (KPNA, 1, DDNAME, 1, 4) 04470000 CALL S1BNCV (KPRNO, DDNAME, 5, 1) 04480000 CALL S1BNCV (KPOCUR, DDNAME, 6, 2) 04490000 CALL S1MVCH (CHAR, 1, DDNAME, 8, 1) 04500000 CALL S1MVCH (DDNAME, 1, LOCVAR(2), 1, 8) 04510000 FILE(N+M+4:N+M+11) = DDNAME 04520000 WRITE (IPR,8123) FILE,NDISKS 04530000 8123 FORMAT (5X,'FILE = ',A44,' ALLOCATED TO ',I5,' DISKS') 04540000 C 04550000 LENGTH = LREC / 4 04560000 IF (LREC .LT. 1024) THEN 04570000 CALL UPAWRK (NREC, LREC, CHAR, PAWCNT, PARCNT, DDNAME, ERR, 04580000 * ERIN) 04590000 NPARAL = -1 04600000 GO TO 180 04610000 ENDIF 04620000 C 04630000 C DO GETMN2 FOR MEMORY NEEDED 04640000 C 04650000 ILEN = NPARAL*(LENGTH+2) 04660000 CALL GETMN2 (COM, ILEN, I, OLEN) 04670000 IF (OLEN .LT. ILEN) THEN 04680000 C NOT ENOUGH MEMORY AVAILABLE -- FREE WHAT WE GOT 04690000 CALL FREMN2 (COM(I+1), OLEN) 04700000 CALL UPAWRK (NREC, LREC, CHAR, PAWCNT, PARCNT, DDNAME, ERR, 04710000 * ERIN) 04720000 NPARAL = -1 04730000 GO TO 180 04740000 ENDIF 04750000 PAINDS = I + 1 04760000 PAINDX = PAINDS + NPARAL 04770000 PADATA = PAINDX + NPARAL 04780000 LENSTR = OLEN 04790000 C 04800000 C ALLOCATE PARALLEL FILE 04810000 C 04820000 CALL APOFILD (FILE, LREC, NREC, DEVICE, NDISKS, ERR) 04830000 IF (ERR .NE. 0) THEN 04840000 WRITE (IPR,9100) ERR,LREC,NREC 04850000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 04860000 CALL XDUMPX (ERR) 04870001 CALL UPAWRK (NREC, LREC, CHAR, PAWCNT, PARCNT, DDNAME, ERR, 04880000 * ERIN) 04890000 NPARAL = -1 04900000 GO TO 180 04910000 C RETURN 04920000 ELSE 04930000 ERR = 1 04940000 TOTAL = (1.0*NREC)*LREC 04950000 WRITE (IPR,9240) KPNA, KPRNO, DDNAME, NREC, LREC, TOTAL 04960000 ENDIF 04970000 180 CONTINUE 04980000 C 04990000 C STORE INFORMATION IN PARBUF AND SET SIZE 05000000 C 05010000 DO 190 I = 1, LENVAR 05020000 190 PARBUF(I) = LOCVAR(I) 05030000 C 05040000 STRLEN = LENVAR 05050000 C 05060000 RETURN 05070000 C 05080000 C 05090000 C 05100000 C************************************************************** 05110000 C INITIALIZE SEQUENTIAL SCRATCH DISK 05120000 C************************************************************** 05130000 C 05140000 ENTRY FPISSD (PARBUF, ERR, ERIN) 05150000 C 05160000 C INITIALIZATION 05170000 C 05180000 ERR = 0 05190000 ERIN = 0 05200000 C 05210000 DO 200 I = 1, LENVAR 05220000 200 LOCVAR(I) = PARBUF(I) 05230000 C 05240000 C OPEN FILE 05250000 C 05260000 IF (NPARAL .LT. 0) THEN 05270000 CALL FOISSD (PAWCNT, LENGTH*4, 2) 05280000 ERR = 1 05290000 ELSE 05300000 CALL APOOPEN (PUNIT, FILE, NPARAL, ERR) 05310000 IF (ERR .NE. 0) THEN 05320000 WRITE (IPR,9110) ERR 05330000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 05340000 RETURN 05350000 ELSE 05360000 ERR = 1 05370000 ENDIF 05380000 ENDIF 05390000 C 05400000 C STORE INFORMATION IN PARBUF 05410000 C 05420000 DO 290 I = 1, LENVAR 05430000 290 PARBUF(I) = LOCVAR(I) 05440000 C 05450000 RETURN 05460000 C 05470000 C 05480000 C 05490000 C****************************************************************** 05500000 C WRITE SEQUENTIALLY ON SCRATCH DISK 05510000 C****************************************************************** 05520000 C 05530000 ENTRY FPWSSD (PARBUF, SEQDA, DATA, ERR, ERIN) 05540000 C 05550000 C INITIALIZATION 05560000 C 05570000 ERR = 0 05580000 ERIN = 0 05590000 C 05600000 DO 300 I = 1, LENVAR 05610000 300 LOCVAR(I) = PARBUF(I) 05620000 C 05630000 IF (NPARAL .LT. 0) THEN 05640000 CALL FOWSSD (PAWCNT, SEQDA, DATA) 05650000 ERR = 1 05660000 ELSE 05670000 C 05680000 C INDS IS THE LOCATION IN COM OF THE DATA 05690000 C INDX IS THE RECORD NUMBER ON DISK OF THE DATA 05700000 C 05710000 INDS = PADATA + PAWCNT*LENGTH 05720000 INDX = SEQDA 05730000 COM(PAINDS+PAWCNT) = LOC(COM(INDS)) 05740000 COM(PAINDX+PAWCNT) = INDX 05750000 C 05760000 C MOVE DATA 05770000 C 05780000 C DO 310 I = 1, LENGTH 05790000 C COM(INDS+I-1) = DATA(I) 05800000 C 310 CONTINUE 05810000 CALL ARMVE (DATA, COM(INDS), LENGTH) 05820000 PAWCNT = PAWCNT + 1 05830000 CESN WRITE (IPR,8233) PAWCNT 05840000 C8233 FORMAT (5X,'FPWSSD -- PAWCNT = ',12Z10) 05850000 C 05860000 C ISSUE WRITE 05870000 C 05880000 IF (PAWCNT .EQ. NPARAL) THEN 05890000 REQUEST = 1 05900000 CESN WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 05910000 C * PAWCNT,COM(PAINDS),COM(PAINDS+1), 05920000 C * REQUEST 05930000 C WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 05940000 CALL APOWRT (PUNIT, ID, COM(PAINDX), 1, PAWCNT, 05950000 * COM(PADATA), 1, REQUEST, 05960000 * ERR) 05970000 IF (ERR .NE. 0) THEN 05980000 WRITE (IPR,9120) ERR 05990000 WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 06000000 * PAWCNT,COM(PAINDS),COM(PAINDS+1), 06010000 * REQUEST 06020000 8234 FORMAT (5X,12Z10) 06030000 WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 06040000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 06050000 RETURN 06060000 ELSE 06070000 ERR = 1 06080000 ENDIF 06090000 KPWKIO = KPWKIO + 1 06100000 C 06110000 C WAIT ON WRITE 06120000 C 06130000 CALL APOWAIT (PUNIT, ID, ERR) 06140000 IF (ERR .NE. 1) THEN 06150000 WRITE (IPR,9130) ERR 06160000 WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 06170000 * PAWCNT,COM(PAINDS),COM(PAINDS+1), 06180000 * REQUEST 06190000 WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 06200000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 06210000 RETURN 06220000 ELSE 06230000 ERR = 1 06240000 ENDIF 06250000 PAWCNT = 0 06260000 ENDIF 06270000 SEQDA = SEQDA + 1 06280000 ENDIF 06290000 C 06300000 C STORE INFORMATION IN PARBUF 06310000 C 06320000 DO 390 I = 1, LENVAR 06330000 390 PARBUF(I) = LOCVAR(I) 06340000 ERR = 1 06350000 C 06360000 RETURN 06370000 C 06380000 C 06390000 C 06400000 C************************************************************** 06410000 C CLOSE SEQUENTIAL SCRATCH DISK 06420000 C************************************************************** 06430000 C 06440000 ENTRY FPCSD (PARBUF, ERR, ERIN) 06450000 C 06460000 C INITIALIZATION 06470000 C 06480000 ERR = 0 06490000 ERIN = 0 06500000 C 06510000 DO 400 I = 1, LENVAR 06520000 400 LOCVAR(I) = PARBUF(I) 06530000 C 06540000 IF (NPARAL .LT. 0) THEN 06550000 CALL FOCSD (PAWCNT) 06560000 ERR = 1 06570000 ELSE 06580000 C 06590000 C ISSUE WRITE 06600000 C 06610000 IF (PAWCNT .GT. 0) THEN 06620000 REQUEST = 1 06630000 CESN WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 06640000 C * PAWCNT,COM(PAINDS),COM(PAINDS+1), 06650000 C * REQUEST 06660000 C WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 06670000 CALL APOWRT (PUNIT, ID, COM(PAINDX), 1, PAWCNT, 06680000 * COM(PADATA), 1, REQUEST, 06690000 * ERR) 06700000 IF (ERR .NE. 0) THEN 06710000 WRITE (IPR,9140) ERR 06720000 WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 06730000 * PAWCNT,COM(PAINDS),COM(PAINDS+1), 06740000 * REQUEST 06750000 WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 06760000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 06770000 RETURN 06780000 ELSE 06790000 ERR = 1 06800000 ENDIF 06810000 KPWKIO = KPWKIO + 1 06820000 C 06830000 C WAIT ON WRITE 06840000 C 06850000 CALL APOWAIT (PUNIT, ID, ERR) 06860000 IF (ERR .NE. 1) THEN 06870000 WRITE (IPR,9150) ERR 06880000 WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 06890000 * PAWCNT,COM(PAINDS),COM(PAINDS+1), 06900000 * REQUEST 06910000 WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 06920000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 06930000 RETURN 06940000 ELSE 06950000 ERR = 1 06960000 ENDIF 06970000 PAWCNT = 0 06980000 C 06990000 ELSE 07000000 C 07010000 ERR = 1 07020000 C 07030000 ENDIF 07040000 ENDIF 07050000 C 07060000 C STORE INFORMATION IN PARBUF 07070000 C 07080000 DO 490 I = 1, LENVAR 07090000 490 PARBUF(I) = LOCVAR(I) 07100000 C 07110000 RETURN 07120000 C 07130000 C 07140000 C 07150000 C****************************************************************** 07160000 C INITIALIZE DIRECT SCRATCH DISK 07170000 C****************************************************************** 07180000 C 07190000 ENTRY FPIDSD (PARBUF, ERR, ERIN) 07200000 C 07210000 ERR = 1 07220000 ERIN = 0 07230000 C 07240000 DO 500 I = 1, LENVAR 07250000 500 LOCVAR(I) = PARBUF(I) 07260000 C 07270000 IF (NPARAL .LT. 0) THEN 07280000 CALL FOIDSD (PARCNT, LENGTH*4) 07290000 ENDIF 07300000 C 07310000 RETURN 07320000 C 07330000 C 07340000 C 07350000 C*************************************************************** 07360000 C READ DIRECT FROM SCRATCH DISK 07370000 C*************************************************************** 07380000 C 07390000 ENTRY FPRDSD (PARBUF, INIT, DA, DATA, ERR, ERIN) 07400000 C 07410000 C INITIALIZATION 07420000 C 07430000 ERR = 0 07440000 ERIN = 0 07450000 C 07460000 DO 600 I = 1, LENVAR 07470000 600 LOCVAR(I) = PARBUF(I) 07480000 C 07490000 IF (NPARAL .LT. 0) THEN 07500000 CALL FORDSD (PARCNT, DA, DATA) 07510000 ERR = 1 07520000 ELSE 07530000 C 07540000 IF (INIT .EQ. 0) THEN 07550000 C 07560000 C IF FIRST CALL OF A SET, 07570000 C MAKE SURE ALL WRITES HAVE BEEN ISSUED ... 07580000 C 07590000 IF (PAWCNT .GT. 0) THEN 07600000 REQUEST = 1 07610000 CESN WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 07620000 C * PAWCNT,COM(PAINDS), 07630000 C * REQUEST 07640000 C WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 07650000 CALL APOWRTL (PUNIT, ID, COM(PAINDX), PAWCNT, 07660000 * COM(PAINDS), COM(PADATA), REQUEST, 07670000 * ERR) 07680000 IF (ERR .NE. 0) THEN 07690000 WRITE (IPR,9160) ERR 07700000 WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 07710000 * PAWCNT,COM(PAINDS), 07720000 * REQUEST 07730000 WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 07740000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 07750000 RETURN 07760000 ELSE 07770000 ERR = 1 07780000 ENDIF 07790000 KPWKIO = KPWKIO + 1 07800000 C 07810000 C WAIT ON WRITE 07820000 C 07830000 CALL APOWAIT (PUNIT, ID, ERR) 07840000 IF (ERR .NE. 1) THEN 07850000 WRITE (IPR,9170) ERR 07860000 WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 07870000 * PAWCNT,COM(PAINDS), 07880000 * REQUEST 07890000 WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 07900000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 07910000 RETURN 07920000 ELSE 07930000 ERR = 1 07940000 ENDIF 07950000 PAWCNT = 0 07960000 ENDIF 07970000 C 07980000 C ... THEN ISSUE ALL READS ... 07990000 C 08000000 DO 620 I = 1, NPARAL 08010000 RDMDA = DA(I) 08020000 IF (RDMDA .LE. 0) GO TO 625 08030000 C 08040000 C INDS IS THE LOCATION IN COM OF THE DATA 08050000 C INDX IS THE RECORD NUMBER ON DISK OF THE DATA 08060000 C 08070000 INDS = PADATA + PARCNT*LENGTH 08080000 INDX = RDMDA 08090000 COM(PAINDS+PARCNT) = PARCNT + 1 08100000 COM(PAINDX+PARCNT) = INDX 08110000 PARCNT = PARCNT + 1 08120000 620 CONTINUE 08130000 625 IF (PARCNT .GT. 0) THEN 08140000 REQUEST = 1 08150000 ERR = 0 08160000 CESN WRITE (IPR,8235) PUNIT,ID,COM(PAINDX),COM(PAINDX+1), 08170000 C * PARCNT,COM(PAINDS),COM(PAINDS+1), 08180000 C * REQUEST 08190000 CALL APORDL (PUNIT, ID, COM(PAINDX), PARCNT, 08200000 * COM(PAINDS), COM(PADATA), REQUEST, 08210000 * ERR) 08220000 IF (ERR .NE. 0) THEN 08230000 WRITE (IPR,9180) ERR 08240000 WRITE (IPR,8235) PUNIT,ID,COM(PAINDX),COM(PAINDX+1), 08250000 * PARCNT,COM(PAINDS),COM(PAINDS+1), 08260000 * REQUEST 08270000 8235 FORMAT (5X,10Z10) 08280000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 08290000 RETURN 08300000 ELSE 08310000 ERR = 1 08320000 ENDIF 08330000 KPWKIO = KPWKIO + 1 08340000 C 08350000 C ... THEN WAIT 08360000 C 08370000 CALL APOWAIT (PUNIT, ID, ERR) 08380000 CESN WRITE (IPR,8235) (COM(PADATA+I-1),I=1,10) 08390000 IF (ERR .NE. 1) THEN 08400000 WRITE (IPR,9190) ERR 08410000 WRITE (IPR,8235) PUNIT,ID,COM(PAINDX),COM(PAINDX+1), 08420000 * PARCNT,COM(PAINDS),COM(PAINDS+1), 08430000 * REQUEST 08440000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 08450000 RETURN 08460000 ELSE 08470000 ERR = 1 08480000 ENDIF 08490000 ENDRD = PARCNT 08500000 PARCNT = 0 08510000 ENDIF 08520000 ELSE 08530000 ERR = 1 08540000 ENDIF 08550000 C 08560000 C SET POINTERS FOR CURRENT READ AND 08570000 C PUSH DOWN STACK 08580000 C 08590000 INDSC = PADATA + (COM(PAINDS)-1)*LENGTH 08600000 ENDRD = ENDRD - 1 08610000 DO 640 I = 2, NPARAL 08620000 COM(PAINDS+I-2) = COM(PAINDS+I-1) 08630000 640 CONTINUE 08640000 C 08650000 C MOVE THE DATA 08660000 C 08670000 C DO 650 I = 1, LENGTH 08680000 C DATA(I) = COM(INDSC+I-1) 08690000 C 650 CONTINUE 08700000 CALL ARMVE (COM(INDSC), DATA, LENGTH) 08710000 C 08720000 C IF READS HAVE ALL BEEN OUTPUT 08730000 C ISSUE NEW SET OF READS ... 08740000 C 08750000 IF (ENDRD .EQ. 0) THEN 08760000 DO 660 I = 1, NPARAL 08770000 RDMDA = DA(I+1) 08780000 IF (RDMDA .LE. 0) GO TO 665 08790000 C 08800000 C INDS IS THE LOCATION IN COM OF THE DATA 08810000 C INDX IS THE RECORD NUMBER ON DISK OF THE DATA 08820000 C 08830000 INDS = PADATA + PARCNT*LENGTH 08840000 INDX = RDMDA 08850000 COM(PAINDS+PARCNT) = PARCNT + 1 08860000 COM(PAINDX+PARCNT) = INDX 08870000 PARCNT = PARCNT + 1 08880000 660 CONTINUE 08890000 665 IF (PARCNT .GT. 0) THEN 08900000 REQUEST = 1 08910000 ERR = 0 08920000 CESN WRITE (IPR,8235) PUNIT,ID,COM(PAINDX),COM(PAINDX+1), 08930000 C * PARCNT,COM(PAINDS),COM(PAINDS+1), 08940000 C * REQUEST 08950000 CALL APORDL (PUNIT, ID, COM(PAINDX), PARCNT, 08960000 * COM(PAINDS), COM(PADATA), REQUEST, 08970000 * ERR) 08980000 IF (ERR .NE. 0) THEN 08990000 WRITE (IPR,9180) ERR 09000000 WRITE (IPR,8235) PUNIT,ID,COM(PAINDX),COM(PAINDX+1), 09010000 * PARCNT,COM(PAINDS),COM(PAINDS+1), 09020000 * REQUEST 09030000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 09040000 RETURN 09050000 ELSE 09060000 ERR = 1 09070000 ENDIF 09080000 KPWKIO = KPWKIO + 1 09090000 C 09100000 C ... THEN WAIT 09110000 C 09120000 CALL APOWAIT (PUNIT, ID, ERR) 09130000 CESN WRITE (IPR,8235) (COM(PADATA+I-1),I=1,10) 09140000 IF (ERR .NE. 1) THEN 09150000 WRITE (IPR,9195) ERR 09160000 WRITE (IPR,8235) PUNIT,ID,COM(PAINDX),COM(PAINDX+1), 09170000 * PARCNT,COM(PAINDS),COM(PAINDS+1), 09180000 * REQUEST 09190000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 09200000 RETURN 09210000 ELSE 09220000 ERR = 1 09230000 ENDIF 09240000 ENDRD = PARCNT 09250000 PARCNT = 0 09260000 ENDIF 09270000 ENDIF 09280000 ENDIF 09290000 C 09300000 DO 690 I = 1, LENVAR 09310000 690 PARBUF(I) = LOCVAR(I) 09320000 C 09330000 RETURN 09340000 C 09350000 C 09360000 C 09370000 C************************************************************* 09380000 C WRITE DIRECT TO SCRATCH DISK 09390000 C************************************************************* 09400000 C 09410000 ENTRY FPWDSD (PARBUF, RECNO, DATA, ERR, ERIN) 09420000 C 09430000 C INITIALIZATION 09440000 C 09450000 ERR = 0 09460000 ERIN = 0 09470000 C 09480000 DO 700 I = 1, LENVAR 09490000 700 LOCVAR(I) = PARBUF(I) 09500000 C 09510000 IF (NPARAL .LT. 0) THEN 09520000 CALL FOWDSD (PAWCNT, RECNO, DATA) 09530000 ERR = 1 09540000 ELSE 09550000 C 09560000 C INDS IS THE LOCATION IN COM OF THE DATA 09570000 C INDX IS THE RECORD NUMBER ON DISK OF THE DATA 09580000 C 09590000 INDS = PADATA + PAWCNT*LENGTH 09600000 INDX = RECNO 09610000 COM(PAINDS+PAWCNT) = PAWCNT + 1 09620000 COM(PAINDX+PAWCNT) = INDX 09630000 C 09640000 C MOVE DATA 09650000 C 09660000 C DO 710 I = 1, LENGTH 09670000 C COM(INDS+I-1) = DATA(I) 09680000 C 710 CONTINUE 09690000 CALL ARMVE (DATA, COM(INDS), LENGTH) 09700000 PAWCNT = PAWCNT + 1 09710000 C 09720000 C ISSUE WRITE 09730000 C 09740000 IF (PAWCNT .EQ. NPARAL) THEN 09750000 REQUEST = 1 09760000 CESN WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 09770000 C * PAWCNT,COM(PAINDS), 09780000 C * REQUEST 09790000 C WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 09800000 CALL APOWRTL (PUNIT, ID, COM(PAINDX), PAWCNT, 09810000 * COM(PAINDS), COM(PADATA), REQUEST, 09820000 * ERR) 09830000 IF (ERR .NE. 0) THEN 09840000 WRITE (IPR,9200) ERR 09850000 WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 09860000 * PAWCNT,COM(PAINDS), 09870000 * REQUEST 09880000 WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 09890000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 09900000 RETURN 09910000 ELSE 09920000 ERR = 1 09930000 ENDIF 09940000 KPWKIO = KPWKIO + 1 09950000 C 09960000 C WAIT ON WRITE 09970000 C 09980000 CALL APOWAIT (PUNIT, ID, ERR) 09990000 IF (ERR .NE. 1) THEN 10000000 WRITE (IPR,9210) ERR 10010000 WRITE (IPR,8234) PUNIT,ID,COM(PAINDX), 10020000 * PAWCNT,COM(PAINDS), 10030000 * REQUEST 10040000 WRITE (IPR,8234) (COM(PADATA+I-1),I=1,10) 10050000 CALL APOCLOS (PUNIT, 'DELETE ', ERIN) 10060000 RETURN 10070000 ELSE 10080000 ERR = 1 10090000 ENDIF 10100000 PAWCNT = 0 10110000 ELSE 10120000 ERR = 1 10130000 ENDIF 10140000 SEQDA = SEQDA + 1 10150000 C 10160000 ENDIF 10170000 C 10180000 DO 790 I = 1, LENVAR 10190000 790 PARBUF(I) = LOCVAR(I) 10200000 C 10210000 RETURN 10220000 C 10230000 C 10240000 C 10250000 C************************************************************** 10260000 C CLOSE DIRECT SCRATCH DISK 10270000 C************************************************************** 10280000 C 10290000 ENTRY FPCDD (PARBUF, ERR, ERIN) 10300000 C 10310000 C INITIALIZATION 10320000 C 10330000 ERR = 1 10340000 ERIN = 0 10350000 C 10360000 DO 800 I = 1, LENVAR 10370000 800 LOCVAR(I) = PARBUF(I) 10380000 C 10390000 IF (NPARAL .LT. 0) THEN 10400000 CALL FOCDD (PARCNT) 10410000 ENDIF 10420000 C 10430000 DO 890 I = 1, LENVAR 10440000 890 PARBUF(I) = LOCVAR(I) 10450000 C 10460000 RETURN 10470000 C 10480000 C 10490000 C 10500000 C************************************************************** 10510000 C UNALLOCATE SCRATCH DISKS 10520000 C************************************************************** 10530000 C 10540000 ENTRY FPUWRK (PARBUF, ERR, ERIN) 10550000 C 10560000 C INITIALIZATION 10570000 C 10580000 ERR = 0 10590000 ERIN = 0 10600000 C 10610000 DO 900 I = 1, LENVAR 10620000 900 LOCVAR(I) = PARBUF(I) 10630000 C 10640000 IF (NPARAL .LT. 0) THEN 10650000 CALL UGUWRK (PAWCNT, PARCNT, ERR, ERIN) 10660000 ELSE 10670000 C 10680000 C UNALLOCATE THE FILE 10690000 C 10700000 CALL APOCLOS (PUNIT, 'DELETE ', ERR) 10710000 IF (ERR .NE. 0) THEN 10720000 WRITE (IPR,9220) ERR 10730000 RETURN 10740000 ELSE 10750000 ERR = 1 10760000 ENDIF 10770000 C 10780000 C FREE THE MEMORY 10790000 C 10800000 CALL FREMN2 (COM(PAINDS), LENSTR) 10810000 ENDIF 10820000 C 10830000 DO 990 I = 1, LENVAR 10840000 990 PARBUF(I) = LOCVAR(I) 10850000 C 10860000 2000 RETURN 10870000 C 10880000 C 10890000 C 10900000 C************************************************************** 10910000 C ERROR MESSAGES 10920000 C************************************************************** 10930000 C 10940000 C NPARAL <= 0 10950000 1010 ERR = 2 10960000 ERIN = NPARAL 10970000 GO TO 2000 10980000 C 10990000 C 11000000 C 11010000 C************************************************************** 11020000 C FORMATS 11030000 C************************************************************** 11040000 C 11050000 9100 FORMAT (5X,'APOFILD ERROR,LREC,NREC = ',3Z10) 11060000 C 11070000 9110 FORMAT (5X,'APOOPEN ERROR ',Z10) 11080000 C 11090000 9120 FORMAT (5X,'APOWRTL(1) ERROR ',Z10) 11100000 C 11110000 9130 FORMAT (5X,'APOWAIT(1) ERROR ',Z10) 11120000 C 11130000 9140 FORMAT (5X,'APOWRTL(2) ERROR ',Z10) 11140000 C 11150000 9150 FORMAT (5X,'APOWAIT(2) ERROR ',Z10) 11160000 C 11170000 9160 FORMAT (5X,'APOWRTL(3) ERROR ',Z10) 11180000 C 11190000 9170 FORMAT (5X,'APOWAIT(3) ERROR ',Z10) 11200000 C 11210000 9180 FORMAT (5X,'APORDL ERROR ',Z10) 11220000 C 11230000 9190 FORMAT (5X,'APOWAIT(4) ERROR ',Z10) 11240000 C 11250000 9195 FORMAT (5X,'APOWAIT(5) ERROR ',Z10) 11260000 C 11270000 9200 FORMAT (5X,'APOWRTL(5) ERROR ',Z10) 11280000 C 11290000 9210 FORMAT (5X,'APOWAIT(6) ERROR ',Z10) 11300000 C 11310000 9220 FORMAT (5X,'APOCLOS ERROR ',Z10) 11320000 C 11330000 9240 FORMAT (5X,3X,A4,I1,6X,A8,6X,'PARALLEL',2X,I9,5X,I7,F14.0) 11340000 C 11350000 END 11360000