FM011.f Source File


Contents

Source Code


Source Code

      PROGRAM FM011

C      COMMENT SECTION.                                                 00010011
C                                                                       00020011
C      FM011                                                            00030011
C                                                                       00040011
C     THIS ROUTINE IS A TEST OF BLANK CHARACTERS (SECTION 3.1.6)        00050011
C         WHICH SHOULD HAVE NO MEANING WHEN EMBEDDED IN FORTRAN RESERVED00060011
C         WORDS.                                                        00070011
C      REFERENCES                                                       00080011
C        AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN,       00090011
C              X3.9-1978                                                00100011
C                                                                       00110011
C        SECTION 3.1.6, BLANK CHARACTER                                 00120011
      DIM EN SION  IADN11(3),IADN12(3)                                  00130011
      IN TEGER  RVTNI1                                                  00140011
      REA  L   IVTNR1                                                   00150011
      LOG  ICAL   LVTNL1,LVTNL2                                         00160011
      COM  MON  IACE11(3)                                               00170011
      EQU IVAL ENCE  (IACE11(1),IADN11(1))                              00180011
      D   A  T  A   IADN12/3*3/                                         00190011
C                                                                       00200011
C      **********************************************************       00210011
C                                                                       00220011
C         A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE         00230011
C     BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD  00240011
C     PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00250011
C     FEDERAL COBOL COMPILER TESTING SERVICE.  THE FORTRAN COMPILER     00260011
C     VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00270011
C     DATA, AND AN EXECUTIVE SYSTEM.  EACH AUDIT ROUTINE IS A FORTRAN   00280011
C     PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC  00290011
C     LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00300011
C     OF EXECUTING THESE TESTS.                                         00310011
C                                                                       00320011
C         THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00330011
C     FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978.                 00340011
C                                                                       00350011
C         SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO -             00360011
C                                                                       00370011
C              NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY           00380011
C                   SOFTWARE STANDARDS VALIDATION GROUP                 00390011
C                          BUILDING 225  RM A266                        00400011
C                         GAITHERSBURG, MD  20899                       00410011
C      **********************************************************       00420011
C                                                                       00430011
C                                                                       00440011
C                                                                       00450011
C     INITIALIZATION SECTION                                            00460011
C                                                                       00470011
C     INITIALIZE CONSTANTS                                              00480011
C      **************                                                   00490011
C     I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER.         00500011
      I01 = 5                                                           00510011
C     I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER.             00520011
      I02 = 6                                                           00530011
C     SYSTEM ENVIRONMENT SECTION                                        00540011
C                                                                       00550011
CX010    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00560011
C     THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5      00570011
C     (UNIT NUMBER FOR CARD READER).                                    00580011
CX011    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00590011
C     THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00600011
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE.         00610011
C                                                                       00620011
CX020    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00630011
C     THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6      00640011
C     (UNIT NUMBER FOR PRINTER).                                        00650011
CX021    THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00660011
C     THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL            00670011
C     FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE.         00680011
C                                                                       00690011
      IVPASS=0                                                          00700011
      IVFAIL=0                                                          00710011
      IVDELE=0                                                          00720011
      ICZERO=0                                                          00730011
C                                                                       00740011
C     WRITE PAGE HEADERS                                                00750011
      WRITE (I02,90000)                                                 00760011
      WRITE (I02,90001)                                                 00770011
      WRITE (I02,90002)                                                 00780011
      WRITE (I02, 90002)                                                00790011
      WRITE (I02,90003)                                                 00800011
      WRITE (I02,90002)                                                 00810011
      WRITE (I02,90004)                                                 00820011
      WRITE (I02,90002)                                                 00830011
      WRITE (I02,90011)                                                 00840011
      WRITE (I02,90002)                                                 00850011
      WRITE (I02,90002)                                                 00860011
      WRITE (I02,90005)                                                 00870011
      WRITE (I02,90006)                                                 00880011
      WRITE (I02,90002)                                                 00890011
      IVTNUM = 103                                                      00900011
