FM028.f Source File


Contents

Source Code


Source Code

      PROGRAM FM028

C     COMMENT SECTION                                                   00010028
C                                                                       00020028
C     FM028                                                             00030028
C                                                                       00040028
C         THIS ROUTINE CONTAINS THE EXTERNAL FUNCTION REFERENCE TESTS.  00050028
C     THE FUNCTION SUBPROGRAM FF029 IS CALLED BY THIS PROGRAM. THE      00060028
C     FUNCTION SUBPROGRAM FF029 INCREMENTS THE CALLING ARGUMENT BY 1    00070028
C     AND RETURNS TO THE CALLING PROGRAM.                               00080028
C                                                                       00090028
C         EXECUTION OF AN EXTERNAL FUNCTION REFERENCE RESULTS IN AN     00100028
C     ASSOCIATION OF ACTUAL ARGUMENTS WITH ALL APPEARANCES OF DUMMY     00110028
C     ARGUMENTS IN THE DEFINING SUBPROGRAM.  FOLLOWING THESE            00120028
C     ASSOCIATIONS, EXECUTION OF THE FIRST EXECUTABLE STATEMENT OF THE  00130028
C     DEFINING SUBPROGRAM IS UNDERTAKEN.                                00140028
C                                                                       00150028
C      REFERENCES                                                       00160028
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00170028
C              X3.9-1978                                                00180028
C                                                                       00190028
C        SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION               00200028
C                                                                       00210028
      INTEGER FF029                                                     00220028
C                                                                       00230028
C                                                                       00240028
C      **********************************************************       00250028
C                                                                       00260028
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00270028
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00280028
C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00290028
C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00300028
C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00310028
C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00320028
C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00330028
C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00340028
C     OF EXECUTING THESE TESTS.                                         00350028
C                                                                       00360028
C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00370028
C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00380028
C                                                                       00390028
C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00400028
C                                                                       00410028
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00420028
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00430028
C                          BUILDING 225  RM A266                        00440028
C                         GAITHERSBURG, MD  20899                       00450028
C      **********************************************************       00460028
C                                                                       00470028
C                                                                       00480028
C                                                                       00490028
C     INITIALIZATION SECTION                                            00500028
C                                                                       00510028
C     INITIALIZE CONSTANTS                                              00520028
C      **************                                                   00530028
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00540028
      I01 = 5                                                           00550028
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00560028
      I02 = 6                                                           00570028
C     SYSTEM ENVIRONMENT SECTION                                        00580028
C                                                                       00590028
CX010    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00600028
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00610028
C     (UNIT NUMBER FOR CARD READER).                                    00620028
CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00630028
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00640028
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         00650028
C                                                                       00660028
CX020    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00670028
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      00680028
C     (UNIT NUMBER FOR PRINTER).                                        00690028
CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00700028
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00710028
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         00720028
C                                                                       00730028
      IVPASS=0                                                          00740028
      IVFAIL=0                                                          00750028
      IVDELE=0                                                          00760028
      ICZERO=0                                                          00770028
C                                                                       00780028
C     WRITE PAGE HEADERS                                                00790028
      WRITE (I02,90000)                                                 00800028
      WRITE (I02,90001)                                                 00810028
      WRITE (I02,90002)                                                 00820028
      WRITE (I02, 90002)                                                00830028
      WRITE (I02,90003)                                                 00840028
      WRITE (I02,90002)                                                 00850028
      WRITE (I02,90004)                                                 00860028
      WRITE (I02,90002)                                                 00870028
      WRITE (I02,90011)                                                 00880028
      WRITE (I02,90002)                                                 00890028
      WRITE (I02,90002)                                                 00900028
      WRITE (I02,90005)                                                 00910028
      WRITE (I02,90006)                                                 00920028
      WRITE (I02,90002)                                                 00930028
C                                                                       00940028
C     TEST SECTION                                                      00950028
C                                                                       00960028
C     EXTERNAL FUNCTION REFERENCE                                       00970028
C                                                                       00980028
C     EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME SAME AS SUBPROGRAM    00990028
C              ARGUMENT NAME.                                           01000028
 6701 CONTINUE                                                          01010028
      IVTNUM = 670                                                      01020028
