FM026.f Source File


Contents

Source Code


Source Code

      PROGRAM FM026

C     COMMENT SECTION                                                   00010026
C                                                                       00020026
C     FM026                                                             00030026
C                                                                       00040026
C         THIS ROUTINE CONTAINS THE BASIC SUBROUTINE REFERENCE TESTS.   00050026
C     THE SUBROUTINE FS027 IS CALLED BY THIS PROGRAM.  THE SUBROUTINE   00060026
C     FS027 INCREMENTS THE CALLING ARGUMENT BY 1 AND RETURNS TO THE     00070026
C     CALLING PROGRAM.                                                  00080026
C                                                                       00090026
C         EXECUTION OF A SUBROUTINE REFERENCE RESULTS IN AN ASSOCIATION 00100026
C     OF ACTUAL ARGUMENTS WITH ALL APPEARANCES OF DUMMY ARGUMENTS IN    00110026
C     THE DEFINING SUBPROGRAM.  FOLLOWING THESE ASSOCIATIONS, EXECUTION 00120026
C     OF THE FIRST EXECUTABLE STATEMENT OF THE DEFINING SUBPROGRAM      00130026
C     IS UNDERTAKEN.                                                    00140026
C                                                                       00150026
C      REFERENCES                                                       00160026
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00170026
C              X3.9-1978                                                00180026
C                                                                       00190026
C        SECTION 15.6.2, SUBROUTINE REFERENCE                           00200026
C                                                                       00210026
C      **********************************************************       00220026
C                                                                       00230026
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00240026
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00250026
C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00260026
C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00270026
C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00280026
C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00290026
C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00300026
C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00310026
C     OF EXECUTING THESE TESTS.                                         00320026
C                                                                       00330026
C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00340026
C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00350026
C                                                                       00360026
C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00370026
C                                                                       00380026
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00390026
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00400026
C                          BUILDING 225  RM A266                        00410026
C                         GAITHERSBURG, MD  20899                       00420026
C      **********************************************************       00430026
C                                                                       00440026
C                                                                       00450026
C                                                                       00460026
C     INITIALIZATION SECTION                                            00470026
C                                                                       00480026
C     INITIALIZE CONSTANTS                                              00490026
C      **************                                                   00500026
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00510026
      I01 = 5                                                           00520026
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00530026
      I02 = 6                                                           00540026
C     SYSTEM ENVIRONMENT SECTION                                        00550026
C                                                                       00560026
CX010    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00570026
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00580026
C     (UNIT NUMBER FOR CARD READER).                                    00590026
CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00600026
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00610026
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         00620026
C                                                                       00630026
CX020    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00640026
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      00650026
C     (UNIT NUMBER FOR PRINTER).                                        00660026
CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00670026
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00680026
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         00690026
C                                                                       00700026
      IVPASS=0                                                          00710026
      IVFAIL=0                                                          00720026
      IVDELE=0                                                          00730026
      ICZERO=0                                                          00740026
C                                                                       00750026
C     WRITE PAGE HEADERS                                                00760026
      WRITE (I02,90000)                                                 00770026
      WRITE (I02,90001)                                                 00780026
      WRITE (I02,90002)                                                 00790026
      WRITE (I02, 90002)                                                00800026
      WRITE (I02,90003)                                                 00810026
      WRITE (I02,90002)                                                 00820026
      WRITE (I02,90004)                                                 00830026
      WRITE (I02,90002)                                                 00840026
      WRITE (I02,90011)                                                 00850026
      WRITE (I02,90002)                                                 00860026
      WRITE (I02,90002)                                                 00870026
      WRITE (I02,90005)                                                 00880026
      WRITE (I02,90006)                                                 00890026
      WRITE (I02,90002)                                                 00900026
C                                                                       00910026
C     TEST SECTION                                                      00920026
C                                                                       00930026
C         SUBROUTINE REFERENCE - CALL                                   00940026
C                                                                       00950026
      IVTNUM = 666                                                      00960026