C                                                                       00910011
C      ****  TEST  103  ****                                            00920011
C     TEST 103  -  THIS TEST HAS BLANKS EMBEDDED IN A DIMENSION         00930011
C           STATEMENT.  ALSO THE DO STATEMENT WITH AN EMBEDDED BLANK    00940011
C           WILL BE TESTED TO INITIALIZE VALUES IN AN ARRAY.  THE       00950011
C           CONTINUE AND IF STATEMENTS HAVE EMBEDDED BLANKS AS WELL.    00960011
C                                                                       00970011
      IF (ICZERO) 31030, 1030, 31030                                    00980011
 1030 CONTINUE                                                          00990011
      D O  1  IVON01 =1 , 3 ,  1                                        01000011
      IADN11(IVON01) = IVON01                                           01010011
    1 C ON T IN UE                                                      01020011
      GO TO 41030                                                       01030011
31030 IVDELE = IVDELE + 1                                               01040011
      WRITE (I02,80003) IVTNUM                                          01050011
      IF (ICZERO) 41030, 1041, 41030                                    01060011
41030 I   F  (IADN11(2) - 2)  21030,11030,21030                         01070011
11030 IVPASS = IVPASS + 1                                               01080011
      WRITE (I02,80001) IVTNUM                                          01090011
      GO TO 1041                                                        01100011
21030 IVFAIL = IVFAIL + 1                                               01110011
      IVCOMP = IADN11(2)                                                01120011
      IVCORR = 2                                                        01130011
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01140011
 1041 CONTINUE                                                          01150011
      IVTNUM = 104                                                      01160011
C                                                                       01170011
C      ****  TEST  104  ****                                            01180011
C     TEST 104  -  THIS TESTS EMBEDDED BLANKS IN AN INTEGER TYPE        01190011
C           STATEMENT.  FRACTION 1/2 SHOULD BECOME 0 AS AN INTEGER.     01200011
C           INTEGER TO REAL * 2. BACK TO INTEGER CONVERSION SHOULD BE 0.01210011
C                                                                       01220011
      IF (ICZERO) 31040, 1040, 31040                                    01230011
 1040 CONTINUE                                                          01240011
      RVTNI1 = 2                                                        01250011
      RVON01 = 1/RVTNI1                                                 01260011
      IVON02 = RVON01 * 2.                                              01270011
      GO TO 41040                                                       01280011
31040 IVDELE = IVDELE + 1                                               01290011
      WRITE (I02,80003) IVTNUM                                          01300011
      IF (ICZERO) 41040, 1051, 41040                                    01310011
41040 IF( IVON02 - 0 ) 21040,11040,21040                                01320011
11040 IVPASS = IVPASS + 1                                               01330011
      WRITE (I02,80001) IVTNUM                                          01340011
      GO TO 1051                                                        01350011
21040 IVFAIL = IVFAIL + 1                                               01360011
      IVCOMP = IVON02                                                   01370011
      IVCORR = 0                                                        01380011
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01390011
 1051 CONTINUE                                                          01400011
      IVTNUM = 105                                                      01410011
C                                                                       01420011
C      ****  TEST  105  ****                                            01430011
C     TEST 105  -  TEST OF EMBEDDED BLANKS IN A REAL TYPE STATEMENT.    01440011
C           REAL TO REAL*2. TO INTEGER CONVERSION IS PERFORMED.  RESULT 01450011
C           IS 1 IF THE TYPE OF THE TEST VARIABLE(IVTNR1) WAS REAL.     01460011
C                                                                       01470011
      IF (ICZERO) 31050, 1050, 31050                                    01480011
 1050 CONTINUE                                                          01490011
      IVTNR1 = .5                                                       01500011
      RVON03 = IVTNR1*2.                                                01510011
      IVON03 = RVON03 +.3                                               01520011
      GO TO 41050                                                       01530011