C                                                                       01030028
C     **** TEST 670 ****                                                01040028
C                                                                       01050028
      IF (ICZERO) 36700,6700,36700                                      01060028
 6700 CONTINUE                                                          01070028
      IVON01 = 0                                                        01080028
      IVCOMP = FF029(IVON01)                                            01090028
      GO TO 46700                                                       01100028
36700 IVDELE = IVDELE + 1                                               01110028
      WRITE (I02,80003) IVTNUM                                          01120028
      IF (ICZERO) 46700,6711,46700                                      01130028
46700 IF (IVCOMP - 1) 26700,16700,26700                                 01140028
16700 IVPASS = IVPASS + 1                                               01150028
      WRITE (I02,80001) IVTNUM                                          01160028
      GO TO 6711                                                        01170028
26700 IVFAIL = IVFAIL + 1                                               01180028
      IVCORR = 1                                                        01190028
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01200028
 6711 CONTINUE                                                          01210028
      IVTNUM = 671                                                      01220028
C                                                                       01230028
C      ****  TEST 671  ****                                             01240028
C                                                                       01250028
C     EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME SAME AS INTERNAL      01260028
C           VARIABLE IN FUNCTION SUBPROGRAM.                            01270028
C                                                                       01280028
      IF (ICZERO) 36710,6710,36710                                      01290028
 6710 CONTINUE                                                          01300028
      IVON02 = 2                                                        01310028
      IVON01 = 5                                                        01320028
      IVCOMP = FF029(IVON02)                                            01330028
      GO TO 46710                                                       01340028
36710 IVDELE = IVDELE + 1                                               01350028
      WRITE (I02,80003) IVTNUM                                          01360028
      IF (ICZERO) 46710,6721,46710                                      01370028
46710 IF (IVCOMP - 3) 26710,16710,26710                                 01380028
16710 IVPASS = IVPASS + 1                                               01390028
      WRITE (I02,80001) IVTNUM                                          01400028
      GO TO 6721                                                        01410028
26710 IVFAIL = IVFAIL + 1                                               01420028
      IVCORR = 3                                                        01430028
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01440028
 6721 CONTINUE                                                          01450028
      IVTNUM = 672                                                      01460028
C                                                                       01470028
C     ****  TEST 672  ****                                              01480028
C                                                                       01490028
C     EXTERNAL FUNCTION REFERENCE - ARGUMENT NAME DIFFERENT FROM        01500028
C           FUNCTION SUBPROGRAM ARGUMENT AND INTERNAL VARIABLE.         01510028
C                                                                       01520028
      IF  (ICZERO) 36720,6720,36720                                     01530028
 6720 CONTINUE                                                          01540028
      IVON01 = 7                                                        01550028
      IVON03 = -12                                                      01560028
      IVCOMP = FF029(IVON03)                                            01570028
      GO TO 46720                                                       01580028
36720 IVDELE = IVDELE + 1                                               01590028
      WRITE (I02,80003) IVTNUM                                          01600028
      IF (ICZERO) 46720,6731,46720                                      01610028
46720 IF (IVCOMP + 11) 26720,16720,26720                                01620028
16720 IVPASS = IVPASS + 1                                               01630028
      WRITE (I02,80001) IVTNUM                                          01640028
      GO TO 6731                                                        01650028
26720 IVFAIL = IVFAIL + 1                                               01660028
      IVCORR = -11                                                      01670028
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01680028
 6731 CONTINUE                                                          01690028
      IVTNUM = 673                                                      01700028
C                                                                       01710028
C      **** TEST 673  ****                                              01720028
C                                                                       01730028
C     REPEATED EXTERNAL FUNCTION REFERENCE IN A DO LOOP.                01740028
C                                                                       01750028
      IF (ICZERO) 36730,6730,36730                                      01760028
 6730 CONTINUE                                                          01770028
      IVON01 = -7                                                       01780028
      IVCOMP = 0                                                        01790028
      DO 6732 IVON04 = 1,5                                              01800028
      IVCOMP = FF029(IVCOMP)                                            01810028
 6732 CONTINUE                                                          01820028
      GO TO 46730                                                       01830028