C                                                                       00970026
C      ****  TEST 666  ****                                             00980026
C     SUBROUTINE CALL - ARGUMENT NAME SAME AS SUBROUTINE ARGUMENT NAME. 00990026
C                                                                       01000026
      IF (ICZERO) 36660, 6660, 36660                                    01010026
 6660 CONTINUE                                                          01020026
      IVON01 = 0                                                        01030026
      CALL FS027(IVON01)                                                01040026
      IVCOMP = IVON01                                                   01050026
      GO TO 46660                                                       01060026
36660 IVDELE = IVDELE + 1                                               01070026
      WRITE (I02,80003) IVTNUM                                          01080026
      IF (ICZERO) 46660, 6671, 46660                                    01090026
46660 IF (IVCOMP - 1) 26660,16660,26660                                 01100026
16660 IVPASS = IVPASS + 1                                               01110026
      WRITE (I02,80001) IVTNUM                                          01120026
      GO TO 6671                                                        01130026
26660 IVFAIL = IVFAIL + 1                                               01140026
      IVCORR = 1                                                        01150026
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01160026
 6671 CONTINUE                                                          01170026
      IVTNUM = 667                                                      01180026
C                                                                       01190026
C      ****  TEST 667  ****                                             01200026
C     SUBROUTINE CALL - ARGUMENT NAME SAME AS INTERNAL VARIABLE IN      01210026
C         SUBROUTINE.                                                   01220026
C                                                                       01230026
      IF (ICZERO) 36670, 6670, 36670                                    01240026
 6670 CONTINUE                                                          01250026
      IVON02 = 2                                                        01260026
      CALL FS027(IVON02)                                                01270026
      IVCOMP = IVON02                                                   01280026
      GO TO 46670                                                       01290026
36670 IVDELE = IVDELE + 1                                               01300026
      WRITE (I02,80003) IVTNUM                                          01310026
      IF (ICZERO) 46670, 6681, 46670                                    01320026
46670 IF (IVCOMP - 3) 26670,16670,26670                                 01330026
16670 IVPASS = IVPASS + 1                                               01340026
      WRITE (I02,80001) IVTNUM                                          01350026
      GO TO 6681                                                        01360026
26670 IVFAIL = IVFAIL + 1                                               01370026
      IVCORR = 3                                                        01380026
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01390026
 6681 CONTINUE                                                          01400026
      IVTNUM = 668                                                      01410026
C                                                                       01420026
C      ****  TEST 668  ****                                             01430026
C     SUBROUTINE CALL - ARGUMENT NAME DIFFERENT FROM SUBROUTINE ARGUMENT01440026
C         AND INTERNAL VARIABLE.                                        01450026
C                                                                       01460026
      IF (ICZERO) 36680, 6680, 36680                                    01470026
 6680 CONTINUE                                                          01480026
      IVON01 = 7                                                        01490026
      IVON03 = -12                                                      01500026
      CALL FS027(IVON03)                                                01510026
      IVCOMP = IVON03                                                   01520026
      GO TO 46680                                                       01530026
36680 IVDELE = IVDELE + 1                                               01540026
      WRITE (I02,80003) IVTNUM                                          01550026
      IF (ICZERO) 46680, 6691, 46680                                    01560026
46680 IF (IVCOMP + 11 ) 26680,16680,26680                               01570026
16680 IVPASS = IVPASS + 1                                               01580026
      WRITE (I02,80001) IVTNUM                                          01590026
      GO TO 6691                                                        01600026
26680 IVFAIL = IVFAIL + 1                                               01610026
      IVCORR = -11                                                      01620026
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01630026
 6691 CONTINUE                                                          01640026
      IVTNUM = 669                                                      01650026
C                                                                       01660026
C      ****  TEST 669  ****                                             01670026
C     REPEATED SUBROUTINE CALLS IN A DO LOOP.                           01680026
C                                                                       01690026
      IF (ICZERO) 36690, 6690, 36690                                    01700026
 6690 CONTINUE                                                          01710026
      IVCOMP = 0                                                        01720026
      DO 6692 IVON04 = 1,5                                              01730026
      CALL FS027 (IVCOMP)                                               01740026
 6692 CONTINUE                                                          01750026
      GO TO 46690                                                       01760026
