fm500.for
来自「开放源码的编译器open watcom 1.6.0版的源代码」· FOR 代码 · 共 803 行 · 第 1/5 页
FOR
803 行
PROGRAM FM500
C***********************************************************************00010500
C***** FORTRAN 77 00020500
C***** FM500 00030500
C***** BLKD1 - (260) 00040500
C***** THIS PROGRAM USES SN501 AND AN502 00050500
C***********************************************************************00060500
C***** TESTING OF BLOCK DATA SUBPROGRAMS FEATURES ANS REF 00070500
C***** IMPLICIT, PARAMETER, EXTERNAL, AND SAVE 16 00080500
C***** THIS SEGMENT USES BLOCK DATA PROGRAM 00090500
C***** AN502 AND SUBROUTINE SN501 00100500
C***** 00110500
C***** S P E C I F I C A T I O N S SEGMENT 260 00120500
EXTERNAL AN502 00130500
C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00140500
C***** PARAMETER (KPI = 2, LPI = 10) 00150500
C***** INTEGER FXVI 00160500
C***** REAL JX1S 00170500
C***** DOUBLE PRECISION AX1D, BX4D 00180500
C***** DIMENSION BX4D(KPI, KPI, KPI, KPI) 00190500
C***** COMPLEX AXVC, BX1C, CZ5C 00200500
C***** LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00210500
C***** CHARACTER*1 A1XVK, B1X1K, C1X7K 00220500
C***** CHARACTER*2 D2Z1K 00230500
C***** CHARACTER*4 E4XVK, G4X2K 00240500
C***** CHARACTER*(LPI) I10XVK 00250500
C***** 00260500
C***** COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00270500
C***** COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00280500
C***** COMMON /BLK3/ RXVD, AX1D(2), BX4D 00290500
C***** COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00300500
C***** COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00310500
C***** COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00320500
C***** S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00330500
C***** 00340500
CALL SN501 00350500
STOP 00360500
C***** END OF TEST SEGMENT 260 00370500
END 00380500
C***********************************************************************00010501
C***** FORTRAN 77 00020501
C***** FM501 SN501 - (251) 00030501
C***** THIS SUBROUTINE IS CALLED BY PROGRAM FM500 00040501
C***********************************************************************00050501
C***** 00060501
C***** GENERAL PURPOSE 00070501
C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 250 00080501
C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF 00090501
C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY 00100501
C***** VARIABLES 00110501
C***** 00120501
CBB** ********************** BBCCOMNT **********************************00130501
C**** 00140501
C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150501
C**** VERSION 2.1 00160501
C**** 00170501
C**** 00180501
C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190501
C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200501
C**** SOFTWARE STANDARDS VALIDATION GROUP 00210501
C**** BUILDING 225 RM A266 00220501
C**** GAITHERSBURG, MD 20899 00230501
C**** 00240501
C**** 00250501
C**** 00260501
CBE** ********************** BBCCOMNT **********************************00270501
SUBROUTINE SN501 00280501
C***** 00290501
IMPLICIT INTEGER (H) 00300501
IMPLICIT DOUBLE PRECISION (R) 00310501
IMPLICIT CHARACTER*2 (S) 00320501
C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00330501
PARAMETER (KPI = 2, LPI = 10) 00340501
INTEGER FXVI 00350501
REAL JX1S 00360501
DOUBLE PRECISION AX1D, BX4D, DVCORR 00370501
DIMENSION BX4D(KPI, KPI, KPI, KPI) 00380501
COMPLEX AXVC, BX1C, CZ5C 00390501
LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00400501
CHARACTER*1 A1XVK, B1X1K, C1X7K, CVNC01 00410501
CHARACTER*2 D2Z1K, CVNC02 00420501
CHARACTER*4 E4XVK, G4X2K, CVNC04 00430501
CHARACTER*(LPI) I10XVK, CVNC10 00440501
C***** 00450501
COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00460501
COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00470501
COMMON /BLK3/ RXVD, AX1D(2), BX4D 00480501
COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00490501
COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00500501
COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00510501
1 S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00520501
C***** 00530501
SAVE/BLK6/ 00540501
C***** 00550501
EQUIVALENCE (NYVI, EZVS) 00560501
C***** LOCAL DECLARATIONS 00570501
DOUBLE PRECISION AVD 00580501
COMPLEX AVC 00590501
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. 00600501
CBB** ********************** BBCINITA **********************************00610501
C**** SPECIFICATION STATEMENTS 00620501
C**** 00630501
CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00640501
1 ZNAME*20, ZTAPE*10, ZPROJ*13, ZTAPED*13!, REMRKS*31 00650501
CBE** ********************** BBCINITA **********************************00660501
CBB** ********************** BBCINITB **********************************00670501
C**** INITIALIZE SECTION 00680501
DATA ZVERS, ZVERSD, ZDATE 00690501
1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00700501
DATA ZCOMPL, ZNAME, ZTAPE 00710501
1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00720501
DATA ZPROJ, ZTAPED, ZPROG 00730501
1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00740501
C DATA REMRKS /' '/ 00750501
C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00760501
C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00770501
C**** 00780501
CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00790501
CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00800501
CZ03 ZPROG = 'PROGRAM NAME' 00810501
CZ04 ZDATE = 'DATE OF TEST' 00820501
CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00830501
CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00840501
CZ07 ZNAME = 'NAME OF USER' 00850501
CZ08 ZTAPE = 'TAPE OWNER/ID' 00860501
CZ09 ZTAPED = 'DATE TAPE COPIED' 00870501
C 00880501
IVPASS = 0 00890501
IVFAIL = 0 00900501
IVDELE = 0 00910501
IVINSP = 0 00920501
IVTOTL = 0 00930501
IVTOTN = 0 00940501
ICZERO = 0 00950501
C 00960501
C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00970501
I01 = 05 00980501
C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00990501
I02 = 06 01000501
C 01010501
CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01020501
C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01030501
CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01040501
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01050501
C 01060501
CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01070501
C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01080501
CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01090501
C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01100501
C 01110501
CBE** ********************** BBCINITB **********************************01120501
NWVI = I02 01130501
IVTOTL = 37 01140501
ZPROG='FM500' 01150501
CBB** ********************** BBCHED0A **********************************01160501
C**** 01170501
C**** WRITE REPORT TITLE 01180501
C**** 01190501
WRITE (I02, 90002) 01200501
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?