| PROGRAM FM311 00010311 |
| C 00020311 |
| C 00030311 |
| C THIS ROUTINE TESTS THE USE OF THE FORTRAN IN-LINE STATEMENT 00040311 |
| C FUNCTION OF TYPES INTEGER, REAL AND LOGICAL. SPECIFIC FEATURES 00050311 |
| C TESTED INCLUDE, 00060311 |
| C 00070311 |
| C A) REAL STATEMENT FUNCTIONS USING REAL CONSTANTS AND VARIABLES 00080311 |
| C IN THE EXPRESSION AND AS ACTUAL ARGUMENTS. 00090311 |
| C 00100311 |
| C B) STATEMENT FUNCTIONS WHICH REQUIRE CONVERSION OF THE 00110311 |
| C EXPRESSION TO REAL AND INTEGER TYPING. 00120311 |
| C 00130311 |
| C C) THE USE OF VARIABLES, ARRAY ELEMENTS, EXTERNAL REFERENCES, 00140311 |
| C AND INITIALLY DEFINED ENITIIES IN THE EXPRESSION. 00150311 |
| C 00160311 |
| C D) VARIOUS DEFINITIONS AND USES OF DUMMY ARGUMENTS. 00170311 |
| C 00180311 |
| C E) ACTUAL ARGUMENTS CONSISTING OF EXPRESSIONS, INTRINSIC 00190311 |
| C FUNCTION REFERENCES, AND EXTERNAL FUNCTION REFERENCES. 00200311 |
| C 00210311 |
| C F) CONFIRMING AND OVERRIDING THE TYPING OF STATEMENT FUNCTIONS 00220311 |
| C AND DUMMY ARGUMENTS. 00230311 |
| C 00240311 |
| C G) USE OF STATEMENT FUNCTIONS AND DUMMY ARGUMENTS IN THE MAIN 00250311 |
| C PROGRAM AND IN EXTERNAL FUNCTION AND SUBROUTINE SUBPROGRAMS.00260311 |
| C 00270311 |
| C THE SUBSET LEVEL FEATURES OF STATEMENT FUNCTIONS ARE ALSO TESTED 00280311 |
| C IN ROUTINE FM020. 00290311 |
| C 00300311 |
| C REFERENCES. 00310311 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00320311 |
| C X3.9-1978 00330311 |
| C 00340311 |
| C SECTION 8.3, COMMON STATEMENT 00350311 |
| C SECTION 8.4, TYPE-STATEMENT 00360311 |
| C SECTION 8.5, IMPLICIT STATEMENT 00370311 |
| C SECTION 8.7, EXTERNAL STATEMENT 00380311 |
| C SECTION 8.8, INTRINSIC STATEMENT 00390311 |
| C SECTION 9, DATA STATEMENT 00400311 |
| C SECTION 15.3, INTRINSIC FUNCTIONS 00410311 |
| C SECTION 15.4, STATEMENT FUNCTION 00420311 |
| C SECTION 15.5, EXTERNAL FUNCTIONS 00430311 |
| C SECTION 15.6, SUBROUTINES 00440311 |
| C SECTION 15.9.1, DUMMY ARGUMENTS 00450311 |
| C SECTION 15.9.2, ACTUAL ARGUMENTS 00460311 |
| C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00470311 |
| C 00480311 |
| C 00490311 |
| C ******************************************************************00500311 |
| C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00510311 |
| C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00520311 |
| C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00530311 |
| C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00540311 |
| C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00550311 |
| C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00560311 |
| C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00570311 |
| C THE RESULT OF EXECUTING THESE TESTS. 00580311 |
| C 00590311 |
| C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00600311 |
| C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00610311 |
| C 00620311 |
| C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00630311 |
| C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00640311 |
| C SOFTWARE STANDARDS VALIDATION GROUP 00650311 |
| C BUILDING 225 RM A266 00660311 |
| C GAITHERSBURG, MD 20899 00670311 |
| C ******************************************************************00680311 |
| C 00690311 |
| C 00700311 |
| IMPLICIT LOGICAL (L) 00710311 |
| IMPLICIT CHARACTER*14 (C) 00720311 |
| C 00730311 |
| IMPLICIT INTEGER (A) 00740311 |
| IMPLICIT INTEGER (B) 00750311 |
| IMPLICIT REAL (K) 00760311 |
| IMPLICIT REAL (M) 00770311 |
| REAL NDON01 00780311 |
| INTEGER EDON01 00790311 |
| INTEGER FF312, FF314 00800311 |
| EXTERNAL FF312 00810311 |
| INTRINSIC NINT 00820311 |
| DIMENSION RADN11(4), RADN12(4), RADN13(4) 00830311 |
| DIMENSION IADN11(4), IADN12(4) 00840311 |
| DIMENSION LADN11(4) 00850311 |
| COMMON /IFOS19/IVCN01 00860311 |
| DATA IVOND1/6/ 00870311 |
| C TEST 001 00880311 |
| RFOS01(RDON01) = 3.5 00890311 |
| C TEST 002 00900311 |
| RFOS02(RDON02) = RDON02 00910311 |
| C TEST 003 00920311 |
| RFOS03(RDON03) = RDON03 + 1.0 00930311 |
| C TEST 004 00940311 |
| IFOS01(RDON04) = RDON04 + 1.0 00950311 |
| C TEST 005 00960311 |
| RFOS04(IDON01) = IDON01 + 1 00970311 |
| C TEST 006 00980311 |
| IFOS02(IDON02) = IDON02 + 1.95 00990311 |
| C TEST 007 01000311 |
| IFOS03(IDON03) = IDON03 + IVON01 01010311 |
| C TEST 008 01020311 |
| RFOS05(RDON05) = RDON05 + RVON02 01030311 |
| C TEST 009 01040311 |
| LFOS01(LDON01) = LDON01 .OR. LVON01 01050311 |
| C TEST 010 01060311 |
| IFOS04(IDON04) = IDON04 + IADN11(1) 01070311 |
| C TEST 011 01080311 |
| RFOS06(RDON06) = RDON06 + RADN12(3) 01090311 |
| C TEST 012 01100311 |
| LFOS02(LDON02) = .NOT. LDON02 .AND. LADN11(2) 01110311 |
| C TEST 013 01120311 |
| RFOS07(IDON05) = RADN13(IDON05) 01130311 |
| C TEST 014 01140311 |
| IFOS05(IDON06) = IDON06 + FF312(4) 01150311 |
| C TEST 015 01160311 |
| IFOS06(IDON07) = (IDON07 + 1) 01170311 |
| C TEST 016 01180311 |
| IFOS07(IDON08) = IDON08 + IVOND1 01190311 |
| C TEST 017 01200311 |
| IFOS08(IDON09) = IDON09 + 1 01210311 |
| IFOS09(IDON10) = IFOS08(IDON10) + 1 01220311 |
| C TEST 018 01230311 |
| IFOS10() = IVON02 01240311 |
| C TEST 019 01250311 |
| IFOS11(IDON11,IDON12,IDON13) = IDON11 + IDON12 + IDON13 01260311 |
| C TEST 020 01270311 |
| IFOS12(IDON14) = IDON14 + 1 01280311 |
| IFOS13(IDON14) = IDON14 + 2 01290311 |
| C TEST 021,022,023 01300311 |
| IFOS14(IDON15) = IDON15 + 1 01310311 |
| C TEST 024 01320311 |
| KFOS01(IDON16) = IDON16 + 1.0 01330311 |
| C TEST 025 01340311 |
| AFOS01(RDON07) = RDON07 + 1.0 01350311 |
| C TEST 026 01360311 |
| RFOS08(MDON01) = MDON01 / 5 01370311 |
| C TEST 027 01380311 |
| RFOS09(BDON01) = BDON01 / 5 01390311 |
| C TEST 028 01400311 |
| RFOS10(NDON01) = NDON01 / 5 01410311 |
| C TEST 029 01420311 |
| RFOS11(EDON01) = EDON01 / 5 01430311 |
| C TEST 030 01440311 |
| IFOS15(IVON04) = IVON04 + 1 01450311 |
| C TEST 031 01460311 |
| IFOS16(IDON17) = IDON17 + 1 01470311 |
| C TEST 032 01480311 |
| IFOS17(IDON18) = IDON18 + 1 01490311 |
| C TEST 037 01500311 |
| IFOS19(IDON21) = IDON21 + 1 01510311 |
| C 01520311 |
| C 01530311 |
| C 01540311 |
| C INITIALIZATION SECTION. 01550311 |
| C 01560311 |
| C INITIALIZE CONSTANTS 01570311 |
| C ******************** 01580311 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01590311 |
| I01 = 5 01600311 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01610311 |
| I02 = 6 01620311 |
| C SYSTEM ENVIRONMENT SECTION 01630311 |
| C 01640311 |
| CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01650311 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01660311 |
| C (UNIT NUMBER FOR CARD READER). 01670311 |
| CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01680311 |
| C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01690311 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01700311 |
| C 01710311 |
| CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01720311 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01730311 |
| C (UNIT NUMBER FOR PRINTER). 01740311 |
| CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01750311 |
| C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01760311 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01770311 |
| C 01780311 |
| IVPASS = 0 01790311 |
| IVFAIL = 0 01800311 |
| IVDELE = 0 01810311 |
| ICZERO = 0 01820311 |
| C 01830311 |
| C WRITE OUT PAGE HEADERS 01840311 |
| C 01850311 |
| WRITE (I02,90002) 01860311 |
| WRITE (I02,90006) 01870311 |
| WRITE (I02,90008) 01880311 |
| WRITE (I02,90004) 01890311 |
| WRITE (I02,90010) 01900311 |
| WRITE (I02,90004) 01910311 |
| WRITE (I02,90016) 01920311 |
| WRITE (I02,90001) 01930311 |
| WRITE (I02,90004) 01940311 |
| WRITE (I02,90012) 01950311 |
| WRITE (I02,90014) 01960311 |
| WRITE (I02,90004) 01970311 |
| C 01980311 |
| C 01990311 |
| C TEST 001 THROUGH TEST 003 TEST REAL STATEMENT FUNCTIONS WHERE THE 02000311 |
| C EXPRESSION CONSISTS OF REAL CONSTANTS AND VARIABLES AND THE ACTUAL02010311 |
| C ARGUMENTS ARE EITHER REAL CONSTANTS OR VARIABLES. 02020311 |
| C 02030311 |
| C 02040311 |
| C **** FCVS PROGRAM 311 - TEST 001 **** 02050311 |
| C 02060311 |
| C EXPRESSION CONSISTS OF REAL CONSTANT (NO DUMMY ARGUMENT). 02070311 |
| C 02080311 |
| IVTNUM = 1 02090311 |
| IF (ICZERO) 30010, 0010, 30010 02100311 |
| 0010 CONTINUE 02110311 |
| RVCOMP = 0.0 02120311 |
| RVCOMP = RFOS01(1.0) 02130311 |
| RVCORR = 3.5 02140311 |
| 40010 IF (RVCOMP - 3.4995) 20010, 10010, 40011 02150311 |
| 40011 IF (RVCOMP - 3.5005) 10010, 10010, 20010 02160311 |
| 30010 IVDELE = IVDELE + 1 02170311 |
| WRITE (I02,80000) IVTNUM 02180311 |
| IF (ICZERO) 10010, 0021, 20010 02190311 |
| 10010 IVPASS = IVPASS + 1 02200311 |
| WRITE (I02,80002) IVTNUM 02210311 |
| GO TO 0021 02220311 |
| 20010 IVFAIL = IVFAIL + 1 02230311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02240311 |
| 0021 CONTINUE 02250311 |
| C 02260311 |
| C **** FCVS PROGRAM 311 - TEST 002 **** 02270311 |
| C 02280311 |
| C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL 02290311 |
| C CONSTANT. 02300311 |
| C 02310311 |
| IVTNUM = 2 02320311 |
| IF (ICZERO) 30020, 0020, 30020 02330311 |
| 0020 CONTINUE 02340311 |
| RVCOMP = 0.0 02350311 |
| RVCOMP = RFOS02(1.3333) 02360311 |
| RVCORR = 1.3333 02370311 |
| 40020 IF (RVCOMP - 1.3328) 20020, 10020, 40021 02380311 |
| 40021 IF (RVCOMP - 1.3338) 10020, 10020, 20020 02390311 |
| 30020 IVDELE = IVDELE + 1 02400311 |
| WRITE (I02,80000) IVTNUM 02410311 |
| IF (ICZERO) 10020, 0031, 20020 02420311 |
| 10020 IVPASS = IVPASS + 1 02430311 |
| WRITE (I02,80002) IVTNUM 02440311 |
| GO TO 0031 02450311 |
| 20020 IVFAIL = IVFAIL + 1 02460311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02470311 |
| 0031 CONTINUE 02480311 |
| C 02490311 |
| C **** FCVS PROGRAM 311 - TEST 003 **** 02500311 |
| C 02510311 |
| C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL 02520311 |
| C VARIABLE. 02530311 |
| C 02540311 |
| IVTNUM = 3 02550311 |
| IF (ICZERO) 30030, 0030, 30030 02560311 |
| 0030 CONTINUE 02570311 |
| RVCOMP = 0.0 02580311 |
| RVON01 = 4.5 02590311 |
| RVCOMP = RFOS03(RVON01) 02600311 |
| RVCORR = 5.5 02610311 |
| 40030 IF (RVCOMP - 5.4995) 20030, 10030, 40031 02620311 |
| 40031 IF (RVCOMP - 5.5005) 10030, 10030, 20030 02630311 |
| 30030 IVDELE = IVDELE + 1 02640311 |
| WRITE (I02,80000) IVTNUM 02650311 |
| IF (ICZERO) 10030, 0041, 20030 02660311 |
| 10030 IVPASS = IVPASS + 1 02670311 |
| WRITE (I02,80002) IVTNUM 02680311 |
| GO TO 0041 02690311 |
| 20030 IVFAIL = IVFAIL + 1 02700311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02710311 |
| 0041 CONTINUE 02720311 |
| C 02730311 |
| C TEST 004 THROUGH TEST 006 TEST STATEMENT FUNCTIONS WHICH REQUIRE 02740311 |
| C TYPE CONVERSION OF THE EXPRESSION. 02750311 |
| C 02760311 |
| C 02770311 |
| C **** FCVS PROGRAM 311 - TEST 004 **** 02780311 |
| C 02790311 |
| C INTEGER STATEMENT FUNCTION WITH REAL EXPRESSION. 02800311 |
| C 02810311 |
| IVTNUM = 4 02820311 |
| IF (ICZERO) 30040, 0040, 30040 02830311 |
| 0040 CONTINUE 02840311 |
| IVCOMP = 0 02850311 |
| IVCOMP = IFOS01(2.3) 02860311 |
| IVCORR = 3 02870311 |
| 40040 IF (IVCOMP - 3) 20040, 10040, 20040 02880311 |
| 30040 IVDELE = IVDELE + 1 02890311 |
| WRITE (I02,80000) IVTNUM 02900311 |
| IF (ICZERO) 10040, 0051, 20040 02910311 |
| 10040 IVPASS = IVPASS + 1 02920311 |
| WRITE (I02,80002) IVTNUM 02930311 |
| GO TO 0051 02940311 |
| 20040 IVFAIL = IVFAIL + 1 02950311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02960311 |
| 0051 CONTINUE 02970311 |
| C 02980311 |
| C **** FCVS PROGRAM 311 - TEST 005 **** 02990311 |
| C 03000311 |
| C REAL STATEMENT FUNCTION WITH INTEGER EXPRESSION 03010311 |
| C 03020311 |
| IVTNUM = 5 03030311 |
| IF (ICZERO) 30050, 0050, 30050 03040311 |
| 0050 CONTINUE 03050311 |
| RVCOMP = 0.0 03060311 |
| RVCOMP = RFOS04(3) 03070311 |
| RVCORR = 4.0 03080311 |
| 40050 IF (RVCOMP - 3.9995) 20050, 10050, 40051 03090311 |
| 40051 IF (RVCOMP - 4.0005) 10050, 10050, 20050 03100311 |
| 30050 IVDELE = IVDELE + 1 03110311 |
| WRITE (I02,80000) IVTNUM 03120311 |
| IF (ICZERO) 10050, 0061, 20050 03130311 |
| 10050 IVPASS = IVPASS + 1 03140311 |
| WRITE (I02,80002) IVTNUM 03150311 |
| GO TO 0061 03160311 |
| 20050 IVFAIL = IVFAIL + 1 03170311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03180311 |
| 0061 CONTINUE 03190311 |
| C 03200311 |
| C **** FCVS PROGRAM 311 - TEST 006 **** 03210311 |
| C 03220311 |
| C INTEGER STATEMENT FUNCTION WITH EXPRESSION CONSISTING OF INTEGER 03230311 |
| C AND REAL PRIMARIES. 03240311 |
| C 03250311 |
| IVTNUM = 6 03260311 |
| IF (ICZERO) 30060, 0060, 30060 03270311 |
| 0060 CONTINUE 03280311 |
| IVCOMP = 0 03290311 |
| IVCOMP = IFOS02(2) 03300311 |
| IVCORR = 3 03310311 |
| 40060 IF (IVCOMP - 3) 20060, 10060, 20060 03320311 |
| 30060 IVDELE = IVDELE + 1 03330311 |
| WRITE (I02,80000) IVTNUM 03340311 |
| IF (ICZERO) 10060, 0071, 20060 03350311 |
| 10060 IVPASS = IVPASS + 1 03360311 |
| WRITE (I02,80002) IVTNUM 03370311 |
| GO TO 0071 03380311 |
| 20060 IVFAIL = IVFAIL + 1 03390311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03400311 |
| 0071 CONTINUE 03410311 |
| C 03420311 |
| C TEST 007 THROUGH TEST 017 TEST THE USAGE OF VARIOUS PRIMARIES 03430311 |
| C IN THE EXPRESSION OF A STATEMENT FUNCTION. 03440311 |
| C 03450311 |
| C 03460311 |
| C **** FCVS PROGRAM 311 - TEST 007 **** 03470311 |
| C 03480311 |
| C USE INTEGER VARIABLE AS PRIMARY 03490311 |
| C 03500311 |
| IVTNUM = 7 03510311 |
| IF (ICZERO) 30070, 0070, 30070 03520311 |
| 0070 CONTINUE 03530311 |
| IVCOMP = 0 03540311 |
| IVON01 = 3 03550311 |
| IVCOMP = IFOS03(4) 03560311 |
| IVCORR = 7 03570311 |
| 40070 IF (IVCOMP - 7) 20070, 10070, 20070 03580311 |
| 30070 IVDELE = IVDELE + 1 03590311 |
| WRITE (I02,80000) IVTNUM 03600311 |
| IF (ICZERO) 10070, 0081, 20070 03610311 |
| 10070 IVPASS = IVPASS + 1 03620311 |
| WRITE (I02,80002) IVTNUM 03630311 |
| GO TO 0081 03640311 |
| 20070 IVFAIL = IVFAIL + 1 03650311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03660311 |
| 0081 CONTINUE 03670311 |
| C 03680311 |
| C **** FCVS PROGRAM 311 - TEST 008 **** 03690311 |
| C 03700311 |
| C USE REAL VARIABLE AS PRIMARY. 03710311 |
| C 03720311 |
| IVTNUM = 8 03730311 |
| IF (ICZERO) 30080, 0080, 30080 03740311 |
| 0080 CONTINUE 03750311 |
| RVCOMP = 0.0 03760311 |
| RVON02 = 1.5 03770311 |
| RADN11(2) = 1.3 03780311 |
| RVCOMP = RFOS05(RADN11(2)) 03790311 |
| RVCORR = 2.8 03800311 |
| 40080 IF (RVCOMP - 2.7995) 20080, 10080, 40081 03810311 |
| 40081 IF (RVCOMP - 2.8005) 10080, 10080, 20080 03820311 |
| 30080 IVDELE = IVDELE + 1 03830311 |
| WRITE (I02,80000) IVTNUM 03840311 |
| IF (ICZERO) 10080, 0091, 20080 03850311 |
| 10080 IVPASS = IVPASS + 1 03860311 |
| WRITE (I02,80002) IVTNUM 03870311 |
| GO TO 0091 03880311 |
| 20080 IVFAIL = IVFAIL + 1 03890311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03900311 |
| 0091 CONTINUE 03910311 |
| C 03920311 |
| C **** FCVS PROGRAM 311 - TEST 009 **** 03930311 |
| C 03940311 |
| C USE LOGICAL VARIABLE AS PRIMARY. 03950311 |
| C 03960311 |
| IVTNUM = 9 03970311 |
| IF (ICZERO) 30090, 0090, 30090 03980311 |
| 0090 CONTINUE 03990311 |
| LVON01 = .TRUE. 04000311 |
| IVCOMP = 0 04010311 |
| IF (LFOS01(.FALSE.)) IVCOMP = 1 04020311 |
| IVCORR = 1 04030311 |
| 40090 IF (IVCOMP - 1) 20090, 10090, 20090 04040311 |
| 30090 IVDELE = IVDELE + 1 04050311 |
| WRITE (I02,80000) IVTNUM 04060311 |
| IF (ICZERO) 10090, 0101, 20090 04070311 |
| 10090 IVPASS = IVPASS + 1 04080311 |
| WRITE (I02,80002) IVTNUM 04090311 |
| GO TO 0101 04100311 |
| 20090 IVFAIL = IVFAIL + 1 04110311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04120311 |
| 0101 CONTINUE 04130311 |
| C 04140311 |
| C **** FCVS PROGRAM 311 - TEST 010 **** 04150311 |
| C 04160311 |
| C USE INTEGER ARRAY ELEMENT NAME AS PRIMARY. 04170311 |
| C 04180311 |
| IVTNUM = 10 04190311 |
| IF (ICZERO) 30100, 0100, 30100 04200311 |
| 0100 CONTINUE 04210311 |
| IVCOMP = 0 04220311 |
| IADN11(1) = 7 04230311 |
| IVCOMP = IFOS04(-4) 04240311 |
| IVCORR = 3 04250311 |
| 40100 IF (IVCOMP - 3) 20100, 10100, 20100 04260311 |
| 30100 IVDELE = IVDELE + 1 04270311 |
| WRITE (I02,80000) IVTNUM 04280311 |
| IF (ICZERO) 10100, 0111, 20100 04290311 |
| 10100 IVPASS = IVPASS + 1 04300311 |
| WRITE (I02,80002) IVTNUM 04310311 |
| GO TO 0111 04320311 |
| 20100 IVFAIL = IVFAIL + 1 04330311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04340311 |
| 0111 CONTINUE 04350311 |
| C 04360311 |
| C **** FCVS PROGRAM 311 - TEST 011 **** 04370311 |
| C 04380311 |
| C USE REAL ARRAY ELEMENT NAME AS PRIMARY. 04390311 |
| C 04400311 |
| IVTNUM = 11 04410311 |
| IF (ICZERO) 30110, 0110, 30110 04420311 |
| 0110 CONTINUE 04430311 |
| RVCOMP = 0.0 04440311 |
| RADN12(3) = 1.23 04450311 |
| RVCOMP = RFOS06(3.0) 04460311 |
| RVCORR = 4.23 04470311 |
| 40110 IF (RVCOMP - 4.2295) 20110, 10110, 40111 04480311 |
| 40111 IF (RVCOMP - 4.2305) 10110, 10110, 20110 04490311 |
| 30110 IVDELE = IVDELE + 1 04500311 |
| WRITE (I02,80000) IVTNUM 04510311 |
| IF (ICZERO) 10110, 0121, 20110 04520311 |
| 10110 IVPASS = IVPASS + 1 04530311 |
| WRITE (I02,80002) IVTNUM 04540311 |
| GO TO 0121 04550311 |
| 20110 IVFAIL = IVFAIL + 1 04560311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04570311 |
| 0121 CONTINUE 04580311 |
| C 04590311 |
| C **** FCVS PROGRAM 311 - TEST 012 **** 04600311 |
| C 04610311 |
| C USE LOGICAL ARRAY ELEMENT NAME AS PRIMARY. 04620311 |
| C 04630311 |
| IVTNUM = 12 04640311 |
| IF (ICZERO) 30120, 0120, 30120 04650311 |
| 0120 CONTINUE 04660311 |
| LADN11(2) = .TRUE. 04670311 |
| IVCOMP = 0 04680311 |
| IF (LFOS02(.FALSE.)) IVCOMP = 1 04690311 |
| IVCORR = 1 04700311 |
| 40120 IF (IVCOMP - 1) 20120, 10120, 20120 04710311 |
| 30120 IVDELE = IVDELE + 1 04720311 |
| WRITE (I02,80000) IVTNUM 04730311 |
| IF (ICZERO) 10120, 0131, 20120 04740311 |
| 10120 IVPASS = IVPASS + 1 04750311 |
| WRITE (I02,80002) IVTNUM 04760311 |
| GO TO 0131 04770311 |
| 20120 IVFAIL = IVFAIL + 1 04780311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04790311 |
| 0131 CONTINUE 04800311 |
| C 04810311 |
| C **** FCVS PROGRAM 311 - TEST 013 **** 04820311 |
| C 04830311 |
| C USE A REAL ARRAY ELEMENT NAME AS PRIMARY WHERE THE SUBSCRIPT 04840311 |
| C VALUE IS THE DUMMY ARGUMENT NAME. 04850311 |
| C 04860311 |
| IVTNUM = 13 04870311 |
| IF (ICZERO) 30130, 0130, 30130 04880311 |
| 0130 CONTINUE 04890311 |
| RVCOMP = 0.0 04900311 |
| RADN13(4) = 13.4 04910311 |
| RVCOMP = RFOS07(4) 04920311 |
| RVCORR = 13.4 04930311 |
| 40130 IF (RVCOMP - 13.395) 20130, 10130, 40131 04940311 |
| 40131 IF (RVCOMP - 13.405) 10130, 10130, 20130 04950311 |
| 30130 IVDELE = IVDELE + 1 04960311 |
| WRITE (I02,80000) IVTNUM 04970311 |
| IF (ICZERO) 10130, 0141, 20130 04980311 |
| 10130 IVPASS = IVPASS + 1 04990311 |
| WRITE (I02,80002) IVTNUM 05000311 |
| GO TO 0141 05010311 |
| 20130 IVFAIL = IVFAIL + 1 05020311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05030311 |
| 0141 CONTINUE 05040311 |
| C 05050311 |
| C **** FCVS PROGRAM 311 - TEST 014 **** 05060311 |
| C 05070311 |
| C USE EXTERNAL FUNCTION REFERENCE AS PRIMARY. 05080311 |
| C 05090311 |
| IVTNUM = 14 05100311 |
| IF (ICZERO) 30140, 0140, 30140 05110311 |
| 0140 CONTINUE 05120311 |
| IVCOMP = 0 05130311 |
| IVCOMP = IFOS05(6) 05140311 |
| IVCORR = 11 05150311 |
| 40140 IF (IVCOMP - 11) 20140, 10140, 20140 05160311 |
| 30140 IVDELE = IVDELE + 1 05170311 |
| WRITE (I02,80000) IVTNUM 05180311 |
| IF (ICZERO) 10140, 0151, 20140 05190311 |
| 10140 IVPASS = IVPASS + 1 05200311 |
| WRITE (I02,80002) IVTNUM 05210311 |
| GO TO 0151 05220311 |
| 20140 IVFAIL = IVFAIL + 1 05230311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05240311 |
| 0151 CONTINUE 05250311 |
| C 05260311 |
| C **** FCVS PROGRAM 311 - TEST 015 **** 05270311 |
| C 05280311 |
| C USE EXPRESSION ENCLOSED IN PARENTHESES. 05290311 |
| C 05300311 |
| IVTNUM = 15 05310311 |
| IF (ICZERO) 30150, 0150, 30150 05320311 |
| 0150 CONTINUE 05330311 |
| IVCOMP = 0 05340311 |
| IVCOMP = IFOS06(4) 05350311 |
| IVCORR = 5 05360311 |
| 40150 IF (IVCOMP - 5) 20150, 10150, 20150 05370311 |
| 30150 IVDELE = IVDELE + 1 05380311 |
| WRITE (I02,80000) IVTNUM 05390311 |
| IF (ICZERO) 10150, 0161, 20150 05400311 |
| 10150 IVPASS = IVPASS + 1 05410311 |
| WRITE (I02,80002) IVTNUM 05420311 |
| GO TO 0161 05430311 |
| 20150 IVFAIL = IVFAIL + 1 05440311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05450311 |
| 0161 CONTINUE 05460311 |
| C 05470311 |
| C **** FCVS PROGRAM 311 - TEST 016 **** 05480311 |
| C 05490311 |
| C USE VARIABLE INITIALLY DEFINED IN DATA STATEMENT AS PRIMARY. 05500311 |
| C 05510311 |
| IVTNUM = 16 05520311 |
| IF (ICZERO) 30160, 0160, 30160 05530311 |
| 0160 CONTINUE 05540311 |
| IVCOMP = 0 05550311 |
| IVCOMP = IFOS07(3) 05560311 |
| IVCORR = 9 05570311 |
| 40160 IF (IVCOMP - 9) 20160, 10160, 20160 05580311 |
| 30160 IVDELE = IVDELE + 1 05590311 |
| WRITE (I02,80000) IVTNUM 05600311 |
| IF (ICZERO) 10160, 0171, 20160 05610311 |
| 10160 IVPASS = IVPASS + 1 05620311 |
| WRITE (I02,80002) IVTNUM 05630311 |
| GO TO 0171 05640311 |
| 20160 IVFAIL = IVFAIL + 1 05650311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05660311 |
| 0171 CONTINUE 05670311 |
| C 05680311 |
| C **** FCVS PROGRAM 311 - TEST 017 **** 05690311 |
| C 05700311 |
| C USE PREVIOUSLY DEFINED STATEMENT FUNCTION REFERENCE AS PRIMARY. 05710311 |
| C 05720311 |
| IVTNUM = 17 05730311 |
| IF (ICZERO) 30170, 0170, 30170 05740311 |
| 0170 CONTINUE 05750311 |
| IVCOMP = 0 05760311 |
| IVCOMP = IFOS09(3) 05770311 |
| IVCORR = 5 05780311 |
| 40170 IF (IVCOMP - 5) 20170, 10170, 20170 05790311 |
| 30170 IVDELE = IVDELE + 1 05800311 |
| WRITE (I02,80000) IVTNUM 05810311 |
| IF (ICZERO) 10170, 0181, 20170 05820311 |
| 10170 IVPASS = IVPASS + 1 05830311 |
| WRITE (I02,80002) IVTNUM 05840311 |
| GO TO 0181 05850311 |
| 20170 IVFAIL = IVFAIL + 1 05860311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05870311 |
| 0181 CONTINUE 05880311 |
| C 05890311 |
| C TEST 018 THROUGH TEST 020 APPLY TO THE DEFINITION OF THE 05900311 |
| C STATEMENT FUNCTION DUMMY ARGUMENTS. 05910311 |
| C 05920311 |
| C 05930311 |
| C **** FCVS PROGRAM 311 - TEST 018 **** 05940311 |
| C 05950311 |
| C DEFINE STATEMENT FUNCTION WITH NO DUMMY ARGUMENTS. 05960311 |
| C 05970311 |
| IVTNUM = 18 05980311 |
| IF (ICZERO) 30180, 0180, 30180 05990311 |
| 0180 CONTINUE 06000311 |
| IVCOMP = 0 06010311 |
| IVON02 = 4 06020311 |
| IVCOMP = IFOS10() 06030311 |
| IVCORR = 4 06040311 |
| 40180 IF (IVCOMP - 4) 20180, 10180, 20180 06050311 |
| 30180 IVDELE = IVDELE + 1 06060311 |
| WRITE (I02,80000) IVTNUM 06070311 |
| IF (ICZERO) 10180, 0191, 20180 06080311 |
| 10180 IVPASS = IVPASS + 1 06090311 |
| WRITE (I02,80002) IVTNUM 06100311 |
| GO TO 0191 06110311 |
| 20180 IVFAIL = IVFAIL + 1 06120311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06130311 |
| 0191 CONTINUE 06140311 |
| C 06150311 |
| C **** FCVS PROGRAM 311 - TEST 019 **** 06160311 |
| C 06170311 |
| C DEFINE STATEMENT FUNCTION WITH THREE DUMMY ARGUMENTS. 06180311 |
| C 06190311 |
| IVTNUM = 19 06200311 |
| IF (ICZERO) 30190, 0190, 30190 06210311 |
| 0190 CONTINUE 06220311 |
| IVCOMP = 0 06230311 |
| IVCOMP = IFOS11(1,2,3) 06240311 |
| IVCORR = 6 06250311 |
| 40190 IF (IVCOMP - 6) 20190, 10190, 20190 06260311 |
| 30190 IVDELE = IVDELE + 1 06270311 |
| WRITE (I02,80000) IVTNUM 06280311 |
| IF (ICZERO) 10190, 0201, 20190 06290311 |
| 10190 IVPASS = IVPASS + 1 06300311 |
| WRITE (I02,80002) IVTNUM 06310311 |
| GO TO 0201 06320311 |
| 20190 IVFAIL = IVFAIL + 1 06330311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06340311 |
| 0201 CONTINUE 06350311 |
| C 06360311 |
| C **** FCVS PROGRAM 311 - TEST 020 **** 06370311 |
| C 06380311 |
| C USE THE SAME DUMMY ARGUMENT NAME IN TWO DIFFERENT 06390311 |
| C STATEMENT FUNCTIONS. 06400311 |
| C 06410311 |
| IVTNUM = 20 06420311 |
| IF (ICZERO) 30200, 0200, 30200 06430311 |
| 0200 CONTINUE 06440311 |
| IVCOMP = 1 06450311 |
| IF (IFOS12(3) .EQ. 4) IVCOMP = IVCOMP * 2 06460311 |
| IF (IFOS13(4) .EQ. 6) IVCOMP = IVCOMP * 3 06470311 |
| IVCORR = 6 06480311 |
| C 6 = 2 * 3 06490311 |
| 40200 IF (IVCOMP - 6) 20200, 10200, 20200 06500311 |
| 30200 IVDELE = IVDELE + 1 06510311 |
| WRITE (I02,80000) IVTNUM 06520311 |
| IF (ICZERO) 10200, 0211, 20200 06530311 |
| 10200 IVPASS = IVPASS + 1 06540311 |
| WRITE (I02,80002) IVTNUM 06550311 |
| GO TO 0211 06560311 |
| 20200 IVFAIL = IVFAIL + 1 06570311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06580311 |
| 0211 CONTINUE 06590311 |
| C 06600311 |
| C TEST 021 THROUGH TEST 022 TEST THE USAGE OF DIFFERENT TYPES OF 06610311 |
| C ACTUAL ARGUMENTS IN A STATEMENT FUNCTION REFERENCE. 06620311 |
| C 06630311 |
| C 06640311 |
| C **** FCVS PROGRAM 311 - TEST 021 **** 06650311 |
| C 06660311 |
| C USE AN EXPRESSION WITH OPERATORS AS AN ACTUAL ARGUMENT. 06670311 |
| C 06680311 |
| IVTNUM = 21 06690311 |
| IF (ICZERO) 30210, 0210, 30210 06700311 |
| 0210 CONTINUE 06710311 |
| IVCOMP = 0 06720311 |
| IVON03 = 4 06730311 |
| IVCOMP = IFOS14(IVON03 * 4 + 1) 06740311 |
| IVCORR = 18 06750311 |
| 40210 IF (IVCOMP - 18) 20210, 10210, 20210 06760311 |
| 30210 IVDELE = IVDELE + 1 06770311 |
| WRITE (I02,80000) IVTNUM 06780311 |
| IF (ICZERO) 10210, 0221, 20210 06790311 |
| 10210 IVPASS = IVPASS + 1 06800311 |
| WRITE (I02,80002) IVTNUM 06810311 |
| GO TO 0221 06820311 |
| 20210 IVFAIL = IVFAIL + 1 06830311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06840311 |
| 0221 CONTINUE 06850311 |
| C 06860311 |
| C **** FCVS PROGRAM 311 - TEST 022 **** 06870311 |
| C 06880311 |
| C USE AN INTRINSIC FUNCTION REFERENCE AS AN ACTUAL ARGUMENT. 06890311 |
| C 06900311 |
| IVTNUM = 22 06910311 |
| IF (ICZERO) 30220, 0220, 30220 06920311 |
| 0220 CONTINUE 06930311 |
| IVCOMP = 0 06940311 |
| RVON01 = 1.75 06950311 |
| IVCOMP = IFOS14(NINT(RVON01)) 06960311 |
| IVCORR = 3 06970311 |
| 40220 IF (IVCOMP - 3) 20220, 10220, 20220 06980311 |
| 30220 IVDELE = IVDELE + 1 06990311 |
| WRITE (I02,80000) IVTNUM 07000311 |
| IF (ICZERO) 10220, 0231, 20220 07010311 |
| 10220 IVPASS = IVPASS + 1 07020311 |
| WRITE (I02,80002) IVTNUM 07030311 |
| GO TO 0231 07040311 |
| 20220 IVFAIL = IVFAIL + 1 07050311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07060311 |
| 0231 CONTINUE 07070311 |
| C 07080311 |
| C **** FCVS PROGRAM 311 - TEST 023 **** 07090311 |
| C 07100311 |
| C USE AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL ARGUMENT. 07110311 |
| C 07120311 |
| IVTNUM = 23 07130311 |
| IF (ICZERO) 30230, 0230, 30230 07140311 |
| 0230 CONTINUE 07150311 |
| IVCOMP = 0 07160311 |
| IVCOMP = IFOS14(FF312(5)) 07170311 |
| IVCORR = 7 07180311 |
| 40230 IF (IVCOMP - 7) 20230, 10230, 20230 07190311 |
| 30230 IVDELE = IVDELE + 1 07200311 |
| WRITE (I02,80000) IVTNUM 07210311 |
| IF (ICZERO) 10230, 0241, 20230 07220311 |
| 10230 IVPASS = IVPASS + 1 07230311 |
| WRITE (I02,80002) IVTNUM 07240311 |
| GO TO 0241 07250311 |
| 20230 IVFAIL = IVFAIL + 1 07260311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07270311 |
| 0241 CONTINUE 07280311 |
| C 07290311 |
| C TEST 024 THROUGH TEST 029 APPLY TO THE TYPING OF STATEMENT 07300311 |
| C FUNCTIONS AND THE ASSOCIATED DUMMY ARGUMENT NAMES. 07310311 |
| C 07320311 |
| C 07330311 |
| C **** FCVS PROGRAM 311 - TEST 024 **** 07340311 |
| C 07350311 |
| C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION WITH 07360311 |
| C THE IMPLICIT STATEMENT TYPING OF REAL. 07370311 |
| C 07380311 |
| IVTNUM = 24 07390311 |
| IF (ICZERO) 30240, 0240, 30240 07400311 |
| 0240 CONTINUE 07410311 |
| RVCOMP = 10.0 07420311 |
| RVCOMP = KFOS01(3) / 5 07430311 |
| RVCORR = 0.8 07440311 |
| 40240 IF (RVCOMP - .79995) 20240, 10240, 40241 07450311 |
| 40241 IF (RVCOMP - .80005) 10240, 10240, 20240 07460311 |
| 30240 IVDELE = IVDELE + 1 07470311 |
| WRITE (I02,80000) IVTNUM 07480311 |
| IF (ICZERO) 10240, 0251, 20240 07490311 |
| 10240 IVPASS = IVPASS + 1 07500311 |
| WRITE (I02,80002) IVTNUM 07510311 |
| GO TO 0251 07520311 |
| 20240 IVFAIL = IVFAIL + 1 07530311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07540311 |
| 0251 CONTINUE 07550311 |
| C 07560311 |
| C **** FCVS PROGRAM 311 - TEST 025 **** 07570311 |
| C 07580311 |
| C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION WITH 07590311 |
| C THE IMPLICIT STATEMENT TYPING OF INTEGER. 07600311 |
| C 07610311 |
| IVTNUM = 25 07620311 |
| IF (ICZERO) 30250, 0250, 30250 07630311 |
| 0250 CONTINUE 07640311 |
| RVCOMP = 10.0 07650311 |
| RVCOMP = AFOS01(3.0) / 5 07660311 |
| RVCORR = 0.0 07670311 |
| 40250 IF (RVCOMP + .00005) 20250, 10250, 40251 07680311 |
| 40251 IF (RVCOMP - .00005) 10250, 10250, 20250 07690311 |
| 30250 IVDELE = IVDELE + 1 07700311 |
| WRITE (I02,80000) IVTNUM 07710311 |
| IF (ICZERO) 10250, 0261, 20250 07720311 |
| 10250 IVPASS = IVPASS + 1 07730311 |
| WRITE (I02,80002) IVTNUM 07740311 |
| GO TO 0261 07750311 |
| 20250 IVFAIL = IVFAIL + 1 07760311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07770311 |
| 0261 CONTINUE 07780311 |
| C 07790311 |
| C **** FCVS PROGRAM 311 - TEST 026 **** 07800311 |
| C 07810311 |
| C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION 07820311 |
| C DUMMY ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF REAL. 07830311 |
| C 07840311 |
| IVTNUM = 26 07850311 |
| IF (ICZERO) 30260, 0260, 30260 07860311 |
| 0260 CONTINUE 07870311 |
| RVCOMP = 10.0 07880311 |
| RVCOMP = RFOS08(4.0) 07890311 |
| RVCORR = 0.8 07900311 |
| 40260 IF (RVCOMP - .79995) 20260, 10260, 40261 07910311 |
| 40261 IF (RVCOMP - .80005) 10260, 10260, 20260 07920311 |
| 30260 IVDELE = IVDELE + 1 07930311 |
| WRITE (I02,80000) IVTNUM 07940311 |
| IF (ICZERO) 10260, 0271, 20260 07950311 |
| 10260 IVPASS = IVPASS + 1 07960311 |
| WRITE (I02,80002) IVTNUM 07970311 |
| GO TO 0271 07980311 |
| 20260 IVFAIL = IVFAIL + 1 07990311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08000311 |
| 0271 CONTINUE 08010311 |
| C 08020311 |
| C **** FCVS PROGRAM 311 - TEST 027 **** 08030311 |
| C 08040311 |
| C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08050311 |
| C ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF INTEGER. 08060311 |
| C 08070311 |
| IVTNUM = 27 08080311 |
| IF (ICZERO) 30270, 0270, 30270 08090311 |
| 0270 CONTINUE 08100311 |
| RVCOMP = 10.0 08110311 |
| RVCOMP = RFOS09(4) 08120311 |
| RVCORR = 0.0 08130311 |
| 40270 IF (RVCOMP + .00005) 20270, 10270, 40271 08140311 |
| 40271 IF (RVCOMP - .00005) 10270, 10270, 20270 08150311 |
| 30270 IVDELE = IVDELE + 1 08160311 |
| WRITE (I02,80000) IVTNUM 08170311 |
| IF (ICZERO) 10270, 0281, 20270 08180311 |
| 10270 IVPASS = IVPASS + 1 08190311 |
| WRITE (I02,80002) IVTNUM 08200311 |
| GO TO 0281 08210311 |
| 20270 IVFAIL = IVFAIL + 1 08220311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08230311 |
| 0281 CONTINUE 08240311 |
| C 08250311 |
| C **** FCVS PROGRAM 311 - TEST 028 **** 08260311 |
| C 08270311 |
| C OVERRIDE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08280311 |
| C ARGUMENT WITH TYPE-STATEMENT TYPING OF REAL. 08290311 |
| C 08300311 |
| IVTNUM = 28 08310311 |
| IF (ICZERO) 30280, 0280, 30280 08320311 |
| 0280 CONTINUE 08330311 |
| RVCOMP = 10.0 08340311 |
| RVCOMP = RFOS10(4.0) 08350311 |
| RVCORR = 0.8 08360311 |
| 40280 IF (RVCOMP - .79995) 20280, 10280, 40281 08370311 |
| 40281 IF (RVCOMP - .80005) 10280, 10280, 20280 08380311 |
| 30280 IVDELE = IVDELE + 1 08390311 |
| WRITE (I02,80000) IVTNUM 08400311 |
| IF (ICZERO) 10280, 0291, 20280 08410311 |
| 10280 IVPASS = IVPASS + 1 08420311 |
| WRITE (I02,80002) IVTNUM 08430311 |
| GO TO 0291 08440311 |
| 20280 IVFAIL = IVFAIL + 1 08450311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08460311 |
| 0291 CONTINUE 08470311 |
| C 08480311 |
| C **** FCVS PROGRAM 311 - TEST 029 **** 08490311 |
| C 08500311 |
| C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08510311 |
| C ARGUMENT WITH TYPE-STATEMENT TYPING OF INTEGER. 08520311 |
| C 08530311 |
| IVTNUM = 29 08540311 |
| IF (ICZERO) 30290, 0290, 30290 08550311 |
| 0290 CONTINUE 08560311 |
| RVCOMP = 10.0 08570311 |
| RVCOMP = RFOS11(4) 08580311 |
| RVCORR = 0.0 08590311 |
| 40290 IF (RVCOMP + .00005) 20290, 10290, 40291 08600311 |
| 40291 IF (RVCOMP - .00005) 10290, 10290, 20290 08610311 |
| 30290 IVDELE = IVDELE + 1 08620311 |
| WRITE (I02,80000) IVTNUM 08630311 |
| IF (ICZERO) 10290, 0301, 20290 08640311 |
| 10290 IVPASS = IVPASS + 1 08650311 |
| WRITE (I02,80002) IVTNUM 08660311 |
| GO TO 0301 08670311 |
| 20290 IVFAIL = IVFAIL + 1 08680311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08690311 |
| 0301 CONTINUE 08700311 |
| C 08710311 |
| C **** FCVS PROGRAM 311 - TEST 030 **** 08720311 |
| C 08730311 |
| C TEST 030 TESTS A STATEMENT FUNCTION WHERE THE DUMMY ARGUMENT 08740311 |
| C NAME IS IDENTICAL TO A VARIABLE NAME WITHIN THE PROGRAM. 08750311 |
| C 08760311 |
| IVTNUM = 30 08770311 |
| IF (ICZERO) 30300, 0300, 30300 08780311 |
| 0300 CONTINUE 08790311 |
| IVON04 = 10 08800311 |
| IVCOMP = 1 08810311 |
| IF (IFOS15(3) .EQ. 4) IVCOMP = IVCOMP * 2 08820311 |
| IF (IVON04 .EQ. 10) IVCOMP = IVCOMP * 3 08830311 |
| IVCORR = 6 08840311 |
| C 6 = 2 * 3 08850311 |
| 40300 IF (IVCOMP - 6) 20300, 10300, 20300 08860311 |
| 30300 IVDELE = IVDELE + 1 08870311 |
| WRITE (I02,80000) IVTNUM 08880311 |
| IF (ICZERO) 10300, 0311, 20300 08890311 |
| 10300 IVPASS = IVPASS + 1 08900311 |
| WRITE (I02,80002) IVTNUM 08910311 |
| GO TO 0311 08920311 |
| 20300 IVFAIL = IVFAIL + 1 08930311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08940311 |
| 0311 CONTINUE 08950311 |
| C 08960311 |
| C **** FCVS PROGRAM 311 - TEST 031 **** 08970311 |
| C 08980311 |
| C TEST 031 TESTS THE ASSIGNMENT OF A STATEMENT FUNCTION TO AN 08990311 |
| C ARRAY ELEMENT. 09000311 |
| C 09010311 |
| IVTNUM = 31 09020311 |
| IF (ICZERO) 30310, 0310, 30310 09030311 |
| 0310 CONTINUE 09040311 |
| IVCOMP = 0 09050311 |
| IADN12(3) = IFOS16(4) 09060311 |
| IVCOMP = IADN12(3) 09070311 |
| IVCORR = 5 09080311 |
| 40310 IF (IVCOMP - 5) 20310, 10310, 20310 09090311 |
| 30310 IVDELE = IVDELE + 1 09100311 |
| WRITE (I02,80000) IVTNUM 09110311 |
| IF (ICZERO) 10310, 0321, 20310 09120311 |
| 10310 IVPASS = IVPASS + 1 09130311 |
| WRITE (I02,80002) IVTNUM 09140311 |
| GO TO 0321 09150311 |
| 20310 IVFAIL = IVFAIL + 1 09160311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09170311 |
| 0321 CONTINUE 09180311 |
| C 09190311 |
| C **** FCVS PROGRAM 311 - TEST 032 **** 09200311 |
| C 09210311 |
| C TEST 032 TESTS THE USE OF A STATEMENT FUNCTION REFERENCE 09220311 |
| C IN AN ARITHMETIC EXPRESSION. 09230311 |
| C 09240311 |
| IVTNUM = 32 09250311 |
| IF (ICZERO) 30320, 0320, 30320 09260311 |
| 0320 CONTINUE 09270311 |
| IVCOMP = 0 09280311 |
| IVON05 = 12 09290311 |
| IVCOMP = IVON05 + IFOS17(4) * 2 - 3 09300311 |
| IVCORR = 19 09310311 |
| 40320 IF (IVCOMP - 19) 20320, 10320, 20320 09320311 |
| 30320 IVDELE = IVDELE + 1 09330311 |
| WRITE (I02,80000) IVTNUM 09340311 |
| IF (ICZERO) 10320, 0331, 20320 09350311 |
| 10320 IVPASS = IVPASS + 1 09360311 |
| WRITE (I02,80002) IVTNUM 09370311 |
| GO TO 0331 09380311 |
| 20320 IVFAIL = IVFAIL + 1 09390311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09400311 |
| 0331 CONTINUE 09410311 |
| C 09420311 |
| C **** FCVS PROGRAM 311 - TEST 033 **** 09430311 |
| C 09440311 |
| C TEST 033 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND 09450311 |
| C REFERENCE WITHIN AN EXTERNAL FUNCTION. 09460311 |
| C 09470311 |
| IVTNUM = 33 09480311 |
| IF (ICZERO) 30330, 0330, 30330 09490311 |
| 0330 CONTINUE 09500311 |
| RVCOMP = 0.0 09510311 |
| RVCOMP = FF313(1.3) 09520311 |
| RVCORR = 5.8 09530311 |
| 40330 IF (RVCOMP - 5.7995) 20330, 10330, 40331 09540311 |
| 40331 IF (RVCOMP - 5.8005) 10330, 10330, 20330 09550311 |
| 30330 IVDELE = IVDELE + 1 09560311 |
| WRITE (I02,80000) IVTNUM 09570311 |
| IF (ICZERO) 10330, 0341, 20330 09580311 |
| 10330 IVPASS = IVPASS + 1 09590311 |
| WRITE (I02,80002) IVTNUM 09600311 |
| GO TO 0341 09610311 |
| 20330 IVFAIL = IVFAIL + 1 09620311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09630311 |
| 0341 CONTINUE 09640311 |
| C 09650311 |
| C **** FCVS PROGRAM 311 - TEST 034 **** 09660311 |
| C 09670311 |
| C TEST 034 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND 09680311 |
| C REFERENCE WITHIN A SUBROUTINE. 09690311 |
| C 09700311 |
| IVTNUM = 34 09710311 |
| IF (ICZERO) 30340, 0340, 30340 09720311 |
| 0340 CONTINUE 09730311 |
| RVCOMP = 0.0 09740311 |
| RVON05 = 10.0 09750311 |
| CALL FS316(RVON05) 09760311 |
| RVCOMP = RVON05 09770311 |
| RVCORR = 5.5 09780311 |
| 40340 IF (RVCOMP - 5.4995) 20340, 10340, 40341 09790311 |
| 40341 IF (RVCOMP - 5.5005) 10340, 10340, 20340 09800311 |
| 30340 IVDELE = IVDELE + 1 09810311 |
| WRITE (I02,80000) IVTNUM 09820311 |
| IF (ICZERO) 10340, 0351, 20340 09830311 |
| 10340 IVPASS = IVPASS + 1 09840311 |
| WRITE (I02,80002) IVTNUM 09850311 |
| GO TO 0351 09860311 |
| 20340 IVFAIL = IVFAIL + 1 09870311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09880311 |
| 0351 CONTINUE 09890311 |
| C 09900311 |
| C **** FCVS PROGRAM 311 - TEST 035 **** 09910311 |
| C 09920311 |
| C TEST 035 REFERENCES THE DUMMY ARGUMENT NAME OF AN EXTERNAL 09930311 |
| C FUNCTION WITHIN THE EXPRESSION OF A STATEMENT FUNCTION DEFINED 09940311 |
| C IN THAT EXTERNAL FUNCTION. 09950311 |
| C 09960311 |
| IVTNUM = 35 09970311 |
| IF (ICZERO) 30350, 0350, 30350 09980311 |
| 0350 CONTINUE 09990311 |
| IVCOMP = 0 10000311 |
| IVCOMP = FF314(4) 10010311 |
| IVCORR = 7 10020311 |
| 40350 IF (IVCOMP - 7) 20350, 10350, 20350 10030311 |
| 30350 IVDELE = IVDELE + 1 10040311 |
| WRITE (I02,80000) IVTNUM 10050311 |
| IF (ICZERO) 10350, 0361, 20350 10060311 |
| 10350 IVPASS = IVPASS + 1 10070311 |
| WRITE (I02,80002) IVTNUM 10080311 |
| GO TO 0361 10090311 |
| 20350 IVFAIL = IVFAIL + 1 10100311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10110311 |
| 0361 CONTINUE 10120311 |
| C 10130311 |
| C **** FCVS PROGRAM 311 - TEST 036 **** 10140311 |
| C 10150311 |
| C TEST 036 TESTS A STATEMENT FUNCTION DEFINED WITHIN AN EXTERNAL 10160311 |
| C FUNCTION IN WHICH THE STATEMENT FUNCTION DUMMY ARGUMENT NAME IS 10170311 |
| C IDENTICAL TO THE EXTERNAL FUNCTION DUMMY ARGUMENT NAME. 10180311 |
| C 10190311 |
| IVTNUM = 36 10200311 |
| IF (ICZERO) 30360, 0360, 30360 10210311 |
| 0360 CONTINUE 10220311 |
| RVCOMP = 0.0 10230311 |
| RVCOMP = FF315(5.5) 10240311 |
| RVCORR = 16.7 10250311 |
| 40360 IF (RVCOMP - 16.695) 20360, 10360, 40361 10260311 |
| 40361 IF (RVCOMP - 16.705) 10360, 10360, 20360 10270311 |
| 30360 IVDELE = IVDELE + 1 10280311 |
| WRITE (I02,80000) IVTNUM 10290311 |
| IF (ICZERO) 10360, 0371, 20360 10300311 |
| 10360 IVPASS = IVPASS + 1 10310311 |
| WRITE (I02,80002) IVTNUM 10320311 |
| GO TO 0371 10330311 |
| 20360 IVFAIL = IVFAIL + 1 10340311 |
| WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 10350311 |
| 0371 CONTINUE 10360311 |
| C 10370311 |
| C **** FCVS PROGRAM 311 - TEST 037 **** 10380311 |
| C 10390311 |
| C TEST 037 TESTS THE USAGE OF THE NAME OF A COMMON BLOCK AS THE 10400311 |
| C SYMBOLIC NAME OF A STATEMENT FUNCTION. 10410311 |
| C 10420311 |
| IVTNUM = 37 10430311 |
| IF (ICZERO) 30370, 0370, 30370 10440311 |
| 0370 CONTINUE 10450311 |
| IVCOMP = 0 10460311 |
| IVCOMP = IFOS19(4) 10470311 |
| IVCORR = 5 10480311 |
| 40370 IF (IVCOMP - 5) 20370, 10370, 20370 10490311 |
| 30370 IVDELE = IVDELE + 1 10500311 |
| WRITE (I02,80000) IVTNUM 10510311 |
| IF (ICZERO) 10370, 0381, 20370 10520311 |
| 10370 IVPASS = IVPASS + 1 10530311 |
| WRITE (I02,80002) IVTNUM 10540311 |
| GO TO 0381 10550311 |
| 20370 IVFAIL = IVFAIL + 1 10560311 |
| WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10570311 |
| 0381 CONTINUE 10580311 |
| C 10590311 |
| C 10600311 |
| C WRITE OUT TEST SUMMARY 10610311 |
| C 10620311 |
| WRITE (I02,90004) 10630311 |
| WRITE (I02,90014) 10640311 |
| WRITE (I02,90004) 10650311 |
| WRITE (I02,90000) 10660311 |
| WRITE (I02,90004) 10670311 |
| WRITE (I02,90020) IVFAIL 10680311 |
| WRITE (I02,90022) IVPASS 10690311 |
| WRITE (I02,90024) IVDELE 10700311 |
| STOP 10710311 |
| 90001 FORMAT (" ",24X,"FM311") 10720311 |
| 90000 FORMAT (" ",20X,"END OF PROGRAM FM311" ) 10730311 |
| C 10740311 |
| C FORMATS FOR TEST DETAIL LINES 10750311 |
| C 10760311 |
| 80000 FORMAT (" ",4X,I5,6X,"DELETED") 10770311 |
| 80002 FORMAT (" ",4X,I5,7X,"PASS") 10780311 |
| 80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 10790311 |
| 80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 10800311 |
| 80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 10810311 |
| C 10820311 |
| C FORMAT STATEMENTS FOR PAGE HEADERS 10830311 |
| C 10840311 |
| 90002 FORMAT ("1") 10850311 |
| 90004 FORMAT (" ") 10860311 |
| 90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 10870311 |
| 90008 FORMAT (" ",21X,"VERSION 2.1" ) 10880311 |
| 90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 10890311 |
| 90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 10900311 |
| 90014 FORMAT (" ",5X,"----------------------------------------------" ) 10910311 |
| 90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 10920311 |
| C 10930311 |
| C FORMAT STATEMENTS FOR RUN SUMMARY 10940311 |
| C 10950311 |
| 90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 10960311 |
| 90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 10970311 |
| 90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 10980311 |
| END 10990311 |
| |
| INTEGER FUNCTION FF312(IDONX1) 00010312 |
| C THIS SUBPROGRAM IS USED BY TESTS 014 AND 023 OF THE MAIN PROGRAM 00020312 |
| C FM311 TO TEST STATEMENT FUNCTION. IN TEST 014 REFERENCE TO FF312 00030312 |
| C IS USED IN THE EXPRESSION OF A STATEMENT FUNCTION. IN TEST 023 00040312 |
| C REFERENCE TO FF312 IS USED AS AN ACTUAL ARGUMENT IN A STATEMENT 00050312 |
| C FUNCTION REFERENCE. THIS ROUTINE MERELY INCREMENTS THE VALUE OF 00060312 |
| C ACTUAL/DUMMY ARGUMENT BY ONE AND RETURN THE RESULT AS THE 00070312 |
| C FUNCTION VALUE. 00080312 |
| IDONX2 = IDONX1 + 1 00090312 |
| FF312 = IDONX2 00100312 |
| RETURN 00110312 |
| END 00120312 |
| |
| REAL FUNCTION FF313(RDON08) 00010313 |
| C THIS SUBPROGRAM IS USED BY TEST 033 OF THE MAIN PROGRAM FM311 TO 00020313 |
| C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030313 |
| C AN EXTERNAL FUNCTION. 00040313 |
| RFOS12(RDON09) = RDON09 + 1.0 00050313 |
| RVON04 = RFOS12(3.5) 00060313 |
| FF313 = RDON08 + RVON04 00070313 |
| RETURN 00080313 |
| END 00090313 |
| |
| INTEGER FUNCTION FF314(IDON19) 00010314 |
| C THIS SUBPROGRAM IS USED BY TEST 035 OF THE MAIN PROGRAM FM311 TO 00020314 |
| C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030314 |
| C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION DUMMY 00040314 |
| C ARGUMENT IS REFERENCED WITHIN THE EXPRESSION OF THE STATEMENT 00050314 |
| C FUNCTION. 00060314 |
| IFOS18(IDON20) = IDON19 + IDON20 00070314 |
| FF314 = IFOS18(3) 00080314 |
| RETURN 00090314 |
| END 00100314 |
| |
| REAL FUNCTION FF315(RDON12) 00010315 |
| C THIS SUBPROGRAM IS USED BY TEST 036 OF THE MAIN PROGRAM FM311 TO 00020315 |
| C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030315 |
| C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION AND 00040315 |
| C STATEMENT FUNCTION DUMMY ARGUMENTS NAMES ARE IDENTICAL. 00050315 |
| RFOS14(RDON12) = RDON12 + 1.0 00060315 |
| RVON06 = 10.2 00070315 |
| RVON07 = RFOS14(RVON06) 00080315 |
| FF315 = RDON12 + RVON07 00090315 |
| RETURN 00100315 |
| END 00110315 |
| |
| SUBROUTINE FS316(RDON10) 00010316 |
| C THIS SUBPROGRAM IS USED BY TEST 034 OF THE MAIN PROGRAM FM311 TO 00020316 |
| C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030316 |
| C A SUBROUTINE. 00040316 |
| RFOS13(RDON11) = RDON11 + 1.0 00050316 |
| RDON10 = RFOS13(3.5) + 1.0 00060316 |
| RETURN 00070316 |
| END 00080316 |