| PROGRAM FM080 |
| |
| C COMMENT SECTION 00010080 |
| C 00020080 |
| C FM080 00030080 |
| C 00040080 |
| C THIS ROUTINE CONTAINS EXTERNAL FUNCTION REFERENCE TESTS. 00050080 |
| C THE FUNCTION SUBPROGRAMS CALLED BY THIS ROUTINE ARE FF081, 00060080 |
| C FF082 AND FF083. THE FUNCTION SUBPROGRAMS ARE DEFINED AS 00070080 |
| C FF081 = INTEGER, FF082 = REAL, FF083 = IMPLICIT REAL. 00080080 |
| C THE FUNCTION SUBPROGRAM DUMMY ARGUMENTS MUST AGREE IN ORDER, 00090080 |
| C NUMBER AND TYPE WITH THE CORRESPONDING ACTUAL ARGUMENTS OF THE 00100080 |
| C MAIN PROGRAM. THE ARGUMENTS OF THE FUNCTION SUBPROGRAMS WILL 00110080 |
| C CORRESPOND TO ACTUAL ARGUMENT LIST REFERENCES OF VARIABLE-NAME, 00120080 |
| C ARRAY-NAME, ARRAY-ELEMENT-NAME AND EXPRESSION RESPECTIVELY. 00130080 |
| C 00140080 |
| C THIS ROUTINE WILL TEST THE VALUE OF THE FUNCTION AND THE 00150080 |
| C FUNCTION ARGUMENTS RETURNED FOLLOWING THE FUNCTION REFERENCE CALL.00160080 |
| C 00170080 |
| C 00180080 |
| C REFERENCES 00190080 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00200080 |
| C X3.9-1978 00210080 |
| C 00220080 |
| C SECTION 2.6, ARRAY 00230080 |
| C SECTION 15.5.2, REFERENCING EXTERNAL FUNCTIONS 00240080 |
| C SECTION 17.2, EVENTS THAT CAUSE ENTITIES TO BECOME DEFINED 00250080 |
| DIMENSION IADN1A (5), IADN2A (4,4) 00260080 |
| DIMENSION RADN3A (3,6,3), RADN1A (10) 00270080 |
| DIMENSION IADN3A (3,4,5) 00280080 |
| INTEGER FF081 00290080 |
| REAL FF082 00300080 |
| C 00310080 |
| C ********************************************************** 00320080 |
| C 00330080 |
| C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00340080 |
| C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00350080 |
| C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00360080 |
| C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00370080 |
| C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00380080 |
| C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00390080 |
| C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00400080 |
| C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00410080 |
| C OF EXECUTING THESE TESTS. 00420080 |
| C 00430080 |
| C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00440080 |
| C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00450080 |
| C 00460080 |
| C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00470080 |
| C 00480080 |
| C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00490080 |
| C SOFTWARE STANDARDS VALIDATION GROUP 00500080 |
| C BUILDING 225 RM A266 00510080 |
| C GAITHERSBURG, MD 20899 00520080 |
| C ********************************************************** 00530080 |
| C 00540080 |
| C 00550080 |
| C 00560080 |
| C INITIALIZATION SECTION 00570080 |
| C 00580080 |
| C INITIALIZE CONSTANTS 00590080 |
| C ************** 00600080 |
| C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00610080 |
| I01 = 5 00620080 |
| C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00630080 |
| I02 = 6 00640080 |
| C SYSTEM ENVIRONMENT SECTION 00650080 |
| C 00660080 |
| CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00670080 |
| C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680080 |
| C (UNIT NUMBER FOR CARD READER). 00690080 |
| CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00700080 |
| C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00710080 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00720080 |
| C 00730080 |
| CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00740080 |
| C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00750080 |
| C (UNIT NUMBER FOR PRINTER). 00760080 |
| CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00770080 |
| C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00780080 |
| C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00790080 |
| C 00800080 |
| IVPASS=0 00810080 |
| IVFAIL=0 00820080 |
| IVDELE=0 00830080 |
| ICZERO=0 00840080 |
| C 00850080 |
| C WRITE PAGE HEADERS 00860080 |
| WRITE (I02,90000) 00870080 |
| WRITE (I02,90001) 00880080 |
| WRITE (I02,90002) 00890080 |
| WRITE (I02, 90002) 00900080 |
| WRITE (I02,90003) 00910080 |
| WRITE (I02,90002) 00920080 |
| WRITE (I02,90004) 00930080 |
| WRITE (I02,90002) 00940080 |
| WRITE (I02,90011) 00950080 |
| WRITE (I02,90002) 00960080 |
| WRITE (I02,90002) 00970080 |
| WRITE (I02,90005) 00980080 |
| WRITE (I02,90006) 00990080 |
| WRITE (I02,90002) 01000080 |
| C 01010080 |
| C TEST SECTION 01020080 |
| C 01030080 |
| C EXTERNAL FUNCTION REFERENCE - FUNCTION SUBPROGRAM DEFINED AS 01040080 |
| C INTEGER (FF081) 01050080 |
| C 01060080 |
| 6741 CONTINUE 01070080 |
| IVTNUM = 674 01080080 |
| C 01090080 |
| C TEST 674 THROUGH 679 TEST THE FUNCTION AND ARGUMENT VALUES 01100080 |
| C FROM REFERENCE OF FUNCTION FF081. FUNCTION SUBPROGRAM FF081 IS 01110080 |
| C DEFINED AS INTEGER. 01120080 |
| C 01130080 |
| C **** TEST 674 **** 01140080 |
| C 01150080 |
| C TEST 674 TESTS THE FUNCTION VALUE RETURNED FROM FUNCTION FF081 01160080 |
| C 01170080 |
| IF (ICZERO) 36740,6740,36740 01180080 |
| 6740 CONTINUE 01190080 |
| IVON0A = 0 01200080 |
| IVON02 = 2 01210080 |
| IADN1A (3) = 8 01220080 |
| IADN1A (2) = 4 01230080 |
| IADN2A (1,3) =10 01240080 |
| IVON0A = FF081 (IVON02, IADN1A, IADN2A, 999) 01250080 |
| GO TO 46740 01260080 |
| 36740 IVDELE = IVDELE + 1 01270080 |
| WRITE (I02,80003) IVTNUM 01280080 |
| IF (ICZERO) 46740,6751,46740 01290080 |
| 46740 IF (IVON0A - 1015) 26740,16740,26740 01300080 |
| 16740 IVPASS = IVPASS + 1 01310080 |
| WRITE (I02,80001) IVTNUM 01320080 |
| GO TO 6751 01330080 |
| 26740 IVFAIL = IVFAIL + 1 01340080 |
| IVCORR = 1015 01350080 |
| IVCOMP = IVON0A 01360080 |
| WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01370080 |
| 6751 CONTINUE 01380080 |
| IVTNUM = 675 01390080 |
| C 01400080 |
| C **** TEST 675 **** 01410080 |
| C 01420080 |
| C TEST 675 TESTS THE RETURN VALUE OF VARIABLE-NAME ARGUMENT 01430080 |
| C IVON02. VALUE OF IVON02 SHOULD BE 4. 01440080 |
| C 01450080 |
| IF (ICZERO) 36750,6750,36750 01460080 |
| 6750 CONTINUE 01470080 |
| GO TO 46750 01480080 |
| 36750 IVDELE = IVDELE + 1 01490080 |
| WRITE (I02,80003) IVTNUM 01500080 |
| IF (ICZERO) 46750,6761,46750 01510080 |
| 46750 IF (IVON02 - 4) 26750,16750,26750 01520080 |
| 16750 IVPASS = IVPASS + 1 01530080 |
| WRITE (I02,80001) IVTNUM 01540080 |
| GO TO 6761 01550080 |
| 26750 IVFAIL = IVFAIL + 1 01560080 |
| IVCORR = 4 01570080 |
| IVCOMP = IVON02 01580080 |
| WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01590080 |
| 6761 CONTINUE 01600080 |
| IVTNUM = 676 01610080 |
| C 01620080 |
| C **** TEST 676 **** 01630080 |
| C 01640080 |
| C TEST 676 TESTS THE RETURN VALUE OF ARRAY-NAME ARGUMENT 01650080 |
| C IADN1A. IADN1A (2) IS INCREMENTED BY 40 IN FUNCTION SUBPROGRAM 01660080 |
| C AND SHOULD RETURN A VALUE OF 44. 01670080 |
| C 01680080 |
| IF (ICZERO) 36760,6760,36760 01690080 |
| 6760 CONTINUE 01700080 |
| GO TO 46760 01710080 |
| 36760 IVDELE = IVDELE + 1 01720080 |
| WRITE (I02,80003) IVTNUM 01730080 |
| IF (ICZERO) 46760,6771,46760 01740080 |
| 46760 IF (IADN1A (2) - 44) 26760,16760,26760 01750080 |
| 16760 IVPASS = IVPASS + 1 01760080 |
| WRITE (I02,80001) IVTNUM 01770080 |
| GO TO 6771 01780080 |
| 26760 IVFAIL = IVFAIL + 1 01790080 |
| IVCORR = 44 01800080 |
| IVCOMP = IADN1A (2) 01810080 |
| WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01820080 |
| 6771 CONTINUE 01830080 |
| IVTNUM = 677 01840080 |
| C 01850080 |
| C **** TEST 677 **** 01860080 |
| C 01870080 |
| C TEST 677 TESTS THE RETURN VALUE OF ARRAY-NAME ARGUMENT IADN1A. 01880080 |
| C IADN1A (3) WAS NOT MODIFFED BY FUNCTION SUBPROGRAM AND SHOULD 01890080 |
| C HAVE A VALUE OF 8 01900080 |
| C 01910080 |
| IF (ICZERO) 36770,6770,36770 01920080 |
| 6770 CONTINUE 01930080 |
| GO TO 46770 01940080 |
| 36770 IVDELE = IVDELE + 1 01950080 |
| WRITE (I02,80003) IVTNUM 01960080 |
| IF (ICZERO) 46770,6781,46770 01970080 |
| 46770 IF (IADN1A (3) - 8) 26770,16770,26770 01980080 |
| 16770 IVPASS = IVPASS + 1 01990080 |
| WRITE (I02,80001) IVTNUM 02000080 |
| GO TO 6781 02010080 |
| 26770 IVFAIL = IVFAIL + 1 02020080 |
| IVCORR = 8 02030080 |
| IVCOMP = IADN1A (3) 02040080 |
| WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02050080 |
| 6781 CONTINUE 02060080 |
| IVTNUM = 678 02070080 |
| C 02080080 |
| C **** TEST 678 **** 02090080 |
| C 02100080 |
| C TEST 678 TESTS THE RETURN VALUE OF ARRAY-ELEMENT-NAME 02110080 |
| C IADN2A (1,3). IADN2A (1,3) WAS INCREMENTED BY 70 IN THE FUNCTION 02120080 |
| C SUBPROGRAM AND SHOULD CONTAIN A VALUE OF 80. 02130080 |
| C 02140080 |
| IF (ICZERO) 36780,6780,36780 02150080 |
| 6780 CONTINUE 02160080 |
| GO TO 46780 02170080 |
| 36780 IVDELE = IVDELE + 1 02180080 |
| WRITE (I02,80003) IVTNUM 02190080 |
| IF (ICZERO) 46780,6791,46780 02200080 |
| 46780 IF (IADN2A (1,3) - 80) 26780,16780,26780 02210080 |
| 16780 IVPASS = IVPASS + 1 02220080 |
| WRITE (I02,80001) IVTNUM 02230080 |
| GO TO 6791 02240080 |
| 26780 IVFAIL = IVFAIL + 1 02250080 |
| IVCORR = 80 02260080 |
| IVCOMP = IADN2A (1,3) 02270080 |
| WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02280080 |
| 6791 CONTINUE 02290080 |
| IVTNUM = 679 02300080 |
| C 02310080 |
| C **** TEST 679 **** 02320080 |
| C 02330080 |
| C TEST 679 TESTS THE VALUE OF INTEGER FUNCTION ASSIGNED 02340080 |
| C TO A REAL VARIABLE. 02350080 |
| C 02360080 |
| IF (ICZERO) 36790,6790,36790 02370080 |
| 6790 CONTINUE 02380080 |
| RVON0A = 0.0 02390080 |
| IVON02 = 2 02400080 |
| IADN1A (2) = 4 02410080 |
| IADN2A (1,3) = 10 02420080 |
| RVON0A = FF081 (IVON02, IADN1A, IADN2A, 999) 02430080 |
| GO TO 46790 02440080 |
| 36790 IVDELE = IVDELE + 1 02450080 |
| WRITE (I02,80003) IVTNUM 02460080 |
| IF (ICZERO) 46790,6801,46790 02470080 |
| 46790 IF (RVON0A - 1014.5) 26790,16790,46791 02480080 |
| 46791 IF (RVON0A - 1015.5) 16790,16790,26790 02490080 |
| 16790 IVPASS = IVPASS + 1 02500080 |
| WRITE (I02,80001) IVTNUM 02510080 |
| GO TO 6801 02520080 |
| 26790 IVFAIL = IVFAIL + 1 02530080 |
| RVCORR = 1015.0 02540080 |
| RVCOMP = RVON0A 02550080 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02560080 |
| 6801 CONTINUE 02570080 |
| IVTNUM = 680 02580080 |
| C 02590080 |
| C EXTERNAL FUNCTION REFERENCE - FUNCTION SUBPROGRAM FF082 DEFINED AS02600080 |
| C REAL 02610080 |
| C 02620080 |
| C TESTS 680 THRU 685 TESTS THE FUNCTION AND ARGUMENT VALUES 02630080 |
| C FROM THE FUNCTION REFERENCE TO SUBPROGRAM FF082. THE FUNCTION 02640080 |
| C SUBPROGRAM IS DEFINED AS REAL. 02650080 |
| C 02660080 |
| C **** TEST 680 *** 02670080 |
| C 02680080 |
| C TEST 680 TESTS THE VALUE OF THE FUNCTION FF082. VALUE OF 02690080 |
| C FUNCTION SHOULD BE 339.0. 02700080 |
| C 02710080 |
| IF (ICZERO) 36800,6800,36800 02720080 |
| 6800 CONTINUE 02730080 |
| RVON01 = 2.0 02740080 |
| RADN3A (2,5,2) = 100.0 02750080 |
| RADN1A (5) = 210.5 02760080 |
| RVON0A = 0.0 02770080 |
| RVON0A = FF082 (RVON01, RADN3A, RADN1A, 26.5) 02780080 |
| GO TO 46800 02790080 |
| 36800 IVDELE = IVDELE + 1 02800080 |
| WRITE (I02, 80003) IVTNUM 02810080 |
| IF (ICZERO) 46800,6811,46800 02820080 |
| 46800 IF (RVON0A - 338.5) 26800,16800,46801 02830080 |
| 46801 IF (RVON0A - 339.5) 16800,16800,26800 02840080 |
| 16800 IVPASS = IVPASS + 1 02850080 |
| WRITE (I02,80001) IVTNUM 02860080 |
| GO TO 6811 02870080 |
| 26800 IVFAIL = IVFAIL + 1 02880080 |
| RVCORR = 339.0 02890080 |
| RVCOMP = RVON0A 02900080 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02910080 |
| 6811 CONTINUE 02920080 |
| IVTNUM = 681 02930080 |
| C 02940080 |
| C **** TEST 681 **** 02950080 |
| C 02960080 |
| C TEST 681 TESTS THE VALUE OF THE VARIABLE-NAME ARGUMENT RVON01 02970080 |
| C FOLLOWING THE FUNCTION REFERENCE. VALUE OF RVON01 SHOULD BE 8.4. 02980080 |
| C 02990080 |
| IF (ICZERO) 36810,6810,36810 03000080 |
| 6810 CONTINUE 03010080 |
| GO TO 46810 03020080 |
| 36810 IVDELE = IVDELE + 1 03030080 |
| WRITE (I02,80003) IVTNUM 03040080 |
| IF (ICZERO) 46810,6821,46810 03050080 |
| 46810 IF (RVON01 - 8.395) 26810,16810,46811 03060080 |
| 46811 IF (RVON01 - 8.405) 16810,16810,26810 03070080 |
| 16810 IVPASS = IVPASS + 1 03080080 |
| WRITE (I02,80001) IVTNUM 03090080 |
| GO TO 6821 03100080 |
| 26810 IVFAIL = IVFAIL + 1 03110080 |
| RVCORR = 8.4 03120080 |
| RVCOMP = RVON01 03130080 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03140080 |
| 6821 CONTINUE 03150080 |
| IVTNUM = 682 03160080 |
| C 03170080 |
| C **** TEST 682 **** 03180080 |
| C 03190080 |
| C TEST 682 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT RADN3A 03200080 |
| C FOLLOWING THE FUNCTION REFERENCE. RADN3A (2,5,2) WAS INITIALIZED 03210080 |
| C IN MAIN PROGRAM AND INCREMENTED IN SUBPROGRAM. VALUE OF RADN3A 03220080 |
| C (2,5,2) SHOULD BE 112.2. 03230080 |
| C 03240080 |
| IF (ICZERO) 36820,6820,36820 03250080 |
| 6820 CONTINUE 03260080 |
| GO TO 46820 03270080 |
| 36820 IVDELE = IVDELE + 1 03280080 |
| WRITE (I02,80003) IVTNUM 03290080 |
| IF (ICZERO) 46820,6831,46820 03300080 |
| 46820 IF (RADN3A (2,5,2) - 111.7) 26820,16820,46821 03310080 |
| 46821 IF (RADN3A (2,5,2) - 112.7) 16820,16820,26820 03320080 |
| 16820 IVPASS = IVPASS + 1 03330080 |
| WRITE (I02,80001) IVTNUM 03340080 |
| GO TO 6831 03350080 |
| 26820 IVFAIL = IVFAIL + 1 03360080 |
| RVCORR = 112.2 03370080 |
| RVCOMP = RADN3A (2,5,2) 03380080 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03390080 |
| 6831 CONTINUE 03400080 |
| IVTNUM = 683 03410080 |
| C 03420080 |
| C **** TEST 683 **** 03430080 |
| C 03440080 |
| C TEST 683 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT RADN3A 03450080 |
| C FOLLOWING THE FUNCTION REFERENCE. RADN3A (1,2,1) WAS INITIALIZED 03460080 |
| C IN THE SUBPROGRAM. THE VALUE OF RADN3A (1,2,1) SHOULD BE 612.2. 03470080 |
| C 03480080 |
| IF (ICZERO) 36830,6830,36830 03490080 |
| 6830 CONTINUE 03500080 |
| GO TO 46830 03510080 |
| 36830 IVDELE = IVDELE + 1 03520080 |
| WRITE (I02,80003) IVTNUM 03530080 |
| IF (ICZERO) 46830,6841,46830 03540080 |
| 46830 IF (RADN3A (1,2,1) - 611.7) 26830,16830,46831 03550080 |
| 46831 IF (RADN3A (1,2,1) - 612.7) 16830,16830,26830 03560080 |
| 16830 IVPASS = IVPASS + 1 03570080 |
| WRITE (I02,80001) IVTNUM 03580080 |
| GO TO 6841 03590080 |
| 26830 IVFAIL = IVFAIL + 1 03600080 |
| RVCORR = 612.2 03610080 |
| RVCOMP = RADN3A (1,2,1) 03620080 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03630080 |
| 6841 CONTINUE 03640080 |
| IVTNUM = 684 03650080 |
| C 03660080 |
| C **** TEST 684 **** 03670080 |
| C 03680080 |
| C TEST 684 TESTS THE VALUE OF THE ARRAY-ELEMENT-NAME ARGUMENT 03690080 |
| C RADN1A FOLLOWING THE FUNCTION REFERENCE. RADN1A (5) WAS 03700080 |
| C INITIALIZED IN THE MAIN PROGRAM AND INCREMENTED BY 18.8 IN THE 03710080 |
| C FUNCTION SUBPROGRAM. THE VALUE OF RADN1A SHOULD BE 229.3. 03720080 |
| C 03730080 |
| IF (ICZERO) 36840,6840,36840 03740080 |
| 6840 CONTINUE 03750080 |
| GO TO 46840 03760080 |
| 36840 IVDELE = IVDELE + 1 03770080 |
| WRITE (I02,80003) IVTNUM 03780080 |
| IF (ICZERO) 46840,6851,46840 03790080 |
| 46840 IF (RADN1A (5) - 228.8) 26840,16840,46841 03800080 |
| 46841 IF (RADN1A (5) - 229.8) 16840,16840,26840 03810080 |
| 16840 IVPASS = IVPASS + 1 03820080 |
| WRITE (I02,80001) IVTNUM 03830080 |
| GO TO 6851 03840080 |
| 26840 IVFAIL = IVFAIL + 1 03850080 |
| RVCORR = 229.3 03860080 |
| RVCOMP = RADN1A (5) 03870080 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03880080 |
| 6851 CONTINUE 03890080 |
| IVTNUM = 685 03900080 |
| C 03910080 |
| C **** TEST 685 **** 03920080 |
| C 03930080 |
| C TEST 685 TESTS THE RESULTANT VALUE WHERE THE FUNCTION 03940080 |
| C SUBPROGRAM IS DEFINED AS REAL AND THE VARIABLE TO WHICH THE 03950080 |
| C FUNCTION VALUE IS ASSIGNED IN THE MAIN PROGRAM IS DEFINED AS 03960080 |
| C INTEGER. 03970080 |
| C 03980080 |
| IF (ICZERO) 36850,6850,36850 03990080 |
| 6850 CONTINUE 04000080 |
| RVON01 = 4.0 04010080 |
| RADN3A (2,5,2) = 200.0 04020080 |
| RADN1A (5) = 2.85 04030080 |
| IVON0A = 0.0 04040080 |
| IVON0A = FF082 (RVON01, RADN3A, RADN1A, 102.68) 04050080 |
| GO TO 46850 04060080 |
| 36850 IVDELE = IVDELE + 1 04070080 |
| WRITE (I02,80003) IVTNUM 04080080 |
| IF (ICZERO) 46850,6861,46850 04090080 |
| 46850 IF (IVON0A - 309) 26850,16850,26850 04100080 |
| 16850 IVPASS = IVPASS + 1 04110080 |
| WRITE (I02,80001) IVTNUM 04120080 |
| GO TO 6861 04130080 |
| 26850 IVFAIL = IVFAIL + 1 04140080 |
| IVCORR = 309 04150080 |
| IVCOMP = IVON0A 04160080 |
| WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04170080 |
| 6861 CONTINUE 04180080 |
| IVTNUM = 686 04190080 |
| C 04200080 |
| C TESTS 686 THRU 690 TESTS THE FUNCTION AND ARGUMENT VALUES 04210080 |
| C FROM THE EXTERNAL FUNCTION REFERENCE TO SUBPROGRAM FF083. THE 04220080 |
| C FUNCTION SUBPROGRAM IS AN IMPLICIT DEFINITION OF REAL. 04230080 |
| C 04240080 |
| C ***** TEST 686 ***** 04250080 |
| C 04260080 |
| C TEST 686 TESTS THE VALUE OF FUNCTION FF082. THE VALUE OF THE 04270080 |
| C FUNCTION SHOULD BE 921.8. 04280080 |
| C 04290080 |
| IF (ICZERO) 36860,6860,36860 04300080 |
| 6860 CONTINUE 04310080 |
| C 04320080 |
| C 04330080 |
| IVON01 = 826 04340080 |
| IADN2A (1,1) = 77 04350080 |
| IADN3A (2,3,4) = 10 04360080 |
| RVON02 = 4.4 04370080 |
| RVON03 = 0.0 04380080 |
| C 04390080 |
| RVON03 = FF083 (IVON01, IADN2A, IADN3A, RVON02 * 2.0) 04400080 |
| GO TO 46860 04410080 |
| 36860 IVDELE = IVDELE + 1 04420080 |
| WRITE (I02,80003) IVTNUM 04430080 |
| IF (ICZERO) 46860,6871,46860 04440080 |
| 46860 IF (RVON03 - 921.3) 26860,16860,46861 04450080 |
| 46861 IF (RVON03 - 922.3) 16860,16860,26860 04460080 |
| 16860 IVPASS = IVPASS + 1 04470080 |
| WRITE (I02,80001) IVTNUM 04480080 |
| GO TO 6871 04490080 |
| 26860 IVFAIL = IVFAIL + 1 04500080 |
| RVCORR = 921.8 04510080 |
| RVCOMP = RVON03 04520080 |
| WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04530080 |
| 6871 CONTINUE 04540080 |
| IVTNUM = 687 04550080 |
| C 04560080 |
| C **** TEST 687 ***** 04570080 |
| C 04580080 |
| C TEST 687 TESTS THE VALUE OF THE VARIABLE-NAME ARGUMENT IVON01 04590080 |
| C FOLLOWING THE FUNCTION REFERENCE. THE VALUE OF IVON01 SHOULD BE 04600080 |
| C 836. 04610080 |
| C 04620080 |
| IF (ICZERO) 36870,6870,36870 04630080 |
| 6870 CONTINUE 04640080 |
| GO TO 46870 04650080 |
| 36870 IVDELE = IVDELE + 1 04660080 |
| WRITE (I02,80003) IVTNUM 04670080 |
| IF (ICZERO) 46870,6881,46870 04680080 |
| 46870 IF (IVON01 - 836) 26870,16870,26870 04690080 |
| 16870 IVPASS = IVPASS + 1 04700080 |
| WRITE (I02,80001) IVTNUM 04710080 |
| GO TO 6881 04720080 |
| 26870 IVFAIL = IVFAIL + 1 04730080 |
| IVCORR = 836 04740080 |
| IVCOMP = IVON01 04750080 |
| WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04760080 |
| 6881 CONTINUE 04770080 |
| IVTNUM = 688 04780080 |
| C 04790080 |
| C **** TEST 688 ***** 04800080 |
| C 04810080 |
| C TEST 688 TESTS THE VALUE OF THE ARRAY-NAME ARGUMENT IADN2A 04820080 |
| C FOLLOWING THE FUNCTION REFERENCE. THE ACTUAL ARGUMENT WAS 04830080 |
| C INITIALIZED IN THE MAIN PROGRAM AND IS INCREMENTED IN THE 04840080 |
| C SUBPROGRAM. THE VALUE OF IADN2A (1,1) SHOULD BE 97. 04850080 |
| C 04860080 |
| IF (ICZERO) 36880,6880,36880 04870080 |
| 6880 CONTINUE 04880080 |
| GO TO 46880 04890080 |
| 36880 IVDELE = IVDELE + 1 04900080 |
| WRITE (I02,80003) IVTNUM 04910080 |
| IF (ICZERO) 46880,6880,46880 04920080 |
| 46880 IF (IADN2A (1,1) - 97) 26880,16880,26880 04930080 |
| 16880 IVPASS = IVPASS + 1 04940080 |
| WRITE (I02,80001) IVTNUM 04950080 |
| GO TO 6891 04960080 |
| 26880 IVFAIL = IVFAIL + 1 04970080 |
| IVCORR = 97 04980080 |
| IVCOMP = IADN2A (1,1) 04990080 |
| WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05000080 |
| 6891 CONTINUE 05010080 |
| IVTNUM = 689 05020080 |
| C 05030080 |
| C **** TEST 689 **** 05040080 |
| C 05050080 |
| C TEST 689 TESTS THE VALUE OF THE ARRAY-ELEMENT-NAME ARGUMENT 05060080 |
| C IADN3A FOLLOWING THE FUNCTION REFERENCE. IADN3A (2,3,4) 05070080 |
| C WAS INTIALIZED IN THE MAIN PROGRAM AND INCREMENTED BY 40 IN THE 05080080 |
| C FUNCTION SUBPROGRAM. THE VALUE OF IADN3A SHOULD BE 50. 05090080 |
| C 05100080 |
| IF (ICZERO) 36890,6890,36890 05110080 |
| 6890 CONTINUE 05120080 |
| GO TO 46890 05130080 |
| 36890 IVDELE = IVDELE + 1 05140080 |
| WRITE (I02,80003) IVTNUM 05150080 |
| IF (ICZERO) 46890,6901,46890 05160080 |
| 46890 IF (IADN3A (2,3,4) - 50) 26890,16890,26890 05170080 |
| 16890 IVPASS = IVPASS + 1 05180080 |
| WRITE (I02,80001) IVTNUM 05190080 |
| GO TO 6901 05200080 |
| 26890 IVFAIL = IVFAIL + 1 05210080 |
| IVCORR = 50 05220080 |
| IVCOMP = IADN3A (2,3,4) 05230080 |
| WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 05240080 |
| 6901 CONTINUE 05250080 |
| IVTNUM = 690 05260080 |
| C 05270080 |
| C **** TEST 690 **** 05280080 |
| C 05290080 |
| C TEST 690 TESTS THE RESULTANT VALUE WHERE THE FUNCTION 05300080 |
| C SUBPROGRAM IS IMPLICITY DEFINED AS REAL AND THE VARIABLE 05310080 |
| C TO WHICH THE FUNCTION VALUE IS ASSIGNED IN THE MAIN PROGRAM 05320080 |
| C IS DEFINED AS INTEGER. THE VALUE OF IVON03 SHOULD BE 329. 05330080 |
| C 05340080 |
| IF (ICZERO) 36900,6900,36900 05350080 |
| 6900 CONTINUE 05360080 |
| IVON01 = 226 05370080 |
| IADN2A (1,1) = 66 05380080 |
| IADN3A (2,3,4) = 20 05390080 |
| RVON02 = 8.8 05400080 |
| IVON03 = 0 05410080 |
| C 05420080 |
| IVON03 = FF083 (IVON01,IADN2A,IADN3A,RVON02 * 2.0) 05430080 |
| C 05440080 |
| GO TO 46900 05450080 |
| 36900 IVDELE = IVDELE + 1 05460080 |
| WRITE (I02,80003) IVTNUM 05470080 |
| IF (ICZERO) 46900,6911,46900 05480080 |
| 46900 IF (IVON03 - 329) 26900,16900,26900 05490080 |
| 16900 IVPASS = IVPASS + 1 05500080 |
| WRITE (I02,80001) IVTNUM 05510080 |
| GO TO 6911 05520080 |
| 26900 IVFAIL = IVFAIL + 1 05530080 |
| IVCORR = 329 05540080 |
| IVCOMP = IVON03 05550080 |
| WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05560080 |
| 6911 CONTINUE 05570080 |
| C 05580080 |
| C WRITE PAGE FOOTINGS AND RUN SUMMARIES 05590080 |
| 99999 CONTINUE 05600080 |
| WRITE (I02,90002) 05610080 |
| WRITE (I02,90006) 05620080 |
| WRITE (I02,90002) 05630080 |
| WRITE (I02,90002) 05640080 |
| WRITE (I02,90007) 05650080 |
| WRITE (I02,90002) 05660080 |
| WRITE (I02,90008) IVFAIL 05670080 |
| WRITE (I02,90009) IVPASS 05680080 |
| WRITE (I02,90010) IVDELE 05690080 |
| C 05700080 |
| C 05710080 |
| C TERMINATE ROUTINE EXECUTION 05720080 |
| STOP 05730080 |
| C 05740080 |
| C FORMAT STATEMENTS FOR PAGE HEADERS 05750080 |
| 90000 FORMAT ("1") 05760080 |
| 90002 FORMAT (" ") 05770080 |
| 90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05780080 |
| 90003 FORMAT (" ",21X,"VERSION 2.1" ) 05790080 |
| 90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 05800080 |
| 90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 05810080 |
| 90006 FORMAT (" ",5X,"----------------------------------------------" ) 05820080 |
| 90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 05830080 |
| C 05840080 |
| C FORMAT STATEMENTS FOR RUN SUMMARIES 05850080 |
| 90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 05860080 |
| 90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 05870080 |
| 90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 05880080 |
| C 05890080 |
| C FORMAT STATEMENTS FOR TEST RESULTS 05900080 |
| 80001 FORMAT (" ",4X,I5,7X,"PASS") 05910080 |
| 80002 FORMAT (" ",4X,I5,7X,"FAIL") 05920080 |
| 80003 FORMAT (" ",4X,I5,7X,"DELETED") 05930080 |
| 80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 05940080 |
| 80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 05950080 |
| C 05960080 |
| 90007 FORMAT (" ",20X,"END OF PROGRAM FM080" ) 05970080 |
| END 05980080 |
| |
| INTEGER FUNCTION FF081 (IDON01, IDDN10, IDDN20, IDON02) 00010081 |
| C 00020081 |
| C COMMENT SECTION 00030081 |
| C 00040081 |
| C FF081 00050081 |
| C 00060081 |
| C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080. 00070081 |
| C THE FUNCTION DUMMY ARGUMENTS IDON01, IDDN10 AND IDDN20 ARE 00080081 |
| C INCREMENTED BY 2, 40 AND 70 RESPECTIVELY BEFORE CONTROL IS 00090081 |
| C RETURNED TO THE CALLING PROGRAM. VALUE OF THE FUNCTION WILL BE 00100081 |
| C THE SUM OF THE ACTUAL ARGUMENTS AS PASSED FROM CALLING PROGRAM. 00110081 |
| C 00120081 |
| C REFERENCES 00130081 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140081 |
| C X3.9-1978 00150081 |
| C 00160081 |
| C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00170081 |
| C 00180081 |
| C TEST SECTION 00190081 |
| C 00200081 |
| C FUNCTION SUBPROGRAM 00210081 |
| C 00220081 |
| DIMENSION IDDN10 (5), IDDN20 (4,4) 00230081 |
| IVON01 = IDON01 00240081 |
| IVON02 = IDDN10(2) 00250081 |
| IVON03 = IDDN20(1,3) 00260081 |
| IVON04 = IDON02 00270081 |
| C 00280081 |
| FF081 = IVON01 + IVON02 + IVON03 + IVON04 00290081 |
| IDON01 = IVON01 + 2 00300081 |
| IDDN10 (2) = IVON02 + 40 00310081 |
| IDDN20 (1,3) = IVON03 + 70 00320081 |
| IDDN10 (4) = IVON02 + 40 00330081 |
| RETURN 00340081 |
| END 00350081 |
| |
| REAL FUNCTION FF082 (RDON01, RDDN3A, RDDN1A, RDON02) 00010082 |
| DIMENSION RDDN3A (3,6,3), RDDN1A (10) 00020082 |
| C 00030082 |
| C COMMENT SECTION 00040082 |
| C 00050082 |
| C FF082 00060082 |
| C 00070082 |
| C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080. 00080082 |
| C THE FUNCTION DUMMY ARGUMENTS RDON01, RDDN3A, AND RDDN1A ARE 00090082 |
| C INCREMENTED BY 6.4, 12.2 AND 18.8 RESPECTIVELY BEFORE CONTROL IS 00100082 |
| C RETURNED TO THE MAIN PROGRAM. VALUE OF THE FUNCTION WILL BE 00110082 |
| C THE SUM OF THE ACTUAL ARGUMENTS AS PASSED TO THE SUBPROGRAM. 00120082 |
| C 00130082 |
| C REFERENCES 00140082 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150082 |
| C X3.9-1978 00160082 |
| C 00170082 |
| C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00180082 |
| C 00190082 |
| C TEST SECTION 00200082 |
| C 00210082 |
| C FUNCTION SUBPROGRAM 00220082 |
| C 00230082 |
| RVON01 = RDON01 00240082 |
| RVON02 = RDDN3A (2,5,2) 00250082 |
| RVON03 = RDDN1A (5) 00260082 |
| RVON04 = RDON02 00270082 |
| C 00280082 |
| FF082 = RVON01 + RVON02 + RVON03 + RVON04 00290082 |
| C 00300082 |
| RDON01 = RVON01 + 6.4 00310082 |
| RDDN3A (2,5,2) = RVON02 + 12.2 00320082 |
| RDDN1A (5) = RVON03 + 18.8 00330082 |
| RDDN3A (1,2,1) = 600.0 + 12.2 00340082 |
| RETURN 00350082 |
| END 00360082 |
| |
| FUNCTION FF083 (IDON01,IDDN2A,IDDN3A,RDON02) 00010083 |
| DIMENSION IDDN2A (2,2), IDDN3A(3,4,5) 00020083 |
| C 00030083 |
| C COMMENT SECTION 00040083 |
| C 00050083 |
| C FF083 00060083 |
| C 00070083 |
| C THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM080. 00080083 |
| C THE TYPE DECLARATION IS IMPLICIT REAL. 00090083 |
| C THE FUNCTION DUMMY ARGUMENTS ARE BOTH INTEGER AND REAL. DUMMY 00100083 |
| C ARGUMENTS IDON01, IDDN2A AND IDDN3A ARE INCREMENTED BY 10, 20 AND 00110083 |
| C 40 RESPECTIVELY BEFORE CONTROL IS RETURNED TO THE MAIN PROGRAM. 00120083 |
| C THE VALUE OF THE FUNCTION RETURNED TO THE REFERENCING PROGRAM 00130083 |
| C WILL BE THE SUM OF THE ACTUAL ARGUMENTS AS PASSED TO THE 00140083 |
| C SUBPROGRAM FF083. 00150083 |
| C DUMMY ARGUMENT IDDN2A CORRESPONDS TO AN ARRAY-NAME IN THE 00160083 |
| C ACTUAL ARGUMENT OF THE MAIN PROGRAM. DUMMY ARGUMENT IDDN3A 00170083 |
| C CORRESPONDS TO AN ARRAY-ELEMENT-NAME IN THE ACTUAL ARGUMENT OF THE00180083 |
| C MAIN PROGRAM. DUMMY ARGUMENT IDON02 CORRESPONDS TO AN EXPRESSION00190083 |
| C CONTAINING VARIABLES,ARITHMETIC OPERATORS AND CONSTANTS IN THE 00200083 |
| C ACTUAL ARGUMENT OF THE MAIN PROGRAM. 00210083 |
| C 00220083 |
| C REFERENCES 00230083 |
| C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00240083 |
| C X3.9-1978 00250083 |
| C 00260083 |
| C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS 00270083 |
| C SECTION 15.5.1, FUNCTION SUBPROGRAM 00280083 |
| C 00290083 |
| C TEST SECTION 00300083 |
| C 00310083 |
| C FUNCTION SUBPROGRAM 00320083 |
| C 00330083 |
| IVON01 = IDON01 00340083 |
| IVON02 = IDDN2A (1,1) 00350083 |
| IVON03 = IDDN3A (2,3,4) 00360083 |
| RVON04 = RDON02 00370083 |
| C 00380083 |
| RVON05 = IVON01 + IVON02 + IVON03 00390083 |
| FF083 = RVON05 + RVON04 00400083 |
| C 00410083 |
| IDON01 = IVON01 + 10 00420083 |
| IDDN2A (1,1) = IVON02 + 20 00430083 |
| IDDN3A (2,3,4) = IVON03 + 40 00440083 |
| C 00450083 |
| RETURN 00460083 |
| END 00470083 |