31050 IVDELE = IVDELE + 1                                               01540011
      WRITE (I02,80003) IVTNUM                                          01550011
      IF (ICZERO) 41050, 1061, 41050                                    01560011
41050 IF(IVON03 - 1) 21050,  11050, 21050                               01570011
11050 IVPASS = IVPASS + 1                                               01580011
      WRITE (I02,80001) IVTNUM                                          01590011
      GO TO 1061                                                        01600011
21050 IVFAIL = IVFAIL + 1                                               01610011
      IVCOMP = IVON03                                                   01620011
      IVCORR = 1                                                        01630011
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          01640011
 1061 CONTINUE                                                          01650011
      IVTNUM = 106                                                      01660011
C                                                                       01670011
C      ****  TEST  106  ****                                            01680011
C     TEST 106  -  TEST THE LOGICAL TYPE WITH EMBEDDED BLANKS BY A      01690011
C           LOGIC ASSIGNMENT (V = .TRUE.) SECTION 4.7.1 AND 10.2        01700011
C                                                                       01710011
      IF (ICZERO) 31060, 1060, 31060                                    01720011
 1060 CONTINUE                                                          01730011
      LVTNL1 = .TRUE.                                                   01740011
      GO TO 41060                                                       01750011
31060 IVDELE = IVDELE + 1                                               01760011
      WRITE (I02,80003) IVTNUM                                          01770011
      IF (ICZERO) 41060, 1071, 41060                                    01780011
41060 IF(ICZERO) 21060,11060,21060                                      01790011
11060 IVPASS = IVPASS + 1                                               01800011
      WRITE (I02,80001) IVTNUM                                          01810011
      GO TO 1071                                                        01820011
21060 IVFAIL = IVFAIL + 1                                               01830011
      WRITE (I02,80002) IVTNUM, IVCOMP ,IVCORR                          01840011
 1071 CONTINUE                                                          01850011
      IVTNUM = 107                                                      01860011
C                                                                       01870011
C      ****  TEST  107  ****                                            01880011
C     TEST 107  -  A SECOND TEST OF THE LOGICAL TYPE STATEMENT WITH     01890011
C           EMBEDDED BLANKS.  THE TEST IS AGAIN MADE BY A LOGICAL       01900011
C           ASSIGNMENT (SECTION 4.7.1 AND 10.2).                        01910011
C                                                                       01920011
      IF (ICZERO) 31070, 1070, 31070                                    01930011
 1070 CONTINUE                                                          01940011
      LVTNL2 = .FALSE.                                                  01950011
      GO TO 41070                                                       01960011
31070 IVDELE = IVDELE + 1                                               01970011
      WRITE (I02,80003) IVTNUM                                          01980011
      IF (ICZERO) 41070, 1081, 41070                                    01990011
41070 IF(ICZERO) 21070,11070,21070                                      02000011
11070 IVPASS = IVPASS + 1                                               02010011
      WRITE (I02,80001) IVTNUM                                          02020011
      GO TO 1081                                                        02030011
21070 IVFAIL = IVFAIL + 1                                               02040011
      WRITE (I02,80002) IVTNUM, IVCOMP ,IVCORR                          02050011
 1081 CONTINUE                                                          02060011
      IVTNUM = 108                                                      02070011
C                                                                       02080011
C      ****  TEST  108  ****                                            02090011
C     TEST 108  -  THIS IS A TEST OF BLANKS EMBEDDED IN THE COMMON,     02100011
C           DIMENSION AND EQUIVALENCE STATEMENTS (SECTION 8.1,          02110011
C           8.3. AND 8.2.).                                             02120011
C                                                                       02130011
      IF (ICZERO) 31080, 1080, 31080                                    02140011
 1080 CONTINUE                                                          02150011
      IADN11(3) = 4                                                     02160011
      GO TO 41080                                                       02170011
31080 IVDELE = IVDELE + 1                                               02180011
      WRITE (I02,80003) IVTNUM                                          02190011
      IF (ICZERO) 41080, 1091, 41080                                    02200011
41080 IF(IACE11(3) - 4)  21080,11080,21080                              02210011
11080 IVPASS = IVPASS + 1                                               02220011
      WRITE (I02,80001) IVTNUM                                          02230011
      GO TO 1091                                                        02240011
21080 IVFAIL = IVFAIL + 1                                               02250011
      IVCOMP = IACE11(3)                                                02260011
      IVCORR = 4                                                        02270011
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02280011
 1091 CONTINUE                                                          02290011
      IVTNUM = 109                                                      02300011
C                                                                       02310011
C      ****  TEST  109  ****                                            02320011
C     TEST 109  -  THIS TESTS THE EFFECT OF BLANKS EMBEDDED IN THE      02330011
C           DATA STATEMENT BY CHECKING THE INITIALIZATION OF ARRAY      02340011
C           ELEMENT VALUES (SECTION 9).                                 02350011
C                                                                       02360011
      IF (ICZERO) 31090, 1090, 31090                                    02370011
 1090 CONTINUE                                                          02380011
      IVON04    = IADN12(1) + IADN12(2) + IADN12(3)                     02390011
      GO TO 41090                                                       02400011
31090 IVDELE = IVDELE + 1                                               02410011
      WRITE (I02,80003) IVTNUM                                          02420011
      IF (ICZERO) 41090, 1101, 41090                                    02430011
41090 IF(IVON04 - 9) 21090,11090,21090                                  02440011
11090 IVPASS = IVPASS + 1                                               02450011
      WRITE (I02,80001) IVTNUM                                          02460011
      GO TO 1101                                                        02470011
21090 IVFAIL = IVFAIL + 1                                               02480011
      IVCOMP = IVON04                                                   02490011
      IVCORR = 9                                                        02500011
      WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR                          02510011
 1101 CONTINUE                                                          02520011
C                                                                       02530011
C     WRITE PAGE FOOTINGS AND RUN SUMMARIES                             02540011
99999 CONTINUE                                                          02550011
      WRITE (I02,90002)                                                 02560011
      WRITE (I02,90006)                                                 02570011
      WRITE (I02,90002)                                                 02580011
      WRITE (I02,90002)                                                 02590011
      WRITE (I02,90007)                                                 02600011
      WRITE (I02,90002)                                                 02610011
      WRITE (I02,90008)  IVFAIL                                         02620011
      WRITE (I02,90009) IVPASS                                          02630011
      WRITE (I02,90010) IVDELE                                          02640011
C                                                                       02650011
C                                                                       02660011
C     TERMINATE ROUTINE EXECUTION                                       02670011
      STOP                                                              02680011
C                                                                       02690011
C     FORMAT STATEMENTS FOR PAGE HEADERS                                02700011
90000 FORMAT ("1")                                                      02710011
90002 FORMAT (" ")                                                      02720011
90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" )            02730011
90003 FORMAT (" ",21X,"VERSION 2.1" )                                   02740011
90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" )        02750011
90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 02760011
90006 FORMAT (" ",5X,"----------------------------------------------" ) 02770011
90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" )                             02780011
C                                                                       02790011
C     FORMAT STATEMENTS FOR RUN SUMMARIES                               02800011
90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" )                        02810011
90009 FORMAT (" ",15X,I5," TESTS PASSED" )                              02820011
90010 FORMAT (" ",15X,I5," TESTS DELETED" )                             02830011
C                                                                       02840011
C     FORMAT STATEMENTS FOR TEST RESULTS                                02850011
80001 FORMAT (" ",4X,I5,7X,"PASS")                                      02860011
80002 FORMAT (" ",4X,I5,7X,"FAIL")                                      02870011
80003 FORMAT (" ",4X,I5,7X,"DELETED")                                   02880011
80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6)                         02890011
80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5)                    02900011
C                                                                       02910011
90007 FORMAT (" ",20X,"END OF PROGRAM FM011" )                          02920011
      END                                                               02930011