📄 ppp.for
字号:
DATA ITWO/1/ 00003260
***END:DPR*** 00003270
***ADD:DPR*** 00003280
DATA ITWO/2/ 00003290
***END:DPR*** 00003300
DATA LSTDB,IOPEN,ISURL,LDBC,LGP,LDBCTR,LDBCTI 00003310
1 / 0, 0, 1, 131, 50, 2, 49/ 00003320
DATA NCMD,NLASTP,INPOS,ITYPEI 00003330
1/ -9999, 0, 9999, 5/ 00003340
DATA MXSTRL,NPOSIN 00003350
1/ 128, 2/ 00003360
DATA MEMMAX,IONPLT,GSCALE,DSCALE,XPV,YPV 00003370
1/ 0, 0, 1., 1., 0., 0./ 00003380
DATA ICODE/0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, 00003390
1 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38, 00003400
2 39,40,41,42,43,44,45,46/ 00003410
DATA IGPNA /1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20, 00003420
1 21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38, 00003430
2 39,40,41,42,43,44,45,46,47,48,49,50/ 00003440
DATA INTEG,IREAL,IANUM,ISTRIN,IOMIT/1,2,3,7,4/ 00003450
DATA IWHOLE/0/ 00003460
END 00003470
***ADD:CDC*** 00003480
DECK ALIGN 00003490
***END:CDC*** 00003500
SUBROUTINE ALIGN(I) 00003510
ALIGN START OF INTEGER ARRAY TO REAL WORD BOUNDARY 00003520
ON COMPUTERS WHERE REAL WORD LENGTH IS A MULTIPLE OF 00003530
INTEGER WORD LENGTH 00003540
00003550
COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE 00003560
00003570
IALIGN = ISURL * ITWO 00003580
IF (IALIGN.EQ.1) GOTO 900 00003590
I = ((I - 1) / IALIGN + 1) * IALIGN 00003600
900 RETURN 00003610
END 00003620
***ADD:CDC*** 00003630
DECK SIZE 00003640
***END:CDC*** 00003650
00003660
SUBROUTINE SIZE(N) 00003670
00003680
DIMENSION IA(1) 00003690
BLANK COMMON SIZE LIMIT CHECK IF MTOT > 0 AT PROGRAM START 00003700
DYNAMIC MEMORY REQUEST IF MTOT = 0 00003710
N = SIZE REQUIRED BY CALLING PROGRAM 00003720
IERROR= RETURN CODE = 1 IF MEMORY IS NOT AVAILIBLE 00003730
CDY = CDC DYNAMIC BLANK COMMON SIZE 00003740
UDY = UNIVAC DYNAMIC BLANK COMMON SIZE 00003750
00003760
COMMON /MEMORY/ MTOT,LPROG,MEMPRT,MEMMAX,MEMNOW 00003770
COMMON /ERROR/ IERROR 00003780
COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM 00003790
COMMON A(1) 00003800
EQUIVALENCE (A(1),IA(1)) 00003810
00003820
CHECK THAT START AND CURRENT END OF BLANK COMMON IS NOT 00003830
ACCIDENTALLY CHANGED 00003840
00003850
IF (IA(1).EQ.-87878) GOTO 2 00003860
WRITE (NFLOG,2030) 00003870
GOTO 800 00003880
2 IF (IA(MEMNOW).NE.-87878) WRITE (NFLOG,2040) 00003890
00003900
IF (N.GT.0) GOTO 5 00003910
WRITE (NFLOG,2020) 00003920
GOTO 800 00003930
5 CALL ALIGN(N) 00003940
MEMNOW = N + 10 00003950
***ADD:CDY*** 00003960
* CDC DYNAMIC INCREASE OF BLANK COMMON 00003970
* THE USER MUST VERIFY THIS CODING FOR HIS SYSTEM 00003980
IF (MTOT.NE.0) GOTO 10 00003990
LPROG = LOCF(A) 00004000
10 LCORE = LPROG + MEMNOW 00004010
MTOT = MEMNOW 00004020
CALL XRFL(LCORE) 00004030
***END:CDY*** 00004040
***ADD:UDY*** 00004050
* UNIVAC DYNAMIC INCREASE OF BLANK COMMON 00004060
* THE USER MUST VERIFY THIS CODING FOR HIS SYSTEM 00004070
LRPOG= LOC(A) 00004080
LCORE = LPROG + MEMNOW 00004090
IF (MEMNOW.LT.MTOT) GOTO 80 00004100
MTOT = MEMNOW 00004110
CALL XRFL(LCORE) 00004120
***END:UDY*** 00004130
***DEL:CDY,UDY*** 00004140
* FIX LENGTH OF BLANK COMMON 00004150
IF (MEMNOW.LT.MTOT) GOTO 80 00004160
WRITE (NFLOG,2010) MEMNOW, MTOT 00004170
GOTO 800 00004180
***END:CDY,UDY*** 00004190
80 CONTINUE 00004200
IF (MEMPRT.EQ.2) WRITE (NFLOG,2000) MEMNOW 00004210
IF (MEMNOW.GT.MEMMAX) MEMMAX = MEMNOW 00004220
IA(MEMNOW) = -87878 00004230
900 RETURN 00004240
800 IERROR = 1 00004250
GOTO 900 00004260
2000 FORMAT (27H ***MEMORY SIZE REQUESTED =,I6,12H IS OBTAINED) 00004270
2010 FORMAT (47H ***ERROR: BLANK COMMON MEMORY SIZE REQUESTED =, 00004280
1I6,26H IS NOT AVAILIBLE, MTOT = ,I6) 00004290
2020 FORMAT (32H ***ERROR: ZERO MEMORY REQUESTED) 00004300
2030 FORMAT (47H ***ERROR: BLANK COMMON LOCATION 1 IS DESTROYED) 00004310
2040 FORMAT (49H ***ERROR: BLANK COMMON END OF LAST USED AREA IS , 00004320
1 9HDESTROYED) 00004330
END 00004340
***ADD:CDC*** 00004350
DECK APCHAR 00004360
***END:CDC*** 00004370
SUBROUTINE APCHAR(ICODE) 00004380
00004390
DIMENSION ICHAR(47) 00004400
00004410
DATA ICHAR /1H0,1H1,1H2,1H3,1H4,1H5,1H6,1H7,1H8,1H9, 00004420
1 1H ,1HA,1HB,1HC,1HD,1HE,1HF,1HG,1HH,1HI, 00004430
2 1HJ,1HK,1HL,1HM,1HN,1HO,1HP,1HQ,1HR,1HS, 00004440
3 1HT,1HU,1HV,1HW,1HX,1HY,1HZ,1H.,1H,,1H+, 00004450
4 1H-,1H=,1H(,1H),1H/,1H*,1H'/ 00004460
00004470
ICODE = ICHAR(ICODE+1) 00004480
RETURN 00004490
END 00004500
***ADD:CDC*** 00004510
DECK DBWRIT 00004520
***END:CDC*** 00004530
SUBROUTINE DBWRIT (AA,LREAL,LINT,IGP,ISGP,ITIME) 00004540
00004550
DIMENSION IA(1),AA(1) 00004560
COMMON /ERROR/ IERROR 00004570
COMMON /CNTRL/ IBATCH,NBSU,LSTC,LSTF,LSTDB,ISURL,ITWO,LINPAG,LINE 00004580
COMMON /FILES/ NFREAD,NFECHO,NFLOG,NFLIST,LUNODE,LUELEM 00004590
COMMON /DB/ IOPEN,NFDB,INDXST,IXTNOW,LGP,NWRITS,NREADS, 00004600
1 LDBC,LDBCTR,LDBCTI,IPHCHK,INSTRI,INRUSE,INSTRU, 00004610
2 MSUBF,MVIEW,MAXIS,MLINEN,MLINEE,MVAR,MRES,LSKEW,MIDSPL00004620
COMMON /DBC/ IHED(18),NDAREC,LDAREC,NRECS,NWORDS,NEXREC,NEXTIX, 00004630
1 LIX,LIXT,NSTRI,NSTRUC,NEGIT,NEGAT,NFREQ, 00004640
2 IXGP(50),MXSGP(50), 00004650
3 FILL1 00004660
COMMON /DIM/ I01,I02,I03,I04,I05,I06,I07,I08,I09,I010,I011, 00004670
1 I1,I2,I3,I4,I5,I6,I7,I8,I9,I10,I11,I12,I13,I14,I15, 00004680
2 I16,I17,I18,I19,I20, 00004690
3 N1,N2,N3,N4,N5,N6,N7,N8,N9,N10,N11,N12,N13,N14,N15, 00004700
4 N16,N17,N18,N19,N20 00004710
COMMON A(1) 00004720
EQUIVALENCE (A(1),IA(1)) 00004730
00004740
IF (IOPEN.EQ.1) GOTO 100 00004750
WRITE (NFLOG,2000) 00004760
GOTO 800 00004770
100 CONTINUE 00004780
00004790
CHECK INDEX KEYS IGP, ISGP, ITIME 00004800
00004810
IF (IGP.LT.3.OR.IGP.GT.LGP) GOTO 150 00004820
IF (ISGP.LT.1.OR.ISGP.GT.MXSGP (IGP)) GOTO 150 00004830
IF (ITIME.LT.0.OR.ITIME.GE.LIXT) GOTO 150 00004840
GOTO 200 00004850
150 WRITE (NFLOG,2005) 00004860
GOTO 800 00004870
200 CONTINUE 00004880
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -