CTITLECSAPUN -- ASSIGN ARRAY PROCESSOR UNIT NUMBER 00000100 C*********************************************************************** C COPYRIGHT ATLANTIC RICHFIELD COMPANY 1991 * C*********************************************************************** CA AUTHOR MCMILLAN, MENDEKE 00000200 CA DESIGNER MCMILLAN, MENDEKE 00000300 CA LANGUAGE S/370 FORTRAN H 00000400 CA SYSTEM IBM (SEE CRAY) 00000400 CA WRITTEN 04-18-78 00000500 C REVISED 05-05-78 MENDEKE ADDED 'CLSE AND 'FREE' 00000600 C REVISED 05-19-78 MENDEKE- PORT SIZE NOW 168 AND 512. 00000700 C REVISED 09-08-78 PKC. USE APREG1 TO APREG7 TO GET REGION SIZE. 00000800 C REVISED 05-22-81 FAC. WRITE RECORD CONTAINING REGION SIZE, 00000900 C ETC., IF SPARCAPR DD-CARD IS PRESENT. 00001000 C REVISED 08-10-81 DJP. CHANGED VALUE FOR 'STRN' FROM 255 TO 100. 00001100 C REVISED 03-14-83 REM. CHANGE USE OF ACNSP TO LCANSP. 00001200 CA 00001300 CA 00001400 CA CALL CSAPUN (SIZE, UNIT) 00001500 CA INPUT SIZE = REGION SIZE NEEDED IN NUMBER OF WORDS I4 00001600 CA OUTPUT UNIT = ASSIGNED UNIT NUMBER I4 00001700 CA 00001800 CA 00001900 CA THIS ROUTINE CHECKS THE REQUESTED SIZE AGAINST THE PARTITION 00002000 CA SIZES IN THE AP3838 AND RETURNS A FORTRAN UNIT NUMBER FOR THE 00002100 CA CORRECT PARTITION. A CALL IS MADE TO VPSS TO OPEN THE UNIT IF 00002200 CA IT IS NOT OPEN. A ZERO UNIT NUMBER IS RETURNED IF AN ERROR 00002300 CA OCCURS. 00002400 CA 00002500 CA THE FOLLOWING RECORD IS WRITTEN TO DDNAME SPARCAPR IF THE DDCARD 00002600 CA IS PRESENT. PRESENCE OF THE DDCARD IS CHECKED IN THE WRITE SUB- 00002700 CA ROUTINE FOAPR. 00002800 CA 00002900 CA WORD FORMAT NAME DESCRIPTION 00003000 CA 00003100 CA 1-2 A8 MCJOB JOB NAME 00003200 CA 3-4 A8 REC8(2) DATE IN FORM MO/DA/YR 00003300 CA 5-6 A8 REC8(3) TIME IN FORM HR/MI/SC 00003400 CA 7 A1 REC4(7) JOB CLASS IN FORM 'X ' 00003500 CA 8 I4 LCRL RECORD LENGTH (LINE CARD), MS 00003600 CA 9 I4 LCPI PROCESSING SAMPLE INTERVAL (LINE CARD), MS 00003700 CA 10 I4 LCANSP NUMBER OF EQUIVALENT SHOTPOINTS (LINE CARD) 00003800 CA 11 A4 KPNA PROCESS NAME 00003900 CA 12 I4 KBYTES REQUESTED REGION SIZE, KILOBYTES 00004000 CA 13 I4 UNIT ARRAY PROCESSER UNIT NUMBER ASSIGNED. 00004100 CA 14 ) 00004200 CA ... ) BLANKS 00004300 CA 20 ) 00004400 CA 00004500 CA 00004600 C EJECT 00004700 SUBROUTINE CSAPUN (SIZE, UNIT) 00004800 C 00004900 IMPLICIT INTEGER (A-Z) 00005000 EXTERNAL UPAPER, UPHOST 00005100 C 00005200 C COMMON /P/ STATEMENTS GENERATED BY UTCGI4 11/23/83 00005300 COMMON /P/ STARTP , M00000( 11) 00005310 REAL *8 STARTP 00005320 COMMON /P/ LCRL , M00052 00005330 COMMON /P/ LCPI , M00060( 2) 00005340 COMMON /P/ LCANSP , M00072( 85) 00005350 COMMON /P/ KPNA 00005360 COMMON /P/ KPRNO , M00420( 54) 00005370 COMMON /P/ MCJOB ( 2) , M00640( 144) 00005380 COMMON /P/ APUNN1 00005390 COMMON /P/ APUNN2 00005400 COMMON /P/ APUNN3 00005410 COMMON /P/ APUNN4 00005420 COMMON /P/ APUNN5 00005430 COMMON /P/ APUNN6 00005440 COMMON /P/ APUNN7 00005450 COMMON /P/ APREG1 00005460 COMMON /P/ APREG2 00005470 COMMON /P/ APREG3 00005480 COMMON /P/ APREG4 00005490 COMMON /P/ APREG5 00005500 COMMON /P/ APREG6 00005510 COMMON /P/ APREG7 , M01276( 42) 00005520 COMMON /P/ ENDP 00005530 C 00005540 C 00005550 C ARRAYS -- LOCAL 00005560 C 00005570 INTEGER CARD (20) 00005580 INTEGER MSGARR (32) 00005590 INTEGER OPENFG ( 7) / 7*0 / 00005600 INTEGER REC4 (20) 00005610 REAL *8 REC8 (10) / 10*' ' / 00005620 INTEGER REGSIZ ( 7) 00005630 INTEGER UNITNO ( 7) 00005640 EQUIVALENCE (REC4 ( 1), REC8 ( 1)) 00005650 C 00005660 C 00005670 UNIT = 0 00005680 REGSIZ(1) = APREG1 00005690 REGSIZ(2) = APREG2 00005700 REGSIZ(3) = APREG3 00005710 REGSIZ(4) = APREG4 00005720 REGSIZ(5) = APREG5 00005730 REGSIZ(6) = APREG6 00005740 REGSIZ(7) = APREG7 00005750 UNITNO(1) = APUNN1 00005760 UNITNO(2) = APUNN2 00005770 UNITNO(3) = APUNN3 00005780 UNITNO(4) = APUNN4 00005790 UNITNO(5) = APUNN5 00005800 UNITNO(6) = APUNN6 00005810 UNITNO(7) = APUNN7 00005820 C 00005830 KBYTES = (4*SIZE + 1023) / 1024 00005840 C 00005850 DO 10 00005860 * I = 1, 7 00005870 IF (KBYTES .GT. REGSIZ(I)) GO TO 10 00005880 UNIT = UNITNO(I) 00005890 IF (OPENFG(I) .EQ. 1) GO TO 20 00005900 C ******************************************************* 00005910 C ***** ***** 00005920 C ***** OPEN ARRAY PROCESSOR 3838 ***** 00005930 C ***** ***** 00005940 C ******************************************************* 00005950 CALL VPSS (UNIT, 'GENO', IERROR, 'REG ', REGSIZ(I), 00005960 * 'OWN ', 'SHR ', 'STRN', 100, 'RCDE', 00005970 * IER, 'EMSG', MSGARR, 'LERR', UPHOST, 00005980 * 'PERR', UPAPER, 'INTV', 1855) 00005990 C 00006000 OPENFG(I) = 1 00006010 IF (IERROR .EQ. 0) GO TO 20 00006020 OPENFG(I) = 0 00006030 CALL VPSS (UNIT, 'CLSE', IERROR) 00006040 CALL VPSS (UNIT, 'FREE', IERROR) 00006050 WRITE (6, 9000) KPNA, KPRNO, UNIT, REGSIZ(I) 00006060 UNIT = 0 00006070 GO TO 20 00006080 10 CONTINUE 00006090 C 00006100 WRITE (6, 9100) KPNA, KPRNO, KBYTES 00006110 C 00006120 C BUILD RECORD WITH REGION SIZE, ETC., FOR ANALYSIS. 00006130 20 REC4 ( 1) = MCJOB (1) 00006140 REC4 ( 2) = MCJOB (2) 00006150 CALL DATIME (REC8(2), REC8(3), CSTIME) 00006160 DA = 1 00006170 CALL FORC ('ACCT', 0, DA, CARD, &30) 00006180 CALL S1MVCH (CARD, 71, REC4(7), 1, 1) 00006190 REC4 ( 8) = LCRL 00006200 REC4 ( 9) = LCPI 00006210 REC4 (10) = LCANSP 00006220 REC4 (11) = KPNA 00006230 REC4 (12) = KBYTES 00006240 REC4 (13) = UNIT 00006250 CALL FOAPR (REC4) 00006260 30 RETURN 00006270 C 00006280 9000 FORMAT (' 3838 GENO ERROR ',A4,I1,' UNIT = ',I5, ' REG = ',I5) 00006290 C 00006300 9100 FORMAT (' 3838 REGION REQUEST ERROR ',A4,I1,' REG = ',I5) 00006310 END 00006320