fm500.for
来自「开放源码的编译器open watcom 1.6.0版的源代码」· FOR 代码 · 共 803 行 · 第 1/5 页
FOR
803 行
WRITE (I02, 90006) 01210501
WRITE (I02, 90007) 01220501
WRITE (I02, 90008) ZVERS, ZVERSD 01230501
WRITE (I02, 90009) ZPROG, ZPROG 01240501
WRITE (I02, 90010) ZDATE, ZCOMPL 01250501
CBE** ********************** BBCHED0A **********************************01260501
C***** 01270501
WRITE(NWVI,26000) 01280501
26000 FORMAT( / 40H BLKD1 - (260) BLOCK DATA SUBPROGRAMS --/ 01290501
1 37H IMPLICIT, PARAMETER, EXTERNAL, SAVE// 01300501
2 15H ANS REF. - 16) 01310501
C***** 01320501
CBB** ********************** BBCHED0B **********************************01330501
C**** WRITE DETAIL REPORT HEADERS 01340501
C**** 01350501
WRITE (I02,90004) 01360501
WRITE (I02,90004) 01370501
WRITE (I02,90013) 01380501
WRITE (I02,90014) 01390501
WRITE (I02,90015) IVTOTL 01400501
CBE** ********************** BBCHED0B **********************************01410501
C**** TO DELETE A TEST USED CODE SHOWN IN TEST 1 01420501
C**** REPLACE THE DELETE COMMENT WITH DELETE CODE 01430501
CT001* TEST 1 INTEGER VARIABLE 01440501
IVTNUM=1 01450501
WRITE (NWVI,70140) 01460501
IVCORR=5 01470501
40010 IF (IXVI - 5) 20010,10010,20010 01480501
10010 IVPASS=IVPASS+1 01490501
WRITE (NWVI,80002) IVTNUM 01500501
GO TO 0011 01510501
20010 IVFAIL=IVFAIL+1 01520501
WRITE (NWVI,80008) IVTNUM 01530501
WRITE (NWVI,80024) IXVI 01540501
WRITE (NWVI,80026) IVCORR 01550501
0011 CONTINUE 01560501
CT002* TEST 2 INTEGER DECLARE VARIABLE 01570501
IVTNUM = 2 01580501
IVCORR=6 01590501
IF (FXVI - 6) 20020,10020,20020 01600501
10020 IVPASS=IVPASS+1 01610501
WRITE (NWVI,80002) IVTNUM 01620501
GO TO 0021 01630501
20020 IVFAIL=IVFAIL+1 01640501
WRITE (NWVI,80008) IVTNUM 01650501
WRITE (NWVI,80024) FXVI 01660501
WRITE (NWVI,80026) IVCORR 01670501
0021 CONTINUE 01680501
CT003* TEST 3 INTEGER ARRAY 01690501
IVTNUM = 3 01700501
IVCORR=8 01710501
IF (KX1I(2) - 8) 20030,10030,20030 01720501
10030 IVPASS=IVPASS+1 01730501
WRITE (NWVI,80002) IVTNUM 01740501
GO TO 0031 01750501
20030 IVFAIL=IVFAIL+1 01760501
WRITE (NWVI,80008) IVTNUM 01770501
WRITE (NWVI,80024) KX1I(2) 01780501
WRITE (NWVI,80026) IVCORR 01790501
0031 CONTINUE 01800501
CT004* TEST 4 IMPLICIT INTEGER ARRAY 01810501
IVTNUM = 4 01820501
IVCORR=1 01830501
IF (HX2I(1,2) - 1) 20040,10040,20040 01840501
10040 IVPASS=IVPASS+1 01850501
WRITE (NWVI,80002) IVTNUM 01860501
GO TO 0041 01870501
20040 IVFAIL=IVFAIL+1 01880501
WRITE (NWVI,80008) IVTNUM 01890501
WRITE (NWVI,80024) HX2I(1,2) 01900501
WRITE (NWVI,80026) IVCORR 01910501
0041 CONTINUE 01920501
CT005* TEST 5 01930501
IVTNUM = 5 01940501
IVCORR=5 01950501
IF (HX2I(2,2) - 5) 20050,10050,20050 01960501
10050 IVPASS=IVPASS+1 01970501
WRITE (NWVI,80002) IVTNUM 01980501
GO TO 0051 01990501
20050 IVFAIL=IVFAIL+1 02000501
WRITE (NWVI,80008) IVTNUM 02010501
WRITE (NWVI,80024) HX2I(2,2) 02020501
WRITE (NWVI,80026) IVCORR 02030501
0051 CONTINUE 02040501
CT006* TEST 6 DO INITIALIZE INTEGER ARRAY 02050501
IVTNUM = 6 02060501
IVINSP=IVINSP+1 02070501
WRITE (NWVI,80004) IVTNUM 02080501
DO 70101 KVI = 1, 2 02090501
IVI = MX2I(KVI, KVI) - 4 02100501
WRITE (NWVI, 70100) IVI 02110501
70101 CONTINUE 02120501
CT007* TEST 7 REAL VARIABLE 02130501
IVTNUM = 7 02140501
RVCORR=5.3 02150501
RVCOMP=0.0 02160501
RVCOMP=AXVS - 5.3 02170501
IF (RVCOMP + .00005) 20070,10070,40070 02180501
40070 IF (RVCOMP - .00005) 10070,10070,20070 02190501
10070 IVPASS=IVPASS+1 02200501
WRITE (NWVI,80002) IVTNUM 02210501
GO TO 0071 02220501
20070 IVFAIL=IVFAIL+1 02230501
WRITE (NWVI,80008) IVTNUM 02240501
WRITE (NWVI,80028) AXVS 02250501
WRITE (NWVI,80030) RVCORR 02260501
0071 CONTINUE 02270501
CT008* TEST 8 EXTENDED PRECISION REAL 02280501
IVTNUM = 8 02290501
AVS = BXVS - 1.23456789012345 02300501
RVCOMP=1.23456789012345 02310501
IF (AVS + .00005) 20080,10080,40080 02320501
40080 IF (AVS - .00005) 10080,10080,20080 02330501
10080 IVPASS=IVPASS+1 02340501
WRITE (NWVI,80002) IVTNUM 02350501
GO TO 0081 02360501
20080 IVFAIL=IVFAIL+1 02370501
WRITE (NWVI,80004) IVTNUM 02380501
70080 FORMAT (1H ,16X,10HCOMPUTED: ,E20.14) 02390501
WRITE (NWVI,70080) BXVS 02400501
70081 FORMAT (1H ,16X,10HCORRECT: ,E20.14) 02410501
WRITE (NWVI, 70081) RVCOMP 02420501
0081 CONTINUE 02430501
CT009* TEST 9 DECLARED REAL ARRAY 02440501
IVTNUM = 9 02450501
RVCORR=2.45 02460501
RVCOMP=2.0 02470501
RVCOMP=(JX1S(1) - 2.45) 02480501
IF (RVCOMP + .00005) 20090,10090,40090 02490501
40090 IF (RVCOMP - .00005) 10090,10090,20090 02500501
10090 IVPASS=IVPASS+1 02510501
WRITE (NWVI,80002) IVTNUM 02520501
GO TO 0091 02530501
20090 IVFAIL=IVFAIL+1 02540501
WRITE (NWVI,80008) IVTNUM 02550501
WRITE (NWVI,80028) JX1S(1) 02560501
WRITE (NWVI,80030) RVCORR 02570501
0091 CONTINUE 02580501
CT010* TEST 10 02590501
IVTNUM = 10 02600501
RVCORR=4.58 02610501
RVCOMP=2.0 02620501
RVCOMP=(JX1S(2) - 4.58) 02630501
40100 IF (RVCOMP + .00005) 20100,10100,40101 02640501
40101 IF (RVCOMP - .00005) 10100,10100,20100 02650501
10100 IVPASS=IVPASS+1 02660501
WRITE (NWVI,80002) 02670501
GO TO 0100 02680501
20100 IVFAIL=IVFAIL+1 02690501
WRITE (NWVI,80008) IVTNUM 02700501
WRITE (NWVI,80028) JX1S(2) 02710501
WRITE (NWVI,80030) RVCORR 02720501
0100 CONTINUE 02730501
CT011* TEST 11 REAL ARRAY - NAME ONLY 02740501
IVTNUM = 11 02750501
IVINSP=IVINSP+1 02760501
WRITE (NWVI,80004) IVTNUM 02770501
DO 70103 KVI = 1, 2 02780501
AVS = CX2S(KVI, KVI) - 1.2 02790501
WRITE (NWVI, 70102) AVS 02800501
70103 CONTINUE 02810501
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?