36730 IVDELE = IVDELE + 1                                               01840028
      WRITE (I02,80003) IVTNUM                                          01850028
      IF (ICZERO) 46730,6741,46730                                      01860028
46730 IF (IVCOMP - 5) 26730,16730,26730                                 01870028
16730 IVPASS = IVPASS + 1                                               01880028
      WRITE (I02,80001) IVTNUM                                          01890028
      GO TO 6741                                                        01900028
26730 IVFAIL = IVFAIL + 1                                               01910028
      IVCORR = 5                                                        01920028
      WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR                          01930028
 6741 CONTINUE                                                          01940028
C                                                                       01950028
C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             01960028
99999 CONTINUE                                                          01970028
      WRITE (I02,90002)                                                 01980028
      WRITE (I02,90006)                                                 01990028
      WRITE (I02,90002)                                                 02000028
      WRITE (I02,90002)                                                 02010028
      WRITE (I02,90007)                                                 02020028
      WRITE (I02,90002)                                                 02030028
      WRITE (I02,90008)  IVFAIL                                         02040028
      WRITE (I02,90009) IVPASS                                          02050028
      WRITE (I02,90010) IVDELE                                          02060028
C                                                                       02070028
C                                                                       02080028
C     TERMINATE ROUTINE EXECUTION                                       02090028
      STOP                                                              02100028
C                                                                       02110028
C     FORMAT STATEMENTS FOR PAGE HEADERS                                02120028
90000 FORMAT ("1")                                                      02130028
90002 FORMAT (" ")                                                      02140028
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            02150028
90003 FORMAT (" ",21X,"VERSION 2.1" )                                   02160028
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )        02170028
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 02180028
90006 FORMAT (" ",5X,"----------------------------------------------" ) 02190028
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             02200028
C                                                                       02210028
C     FORMAT STATEMENTS FOR RUN SUMMARIES                               02220028
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" )                        02230028
90009 FORMAT (" ",15X,I5," TESTS PASSED" )                              02240028
90010 FORMAT (" ",15X,I5," TESTS DELETED" )                             02250028
C                                                                       02260028
C     FORMAT STATEMENTS FOR TEST RESULTS                                02270028
80001 FORMAT (" ",4X,I5,7X,"PASS")                                      02280028
80002 FORMAT (" ",4X,I5,7X,"FAIL")                                      02290028
80003 FORMAT (" ",4X,I5,7X,"DELETED")                                   02300028
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         02310028
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    02320028
C                                                                       02330028
90007 FORMAT (" ",20X,"END OF PROGRAM FM028" )                          02340028
      END                                                               02350028

      INTEGER FUNCTION FF029(IVON01)                                    00010029
C                                                                       00020029
C     COMMENT SECTION                                                   00030029
C     FF029                                                             00040029
C                                                                       00050029
C         THIS FUNCTION SUBPROGRAM IS CALLED BY THE MAIN PROGRAM FM028. 00060029
C     THE FUNCTION ARGUMENT IS INCREMENTED BY 1 AND CONTROL RETURNED    00070029
C     TO THE CALLING PROGRAM.                                           00080029
C                                                                       00090029
C      REFERENCES                                                       00100029
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00110029
C              X3.9-1978                                                00120029
C                                                                       00130029
C        SECTION 15.5.1, DEFINING FUNCTION SUBPROGRAMS AND FUNCTION     00140029
C                        STATEMENTS                                     00150029
C        SECTION 15.8, RETURN STATEMENT                                 00160029
C                                                                       00170029
C     TEST SECTION                                                      00180029
C                                                                       00190029
C          FUNCTION SUBPROGRAM                                          00200029
C                                                                       00210029
C     INCREMENT ARGUMENT BY 1 AND RETURN TO CALLING PROGRAM.            00220029
C                                                                       00230029
      IVON02 = IVON01                                                   00240029
      FF029  = IVON02 + 1                                               00250029
      IVON02 = 500                                                      00260029
      RETURN                                                            00270029
      END                                                               00280029