36690 IVDELE = IVDELE + 1                                               01770026
      WRITE (I02,80003) IVTNUM                                          01780026
      IF (ICZERO) 46690, 6701, 46690                                    01790026
46690 IF (IVCOMP - 5) 26690,16690,26690                                 01800026
16690 IVPASS = IVPASS + 1                                               01810026
      WRITE (I02,80001) IVTNUM                                          01820026
      GO TO 6701                                                        01830026
26690 IVFAIL = IVFAIL + 1                                               01840026
      IVCORR = 5                                                        01850026
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01860026
C      ****     END OF TESTS   ****                                     01870026
 6701 CONTINUE                                                          01880026
C                                                                       01890026
C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             01900026
99999 CONTINUE                                                          01910026
      WRITE (I02,90002)                                                 01920026
      WRITE (I02,90006)                                                 01930026
      WRITE (I02,90002)                                                 01940026
      WRITE (I02,90002)                                                 01950026
      WRITE (I02,90007)                                                 01960026
      WRITE (I02,90002)                                                 01970026
      WRITE (I02,90008)  IVFAIL                                         01980026
      WRITE (I02,90009) IVPASS                                          01990026
      WRITE (I02,90010) IVDELE                                          02000026
C                                                                       02010026
C                                                                       02020026
C     TERMINATE ROUTINE EXECUTION                                       02030026
      STOP                                                              02040026
C                                                                       02050026
C     FORMAT STATEMENTS FOR PAGE HEADERS                                02060026
90000 FORMAT ("1")                                                      02070026
90002 FORMAT (" ")                                                      02080026
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            02090026
90003 FORMAT (" ",21X,"VERSION 2.1" )                                   02100026
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )        02110026
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 02120026
90006 FORMAT (" ",5X,"----------------------------------------------" ) 02130026
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             02140026
C                                                                       02150026
C     FORMAT STATEMENTS FOR RUN SUMMARIES                               02160026
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" )                        02170026
90009 FORMAT (" ",15X,I5," TESTS PASSED" )                              02180026
90010 FORMAT (" ",15X,I5," TESTS DELETED" )                             02190026
C                                                                       02200026
C     FORMAT STATEMENTS FOR TEST RESULTS                                02210026
80001 FORMAT (" ",4X,I5,7X,"PASS")                                      02220026
80002 FORMAT (" ",4X,I5,7X,"FAIL")                                      02230026
80003 FORMAT (" ",4X,I5,7X,"DELETED")                                   02240026
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         02250026
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    02260026
C                                                                       02270026
90007 FORMAT (" ",20X,"END OF PROGRAM FM026" )                          02280026
      END                                                               02290026

      SUBROUTINE FS027(IVON01)                                          00010027
C     COMMENT SECTION                                                   00020027
C                                                                       00030027
C     FS027                                                             00040027
C                                                                       00050027
C         THIS SUBROUTINE IS CALLED BY THE MAIN PROGRAM FM026.  THE     00060027
C     SUBROUTINE ARGUMENT IS INCREMENTED BY 1 AND CONTROL RETURNED      00070027
C     TO THE CALLING PROGRAM.                                           00080027
C                                                                       00090027
C      REFERENCES                                                       00100027
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00110027
C              X3.9-1978                                                00120027
C                                                                       00130027
C        SECTION 15.6, SUBROUTINES                                      00140027
C        SECTION 15.8, RETURN STATEMENT                                 00150027
C                                                                       00160027
C     TEST SECTION                                                      00170027
C                                                                       00180027
C         SUBROUTINE SUBPROGRAM                                         00190027
C                                                                       00200027
C     INCREMENT ARGUMENT BY 1 AND RETURN TO CALLING PROGRAM.            00210027
C                                                                       00220027
      IVON02 = IVON01                                                   00230027
      IVON02 = IVON02 + 1                                               00240027
      IVON01 = IVON02                                                   00250027
      IVON02 = 300                                                      00260027
      RETURN                                                            00270027
      END                                                               00280027