diff --git a/Fortran/UnitTests/CMakeLists.txt b/Fortran/UnitTests/CMakeLists.txt --- a/Fortran/UnitTests/CMakeLists.txt +++ b/Fortran/UnitTests/CMakeLists.txt @@ -1,2 +1,3 @@ # This file should only contain add_subdirectory(...) one for each test add_subdirectory(hello) +add_subdirectory(fcvs21_f95) # NIST Fortran Compiler Validation Suite diff --git a/Fortran/UnitTests/fcvs21_f95/CMakeLists.txt b/Fortran/UnitTests/fcvs21_f95/CMakeLists.txt new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/CMakeLists.txt @@ -0,0 +1,45 @@ +# NIST Fortran 77 Test Suite +# http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html +# +# Reference results generated with gfortran -v: +# Using built-in specs. +# COLLECT_GCC=gfortran +# COLLECT_LTO_WRAPPER=/usr/lib/gcc/x86_64-linux-gnu/7/lto-wrapper +# OFFLOAD_TARGET_NAMES=nvptx-none +# OFFLOAD_TARGET_DEFAULT=1 +# Target: x86_64-linux-gnu +# Configured with: ../src/configure -v --with-pkgversion='Ubuntu 7.5.0-3ubuntu1~18.04' --with-bugurl=file:///usr/share/doc/gcc-7/README.Bugs --enable-languages=c,ada,c++,go,brig,d,fortran,objc,obj-c++ --prefix=/usr --with-gcc-major-version-only --program-suffix=-7 --program-prefix=x86_64-linux-gnu- --enable-shared --enable-linker-build-id --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --libdir=/usr/lib --enable-nls --enable-bootstrap --enable-clocale=gnu --enable-libstdcxx-debug --enable-libstdcxx-time=yes --with-default-libstdcxx-abi=new --enable-gnu-unique-object --disable-vtable-verify --enable-libmpx --enable-plugin --enable-default-pie --with-system-zlib --with-target-system-zlib --enable-objc-gc=auto --enable-multiarch --disable-werror --with-arch-32=i686 --with-abi=m64 --with-multilib-list=m32,m64,mx32 --enable-multilib --with-tune=generic --enable-offload-targets=nvptx-none --without-cuda-driver --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu +# Thread model: posix +# gcc version 7.5.0 (Ubuntu 7.5.0-3ubuntu1~18.04) +# +# See additional comments in `driver_run` script should reference +# results ever need to be updated. +# +# Following test have been intentionally ommitted due to feature +# deletion in Fortran 95 standard: +# F95: 103, 111, 252, 253, 255, 257, 259, 260, 719 +# +# We omit these tests because they never pass with any recent +# compiler: +# 001, 406, 923 +# +# Tests make use of arithmetic IF which is now a deleted feature +# in Fortran 2008 +# +# Note that the NIST license allows redistribution but requires +# explicit acknowledgement of what has been changed. Please +# amend README file if you modify the tests. + +# clean-up fort.* files otherwise one of the tests will fail +llvm_test_prepare("rm -f ${CMAKE_CURRENT_BINARY_DIR}/fort.*") + +# Test 509 requires this flag in more recent versions of GCC +check_fortran_compiler_flag("-std=legacy" SUPPORTS_LEGACY) +if (SUPPORTS_LEGACY) + add_compile_options(-std=legacy) +endif () + +llvm_singlesource() +set(FP_TOLERANCE 1.0e-11) # set by the most sensitive numerical test + +file(COPY lit.local.cfg DESTINATION "${CMAKE_CURRENT_BINARY_DIR}") diff --git a/Fortran/UnitTests/fcvs21_f95/FM002.f b/Fortran/UnitTests/fcvs21_f95/FM002.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM002.f @@ -0,0 +1,334 @@ + PROGRAM FM002 + +C COMMENT SECTION 00010002 +C 00020002 +C FM002 00030002 +C 00040002 +C THIS ROUTINE CHECKS THAT COMMENT LINES WHICH HAVE VALID 00050002 +C FORTRAN STATEMENTS DO NOT AFFECT THE EXECUTION OF THE PROGRAM 00060002 +C IN ANY WAY. 00070002 +C 00080002 +C REFERENCES 00090002 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00100002 +C X3.9-1978 00110002 +C 00120002 +C SECTION 3.2.1, COMMENT LINE 00130002 +C 00140002 +C ********************************************************** 00150002 +C 00160002 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00170002 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00180002 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00190002 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00200002 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00210002 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00220002 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00230002 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00240002 +C OF EXECUTING THESE TESTS. 00250002 +C 00260002 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00270002 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00280002 +C 00290002 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00300002 +C 00310002 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00320002 +C SOFTWARE STANDARDS VALIDATION GROUP 00330002 +C BUILDING 225 RM A266 00340002 +C GAITHERSBURG, MD 20899 00350002 +C ********************************************************** 00360002 +C 00370002 +C 00380002 +C 00390002 +C INITIALIZATION SECTION 00400002 +C 00410002 +C INITIALIZE CONSTANTS 00420002 +C ************** 00430002 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00440002 + I01 = 5 00450002 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00460002 + I02 = 6 00470002 +C SYSTEM ENVIRONMENT SECTION 00480002 +C 00490002 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00500002 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00510002 +C (UNIT NUMBER FOR CARD READER). 00520002 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00530002 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00540002 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00550002 +C 00560002 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00570002 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00580002 +C (UNIT NUMBER FOR PRINTER). 00590002 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00600002 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00610002 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00620002 +C 00630002 + IVPASS=0 00640002 + IVFAIL=0 00650002 + IVDELE=0 00660002 + ICZERO=0 00670002 +C 00680002 +C WRITE PAGE HEADERS 00690002 + WRITE (I02,90000) 00700002 + WRITE (I02,90001) 00710002 + WRITE (I02,90002) 00720002 + WRITE (I02, 90002) 00730002 + WRITE (I02,90003) 00740002 + WRITE (I02,90002) 00750002 + WRITE (I02,90004) 00760002 + WRITE (I02,90002) 00770002 + WRITE (I02,90011) 00780002 + WRITE (I02,90002) 00790002 + WRITE (I02,90002) 00800002 + WRITE (I02,90005) 00810002 + WRITE (I02,90006) 00820002 + WRITE (I02,90002) 00830002 +C TEST SECTION 00840002 +C 00850002 + 41 CONTINUE 00860002 + IVTNUM=4 00870002 +C 00880002 +C **** TEST 004 **** 00890002 +C TEST 004 - BLANK COMMENT LINE 00900002 +C 00910002 + IF (ICZERO) 30040,40,30040 00920002 + 40 CONTINUE 00930002 + IVON01=4 00940002 +C 00950002 + GO TO 40040 00960002 +30040 IVDELE=IVDELE+1 00970002 + WRITE (I02,80003) IVTNUM 00980002 + IF (ICZERO) 40040, 51, 40040 00990002 +40040 IF (IVON01 - 4) 20040, 10040, 20040 01000002 +10040 IVPASS=IVPASS+1 01010002 + WRITE (I02,80001) IVTNUM 01020002 + GO TO 51 01030002 +20040 IVFAIL=IVFAIL+1 01040002 + IVCOMP=IVON01 01050002 + IVCORR=4 01060002 + WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 01070002 + 51 CONTINUE 01080002 + IVTNUM=5 01090002 +C 01100002 +C **** TEST 005 **** 01110002 +C TEST 005 - GO TO IN COMMENT LINE 01120002 +C 01130002 + IF (ICZERO) 30050, 50, 30050 01140002 + 50 CONTINUE 01150002 + IVON01 = 3 01160002 +C GO TO 20050 01170002 + IVON01=5 01180002 + GO TO 40050 01190002 +30050 IVDELE=IVDELE+1 01200002 + WRITE (I02,80003) IVTNUM 01210002 + IF (ICZERO) 40050, 61, 40050 01220002 +40050 IF (IVON01 - 5) 20050,10050,20050 01230002 +10050 IVPASS=IVPASS+1 01240002 + WRITE (I02,80001) IVTNUM 01250002 + GO TO 61 01260002 +20050 IVFAIL=IVFAIL+1 01270002 + IVCOMP=IVON01 01280002 + IVCORR=5 01290002 + WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 01300002 + 61 CONTINUE 01310002 + IVTNUM=6 01320002 +C 01330002 +C **** TEST 006 **** 01340002 +C TEST 006 - INTEGER ASSIGNMENT STATEMENT IN COMMENT LINE 01350002 +C 01360002 + IF (ICZERO) 30060,60,30060 01370002 + 60 CONTINUE 01380002 + IVON01=6 01390002 +C IVON01=1 01400002 + GO TO 40060 01410002 +30060 IVDELE=IVDELE+1 01420002 + WRITE (I02,80003) IVTNUM 01430002 + IF (ICZERO) 40060,71,40060 01440002 +40060 IF (IVON01-6) 20060,10060,20060 01450002 +10060 IVPASS=IVPASS+1 01460002 + WRITE (I02,80001) IVTNUM 01470002 + GO TO 71 01480002 +20060 IVFAIL=IVFAIL+1 01490002 + IVCOMP=IVON01 01500002 + IVCORR=6 01510002 + WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 01520002 + 71 CONTINUE 01530002 + IVTNUM=7 01540002 +C 01550002 +C **** TEST 007 **** 01560002 +C TEST 007 - INTEGER ASSIGNMENT STATEMENT IN COMMENT LINE 01570002 +C INTEGER EXPRESSION TO RIGHT OF = 01580002 +C 01590002 + IF (ICZERO) 30070,70,30070 01600002 + 70 CONTINUE 01610002 + IVON02=6 01620002 + IVON01=7 01630002 +C IVON01= 3*IVON02 01640002 + GO TO 40070 01650002 +30070 IVDELE=IVDELE+1 01660002 + WRITE (I02,80003) IVTNUM 01670002 + IF (ICZERO) 40070,81,40070 01680002 +40070 IF (IVON01-7) 20070,10070,20070 01690002 +10070 IVPASS=IVPASS+1 01700002 + WRITE (I02,80001) IVTNUM 01710002 + GO TO 81 01720002 +20070 IVFAIL=IVFAIL+1 01730002 + IVCOMP=IVON01 01740002 + IVCORR=7 01750002 + WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 01760002 + 81 CONTINUE 01770002 + IVTNUM=8 01780002 +C 01790002 +C **** TEST 008 **** 01800002 +C TEST 008 - IF STATEMENT IN COMMENT LINE 01810002 +C 01820002 + IF (ICZERO) 30080,80,30080 01830002 + 80 CONTINUE 01840002 + IVON01=300 01850002 +C IF (IVON01) 20080,20080,20080 01860002 + IVON01=8 01870002 + GO TO 40080 01880002 +30080 IVDELE=IVDELE+1 01890002 + WRITE (I02,80003) IVTNUM 01900002 + IF (ICZERO) 40080,91,40080 01910002 +40080 IF (IVON01-8) 20080,10080,20080 01920002 +10080 IVPASS=IVPASS+1 01930002 + WRITE (I02,80001) IVTNUM 01940002 + GO TO 91 01950002 +20080 IVFAIL=IVFAIL+1 01960002 + IVCOMP=IVON01 01970002 + IVCORR=8 01980002 + WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 01990002 + 91 CONTINUE 02000002 + IVTNUM=9 02010002 +C 02020002 +C **** TEST 009 **** 02030002 +C TEST 009 - WRITE STATEMENT IN A COMMENT LINE 02040002 +C 02050002 + IF (ICZERO) 30090,90,30090 02060002 + 90 CONTINUE 02070002 + IVON01=200 02080002 +C 92 WRITE (I02,80002) IVTNUM 02090002 + IVON01=9 02100002 + GO TO 40090 02110002 +30090 IVDELE=IVDELE+1 02120002 + WRITE (I02,80003) IVTNUM 02130002 + IF (ICZERO) 40090,101,40090 02140002 +40090 IF (IVON01-9) 20090,10090,20090 02150002 +10090 IVPASS=IVPASS+1 02160002 + WRITE (I02,80001) IVTNUM 02170002 + GO TO 101 02180002 +20090 IVFAIL=IVFAIL+1 02190002 + IVCOMP=IVON01 02200002 + IVCORR=9 02210002 + WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 02220002 + 101 IVTNUM=10 02230002 +C 02240002 +C **** TEST 010 **** 02250002 +C TEST 010 - STATEMENT LABEL IN COMMENT LINE 02260002 +C 02270002 + IF (ICZERO) 30100,100,30100 02280002 + 100 CONTINUE 02290002 + GO TO 102 02300002 +C 102 WRITE (I02,80002) 02310002 +C GO TO 111 02320002 + 102 IVON01=10 02330002 + GO TO 40100 02340002 +30100 IVDELE=IVDELE+1 02350002 + WRITE (I02,80003) IVTNUM 02360002 + IF (ICZERO) 40100,111,40100 02370002 +40100 IF (IVON01-10) 20100,10100,20100 02380002 +10100 IVPASS=IVPASS+1 02390002 + WRITE (I02,80001) IVTNUM 02400002 + GO TO 111 02410002 +20100 IVFAIL=IVFAIL+1 02420002 + IVCOMP=IVON01 02430002 + IVCORR=10 02440002 + WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 02450002 + 111 CONTINUE 02460002 + IVTNUM=11 02470002 +C 02480002 +C **** TEST 011 **** 02490002 +C TEST 011 - CONTINUE IN COMMENT LINE 02500002 +C FOLLOWED BY INTEGER ASSIGNMENT STATEMENT IN COMMENT 02510002 +C 02520002 + IF (ICZERO) 30110,110,30110 02530002 + 110 IVON01=11 02540002 +C CONTINUE 02550002 +C IVON01=7000 02560002 + GO TO 40110 02570002 +30110 IVDELE=IVDELE+1 02580002 + WRITE (I02,80003) IVTNUM 02590002 + IF (ICZERO) 40110,121,40110 02600002 +40110 IF (IVON01 -11) 20110,10110,20110 02610002 +10110 IVPASS=IVPASS+1 02620002 + WRITE (I02,80001) IVTNUM 02630002 + GO TO 121 02640002 +20110 IVFAIL=IVFAIL+1 02650002 + IVCOMP=IVON01 02660002 + IVCORR=11 02670002 + WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 02680002 + 121 CONTINUE 02690002 + IVTNUM=12 02700002 +C 02710002 +C **** TEST 012 **** 02720002 +C TEST 012 - INTEGER ASSIGNMENT STATEMENT IN COMMENT LINE 02730002 +C 02740002 + IF (ICZERO) 30120,120,30120 02750002 + 120 CONTINUE 02760002 + IVON01=12 02770002 +C IVON01=IVON01+1 02780002 + GO TO 40120 02790002 +30120 IVDELE=IVDELE+1 02800002 + WRITE (I02,80003) IVTNUM 02810002 + IF (ICZERO) 40120,99999,40120 02820002 +40120 IF (IVON01 - 12) 20120,10120,20120 02830002 +10120 IVPASS=IVPASS+1 02840002 + WRITE (I02,80001) IVTNUM 02850002 + GO TO 99999 02860002 +20120 IVFAIL=IVFAIL+1 02870002 + IVCOMP=IVON01 02880002 + IVCORR=12 02890002 + WRITE (I02,80004) IVTNUM,IVCOMP,IVCORR 02900002 +C 02910002 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02920002 +99999 CONTINUE 02930002 + WRITE (I02,90002) 02940002 + WRITE (I02,90006) 02950002 + WRITE (I02,90002) 02960002 + WRITE (I02,90002) 02970002 + WRITE (I02,90007) 02980002 + WRITE (I02,90002) 02990002 + WRITE (I02,90008) IVFAIL 03000002 + WRITE (I02,90009) IVPASS 03010002 + WRITE (I02,90010) IVDELE 03020002 +C 03030002 +C 03040002 +C TERMINATE ROUTINE EXECUTION 03050002 + STOP 03060002 +C 03070002 +C FORMAT STATEMENTS FOR PAGE HEADERS 03080002 +90000 FORMAT ("1") 03090002 +90002 FORMAT (" ") 03100002 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03110002 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03120002 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03130002 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03140002 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03150002 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03160002 +C 03170002 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03180002 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03190002 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03200002 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03210002 +C 03220002 +C FORMAT STATEMENTS FOR TEST RESULTS 03230002 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03240002 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03250002 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03260002 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03270002 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03280002 +C 03290002 +90007 FORMAT (" ",20X,"END OF PROGRAM FM002" ) 03300002 +C COMMENT LINE BEFORE END STATEMENT 03310002 + END 03320002 diff --git a/Fortran/UnitTests/fcvs21_f95/FM002.reference_output b/Fortran/UnitTests/fcvs21_f95/FM002.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM002.reference_output @@ -0,0 +1,33 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM002 + + 0 ERRORS ENCOUNTERED + 9 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM003.f b/Fortran/UnitTests/fcvs21_f95/FM003.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM003.f @@ -0,0 +1,366 @@ + PROGRAM FM003 + +C COMMENT SECTION 00010003 +C 00020003 +C FM003 00030003 +C 00040003 +C THIS ROUTINE CONTAINS THE BASIC CONTINUE TESTS. THESE TESTS 00050003 +C ENSURE THAT EXECUTION OF A CONTINUE STATEMENT CAUSES CONTINUATION 00060003 +C OF THE NORMAL PROGRAM EXECUTION SEQUENCE. ONLY THE STATEMENTS IN 00070003 +C THE BASIC ASSUMPTIONS ARE INCLUDED IN THESE TESTS. OTHER CONTINUE00080003 +C TESTS ARE CONTAINED IN OTHER ROUTINES AS PART OF THE TESTS FOR 00090003 +C OTHER LANGUAGE FEATURES SUCH AS THE DO STATEMENTS TESTS. 00100003 +C 00110003 +C REFERENCES 00120003 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130003 +C X3.9-1978 00140003 +C 00150003 +C SECTION 3.6, NORMAL EXECUTION SEQUENCE AND TRANSFER OF CONTROL 00160003 +C SECTION 11.11, CONTINUE STATEMENT 00170003 +C 00180003 +C 00190003 +C ********************************************************** 00200003 +C 00210003 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00220003 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00230003 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00240003 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00250003 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00260003 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00270003 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00280003 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00290003 +C OF EXECUTING THESE TESTS. 00300003 +C 00310003 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00320003 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00330003 +C 00340003 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00350003 +C 00360003 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00370003 +C SOFTWARE STANDARDS VALIDATION GROUP 00380003 +C BUILDING 225 RM A266 00390003 +C GAITHERSBURG, MD 20899 00400003 +C ********************************************************** 00410003 +C 00420003 +C 00430003 +C 00440003 +C INITIALIZATION SECTION 00450003 +C 00460003 +C INITIALIZE CONSTANTS 00470003 +C ************** 00480003 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00490003 + I01 = 5 00500003 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00510003 + I02 = 6 00520003 +C SYSTEM ENVIRONMENT SECTION 00530003 +C 00540003 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00550003 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00560003 +C (UNIT NUMBER FOR CARD READER). 00570003 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00580003 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00590003 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00600003 +C 00610003 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00620003 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00630003 +C (UNIT NUMBER FOR PRINTER). 00640003 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00650003 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00660003 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00670003 +C 00680003 + IVPASS=0 00690003 + IVFAIL=0 00700003 + IVDELE=0 00710003 + ICZERO=0 00720003 +C 00730003 +C WRITE PAGE HEADERS 00740003 + WRITE (I02,90000) 00750003 + WRITE (I02,90001) 00760003 + WRITE (I02,90002) 00770003 + WRITE (I02, 90002) 00780003 + WRITE (I02,90003) 00790003 + WRITE (I02,90002) 00800003 + WRITE (I02,90004) 00810003 + WRITE (I02,90002) 00820003 + WRITE (I02,90011) 00830003 + WRITE (I02,90002) 00840003 + WRITE (I02,90002) 00850003 + WRITE (I02,90005) 00860003 + WRITE (I02,90006) 00870003 + WRITE (I02,90002) 00880003 + 131 CONTINUE 00890003 + IVTNUM = 13 00900003 +C 00910003 +C **** TEST 013 **** 00920003 +C TEST 13 - CONTINUE TEST 00930003 +C CONTINUE STATEMENT FOLLOWING INTEGER ASSIGNMENT 00940003 +C STATEMENTS. 00950003 +C 00960003 + IF (ICZERO) 30130, 130, 30130 00970003 + 130 CONTINUE 00980003 + IVON01=5 00990003 + IVON02=6 01000003 + CONTINUE 01010003 + GO TO 40130 01020003 +30130 IVDELE = IVDELE + 1 01030003 + WRITE (I02,80003) IVTNUM 01040003 + IF (ICZERO) 40130, 141, 40130 01050003 +40130 IF (IVON01-5) 20131,40131,20131 01060003 +40131 IF (IVON02-6) 20132,10130,20132 01070003 +10130 IVPASS = IVPASS + 1 01080003 + WRITE (I02,80001) IVTNUM 01090003 + GO TO 141 01100003 +20131 IVCOMP=IVON01 01110003 + IVCORR=5 01120003 + GO TO 20130 01130003 +20132 IVCOMP=IVON02 01140003 + IVCORR=6 01150003 +20130 IVFAIL = IVFAIL + 1 01160003 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01170003 + 141 CONTINUE 01180003 + IVTNUM = 14 01190003 +C 01200003 +C **** TEST 014 **** 01210003 +C TEST 14 - CONTINUE TEST 01220003 +C CONTINUE STATEMENT BETWEEN INTEGER ASSIGNMENT 01230003 +C STATEMENTS 01240003 +C 01250003 + IF (ICZERO) 30140, 140, 30140 01260003 + 140 CONTINUE 01270003 + IVON01=14 01280003 + CONTINUE 01290003 + IVON02=15 01300003 + GO TO 40140 01310003 +30140 IVDELE = IVDELE + 1 01320003 + WRITE (I02,80003) IVTNUM 01330003 + IF (ICZERO) 40140, 151, 40140 01340003 +40140 IF (IVON01 - 14) 20141,40141,20141 01350003 +40141 IF (IVON02 - 15) 20142, 10140, 20142 01360003 +10140 IVPASS = IVPASS + 1 01370003 + WRITE (I02,80001) IVTNUM 01380003 + GO TO 151 01390003 +20141 IVCOMP=IVON01 01400003 + IVCORR=14 01410003 + GO TO 20140 01420003 +20142 IVCOMP=IVON02 01430003 + IVCORR=15 01440003 +20140 IVFAIL = IVFAIL + 1 01450003 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01460003 + 151 CONTINUE 01470003 + IVTNUM = 15 01480003 +C 01490003 +C **** TEST 015 **** 01500003 +C TEST 15 - CONTINUE TEST 01510003 +C TWO CONSECUTIVE CONTINUE STATEMENTS 01520003 +C 01530003 + IF (ICZERO) 30150, 150, 30150 01540003 + 150 CONTINUE 01550003 + CONTINUE 01560003 + IVON01=19 01570003 + IVON02=20 01580003 + GO TO 40150 01590003 +30150 IVDELE = IVDELE + 1 01600003 + WRITE (I02,80003) IVTNUM 01610003 + IF (ICZERO) 40150, 161, 40150 01620003 +40150 IF (IVON01 - 19) 20151,40151,20151 01630003 +40151 IF (IVON02 -20) 20152,10150,20152 01640003 +10150 IVPASS = IVPASS + 1 01650003 + WRITE (I02,80001) IVTNUM 01660003 + GO TO 161 01670003 +20151 IVCOMP=IVON01 01680003 + IVCORR=19 01690003 + GO TO 20150 01700003 +20152 IVCOMP=IVON02 01710003 + IVCORR=20 01720003 +20150 IVFAIL = IVFAIL + 1 01730003 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01740003 + 161 CONTINUE 01750003 + IVTNUM = 16 01760003 +C 01770003 +C **** TEST 016 **** 01780003 +C TEST 16 - CONTINUE TEST 01790003 +C BRANCH TO CONTINUE STATEMENT FROM IF STATEMENT 01800003 +C 01810003 + IF (ICZERO) 30160, 160, 30160 01820003 + 160 CONTINUE 01830003 + IVON01=16 01840003 + IF (IVON01 - 16) 162,163,162 01850003 + 162 IVCORR=16 01860003 + GO TO 20160 01870003 + 163 CONTINUE 01880003 + IVON01=160 01890003 + GO TO 40160 01900003 +30160 IVDELE = IVDELE + 1 01910003 + WRITE (I02,80003) IVTNUM 01920003 + IF (ICZERO) 40160, 171, 40160 01930003 +40160 IF (IVON01-160) 20161,10160,20161 01940003 +10160 IVPASS = IVPASS + 1 01950003 + WRITE (I02,80001) IVTNUM 01960003 + GO TO 171 01970003 +20161 IVCORR=160 01980003 +20160 IVFAIL = IVFAIL + 1 01990003 + IVCOMP=IVON01 02000003 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02010003 + 171 CONTINUE 02020003 + IVTNUM = 17 02030003 +C 02040003 +C **** TEST 017 **** 02050003 +C TEST 17 - CONTINUE TEST 02060003 +C TWO OF THE BRANCHES OF AN IF STATEMENT ARE TO THE SAME 02070003 +C CONTINUE STATEMENT. THE THIRD BRANCH ALSO IS MADE TO 02080003 +C A CONTINUE STATEMENT. 02090003 +C 02100003 + IF (ICZERO) 30170, 170, 30170 02110003 + 170 CONTINUE 02120003 + IVON01=17 02130003 + IF (IVON01-19) 173,172,172 02140003 + 172 CONTINUE 02150003 + IVCORR=17 02160003 + GO TO 20170 02170003 + 173 CONTINUE 02180003 + IVON01=170 02190003 + GO TO 40170 02200003 +30170 IVDELE = IVDELE + 1 02210003 + WRITE (I02,80003) IVTNUM 02220003 + IF (ICZERO) 40170, 181, 40170 02230003 +40170 IF (IVON01 - 170) 20171,10170,20171 02240003 +10170 IVPASS = IVPASS + 1 02250003 + WRITE (I02,80001) IVTNUM 02260003 + GO TO 181 02270003 +20171 IVCORR=170 02280003 +20170 IVFAIL = IVFAIL + 1 02290003 + IVCOMP=IVON01 02300003 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02310003 + 181 CONTINUE 02320003 + IVTNUM = 18 02330003 +C 02340003 +C **** TEST 018 **** 02350003 +C TEST 18 - CONTINUE TEST 02360003 +C BRANCH TO CONTINUE STATEMENT FROM GO TO STATEMENT 02370003 +C 02380003 + IF (ICZERO) 30180, 180, 30180 02390003 + 180 CONTINUE 02400003 + IF (ICZERO) 184,182,184 02410003 + 182 IVON01=18 02420003 + GO TO 183 02430003 + 184 IVON01=20 02440003 + 183 CONTINUE 02450003 + IVON02=180 02460003 + GO TO 40180 02470003 +30180 IVDELE = IVDELE + 1 02480003 + WRITE (I02,80003) IVTNUM 02490003 + IF (ICZERO) 40180, 191, 40180 02500003 +40180 IF (IVON01 - 18) 20181,40181,20181 02510003 +40181 IF (IVON02 -180) 20182,10180,20182 02520003 +10180 IVPASS = IVPASS + 1 02530003 + WRITE (I02,80001) IVTNUM 02540003 + GO TO 191 02550003 +20181 IVCORR=18 02560003 + IVCOMP=IVON01 02570003 + GO TO 20180 02580003 +20182 IVCOMP=IVON02 02590003 + IVCORR=180 02600003 +20180 IVFAIL = IVFAIL + 1 02610003 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02620003 + 191 CONTINUE 02630003 + IVTNUM = 19 02640003 +C 02650003 +C **** TEST 019 **** 02660003 +C TEST 19 - CONTINUE TEST 02670003 +C BRANCH TO THREE CONTINUE STATEMENTS FROM IF STATEMENT. 02680003 +C CONTINUE STATEMENTS FOLLOW EACH OTHER. 02690003 +C 02700003 + IF (ICZERO) 30190, 190, 30190 02710003 + 190 CONTINUE 02720003 + ICONE = 1 02730003 + IF (ICONE) 194,192,193 02740003 + 193 CONTINUE 02750003 + 192 CONTINUE 02760003 + 194 CONTINUE 02770003 + IVON01=19 02780003 + GO TO 40190 02790003 +30190 IVDELE = IVDELE + 1 02800003 + WRITE (I02,80003) IVTNUM 02810003 + IF (ICZERO) 40190, 201, 40190 02820003 +40190 IF (IVON01 - 19) 20190,10190,20190 02830003 +10190 IVPASS = IVPASS + 1 02840003 + WRITE (I02,80001) IVTNUM 02850003 + GO TO 201 02860003 +20190 IVFAIL = IVFAIL + 1 02870003 + IVCOMP=IVON01 02880003 + IVCORR=19 02890003 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02900003 + 201 CONTINUE 02910003 + IVTNUM = 20 02920003 +C 02930003 +C **** TEST 020 **** 02940003 +C TEST 20 - CONTINUE TEST 02950003 +C THREE SEPARATE BRANCHES OF AN IF STATEMENT ARE TO 02960003 +C CONTINUE STATEMENTS. 02970003 +C 02980003 + IF (ICZERO) 30200, 200, 30200 02990003 + 200 CONTINUE 03000003 + ICON02=-2 03010003 + IF (ICON02) 204,202,203 03020003 + 203 CONTINUE 03030003 + IVON01=203 03040003 + GO TO 40200 03050003 + 204 CONTINUE 03060003 + IVON01 = 204 03070003 + GO TO 40200 03080003 + 202 CONTINUE 03090003 + IVON01=202 03100003 + GO TO 40200 03110003 +30200 IVDELE = IVDELE + 1 03120003 + WRITE (I02,80003) IVTNUM 03130003 + IF (ICZERO) 40200, 211, 40200 03140003 +40200 IF (IVON01 - 204) 20200,10200,20200 03150003 +10200 IVPASS = IVPASS + 1 03160003 + WRITE (I02,80001) IVTNUM 03170003 + GO TO 211 03180003 +20200 IVFAIL = IVFAIL + 1 03190003 + IVCOMP=IVON01 03200003 + IVCORR=204 03210003 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03220003 + 211 CONTINUE 03230003 +C 03240003 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03250003 +99999 CONTINUE 03260003 + WRITE (I02,90002) 03270003 + WRITE (I02,90006) 03280003 + WRITE (I02,90002) 03290003 + WRITE (I02,90002) 03300003 + WRITE (I02,90007) 03310003 + WRITE (I02,90002) 03320003 + WRITE (I02,90008) IVFAIL 03330003 + WRITE (I02,90009) IVPASS 03340003 + WRITE (I02,90010) IVDELE 03350003 +C 03360003 +C 03370003 +C TERMINATE ROUTINE EXECUTION 03380003 + STOP 03390003 +C 03400003 +C FORMAT STATEMENTS FOR PAGE HEADERS 03410003 +90000 FORMAT ("1") 03420003 +90002 FORMAT (" ") 03430003 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03440003 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03450003 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03460003 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03470003 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03480003 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03490003 +C 03500003 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03510003 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03520003 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03530003 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03540003 +C 03550003 +C FORMAT STATEMENTS FOR TEST RESULTS 03560003 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03570003 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03580003 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03590003 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03600003 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03610003 +C 03620003 +90007 FORMAT (" ",20X,"END OF PROGRAM FM003" ) 03630003 + END 03640003 diff --git a/Fortran/UnitTests/fcvs21_f95/FM003.reference_output b/Fortran/UnitTests/fcvs21_f95/FM003.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM003.reference_output @@ -0,0 +1,32 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM003 + + 0 ERRORS ENCOUNTERED + 8 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM004.f b/Fortran/UnitTests/fcvs21_f95/FM004.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM004.f @@ -0,0 +1,487 @@ + PROGRAM FM004 + +C COMMENT SECTION 00010004 +C 00020004 +C FM004 00030004 +C 00040004 +C THIS ROUTINE CONTAINS BASIC ARITHMETIC IF STATEMENT TESTS. 00050004 +C THE STATEMENT FORMAT IS 00060004 +C IF (E) K1, K2, K3 00070004 +C WHERE E IS A SIMPLE INTEGER EXPRESSION OF FORM 00080004 +C VARIABLE - CONSTANT 00090004 +C VARIABLE + CONSTANT 00100004 +C AND K1, K2 AND K3 ARE STATEMENT LABELS. ONLY THE STATEMENTS IN 00110004 +C THE BASIC ASSUMPTIONS ARE INCLUDED IN THESE TESTS. 00120004 +C EXECUTION OF AN IF STATEMENT CAUSES EVALUATION OF THE 00130004 +C EXPRESSION E FOLLOWING WHICH THE STATEMENT LABEL K1, K2 OR K3 00140004 +C IS EXECUTED NEXT AS THE VALUE OF E IS LESS THAN ZERO, ZERO, OR 00150004 +C GREATER THAN ZERO, RESPECTIVELY. 00160004 +C 00170004 +C THE BASIC UNCONDITIONAL GO TO STATEMENT IS TESTED IN THIS 00180004 +C ROUTINE. THE STATEMENT IS OF THE FORM 00190004 +C GO TO K 00200004 +C WHERE K IS A STATEMENT LABEL. 00210004 +C EXECUTION OF AN UNCONDITIONAL GO TO STATEMENT CAUSES THE 00220004 +C STATEMENT IDENTIFIED BY STATEMENT LABEL K TO BE EXECUTED NEXT. 00230004 +C 00240004 +C REFERENCES 00250004 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260004 +C X3.9-1978 00270004 +C 00280004 +C SECTION 3.6, NORMAL EXECUTION SEQUENCE AND TRANSFER OF CONTROL 00290004 +C SECTION 11.1, GO TO STATEMENT 00300004 +C SECTION 11.4, ARITHMETIC IF STATEMENT 00310004 +C 00320004 +C ********************************************************** 00330004 +C 00340004 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350004 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360004 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370004 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380004 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390004 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400004 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410004 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420004 +C OF EXECUTING THESE TESTS. 00430004 +C 00440004 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450004 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460004 +C 00470004 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480004 +C 00490004 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00500004 +C SOFTWARE STANDARDS VALIDATION GROUP 00510004 +C BUILDING 225 RM A266 00520004 +C GAITHERSBURG, MD 20899 00530004 +C ********************************************************** 00540004 +C 00550004 +C 00560004 +C 00570004 +C INITIALIZATION SECTION 00580004 +C 00590004 +C INITIALIZE CONSTANTS 00600004 +C ************** 00610004 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620004 + I01 = 5 00630004 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640004 + I02 = 6 00650004 +C SYSTEM ENVIRONMENT SECTION 00660004 +C 00670004 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00680004 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690004 +C (UNIT NUMBER FOR CARD READER). 00700004 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710004 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720004 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730004 +C 00740004 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00750004 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760004 +C (UNIT NUMBER FOR PRINTER). 00770004 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780004 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790004 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800004 +C 00810004 + IVPASS=0 00820004 + IVFAIL=0 00830004 + IVDELE=0 00840004 + ICZERO=0 00850004 +C 00860004 +C WRITE PAGE HEADERS 00870004 + WRITE (I02,90000) 00880004 + WRITE (I02,90001) 00890004 + WRITE (I02,90002) 00900004 + WRITE (I02, 90002) 00910004 + WRITE (I02,90003) 00920004 + WRITE (I02,90002) 00930004 + WRITE (I02,90004) 00940004 + WRITE (I02,90002) 00950004 + WRITE (I02,90011) 00960004 + WRITE (I02,90002) 00970004 + WRITE (I02,90002) 00980004 + WRITE (I02,90005) 00990004 + WRITE (I02,90006) 01000004 + WRITE (I02,90002) 01010004 +C TEST SECTION 01020004 +C 01030004 +C TESTS 21, 22, AND 23 CONTAIN THE SAME IF STATEMENT BUT THE 01040004 +C EXPECTED BRANCH IS TO THE FIRST, SECOND OR THIRD STATEMENT LABEL 01050004 +C AS THE INTEGER EXPRESSION IS LESS THAN ZERO, EQUAL TO ZERO, OR 01060004 +C GREATER THAN ZERO RESPECTIVELY. 01070004 +C 01080004 + 211 CONTINUE 01090004 + IVTNUM = 21 01100004 +C 01110004 +C **** TEST 021 **** 01120004 +C TEST 21 - ARITHMETIC IF STATEMENT TEST 01130004 +C LESS THAN ZERO BRANCH EXPECTED. 01140004 +C 01150004 + IF (ICZERO) 30210, 210, 30210 01160004 + 210 CONTINUE 01170004 + IVON01=2 01180004 + IF (IVON01 - 3) 212,213,214 01190004 + 212 IVON02 = -1 01200004 + GO TO 40210 01210004 + 213 IVON02 = 0 01220004 + GO TO 40210 01230004 + 214 IVON02 = 1 01240004 + GO TO 40210 01250004 +30210 IVDELE = IVDELE + 1 01260004 + WRITE (I02,80003) IVTNUM 01270004 + IF (ICZERO) 40210, 221, 40210 01280004 +40210 IF (IVON02) 10210, 20210, 20210 01290004 +10210 IVPASS = IVPASS + 1 01300004 + WRITE (I02,80001) IVTNUM 01310004 + GO TO 221 01320004 +20210 IVFAIL = IVFAIL + 1 01330004 + IVCOMP=IVON02 01340004 + IVCORR=-1 01350004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01360004 + 221 CONTINUE 01370004 + IVTNUM = 22 01380004 +C 01390004 +C **** TEST 022 **** 01400004 +C TEST 22 - ARITHMETIC IF STATEMENT TEST 01410004 +C EQUAL TO ZERO BRANCH EXPECTED 01420004 +C 01430004 + IF (ICZERO) 30220, 220, 30220 01440004 + 220 CONTINUE 01450004 + IVON01 = 3 01460004 + IF (IVON01 - 3) 222,223,224 01470004 + 222 IVON02 = -1 01480004 + GO TO 40220 01490004 + 223 IVON02 = 0 01500004 + GO TO 40220 01510004 + 224 IVON02 = 1 01520004 + GO TO 40220 01530004 +30220 IVDELE = IVDELE + 1 01540004 + WRITE (I02,80003) IVTNUM 01550004 + IF (ICZERO) 40220, 231, 40220 01560004 +40220 IF (IVON02) 20220, 10220, 20220 01570004 +10220 IVPASS = IVPASS + 1 01580004 + WRITE (I02,80001) IVTNUM 01590004 + GO TO 231 01600004 +20220 IVFAIL = IVFAIL + 1 01610004 + IVCOMP=IVON02 01620004 + IVCORR= 0 01630004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01640004 + 231 CONTINUE 01650004 + IVTNUM = 23 01660004 +C 01670004 +C **** TEST 023 **** 01680004 +C TEST 23 - ARITHMETIC IF STATEMENT TEST 01690004 +C GREATER THAN ZERO BRANCH EXPECTED 01700004 +C 01710004 + IF (ICZERO) 30230, 230, 30230 01720004 + 230 CONTINUE 01730004 + IVON01 = 4 01740004 + IF (IVON01 - 3) 232,233,234 01750004 + 232 IVON02 = -1 01760004 + GO TO 40230 01770004 + 233 IVON02 = 0 01780004 + GO TO 40230 01790004 + 234 IVON02 = 1 01800004 + GO TO 40230 01810004 +30230 IVDELE = IVDELE + 1 01820004 + WRITE (I02,80003) IVTNUM 01830004 + IF (ICZERO) 40230, 241, 40230 01840004 +40230 IF (IVON02) 20230, 20230, 10230 01850004 +10230 IVPASS = IVPASS + 1 01860004 + WRITE (I02,80001) IVTNUM 01870004 + GO TO 241 01880004 +20230 IVFAIL = IVFAIL + 1 01890004 + IVCOMP=IVON02 01900004 + IVCORR = 1 01910004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01920004 +C 01930004 +C TESTS 24 THROUGH 29 CONTAIN AN IF STATEMENT WITH TWO OF THE 01940004 +C THREE BRANCH STATEMENT LABELS EQUAL. 01950004 +C 01960004 + 241 CONTINUE 01970004 + IVTNUM = 24 01980004 +C 01990004 +C **** TEST 024 **** 02000004 +C TEST 24 - ARITHMETIC IF STATEMENT TEST 02010004 +C LESS THAN ZERO BRANCH EXPECTED 02020004 +C 02030004 + IF (ICZERO) 30240, 240, 30240 02040004 + 240 CONTINUE 02050004 + IVON01=2 02060004 + IF (IVON01 - 3) 242,243,242 02070004 + 242 IVON02=-1 02080004 + GO TO 40240 02090004 + 243 IVON02=0 02100004 + GO TO 40240 02110004 +30240 IVDELE = IVDELE + 1 02120004 + WRITE (I02,80003) IVTNUM 02130004 + IF (ICZERO) 40240, 251, 40240 02140004 +40240 IF (IVON02) 10240, 20240, 20240 02150004 +10240 IVPASS = IVPASS + 1 02160004 + WRITE (I02,80001) IVTNUM 02170004 + GO TO 251 02180004 +20240 IVFAIL = IVFAIL + 1 02190004 + IVCOMP=IVON02 02200004 + IVCORR=-1 02210004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02220004 + 251 CONTINUE 02230004 + IVTNUM = 25 02240004 +C 02250004 +C **** TEST 025 **** 02260004 +C TEST 25 - ARITHMETIC IF STATEMENT TEST 02270004 +C EQUAL TO ZERO BRANCH EXPECTED 02280004 +C 02290004 + IF (ICZERO) 30250, 250, 30250 02300004 + 250 CONTINUE 02310004 + IVON01=3 02320004 + IF (IVON01 - 3) 252,253,252 02330004 + 252 IVON02= -1 02340004 + GO TO 40250 02350004 + 253 IVON02 = 0 02360004 + GO TO 40250 02370004 +30250 IVDELE = IVDELE + 1 02380004 + WRITE (I02,80003) IVTNUM 02390004 + IF (ICZERO) 40250, 261, 40250 02400004 +40250 IF (IVON02) 20250,10250,20250 02410004 +10250 IVPASS = IVPASS + 1 02420004 + WRITE (I02,80001) IVTNUM 02430004 + GO TO 261 02440004 +20250 IVFAIL = IVFAIL + 1 02450004 + IVCOMP=IVON02 02460004 + IVCORR=0 02470004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02480004 + 261 CONTINUE 02490004 + IVTNUM = 26 02500004 +C 02510004 +C **** TEST 026 **** 02520004 +C TEST 26 - ARITHMETIC IF STATEMENT TEST 02530004 +C GREATER THAN ZERO BRANCH EXPECTED 02540004 +C 02550004 + IF (ICZERO) 30260, 260, 30260 02560004 + 260 CONTINUE 02570004 + IVON01=4 02580004 + IF (IVON01-3) 262, 263, 262 02590004 + 262 IVON02= 1 02600004 + GO TO 40260 02610004 + 263 IVON02 = 0 02620004 + GO TO 40260 02630004 +30260 IVDELE = IVDELE + 1 02640004 + WRITE (I02,80003) IVTNUM 02650004 + IF (ICZERO) 40260, 271, 40260 02660004 +40260 IF (IVON02) 20260, 20260, 10260 02670004 +10260 IVPASS = IVPASS + 1 02680004 + WRITE (I02,80001) IVTNUM 02690004 + GO TO 271 02700004 +20260 IVFAIL = IVFAIL + 1 02710004 + IVCOMP=IVON02 02720004 + IVCORR = 1 02730004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02740004 + 271 CONTINUE 02750004 + IVTNUM = 27 02760004 +C 02770004 +C **** TEST 027 **** 02780004 +C TEST 27 - ARITHMETIC IF STATEMENT TEST 02790004 +C LESS THAN ZERO BRANCH EXPECTED 02800004 +C 02810004 + IF (ICZERO) 30270, 270, 30270 02820004 + 270 CONTINUE 02830004 + IVON01 = -4 02840004 + IF (IVON01 + 3) 272, 272, 273 02850004 + 272 IVON02= -1 02860004 + GO TO 40270 02870004 + 273 IVON02 = 1 02880004 + GO TO 40270 02890004 +30270 IVDELE = IVDELE + 1 02900004 + WRITE (I02,80003) IVTNUM 02910004 + IF (ICZERO) 40270, 281, 40270 02920004 +40270 IF (IVON02) 10270, 20270, 20270 02930004 +10270 IVPASS = IVPASS + 1 02940004 + WRITE (I02,80001) IVTNUM 02950004 + GO TO 281 02960004 +20270 IVFAIL = IVFAIL + 1 02970004 + IVCOMP=IVON02 02980004 + IVCORR= -1 02990004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03000004 + 281 CONTINUE 03010004 + IVTNUM = 28 03020004 +C 03030004 +C **** TEST 028 **** 03040004 +C TEST 28 - ARITHMETIC IF STATEMENT TEST 03050004 +C EQUAL TO ZERO BRANCH EXPECTED 03060004 +C 03070004 + IF (ICZERO) 30280, 280, 30280 03080004 + 280 CONTINUE 03090004 + IVON01 = -3 03100004 + IF (IVON01 + 3) 282, 282, 283 03110004 + 282 IVON02 = 0 03120004 + GO TO 40280 03130004 + 283 IVON02 = 1 03140004 + GO TO 40280 03150004 +30280 IVDELE = IVDELE + 1 03160004 + WRITE (I02,80003) IVTNUM 03170004 + IF (ICZERO) 40280, 291, 40280 03180004 +40280 IF (IVON02) 20280, 10280, 20280 03190004 +10280 IVPASS = IVPASS + 1 03200004 + WRITE (I02,80001) IVTNUM 03210004 + GO TO 291 03220004 +20280 IVFAIL = IVFAIL + 1 03230004 + IVCOMP=IVON02 03240004 + IVCORR= 0 03250004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03260004 + 291 CONTINUE 03270004 + IVTNUM = 29 03280004 +C 03290004 +C **** TEST 029 **** 03300004 +C TEST 29 - ARITHMETIC IF STATEMENT TEST 03310004 +C GREATER THAN ZERO BRANCH EXPECTED 03320004 +C 03330004 + IF (ICZERO) 30290, 290, 30290 03340004 + 290 CONTINUE 03350004 + IVON01 = -2 03360004 + IF (IVON01 + 3) 292,292,293 03370004 + 292 IVON02 = -1 03380004 + GO TO 40290 03390004 + 293 IVON02 = 1 03400004 + GO TO 40290 03410004 +30290 IVDELE = IVDELE + 1 03420004 + WRITE (I02,80003) IVTNUM 03430004 + IF (ICZERO) 40290, 301, 40290 03440004 +40290 IF (IVON02) 20290, 20290, 10290 03450004 +10290 IVPASS = IVPASS + 1 03460004 + WRITE (I02,80001) IVTNUM 03470004 + GO TO 301 03480004 +20290 IVFAIL = IVFAIL + 1 03490004 + IVCOMP= IVON02 03500004 + IVCORR = 1 03510004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03520004 +C 03530004 +C TESTS 30 AND 31 CONTAIN THE BASIC GO TO STATEMENT TESTS. 03540004 +C 03550004 + 301 CONTINUE 03560004 + IVTNUM = 30 03570004 +C 03580004 +C **** TEST 030 **** 03590004 +C TEST 30 - UNCONDITIONAL GO TO STATEMENT TEST 03600004 +C 03610004 + IF (ICZERO) 30300, 300, 30300 03620004 + 300 CONTINUE 03630004 + IVON01 = 1 03640004 + GO TO 302 03650004 + 303 IVON01 = 2 03660004 + GO TO 304 03670004 + 302 IVON01 = 3 03680004 + GO TO 303 03690004 + 304 GO TO 40300 03700004 +30300 IVDELE = IVDELE + 1 03710004 + WRITE (I02,80003) IVTNUM 03720004 + IF (ICZERO) 40300, 311, 40300 03730004 +40300 IF (IVON01 - 2) 20300,10300,20300 03740004 +10300 IVPASS = IVPASS + 1 03750004 + WRITE (I02,80001) IVTNUM 03760004 + GO TO 311 03770004 +20300 IVFAIL = IVFAIL + 1 03780004 + IVCOMP = IVON01 03790004 + IVCORR = 2 03800004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03810004 + 311 CONTINUE 03820004 + IVTNUM = 31 03830004 +C 03840004 +C **** TEST 031 **** 03850004 +C TEST 31 - UNCONDITIONAL GO TO STATEMENT TEST 03860004 +C 03870004 + IF (ICZERO) 30310, 310, 30310 03880004 + 310 CONTINUE 03890004 + IVON01 = 1 03900004 + GO TO 316 03910004 + 313 GO TO 317 03920004 + 314 IVON01 = 3 03930004 + GO TO 40310 03940004 + 315 GO TO 313 03950004 + 316 GO TO 315 03960004 + 317 GO TO 314 03970004 +30310 IVDELE = IVDELE + 1 03980004 + WRITE (I02,80003) IVTNUM 03990004 + IF (ICZERO) 40310, 321, 40310 04000004 +40310 IF (IVON01 - 3) 20310, 10310, 20310 04010004 +10310 IVPASS = IVPASS + 1 04020004 + WRITE (I02,80001) IVTNUM 04030004 + GO TO 321 04040004 +20310 IVFAIL = IVFAIL + 1 04050004 + IVCOMP=IVON01 04060004 + IVCORR = 3 04070004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04080004 + 321 CONTINUE 04090004 + IVTNUM = 32 04100004 +C 04110004 +C **** TEST 032 **** 04120004 +C TEST 32 - ARITHMETIC IF STATEMENT AND UNCONDITIONAL GO TO 04130004 +C STATEMENT 04140004 +C THIS TEST COMBINES THE BASIC ARITHMETIC IF STATEMENTS AND 04150004 +C UNCONDITIONAL GO TO STATEMENTS IN ONE TEST. 04160004 +C 04170004 + IF (ICZERO) 30320, 320, 30320 04180004 + 320 CONTINUE 04190004 + IVON01 = 1 04200004 + GO TO 322 04210004 + 324 IVON01 = 2 04220004 + IF (IVON01 -1) 323, 323, 325 04230004 + 327 IVON01 = 5 04240004 + GO TO 328 04250004 + 326 IVON01 = -4 04260004 + IF (IVON01 + 4) 323, 327, 323 04270004 + 322 IF (IVON01 - 1) 323, 324, 323 04280004 + 323 GO TO 20320 04290004 + 325 IVON01 = 3 04300004 + IF (IVON01 -4) 326,323,323 04310004 + 328 GO TO 40320 04320004 +30320 IVDELE = IVDELE + 1 04330004 + WRITE (I02,80003) IVTNUM 04340004 + IF (ICZERO) 40320, 331, 40320 04350004 +40320 IF (IVON01 - 5) 20320, 10320, 20320 04360004 +10320 IVPASS = IVPASS + 1 04370004 + WRITE (I02,80001) IVTNUM 04380004 + GO TO 331 04390004 +20320 IVFAIL = IVFAIL + 1 04400004 + IVCOMP=IVON01 04410004 + IVCORR=5 04420004 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04430004 + 331 CONTINUE 04440004 +C 04450004 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 04460004 +99999 CONTINUE 04470004 + WRITE (I02,90002) 04480004 + WRITE (I02,90006) 04490004 + WRITE (I02,90002) 04500004 + WRITE (I02,90002) 04510004 + WRITE (I02,90007) 04520004 + WRITE (I02,90002) 04530004 + WRITE (I02,90008) IVFAIL 04540004 + WRITE (I02,90009) IVPASS 04550004 + WRITE (I02,90010) IVDELE 04560004 +C 04570004 +C 04580004 +C TERMINATE ROUTINE EXECUTION 04590004 + STOP 04600004 +C 04610004 +C FORMAT STATEMENTS FOR PAGE HEADERS 04620004 +90000 FORMAT ("1") 04630004 +90002 FORMAT (" ") 04640004 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04650004 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 04660004 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 04670004 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 04680004 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 04690004 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 04700004 +C 04710004 +C FORMAT STATEMENTS FOR RUN SUMMARIES 04720004 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 04730004 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 04740004 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 04750004 +C 04760004 +C FORMAT STATEMENTS FOR TEST RESULTS 04770004 +80001 FORMAT (" ",4X,I5,7X,"PASS") 04780004 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 04790004 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 04800004 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 04810004 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 04820004 +C 04830004 +90007 FORMAT (" ",20X,"END OF PROGRAM FM004" ) 04840004 + END 04850004 diff --git a/Fortran/UnitTests/fcvs21_f95/FM004.reference_output b/Fortran/UnitTests/fcvs21_f95/FM004.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM004.reference_output @@ -0,0 +1,36 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM004 + + 0 ERRORS ENCOUNTERED + 12 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM005.f b/Fortran/UnitTests/fcvs21_f95/FM005.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM005.f @@ -0,0 +1,396 @@ + PROGRAM FM005 + +C COMMENT SECTION 00010005 +C 00020005 +C FM005 00030005 +C 00040005 +C THIS ROUTINE TESTS THE BASIC ASSUMPTIONS REGARDING THE SIMPLE 00050005 +C FORMATTED WRITE STATEMENT OF FORM 00060005 +C WRITE (U,F) OR 00070005 +C WRITE (U,F) L 00080005 +C WHERE U IS A LOGICAL UNIT NUMBER 00090005 +C F IS A FORMAT STATEMENT LABEL, AND 00100005 +C L IS A LIST OF INTEGER VARIABLES. 00110005 +C THE FORMAT STATEMENT F CONTAINS NH HOLLERITH FIELD DESCRIPTORS, 00120005 +C NX BLANK FIELD DESCRIPTORS AND IW NUMERIC FIELD DESCRIPTORS. 00130005 +C 00140005 +C THIS ROUTINE TESTS WHETHER THE FIRST CHARACTER OF A FORMAT 00150005 +C RECORD FOR PRINTER OUTPUT DETERMINES VERTICAL SPACING AS FOLLOWS 00160005 +C BLANK - ONE LINE 00170005 +C 1 - ADVANCE TO FIRST LINE OF NEXT PAGE 00180005 +C 00190005 +C REFERENCES 00200005 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00210005 +C X3.9-1978 00220005 +C 00230005 +C SECTION 12.8.2, INPUT/OUTPUT LISTS 00240005 +C SECTION 12.9.5.2, READ, WRITE, AND PRINT STATEMENT 00250005 +C SECTION 12.9.5.2.3, PRINTING OF FORMATTED RECORDS 00260005 +C SECTION 13.5.2, H EDITING 00270005 +C SECTION 13.5.3.2, X EDITING 00280005 +C SECTION 13.5.9.1, NUMERIC EDITING 00290005 +C 00300005 +C ALL OF THE RESULTS OF THIS ROUTINE MUST BE VISUALLY CHECKED 00310005 +C ON THE OUTPUT REPORT. THE USUAL TEST CODE FOR PASS, FAIL, OR 00320005 +C DELETE DOES NOT APPLY TO THIS ROUTINE. IF ANY TEST IS TO BE 00330005 +C DELETED, CHANGE THE OFFENDING WRITE OR FORMAT STATEMENT TO A 00340005 +C COMMENT. THE PERSON RESPONSIBLE FOR CHECKING THE OUTPUT MUST ALSO00350005 +C CHECK THE COMPILER LISTING TO SEE IF ANY STATEMENTS HAVE BEEN 00360005 +C CHANGED TO COMMENTS. 00370005 +C 00380005 +C ********************************************************** 00390005 +C 00400005 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00410005 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00420005 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00430005 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00440005 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00450005 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00460005 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00470005 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00480005 +C OF EXECUTING THESE TESTS. 00490005 +C 00500005 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00510005 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00520005 +C 00530005 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00540005 +C 00550005 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00560005 +C SOFTWARE STANDARDS VALIDATION GROUP 00570005 +C BUILDING 225 RM A266 00580005 +C GAITHERSBURG, MD 20899 00590005 +C ********************************************************** 00600005 +C 00610005 +C 00620005 +C 00630005 +C INITIALIZATION SECTION 00640005 +C 00650005 +C INITIALIZE CONSTANTS 00660005 +C ************** 00670005 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680005 + I01 = 5 00690005 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700005 + I02 = 6 00710005 +C SYSTEM ENVIRONMENT SECTION 00720005 +C 00730005 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00740005 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750005 +C (UNIT NUMBER FOR CARD READER). 00760005 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00770005 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00780005 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00790005 +C 00800005 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00810005 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00820005 +C (UNIT NUMBER FOR PRINTER). 00830005 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00840005 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850005 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00860005 +C 00870005 + IVPASS=0 00880005 + IVFAIL=0 00890005 + IVDELE=0 00900005 + ICZERO=0 00910005 +C 00920005 +C WRITE PAGE HEADERS 00930005 + WRITE (I02,90000) 00940005 + WRITE (I02,90001) 00950005 + WRITE (I02,90002) 00960005 + WRITE (I02, 90002) 00970005 + WRITE (I02,90003) 00980005 + WRITE (I02,90002) 00990005 + WRITE (I02,90004) 01000005 + WRITE (I02,90002) 01010005 + WRITE (I02,90011) 01020005 + WRITE (I02,90002) 01030005 + WRITE (I02,90002) 01040005 + WRITE (I02,90006) 01050005 + WRITE (I02,90002) 01060005 + 331 CONTINUE 01070005 + IVTNUM = 33 01080005 +C 01090005 +C **** TEST 033 **** 01100005 +C TEST 33 - VERTICAL SPACING TEST 01110005 +C 1 IN FIRST CHARACTER OF FORMATTED PRINT RECORD MEANS 01120005 +C RECORD IS FIRST LINE AT TOP OF NEXT PAGE. 01130005 +C 01140005 + WRITE (I02,80001) IVTNUM 01150005 + WRITE (I02,80331) 01160005 +80331 FORMAT (5X,"LAST LINE ON THIS PAGE" ) 01170005 + WRITE (I02,80330) 01180005 +80330 FORMAT ("1"," THIS IS FIRST LINE ON PAGE" ) 01190005 + 341 CONTINUE 01200005 + IVTNUM = 34 01210005 +C 01220005 +C **** TEST 034 **** 01230005 +C TEST 34 - VERTICAL SPACING TEST 01240005 +C PRINT BLANK LINES 01250005 +C 01260005 + WRITE (I02,90002) 01270005 + WRITE (I02,80001) IVTNUM 01280005 + WRITE (I02,80340) 01290005 +80340 FORMAT (" ", 10X) 01300005 + WRITE (I02,80341) 01310005 +80341 FORMAT (" THERE IS ONE BLANK LINE BEFORE THIS LINE" ) 01320005 + WRITE (I02,80342) 01330005 + WRITE (I02,80342) 01340005 +80342 FORMAT (" " ) 01350005 + WRITE (I02,80343) 01360005 +80343 FORMAT (" THERE ARE TWO BLANK LINES BEFORE THIS LINE" ) 01370005 + WRITE (I02,80344) 01380005 + WRITE (I02,80344) 01390005 + WRITE (I02,80344) 01400005 +80344 FORMAT (11X) 01410005 + WRITE (I02,80345) 01420005 +80345 FORMAT (" THERE ARE THREE BLANK LINES BEFORE THIS LINE" ) 01430005 + 351 CONTINUE 01440005 + IVTNUM = 35 01450005 +C 01460005 +C **** TEST 035 **** 01470005 +C TEST 35 - PRINT 54 CHARACTERS 01480005 +C 01490005 + WRITE (I02,90002) 01500005 + WRITE (I02,80001)IVTNUM 01510005 + WRITE (I02,80351) 01520005 +80351 FORMAT (" NEXT LINE CONTAINS 54 CHARACTERS" ) 01530005 + WRITE (I02,80350) 01540005 +80350 FORMAT(" 123456789012345678901234567890123456789012345678901234" )01550005 + 361 CONTINUE 01560005 + IVTNUM = 36 01570005 +C 01580005 +C **** TEST 036 **** 01590005 +C TEST 36 - NUMERIC FIELD DESCRIPTOR I1 01600005 +C 01610005 + WRITE (I02,90000) 01620005 + WRITE (I02,90002) 01630005 + WRITE (I02,80001) IVTNUM 01640005 + WRITE (I02,80361) 01650005 +80361 FORMAT (" ",10X,"THIS TEST PRINTS 3 UNDER I1 DESCRIPTOR" ) 01660005 + IVON01 = 3 01670005 + WRITE (I02,80360) IVON01 01680005 +80360 FORMAT (" ",10X,I1) 01690005 + 371 CONTINUE 01700005 + IVTNUM = 37 01710005 +C 01720005 +C **** TEST 037 **** 01730005 +C TEST 37 - NUMERIC FIELD DESCRIPTOR I2 01740005 +C 01750005 + WRITE (I02,90002) 01760005 + WRITE (I02,80001) IVTNUM 01770005 + WRITE (I02,80371) 01780005 +80371 FORMAT (11X,"THIS TEST PRINTS 15 UNDER I2 DESCRIPTOR" ) 01790005 + IVON01 = 15 01800005 + WRITE (I02,80370) IVON01 01810005 +80370 FORMAT (" ",10X,I2) 01820005 + 381 CONTINUE 01830005 + IVTNUM = 38 01840005 +C 01850005 +C **** TEST 038 **** 01860005 +C TEST 38 - NUMERIC FIELD DESCRIPTOR I3 01870005 +C 01880005 + WRITE (I02,90002) 01890005 + WRITE (I02,80001) IVTNUM 01900005 + WRITE (I02,80381) 01910005 +80381 FORMAT (11X,"THIS TEST PRINTS 291 UNDER I3 DESCRIPTOR" ) 01920005 + IVON01 = 291 01930005 + WRITE (I02,80380) IVON01 01940005 +80380 FORMAT (11X,I3) 01950005 + 391 CONTINUE 01960005 + IVTNUM = 39 01970005 +C 01980005 +C **** TEST 039 **** 01990005 +C TEST 39 - NUMERIC FIELD DESCRIPTOR I4 02000005 +C 02010005 + WRITE (I02,90002) 02020005 + WRITE (I02,80001) IVTNUM 02030005 + WRITE (I02,80391) 02040005 +80391 FORMAT (11X,"THIS TEST PRINTS 4321 UNDER I4 DESCRIPTOR" ) 02050005 + IVON01 = 4321 02060005 + WRITE (I02,80390) IVON01 02070005 +80390 FORMAT (11X,I4) 02080005 + 401 CONTINUE 02090005 + IVTNUM = 40 02100005 +C 02110005 +C **** TEST 040 **** 02120005 +C TEST 40 - NUMERIC FIELD DESCRIPTOR I5 02130005 +C 02140005 + WRITE (I02,90002) 02150005 + WRITE (I02,80001) IVTNUM 02160005 + WRITE (I02,80401) 02170005 +80401 FORMAT (" ",10X,"THIS TEST PRINTS 12345 UNDER I5 DESCRIPTOR" ) 02180005 + IVON01 = 12345 02190005 + WRITE (I02,80400) IVON01 02200005 +80400 FORMAT (" ",10X,I5) 02210005 + 411 CONTINUE 02220005 + IVTNUM = 41 02230005 +C 02240005 +C **** TEST 041 **** 02250005 +C TEST 41 - NUMERIC FIELD DESCRIPTORS, INTEGER CONVERSION 02260005 +C 02270005 + IVON01 = 1 02280005 + IVON02 = 22 02290005 + IVON03 = 333 02300005 + IVON04 = 4444 02310005 + IVON05 = 25555 02320005 + WRITE (I02,90002) 02330005 + WRITE (I02,80001) IVTNUM 02340005 + WRITE (I02,80411) 02350005 +80411 FORMAT (3X,"THIS TEST PRINTS 1, 22, 333, 4444, AND 25555 UNDER" ) 02360005 + WRITE (I02,80412) 02370005 +80412 FORMAT (10X,"(10X,I1,3X,I2,3X,I3,3X,I4,3X,I5)" ) 02380005 + WRITE (I02,80410) IVON01, IVON02, IVON03, IVON04, IVON05 02390005 +80410 FORMAT (10X,I1,3X,I2,3X,I3,3X,I4,3X,I5) 02400005 + 421 CONTINUE 02410005 + IVTNUM = 42 02420005 +C 02430005 +C **** TEST 042 **** 02440005 +C TEST 42 - HOLLERITH, NUMERIC AND X FIELD DESCRIPTORS 02450005 +C COMBINE HOLLERITH, NUMERIC AND X FIELD DESCRIPTORS IN 02460005 +C ONE FORMAT STATEMENT 02470005 +C 02480005 + IVON01=113 02490005 + IVON02=8 02500005 + WRITE (I02,90002) 02510005 + WRITE (I02,80001) IVTNUM 02520005 + WRITE (I02,80421) 02530005 +80421 FORMAT (10X,"NEXT TWO LINES ARE IDENTICAL" ) 02540005 + WRITE (I02,80422) 02550005 +80422 FORMAT (" IVON01 = 113 IVON02 = 8" ) 02560005 + WRITE (I02,80420) IVON01, IVON02 02570005 +80420 FORMAT (6X,"IVON01 =",I5,3X,"IVON02 =",I5) 02580005 + 431 CONTINUE 02590005 + IVTNUM=43 02600005 +C 02610005 +C **** TEST 043 **** 02620005 +C TEST 43 - NUMERIC FIELD DESCRIPTOR I2 02630005 +C PRINT NEGATIVE INTEGER 02640005 +C 02650005 + IVON01 = -1 02660005 + WRITE (I02,90000) 02670005 + WRITE (I02,90002) 02680005 + WRITE (I02,80001) IVTNUM 02690005 + WRITE (I02,80431) 02700005 +80431 FORMAT (11X,"THIS TEST PRINTS -1 UNDER I2 DESCRIPTOR" ) 02710005 + WRITE (I02,80430) IVON01 02720005 +80430 FORMAT (11X,I2) 02730005 + 441 CONTINUE 02740005 + IVTNUM = 44 02750005 +C 02760005 +C **** TEST 044 **** 02770005 +C TEST 44 - NUMERIC FIELD DESCRIPTOR I3 02780005 +C PRINT NEGATIVE INTEGER 02790005 +C 02800005 + IVON01 = -22 02810005 + WRITE (I02,90002) 02820005 + WRITE (I02,80001) IVTNUM 02830005 + WRITE (I02,80441) 02840005 +80441 FORMAT (11X,"THIS TEST PRINTS -22 UNDER I3 DESCRIPTOR" ) 02850005 + WRITE (I02,80440) IVON01 02860005 +80440 FORMAT (11X,I3) 02870005 + 451 CONTINUE 02880005 + IVTNUM = 45 02890005 +C 02900005 +C **** TEST 045 **** 02910005 +C TEST 45 - NUMERIC FIELD DESCRIPTOR I4 02920005 +C PRINT NEGATIVE INTEGER 02930005 +C 02940005 + IVON01 = -333 02950005 + WRITE (I02,90002) 02960005 + WRITE (I02,80001) IVTNUM 02970005 + WRITE (I02,80451) 02980005 +80451 FORMAT (11X,"THIS TEST PRINTS -333 UNDER I4 DESCRIPTOR" ) 02990005 + WRITE (I02,80450) IVON01 03000005 +80450 FORMAT (11X,I4) 03010005 + 461 CONTINUE 03020005 + IVTNUM = 46 03030005 +C 03040005 +C **** TEST 046 **** 03050005 +C TEST 46 - NUMERIC FIELD DESCRIPTOR I5 03060005 +C PRINT NEGATIVE INTEGER 03070005 +C 03080005 + IVON01 = -4444 03090005 + WRITE (I02,90002) 03100005 + WRITE (I02,80001) IVTNUM 03110005 + WRITE (I02,80461) 03120005 +80461 FORMAT (11X,"THIS TEST PRINTS -4444 UNDER I5 DESCRIPTOR" ) 03130005 + WRITE (I02,80460) IVON01 03140005 +80460 FORMAT (11X,I5) 03150005 + 471 CONTINUE 03160005 + IVTNUM = 47 03170005 +C 03180005 +C **** TEST 047 **** 03190005 +C TEST 47 - NUMERIC FIELD DESCRIPTOR I6 03200005 +C PRINT NEGATIVE INTEGER 03210005 +C 03220005 + IVON01 = -15555 03230005 + WRITE (I02,90002) 03240005 + WRITE (I02,80001) IVTNUM 03250005 + WRITE (I02,80471) 03260005 +80471 FORMAT (11X,"THIS TEST PRINTS -15555 UNDER DESCRIPTOR I6" ) 03270005 + WRITE (I02,80470) IVON01 03280005 +80470 FORMAT (11X,I6) 03290005 + 481 CONTINUE 03300005 + IVTNUM = 48 03310005 +C 03320005 +C **** TEST 048 **** 03330005 +C TEST 48 - NUMERIC FIELD DESCRIPTORS, INTEGER CONVERSION 03340005 +C PRINT NEGATIVE INTEGERS 03350005 +C 03360005 + IVON01 = -9 03370005 + IVON02 = -88 03380005 + IVON03 = -777 03390005 + IVON04 = -6666 03400005 + IVON05 = -25555 03410005 + WRITE (I02,90002) 03420005 + WRITE (I02,80001) IVTNUM 03430005 + WRITE (I02,80481) 03440005 +80481 FORMAT (8X,"THIS TEST PRINTS -9, -88, -777, -6666, AND -25555" ) 03450005 + WRITE (I02,80482) 03460005 +80482 FORMAT (11X,"UNDER FORMAT 10X,I2,3X,I3,3X,I4,3X,I5,3X,I6" ) 03470005 + WRITE (I02,80480) IVON01,IVON02,IVON03,IVON04,IVON05 03480005 +80480 FORMAT (10X,I2,3X,I3,3X,I4,3X,I5,3X,I6) 03490005 + 491 CONTINUE 03500005 + IVTNUM = 49 03510005 +C 03520005 +C **** TEST 049 **** 03530005 +C TEST 49 - NUMERIC FIELD DESCRIPTOR I5 03540005 +C MIX POSITIVE AND NEGATIVE INTEGER OUTPUT IN ONE FORMAT 03550005 +C STATEMENT ALL UNDER I5 DESCRIPTOR 03560005 +C 03570005 + IVON01 =5 03580005 + IVON02 = -54 03590005 + IVON03 = 543 03600005 + IVON04 = -5432 03610005 + IVON05=32000 03620005 + WRITE (I02,90002) 03630005 + WRITE (I02,80001) IVTNUM 03640005 + WRITE (I02,80491) 03650005 +80491 FORMAT (18X,"THIS TEST PRINTS 5, -54, 543, -5432, AND 32000" ) 03660005 + WRITE (I02,80492) 03670005 +80492 FORMAT (11X,"UNDER I5 NUMERIC FIELD DESCRIPTOR" ) 03680005 + WRITE (I02,80490) IVON01,IVON02,IVON03,IVON04,IVON05 03690005 +80490 FORMAT (11X,I5,3X,I5,3X,I5,3X,I5,3X,I5) 03700005 +C 03710005 +C WRITE PAGE FOOTINGS 03720005 +99999 CONTINUE 03730005 + WRITE (I02,90002) 03740005 + WRITE (I02,90006) 03750005 + WRITE (I02,90002) 03760005 + WRITE (I02,90007) 03770005 +C 03780005 +C TERMINATE ROUTINE EXECUTION 03790005 + STOP 03800005 +C 03810005 +C FORMAT STATEMENTS FOR PAGE HEADERS 03820005 +90000 FORMAT ("1") 03830005 +90002 FORMAT (" ") 03840005 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03850005 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03860005 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03870005 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03880005 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03890005 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03900005 +C FORMAT STATEMENTS FOR THIS ROUTINE 03910005 +80001 FORMAT (10X,"TEST ",I2) 03920005 +90007 FORMAT (" ",20X,"END OF PROGRAM FM005" ) 03930005 + END 03940005 diff --git a/Fortran/UnitTests/fcvs21_f95/FM005.reference_output b/Fortran/UnitTests/fcvs21_f95/FM005.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM005.reference_output @@ -0,0 +1,98 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + ---------------------------------------------- + + TEST 33 + LAST LINE ON THIS PAGE +1 THIS IS FIRST LINE ON PAGE + + TEST 34 + + THERE IS ONE BLANK LINE BEFORE THIS LINE + + + THERE ARE TWO BLANK LINES BEFORE THIS LINE + + + + THERE ARE THREE BLANK LINES BEFORE THIS LINE + + TEST 35 + NEXT LINE CONTAINS 54 CHARACTERS + 123456789012345678901234567890123456789012345678901234 +1 + + TEST 36 + THIS TEST PRINTS 3 UNDER I1 DESCRIPTOR + 3 + + TEST 37 + THIS TEST PRINTS 15 UNDER I2 DESCRIPTOR + 15 + + TEST 38 + THIS TEST PRINTS 291 UNDER I3 DESCRIPTOR + 291 + + TEST 39 + THIS TEST PRINTS 4321 UNDER I4 DESCRIPTOR + 4321 + + TEST 40 + THIS TEST PRINTS 12345 UNDER I5 DESCRIPTOR + 12345 + + TEST 41 + THIS TEST PRINTS 1, 22, 333, 4444, AND 25555 UNDER + (10X,I1,3X,I2,3X,I3,3X,I4,3X,I5) + 1 22 333 4444 25555 + + TEST 42 + NEXT TWO LINES ARE IDENTICAL + IVON01 = 113 IVON02 = 8 + IVON01 = 113 IVON02 = 8 +1 + + TEST 43 + THIS TEST PRINTS -1 UNDER I2 DESCRIPTOR + -1 + + TEST 44 + THIS TEST PRINTS -22 UNDER I3 DESCRIPTOR + -22 + + TEST 45 + THIS TEST PRINTS -333 UNDER I4 DESCRIPTOR + -333 + + TEST 46 + THIS TEST PRINTS -4444 UNDER I5 DESCRIPTOR + -4444 + + TEST 47 + THIS TEST PRINTS -15555 UNDER DESCRIPTOR I6 + -15555 + + TEST 48 + THIS TEST PRINTS -9, -88, -777, -6666, AND -25555 + UNDER FORMAT 10X,I2,3X,I3,3X,I4,3X,I5,3X,I6 + -9 -88 -777 -6666 -25555 + + TEST 49 + THIS TEST PRINTS 5, -54, 543, -5432, AND 32000 + UNDER I5 NUMERIC FIELD DESCRIPTOR + 5 -54 543 -5432 32000 + + ---------------------------------------------- + + END OF PROGRAM FM005 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM006.f b/Fortran/UnitTests/fcvs21_f95/FM006.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM006.f @@ -0,0 +1,764 @@ + PROGRAM FM006 + +C COMMENT SECTION 00010006 +C 00020006 +C FM006 00030006 +C 00040006 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF 00050006 +C THE FORM 00060006 +C INTEGER VARIABLE = INTEGER CONSTANT 00070006 +C INTEGER VARIABLE = INTEGER VARIABLE 00080006 +C THE INTEGER CONSTANT MAY BE UNSIGNED, POSITIVE OR NEGATIVE. 00090006 +C 00100006 +C AN INTEGER DATUM IS ALWAYS AN EXACT REPRESENTATION OF AN 00110006 +C INTEGER VALUE. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES. 00120006 +C IT MAY ONLY ASSUME INTEGRAL VALUES. 00130006 +C 00140006 +C AN INTEGER CONSTANT IS WRITTEN AS A NONEMPTY STRING OF DIGITS.00150006 +C THE CONSTANT IS THE DIGIT STRING INTERPRETED AS A DECIMAL NUMBER. 00160006 +C 00170006 +C THIS ROUTINE ALSO CONTAINS TESTS WHICH CHECK ON THE USE OF 00180006 +C AT LEAST 16 BITS FOR REPRESENTING INTEGER DATA VALUES. THE 00190006 +C CONSTANT VALUES 32767 AND -32766 ARE USED IN THESE TESTS. 00200006 +C 00210006 +C REFERENCES 00220006 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00230006 +C X3.9-1978 00240006 +C 00250006 +C SECTION 4.3, INTEGER TYPE 00260006 +C SECTION 4.3.1, INTEGER CONSTANT 00270006 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENTS 00280006 +C 00290006 +C 00300006 +C ********************************************************** 00310006 +C 00320006 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00330006 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00340006 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00350006 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00360006 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00370006 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00380006 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00390006 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00400006 +C OF EXECUTING THESE TESTS. 00410006 +C 00420006 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00430006 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00440006 +C 00450006 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00460006 +C 00470006 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00480006 +C SOFTWARE STANDARDS VALIDATION GROUP 00490006 +C BUILDING 225 RM A266 00500006 +C GAITHERSBURG, MD 20899 00510006 +C ********************************************************** 00520006 +C 00530006 +C 00540006 +C 00550006 +C INITIALIZATION SECTION 00560006 +C 00570006 +C INITIALIZE CONSTANTS 00580006 +C ************** 00590006 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00600006 + I01 = 5 00610006 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00620006 + I02 = 6 00630006 +C SYSTEM ENVIRONMENT SECTION 00640006 +C 00650006 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00660006 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670006 +C (UNIT NUMBER FOR CARD READER). 00680006 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00690006 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00700006 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00710006 +C 00720006 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00730006 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00740006 +C (UNIT NUMBER FOR PRINTER). 00750006 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00760006 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00770006 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00780006 +C 00790006 + IVPASS=0 00800006 + IVFAIL=0 00810006 + IVDELE=0 00820006 + ICZERO=0 00830006 +C 00840006 +C WRITE PAGE HEADERS 00850006 + WRITE (I02,90000) 00860006 + WRITE (I02,90001) 00870006 + WRITE (I02,90002) 00880006 + WRITE (I02, 90002) 00890006 + WRITE (I02,90003) 00900006 + WRITE (I02,90002) 00910006 + WRITE (I02,90004) 00920006 + WRITE (I02,90002) 00930006 + WRITE (I02,90011) 00940006 + WRITE (I02,90002) 00950006 + WRITE (I02,90002) 00960006 + WRITE (I02,90005) 00970006 + WRITE (I02,90006) 00980006 + WRITE (I02,90002) 00990006 +C TEST SECTION 01000006 +C 01010006 +C ARITHMETIC ASSIGNMENT STATEMENT 01020006 +C 01030006 +C TEST 50 THROUGH TEST 61 CONTAIN STATEMENT OF FORM 01040006 +C INTEGER VARIABLE = INTEGER CONSTANT 01050006 +C 01060006 +C TESTS 50 THROUGH 53 CONTAIN UNSIGNED INTEGER CONSTANT. 01070006 +C 01080006 + 501 CONTINUE 01090006 + IVTNUM = 50 01100006 +C 01110006 +C **** TEST 50 **** 01120006 +C 01130006 + IF (ICZERO) 30500, 500, 30500 01140006 + 500 CONTINUE 01150006 + IVCOMP=3 01160006 + GO TO 40500 01170006 +30500 IVDELE = IVDELE + 1 01180006 + WRITE (I02,80003) IVTNUM 01190006 + IF (ICZERO) 40500, 511, 40500 01200006 +40500 IF (IVCOMP - 3) 20500, 10500, 20500 01210006 +10500 IVPASS = IVPASS + 1 01220006 + WRITE (I02,80001) IVTNUM 01230006 + GO TO 511 01240006 +20500 IVFAIL = IVFAIL + 1 01250006 + IVCORR = 3 01260006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01270006 + 511 CONTINUE 01280006 + IVTNUM = 51 01290006 +C 01300006 +C **** TEST 51 **** 01310006 +C 01320006 + IF (ICZERO) 30510, 510, 30510 01330006 + 510 CONTINUE 01340006 + IVCOMP = 76 01350006 + GO TO 40510 01360006 +30510 IVDELE = IVDELE + 1 01370006 + WRITE (I02,80003) IVTNUM 01380006 + IF (ICZERO) 40510, 521, 40510 01390006 +40510 IF (IVCOMP - 76) 20510, 10510, 20510 01400006 +10510 IVPASS = IVPASS + 1 01410006 + WRITE (I02,80001) IVTNUM 01420006 + GO TO 521 01430006 +20510 IVFAIL = IVFAIL + 1 01440006 + IVCORR = 76 01450006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01460006 + 521 CONTINUE 01470006 + IVTNUM = 52 01480006 +C 01490006 +C **** TEST 52 **** 01500006 +C 01510006 + IF (ICZERO) 30520, 520, 30520 01520006 + 520 CONTINUE 01530006 + IVCOMP = 587 01540006 + GO TO 40520 01550006 +30520 IVDELE = IVDELE + 1 01560006 + WRITE (I02,80003) IVTNUM 01570006 + IF (ICZERO) 40520, 531, 40520 01580006 +40520 IF (IVCOMP - 587) 20520, 10520, 20520 01590006 +10520 IVPASS = IVPASS + 1 01600006 + WRITE (I02,80001) IVTNUM 01610006 + GO TO 531 01620006 +20520 IVFAIL = IVFAIL + 1 01630006 + IVCORR = 587 01640006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01650006 + 531 CONTINUE 01660006 + IVTNUM = 53 01670006 +C 01680006 +C **** TEST 53 **** 01690006 +C 01700006 + IF (ICZERO) 30530, 530, 30530 01710006 + 530 CONTINUE 01720006 + IVCOMP = 9999 01730006 + GO TO 40530 01740006 +30530 IVDELE = IVDELE + 1 01750006 + WRITE (I02,80003) IVTNUM 01760006 + IF (ICZERO) 40530, 541, 40530 01770006 +40530 IF (IVCOMP - 9999) 20530, 10530, 20530 01780006 +10530 IVPASS = IVPASS + 1 01790006 + WRITE (I02,80001) IVTNUM 01800006 + GO TO 541 01810006 +20530 IVFAIL = IVFAIL + 1 01820006 + IVCORR = 9999 01830006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01840006 +C 01850006 +C TESTS 54 THROUGH 57 CONTAIN POSITIVE SIGNED INTEGERS 01860006 +C 01870006 + 541 CONTINUE 01880006 + IVTNUM = 54 01890006 +C 01900006 +C **** TEST 54 **** 01910006 +C 01920006 + IF (ICZERO) 30540, 540, 30540 01930006 + 540 CONTINUE 01940006 + IVCOMP = +3 01950006 + GO TO 40540 01960006 +30540 IVDELE = IVDELE + 1 01970006 + WRITE (I02,80003) IVTNUM 01980006 + IF (ICZERO) 40540, 551, 40540 01990006 +40540 IF (IVCOMP - 3) 20540, 10540, 20540 02000006 +10540 IVPASS = IVPASS + 1 02010006 + WRITE (I02,80001) IVTNUM 02020006 + GO TO 551 02030006 +20540 IVFAIL = IVFAIL + 1 02040006 + IVCORR = 3 02050006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02060006 + 551 CONTINUE 02070006 + IVTNUM = 55 02080006 +C 02090006 +C **** TEST 55 **** 02100006 +C 02110006 + IF (ICZERO) 30550, 550, 30550 02120006 + 550 CONTINUE 02130006 + IVCOMP = +76 02140006 + GO TO 40550 02150006 +30550 IVDELE = IVDELE + 1 02160006 + WRITE (I02,80003) IVTNUM 02170006 + IF (ICZERO) 40550, 561, 40550 02180006 +40550 IF (IVCOMP - 76) 20550, 10550, 20550 02190006 +10550 IVPASS = IVPASS + 1 02200006 + WRITE (I02,80001) IVTNUM 02210006 + GO TO 561 02220006 +20550 IVFAIL = IVFAIL + 1 02230006 + IVCORR = 76 02240006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02250006 + 561 CONTINUE 02260006 + IVTNUM = 56 02270006 +C 02280006 +C **** TEST 56 **** 02290006 +C 02300006 + IF (ICZERO) 30560, 560, 30560 02310006 + 560 CONTINUE 02320006 + IVCOMP = +587 02330006 + GO TO 40560 02340006 +30560 IVDELE = IVDELE + 1 02350006 + WRITE (I02,80003) IVTNUM 02360006 + IF (ICZERO) 40560, 571, 40560 02370006 +40560 IF (IVCOMP - 587) 20560, 10560, 20560 02380006 +10560 IVPASS = IVPASS + 1 02390006 + WRITE (I02,80001) IVTNUM 02400006 + GO TO 571 02410006 +20560 IVFAIL = IVFAIL + 1 02420006 + IVCORR = 587 02430006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02440006 + 571 CONTINUE 02450006 + IVTNUM = 57 02460006 +C 02470006 +C **** TEST 57 **** 02480006 +C 02490006 + IF (ICZERO) 30570, 570, 30570 02500006 + 570 CONTINUE 02510006 + IVCOMP = +9999 02520006 + GO TO 40570 02530006 +30570 IVDELE = IVDELE + 1 02540006 + WRITE (I02,80003) IVTNUM 02550006 + IF (ICZERO) 40570, 581, 40570 02560006 +40570 IF (IVCOMP - 9999) 20570, 10570, 20570 02570006 +10570 IVPASS = IVPASS + 1 02580006 + WRITE (I02,80001) IVTNUM 02590006 + GO TO 581 02600006 +20570 IVFAIL = IVFAIL + 1 02610006 + IVCORR = 9999 02620006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02630006 +C 02640006 +C TESTS 58 THROUGH 61 CONTAIN SIGNED NEGATIVE INTEGERS 02650006 +C 02660006 + 581 CONTINUE 02670006 + IVTNUM = 58 02680006 +C 02690006 +C **** TEST 58 **** 02700006 +C 02710006 + IF (ICZERO) 30580, 580, 30580 02720006 + 580 CONTINUE 02730006 + IVCOMP = -3 02740006 + GO TO 40580 02750006 +30580 IVDELE = IVDELE + 1 02760006 + WRITE (I02,80003) IVTNUM 02770006 + IF (ICZERO) 40580, 591, 40580 02780006 +40580 IF (IVCOMP + 3) 20580, 10580, 20580 02790006 +10580 IVPASS = IVPASS + 1 02800006 + WRITE (I02,80001) IVTNUM 02810006 + GO TO 591 02820006 +20580 IVFAIL = IVFAIL + 1 02830006 + IVCORR = -3 02840006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02850006 + 591 CONTINUE 02860006 + IVTNUM = 59 02870006 +C 02880006 +C **** TEST 59 **** 02890006 +C 02900006 + IF (ICZERO) 30590, 590, 30590 02910006 + 590 CONTINUE 02920006 + IVCOMP = -76 02930006 + GO TO 40590 02940006 +30590 IVDELE = IVDELE + 1 02950006 + WRITE (I02,80003) IVTNUM 02960006 + IF (ICZERO) 40590, 601, 40590 02970006 +40590 IF (IVCOMP + 76) 20590, 10590, 20590 02980006 +10590 IVPASS = IVPASS + 1 02990006 + WRITE (I02,80001) IVTNUM 03000006 + GO TO 601 03010006 +20590 IVFAIL = IVFAIL + 1 03020006 + IVCORR = -76 03030006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03040006 + 601 CONTINUE 03050006 + IVTNUM = 60 03060006 +C 03070006 +C **** TEST 60 **** 03080006 +C 03090006 + IF (ICZERO) 30600, 600, 30600 03100006 + 600 CONTINUE 03110006 + IVCOMP = -587 03120006 + GO TO 40600 03130006 +30600 IVDELE = IVDELE + 1 03140006 + WRITE (I02,80003) IVTNUM 03150006 + IF (ICZERO) 40600, 611, 40600 03160006 +40600 IF (IVCOMP + 587) 20600,10600,20600 03170006 +10600 IVPASS = IVPASS + 1 03180006 + WRITE (I02,80001) IVTNUM 03190006 + GO TO 611 03200006 +20600 IVFAIL = IVFAIL + 1 03210006 + IVCORR = -587 03220006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03230006 + 611 CONTINUE 03240006 + IVTNUM = 61 03250006 +C 03260006 +C **** TEST 61 **** 03270006 +C 03280006 + IF (ICZERO) 30610, 610, 30610 03290006 + 610 CONTINUE 03300006 + IVCOMP = -9999 03310006 + GO TO 40610 03320006 +30610 IVDELE = IVDELE + 1 03330006 + WRITE (I02,80003) IVTNUM 03340006 + IF (ICZERO) 40610, 621, 40610 03350006 +40610 IF (IVCOMP + 9999) 20610, 10610, 20610 03360006 +10610 IVPASS = IVPASS + 1 03370006 + WRITE (I02,80001) IVTNUM 03380006 + GO TO 621 03390006 +20610 IVFAIL = IVFAIL + 1 03400006 + IVCORR = -9999 03410006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03420006 +C 03430006 +C TEST 62 THROUGH TEST 73 CONTAIN STATEMENT OF FORM 03440006 +C INTEGER VARIABLE = INTEGER VARIABLE 03450006 +C 03460006 +C TESTS 62 THROUGH 65 CONTAIN UNSIGNED VALUES. 03470006 +C 03480006 + 621 CONTINUE 03490006 + IVTNUM = 62 03500006 +C 03510006 +C **** TEST 62 **** 03520006 +C 03530006 + IF (ICZERO) 30620, 620, 30620 03540006 + 620 CONTINUE 03550006 + IVON01 = 3 03560006 + IVCOMP = IVON01 03570006 + GO TO 40620 03580006 +30620 IVDELE = IVDELE + 1 03590006 + WRITE (I02,80003) IVTNUM 03600006 + IF (ICZERO) 40620, 631, 40620 03610006 +40620 IF (IVCOMP - 3) 20620, 10620, 20620 03620006 +10620 IVPASS = IVPASS + 1 03630006 + WRITE (I02,80001) IVTNUM 03640006 + GO TO 631 03650006 +20620 IVFAIL = IVFAIL + 1 03660006 + IVCORR = 3 03670006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03680006 + 631 CONTINUE 03690006 + IVTNUM = 63 03700006 +C 03710006 +C **** TEST 63 **** 03720006 +C 03730006 + IF (ICZERO) 30630, 630, 30630 03740006 + 630 CONTINUE 03750006 + IVON01 = 76 03760006 + IVCOMP = IVON01 03770006 + GO TO 40630 03780006 +30630 IVDELE = IVDELE + 1 03790006 + WRITE (I02,80003) IVTNUM 03800006 + IF (ICZERO) 40630, 641, 40630 03810006 +40630 IF (IVCOMP - 76) 20630, 10630, 20630 03820006 +10630 IVPASS = IVPASS + 1 03830006 + WRITE (I02,80001) IVTNUM 03840006 + GO TO 641 03850006 +20630 IVFAIL = IVFAIL + 1 03860006 + IVCORR = 76 03870006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03880006 + 641 CONTINUE 03890006 + IVTNUM = 64 03900006 +C 03910006 +C **** TEST 64 **** 03920006 +C 03930006 + IF (ICZERO) 30640, 640, 30640 03940006 + 640 CONTINUE 03950006 + IVON01 = 587 03960006 + IVCOMP = IVON01 03970006 + GO TO 40640 03980006 +30640 IVDELE = IVDELE + 1 03990006 + WRITE (I02,80003) IVTNUM 04000006 + IF (ICZERO) 40640, 651, 40640 04010006 +40640 IF (IVCOMP - 587) 20640, 10640, 20640 04020006 +10640 IVPASS = IVPASS + 1 04030006 + WRITE (I02,80001) IVTNUM 04040006 + GO TO 651 04050006 +20640 IVFAIL = IVFAIL + 1 04060006 + IVCORR = 587 04070006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04080006 + 651 CONTINUE 04090006 + IVTNUM = 65 04100006 +C 04110006 +C **** TEST 65 **** 04120006 +C 04130006 + IF (ICZERO) 30650, 650, 30650 04140006 + 650 CONTINUE 04150006 + IVON01 = 9999 04160006 + IVCOMP = IVON01 04170006 + GO TO 40650 04180006 +30650 IVDELE = IVDELE + 1 04190006 + WRITE (I02,80003) IVTNUM 04200006 + IF (ICZERO) 40650, 661, 40650 04210006 +40650 IF (IVCOMP - 9999) 20650, 10650, 20650 04220006 +10650 IVPASS = IVPASS + 1 04230006 + WRITE (I02,80001) IVTNUM 04240006 + GO TO 661 04250006 +20650 IVFAIL = IVFAIL + 1 04260006 + IVCORR = 9999 04270006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04280006 +C 04290006 +C TESTS 66 THROUGH 69 CONTAIN POSITIVE VALUES. 04300006 +C 04310006 + 661 CONTINUE 04320006 + IVTNUM = 66 04330006 +C 04340006 +C **** TEST 66 **** 04350006 +C 04360006 + IF (ICZERO) 30660, 660, 30660 04370006 + 660 CONTINUE 04380006 + IVON01 = +3 04390006 + IVCOMP = IVON01 04400006 + GO TO 40660 04410006 +30660 IVDELE = IVDELE + 1 04420006 + WRITE (I02,80003) IVTNUM 04430006 + IF (ICZERO) 40660, 671, 40660 04440006 +40660 IF (IVCOMP - 3) 20660,10660,20660 04450006 +10660 IVPASS = IVPASS + 1 04460006 + WRITE (I02,80001) IVTNUM 04470006 + GO TO 671 04480006 +20660 IVFAIL = IVFAIL + 1 04490006 + IVCORR = 3 04500006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04510006 + 671 CONTINUE 04520006 + IVTNUM = 67 04530006 +C 04540006 +C **** TEST 67 **** 04550006 +C 04560006 + IF (ICZERO) 30670, 670, 30670 04570006 + 670 CONTINUE 04580006 + IVON01 = +76 04590006 + IVCOMP = IVON01 04600006 + GO TO 40670 04610006 +30670 IVDELE = IVDELE + 1 04620006 + WRITE (I02,80003) IVTNUM 04630006 + IF (ICZERO) 40670, 681, 40670 04640006 +40670 IF (IVCOMP - 76) 20670, 10670, 20670 04650006 +10670 IVPASS = IVPASS + 1 04660006 + WRITE (I02,80001) IVTNUM 04670006 + GO TO 681 04680006 +20670 IVFAIL = IVFAIL + 1 04690006 + IVCORR = 76 04700006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04710006 + 681 CONTINUE 04720006 + IVTNUM = 68 04730006 +C 04740006 +C **** TEST 68 **** 04750006 +C 04760006 + IF (ICZERO) 30680, 680, 30680 04770006 + 680 CONTINUE 04780006 + IVON01 = +587 04790006 + IVCOMP = IVON01 04800006 + GO TO 40680 04810006 +30680 IVDELE = IVDELE + 1 04820006 + WRITE (I02,80003) IVTNUM 04830006 + IF (ICZERO) 40680, 691, 40680 04840006 +40680 IF (IVCOMP - 587) 20680, 10680, 20680 04850006 +10680 IVPASS = IVPASS + 1 04860006 + WRITE (I02,80001) IVTNUM 04870006 + GO TO 691 04880006 +20680 IVFAIL = IVFAIL + 1 04890006 + IVCORR = 587 04900006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04910006 + 691 CONTINUE 04920006 + IVTNUM = 69 04930006 +C 04940006 +C **** TEST 69 **** 04950006 +C 04960006 + IF (ICZERO) 30690, 690, 30690 04970006 + 690 CONTINUE 04980006 + IVON01 = +9999 04990006 + IVCOMP = IVON01 05000006 + GO TO 40690 05010006 +30690 IVDELE = IVDELE + 1 05020006 + WRITE (I02,80003) IVTNUM 05030006 + IF (ICZERO) 40690, 701, 40690 05040006 +40690 IF (IVCOMP - 9999) 20690, 10690, 20690 05050006 +10690 IVPASS = IVPASS + 1 05060006 + WRITE (I02,80001) IVTNUM 05070006 + GO TO 701 05080006 +20690 IVFAIL = IVFAIL + 1 05090006 + IVCORR = 9999 05100006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05110006 +C 05120006 +C TESTS 70 THROUGH 73 CONTAIN NEGATIVE VALUES. 05130006 +C 05140006 + 701 CONTINUE 05150006 + IVTNUM = 70 05160006 +C 05170006 +C **** TEST 70 **** 05180006 +C 05190006 + IF (ICZERO) 30700, 700, 30700 05200006 + 700 CONTINUE 05210006 + IVON01 = -3 05220006 + IVCOMP = IVON01 05230006 + GO TO 40700 05240006 +30700 IVDELE = IVDELE + 1 05250006 + WRITE (I02,80003) IVTNUM 05260006 + IF (ICZERO) 40700, 711, 40700 05270006 +40700 IF (IVCOMP + 3) 20700, 10700, 20700 05280006 +10700 IVPASS = IVPASS + 1 05290006 + WRITE (I02,80001) IVTNUM 05300006 + GO TO 711 05310006 +20700 IVFAIL = IVFAIL + 1 05320006 + IVCORR = -3 05330006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05340006 + 711 CONTINUE 05350006 + IVTNUM = 71 05360006 +C 05370006 +C **** TEST 71 **** 05380006 +C 05390006 + IF (ICZERO) 30710, 710, 30710 05400006 + 710 CONTINUE 05410006 + IVON01 = -76 05420006 + IVCOMP = IVON01 05430006 + GO TO 40710 05440006 +30710 IVDELE = IVDELE + 1 05450006 + WRITE (I02,80003) IVTNUM 05460006 + IF (ICZERO) 40710, 721, 40710 05470006 +40710 IF (IVCOMP + 76) 20710, 10710, 20710 05480006 +10710 IVPASS = IVPASS + 1 05490006 + WRITE (I02,80001) IVTNUM 05500006 + GO TO 721 05510006 +20710 IVFAIL = IVFAIL + 1 05520006 + IVCORR = -76 05530006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05540006 + 721 CONTINUE 05550006 + IVTNUM = 72 05560006 +C 05570006 +C **** TEST 72 **** 05580006 +C 05590006 + IF (ICZERO) 30720, 720, 30720 05600006 + 720 CONTINUE 05610006 + IVON01 = -587 05620006 + IVCOMP = IVON01 05630006 + GO TO 40720 05640006 +30720 IVDELE = IVDELE + 1 05650006 + WRITE (I02,80003) IVTNUM 05660006 + IF (ICZERO) 40720, 731, 40720 05670006 +40720 IF (IVCOMP + 587) 20720, 10720, 20720 05680006 +10720 IVPASS = IVPASS + 1 05690006 + WRITE (I02,80001) IVTNUM 05700006 + GO TO 731 05710006 +20720 IVFAIL = IVFAIL + 1 05720006 + IVCORR = -587 05730006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05740006 + 731 CONTINUE 05750006 + IVTNUM = 73 05760006 +C 05770006 +C **** TEST 73 **** 05780006 +C 05790006 + IF (ICZERO) 30730, 730, 30730 05800006 + 730 CONTINUE 05810006 + IVON01 = -9999 05820006 + IVCOMP = IVON01 05830006 + GO TO 40730 05840006 +30730 IVDELE = IVDELE + 1 05850006 + WRITE (I02,80003) IVTNUM 05860006 + IF (ICZERO) 40730, 741, 40730 05870006 +40730 IF (IVCOMP + 9999) 20730, 10730, 20730 05880006 +10730 IVPASS = IVPASS + 1 05890006 + WRITE (I02,80001) IVTNUM 05900006 + GO TO 741 05910006 +20730 IVFAIL = IVFAIL + 1 05920006 + IVCORR = -9999 05930006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05940006 +C 05950006 +C TESTS 74 THROUGH 79 CHECK THAT AT LEAST 16 BITS ARE USED IN THE 05960006 +C INTERNAL REPRESENTATION OF AN INTEGER DATUM. THIS INCLUDES ONE 05970006 +C BIT FOR THE SIGN. THE LARGEST INTEGER USED IS 32767 =2**15 - 1, 05980006 +C AND THE SMALLEST INTEGER USED IS -32766. 05990006 +C 06000006 + 741 CONTINUE 06010006 + IVTNUM = 74 06020006 +C 06030006 +C **** TEST 74 **** 06040006 +C UNSIGNED CONSTANT 32767 06050006 +C 06060006 + IF (ICZERO) 30740, 740, 30740 06070006 + 740 CONTINUE 06080006 + IVCOMP = 32767 06090006 + GO TO 40740 06100006 +30740 IVDELE = IVDELE + 1 06110006 + WRITE (I02,80003) IVTNUM 06120006 + IF (ICZERO) 40740, 751, 40740 06130006 +40740 IF (IVCOMP - 32767) 20740, 10740, 20740 06140006 +10740 IVPASS = IVPASS + 1 06150006 + WRITE (I02,80001) IVTNUM 06160006 + GO TO 751 06170006 +20740 IVFAIL = IVFAIL + 1 06180006 + IVCORR = 32767 06190006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06200006 + 751 CONTINUE 06210006 + IVTNUM = 75 06220006 +C 06230006 +C **** TEST 75 **** 06240006 +C SIGNED POSITIVE CONSTANT +32767 06250006 +C 06260006 + IF (ICZERO) 30750, 750, 30750 06270006 + 750 CONTINUE 06280006 + IVCOMP = +32767 06290006 + GO TO 40750 06300006 +30750 IVDELE = IVDELE + 1 06310006 + WRITE (I02,80003) IVTNUM 06320006 + IF (ICZERO) 40750, 761, 40750 06330006 +40750 IF (IVCOMP - 32767) 20750, 10750, 20750 06340006 +10750 IVPASS = IVPASS + 1 06350006 + WRITE (I02,80001) IVTNUM 06360006 + GO TO 761 06370006 +20750 IVFAIL = IVFAIL + 1 06380006 + IVCORR = 32767 06390006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06400006 + 761 CONTINUE 06410006 + IVTNUM = 76 06420006 +C 06430006 +C **** TEST 76 **** 06440006 +C SIGNED NEGATIVE CONSTANT -32766 06450006 +C 06460006 + IF (ICZERO) 30760, 760, 30760 06470006 + 760 CONTINUE 06480006 + IVCOMP = - 32766 06490006 + GO TO 40760 06500006 +30760 IVDELE = IVDELE + 1 06510006 + WRITE (I02,80003) IVTNUM 06520006 + IF (ICZERO) 40760, 771, 40760 06530006 +40760 IF (IVCOMP + 32766) 20760, 10760, 20760 06540006 +10760 IVPASS = IVPASS + 1 06550006 + WRITE (I02,80001) IVTNUM 06560006 + GO TO 771 06570006 +20760 IVFAIL = IVFAIL + 1 06580006 + IVCORR = -32766 06590006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06600006 + 771 CONTINUE 06610006 + IVTNUM = 77 06620006 +C 06630006 +C **** TEST 77 **** 06640006 +C 06650006 + IF (ICZERO) 30770, 770, 30770 06660006 + 770 CONTINUE 06670006 + IVON01 = 32767 06680006 + IVCOMP = IVON01 06690006 + GO TO 40770 06700006 +30770 IVDELE = IVDELE + 1 06710006 + WRITE (I02,80003) IVTNUM 06720006 + IF (ICZERO) 40770, 781, 40770 06730006 +40770 IF (IVCOMP - 32767) 20770, 10770, 20770 06740006 +10770 IVPASS = IVPASS + 1 06750006 + WRITE (I02,80001) IVTNUM 06760006 + GO TO 781 06770006 +20770 IVFAIL = IVFAIL + 1 06780006 + IVCORR = 32767 06790006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06800006 + 781 CONTINUE 06810006 + IVTNUM = 78 06820006 +C 06830006 +C **** TEST 78 **** 06840006 +C 06850006 + IF (ICZERO) 30780, 780, 30780 06860006 + 780 CONTINUE 06870006 + IVON01 = +32767 06880006 + IVCOMP = IVON01 06890006 + GO TO 40780 06900006 +30780 IVDELE = IVDELE + 1 06910006 + WRITE (I02,80003) IVTNUM 06920006 + IF (ICZERO) 40780, 791, 40780 06930006 +40780 IF (IVCOMP - 32767) 20780, 10780, 20780 06940006 +10780 IVPASS = IVPASS + 1 06950006 + WRITE (I02,80001) IVTNUM 06960006 + GO TO 791 06970006 +20780 IVFAIL = IVFAIL + 1 06980006 + IVCORR = 32767 06990006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07000006 + 791 CONTINUE 07010006 + IVTNUM = 79 07020006 +C 07030006 +C **** TEST 79 **** 07040006 +C 07050006 + IF (ICZERO) 30790, 790, 30790 07060006 + 790 CONTINUE 07070006 + IVON01 = -32766 07080006 + IVCOMP=IVON01 07090006 + GO TO 40790 07100006 +30790 IVDELE = IVDELE + 1 07110006 + WRITE (I02,80003) IVTNUM 07120006 + IF (ICZERO) 40790, 801, 40790 07130006 +40790 IF (IVCOMP + 32766) 20790, 10790, 20790 07140006 +10790 IVPASS = IVPASS + 1 07150006 + WRITE (I02,80001) IVTNUM 07160006 + GO TO 801 07170006 +20790 IVFAIL = IVFAIL + 1 07180006 + IVCORR = -32766 07190006 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07200006 + 801 CONTINUE 07210006 +C 07220006 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07230006 +99999 CONTINUE 07240006 + WRITE (I02,90002) 07250006 + WRITE (I02,90006) 07260006 + WRITE (I02,90002) 07270006 + WRITE (I02,90002) 07280006 + WRITE (I02,90007) 07290006 + WRITE (I02,90002) 07300006 + WRITE (I02,90008) IVFAIL 07310006 + WRITE (I02,90009) IVPASS 07320006 + WRITE (I02,90010) IVDELE 07330006 +C 07340006 +C 07350006 +C TERMINATE ROUTINE EXECUTION 07360006 + STOP 07370006 +C 07380006 +C FORMAT STATEMENTS FOR PAGE HEADERS 07390006 +90000 FORMAT ("1") 07400006 +90002 FORMAT (" ") 07410006 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07420006 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07430006 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07440006 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07450006 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07460006 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07470006 +C 07480006 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07490006 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07500006 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07510006 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07520006 +C 07530006 +C FORMAT STATEMENTS FOR TEST RESULTS 07540006 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07550006 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07560006 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07570006 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07580006 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07590006 +C 07600006 +90007 FORMAT (" ",20X,"END OF PROGRAM FM006" ) 07610006 + END 07620006 diff --git a/Fortran/UnitTests/fcvs21_f95/FM006.reference_output b/Fortran/UnitTests/fcvs21_f95/FM006.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM006.reference_output @@ -0,0 +1,54 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 50 PASS + 51 PASS + 52 PASS + 53 PASS + 54 PASS + 55 PASS + 56 PASS + 57 PASS + 58 PASS + 59 PASS + 60 PASS + 61 PASS + 62 PASS + 63 PASS + 64 PASS + 65 PASS + 66 PASS + 67 PASS + 68 PASS + 69 PASS + 70 PASS + 71 PASS + 72 PASS + 73 PASS + 74 PASS + 75 PASS + 76 PASS + 77 PASS + 78 PASS + 79 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM006 + + 0 ERRORS ENCOUNTERED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM007.f b/Fortran/UnitTests/fcvs21_f95/FM007.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM007.f @@ -0,0 +1,542 @@ + PROGRAM FM007 + +C COMMENT SECTION 00010007 +C 00020007 +C FM007 00030007 +C 00040007 +C THIS ROUTINE TESTS THE USE OF DATA INITIALIZATION STATEMENTS. 00050007 +C DATA INITIALIZATION STATEMENTS ARE USED TO DEFINE INITIAL VALUES 00060007 +C OF INTEGER VARIABLES. THE DATA STATEMENTS CONTAIN UNSIGNED, 00070007 +C POSITIVE SIGNED AND NEGATIVE SIGNED INTEGER CONSTANTS. THE LAST 00080007 +C DATA STATEMENT CONTAINS THE FORM 00090007 +C J*INTEGER CONSTANT 00100007 +C WHICH INDICATES THE CONSTANT IS TO BE SPECIFIED J TIMES. 00110007 +C 00120007 +C THE TESTS IN THIS ROUTINE CHECK THE INTEGER VARIABLES IN THE 00130007 +C DATA STATEMENT FOR THE ASSIGNED INITIAL VALUES. 00140007 +C 00150007 +C REFERENCES 00160007 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00170007 +C X3.9-1978 00180007 +C 00190007 +C SECTION 4.3, INTEGER TYPE 00200007 +C SECTION 4.3.1, INTEGER CONSTANT 00210007 +C SECTION 9, DATA STATEMENT 00220007 +C 00230007 +C 00240007 +C DATA INITIALIZATION STATEMENTS 00250007 +C 00260007 + DATA IVON01,IVON02,IVON03,IVON04,IVON05/3,76,587,9999,21111/ 00270007 + DATA IVON06,IVON07,IVON08,IVON09,IVON10/+3,+76,+587,+9999,+21111/ 00280007 + DATA IVON11,IVON12,IVON13,IVON14,IVON15/-3,-76,-587,-9999,-21111/ 00290007 + DATA IVON16,IVON17,IVON18,IVON19,IVON20/ 2*119, 2*7, -427/ 00300007 +C 00310007 +C 00320007 +C ********************************************************** 00330007 +C 00340007 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350007 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360007 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370007 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380007 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390007 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400007 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410007 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420007 +C OF EXECUTING THESE TESTS. 00430007 +C 00440007 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450007 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460007 +C 00470007 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480007 +C 00490007 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00500007 +C SOFTWARE STANDARDS VALIDATION GROUP 00510007 +C BUILDING 225 RM A266 00520007 +C GAITHERSBURG, MD 20899 00530007 +C ********************************************************** 00540007 +C 00550007 +C 00560007 +C 00570007 +C INITIALIZATION SECTION 00580007 +C 00590007 +C INITIALIZE CONSTANTS 00600007 +C ************** 00610007 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620007 + I01 = 5 00630007 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640007 + I02 = 6 00650007 +C SYSTEM ENVIRONMENT SECTION 00660007 +C 00670007 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00680007 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690007 +C (UNIT NUMBER FOR CARD READER). 00700007 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710007 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720007 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730007 +C 00740007 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00750007 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760007 +C (UNIT NUMBER FOR PRINTER). 00770007 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780007 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790007 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800007 +C 00810007 + IVPASS=0 00820007 + IVFAIL=0 00830007 + IVDELE=0 00840007 + ICZERO=0 00850007 +C 00860007 +C WRITE PAGE HEADERS 00870007 + WRITE (I02,90000) 00880007 + WRITE (I02,90001) 00890007 + WRITE (I02,90002) 00900007 + WRITE (I02, 90002) 00910007 + WRITE (I02,90003) 00920007 + WRITE (I02,90002) 00930007 + WRITE (I02,90004) 00940007 + WRITE (I02,90002) 00950007 + WRITE (I02,90011) 00960007 + WRITE (I02,90002) 00970007 + WRITE (I02,90002) 00980007 + WRITE (I02,90005) 00990007 + WRITE (I02,90006) 01000007 + WRITE (I02,90002) 01010007 +C TEST SECTION 01020007 +C 01030007 +C TESTS 80 THROUGH 84 CHECK THE VALUES INITIALIZED BY THE DATA 01040007 +C STATEMENT CONTAINING IVON01,..., IVON05. 01050007 +C 01060007 + 801 CONTINUE 01070007 + IVTNUM = 80 01080007 +C 01090007 +C **** TEST 80 **** 01100007 +C 01110007 + IF (ICZERO) 30800, 800, 30800 01120007 + 800 CONTINUE 01130007 + IVCOMP = IVON01 01140007 + GO TO 40800 01150007 +30800 IVDELE = IVDELE + 1 01160007 + WRITE (I02,80003) IVTNUM 01170007 + IF (ICZERO) 40800, 811, 40800 01180007 +40800 IF (IVCOMP - 3) 20800, 10800,20800 01190007 +10800 IVPASS = IVPASS + 1 01200007 + WRITE (I02,80001) IVTNUM 01210007 + GO TO 811 01220007 +20800 IVFAIL = IVFAIL + 1 01230007 + IVCORR = 3 01240007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01250007 + 811 CONTINUE 01260007 + IVTNUM = 81 01270007 +C 01280007 +C **** TEST 81 **** 01290007 +C 01300007 + IF (ICZERO) 30810, 810, 30810 01310007 + 810 CONTINUE 01320007 + IVCOMP = IVON02 01330007 + GO TO 40810 01340007 +30810 IVDELE = IVDELE + 1 01350007 + WRITE (I02,80003) IVTNUM 01360007 + IF (ICZERO) 40810, 821, 40810 01370007 +40810 IF (IVCOMP - 76) 20810, 10810, 20810 01380007 +10810 IVPASS = IVPASS + 1 01390007 + WRITE (I02,80001) IVTNUM 01400007 + GO TO 821 01410007 +20810 IVFAIL = IVFAIL + 1 01420007 + IVCORR = 76 01430007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01440007 + 821 CONTINUE 01450007 + IVTNUM = 82 01460007 +C 01470007 +C **** TEST 82 **** 01480007 +C 01490007 + IF (ICZERO) 30820, 820, 30820 01500007 + 820 CONTINUE 01510007 + IVCOMP = IVON03 01520007 + GO TO 40820 01530007 +30820 IVDELE = IVDELE + 1 01540007 + WRITE (I02,80003) IVTNUM 01550007 + IF (ICZERO) 40820, 831, 40820 01560007 +40820 IF (IVCOMP - 587) 20820, 10820, 20820 01570007 +10820 IVPASS = IVPASS + 1 01580007 + WRITE (I02,80001) IVTNUM 01590007 + GO TO 831 01600007 +20820 IVFAIL = IVFAIL + 1 01610007 + IVCORR = 587 01620007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01630007 + 831 CONTINUE 01640007 + IVTNUM = 83 01650007 +C 01660007 +C **** TEST 83 **** 01670007 +C 01680007 + IF (ICZERO) 30830, 830, 30830 01690007 + 830 CONTINUE 01700007 + IVCOMP =IVON04 01710007 + GO TO 40830 01720007 +30830 IVDELE = IVDELE + 1 01730007 + WRITE (I02,80003) IVTNUM 01740007 + IF (ICZERO) 40830, 841, 40830 01750007 +40830 IF (IVCOMP - 9999) 20830, 10830, 20830 01760007 +10830 IVPASS = IVPASS + 1 01770007 + WRITE (I02,80001) IVTNUM 01780007 + GO TO 841 01790007 +20830 IVFAIL = IVFAIL + 1 01800007 + IVCORR = 9999 01810007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01820007 + 841 CONTINUE 01830007 + IVTNUM = 84 01840007 +C 01850007 +C **** TEST 84 **** 01860007 +C 01870007 + IF (ICZERO) 30840, 840, 30840 01880007 + 840 CONTINUE 01890007 + IVCOMP = IVON05 01900007 + GO TO 40840 01910007 +30840 IVDELE = IVDELE + 1 01920007 + WRITE (I02,80003) IVTNUM 01930007 + IF (ICZERO) 40840, 851, 40840 01940007 +40840 IF (IVCOMP - 21111) 20840, 10840, 20840 01950007 +10840 IVPASS = IVPASS + 1 01960007 + WRITE (I02,80001) IVTNUM 01970007 + GO TO 851 01980007 +20840 IVFAIL = IVFAIL + 1 01990007 + IVCORR = 21111 02000007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02010007 +C 02020007 +C TESTS 85 THROUGH 89 CHECK THE VALUES INITIALIZED BY THE DATA 02030007 +C STATEMENT CONTAINING IVON06,...,IVON10. 02040007 +C 02050007 + 851 CONTINUE 02060007 + IVTNUM = 85 02070007 +C 02080007 +C **** TEST 85 **** 02090007 +C 02100007 + IF (ICZERO) 30850, 850, 30850 02110007 + 850 CONTINUE 02120007 + IVCOMP=IVON06 02130007 + GO TO 40850 02140007 +30850 IVDELE = IVDELE + 1 02150007 + WRITE (I02,80003) IVTNUM 02160007 + IF (ICZERO) 40850, 861, 40850 02170007 +40850 IF (IVCOMP - 3) 20850, 10850, 20850 02180007 +10850 IVPASS = IVPASS + 1 02190007 + WRITE (I02,80001) IVTNUM 02200007 + GO TO 861 02210007 +20850 IVFAIL = IVFAIL + 1 02220007 + IVCORR = 3 02230007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02240007 + 861 CONTINUE 02250007 + IVTNUM = 86 02260007 +C 02270007 +C **** TEST 86 **** 02280007 +C 02290007 + IF (ICZERO) 30860, 860, 30860 02300007 + 860 CONTINUE 02310007 + IVCOMP = IVON07 02320007 + GO TO 40860 02330007 +30860 IVDELE = IVDELE + 1 02340007 + WRITE (I02,80003) IVTNUM 02350007 + IF (ICZERO) 40860, 871, 40860 02360007 +40860 IF (IVCOMP - 76) 20860, 10860, 20860 02370007 +10860 IVPASS = IVPASS + 1 02380007 + WRITE (I02,80001) IVTNUM 02390007 + GO TO 871 02400007 +20860 IVFAIL = IVFAIL + 1 02410007 + IVCORR = 76 02420007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02430007 + 871 CONTINUE 02440007 + IVTNUM = 87 02450007 +C 02460007 +C **** TEST 87 **** 02470007 +C 02480007 + IF (ICZERO) 30870, 870, 30870 02490007 + 870 CONTINUE 02500007 + IVCOMP = IVON08 02510007 + GO TO 40870 02520007 +30870 IVDELE = IVDELE + 1 02530007 + WRITE (I02,80003) IVTNUM 02540007 + IF (ICZERO) 40870, 881, 40870 02550007 +40870 IF (IVCOMP - 587) 20870, 10870, 20870 02560007 +10870 IVPASS = IVPASS + 1 02570007 + WRITE (I02,80001) IVTNUM 02580007 + GO TO 881 02590007 +20870 IVFAIL = IVFAIL + 1 02600007 + IVCORR = 587 02610007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02620007 + 881 CONTINUE 02630007 + IVTNUM = 88 02640007 +C 02650007 +C **** TEST 88 **** 02660007 +C 02670007 + IF (ICZERO) 30880, 880, 30880 02680007 + 880 CONTINUE 02690007 + IVCOMP = IVON09 02700007 + GO TO 40880 02710007 +30880 IVDELE = IVDELE + 1 02720007 + WRITE (I02,80003) IVTNUM 02730007 + IF (ICZERO) 40880, 891, 40880 02740007 +40880 IF (IVCOMP - 9999) 20880, 10880, 20880 02750007 +10880 IVPASS = IVPASS + 1 02760007 + WRITE (I02,80001) IVTNUM 02770007 + GO TO 891 02780007 +20880 IVFAIL = IVFAIL + 1 02790007 + IVCORR = 9999 02800007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02810007 + 891 CONTINUE 02820007 + IVTNUM = 89 02830007 +C 02840007 +C **** TEST 89 **** 02850007 +C 02860007 + IF (ICZERO) 30890, 890, 30890 02870007 + 890 CONTINUE 02880007 + IVCOMP = IVON10 02890007 + GO TO 40890 02900007 +30890 IVDELE = IVDELE + 1 02910007 + WRITE (I02,80003) IVTNUM 02920007 + IF (ICZERO) 40890, 901, 40890 02930007 +40890 IF (IVCOMP - 21111) 20890, 10890, 20890 02940007 +10890 IVPASS = IVPASS + 1 02950007 + WRITE (I02,80001) IVTNUM 02960007 + GO TO 901 02970007 +20890 IVFAIL = IVFAIL + 1 02980007 + IVCORR= 21111 02990007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03000007 +C 03010007 +C TESTS 90 THROUGH 94 CHECK THE VALUES INITIALIZED BY THE DATA 03020007 +C STATEMENT CONTAINING IVON11,...,IVON15. 03030007 +C 03040007 + 901 CONTINUE 03050007 + IVTNUM = 90 03060007 +C 03070007 +C **** TEST 90 **** 03080007 +C 03090007 + IF (ICZERO) 30900, 900, 30900 03100007 + 900 CONTINUE 03110007 + IVCOMP = IVON11 03120007 + GO TO 40900 03130007 +30900 IVDELE = IVDELE + 1 03140007 + WRITE (I02,80003) IVTNUM 03150007 + IF (ICZERO) 40900, 911, 40900 03160007 +40900 IF (IVCOMP + 3) 20900, 10900, 20900 03170007 +10900 IVPASS = IVPASS + 1 03180007 + WRITE (I02,80001) IVTNUM 03190007 + GO TO 911 03200007 +20900 IVFAIL = IVFAIL + 1 03210007 + IVCORR = -3 03220007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03230007 + 911 CONTINUE 03240007 + IVTNUM = 91 03250007 +C 03260007 +C **** TEST 91 **** 03270007 +C 03280007 + IF (ICZERO) 30910, 910, 30910 03290007 + 910 CONTINUE 03300007 + IVCOMP = IVON12 03310007 + GO TO 40910 03320007 +30910 IVDELE = IVDELE + 1 03330007 + WRITE (I02,80003) IVTNUM 03340007 + IF (ICZERO) 40910, 921, 40910 03350007 +40910 IF (IVCOMP + 76) 20910, 10910, 20910 03360007 +10910 IVPASS = IVPASS + 1 03370007 + WRITE (I02,80001) IVTNUM 03380007 + GO TO 921 03390007 +20910 IVFAIL = IVFAIL + 1 03400007 + IVCORR = -76 03410007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03420007 + 921 CONTINUE 03430007 + IVTNUM = 92 03440007 +C 03450007 +C **** TEST 92 **** 03460007 +C 03470007 + IF (ICZERO) 30920, 920, 30920 03480007 + 920 CONTINUE 03490007 + IVCOMP= IVON13 03500007 + GO TO 40920 03510007 +30920 IVDELE = IVDELE + 1 03520007 + WRITE (I02,80003) IVTNUM 03530007 + IF (ICZERO) 40920, 931, 40920 03540007 +40920 IF (IVCOMP + 587) 20920, 10920, 20920 03550007 +10920 IVPASS = IVPASS + 1 03560007 + WRITE (I02,80001) IVTNUM 03570007 + GO TO 931 03580007 +20920 IVFAIL = IVFAIL + 1 03590007 + IVCORR = -587 03600007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03610007 + 931 CONTINUE 03620007 + IVTNUM = 93 03630007 +C 03640007 +C **** TEST 93 **** 03650007 +C 03660007 + IF (ICZERO) 30930, 930, 30930 03670007 + 930 CONTINUE 03680007 + IVCOMP = IVON14 03690007 + GO TO 40930 03700007 +30930 IVDELE = IVDELE + 1 03710007 + WRITE (I02,80003) IVTNUM 03720007 + IF (ICZERO) 40930, 941, 40930 03730007 +40930 IF (IVCOMP + 9999) 20930, 10930, 20930 03740007 +10930 IVPASS = IVPASS + 1 03750007 + WRITE (I02,80001) IVTNUM 03760007 + GO TO 941 03770007 +20930 IVFAIL = IVFAIL + 1 03780007 + IVCORR = -9999 03790007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03800007 + 941 CONTINUE 03810007 + IVTNUM = 94 03820007 +C 03830007 +C **** TEST 94 **** 03840007 +C 03850007 + IF (ICZERO) 30940, 940, 30940 03860007 + 940 CONTINUE 03870007 + IVCOMP = IVON15 03880007 + GO TO 40940 03890007 +30940 IVDELE = IVDELE + 1 03900007 + WRITE (I02,80003) IVTNUM 03910007 + IF (ICZERO) 40940, 951, 40940 03920007 +40940 IF (IVCOMP + 21111) 20940, 10940, 20940 03930007 +10940 IVPASS = IVPASS + 1 03940007 + WRITE (I02,80001) IVTNUM 03950007 + GO TO 951 03960007 +20940 IVFAIL = IVFAIL + 1 03970007 + IVCORR = -21111 03980007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03990007 +C 04000007 +C TESTS 95 THROUGH 99 CHECK THE VALUES INITIALIZED BY THE DATA 04010007 +C STATEMENT CONTAINING IVON16,...,IVON20. 04020007 +C 04030007 + 951 CONTINUE 04040007 + IVTNUM = 95 04050007 +C 04060007 +C **** TEST 95 **** 04070007 +C 04080007 + IF (ICZERO) 30950, 950, 30950 04090007 + 950 CONTINUE 04100007 + IVCOMP =IVON16 04110007 + GO TO 40950 04120007 +30950 IVDELE = IVDELE + 1 04130007 + WRITE (I02,80003) IVTNUM 04140007 + IF (ICZERO) 40950, 961, 40950 04150007 +40950 IF (IVCOMP - 119) 20950, 10950, 20950 04160007 +10950 IVPASS = IVPASS + 1 04170007 + WRITE (I02,80001) IVTNUM 04180007 + GO TO 961 04190007 +20950 IVFAIL = IVFAIL + 1 04200007 + IVCORR = 119 04210007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04220007 + 961 CONTINUE 04230007 + IVTNUM = 96 04240007 +C 04250007 +C **** TEST 96 **** 04260007 +C 04270007 + IF (ICZERO) 30960, 960, 30960 04280007 + 960 CONTINUE 04290007 + IVCOMP=IVON17 04300007 + GO TO 40960 04310007 +30960 IVDELE = IVDELE + 1 04320007 + WRITE (I02,80003) IVTNUM 04330007 + IF (ICZERO) 40960, 971, 40960 04340007 +40960 IF (IVCOMP - 119) 20960, 10960, 20960 04350007 +10960 IVPASS = IVPASS + 1 04360007 + WRITE (I02,80001) IVTNUM 04370007 + GO TO 971 04380007 +20960 IVFAIL = IVFAIL + 1 04390007 + IVCORR = 119 04400007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04410007 + 971 CONTINUE 04420007 + IVTNUM = 97 04430007 +C 04440007 +C **** TEST 97 **** 04450007 +C 04460007 + IF (ICZERO) 30970, 970, 30970 04470007 + 970 CONTINUE 04480007 + IVCOMP = IVON18 04490007 + GO TO 40970 04500007 +30970 IVDELE = IVDELE + 1 04510007 + WRITE (I02,80003) IVTNUM 04520007 + IF (ICZERO) 40970, 981, 40970 04530007 +40970 IF (IVCOMP - 7) 20970, 10970, 20970 04540007 +10970 IVPASS = IVPASS + 1 04550007 + WRITE (I02,80001) IVTNUM 04560007 + GO TO 981 04570007 +20970 IVFAIL = IVFAIL + 1 04580007 + IVCORR = 7 04590007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04600007 + 981 CONTINUE 04610007 + IVTNUM = 98 04620007 +C 04630007 +C **** TEST 98 **** 04640007 +C 04650007 + IF (ICZERO) 30980, 980, 30980 04660007 + 980 CONTINUE 04670007 + IVCOMP = IVON19 04680007 + GO TO 40980 04690007 +30980 IVDELE = IVDELE + 1 04700007 + WRITE (I02,80003) IVTNUM 04710007 + IF (ICZERO) 40980, 991, 40980 04720007 +40980 IF (IVCOMP - 7) 20980, 10980, 20980 04730007 +10980 IVPASS = IVPASS + 1 04740007 + WRITE (I02,80001) IVTNUM 04750007 + GO TO 991 04760007 +20980 IVFAIL = IVFAIL + 1 04770007 + IVCORR = 7 04780007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04790007 + 991 CONTINUE 04800007 + IVTNUM = 99 04810007 +C 04820007 +C **** TEST 99 **** 04830007 +C 04840007 + IF (ICZERO) 30990, 990, 30990 04850007 + 990 CONTINUE 04860007 + IVCOMP = IVON20 04870007 + GO TO 40990 04880007 +30990 IVDELE = IVDELE + 1 04890007 + WRITE (I02,80003) IVTNUM 04900007 + IF (ICZERO) 40990, 1001, 40990 04910007 +40990 IF (IVCOMP + 427) 20990,10990,20990 04920007 +10990 IVPASS = IVPASS + 1 04930007 + WRITE (I02,80001) IVTNUM 04940007 + GO TO 1001 04950007 +20990 IVFAIL = IVFAIL + 1 04960007 + IVCORR = -427 04970007 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04980007 + 1001 CONTINUE 04990007 +C 05000007 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 05010007 +99999 CONTINUE 05020007 + WRITE (I02,90002) 05030007 + WRITE (I02,90006) 05040007 + WRITE (I02,90002) 05050007 + WRITE (I02,90002) 05060007 + WRITE (I02,90007) 05070007 + WRITE (I02,90002) 05080007 + WRITE (I02,90008) IVFAIL 05090007 + WRITE (I02,90009) IVPASS 05100007 + WRITE (I02,90010) IVDELE 05110007 +C 05120007 +C 05130007 +C TERMINATE ROUTINE EXECUTION 05140007 + STOP 05150007 +C 05160007 +C FORMAT STATEMENTS FOR PAGE HEADERS 05170007 +90000 FORMAT ("1") 05180007 +90002 FORMAT (" ") 05190007 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05200007 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 05210007 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 05220007 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 05230007 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 05240007 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 05250007 +C 05260007 +C FORMAT STATEMENTS FOR RUN SUMMARIES 05270007 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 05280007 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 05290007 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 05300007 +C 05310007 +C FORMAT STATEMENTS FOR TEST RESULTS 05320007 +80001 FORMAT (" ",4X,I5,7X,"PASS") 05330007 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 05340007 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 05350007 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 05360007 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 05370007 +C 05380007 +90007 FORMAT (" ",20X,"END OF PROGRAM FM007" ) 05390007 + END 05400007 diff --git a/Fortran/UnitTests/fcvs21_f95/FM007.reference_output b/Fortran/UnitTests/fcvs21_f95/FM007.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM007.reference_output @@ -0,0 +1,44 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 80 PASS + 81 PASS + 82 PASS + 83 PASS + 84 PASS + 85 PASS + 86 PASS + 87 PASS + 88 PASS + 89 PASS + 90 PASS + 91 PASS + 92 PASS + 93 PASS + 94 PASS + 95 PASS + 96 PASS + 97 PASS + 98 PASS + 99 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM007 + + 0 ERRORS ENCOUNTERED + 20 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM008.f b/Fortran/UnitTests/fcvs21_f95/FM008.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM008.f @@ -0,0 +1,863 @@ + PROGRAM FM008 + +C COMMENT SECTION. 00010008 +C 00020008 +C FM008 00030008 +C 00040008 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050008 +C FORM INTEGER VARIABLE = ARITHMETIC EXPRESSION 00060008 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00070008 +C OPERATOR + INTEGER CONSTANTS AND POSITIVE INTEGER VARIABLES. 00080008 +C SOME OF THE TESTS USE PARENTHESES TO GROUP ELEMENTS IN THE 00090008 +C ARITHMETIC EXPRESSION. 00100008 +C 00110008 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00120008 +C (1) TWO INTEGER CONSTANTS, 00130008 +C (2) THREE INTEGER CONSTANTS, 00140008 +C (3) THREE INTEGER CONSTANTS WITH PARENTHESES TO GROUP 00150008 +C ELEMENTS, 00160008 +C (4) ONE INTEGER VARIABLE AND ONE INTEGER CONSTANT, 00170008 +C (5) ONE INTEGER VARIABLE AND TWO INTEGER CONSTANTS, 00180008 +C (6) ONE INTEGER VARIABLE AND TWO INTEGER CONSTANTS WITH 00190008 +C PARENTHESES TO GROUP ELEMENTS. 00200008 +C 00210008 +C 00220008 +C REFERENCES 00230008 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00240008 +C X3.9-1978 00250008 +C 00260008 +C SECTION 4.3, INTEGER TYPE 00270008 +C SECTION 4.3.1, INTEGER CONSTANT 00280008 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00290008 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENTS 00300008 +C 00310008 +C 00320008 +C ********************************************************** 00330008 +C 00340008 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350008 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360008 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370008 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380008 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390008 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400008 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410008 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420008 +C OF EXECUTING THESE TESTS. 00430008 +C 00440008 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450008 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460008 +C 00470008 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480008 +C 00490008 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00500008 +C SOFTWARE STANDARDS VALIDATION GROUP 00510008 +C BUILDING 225 RM A266 00520008 +C GAITHERSBURG, MD 20899 00530008 +C ********************************************************** 00540008 +C 00550008 +C 00560008 +C 00570008 +C INITIALIZATION SECTION 00580008 +C 00590008 +C INITIALIZE CONSTANTS 00600008 +C ************** 00610008 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620008 + I01 = 5 00630008 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640008 + I02 = 6 00650008 +C SYSTEM ENVIRONMENT SECTION 00660008 +C 00670008 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00680008 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690008 +C (UNIT NUMBER FOR CARD READER). 00700008 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710008 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720008 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730008 +C 00740008 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00750008 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760008 +C (UNIT NUMBER FOR PRINTER). 00770008 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780008 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790008 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800008 +C 00810008 + IVPASS=0 00820008 + IVFAIL=0 00830008 + IVDELE=0 00840008 + ICZERO=0 00850008 +C 00860008 +C WRITE PAGE HEADERS 00870008 + WRITE (I02,90000) 00880008 + WRITE (I02,90001) 00890008 + WRITE (I02,90002) 00900008 + WRITE (I02, 90002) 00910008 + WRITE (I02,90003) 00920008 + WRITE (I02,90002) 00930008 + WRITE (I02,90004) 00940008 + WRITE (I02,90002) 00950008 + WRITE (I02,90011) 00960008 + WRITE (I02,90002) 00970008 + WRITE (I02,90002) 00980008 + WRITE (I02,90005) 00990008 + WRITE (I02,90006) 01000008 + WRITE (I02,90002) 01010008 +C TEST SECTION 01020008 +C 01030008 +C ARITHMETIC ASSIGNMENT STATEMENT 01040008 +C 01050008 +C TEST 200 THROUGH TEST 214 CONTAIN INTEGER CONSTANTS AND OPERATOR +01060008 +C IN ARITHMETIC EXPRESSION. 01070008 +C 01080008 +C TEST 200 THROUGH TEST 206 - TWO INTEGER CONSTANTS 01090008 +C 01100008 + 2001 CONTINUE 01110008 + IVTNUM = 200 01120008 +C 01130008 +C **** TEST 200 **** 01140008 +C 01150008 + IF (ICZERO) 32000, 2000, 32000 01160008 + 2000 CONTINUE 01170008 + IVCOMP = 2+3 01180008 + GO TO 42000 01190008 +32000 IVDELE = IVDELE + 1 01200008 + WRITE (I02,80003) IVTNUM 01210008 + IF (ICZERO) 42000, 2011, 42000 01220008 +42000 IF (IVCOMP - 5) 22000,12000,22000 01230008 +12000 IVPASS = IVPASS + 1 01240008 + WRITE (I02,80001) IVTNUM 01250008 + GO TO 2011 01260008 +22000 IVFAIL = IVFAIL + 1 01270008 + IVCORR = 5 01280008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01290008 + 2011 CONTINUE 01300008 + IVTNUM = 201 01310008 +C 01320008 +C **** TEST 201 **** 01330008 +C 01340008 + IF (ICZERO) 32010, 2010, 32010 01350008 + 2010 CONTINUE 01360008 + IVCOMP = 51 + 52 01370008 + GO TO 42010 01380008 +32010 IVDELE = IVDELE + 1 01390008 + WRITE (I02,80003) IVTNUM 01400008 + IF (ICZERO) 42010, 2021, 42010 01410008 +42010 IF (IVCOMP - 103) 22010,12010,22010 01420008 +12010 IVPASS = IVPASS + 1 01430008 + WRITE (I02,80001) IVTNUM 01440008 + GO TO 2021 01450008 +22010 IVFAIL = IVFAIL + 1 01460008 + IVCORR = 103 01470008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01480008 + 2021 CONTINUE 01490008 + IVTNUM = 202 01500008 +C 01510008 +C **** TEST 202 **** 01520008 +C 01530008 + IF (ICZERO) 32020, 2020, 32020 01540008 + 2020 CONTINUE 01550008 + IVCOMP = 189 + 676 01560008 + GO TO 42020 01570008 +32020 IVDELE = IVDELE + 1 01580008 + WRITE (I02,80003) IVTNUM 01590008 + IF (ICZERO) 42020, 2031, 42020 01600008 +42020 IF (IVCOMP - 865) 22020,12020,22020 01610008 +12020 IVPASS = IVPASS + 1 01620008 + WRITE (I02,80001) IVTNUM 01630008 + GO TO 2031 01640008 +22020 IVFAIL = IVFAIL + 1 01650008 + IVCORR = 865 01660008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01670008 + 2031 CONTINUE 01680008 + IVTNUM = 203 01690008 +C 01700008 +C **** TEST 203 **** 01710008 +C 01720008 + IF (ICZERO) 32030, 2030, 32030 01730008 + 2030 CONTINUE 01740008 + IVCOMP = 1358 + 8001 01750008 + GO TO 42030 01760008 +32030 IVDELE = IVDELE + 1 01770008 + WRITE (I02,80003) IVTNUM 01780008 + IF (ICZERO) 42030, 2041, 42030 01790008 +42030 IF (IVCOMP - 9359) 22030, 12030, 22030 01800008 +12030 IVPASS = IVPASS + 1 01810008 + WRITE (I02,80001) IVTNUM 01820008 + GO TO 2041 01830008 +22030 IVFAIL = IVFAIL + 1 01840008 + IVCORR = 9359 01850008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01860008 + 2041 CONTINUE 01870008 + IVTNUM = 204 01880008 +C 01890008 +C **** TEST 204 **** 01900008 +C 01910008 + IF (ICZERO) 32040, 2040, 32040 01920008 + 2040 CONTINUE 01930008 + IVCOMP = 11112 + 10001 01940008 + GO TO 42040 01950008 +32040 IVDELE = IVDELE + 1 01960008 + WRITE (I02,80003) IVTNUM 01970008 + IF (ICZERO) 42040, 2051, 42040 01980008 +42040 IF (IVCOMP - 21113) 22040, 12040, 22040 01990008 +12040 IVPASS = IVPASS + 1 02000008 + WRITE (I02,80001) IVTNUM 02010008 + GO TO 2051 02020008 +22040 IVFAIL = IVFAIL + 1 02030008 + IVCORR=21113 02040008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02050008 + 2051 CONTINUE 02060008 + IVTNUM = 205 02070008 +C 02080008 +C **** TEST 205 **** 02090008 +C 02100008 + IF (ICZERO) 32050, 2050, 32050 02110008 + 2050 CONTINUE 02120008 + IVCOMP = 189 + 9876 02130008 + GO TO 42050 02140008 +32050 IVDELE = IVDELE + 1 02150008 + WRITE (I02,80003) IVTNUM 02160008 + IF (ICZERO) 42050, 2061, 42050 02170008 +42050 IF (IVCOMP - 10065) 22050,12050,22050 02180008 +12050 IVPASS = IVPASS + 1 02190008 + WRITE (I02,80001) IVTNUM 02200008 + GO TO 2061 02210008 +22050 IVFAIL = IVFAIL + 1 02220008 + IVCORR = 10065 02230008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02240008 + 2061 CONTINUE 02250008 + IVTNUM = 206 02260008 +C 02270008 +C **** TEST 206 **** 02280008 +C REQUIRES 32767 02290008 +C 02300008 + IF (ICZERO) 32060, 2060, 32060 02310008 + 2060 CONTINUE 02320008 + IVCOMP = 32752 + 15 02330008 + GO TO 42060 02340008 +32060 IVDELE = IVDELE + 1 02350008 + WRITE (I02,80003) IVTNUM 02360008 + IF (ICZERO) 42060, 2071, 42060 02370008 +42060 IF (IVCOMP - 32767) 22060,12060,22060 02380008 +12060 IVPASS = IVPASS + 1 02390008 + WRITE (I02,80001) IVTNUM 02400008 + GO TO 2071 02410008 +22060 IVFAIL = IVFAIL + 1 02420008 + IVCORR = 32767 02430008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02440008 +C 02450008 +C TEST 207 THROUGH TEST 210 - THREE INTEGER CONSTANTS 02460008 +C 02470008 + 2071 CONTINUE 02480008 + IVTNUM = 207 02490008 +C 02500008 +C **** TEST 207 **** 02510008 +C 02520008 + IF (ICZERO) 32070, 2070, 32070 02530008 + 2070 CONTINUE 02540008 + IVCOMP = 2+3+4 02550008 + GO TO 42070 02560008 +32070 IVDELE = IVDELE + 1 02570008 + WRITE (I02,80003) IVTNUM 02580008 + IF (ICZERO) 42070, 2081, 42070 02590008 +42070 IF (IVCOMP - 9) 22070,12070,22070 02600008 +12070 IVPASS = IVPASS + 1 02610008 + WRITE (I02,80001) IVTNUM 02620008 + GO TO 2081 02630008 +22070 IVFAIL = IVFAIL + 1 02640008 + IVCORR = 9 02650008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02660008 + 2081 CONTINUE 02670008 + IVTNUM = 208 02680008 +C 02690008 +C **** TEST 208 **** 02700008 +C 02710008 + IF (ICZERO) 32080, 2080, 32080 02720008 + 2080 CONTINUE 02730008 + IVCOMP = 51 + 52 + 53 02740008 + GO TO 42080 02750008 +32080 IVDELE = IVDELE + 1 02760008 + WRITE (I02,80003) IVTNUM 02770008 + IF (ICZERO) 42080, 2091, 42080 02780008 +42080 IF (IVCOMP - 156) 22080,12080,22080 02790008 +12080 IVPASS = IVPASS + 1 02800008 + WRITE (I02,80001) IVTNUM 02810008 + GO TO 2091 02820008 +22080 IVFAIL = IVFAIL + 1 02830008 + IVCORR = 156 02840008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02850008 + 2091 CONTINUE 02860008 + IVTNUM = 209 02870008 +C 02880008 +C **** TEST 209 **** 02890008 +C 02900008 + IF (ICZERO) 32090, 2090, 32090 02910008 + 2090 CONTINUE 02920008 + IVCOMP = 189 +676+101 02930008 + GO TO 42090 02940008 +32090 IVDELE = IVDELE + 1 02950008 + WRITE (I02,80003) IVTNUM 02960008 + IF (ICZERO) 42090, 2101, 42090 02970008 +42090 IF (IVCOMP - 966) 22090,12090,22090 02980008 +12090 IVPASS = IVPASS + 1 02990008 + WRITE (I02,80001) IVTNUM 03000008 + GO TO 2101 03010008 +22090 IVFAIL = IVFAIL + 1 03020008 + IVCORR = 966 03030008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03040008 + 2101 CONTINUE 03050008 + IVTNUM = 210 03060008 +C 03070008 +C **** TEST 210 **** 03080008 +C 03090008 + IF (ICZERO) 32100, 2100, 32100 03100008 + 2100 CONTINUE 03110008 + IVCOMP = 1358 + 8001 + 2189 03120008 + GO TO 42100 03130008 +32100 IVDELE = IVDELE + 1 03140008 + WRITE (I02,80003) IVTNUM 03150008 + IF (ICZERO) 42100, 2111, 42100 03160008 +42100 IF (IVCOMP - 11548) 22100,12100,22100 03170008 +12100 IVPASS = IVPASS + 1 03180008 + WRITE (I02,80001) IVTNUM 03190008 + GO TO 2111 03200008 +22100 IVFAIL = IVFAIL + 1 03210008 + IVCORR = 11548 03220008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03230008 +C 03240008 +C TESTS 211 THROUGH 214 ARE THE SAME AS 207 THROUGH 210 EXCEPT 03250008 +C PARENTHESES ARE USED TO GROUP THE CONSTANTS. 03260008 +C 03270008 + 2111 CONTINUE 03280008 + IVTNUM = 211 03290008 +C 03300008 +C **** TEST 211 **** 03310008 +C 03320008 + IF (ICZERO) 32110, 2110, 32110 03330008 + 2110 CONTINUE 03340008 + IVCOMP = (2+3)+4 03350008 + GO TO 42110 03360008 +32110 IVDELE = IVDELE + 1 03370008 + WRITE (I02,80003) IVTNUM 03380008 + IF (ICZERO) 42110, 2121, 42110 03390008 +42110 IF (IVCOMP -9) 22110,12110,22110 03400008 +12110 IVPASS = IVPASS + 1 03410008 + WRITE (I02,80001) IVTNUM 03420008 + GO TO 2121 03430008 +22110 IVFAIL = IVFAIL + 1 03440008 + IVCORR = 9 03450008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03460008 + 2121 CONTINUE 03470008 + IVTNUM = 212 03480008 +C 03490008 +C **** TEST 212 **** 03500008 +C 03510008 + IF (ICZERO) 32120, 2120, 32120 03520008 + 2120 CONTINUE 03530008 + IVCOMP = 51+(52+53) 03540008 + GO TO 42120 03550008 +32120 IVDELE = IVDELE + 1 03560008 + WRITE (I02,80003) IVTNUM 03570008 + IF (ICZERO) 42120, 2131, 42120 03580008 +42120 IF (IVCOMP - 156) 22120,12120,22120 03590008 +12120 IVPASS = IVPASS + 1 03600008 + WRITE (I02,80001) IVTNUM 03610008 + GO TO 2131 03620008 +22120 IVFAIL = IVFAIL + 1 03630008 + IVCORR = 156 03640008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03650008 + 2131 CONTINUE 03660008 + IVTNUM = 213 03670008 +C 03680008 +C **** TEST 213 **** 03690008 +C 03700008 + IF (ICZERO) 32130, 2130, 32130 03710008 + 2130 CONTINUE 03720008 + IVCOMP = 189 +(676+101) 03730008 + GO TO 42130 03740008 +32130 IVDELE = IVDELE + 1 03750008 + WRITE (I02,80003) IVTNUM 03760008 + IF (ICZERO) 42130, 2141, 42130 03770008 +42130 IF (IVCOMP - 966) 22130,12130,22130 03780008 +12130 IVPASS = IVPASS + 1 03790008 + WRITE (I02,80001) IVTNUM 03800008 + GO TO 2141 03810008 +22130 IVFAIL = IVFAIL + 1 03820008 + IVCORR = 966 03830008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03840008 + 2141 CONTINUE 03850008 + IVTNUM = 214 03860008 +C 03870008 +C **** TEST 214 **** 03880008 +C 03890008 + IF (ICZERO) 32140, 2140, 32140 03900008 + 2140 CONTINUE 03910008 + IVCOMP = (1358+2189) + 8001 03920008 + GO TO 42140 03930008 +32140 IVDELE = IVDELE + 1 03940008 + WRITE (I02,80003) IVTNUM 03950008 + IF (ICZERO) 42140, 2151, 42140 03960008 +42140 IF (IVCOMP - 11548) 22140,12140,22140 03970008 +12140 IVPASS = IVPASS + 1 03980008 + WRITE (I02,80001) IVTNUM 03990008 + GO TO 2151 04000008 +22140 IVFAIL = IVFAIL + 1 04010008 + IVCORR = 11548 04020008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04030008 +C 04040008 +C TEST 215 THROUGH TEST 234 CONTAIN INTEGER VARIABLES, INTEGER 04050008 +C CONSTANTS AND THE OPERATOR + IN ARITHMETIC EXPRESSION. 04060008 +C 04070008 +C TEST 215 THROUGH TEST 219 - ONE INTEGER VARIABLE AND ONE INTEGER 04080008 +C CONSTANT IN ARITHMETIC EXPRESSION. 04090008 +C 04100008 + 2151 CONTINUE 04110008 + IVTNUM = 215 04120008 +C 04130008 +C **** TEST 215 **** 04140008 +C 04150008 + IF (ICZERO) 32150, 2150, 32150 04160008 + 2150 CONTINUE 04170008 + IVON01 = 2 04180008 + IVCOMP = IVON01 + 3 04190008 + GO TO 42150 04200008 +32150 IVDELE = IVDELE + 1 04210008 + WRITE (I02,80003) IVTNUM 04220008 + IF (ICZERO) 42150, 2161, 42150 04230008 +42150 IF (IVCOMP - 5) 22150,12150,22150 04240008 +12150 IVPASS = IVPASS + 1 04250008 + WRITE (I02,80001) IVTNUM 04260008 + GO TO 2161 04270008 +22150 IVFAIL = IVFAIL + 1 04280008 + IVCORR=5 04290008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04300008 + 2161 CONTINUE 04310008 + IVTNUM = 216 04320008 +C 04330008 +C **** TEST 216 **** 04340008 +C 04350008 + IF (ICZERO) 32160, 2160, 32160 04360008 + 2160 CONTINUE 04370008 + IVON01 = 3 04380008 + IVCOMP = 2 + IVON01 04390008 + GO TO 42160 04400008 +32160 IVDELE = IVDELE + 1 04410008 + WRITE (I02,80003) IVTNUM 04420008 + IF (ICZERO) 42160, 2171, 42160 04430008 +42160 IF (IVCOMP - 5) 22160,12160,22160 04440008 +12160 IVPASS = IVPASS + 1 04450008 + WRITE (I02,80001) IVTNUM 04460008 + GO TO 2171 04470008 +22160 IVFAIL = IVFAIL + 1 04480008 + IVCORR = 5 04490008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04500008 + 2171 CONTINUE 04510008 + IVTNUM = 217 04520008 +C 04530008 +C **** TEST 217 **** 04540008 +C 04550008 + IF (ICZERO) 32170, 2170, 32170 04560008 + 2170 CONTINUE 04570008 + IVON01 = 51 04580008 + IVCOMP = IVON01 +52 04590008 + GO TO 42170 04600008 +32170 IVDELE = IVDELE + 1 04610008 + WRITE (I02,80003) IVTNUM 04620008 + IF (ICZERO) 42170, 2181, 42170 04630008 +42170 IF (IVCOMP - 103) 22170,12170,22170 04640008 +12170 IVPASS = IVPASS + 1 04650008 + WRITE (I02,80001) IVTNUM 04660008 + GO TO 2181 04670008 +22170 IVFAIL = IVFAIL + 1 04680008 + IVCORR = 103 04690008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04700008 + 2181 CONTINUE 04710008 + IVTNUM = 218 04720008 +C 04730008 +C **** TEST 218 **** 04740008 +C 04750008 + IF (ICZERO) 32180, 2180, 32180 04760008 + 2180 CONTINUE 04770008 + IVON01 = 676 04780008 + IVCOMP = 189 + IVON01 04790008 + GO TO 42180 04800008 +32180 IVDELE = IVDELE + 1 04810008 + WRITE (I02,80003) IVTNUM 04820008 + IF (ICZERO) 42180, 2191, 42180 04830008 +42180 IF (IVCOMP - 865) 22180,12180,22180 04840008 +12180 IVPASS = IVPASS + 1 04850008 + WRITE (I02,80001) IVTNUM 04860008 + GO TO 2191 04870008 +22180 IVFAIL = IVFAIL + 1 04880008 + IVCORR = 865 04890008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04900008 + 2191 CONTINUE 04910008 + IVTNUM = 219 04920008 +C 04930008 +C **** TEST 219 **** 04940008 +C 04950008 + IF (ICZERO) 32190, 2190, 32190 04960008 + 2190 CONTINUE 04970008 + IVON01 = 1358 04980008 + IVCOMP = IVON01 + 8001 04990008 + GO TO 42190 05000008 +32190 IVDELE = IVDELE + 1 05010008 + WRITE (I02,80003) IVTNUM 05020008 + IF (ICZERO) 42190, 2201, 42190 05030008 +42190 IF (IVCOMP - 9359) 22190,12190,22190 05040008 +12190 IVPASS = IVPASS + 1 05050008 + WRITE (I02,80001) IVTNUM 05060008 + GO TO 2201 05070008 +22190 IVFAIL = IVFAIL + 1 05080008 + IVCORR = 9359 05090008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05100008 +C 05110008 +C TEST 220 THROUGH TEST 224 - ONE INTEGER VARIABLE, TWO INTEGER 05120008 +C CONSTANTS IN ARITHMETIC EXPRESSION. 05130008 +C 05140008 + 2201 CONTINUE 05150008 + IVTNUM = 220 05160008 +C 05170008 +C **** TEST 220 **** 05180008 +C 05190008 + IF (ICZERO) 32200, 2200, 32200 05200008 + 2200 CONTINUE 05210008 + IVON01 = 2 05220008 + IVCOMP = IVON01 +3 +4 05230008 + GO TO 42200 05240008 +32200 IVDELE = IVDELE + 1 05250008 + WRITE (I02,80003) IVTNUM 05260008 + IF (ICZERO) 42200, 2211, 42200 05270008 +42200 IF (IVCOMP - 9) 22200,12200,22200 05280008 +12200 IVPASS = IVPASS + 1 05290008 + WRITE (I02,80001) IVTNUM 05300008 + GO TO 2211 05310008 +22200 IVFAIL = IVFAIL + 1 05320008 + IVCORR = 9 05330008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05340008 + 2211 CONTINUE 05350008 + IVTNUM = 221 05360008 +C 05370008 +C **** TEST 221 **** 05380008 +C 05390008 + IF (ICZERO) 32210, 2210, 32210 05400008 + 2210 CONTINUE 05410008 + IVON01 = 3 05420008 + IVCOMP = 2+IVON01+4 05430008 + GO TO 42210 05440008 +32210 IVDELE = IVDELE + 1 05450008 + WRITE (I02,80003) IVTNUM 05460008 + IF (ICZERO) 42210, 2221, 42210 05470008 +42210 IF (IVCOMP - 9) 22210,12210,22210 05480008 +12210 IVPASS = IVPASS + 1 05490008 + WRITE (I02,80001) IVTNUM 05500008 + GO TO 2221 05510008 +22210 IVFAIL = IVFAIL + 1 05520008 + IVCORR = 9 05530008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05540008 + 2221 CONTINUE 05550008 + IVTNUM = 222 05560008 +C 05570008 +C **** TEST 222 **** 05580008 +C 05590008 + IF (ICZERO) 32220, 2220, 32220 05600008 + 2220 CONTINUE 05610008 + IVON01 = 4 05620008 + IVCOMP= 2+3+IVON01 05630008 + GO TO 42220 05640008 +32220 IVDELE = IVDELE + 1 05650008 + WRITE (I02,80003) IVTNUM 05660008 + IF (ICZERO) 42220, 2231, 42220 05670008 +42220 IF (IVCOMP - 9) 22220,12220,22220 05680008 +12220 IVPASS = IVPASS + 1 05690008 + WRITE (I02,80001) IVTNUM 05700008 + GO TO 2231 05710008 +22220 IVFAIL = IVFAIL + 1 05720008 + IVCORR = 9 05730008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05740008 + 2231 CONTINUE 05750008 + IVTNUM = 223 05760008 +C 05770008 +C **** TEST 223 **** 05780008 +C 05790008 + IF (ICZERO) 32230, 2230, 32230 05800008 + 2230 CONTINUE 05810008 + IVON01 = 2189 05820008 + IVCOMP = 1358+IVON01+8001 05830008 + GO TO 42230 05840008 +32230 IVDELE = IVDELE + 1 05850008 + WRITE (I02,80003) IVTNUM 05860008 + IF (ICZERO) 42230, 2241, 42230 05870008 +42230 IF (IVCOMP - 11548) 22230,12230,22230 05880008 +12230 IVPASS = IVPASS + 1 05890008 + WRITE (I02,80001) IVTNUM 05900008 + GO TO 2241 05910008 +22230 IVFAIL = IVFAIL + 1 05920008 + IVCORR=11548 05930008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05940008 + 2241 CONTINUE 05950008 + IVTNUM = 224 05960008 +C 05970008 +C **** TEST 224 **** 05980008 +C 05990008 + IF (ICZERO) 32240, 2240, 32240 06000008 + 2240 CONTINUE 06010008 + IVON01 = 11111 06020008 + IVCOMP = 11111 + IVON01 + 10111 06030008 + GO TO 42240 06040008 +32240 IVDELE = IVDELE + 1 06050008 + WRITE (I02,80003) IVTNUM 06060008 + IF (ICZERO) 42240, 2251, 42240 06070008 +42240 IF (IVCOMP - 32333) 22240,12240,22240 06080008 +12240 IVPASS = IVPASS + 1 06090008 + WRITE (I02,80001) IVTNUM 06100008 + GO TO 2251 06110008 +22240 IVFAIL = IVFAIL + 1 06120008 + IVCORR = 32333 06130008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06140008 +C 06150008 +C TEST 225 THROUGH TEST 234 USE PARENTHESES TO GROUP ELEMENTS IN 06160008 +C AN ARITHMETIC EXPRESSION. THE RESULTS ARE THE SAME AS TESTS 06170008 +C 220 THROUGH 224. 06180008 +C 06190008 + 2251 CONTINUE 06200008 + IVTNUM = 225 06210008 +C 06220008 +C **** TEST 225 **** 06230008 +C 06240008 + IF (ICZERO) 32250, 2250, 32250 06250008 + 2250 CONTINUE 06260008 + IVON01 = 2 06270008 + IVCOMP = (IVON01 +3) + 4 06280008 + GO TO 42250 06290008 +32250 IVDELE = IVDELE + 1 06300008 + WRITE (I02,80003) IVTNUM 06310008 + IF (ICZERO) 42250, 2261, 42250 06320008 +42250 IF (IVCOMP -9) 22250,12250,22250 06330008 +12250 IVPASS = IVPASS + 1 06340008 + WRITE (I02,80001) IVTNUM 06350008 + GO TO 2261 06360008 +22250 IVFAIL = IVFAIL + 1 06370008 + IVCORR = 9 06380008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06390008 + 2261 CONTINUE 06400008 + IVTNUM = 226 06410008 +C 06420008 +C **** TEST 226 **** 06430008 +C 06440008 + IF (ICZERO) 32260, 2260, 32260 06450008 + 2260 CONTINUE 06460008 + IVON01 = 2 06470008 + IVCOMP = IVON01 + (3+4) 06480008 + GO TO 42260 06490008 +32260 IVDELE = IVDELE + 1 06500008 + WRITE (I02,80003) IVTNUM 06510008 + IF (ICZERO) 42260, 2271, 42260 06520008 +42260 IF (IVCOMP - 9) 22260,12260,22260 06530008 +12260 IVPASS = IVPASS + 1 06540008 + WRITE (I02,80001) IVTNUM 06550008 + GO TO 2271 06560008 +22260 IVFAIL = IVFAIL + 1 06570008 + IVCORR = 9 06580008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06590008 + 2271 CONTINUE 06600008 + IVTNUM = 227 06610008 +C 06620008 +C **** TEST 227 **** 06630008 +C 06640008 + IF (ICZERO) 32270, 2270, 32270 06650008 + 2270 CONTINUE 06660008 + IVON01 = 3 06670008 + IVCOMP = (2+IVON01) + 4 06680008 + GO TO 42270 06690008 +32270 IVDELE = IVDELE + 1 06700008 + WRITE (I02,80003) IVTNUM 06710008 + IF (ICZERO) 42270, 2281, 42270 06720008 +42270 IF (IVCOMP - 9) 22270,12270,22270 06730008 +12270 IVPASS = IVPASS + 1 06740008 + WRITE (I02,80001) IVTNUM 06750008 + GO TO 2281 06760008 +22270 IVFAIL = IVFAIL + 1 06770008 + IVCORR = 9 06780008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06790008 + 2281 CONTINUE 06800008 + IVTNUM = 228 06810008 +C 06820008 +C **** TEST 228 **** 06830008 +C 06840008 + IF (ICZERO) 32280, 2280, 32280 06850008 + 2280 CONTINUE 06860008 + IVON01 = 3 06870008 + IVCOMP = 2 +(IVON01+4) 06880008 + GO TO 42280 06890008 +32280 IVDELE = IVDELE + 1 06900008 + WRITE (I02,80003) IVTNUM 06910008 + IF (ICZERO) 42280, 2291, 42280 06920008 +42280 IF (IVCOMP - 9) 22280, 12280, 22280 06930008 +12280 IVPASS = IVPASS + 1 06940008 + WRITE (I02,80001) IVTNUM 06950008 + GO TO 2291 06960008 +22280 IVFAIL = IVFAIL + 1 06970008 + IVCORR = 9 06980008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06990008 + 2291 CONTINUE 07000008 + IVTNUM = 229 07010008 +C 07020008 +C **** TEST 229 **** 07030008 +C 07040008 + IF (ICZERO) 32290, 2290, 32290 07050008 + 2290 CONTINUE 07060008 + IVON01 = 4 07070008 + IVCOMP = (2+3)+IVON01 07080008 + GO TO 42290 07090008 +32290 IVDELE = IVDELE + 1 07100008 + WRITE (I02,80003) IVTNUM 07110008 + IF (ICZERO) 42290, 2301, 42290 07120008 +42290 IF (IVCOMP - 9) 22290,12290,22290 07130008 +12290 IVPASS = IVPASS + 1 07140008 + WRITE (I02,80001) IVTNUM 07150008 + GO TO 2301 07160008 +22290 IVFAIL = IVFAIL + 1 07170008 + IVCORR = 9 07180008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07190008 + 2301 CONTINUE 07200008 + IVTNUM = 230 07210008 +C 07220008 +C **** TEST 230 **** 07230008 +C 07240008 + IF (ICZERO) 32300, 2300, 32300 07250008 + 2300 CONTINUE 07260008 + IVON01 = 2189 07270008 + IVCOMP = 1358 + (IVON01+8001) 07280008 + GO TO 42300 07290008 +32300 IVDELE = IVDELE + 1 07300008 + WRITE (I02,80003) IVTNUM 07310008 + IF (ICZERO) 42300, 2311, 42300 07320008 +42300 IF (IVCOMP - 11548) 22300,12300,22300 07330008 +12300 IVPASS = IVPASS + 1 07340008 + WRITE (I02,80001) IVTNUM 07350008 + GO TO 2311 07360008 +22300 IVFAIL = IVFAIL + 1 07370008 + IVCORR = 11548 07380008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07390008 + 2311 CONTINUE 07400008 + IVTNUM = 231 07410008 +C 07420008 +C **** TEST 231 **** 07430008 +C 07440008 + IF (ICZERO) 32310, 2310, 32310 07450008 + 2310 CONTINUE 07460008 + IVON01 = 2189 07470008 + IVCOMP = (1358+IVON01) + 8001 07480008 + GO TO 42310 07490008 +32310 IVDELE = IVDELE + 1 07500008 + WRITE (I02,80003) IVTNUM 07510008 + IF (ICZERO) 42310, 2321, 42310 07520008 +42310 IF (IVCOMP - 11548) 22310,12310,22310 07530008 +12310 IVPASS = IVPASS + 1 07540008 + WRITE (I02,80001) IVTNUM 07550008 + GO TO 2321 07560008 +22310 IVFAIL = IVFAIL + 1 07570008 + IVCORR = 11548 07580008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07590008 + 2321 CONTINUE 07600008 + IVTNUM = 232 07610008 +C 07620008 +C **** TEST 232 **** 07630008 +C 07640008 + IF (ICZERO) 32320, 2320, 32320 07650008 + 2320 CONTINUE 07660008 + IVON01 = 11111 07670008 + IVCOMP = (11111 + IVON01) + 10111 07680008 + GO TO 42320 07690008 +32320 IVDELE = IVDELE + 1 07700008 + WRITE (I02,80003) IVTNUM 07710008 + IF (ICZERO) 42320, 2331, 42320 07720008 +42320 IF (IVCOMP - 32333) 22320,12320,22320 07730008 +12320 IVPASS = IVPASS + 1 07740008 + WRITE (I02,80001) IVTNUM 07750008 + GO TO 2331 07760008 +22320 IVFAIL = IVFAIL + 1 07770008 + IVCORR = 32333 07780008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07790008 + 2331 CONTINUE 07800008 + IVTNUM = 233 07810008 +C 07820008 +C **** TEST 233 **** 07830008 +C 07840008 + IF (ICZERO) 32330, 2330, 32330 07850008 + 2330 CONTINUE 07860008 + IVON01 = 11111 07870008 + IVCOMP = (IVON01 + 10111) + 11111 07880008 + GO TO 42330 07890008 +32330 IVDELE = IVDELE + 1 07900008 + WRITE (I02,80003) IVTNUM 07910008 + IF (ICZERO) 42330, 2341, 42330 07920008 +42330 IF (IVCOMP - 32333) 22330,12330,22330 07930008 +12330 IVPASS = IVPASS + 1 07940008 + WRITE (I02,80001) IVTNUM 07950008 + GO TO 2341 07960008 +22330 IVFAIL = IVFAIL + 1 07970008 + IVCORR = 32333 07980008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07990008 + 2341 CONTINUE 08000008 + IVTNUM = 234 08010008 +C 08020008 +C **** TEST 234 **** 08030008 +C 08040008 + IF (ICZERO) 32340, 2340, 32340 08050008 + 2340 CONTINUE 08060008 + IVON01 = 10111 08070008 + IVCOMP = 11111 + (11111+IVON01) 08080008 + GO TO 42340 08090008 +32340 IVDELE = IVDELE + 1 08100008 + WRITE (I02,80003) IVTNUM 08110008 + IF (ICZERO) 42340, 2351, 42340 08120008 +42340 IF (IVCOMP - 32333) 22340,12340,22340 08130008 +12340 IVPASS = IVPASS + 1 08140008 + WRITE (I02,80001) IVTNUM 08150008 + GO TO 2351 08160008 +22340 IVFAIL = IVFAIL + 1 08170008 + IVCORR = 32333 08180008 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08190008 + 2351 CONTINUE 08200008 +C 08210008 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08220008 +99999 CONTINUE 08230008 + WRITE (I02,90002) 08240008 + WRITE (I02,90006) 08250008 + WRITE (I02,90002) 08260008 + WRITE (I02,90002) 08270008 + WRITE (I02,90007) 08280008 + WRITE (I02,90002) 08290008 + WRITE (I02,90008) IVFAIL 08300008 + WRITE (I02,90009) IVPASS 08310008 + WRITE (I02,90010) IVDELE 08320008 +C 08330008 +C 08340008 +C TERMINATE ROUTINE EXECUTION 08350008 + STOP 08360008 +C 08370008 +C FORMAT STATEMENTS FOR PAGE HEADERS 08380008 +90000 FORMAT ("1") 08390008 +90002 FORMAT (" ") 08400008 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08410008 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08420008 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08430008 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08440008 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08450008 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08460008 +C 08470008 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08480008 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08490008 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08500008 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08510008 +C 08520008 +C FORMAT STATEMENTS FOR TEST RESULTS 08530008 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08540008 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08550008 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08560008 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08570008 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08580008 +C 08590008 +90007 FORMAT (" ",20X,"END OF PROGRAM FM008" ) 08600008 + END 08610008 diff --git a/Fortran/UnitTests/fcvs21_f95/FM008.reference_output b/Fortran/UnitTests/fcvs21_f95/FM008.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM008.reference_output @@ -0,0 +1,59 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 200 PASS + 201 PASS + 202 PASS + 203 PASS + 204 PASS + 205 PASS + 206 PASS + 207 PASS + 208 PASS + 209 PASS + 210 PASS + 211 PASS + 212 PASS + 213 PASS + 214 PASS + 215 PASS + 216 PASS + 217 PASS + 218 PASS + 219 PASS + 220 PASS + 221 PASS + 222 PASS + 223 PASS + 224 PASS + 225 PASS + 226 PASS + 227 PASS + 228 PASS + 229 PASS + 230 PASS + 231 PASS + 232 PASS + 233 PASS + 234 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM008 + + 0 ERRORS ENCOUNTERED + 35 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM009.f b/Fortran/UnitTests/fcvs21_f95/FM009.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM009.f @@ -0,0 +1,792 @@ + PROGRAM FM009 + +C COMMENT SECTION. 00010009 +C 00020009 +C FM009 00030009 +C 00040009 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050009 +C FORM 00060009 +C INTEGER VARIABLE = ARITHMETIC EXPRESSION 00070009 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00080009 +C OPERATOR +, INTEGER CONSTANTS AND POSITIVE INTEGER VARIABLES. 00090009 +C SOME OF THE TESTS USE PARENTHESES TO GROUP ELEMENTS IN THE 00100009 +C ARITHMETIC EXPRESSION. 00110009 +C 00120009 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00130009 +C (1) TWO INTEGER VARIABLES, 00140009 +C (2) TWO INTEGER VARIABLES AND ONE INTEGER CONSTANT, 00150009 +C (3) TWO INTEGER VARIABLES AND ONE INTEGER CONSTANT WITH 00160009 +C PARENTHESES TO GROUP ELEMENTS. 00170009 +C 00180009 +C REFERENCES 00190009 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00200009 +C X3.9-1978 00210009 +C 00220009 +C SECTION 4.3, INTEGER TYPE 00230009 +C SECTION 4.3.1, INTEGER CONSTANT 00240009 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00250009 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENTS 00260009 +C 00270009 +C ********************************************************** 00280009 +C 00290009 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00300009 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00310009 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00320009 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00330009 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00340009 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00350009 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00360009 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00370009 +C OF EXECUTING THESE TESTS. 00380009 +C 00390009 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00400009 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00410009 +C 00420009 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00430009 +C 00440009 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00450009 +C SOFTWARE STANDARDS VALIDATION GROUP 00460009 +C BUILDING 225 RM A266 00470009 +C GAITHERSBURG, MD 20899 00480009 +C ********************************************************** 00490009 +C 00500009 +C 00510009 +C 00520009 +C INITIALIZATION SECTION 00530009 +C 00540009 +C INITIALIZE CONSTANTS 00550009 +C ************** 00560009 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00570009 + I01 = 5 00580009 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00590009 + I02 = 6 00600009 +C SYSTEM ENVIRONMENT SECTION 00610009 +C 00620009 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00630009 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00640009 +C (UNIT NUMBER FOR CARD READER). 00650009 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00660009 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670009 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00680009 +C 00690009 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00700009 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00710009 +C (UNIT NUMBER FOR PRINTER). 00720009 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00730009 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00740009 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00750009 +C 00760009 + IVPASS=0 00770009 + IVFAIL=0 00780009 + IVDELE=0 00790009 + ICZERO=0 00800009 +C 00810009 +C WRITE PAGE HEADERS 00820009 + WRITE (I02,90000) 00830009 + WRITE (I02,90001) 00840009 + WRITE (I02,90002) 00850009 + WRITE (I02, 90002) 00860009 + WRITE (I02,90003) 00870009 + WRITE (I02,90002) 00880009 + WRITE (I02,90004) 00890009 + WRITE (I02,90002) 00900009 + WRITE (I02,90011) 00910009 + WRITE (I02,90002) 00920009 + WRITE (I02,90002) 00930009 + WRITE (I02,90005) 00940009 + WRITE (I02,90006) 00950009 + WRITE (I02,90002) 00960009 +C 00970009 +C TEST SECTION 00980009 +C 00990009 +C ARITHMETIC ASSIGNMENT STATEMENT 01000009 +C 01010009 +C TEST 235 THROUGH TEST 243 CONTAIN TWO POSITIVE INTEGER VARIABLES 01020009 +C AND OPERATOR + IN ARITHMETIC EXPRESSION. 01030009 +C 01040009 + 2351 CONTINUE 01050009 + IVTNUM = 235 01060009 +C 01070009 +C **** TEST 235 **** 01080009 +C 01090009 + IF (ICZERO) 32350, 2350, 32350 01100009 + 2350 CONTINUE 01110009 + IVON01 = 2 01120009 + IVON02 = 3 01130009 + IVCOMP = IVON01 + IVON02 01140009 + GO TO 42350 01150009 +32350 IVDELE = IVDELE + 1 01160009 + WRITE (I02,80003) IVTNUM 01170009 + IF (ICZERO) 42350, 2361, 42350 01180009 +42350 IF (IVCOMP - 5) 22350,12350,22350 01190009 +12350 IVPASS = IVPASS + 1 01200009 + WRITE (I02,80001) IVTNUM 01210009 + GO TO 2361 01220009 +22350 IVFAIL = IVFAIL + 1 01230009 + IVCORR = 5 01240009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01250009 + 2361 CONTINUE 01260009 + IVTNUM = 236 01270009 +C 01280009 +C **** TEST 236 **** 01290009 +C 01300009 + IF (ICZERO) 32360, 2360, 32360 01310009 + 2360 CONTINUE 01320009 + IVON01 = 2 01330009 + IVON02 = 3 01340009 + IVCOMP = IVON02 + IVON01 01350009 + GO TO 42360 01360009 +32360 IVDELE = IVDELE + 1 01370009 + WRITE (I02,80003) IVTNUM 01380009 + IF (ICZERO) 42360, 2371, 42360 01390009 +42360 IF (IVCOMP - 5) 22360, 12360, 22360 01400009 +12360 IVPASS = IVPASS + 1 01410009 + WRITE (I02,80001) IVTNUM 01420009 + GO TO 2371 01430009 +22360 IVFAIL = IVFAIL + 1 01440009 + IVCORR = 5 01450009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01460009 + 2371 CONTINUE 01470009 + IVTNUM = 237 01480009 +C 01490009 +C **** TEST 237 **** 01500009 +C 01510009 + IF (ICZERO) 32370, 2370, 32370 01520009 + 2370 CONTINUE 01530009 + IVON01 = 51 01540009 + IVON02 = 52 01550009 + IVCOMP = IVON01 + IVON02 01560009 + GO TO 42370 01570009 +32370 IVDELE = IVDELE + 1 01580009 + WRITE (I02,80003) IVTNUM 01590009 + IF (ICZERO) 42370, 2381, 42370 01600009 +42370 IF (IVCOMP - 103) 22370, 12370, 22370 01610009 +12370 IVPASS = IVPASS + 1 01620009 + WRITE (I02,80001) IVTNUM 01630009 + GO TO 2381 01640009 +22370 IVFAIL = IVFAIL + 1 01650009 + IVCORR = 103 01660009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01670009 + 2381 CONTINUE 01680009 + IVTNUM = 238 01690009 +C 01700009 +C **** TEST 238 **** 01710009 +C 01720009 + IF (ICZERO) 32380, 2380, 32380 01730009 + 2380 CONTINUE 01740009 + IVON01 = 189 01750009 + IVON02 = 676 01760009 + IVCOMP = IVON01 + IVON02 01770009 + GO TO 42380 01780009 +32380 IVDELE = IVDELE + 1 01790009 + WRITE (I02,80003) IVTNUM 01800009 + IF (ICZERO) 42380, 2391, 42380 01810009 +42380 IF (IVCOMP - 865) 22380, 12380, 22380 01820009 +12380 IVPASS = IVPASS + 1 01830009 + WRITE (I02,80001) IVTNUM 01840009 + GO TO 2391 01850009 +22380 IVFAIL = IVFAIL + 1 01860009 + IVCORR = 865 01870009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01880009 + 2391 CONTINUE 01890009 + IVTNUM = 239 01900009 +C 01910009 +C **** TEST 239 **** 01920009 +C 01930009 + IF (ICZERO) 32390, 2390, 32390 01940009 + 2390 CONTINUE 01950009 + IVON01 = 1358 01960009 + IVON02 = 8001 01970009 + IVCOMP = IVON01 + IVON02 01980009 + GO TO 42390 01990009 +32390 IVDELE = IVDELE + 1 02000009 + WRITE (I02,80003) IVTNUM 02010009 + IF (ICZERO) 42390, 2401, 42390 02020009 +42390 IF (IVCOMP - 9359) 22390, 12390, 22390 02030009 +12390 IVPASS = IVPASS + 1 02040009 + WRITE (I02,80001) IVTNUM 02050009 + GO TO 2401 02060009 +22390 IVFAIL = IVFAIL + 1 02070009 + IVCORR = 9359 02080009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02090009 + 2401 CONTINUE 02100009 + IVTNUM = 240 02110009 +C 02120009 +C **** TEST 240 **** 02130009 +C 02140009 + IF (ICZERO) 32400, 2400, 32400 02150009 + 2400 CONTINUE 02160009 + IVON01 = 1358 02170009 + IVON02 = 8001 02180009 + IVCOMP = IVON02 + IVON01 02190009 + GO TO 42400 02200009 +32400 IVDELE = IVDELE + 1 02210009 + WRITE (I02,80003) IVTNUM 02220009 + IF (ICZERO) 42400, 2411, 42400 02230009 +42400 IF (IVCOMP - 9359) 22400, 12400, 22400 02240009 +12400 IVPASS = IVPASS + 1 02250009 + WRITE (I02,80001) IVTNUM 02260009 + GO TO 2411 02270009 +22400 IVFAIL = IVFAIL + 1 02280009 + IVCORR = 9359 02290009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02300009 + 2411 CONTINUE 02310009 + IVTNUM = 241 02320009 +C 02330009 +C **** TEST 241 **** 02340009 +C 02350009 + IF (ICZERO) 32410, 2410, 32410 02360009 + 2410 CONTINUE 02370009 + IVON01 = 11112 02380009 + IVON02 = 10001 02390009 + IVCOMP = IVON01 + IVON02 02400009 + GO TO 42410 02410009 +32410 IVDELE = IVDELE + 1 02420009 + WRITE (I02,80003) IVTNUM 02430009 + IF (ICZERO) 42410, 2421, 42410 02440009 +42410 IF (IVCOMP - 21113) 22410, 12410, 22410 02450009 +12410 IVPASS = IVPASS + 1 02460009 + WRITE (I02,80001) IVTNUM 02470009 + GO TO 2421 02480009 +22410 IVFAIL = IVFAIL + 1 02490009 + IVCORR = 21113 02500009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02510009 + 2421 CONTINUE 02520009 + IVTNUM = 242 02530009 +C 02540009 +C **** TEST 242 **** 02550009 +C 02560009 + IF (ICZERO) 32420, 2420, 32420 02570009 + 2420 CONTINUE 02580009 + IVON01 = 189 02590009 + IVON02 = 9876 02600009 + IVCOMP = IVON01 + IVON02 02610009 + GO TO 42420 02620009 +32420 IVDELE = IVDELE + 1 02630009 + WRITE (I02,80003) IVTNUM 02640009 + IF (ICZERO) 42420, 2431, 42420 02650009 +42420 IF (IVCOMP - 10065) 22420, 12420, 22420 02660009 +12420 IVPASS = IVPASS + 1 02670009 + WRITE (I02,80001) IVTNUM 02680009 + GO TO 2431 02690009 +22420 IVFAIL = IVFAIL + 1 02700009 + IVCORR = 10065 02710009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02720009 + 2431 CONTINUE 02730009 + IVTNUM = 243 02740009 +C 02750009 +C **** TEST 243 **** 02760009 +C REQUIRES 32767 02770009 +C 02780009 + IF (ICZERO) 32430, 2430, 32430 02790009 + 2430 CONTINUE 02800009 + IVON01 = 16383 02810009 + IVON02 = 16384 02820009 + IVCOMP = IVON01 + IVON02 02830009 + GO TO 42430 02840009 +32430 IVDELE = IVDELE + 1 02850009 + WRITE (I02,80003) IVTNUM 02860009 + IF (ICZERO) 42430, 2441, 42430 02870009 +42430 IF (IVCOMP - 32767) 22430, 12430, 22430 02880009 +12430 IVPASS = IVPASS + 1 02890009 + WRITE (I02,80001) IVTNUM 02900009 + GO TO 2441 02910009 +22430 IVFAIL = IVFAIL + 1 02920009 + IVCORR = 32767 02930009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02940009 +C 02950009 +C TEST 244 THROUGH TEST 250 CONTAIN TWO POSITIVE INTEGER VARIABLES, 02960009 +C ONE INTEGER CONSTANT, AND OPERATOR + IN ARITHMETIC EXPRESSION. 02970009 +C 02980009 + 2441 CONTINUE 02990009 + IVTNUM = 244 03000009 +C 03010009 +C **** TEST 244 **** 03020009 +C 03030009 + IF (ICZERO) 32440, 2440, 32440 03040009 + 2440 CONTINUE 03050009 + IVON01 = 2 03060009 + IVON02 = 3 03070009 + IVCOMP = IVON01 + IVON02 + 4 03080009 + GO TO 42440 03090009 +32440 IVDELE = IVDELE + 1 03100009 + WRITE (I02,80003) IVTNUM 03110009 + IF (ICZERO) 42440, 2451, 42440 03120009 +42440 IF (IVCOMP - 9) 22440, 12440, 22440 03130009 +12440 IVPASS = IVPASS + 1 03140009 + WRITE (I02,80001) IVTNUM 03150009 + GO TO 2451 03160009 +22440 IVFAIL = IVFAIL + 1 03170009 + IVCORR = 9 03180009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03190009 + 2451 CONTINUE 03200009 + IVTNUM = 245 03210009 +C 03220009 +C **** TEST 245 **** 03230009 +C 03240009 + IF (ICZERO) 32450, 2450, 32450 03250009 + 2450 CONTINUE 03260009 + IVON01 = 2 03270009 + IVON03 = 4 03280009 + IVCOMP = IVON01 +3 + IVON03 03290009 + GO TO 42450 03300009 +32450 IVDELE = IVDELE + 1 03310009 + WRITE (I02,80003) IVTNUM 03320009 + IF (ICZERO) 42450, 2461, 42450 03330009 +42450 IF (IVCOMP - 9) 22450, 12450, 22450 03340009 +12450 IVPASS = IVPASS + 1 03350009 + WRITE (I02,80001) IVTNUM 03360009 + GO TO 2461 03370009 +22450 IVFAIL = IVFAIL + 1 03380009 + IVCORR = 9 03390009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03400009 + 2461 CONTINUE 03410009 + IVTNUM = 246 03420009 +C 03430009 +C **** TEST 246 **** 03440009 +C 03450009 + IF (ICZERO) 32460, 2460, 32460 03460009 + 2460 CONTINUE 03470009 + IVON02 = 3 03480009 + IVON03 = 4 03490009 + IVCOMP = 2 + IVON02 + IVON03 03500009 + GO TO 42460 03510009 +32460 IVDELE = IVDELE + 1 03520009 + WRITE (I02,80003) IVTNUM 03530009 + IF (ICZERO) 42460, 2471, 42460 03540009 +42460 IF (IVCOMP - 9) 22460, 12460, 22460 03550009 +12460 IVPASS = IVPASS + 1 03560009 + WRITE (I02,80001) IVTNUM 03570009 + GO TO 2471 03580009 +22460 IVFAIL = IVFAIL + 1 03590009 + IVCORR = 9 03600009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03610009 + 2471 CONTINUE 03620009 + IVTNUM = 247 03630009 +C 03640009 +C **** TEST 247 **** 03650009 +C 03660009 + IF (ICZERO) 32470, 2470, 32470 03670009 + 2470 CONTINUE 03680009 + IVON01 = 51 03690009 + IVON03 = 53 03700009 + IVCOMP = IVON01 +52 + IVON03 03710009 + GO TO 42470 03720009 +32470 IVDELE = IVDELE + 1 03730009 + WRITE (I02,80003) IVTNUM 03740009 + IF (ICZERO) 42470, 2481, 42470 03750009 +42470 IF (IVCOMP - 156) 22470, 12470, 22470 03760009 +12470 IVPASS = IVPASS + 1 03770009 + WRITE (I02,80001) IVTNUM 03780009 + GO TO 2481 03790009 +22470 IVFAIL = IVFAIL + 1 03800009 + IVCORR = 156 03810009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03820009 + 2481 CONTINUE 03830009 + IVTNUM = 248 03840009 +C 03850009 +C **** TEST 248 **** 03860009 +C 03870009 + IF (ICZERO) 32480, 2480, 32480 03880009 + 2480 CONTINUE 03890009 + IVON02 = 676 03900009 + IVON03 = 101 03910009 + IVCOMP = 189 + IVON02 + IVON03 03920009 + GO TO 42480 03930009 +32480 IVDELE = IVDELE + 1 03940009 + WRITE (I02,80003) IVTNUM 03950009 + IF (ICZERO) 42480, 2491, 42480 03960009 +42480 IF (IVCOMP - 966) 22480, 12480, 22480 03970009 +12480 IVPASS = IVPASS + 1 03980009 + WRITE (I02,80001) IVTNUM 03990009 + GO TO 2491 04000009 +22480 IVFAIL = IVFAIL + 1 04010009 + IVCORR = 966 04020009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04030009 + 2491 CONTINUE 04040009 + IVTNUM = 249 04050009 +C 04060009 +C **** TEST 249 **** 04070009 +C 04080009 + IF (ICZERO) 32490, 2490, 32490 04090009 + 2490 CONTINUE 04100009 + IVON01 = 1358 04110009 + IVON02 = 8001 04120009 + IVCOMP = IVON01 + IVON02 + 2189 04130009 + GO TO 42490 04140009 +32490 IVDELE = IVDELE + 1 04150009 + WRITE (I02,80003) IVTNUM 04160009 + IF (ICZERO) 42490, 2501, 42490 04170009 +42490 IF (IVCOMP - 11548) 22490, 12490, 22490 04180009 +12490 IVPASS = IVPASS + 1 04190009 + WRITE (I02,80001) IVTNUM 04200009 + GO TO 2501 04210009 +22490 IVFAIL = IVFAIL + 1 04220009 + IVCORR = 11548 04230009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04240009 + 2501 CONTINUE 04250009 + IVTNUM = 250 04260009 +C 04270009 +C **** TEST 250 **** 04280009 +C REQUIRES 32767 04290009 +C 04300009 + IF (ICZERO) 32500, 2500, 32500 04310009 + 2500 CONTINUE 04320009 + IVON01 = 16383 04330009 + IVON03 = 4 04340009 + IVCOMP = IVON01 + 16380 + IVON03 04350009 + GO TO 42500 04360009 +32500 IVDELE = IVDELE + 1 04370009 + WRITE (I02,80003) IVTNUM 04380009 + IF (ICZERO) 42500, 2511, 42500 04390009 +42500 IF (IVCOMP - 32767) 22500,12500,22500 04400009 +12500 IVPASS = IVPASS + 1 04410009 + WRITE (I02,80001) IVTNUM 04420009 + GO TO 2511 04430009 +22500 IVFAIL = IVFAIL + 1 04440009 + IVCORR = 32767 04450009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04460009 +C 04470009 +C TEST 251 THROUGH TEST 264 CONTAIN TWO POSITIVE INTEGER VARIABLES, 04480009 +C ONE INTEGER CONSTANT, AND OPERATOR + IN ARITHMETIC EXPRESSION. 04490009 +C PARENTHESES ARE USED TO GROUP ELEMENTS. THE RESULTS ARE THE SAME 04500009 +C AS TESTS 244 THROUGH 250. 04510009 +C 04520009 + 2511 CONTINUE 04530009 + IVTNUM = 251 04540009 +C 04550009 +C **** TEST 251 **** 04560009 +C 04570009 + IF (ICZERO) 32510, 2510, 32510 04580009 + 2510 CONTINUE 04590009 + IVON01 = 2 04600009 + IVON02 = 3 04610009 + IVCOMP = (IVON01 + IVON02) + 4 04620009 + GO TO 42510 04630009 +32510 IVDELE = IVDELE + 1 04640009 + WRITE (I02,80003) IVTNUM 04650009 + IF (ICZERO) 42510, 2521, 42510 04660009 +42510 IF (IVCOMP - 9) 22510,12510,22510 04670009 +12510 IVPASS = IVPASS + 1 04680009 + WRITE (I02,80001) IVTNUM 04690009 + GO TO 2521 04700009 +22510 IVFAIL = IVFAIL + 1 04710009 + IVCORR = 9 04720009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04730009 + 2521 CONTINUE 04740009 + IVTNUM = 252 04750009 +C 04760009 +C **** TEST 252 **** 04770009 +C 04780009 + IF (ICZERO) 32520, 2520, 32520 04790009 + 2520 CONTINUE 04800009 + IVON02 = 3 04810009 + IVON03 = 4 04820009 + IVCOMP = 2 + (IVON02 + IVON03) 04830009 + GO TO 42520 04840009 +32520 IVDELE = IVDELE + 1 04850009 + WRITE (I02,80003) IVTNUM 04860009 + IF (ICZERO) 42520, 2531, 42520 04870009 +42520 IF (IVCOMP - 9) 22520,12520,22520 04880009 +12520 IVPASS = IVPASS + 1 04890009 + WRITE (I02,80001) IVTNUM 04900009 + GO TO 2531 04910009 +22520 IVFAIL = IVFAIL + 1 04920009 + IVCORR = 9 04930009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04940009 + 2531 CONTINUE 04950009 + IVTNUM = 253 04960009 +C 04970009 +C **** TEST 253 **** 04980009 +C 04990009 + IF (ICZERO) 32530, 2530, 32530 05000009 + 2530 CONTINUE 05010009 + IVON02 =3 05020009 + IVON03 =4 05030009 + IVCOMP = (2+IVON02)+IVON03 05040009 + GO TO 42530 05050009 +32530 IVDELE = IVDELE + 1 05060009 + WRITE (I02,80003) IVTNUM 05070009 + IF (ICZERO) 42530, 2541, 42530 05080009 +42530 IF (IVCOMP -9) 22530,12530,22530 05090009 +12530 IVPASS = IVPASS + 1 05100009 + WRITE (I02,80001) IVTNUM 05110009 + GO TO 2541 05120009 +22530 IVFAIL = IVFAIL + 1 05130009 + IVCORR =9 05140009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05150009 + 2541 CONTINUE 05160009 + IVTNUM = 254 05170009 +C 05180009 +C **** TEST 254 **** 05190009 +C 05200009 + IF (ICZERO) 32540, 2540, 32540 05210009 + 2540 CONTINUE 05220009 + IVON01 = 2 05230009 + IVON02 = 3 05240009 + IVCOMP = IVON01 + (IVON02 + 4) 05250009 + GO TO 42540 05260009 +32540 IVDELE = IVDELE + 1 05270009 + WRITE (I02,80003) IVTNUM 05280009 + IF (ICZERO) 42540, 2551, 42540 05290009 +42540 IF (IVCOMP-9)22540,12540,22540 05300009 +12540 IVPASS = IVPASS + 1 05310009 + WRITE (I02,80001) IVTNUM 05320009 + GO TO 2551 05330009 +22540 IVFAIL = IVFAIL + 1 05340009 + IVCORR=9 05350009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05360009 + 2551 CONTINUE 05370009 + IVTNUM = 255 05380009 +C 05390009 +C **** TEST 255 **** 05400009 +C 05410009 + IF (ICZERO) 32550, 2550, 32550 05420009 + 2550 CONTINUE 05430009 + IVON01 = 2 05440009 + IVON03 = 4 05450009 + IVCOMP = IVON01 +(3+IVON03) 05460009 + GO TO 42550 05470009 +32550 IVDELE = IVDELE + 1 05480009 + WRITE (I02,80003) IVTNUM 05490009 + IF (ICZERO) 42550, 2561, 42550 05500009 +42550 IF (IVCOMP-9)22550,12550,22550 05510009 +12550 IVPASS = IVPASS + 1 05520009 + WRITE (I02,80001) IVTNUM 05530009 + GO TO 2561 05540009 +22550 IVFAIL = IVFAIL + 1 05550009 + IVCORR =9 05560009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05570009 + 2561 CONTINUE 05580009 + IVTNUM = 256 05590009 +C 05600009 +C **** TEST 256 **** 05610009 +C 05620009 + IF (ICZERO) 32560, 2560, 32560 05630009 + 2560 CONTINUE 05640009 + IVON01 = 2 05650009 + IVON03 = 4 05660009 + IVCOMP =(IVON01+3)+IVON03 05670009 + GO TO 42560 05680009 +32560 IVDELE = IVDELE + 1 05690009 + WRITE (I02,80003) IVTNUM 05700009 + IF (ICZERO) 42560, 2571, 42560 05710009 +42560 IF (IVCOMP-9) 22560,12560,22560 05720009 +12560 IVPASS = IVPASS + 1 05730009 + WRITE (I02,80001) IVTNUM 05740009 + GO TO 2571 05750009 +22560 IVFAIL = IVFAIL + 1 05760009 + IVCORR =9 05770009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05780009 + 2571 CONTINUE 05790009 + IVTNUM = 257 05800009 +C 05810009 +C **** TEST 257 **** 05820009 +C 05830009 + IF (ICZERO) 32570, 2570, 32570 05840009 + 2570 CONTINUE 05850009 + IVON01 = 51 05860009 + IVON03 = 53 05870009 + IVCOMP=IVON01+(52+IVON03) 05880009 + GO TO 42570 05890009 +32570 IVDELE = IVDELE + 1 05900009 + WRITE (I02,80003) IVTNUM 05910009 + IF (ICZERO) 42570, 2581, 42570 05920009 +42570 IF (IVCOMP -156) 22570,12570,22570 05930009 +12570 IVPASS = IVPASS + 1 05940009 + WRITE (I02,80001) IVTNUM 05950009 + GO TO 2581 05960009 +22570 IVFAIL = IVFAIL + 1 05970009 + IVCORR = 156 05980009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05990009 + 2581 CONTINUE 06000009 + IVTNUM = 258 06010009 +C 06020009 +C **** TEST 258 **** 06030009 +C 06040009 + IF (ICZERO) 32580, 2580, 32580 06050009 + 2580 CONTINUE 06060009 + IVON01 = 51 06070009 + IVON03 = 53 06080009 + IVCOMP =(IVON01+52)+IVON03 06090009 + GO TO 42580 06100009 +32580 IVDELE = IVDELE + 1 06110009 + WRITE (I02,80003) IVTNUM 06120009 + IF (ICZERO) 42580, 2591, 42580 06130009 +42580 IF (IVCOMP-156) 22580,12580,22580 06140009 +12580 IVPASS = IVPASS + 1 06150009 + WRITE (I02,80001) IVTNUM 06160009 + GO TO 2591 06170009 +22580 IVFAIL = IVFAIL + 1 06180009 + IVCORR = 156 06190009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06200009 + 2591 CONTINUE 06210009 + IVTNUM = 259 06220009 +C 06230009 +C **** TEST 259 **** 06240009 +C 06250009 + IF (ICZERO) 32590, 2590, 32590 06260009 + 2590 CONTINUE 06270009 + IVON02 = 676 06280009 + IVON03 = 101 06290009 + IVCOMP = 189+(IVON02+IVON03) 06300009 + GO TO 42590 06310009 +32590 IVDELE = IVDELE + 1 06320009 + WRITE (I02,80003) IVTNUM 06330009 + IF (ICZERO) 42590, 2601, 42590 06340009 +42590 IF (IVCOMP -966) 22590,12590,22590 06350009 +12590 IVPASS = IVPASS + 1 06360009 + WRITE (I02,80001) IVTNUM 06370009 + GO TO 2601 06380009 +22590 IVFAIL = IVFAIL + 1 06390009 + IVCORR =966 06400009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06410009 + 2601 CONTINUE 06420009 + IVTNUM = 260 06430009 +C 06440009 +C **** TEST 260 **** 06450009 +C 06460009 + IF (ICZERO) 32600, 2600, 32600 06470009 + 2600 CONTINUE 06480009 + IVON02 = 676 06490009 + IVON03 = 101 06500009 + IVCOMP = (189 + IVON02) + IVON03 06510009 + GO TO 42600 06520009 +32600 IVDELE = IVDELE + 1 06530009 + WRITE (I02,80003) IVTNUM 06540009 + IF (ICZERO) 42600, 2611, 42600 06550009 +42600 IF (IVCOMP-966) 22600,12600,22600 06560009 +12600 IVPASS = IVPASS + 1 06570009 + WRITE (I02,80001) IVTNUM 06580009 + GO TO 2611 06590009 +22600 IVFAIL = IVFAIL + 1 06600009 + IVCORR=966 06610009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06620009 + 2611 CONTINUE 06630009 + IVTNUM = 261 06640009 +C 06650009 +C **** TEST 261 **** 06660009 +C 06670009 + IF (ICZERO) 32610, 2610, 32610 06680009 + 2610 CONTINUE 06690009 + IVON01 = 1358 06700009 + IVON02 = 8001 06710009 + IVCOMP = IVON01 + (IVON02 + 2189) 06720009 + GO TO 42610 06730009 +32610 IVDELE = IVDELE + 1 06740009 + WRITE (I02,80003) IVTNUM 06750009 + IF (ICZERO) 42610, 2621, 42610 06760009 +42610 IF (IVCOMP-11548) 22610,12610,22610 06770009 +12610 IVPASS = IVPASS + 1 06780009 + WRITE (I02,80001) IVTNUM 06790009 + GO TO 2621 06800009 +22610 IVFAIL = IVFAIL + 1 06810009 + IVCORR=11548 06820009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06830009 + 2621 CONTINUE 06840009 + IVTNUM = 262 06850009 +C 06860009 +C **** TEST 262 **** 06870009 +C 06880009 + IF (ICZERO) 32620, 2620, 32620 06890009 + 2620 CONTINUE 06900009 + IVON01 = 1358 06910009 + IVON02 = 8001 06920009 + IVCOMP =(IVON01+IVON02)+2189 06930009 + GO TO 42620 06940009 +32620 IVDELE = IVDELE + 1 06950009 + WRITE (I02,80003) IVTNUM 06960009 + IF (ICZERO) 42620, 2631, 42620 06970009 +42620 IF (IVCOMP-11548) 22620,12620,22620 06980009 +12620 IVPASS = IVPASS + 1 06990009 + WRITE (I02,80001) IVTNUM 07000009 + GO TO 2631 07010009 +22620 IVFAIL = IVFAIL + 1 07020009 + IVCORR=11548 07030009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07040009 + 2631 CONTINUE 07050009 + IVTNUM = 263 07060009 +C 07070009 +C **** TEST 263 **** 07080009 +C REQUIRES 32767 07090009 +C 07100009 + IF (ICZERO) 32630, 2630, 32630 07110009 + 2630 CONTINUE 07120009 + IVON01 = 16383 07130009 + IVON03 = 16380 07140009 + IVCOMP = IVON01 + (4+IVON03) 07150009 + GO TO 42630 07160009 +32630 IVDELE = IVDELE + 1 07170009 + WRITE (I02,80003) IVTNUM 07180009 + IF (ICZERO) 42630, 2641, 42630 07190009 +42630 IF (IVCOMP-32767) 22630,12630,22630 07200009 +12630 IVPASS = IVPASS + 1 07210009 + WRITE (I02,80001) IVTNUM 07220009 + GO TO 2641 07230009 +22630 IVFAIL = IVFAIL + 1 07240009 + IVCORR =32767 07250009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07260009 + 2641 CONTINUE 07270009 + IVTNUM = 264 07280009 +C 07290009 +C **** TEST 264 **** 07300009 +C REQUIRES 32767 07310009 +C 07320009 + IF (ICZERO) 32640, 2640, 32640 07330009 + 2640 CONTINUE 07340009 + IVON01 = 16383 07350009 + IVON02 = 16380 07360009 + IVCOMP = (IVON01+IVON02) +4 07370009 + GO TO 42640 07380009 +32640 IVDELE = IVDELE + 1 07390009 + WRITE (I02,80003) IVTNUM 07400009 + IF (ICZERO) 42640, 2651, 42640 07410009 +42640 IF (IVCOMP - 32767) 22640,12640,22640 07420009 +12640 IVPASS = IVPASS + 1 07430009 + WRITE (I02,80001) IVTNUM 07440009 + GO TO 2651 07450009 +22640 IVFAIL = IVFAIL + 1 07460009 + IVCORR = 32767 07470009 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07480009 + 2651 CONTINUE 07490009 +C 07500009 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07510009 +99999 CONTINUE 07520009 + WRITE (I02,90002) 07530009 + WRITE (I02,90006) 07540009 + WRITE (I02,90002) 07550009 + WRITE (I02,90002) 07560009 + WRITE (I02,90007) 07570009 + WRITE (I02,90002) 07580009 + WRITE (I02,90008) IVFAIL 07590009 + WRITE (I02,90009) IVPASS 07600009 + WRITE (I02,90010) IVDELE 07610009 +C 07620009 +C 07630009 +C TERMINATE ROUTINE EXECUTION 07640009 + STOP 07650009 +C 07660009 +C FORMAT STATEMENTS FOR PAGE HEADERS 07670009 +90000 FORMAT ("1") 07680009 +90002 FORMAT (" ") 07690009 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07700009 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07710009 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07720009 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07730009 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07740009 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07750009 +C 07760009 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07770009 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07780009 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07790009 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07800009 +C 07810009 +C FORMAT STATEMENTS FOR TEST RESULTS 07820009 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07830009 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07840009 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07850009 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07860009 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07870009 +C 07880009 +90007 FORMAT (" ",20X,"END OF PROGRAM FM009" ) 07890009 + END 07900009 diff --git a/Fortran/UnitTests/fcvs21_f95/FM009.reference_output b/Fortran/UnitTests/fcvs21_f95/FM009.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM009.reference_output @@ -0,0 +1,54 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 235 PASS + 236 PASS + 237 PASS + 238 PASS + 239 PASS + 240 PASS + 241 PASS + 242 PASS + 243 PASS + 244 PASS + 245 PASS + 246 PASS + 247 PASS + 248 PASS + 249 PASS + 250 PASS + 251 PASS + 252 PASS + 253 PASS + 254 PASS + 255 PASS + 256 PASS + 257 PASS + 258 PASS + 259 PASS + 260 PASS + 261 PASS + 262 PASS + 263 PASS + 264 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM009 + + 0 ERRORS ENCOUNTERED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM010.f b/Fortran/UnitTests/fcvs21_f95/FM010.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM010.f @@ -0,0 +1,317 @@ + PROGRAM FM010 + +C COMMENT SECTION. 00010010 +C 00020010 +C FM010 00030010 +C 00040010 +C THIS ROUTINE TESTS REFERENCE FORMAT OF FORTRAN STATEMENTS 00050010 +C AND STATEMENT NUMBERS. THE USE OF THE BLANK CHARACTER IS TESTED 00060010 +C BOTH WITHIN THE STATEMENT NUMBER FIELD AND WITHIN THE FORTRAN 00070010 +C STATEMENTS THEMSELVES. LEADING ZERO IS TESTED FOR STATEMENTS AND 00080010 +C INTEGER CONSTANTS. VARIABLE NAMES WHICH LOOK VERY MUCH LIKE 00090010 +C FORTRAN RESERVED WORDS ARE TESTED IN ARITHMETIC ASSIGNMENT 00100010 +C STATEMENTS. NAMING CONVENTIONS USED THROUGHOUT THE FCVS ARE 00110010 +C TESTED ALSO IN ARITHMETIC ASSIGNMENT STATEMENTS. 00120010 +C 00130010 +C REFERENCES 00140010 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150010 +C X3.9-1978 00160010 +C 00170010 +C SECTION 2.5, VARIABLES 00180010 +C SECTION 3.1.6, BLANK CHARACTER 00190010 +C SECTION 3.2.2, INITIAL LINES 00200010 +C SECTION 3.4, STATEMENT LABELS 00210010 +C 00220010 +C 00230010 +C ********************************************************** 00240010 +C 00250010 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00260010 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00270010 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00280010 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00290010 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00300010 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00310010 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00320010 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00330010 +C OF EXECUTING THESE TESTS. 00340010 +C 00350010 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00360010 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00370010 +C 00380010 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00390010 +C 00400010 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00410010 +C SOFTWARE STANDARDS VALIDATION GROUP 00420010 +C BUILDING 225 RM A266 00430010 +C GAITHERSBURG, MD 20899 00440010 +C ********************************************************** 00450010 +C 00460010 +C 00470010 +C 00480010 +C INITIALIZATION SECTION 00490010 +C 00500010 +C INITIALIZE CONSTANTS 00510010 +C ************** 00520010 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00530010 + I01 = 5 00540010 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00550010 + I02 = 6 00560010 +C SYSTEM ENVIRONMENT SECTION 00570010 +C 00580010 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00590010 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00600010 +C (UNIT NUMBER FOR CARD READER). 00610010 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00620010 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00630010 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00640010 +C 00650010 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00660010 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00670010 +C (UNIT NUMBER FOR PRINTER). 00680010 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00690010 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00700010 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00710010 +C 00720010 + IVPASS=0 00730010 + IVFAIL=0 00740010 + IVDELE=0 00750010 + ICZERO=0 00760010 +C 00770010 +C WRITE PAGE HEADERS 00780010 + WRITE (I02,90000) 00790010 + WRITE (I02,90001) 00800010 + WRITE (I02,90002) 00810010 + WRITE (I02, 90002) 00820010 + WRITE (I02,90003) 00830010 + WRITE (I02,90002) 00840010 + WRITE (I02,90004) 00850010 + WRITE (I02,90002) 00860010 + WRITE (I02,90011) 00870010 + WRITE (I02,90002) 00880010 + WRITE (I02,90002) 00890010 + WRITE (I02,90005) 00900010 + WRITE (I02,90006) 00910010 + WRITE (I02,90002) 00920010 + 1001 CONTINUE 00930010 + IVTNUM = 100 00940010 +C 00950010 +C **** TEST 100 **** 00960010 +C 00970010 +C TEST 100 - TO CHECK THE VARIOUS COMBINATIONS OF FORMING VARIABLE00980010 +C NAMES. THESE ARE ACTUALLY SYMBOLIC NAMES (ANSI X3.9-1978 00990010 +C SECTION 2.2). THIS IS BASICALLY A SYNTAX CHECK USING A 01000010 +C COMBINATION OF FROM ONE TO SIX ALPHANUMERIC CHARACTERS WITH 01010010 +C THE FIRST CHARACTER ALWAYS ALPHABETIC. REFERENCE FORMAT IS 01020010 +C ALSO CHECKED BY HAVING EACH ASSIGNMENT STATEMENT AN INITIAL 01030010 +C LINE (SECTION 3.2.2). THIS MEANS ZERO MAY APPEAR IN COLUMN 01040010 +C SIX WITHOUT EFFECT, THAT LINES MAY BEGIN ANYWHERE FROM 01050010 +C COLUMN SEVEN TO COLUMN 72, AND BLANKS MAY BE USED FREELY 01060010 +C WITHOUT MEANING (3.1.6 BLANK CHARACTERS). 01070010 +C 01080010 + IF (ICZERO) 31000, 1000, 31000 01090010 + 1000 CONTINUE 01100010 + A=1. 01110010 + B =2. 01120010 + C =3. 01130010 + D =4. 01140010 + E =5. 01150010 + F =6. 01160010 + 0G = 7. 01170010 + H=8. 01180010 + I=901190010 + J = 10 01200010 + K = 11 01210010 + L = 1201220010 + 0M=13 01230010 + N=14 01240010 + O=15. 01250010 + P=16. 01260010 + Q=17. 01270010 + R=18. 01280010 + S=19. 01290010 + T=20. 01300010 + U=21. 01310010 + V=22. 01320010 + W=23. 01330010 + X=24. 01340010 + Y=25. 01350010 + Z=26. 01360010 + AAAAAA=27. 01370010 + BBBBB=28. 01380010 + CCCC=29. 01390010 + DDD=30 01400010 + EE=31. 01410010 + F0=32. 01420010 + G12=33. 01430010 + H345 = 34. 01440010 + I6789 = 35 01450010 + J01234 = 36 01460010 + K 5 6 78 9=37 01470010 + L 2 L 2 L 2 =38 01480010 + M 3 M 3 M3 = 3901490010 + N 40 = 4 001500010 + 0 OMY = 4 1.01510010 + I PM H = 4 201520010 + GO TO 1 = 4 3. 01530010 + IF 3 = 44 01540010 + DO 3 = 53. 01550010 + CALL FL =62. 01560010 + TYPE I = 63. 01570010 + TRUE =71. 01580010 + FALSE = 72. 01590010 + GO TO 41000 01600010 +31000 IVDELE = IVDELE + 1 01610010 + WRITE (I02,80003) IVTNUM 01620010 + IF (ICZERO) 41000, 1011, 41000 01630010 +41000 IF (IPMH - 42) 21000,11000,21000 01640010 +11000 IVPASS = IVPASS + 1 01650010 + WRITE (I02,80001) IVTNUM 01660010 + GO TO 1011 01670010 +21000 IVFAIL = IVFAIL + 1 01680010 + IVCOMP = IPMH 01690010 + IVCORR = 42 01700010 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01710010 + 1011 CONTINUE 01720010 + IVTNUM = 101 01730010 +C 01740010 +C **** TEST 101 **** 01750010 +C TEST 101 - CHECKS THE FCVS NAMING CONVENTIONS FOR INTEGER AND 01760010 +C REAL VARIABLES IN ASSIGNMENT STATEMENTS: VARIABLE = CONSTANT01770010 +C BASICALLY A SYNTAX CHECK ON SIX CHARACTER VARIABLE NAMES. 01780010 +C 01790010 + IF (ICZERO) 31010, 1010, 31010 01800010 + 1010 CONTINUE 01810010 + IACE11 = 1 01820010 + IACE21 = 2 01830010 + IACE31 = 3 01840010 + IACN11 = 4 01850010 + IADN11 = 5 01860010 + IATE31 = 6 01870010 + RACE11 = 7. 01880010 + RACE21 = 8. 01890010 + RACN31 = 9. 01900010 + RADE31 = 10. 01910010 + IVTE69 = 11 01920010 + IVON78 = 12 01930010 + RVTNAZ = 13. 01940010 + RVOEZ9 = 14. 01950010 + ICTE96 = 15 01960010 + ICON84 = 16 01970010 + RCON48 = 17. 01980010 + RCTE54 = 18. 01990010 + IDONY4 = 19 02000010 + IDOEB6 = 20 02010010 + RDON46 = 21. 02020010 + IFONS3 = 22 02030010 + RFON77 = 23. 02040010 + GO TO 41010 02050010 +31010 IVDELE = IVDELE + 1 02060010 + WRITE (I02,80003) IVTNUM 02070010 + IF (ICZERO) 41010, 1021, 41010 02080010 +41010 IF (IVTE69 - 11) 21010,11010,21010 02090010 +11010 IVPASS = IVPASS + 1 02100010 + WRITE (I02,80001) IVTNUM 02110010 + GO TO 1021 02120010 +21010 IVFAIL = IVFAIL + 1 02130010 + IVCOMP = IVTE69 02140010 + IVCORR = 11 02150010 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02160010 + 1021 CONTINUE 02170010 + IVTNUM = 102 02180010 +C 02190010 +C **** TEST 102 **** 02200010 +C TEST 102 - REFERENCE FORMAT CHECK ON STATEMENT LABELS (SECTION 02210010 +C 3.4). THESE ARE NON-ZERO INTEGERS, FROM 1 TO 5 DIGITS, 02220010 +C MAY BEGIN ANYWHERE FROM COLS. 1 TO 5, AND LEADING ZEROS ARE 02230010 +C NOT SIGNIFICANT. BLANKS WILL BE IMBEDDED IN SOME OF THE 02240010 +C STATEMENT LABELS AND THESE SHOULD HAVE NO EFFECT. THE 02250010 +C CONTINUE STATEMENT (SECTION 11.11) IS USED FOR THIS TEST. 02260010 +C A BASIC FCVS ASSUMPTION IS THAT THE LOGIC WILL FALL THRU A 02270010 +C SERIES OF CONTINUE STATEMENTS (NORMAL EXECUTION SEQUENCE). 02280010 +C 02290010 + IF (ICZERO) 31020, 1020, 31020 02300010 + 1020 CONTINUE 02310010 +1 CONTINUE 02320010 + 2 CONTINUE 02330010 + 3 CONTINUE 02340010 + 4 CONTINUE 02350010 + 5 CONTINUE 02360010 +06 CONTINUE 02370010 + 007 CONTINUE 02380010 + 0008 CONTINUE 02390010 +00009 CONTINUE 02400010 + 010 CONTINUE 02410010 +1 1 CONTINUE 02420010 + 0 12 CONTINUE 02430010 +0 1 3 CONTINUE 02440010 +00 14 CONTINUE 02450010 +0 15 CONTINUE 02460010 +0 016 CONTINUE 02470010 +100 CONTINUE 02480010 +1 0 1 CONTINUE 02490010 +10 2 IVON01 = 1 02500010 +1 03 CONTINUE 02510010 + 1 04 CONTINUE 02520010 +01 05 CONTINUE 02530010 +010 6 CONTINUE 02540010 +0107 CONTINUE 02550010 +00108 CONTINUE 02560010 +1 1 1 CONTINUE 02570010 +1 111 CONTINUE 02580010 + 99 CONTINUE 02590010 +9 9 9 CONTINUE 02600010 +99 99 CONTINUE 02610010 + GO TO 41020 02620010 +31020 IVDELE = IVDELE + 1 02630010 + WRITE (I02,80003) IVTNUM 02640010 + IF (ICZERO) 41020, 1031, 41020 02650010 +41020 IF (IVON01 - 1) 21020,11020,21020 02660010 +11020 IVPASS = IVPASS + 1 02670010 + WRITE (I02,80001) IVTNUM 02680010 + GO TO 1031 02690010 +21020 IVFAIL = IVFAIL + 1 02700010 + IVCOMP = IVON01 02710010 + IVCORR = 1 02720010 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02730010 + 1031 CONTINUE 02740010 +C 02750010 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02760010 +99999 CONTINUE 02770010 + WRITE (I02,90002) 02780010 + WRITE (I02,90006) 02790010 + WRITE (I02,90002) 02800010 + WRITE (I02,90002) 02810010 + WRITE (I02,90007) 02820010 + WRITE (I02,90002) 02830010 + WRITE (I02,90008) IVFAIL 02840010 + WRITE (I02,90009) IVPASS 02850010 + WRITE (I02,90010) IVDELE 02860010 +C 02870010 +C 02880010 +C TERMINATE ROUTINE EXECUTION 02890010 + STOP 02900010 +C 02910010 +C FORMAT STATEMENTS FOR PAGE HEADERS 02920010 +90000 FORMAT ("1") 02930010 +90002 FORMAT (" ") 02940010 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02950010 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 02960010 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 02970010 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 02980010 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 02990010 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03000010 +C 03010010 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03020010 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03030010 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03040010 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03050010 +C 03060010 +C FORMAT STATEMENTS FOR TEST RESULTS 03070010 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03080010 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03090010 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03100010 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03110010 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03120010 +C 03130010 +90007 FORMAT (" ",20X,"END OF PROGRAM FM010" ) 03140010 + END 03150010 diff --git a/Fortran/UnitTests/fcvs21_f95/FM010.reference_output b/Fortran/UnitTests/fcvs21_f95/FM010.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM010.reference_output @@ -0,0 +1,27 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 100 PASS + 101 PASS + 102 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM010 + + 0 ERRORS ENCOUNTERED + 3 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM011.f b/Fortran/UnitTests/fcvs21_f95/FM011.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM011.f @@ -0,0 +1,295 @@ + 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 diff --git a/Fortran/UnitTests/fcvs21_f95/FM011.reference_output b/Fortran/UnitTests/fcvs21_f95/FM011.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM011.reference_output @@ -0,0 +1,31 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 103 PASS + 104 PASS + 105 PASS + 106 PASS + 107 PASS + 108 PASS + 109 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM011 + + 0 ERRORS ENCOUNTERED + 7 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM012.f b/Fortran/UnitTests/fcvs21_f95/FM012.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM012.f @@ -0,0 +1,583 @@ + PROGRAM FM012 + +C 00010012 +C COMMENT SECTION. 00020012 +C 00030012 +C FM012 00040012 +C 00050012 +C THIS ROUTINE TESTS THE FORTRAN DO - STATEMENT FROM ITS 00060012 +C SIMPLIST FORMAT TO THE MORE ABBREVIATED FORMS. VARIOUS INCREMENTS00070012 +C ARE USED AND BRANCHING BY VARIOUS METHODS IS TESTED FOR PASSING 00080012 +C CONTROL OUT OF THE DO RANGE AND RETURNING (EXTENDED RANGE). 00090012 +C NESTED DO STATEMENTS USING VARIOUS TERMINATING STATEMENTS ARE ALSO00100012 +C TESTED BY THIS ROUTINE. 00110012 +C 00120012 +C REFERENCES 00130012 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140012 +C X3.9-1978 00150012 +C 00160012 +C SECTION 11.10, DO STATEMENT 00170012 +C SECTION 11.10.3, EXECUTES A DO LOOP 00180012 +C SECTION 11.11, CONTINUE STATEMENT 00190012 +C 00200012 +C 00210012 +C ********************************************************** 00220012 +C 00230012 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00240012 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00250012 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00260012 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00270012 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00280012 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00290012 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00300012 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00310012 +C OF EXECUTING THESE TESTS. 00320012 +C 00330012 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00340012 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00350012 +C 00360012 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00370012 +C 00380012 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00390012 +C SOFTWARE STANDARDS VALIDATION GROUP 00400012 +C BUILDING 225 RM A266 00410012 +C GAITHERSBURG, MD 20899 00420012 +C ********************************************************** 00430012 +C 00440012 +C 00450012 +C 00460012 +C INITIALIZATION SECTION 00470012 +C 00480012 +C INITIALIZE CONSTANTS 00490012 +C ************** 00500012 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00510012 + I01 = 5 00520012 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00530012 + I02 = 6 00540012 +C SYSTEM ENVIRONMENT SECTION 00550012 +C 00560012 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00570012 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00580012 +C (UNIT NUMBER FOR CARD READER). 00590012 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00600012 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00610012 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00620012 +C 00630012 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00640012 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00650012 +C (UNIT NUMBER FOR PRINTER). 00660012 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00670012 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00680012 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00690012 +C 00700012 + IVPASS=0 00710012 + IVFAIL=0 00720012 + IVDELE=0 00730012 + ICZERO=0 00740012 +C 00750012 +C WRITE PAGE HEADERS 00760012 + WRITE (I02,90000) 00770012 + WRITE (I02,90001) 00780012 + WRITE (I02,90002) 00790012 + WRITE (I02, 90002) 00800012 + WRITE (I02,90003) 00810012 + WRITE (I02,90002) 00820012 + WRITE (I02,90004) 00830012 + WRITE (I02,90002) 00840012 + WRITE (I02,90011) 00850012 + WRITE (I02,90002) 00860012 + WRITE (I02,90002) 00870012 + WRITE (I02,90005) 00880012 + WRITE (I02,90006) 00890012 + WRITE (I02,90002) 00900012 + IVTNUM = 110 00910012 +C 00920012 +C TEST 110 - DO STATEMENT WITH THE COMPLETE FORMAT, INCREMENT OF 100930012 +C THE LOOP SHOULD BE EXECUTED TEN (10) TIMES THUS THE LOOP 00940012 +C COUNTER SHOULD HAVE A VALUE OF TEN AT THE COMPLETION OF THE 00950012 +C DO-LOOP. 00960012 +C 00970012 +C 00980012 + IF (ICZERO) 31100, 1100, 31100 00990012 + 1100 CONTINUE 01000012 + IVON01=0 01010012 + DO 1102 I=1,10,1 01020012 + IVON01=IVON01+1 01030012 + 1102 CONTINUE 01040012 + GO TO 41100 01050012 +31100 IVDELE = IVDELE + 1 01060012 + WRITE (I02,80003) IVTNUM 01070012 + IF (ICZERO) 41100, 1111, 41100 01080012 +41100 IF(IVON01-10) 21100,11100,21100 01090012 +11100 IVPASS = IVPASS + 1 01100012 + WRITE (I02,80001) IVTNUM 01110012 + GO TO 1111 01120012 +21100 IVFAIL = IVFAIL + 1 01130012 + IVCOMP=IVON01 01140012 + IVCORR=10 01150012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01160012 + 1111 CONTINUE 01170012 + IVTNUM = 111 01180012 +C 01190012 +C TEST 111 - SAME DO TEST AS IN TEST 110 EXCEPT THAT NO INCREMENT 01200012 +C IS GIVEN. THE INCREMENT SHOULD BE 1 AND THE LOOP PERFORMED 01210012 +C TEN (10) TIMES AS BEFORE. 01220012 +C 01230012 +C 01240012 + IF (ICZERO) 31110, 1110, 31110 01250012 + 1110 CONTINUE 01260012 + IVON01=0 01270012 + DO 1112 J=1,10 01280012 + IVON01=IVON01+1 01290012 + 1112 CONTINUE 01300012 + GO TO 41110 01310012 +31110 IVDELE = IVDELE + 1 01320012 + WRITE (I02,80003) IVTNUM 01330012 + IF (ICZERO) 41110, 1121, 41110 01340012 +41110 IF(IVON01-10) 21110, 11110, 21110 01350012 +11110 IVPASS = IVPASS + 1 01360012 + WRITE (I02,80001) IVTNUM 01370012 + GO TO 1121 01380012 +21110 IVFAIL = IVFAIL + 1 01390012 + IVCOMP=IVON01 01400012 + IVCORR=10 01410012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01420012 + 1121 CONTINUE 01430012 + IVTNUM = 112 01440012 +C 01450012 +C TEST 112 - DO STATEMENT WITH AN INCREMENT OTHER THAN ONE (1). 01460012 +C THE DO - LOOP SHOULD BE EXECUTED FIVE (5) TIMES THUS 01470012 +C THE VALUE OF THE LOOP COUNTER SHOULD BE FIVE (5) AT THE 01480012 +C END OF THE DO - LOOP. 01490012 +C 01500012 +C 01510012 + IF (ICZERO) 31120, 1120, 31120 01520012 + 1120 CONTINUE 01530012 + IVON01=0 01540012 + DO 1122 K = 1, 10, 2 01550012 + IVON01=IVON01+1 01560012 + 1122 CONTINUE 01570012 + GO TO 41120 01580012 +31120 IVDELE = IVDELE + 1 01590012 + WRITE (I02,80003) IVTNUM 01600012 + IF (ICZERO) 41120, 1131, 41120 01610012 +41120 IF (IVON01 - 5 ) 21120, 11120, 21120 01620012 +11120 IVPASS = IVPASS + 1 01630012 + WRITE (I02,80001) IVTNUM 01640012 + GO TO 1131 01650012 +21120 IVFAIL = IVFAIL + 1 01660012 + IVCOMP=IVON01 01670012 + IVCORR=5 01680012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01690012 + 1131 CONTINUE 01700012 + IVTNUM = 113 01710012 +C 01720012 +C TEST 113 - DO STATEMENT WITH THE INITIAL VALUE EQUAL TO THE 01730012 +C TERMINAL VALUE. THE DO - LOOP SHOULD BE EXECUTED ONE (1) 01740012 +C TIME THUS THE VALUE OF THE LOOP COUNTER SHOULD BE ONE (1). 01750012 +C 01760012 +C 01770012 + IF (ICZERO) 31130, 1130, 31130 01780012 + 1130 CONTINUE 01790012 + IVON01=0 01800012 + DO 1132 L = 2, 2 01810012 + IVON01=IVON01+1 01820012 + 1132 CONTINUE 01830012 + GO TO 41130 01840012 +31130 IVDELE = IVDELE + 1 01850012 + WRITE (I02,80003) IVTNUM 01860012 + IF (ICZERO) 41130, 1141, 41130 01870012 +41130 IF ( IVON01 - 1 ) 21130, 11130, 21130 01880012 +11130 IVPASS = IVPASS + 1 01890012 + WRITE (I02,80001) IVTNUM 01900012 + GO TO 1141 01910012 +21130 IVFAIL = IVFAIL + 1 01920012 + IVCOMP=IVON01 01930012 + IVCORR=1 01940012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01950012 + 1141 CONTINUE 01960012 + IVTNUM = 114 01970012 +C 01980012 +C TEST 114 - THIS TESTS THE UNCONDITIONAL BRANCH OUT OF THE 01990012 +C RANGE OF THE DO USING THE GO TO STATEMENT. THE DO INDEX 02000012 +C SHOULD RETAIN THE VALUE IT HAD WHEN THE UNCONDITIONAL BRANCH02010012 +C WAS MADE. SINCE THE DO LOOP ONLY CONTAINS AN UNCONDITIONAL 02020012 +C BRANCH, THE VALUE OF THE DO INDEX SHOULD BE ITS INITIAL 02030012 +C VALUE. IN THIS CASE THE VALUE SHOULD BE ONE (1). 02040012 +C SEE SECTION 11.10. 02050012 +C 02060012 +C 02070012 + IF (ICZERO) 31140, 1140, 31140 02080012 + 1140 CONTINUE 02090012 + DO 1142 M=1,10 02100012 + GO TO 1143 02110012 + 1142 CONTINUE 02120012 + 1143 CONTINUE 02130012 + GO TO 41140 02140012 +31140 IVDELE = IVDELE + 1 02150012 + WRITE (I02,80003) IVTNUM 02160012 + IF (ICZERO) 41140, 1151, 41140 02170012 +41140 IF ( M - 1 ) 21140, 11140, 21140 02180012 +11140 IVPASS = IVPASS + 1 02190012 + WRITE (I02,80001) IVTNUM 02200012 + GO TO 1151 02210012 +21140 IVFAIL = IVFAIL + 1 02220012 + IVCOMP=M 02230012 + IVCORR=1 02240012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02250012 + 1151 CONTINUE 02260012 + IVTNUM = 115 02270012 +C 02280012 +C TEST 115 - THIS TEST IS SIMILAR TO TEST 114 IN THAT THE DO 02290012 +C RANGE HAS ONLY AN UNCONDITIONAL BRANCH OUTSIDE OF THE RANGE.02300012 +C THE DO INDEX SHOULD AGAIN RETAIN ITS VALUE, IN THIS CASE 02310012 +C ITS INITIAL VALUE OF ONE (1). 02320012 +C SEE SECTION 11.10. 02330012 +C 02340012 +C 02350012 + IF (ICZERO) 31150, 1150, 31150 02360012 + 1150 CONTINUE 02370012 + DO 1152 N = 1, 10 02380012 + IF ( N - 1 ) 1152, 1153, 1152 02390012 + 1152 CONTINUE 02400012 + 1153 CONTINUE 02410012 + GO TO 41150 02420012 +31150 IVDELE = IVDELE + 1 02430012 + WRITE (I02,80003) IVTNUM 02440012 + IF (ICZERO) 41150, 1161, 41150 02450012 +41150 IF (N - 1 ) 21150, 11150, 21150 02460012 +11150 IVPASS = IVPASS + 1 02470012 + WRITE (I02,80001) IVTNUM 02480012 + GO TO 1161 02490012 +21150 IVFAIL = IVFAIL + 1 02500012 + IVCOMP=N 02510012 + IVCORR=1 02520012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02530012 + 1161 CONTINUE 02540012 + IVTNUM = 116 02550012 +C 02560012 +C TEST 116 - THIS IS A TEST OF A NEST OF TWO DO RANGES. TWO 02570012 +C SEPARATE CONTINUE STATEMENTS ARE USED AS TERMINAL STATEMENTS02580012 +C FOR THE TWO RESPECTIVE DO RANGES. THE OUTER LOOP SHOULD BE 02590012 +C PERFORMED TEN (10) TIMES AND THE INNER LOOP SHOULD BE 02600012 +C PERFORMED TWICE FOR EACH EXECUTION OF THE OUTER LOOP. THE 02610012 +C LOOP COUNTER SHOULD HAVE A VALUE OF TWENTY (20) SINCE IT 02620012 +C IS INCREMENTED IN THE INNER DO - LOOP. 02630012 +C SEE SECTION 11.10.3. 02640012 +C 02650012 +C 02660012 + IF (ICZERO) 31160, 1160, 31160 02670012 + 1160 CONTINUE 02680012 + IVON01=0 02690012 + DO 1163 I=1,10,1 02700012 + DO 1162 J=1,2,1 02710012 + IVON01=IVON01+1 02720012 + 1162 CONTINUE 02730012 + 1163 CONTINUE 02740012 + GO TO 41160 02750012 +31160 IVDELE = IVDELE + 1 02760012 + WRITE (I02,80003) IVTNUM 02770012 + IF (ICZERO) 41160, 1171, 41160 02780012 +41160 IF ( IVON01 - 20 ) 21160, 11160, 21160 02790012 +11160 IVPASS = IVPASS + 1 02800012 + WRITE (I02,80001) IVTNUM 02810012 + GO TO 1171 02820012 +21160 IVFAIL = IVFAIL + 1 02830012 + IVCOMP=IVON01 02840012 + IVCORR=20 02850012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02860012 + 1171 CONTINUE 02870012 + IVTNUM = 117 02880012 +C 02890012 +C TEST 117 - THIS IS BASICALLY THE SAME AS TEST 116 EXCEPT THAT 02900012 +C ONLY ONE CONTINUE STATEMENT IS USED AS THE TERMINATING 02910012 +C STATEMENT FOR BOTH OF THE DO RANGES. THE VALUE OF THE 02920012 +C LOOP COUNTER SHOULD AGAIN BE TWENTY (20). 02930012 +C 02940012 +C 02950012 + IF (ICZERO) 31170, 1170, 31170 02960012 + 1170 CONTINUE 02970012 + IVON01=0 02980012 + DO 1172 K=1,10,1 02990012 + DO 1172 L=1,2,1 03000012 + IVON01=IVON01+1 03010012 + 1172 CONTINUE 03020012 + GO TO 41170 03030012 +31170 IVDELE = IVDELE + 1 03040012 + WRITE (I02,80003) IVTNUM 03050012 + IF (ICZERO) 41170, 1181, 41170 03060012 +41170 IF (IVON01 - 20 ) 21170, 11170, 21170 03070012 +11170 IVPASS = IVPASS + 1 03080012 + WRITE (I02,80001) IVTNUM 03090012 + GO TO 1181 03100012 +21170 IVFAIL = IVFAIL + 1 03110012 + IVCOMP=IVON01 03120012 + IVCORR=20 03130012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03140012 + 1181 CONTINUE 03150012 + IVTNUM = 118 03160012 +C 03170012 +C TEST 118 - THIS IS BASICALLY THE SAME TEST AS 116 EXCEPT 03180012 +C THAT THE LOOP COUNTER INCREMENT IS THE TERMINATING STATEMENT03190012 +C OF BOTH OF THE DO RANGES. THE VALUE OF THE LOOP COUNTER 03200012 +C SHOULD BE TWENTY (20), BUT THE NUMBER OF EXECUTIONS OF 03210012 +C THE OUTER LOOP IS NOW TWO (2) AND THE INNER LOOP EXECUTES 03220012 +C TEN (10) TIMES FOR EVERY EXECUTION OF THE OUTER LOOP. 03230012 +C 03240012 +C 03250012 + IF (ICZERO) 31180, 1180, 31180 03260012 + 1180 CONTINUE 03270012 + IVON01=0 03280012 + DO 1182 M=1,2,1 03290012 + DO 1182 N=1,10,1 03300012 + 1182 IVON01 = IVON01 + 1 03310012 + GO TO 41180 03320012 +31180 IVDELE = IVDELE + 1 03330012 + WRITE (I02,80003) IVTNUM 03340012 + IF (ICZERO) 41180, 1191, 41180 03350012 +41180 IF (IVON01 - 20 ) 21180, 11180, 21180 03360012 +11180 IVPASS = IVPASS + 1 03370012 + WRITE (I02,80001) IVTNUM 03380012 + GO TO 1191 03390012 +21180 IVFAIL = IVFAIL + 1 03400012 + IVCOMP=IVON01 03410012 + IVCORR=20 03420012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03430012 + 1191 CONTINUE 03440012 + IVTNUM = 119 03450012 +C 03460012 +C TEST 119 - THIS IS A TEST OF AN UNCONDITIONAL BRANCH OUT OF A 03470012 +C NESTED DO RANGE QUITE LIKE TEST 114. THE LOOP COUNTER 03480012 +C SHOULD ONLY BE INCREMENTED ON THE OUTER LOOP RANGE SO 03490012 +C THE FINAL VALUE OF THE LOOP COUNTER SHOULD BE TEN (10). 03500012 +C 03510012 +C 03520012 + IF (ICZERO) 31190, 1190, 31190 03530012 + 1190 CONTINUE 03540012 + IVON01=0 03550012 + DO 1194 I=1,10,1 03560012 + DO 1193 J=1,2,1 03570012 +C 03580012 +C THE FOLLOWING STATEMENT IS TO ELIMINATE THE DEAD CODE PRODUCED 03590012 +C BY THE STATEMENT GO TO 1194. 03600012 +C 03610012 + IF ( ICZERO ) 1193, 1192, 1193 03620012 +C 03630012 + 1192 GO TO 1194 03640012 + 1193 IVON01 = IVON01 + 1 03650012 + 1194 IVON01 = IVON01 + 1 03660012 + GO TO 41190 03670012 +31190 IVDELE = IVDELE + 1 03680012 + WRITE (I02,80003) IVTNUM 03690012 + IF (ICZERO) 41190, 1201, 41190 03700012 +41190 IF ( IVON01 - 10 ) 21190, 11190, 21190 03710012 +11190 IVPASS = IVPASS + 1 03720012 + WRITE (I02,80001) IVTNUM 03730012 + GO TO 1201 03740012 +21190 IVFAIL = IVFAIL + 1 03750012 + IVCOMP=IVON01 03760012 + IVCORR=10 03770012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03780012 + 1201 CONTINUE 03790012 + IVTNUM = 120 03800012 +C 03810012 +C TEST 120 - THIS IS BASICALLY THE SAME TEST AS TEST 119 EXCEPT 03820012 +C THAT AN IF STATEMENT IS USED TO BRANCH OUT OF THE INNER LOOP03830012 +C WITHOUT INCREMENTING THE LOOP COUNTER. THE VALUE OF THE 03840012 +C LOOP COUNTER SHOULD AGAIN BE TEN (10). 03850012 +C 03860012 +C 03870012 + IF (ICZERO) 31200, 1200, 31200 03880012 + 1200 CONTINUE 03890012 + IVON01=0 03900012 + DO 1203 I=1,10,1 03910012 + DO 1202 J=1,2,1 03920012 + IF ( J - 1 ) 1203, 1203, 1202 03930012 + 1202 IVON01 = IVON01 + 1 03940012 + 1203 IVON01 = IVON01 + 1 03950012 + GO TO 41200 03960012 +31200 IVDELE = IVDELE + 1 03970012 + WRITE (I02,80003) IVTNUM 03980012 + IF (ICZERO) 41200, 1211, 41200 03990012 +41200 IF ( IVON01 - 10 ) 21200, 11200, 21200 04000012 +11200 IVPASS = IVPASS + 1 04010012 + WRITE (I02,80001) IVTNUM 04020012 + GO TO 1211 04030012 +21200 IVFAIL = IVFAIL + 1 04040012 + IVCOMP=IVON01 04050012 + IVCORR=10 04060012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04070012 + 1211 CONTINUE 04080012 + IVTNUM = 121 04090012 +C 04100012 +C TEST 121 - THIS IS A TEST OF DO NESTS WITHIN DO NESTS. THE 04110012 +C LOOP COUNTER SHOULD HAVE A FINAL VALUE OF EIGHTY-FOUR (84). 04120012 +C 04130012 +C 04140012 + IF (ICZERO) 31210, 1210, 31210 04150012 + 1210 CONTINUE 04160012 + IVON01=0 04170012 + DO 1216 I1=1,2,1 04180012 + DO 1213 I2=1,3,1 04190012 + DO 1212 I3=1,4,1 04200012 + IVON01=IVON01+1 04210012 + 1212 CONTINUE 04220012 + 1213 CONTINUE 04230012 + DO 1215 I4=1,5,1 04240012 + DO 1214 I5=1,6,1 04250012 + IVON01=IVON01+1 04260012 + 1214 CONTINUE 04270012 + 1215 CONTINUE 04280012 + 1216 CONTINUE 04290012 + GO TO 41210 04300012 +31210 IVDELE = IVDELE + 1 04310012 + WRITE (I02,80003) IVTNUM 04320012 + IF (ICZERO) 41210, 1221, 41210 04330012 +41210 IF ( IVON01 - 84 ) 21210, 11210, 21210 04340012 +11210 IVPASS = IVPASS + 1 04350012 + WRITE (I02,80001) IVTNUM 04360012 + GO TO 1221 04370012 +21210 IVFAIL = IVFAIL + 1 04380012 + IVCOMP=IVON01 04390012 + IVCORR=84 04400012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04410012 + 1221 CONTINUE 04420012 + IVTNUM = 122 04430012 +C 04440012 +C TEST 122 - THIS IS AGAIN A TEST OF DO NESTS BUT COMBINED WITH 04450012 +C ARITHMETIC IF STATEMENT BRANCHES WITHIN THE DO RANGE. THE 04460012 +C FINAL LOOP COUNTER VALUE SHOULD BE EIGHTEEN (18). 04470012 +C 04480012 +C 04490012 + IF (ICZERO) 31220, 1220, 31220 04500012 + 1220 CONTINUE 04510012 + IVON01=0 04520012 + DO 1228 I1=1,3,1 04530012 + DO 1223 I2=1,4,1 04540012 + IF ( I2 - 3 ) 1222, 1224, 1224 04550012 + 1222 IVON01 = IVON01 + 1 04560012 + 1223 CONTINUE 04570012 + 1224 DO 1226 I3=1,5,1 04580012 + IF ( I3 - 3 ) 1225, 1225, 1227 04590012 + 1225 IVON01 = IVON01 + 1 04600012 + 1226 CONTINUE 04610012 + 1227 CONTINUE 04620012 + 1228 CONTINUE 04630012 + GO TO 41220 04640012 +31220 IVDELE = IVDELE + 1 04650012 + WRITE (I02,80003) IVTNUM 04660012 + IF (ICZERO) 41220, 1231, 41220 04670012 +41220 IF ( IVON01 - 15 ) 21220, 11220, 21220 04680012 +11220 IVPASS = IVPASS + 1 04690012 + WRITE (I02,80001) IVTNUM 04700012 + GO TO 1231 04710012 +21220 IVFAIL = IVFAIL + 1 04720012 + IVCOMP=IVON01 04730012 + IVCORR=15 04740012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04750012 + 1231 CONTINUE 04760012 + IVTNUM = 124 04950012 +C 04960012 +C TEST 124 - THIS IS A TEST OF A TRIPLE NESTED DO RANGE WITH 04970012 +C AN UNCONDITIONAL GO TO STATEMENT BRANCH IN THE INNERMOST 04980012 +C NESTED DO TO THE COMMON TERMINAL STATEMENT. THE FINAL 04990012 +C LOOP COUNTER VALUE SHOULD BE ONE HUNDRED AND FORTY-TWO (142)05000012 +C THE INITIAL VALUE OF THE INNERMOST DO RANGE IS TWO (2). 05010012 +C 05020012 +C 05030012 + IF (ICZERO) 31240, 1240, 31240 05040012 + 1240 CONTINUE 05050012 + IVON01=0 05060012 + DO 1242 I2=1,5,1 05070012 + DO 1242 I3=2,8,1 05080012 + DO 1242 I1=1,4,1 05090012 + IVON01=IVON01+1 05100012 + GO TO 1242 05110012 + 1242 CONTINUE 05120012 + GO TO 41240 05130012 +31240 IVDELE = IVDELE + 1 05140012 + WRITE (I02,80003) IVTNUM 05150012 + IF (ICZERO) 41240, 1251, 41240 05160012 +41240 IF ( IVON01 - 140 ) 21240, 11240, 21240 05170012 +11240 IVPASS = IVPASS + 1 05180012 + WRITE (I02,80001) IVTNUM 05190012 + GO TO 1251 05200012 +21240 IVFAIL = IVFAIL + 1 05210012 + IVCOMP=IVON01 05220012 + IVCORR=140 05230012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05240012 + 1251 CONTINUE 05250012 + IVTNUM = 125 05260012 +C 05270012 +C TEST 125 - THIS IS BASICALLY THE SAME AS TEST 124 EXCEPT THAT 05280012 +C AN ARITHMETIC IF BRANCH IS USED INSTEAD OF THE GO TO 05290012 +C STATEMENT FOR THE BRANCH TO THE TERMINAL STATEMENT COMMON 05300012 +C TO ALL THREE OF THE DO RANGES. 05310012 +C THE FINAL VALUE OF THE LOOP COUNTER SHOULD BE ONE 05320012 +C HUNDRED AND FORTY (140). 05330012 +C 05340012 +C 05350012 + IF (ICZERO) 31250, 1250, 31250 05360012 + 1250 CONTINUE 05370012 + IVON01=0 05380012 + DO 1252 I1=1,4,1 05390012 + DO 1252 I2=1,5,1 05400012 + DO 1252 I3=2,8,1 05410012 + IVON01=IVON01+1 05420012 + IF ( I3 - 9 ) 1252, 1252, 1253 05430012 + 1252 CONTINUE 05440012 + 1253 CONTINUE 05450012 + GO TO 41250 05460012 +31250 IVDELE = IVDELE + 1 05470012 + WRITE (I02,80003) IVTNUM 05480012 + IF (ICZERO) 41250, 1261, 41250 05490012 +41250 IF ( IVON01 - 140 ) 21250, 11250, 21250 05500012 +11250 IVPASS = IVPASS + 1 05510012 + WRITE (I02,80001) IVTNUM 05520012 + GO TO 1261 05530012 +21250 IVFAIL = IVFAIL + 1 05540012 + IVCOMP=IVON01 05550012 + IVCORR=140 05560012 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05570012 + 1261 CONTINUE 05580012 +C 05590012 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 05600012 +99999 CONTINUE 05610012 + WRITE (I02,90002) 05620012 + WRITE (I02,90006) 05630012 + WRITE (I02,90002) 05640012 + WRITE (I02,90002) 05650012 + WRITE (I02,90007) 05660012 + WRITE (I02,90002) 05670012 + WRITE (I02,90008) IVFAIL 05680012 + WRITE (I02,90009) IVPASS 05690012 + WRITE (I02,90010) IVDELE 05700012 +C 05710012 +C 05720012 +C TERMINATE ROUTINE EXECUTION 05730012 + STOP 05740012 +C 05750012 +C FORMAT STATEMENTS FOR PAGE HEADERS 05760012 +90000 FORMAT ("1") 05770012 +90002 FORMAT (" ") 05780012 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05790012 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 05800012 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 05810012 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 05820012 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 05830012 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 05840012 +C 05850012 +C FORMAT STATEMENTS FOR RUN SUMMARIES 05860012 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 05870012 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 05880012 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 05890012 +C 05900012 +C FORMAT STATEMENTS FOR TEST RESULTS 05910012 +80001 FORMAT (" ",4X,I5,7X,"PASS") 05920012 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 05930012 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 05940012 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 05950012 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 05960012 +C 05970012 +90007 FORMAT (" ",20X,"END OF PROGRAM FM012" ) 05980012 + END 05990012 diff --git a/Fortran/UnitTests/fcvs21_f95/FM012.reference_output b/Fortran/UnitTests/fcvs21_f95/FM012.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM012.reference_output @@ -0,0 +1,39 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 110 PASS + 111 PASS + 112 PASS + 113 PASS + 114 PASS + 115 PASS + 116 PASS + 117 PASS + 118 PASS + 119 PASS + 120 PASS + 121 PASS + 122 PASS + 124 PASS + 125 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM012 + + 0 ERRORS ENCOUNTERED + 15 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM013.f b/Fortran/UnitTests/fcvs21_f95/FM013.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM013.f @@ -0,0 +1,291 @@ + PROGRAM FM013 + +C 00010013 +C COMMENT SECTION. 00020013 +C 00030013 +C FM013 00040013 +C 00050013 +C THIS ROUTINE TESTS THE FORTRAN ASSIGNED GO TO STATEMENT 00060013 +C AS DESCRIBED IN SECTION 11.3 (ASSIGNED GO TO STATEMENT). FIRST A 00070013 +C STATEMENT LABEL IS ASSIGNED TO AN INTEGER VARIABLE IN THE ASSIGN 00080013 +C STATEMENT. SECONDLY A BRANCH IS MADE IN AN ASSIGNED GO TO 00090013 +C STATEMENT USING THE INTEGER VARIABLE AS THE BRANCH CONTROLLER 00100013 +C IN A LIST OF POSSIBLE STATEMENT NUMBERS TO BE BRANCHED TO. 00110013 +C 00120013 +C REFERENCES 00130013 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140013 +C X3.9-1978 00150013 +C 00160013 +C SECTION 10.3, STATEMENT LABEL ASSIGNMENT (ASSIGN) STATEMENT 00170013 +C SECTION 11.3, ASSIGNED GO TO STATEMENT 00180013 +C 00190013 +C 00200013 +C ********************************************************** 00210013 +C 00220013 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00230013 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00240013 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00250013 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00260013 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00270013 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00280013 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00290013 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00300013 +C OF EXECUTING THESE TESTS. 00310013 +C 00320013 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00330013 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00340013 +C 00350013 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00360013 +C 00370013 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00380013 +C SOFTWARE STANDARDS VALIDATION GROUP 00390013 +C BUILDING 225 RM A266 00400013 +C GAITHERSBURG, MD 20899 00410013 +C ********************************************************** 00420013 +C 00430013 +C 00440013 +C 00450013 +C INITIALIZATION SECTION 00460013 +C 00470013 +C INITIALIZE CONSTANTS 00480013 +C ************** 00490013 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00500013 + I01 = 5 00510013 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00520013 + I02 = 6 00530013 +C SYSTEM ENVIRONMENT SECTION 00540013 +C 00550013 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00560013 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00570013 +C (UNIT NUMBER FOR CARD READER). 00580013 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00590013 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00600013 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00610013 +C 00620013 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00630013 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00640013 +C (UNIT NUMBER FOR PRINTER). 00650013 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00660013 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670013 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00680013 +C 00690013 + IVPASS=0 00700013 + IVFAIL=0 00710013 + IVDELE=0 00720013 + ICZERO=0 00730013 +C 00740013 +C WRITE PAGE HEADERS 00750013 + WRITE (I02,90000) 00760013 + WRITE (I02,90001) 00770013 + WRITE (I02,90002) 00780013 + WRITE (I02, 90002) 00790013 + WRITE (I02,90003) 00800013 + WRITE (I02,90002) 00810013 + WRITE (I02,90004) 00820013 + WRITE (I02,90002) 00830013 + WRITE (I02,90011) 00840013 + WRITE (I02,90002) 00850013 + WRITE (I02,90002) 00860013 + WRITE (I02,90005) 00870013 + WRITE (I02,90006) 00880013 + WRITE (I02,90002) 00890013 + IVTNUM = 126 00900013 +C 00910013 +C TEST 126 - THIS TESTS THE SIMPLE ASSIGN STATEMENT IN PREPARATION00920013 +C FOR THE ASSIGNED GO TO TEST TO FOLLOW. 00930013 +C THE ASSIGNED GO TO IS THE SIMPLIST FORM OF THE STATEMENT. 00940013 +C 00950013 +C 00960013 + IF (ICZERO) 31260, 1260, 31260 00970013 + 1260 CONTINUE 00980013 + ASSIGN 1263 TO I 00990013 + GO TO I, (1262,1263,1264) 01000013 + 1262 ICON01 = 1262 01010013 + GO TO 1265 01020013 + 1263 ICON01 = 1263 01030013 + GO TO 1265 01040013 + 1264 ICON01 = 1264 01050013 + 1265 CONTINUE 01060013 + GO TO 41260 01070013 +31260 IVDELE = IVDELE + 1 01080013 + WRITE (I02,80003) IVTNUM 01090013 + IF (ICZERO) 41260, 1271, 41260 01100013 +41260 IF ( ICON01 - 1263 ) 21260, 11260, 21260 01110013 +11260 IVPASS = IVPASS + 1 01120013 + WRITE (I02,80001) IVTNUM 01130013 + GO TO 1271 01140013 +21260 IVFAIL = IVFAIL + 1 01150013 + IVCOMP=ICON01 01160013 + IVCORR = 1263 01170013 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01180013 + 1271 CONTINUE 01190013 + IVTNUM = 127 01200013 +C 01210013 +C TEST 127 - THIS IS A TEST OF MORE COMPLEX BRANCHING USING 01220013 +C THE ASSIGN AND ASSIGNED GO TO STATEMENTS. THIS TEST IS NOT 01230013 +C INTENDED TO BE AN EXAMPLE OF STRUCTURED PROGRAMMING. 01240013 +C 01250013 +C 01260013 + IF (ICZERO) 31270, 1270, 31270 01270013 + 1270 CONTINUE 01280013 + IVON01=0 01290013 + 1272 ASSIGN 1273 TO J 01300013 + IVON01=IVON01+1 01310013 + GO TO 1276 01320013 + 1273 ASSIGN 1274 TO J 01330013 + IVON01=IVON01 * 10 + 2 01340013 + GO TO 1276 01350013 + 1274 ASSIGN 1275 TO J 01360013 + IVON01=IVON01 * 100 + 3 01370013 + GO TO 1276 01380013 + 1275 GO TO 1277 01390013 + 1276 GO TO J, ( 1272, 1273, 1274, 1275 ) 01400013 + 1277 CONTINUE 01410013 + GO TO 41270 01420013 +31270 IVDELE = IVDELE + 1 01430013 + WRITE (I02,80003) IVTNUM 01440013 + IF (ICZERO) 41270, 1281, 41270 01450013 +41270 IF ( IVON01 - 1203 ) 21270, 11270, 21270 01460013 +11270 IVPASS = IVPASS + 1 01470013 + WRITE (I02,80001) IVTNUM 01480013 + GO TO 1281 01490013 +21270 IVFAIL = IVFAIL + 1 01500013 + IVCOMP=IVON01 01510013 + IVCORR=1203 01520013 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01530013 + 1281 CONTINUE 01540013 + IVTNUM = 128 01550013 +C 01560013 +C TEST 128 - TEST OF THE ASSIGNED GO TO WITH ALL OF THE 01570013 +C STATEMENT NUMBERS IN THE ASSIGNED GO TO LIST THE SAME 01580013 +C VALUE EXCEPT FOR ONE. 01590013 +C 01600013 +C 01610013 + IF (ICZERO) 31280, 1280, 31280 01620013 + 1280 CONTINUE 01630013 + ICON01=0 01640013 + ASSIGN 1283 TO K 01650013 + GO TO K, ( 1282, 1282, 1282, 1282, 1282, 1282, 1283 ) 01660013 + 1282 ICON01 = 0 01670013 + GO TO 1284 01680013 + 1283 ICON01 = 1 01690013 + 1284 CONTINUE 01700013 + GO TO 41280 01710013 +31280 IVDELE = IVDELE + 1 01720013 + WRITE (I02,80003) IVTNUM 01730013 + IF (ICZERO) 41280, 1291, 41280 01740013 +41280 IF ( ICON01 - 1 ) 21280, 11280, 21280 01750013 +11280 IVPASS = IVPASS + 1 01760013 + WRITE (I02,80001) IVTNUM 01770013 + GO TO 1291 01780013 +21280 IVFAIL = IVFAIL + 1 01790013 + IVCOMP=ICON01 01800013 + IVCORR=1 01810013 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01820013 + 1291 CONTINUE 01830013 + IVTNUM = 129 01840013 +C 01850013 +C TEST 129 - THIS TESTS THE ASSIGN STATEMENT IN CONJUNCTION 01860013 +C WITH THE NORMAL ARITHMETIC ASSIGN STATEMENT. THE VALUE 01870013 +C OF THE INDEX FOR THE ASSIGNED GO TO STATEMENT IS CHANGED BY 01880013 +C THE COMBINATION OF STATEMENTS. 01890013 +C 01900013 +C 01910013 + IF (ICZERO) 31290, 1290, 31290 01920013 + 1290 CONTINUE 01930013 + ICON01=0 01940013 + ASSIGN 1292 TO L 01950013 + L = 1293 01960013 + ASSIGN 1294 TO L 01970013 + GO TO L, ( 1294, 1293, 1292 ) 01980013 + 1292 ICON01 = 0 01990013 + GO TO 1295 02000013 + 1293 ICON01 = 0 02010013 + GO TO 1295 02020013 + 1294 ICON01 = 1 02030013 + 1295 CONTINUE 02040013 + GO TO 41290 02050013 +31290 IVDELE = IVDELE + 1 02060013 + WRITE (I02,80003) IVTNUM 02070013 + IF (ICZERO) 41290, 1301, 41290 02080013 +41290 IF ( ICON01 - 1 ) 21290, 11290, 21290 02090013 +11290 IVPASS = IVPASS + 1 02100013 + WRITE (I02,80001) IVTNUM 02110013 + GO TO 1301 02120013 +21290 IVFAIL = IVFAIL + 1 02130013 + IVCOMP=ICON01 02140013 + IVCORR=1 02150013 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02160013 + 1301 CONTINUE 02170013 + IVTNUM = 130 02180013 +C 02190013 +C TEST 130 - THIS IS A TEST OF A LOOP USING A COMBINATION OF THE 02200013 +C ASSIGNED GO TO STATEMENT AND THE ARITHMETIC IF STATEMENT. 02210013 +C THE LOOP SHOULD BE EXECUTED ELEVEN (11) TIMES THEN CONTROL 02220013 +C SHOULD PASS TO THE CHECK OF THE VALUE FOR IVON01. 02230013 +C 02240013 +C 02250013 + IF (ICZERO) 31300, 1300, 31300 02260013 + 1300 CONTINUE 02270013 + IVON01=0 02280013 + 1302 ASSIGN 1302 TO M 02290013 + IVON01=IVON01+1 02300013 + IF ( IVON01 - 10 ) 1303, 1303, 1304 02310013 + 1303 GO TO 1305 02320013 + 1304 ASSIGN 1306 TO M 02330013 + 1305 GO TO M, ( 1302, 1306 ) 02340013 + 1306 CONTINUE 02350013 + GO TO 41300 02360013 +31300 IVDELE = IVDELE + 1 02370013 + WRITE (I02,80003) IVTNUM 02380013 + IF (ICZERO) 41300, 1311, 41300 02390013 +41300 IF ( IVON01 - 11 ) 21300, 11300, 21300 02400013 +11300 IVPASS = IVPASS + 1 02410013 + WRITE (I02,80001) IVTNUM 02420013 + GO TO 1311 02430013 +21300 IVFAIL = IVFAIL + 1 02440013 + IVCOMP=IVON01 02450013 + IVCORR=11 02460013 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02470013 + 1311 CONTINUE 02480013 +C 02490013 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02500013 +99999 CONTINUE 02510013 + WRITE (I02,90002) 02520013 + WRITE (I02,90006) 02530013 + WRITE (I02,90002) 02540013 + WRITE (I02,90002) 02550013 + WRITE (I02,90007) 02560013 + WRITE (I02,90002) 02570013 + WRITE (I02,90008) IVFAIL 02580013 + WRITE (I02,90009) IVPASS 02590013 + WRITE (I02,90010) IVDELE 02600013 +C 02610013 +C 02620013 +C TERMINATE ROUTINE EXECUTION 02630013 + STOP 02640013 +C 02650013 +C FORMAT STATEMENTS FOR PAGE HEADERS 02660013 +90000 FORMAT ("1") 02670013 +90002 FORMAT (" ") 02680013 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02690013 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 02700013 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 02710013 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 02720013 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 02730013 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 02740013 +C 02750013 +C FORMAT STATEMENTS FOR RUN SUMMARIES 02760013 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 02770013 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 02780013 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 02790013 +C 02800013 +C FORMAT STATEMENTS FOR TEST RESULTS 02810013 +80001 FORMAT (" ",4X,I5,7X,"PASS") 02820013 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 02830013 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 02840013 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 02850013 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 02860013 +C 02870013 +90007 FORMAT (" ",20X,"END OF PROGRAM FM013" ) 02880013 + END 02890013 diff --git a/Fortran/UnitTests/fcvs21_f95/FM013.reference_output b/Fortran/UnitTests/fcvs21_f95/FM013.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM013.reference_output @@ -0,0 +1,29 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 126 PASS + 127 PASS + 128 PASS + 129 PASS + 130 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM013 + + 0 ERRORS ENCOUNTERED + 5 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM014.f b/Fortran/UnitTests/fcvs21_f95/FM014.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM014.f @@ -0,0 +1,253 @@ + PROGRAM FM014 + +C 00010014 +C COMMENT SECTION. 00020014 +C 00030014 +C FM014 00040014 +C 00050014 +C THIS ROUTINE TESTS THE FORTRAN COMPUTED GO TO STATEMENT.00060014 +C BECAUSE THE FORM OF THE COMPUTED GO TO IS SO STRAIGHTFORWARD, THE 00070014 +C TESTS MAINLY RELATE TO THE RANGE OF POSSIBLE STATEMENT NUMBERS 00080014 +C WHICH ARE USED. 00090014 +C 00100014 +C REFERENCES 00110014 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00120014 +C X3.9-1978 00130014 +C 00140014 +C SECTION 11.2, COMPUTED GO TO STATEMENT 00150014 +C 00160014 +C 00170014 +C ********************************************************** 00180014 +C 00190014 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00200014 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00210014 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00220014 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00230014 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00240014 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00250014 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00260014 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00270014 +C OF EXECUTING THESE TESTS. 00280014 +C 00290014 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00300014 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00310014 +C 00320014 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00330014 +C 00340014 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00350014 +C SOFTWARE STANDARDS VALIDATION GROUP 00360014 +C BUILDING 225 RM A266 00370014 +C GAITHERSBURG, MD 20899 00380014 +C ********************************************************** 00390014 +C 00400014 +C 00410014 +C 00420014 +C INITIALIZATION SECTION 00430014 +C 00440014 +C INITIALIZE CONSTANTS 00450014 +C ************** 00460014 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00470014 + I01 = 5 00480014 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00490014 + I02 = 6 00500014 +C SYSTEM ENVIRONMENT SECTION 00510014 +C 00520014 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00530014 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00540014 +C (UNIT NUMBER FOR CARD READER). 00550014 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00560014 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00570014 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00580014 +C 00590014 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00600014 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00610014 +C (UNIT NUMBER FOR PRINTER). 00620014 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00630014 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00640014 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00650014 +C 00660014 + IVPASS=0 00670014 + IVFAIL=0 00680014 + IVDELE=0 00690014 + ICZERO=0 00700014 +C 00710014 +C WRITE PAGE HEADERS 00720014 + WRITE (I02,90000) 00730014 + WRITE (I02,90001) 00740014 + WRITE (I02,90002) 00750014 + WRITE (I02, 90002) 00760014 + WRITE (I02,90003) 00770014 + WRITE (I02,90002) 00780014 + WRITE (I02,90004) 00790014 + WRITE (I02,90002) 00800014 + WRITE (I02,90011) 00810014 + WRITE (I02,90002) 00820014 + WRITE (I02,90002) 00830014 + WRITE (I02,90005) 00840014 + WRITE (I02,90006) 00850014 + WRITE (I02,90002) 00860014 + IVTNUM = 131 00870014 +C 00880014 +C TEST 131 - TEST OF THE SIMPLIST FORM OF THE COMPUTED GO TO 00890014 +C STATEMENT WITH THREE POSSIBLE BRANCHES. 00900014 +C 00910014 +C 00920014 + IF (ICZERO) 31310, 1310, 31310 00930014 + 1310 CONTINUE 00940014 + ICON01=0 00950014 + I=3 00960014 + GO TO ( 1312, 1313, 1314 ), I 00970014 + 1312 ICON01 = 1312 00980014 + GO TO 1315 00990014 + 1313 ICON01 = 1313 01000014 + GO TO 1315 01010014 + 1314 ICON01 = 1314 01020014 + 1315 CONTINUE 01030014 + GO TO 41310 01040014 +31310 IVDELE = IVDELE + 1 01050014 + WRITE (I02,80003) IVTNUM 01060014 + IF (ICZERO) 41310, 1321, 41310 01070014 +41310 IF ( ICON01 - 1314 ) 21310, 11310, 21310 01080014 +11310 IVPASS = IVPASS + 1 01090014 + WRITE (I02,80001) IVTNUM 01100014 + GO TO 1321 01110014 +21310 IVFAIL = IVFAIL + 1 01120014 + IVCOMP=ICON01 01130014 + IVCORR = 1314 01140014 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01150014 + 1321 CONTINUE 01160014 + IVTNUM = 132 01170014 +C 01180014 +C TEST 132 - THIS TESTS THE COMPUTED GO TO IN CONJUNCTION WITH THE01190014 +C THE UNCONDITIONAL GO TO STATEMENT. THIS TEST IS NOT 01200014 +C INTENDED TO BE AN EXAMPLE OF GOOD STRUCTURED PROGRAMMING. 01210014 +C 01220014 +C 01230014 + IF (ICZERO) 31320, 1320, 31320 01240014 + 1320 CONTINUE 01250014 + IVON01=0 01260014 + J=1 01270014 + GO TO 1326 01280014 + 1322 J = 2 01290014 + IVON01=IVON01+2 01300014 + GO TO 1326 01310014 + 1323 J = 3 01320014 + IVON01=IVON01 * 10 + 3 01330014 + GO TO 1326 01340014 + 1324 J = 4 01350014 + IVON01=IVON01 * 100 + 4 01360014 + GO TO 1326 01370014 + 1325 IVON01 = IVON01 + 1 01380014 + GO TO 1327 01390014 + 1326 GO TO ( 1322, 1323, 1324, 1325, 1326 ), J 01400014 + 1327 CONTINUE 01410014 + GO TO 41320 01420014 +31320 IVDELE = IVDELE + 1 01430014 + WRITE (I02,80003) IVTNUM 01440014 + IF (ICZERO) 41320, 1331, 41320 01450014 +41320 IF ( IVON01 - 2305 ) 21320, 11320, 21320 01460014 +11320 IVPASS = IVPASS + 1 01470014 + WRITE (I02,80001) IVTNUM 01480014 + GO TO 1331 01490014 +21320 IVFAIL = IVFAIL + 1 01500014 + IVCOMP=IVON01 01510014 + IVCORR=2305 01520014 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01530014 + 1331 CONTINUE 01540014 + IVTNUM = 133 01550014 +C 01560014 +C TEST 133 - THIS IS A TEST OF THE COMPUTED GO TO STATEMENT WITH 01570014 +C A SINGLE STATEMENT LABEL AS THE LIST OF POSSIBLE BRANCHES. 01580014 +C 01590014 +C 01600014 + IF (ICZERO) 31330, 1330, 31330 01610014 + 1330 CONTINUE 01620014 + IVON01=0 01630014 + K=1 01640014 + GO TO ( 1332 ), K 01650014 + 1332 IVON01 = 1 01660014 + GO TO 41330 01670014 +31330 IVDELE = IVDELE + 1 01680014 + WRITE (I02,80003) IVTNUM 01690014 + IF (ICZERO) 41330, 1341, 41330 01700014 +41330 IF ( IVON01 - 1 ) 21330, 11330, 21330 01710014 +11330 IVPASS = IVPASS + 1 01720014 + WRITE (I02,80001) IVTNUM 01730014 + GO TO 1341 01740014 +21330 IVFAIL = IVFAIL + 1 01750014 + IVCOMP=IVON01 01760014 + IVCORR=1 01770014 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01780014 + 1341 CONTINUE 01790014 + IVTNUM = 134 01800014 +C 01810014 +C TEST 134 - THIS IS A TEST OF FIVE (5) DIGIT STATEMENT NUMBERS 01820014 +C WHICH EXCEED THE INTEGER 32767 USED IN THE COMPUTED GO TO 01830014 +C STATEMENT WITH THREE POSSIBLE BRANCHES. 01840014 +C 01850014 +C 01860014 + IF (ICZERO) 31340, 1340, 31340 01870014 + 1340 CONTINUE 01880014 + IVON01=0 01890014 + L=2 01900014 + GO TO ( 99991, 99992, 99993 ), L 01910014 +99991 IVON01=1 01920014 + GO TO 1342 01930014 +99992 IVON01=2 01940014 + GO TO 1342 01950014 +99993 IVON01=3 01960014 + 1342 CONTINUE 01970014 + GO TO 41340 01980014 +31340 IVDELE = IVDELE + 1 01990014 + WRITE (I02,80003) IVTNUM 02000014 + IF (ICZERO) 41340, 1351, 41340 02010014 +41340 IF ( IVON01 - 2 ) 21340, 11340, 21340 02020014 +11340 IVPASS = IVPASS + 1 02030014 + WRITE (I02,80001) IVTNUM 02040014 + GO TO 1351 02050014 +21340 IVFAIL = IVFAIL + 1 02060014 + IVCOMP=IVON01 02070014 + IVCORR=2 02080014 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02090014 + 1351 CONTINUE 02100014 +C 02110014 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02120014 +99999 CONTINUE 02130014 + WRITE (I02,90002) 02140014 + WRITE (I02,90006) 02150014 + WRITE (I02,90002) 02160014 + WRITE (I02,90002) 02170014 + WRITE (I02,90007) 02180014 + WRITE (I02,90002) 02190014 + WRITE (I02,90008) IVFAIL 02200014 + WRITE (I02,90009) IVPASS 02210014 + WRITE (I02,90010) IVDELE 02220014 +C 02230014 +C 02240014 +C TERMINATE ROUTINE EXECUTION 02250014 + STOP 02260014 +C 02270014 +C FORMAT STATEMENTS FOR PAGE HEADERS 02280014 +90000 FORMAT ("1") 02290014 +90002 FORMAT (" ") 02300014 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02310014 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 02320014 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 02330014 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 02340014 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 02350014 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 02360014 +C 02370014 +C FORMAT STATEMENTS FOR RUN SUMMARIES 02380014 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 02390014 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 02400014 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 02410014 +C 02420014 +C FORMAT STATEMENTS FOR TEST RESULTS 02430014 +80001 FORMAT (" ",4X,I5,7X,"PASS") 02440014 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 02450014 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 02460014 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 02470014 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 02480014 +C 02490014 +90007 FORMAT (" ",20X,"END OF PROGRAM FM014" ) 02500014 + END 02510014 diff --git a/Fortran/UnitTests/fcvs21_f95/FM014.reference_output b/Fortran/UnitTests/fcvs21_f95/FM014.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM014.reference_output @@ -0,0 +1,28 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 131 PASS + 132 PASS + 133 PASS + 134 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM014 + + 0 ERRORS ENCOUNTERED + 4 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM016.f b/Fortran/UnitTests/fcvs21_f95/FM016.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM016.f @@ -0,0 +1,834 @@ + PROGRAM FM016 + +C 00010016 +C COMMENT SECTION. 00020016 +C 00030016 +C FM016 00040016 +C 00050016 +C THIS ROUTINE BEGINS A SERIES OF TESTS OF THE FORTRAN 00060016 +C LOGICAL IF STATEMENT IN ALL OF THE VARIOUS FORMS. THE 00070016 +C FOLLOWING LOGICAL OPERANDS ARE USED FOR THIS ROUTINE - LOGICAL 00080016 +C CONSTANTS, LOGICAL VARIABLES, LOGICAL ARRAY ELEMENTS, AND 00090016 +C ARITHMETIC EXPRESSIONS WITH VARIOUS RELATIONAL OPERATORS. BOTH 00100016 +C THE TRUE AND FALSE BRANCHES ARE TESTED IN THE SERIES OF TESTS. 00110016 +C 00120016 +C REFERENCES 00130016 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140016 +C X3.9-1978 00150016 +C 00160016 +C SECTION 4.7.1, LOGICAL CONSTANT 00170016 +C SECTION 6, EXPRESSIONS 00180016 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00190016 +C SECTION 6.3, RELATIONAL EXPRESSIONS 00200016 +C SECTION 6.4, LOGICAL EXPRESSIONS 00210016 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00220016 +C SECTION 10, ASSIGNMENT STATEMENTS 00230016 +C SECTION 10.2, LOGICAL ASSIGNMENT STATEMENT 00240016 +C SECTION 11.5, LOGICAL IF STATEMENT 00250016 +C 00260016 + LOGICAL LCTNT1, LCTNF1, LVTNTF, LVTNFT, LATN1A(2) 00270016 + LOGICAL LADN1D, LADN1B 00280016 + DIMENSION LADN1D(2), LADN1B(2) 00290016 + DATA LADN1D/.TRUE., .FALSE./ 00300016 +C 00310016 +C ********************************************************** 00320016 +C 00330016 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00340016 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00350016 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00360016 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00370016 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00380016 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00390016 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00400016 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00410016 +C OF EXECUTING THESE TESTS. 00420016 +C 00430016 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00440016 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00450016 +C 00460016 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00470016 +C 00480016 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00490016 +C SOFTWARE STANDARDS VALIDATION GROUP 00500016 +C BUILDING 225 RM A266 00510016 +C GAITHERSBURG, MD 20899 00520016 +C ********************************************************** 00530016 +C 00540016 +C 00550016 +C 00560016 +C INITIALIZATION SECTION 00570016 +C 00580016 +C INITIALIZE CONSTANTS 00590016 +C ************** 00600016 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00610016 + I01 = 5 00620016 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00630016 + I02 = 6 00640016 +C SYSTEM ENVIRONMENT SECTION 00650016 +C 00660016 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00670016 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680016 +C (UNIT NUMBER FOR CARD READER). 00690016 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00700016 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00710016 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00720016 +C 00730016 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00740016 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00750016 +C (UNIT NUMBER FOR PRINTER). 00760016 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00770016 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00780016 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00790016 +C 00800016 + IVPASS=0 00810016 + IVFAIL=0 00820016 + IVDELE=0 00830016 + ICZERO=0 00840016 +C 00850016 +C WRITE PAGE HEADERS 00860016 + WRITE (I02,90000) 00870016 + WRITE (I02,90001) 00880016 + WRITE (I02,90002) 00890016 + WRITE (I02, 90002) 00900016 + WRITE (I02,90003) 00910016 + WRITE (I02,90002) 00920016 + WRITE (I02,90004) 00930016 + WRITE (I02,90002) 00940016 + WRITE (I02,90011) 00950016 + WRITE (I02,90002) 00960016 + WRITE (I02,90002) 00970016 + WRITE (I02,90005) 00980016 + WRITE (I02,90006) 00990016 + WRITE (I02,90002) 01000016 + IVTNUM = 139 01010016 +C TEST 139 - THIS TESTS THE LOGICAL CONSTANT .TRUE. 01020016 +C 01030016 + IF (ICZERO) 31390, 1390, 31390 01040016 + 1390 CONTINUE 01050016 + IVON01=0 01060016 + IF ( .TRUE. ) IVON01 = 1 01070016 + GO TO 41390 01080016 +31390 IVDELE = IVDELE + 1 01090016 + WRITE (I02,80003) IVTNUM 01100016 + IF (ICZERO) 41390, 1401, 41390 01110016 +41390 IF ( IVON01 - 1 ) 21390, 11390, 21390 01120016 +11390 IVPASS = IVPASS + 1 01130016 + WRITE (I02,80001) IVTNUM 01140016 + GO TO 1401 01150016 +21390 IVFAIL = IVFAIL + 1 01160016 + IVCOMP=IVON01 01170016 + IVCORR=1 01180016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01190016 + 1401 CONTINUE 01200016 + IVTNUM = 140 01210016 +C TEST 140 - THIS TESTS THE LOGICAL CONSTANT .FALSE. 01220016 +C 01230016 + IF (ICZERO) 31400, 1400, 31400 01240016 + 1400 CONTINUE 01250016 + IVON01=1 01260016 + IF ( .FALSE. ) IVON01=0 01270016 + GO TO 41400 01280016 +31400 IVDELE = IVDELE + 1 01290016 + WRITE (I02,80003) IVTNUM 01300016 + IF (ICZERO) 41400, 1411, 41400 01310016 +41400 IF ( IVON01 - 1 ) 21400, 11400, 21400 01320016 +11400 IVPASS = IVPASS + 1 01330016 + WRITE (I02,80001) IVTNUM 01340016 + GO TO 1411 01350016 +21400 IVFAIL = IVFAIL + 1 01360016 + IVCOMP=IVON01 01370016 + IVCORR=1 01380016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01390016 + 1411 CONTINUE 01400016 + IVTNUM = 141 01410016 +C TEST 141 - THIS TESTS THE LOGICAL VARIABLE = .TRUE. 01420016 +C 01430016 + IF (ICZERO) 31410, 1410, 31410 01440016 + 1410 CONTINUE 01450016 + LCTNT1=.TRUE. 01460016 + IVON01 = 0 01470016 + IF ( LCTNT1 ) IVON01 = 1 01480016 + GO TO 41410 01490016 +31410 IVDELE = IVDELE + 1 01500016 + WRITE (I02,80003) IVTNUM 01510016 + IF (ICZERO) 41410, 1421, 41410 01520016 +41410 IF ( IVON01 - 1 ) 21410, 11410, 21410 01530016 +11410 IVPASS = IVPASS + 1 01540016 + WRITE (I02,80001) IVTNUM 01550016 + GO TO 1421 01560016 +21410 IVFAIL = IVFAIL + 1 01570016 + IVCOMP=IVON01 01580016 + IVCORR=1 01590016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01600016 + 1421 CONTINUE 01610016 + IVTNUM = 142 01620016 +C TEST 142 - THIS TESTS THE LOGICAL VARIABLE = .FALSE. 01630016 +C 01640016 + IF (ICZERO) 31420, 1420, 31420 01650016 + 1420 CONTINUE 01660016 + IVON01=1 01670016 + LCTNF1=.FALSE. 01680016 + IF ( LCTNF1 ) IVON01=0 01690016 + GO TO 41420 01700016 +31420 IVDELE = IVDELE + 1 01710016 + WRITE (I02,80003) IVTNUM 01720016 + IF (ICZERO) 41420, 1431, 41420 01730016 +41420 IF ( IVON01 - 1 ) 21420, 11420, 21420 01740016 +11420 IVPASS = IVPASS + 1 01750016 + WRITE (I02,80001) IVTNUM 01760016 + GO TO 1431 01770016 +21420 IVFAIL = IVFAIL + 1 01780016 + IVCOMP=IVON01 01790016 + IVCORR=1 01800016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01810016 + 1431 CONTINUE 01820016 + IVTNUM = 143 01830016 +C TEST 143 - THIS TESTS CHANGING THE VALUE OF A LOGICAL VARIABLE 01840016 +C FROM .TRUE. TO .FALSE. 01850016 +C 01860016 + IF (ICZERO) 31430, 1430, 31430 01870016 + 1430 CONTINUE 01880016 + LVTNTF=.TRUE. 01890016 + LVTNTF=.FALSE. 01900016 + IVON01 = 1 01910016 + IF ( LVTNTF ) IVON01 = 0 01920016 + GO TO 41430 01930016 +31430 IVDELE = IVDELE + 1 01940016 + WRITE (I02,80003) IVTNUM 01950016 + IF (ICZERO) 41430, 1441, 41430 01960016 +41430 IF ( IVON01 - 1 ) 21430, 11430, 21430 01970016 +11430 IVPASS = IVPASS + 1 01980016 + WRITE (I02,80001) IVTNUM 01990016 + GO TO 1441 02000016 +21430 IVFAIL = IVFAIL + 1 02010016 + IVCOMP=IVON01 02020016 + IVCORR=1 02030016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02040016 + 1441 CONTINUE 02050016 + IVTNUM = 144 02060016 +C TEST 144 - THIS TESTS CHANGING THE VALUE OF A LOGICAL VARIABLE 02070016 +C FROM .FALSE. TO .TRUE. 02080016 +C 02090016 + IF (ICZERO) 31440, 1440, 31440 02100016 + 1440 CONTINUE 02110016 + LVTNFT=.FALSE. 02120016 + LVTNFT=.TRUE. 02130016 + IVON01=0 02140016 + IF ( LVTNFT ) IVON01=1 02150016 + GO TO 41440 02160016 +31440 IVDELE = IVDELE + 1 02170016 + WRITE (I02,80003) IVTNUM 02180016 + IF (ICZERO) 41440, 1451, 41440 02190016 +41440 IF ( IVON01 - 1 ) 21440, 11440, 21440 02200016 +11440 IVPASS = IVPASS + 1 02210016 + WRITE (I02,80001) IVTNUM 02220016 + GO TO 1451 02230016 +21440 IVFAIL = IVFAIL + 1 02240016 + IVCOMP=IVON01 02250016 + IVCORR=1 02260016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02270016 + 1451 CONTINUE 02280016 + IVTNUM = 145 02290016 +C TEST 145 - TEST OF A LOGICAL ARRAY ELEMENT SET TO .TRUE. 02300016 +C 02310016 + IF (ICZERO) 31450, 1450, 31450 02320016 + 1450 CONTINUE 02330016 + LATN1A(1)=.TRUE. 02340016 + IVON01=0 02350016 + IF ( LATN1A(1) ) IVON01=1 02360016 + GO TO 41450 02370016 +31450 IVDELE = IVDELE + 1 02380016 + WRITE (I02,80003) IVTNUM 02390016 + IF (ICZERO) 41450, 1461, 41450 02400016 +41450 IF ( IVON01 - 1 ) 21450, 11450, 21450 02410016 +11450 IVPASS = IVPASS + 1 02420016 + WRITE (I02,80001) IVTNUM 02430016 + GO TO 1461 02440016 +21450 IVFAIL = IVFAIL + 1 02450016 + IVCOMP=IVON01 02460016 + IVCORR=1 02470016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02480016 + 1461 CONTINUE 02490016 + IVTNUM = 146 02500016 +C TEST 146 - TEST OF A LOGICAL ARRAY ELEMENT SET TO .FALSE. 02510016 +C 02520016 + IF (ICZERO) 31460, 1460, 31460 02530016 + 1460 CONTINUE 02540016 + LATN1A(2) = .FALSE. 02550016 + IVON01=1 02560016 + IF ( LATN1A(2) ) IVON01=0 02570016 + GO TO 41460 02580016 +31460 IVDELE = IVDELE + 1 02590016 + WRITE (I02,80003) IVTNUM 02600016 + IF (ICZERO) 41460, 1471, 41460 02610016 +41460 IF ( IVON01 - 1 ) 21460, 11460, 21460 02620016 +11460 IVPASS = IVPASS + 1 02630016 + WRITE (I02,80001) IVTNUM 02640016 + GO TO 1471 02650016 +21460 IVFAIL = IVFAIL + 1 02660016 + IVCOMP=IVON01 02670016 + IVCORR=1 02680016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02690016 + 1471 CONTINUE 02700016 + IVTNUM = 147 02710016 +C TEST 147 - TEST OF A LOGICAL ARRAY ELEMENT SET .TRUE. 02720016 +C IN A DATA INITIALIZATION STATEMENT. 02730016 +C 02740016 + IF (ICZERO) 31470, 1470, 31470 02750016 + 1470 CONTINUE 02760016 + IVON01=0 02770016 + IF ( LADN1D(1) ) IVON01=1 02780016 + GO TO 41470 02790016 +31470 IVDELE = IVDELE + 1 02800016 + WRITE (I02,80003) IVTNUM 02810016 + IF (ICZERO) 41470, 1481, 41470 02820016 +41470 IF ( IVON01 - 1 ) 21470, 11470, 21470 02830016 +11470 IVPASS = IVPASS + 1 02840016 + WRITE (I02,80001) IVTNUM 02850016 + GO TO 1481 02860016 +21470 IVFAIL = IVFAIL + 1 02870016 + IVCOMP=IVON01 02880016 + IVCORR=1 02890016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02900016 + 1481 CONTINUE 02910016 + IVTNUM = 148 02920016 +C TEST 148 - TEST OF A LOGICAL ARRAY ELEMENT SET .FALSE. 02930016 +C IN A DATA INITIALIZATION STATEMENT. 02940016 +C 02950016 + IF (ICZERO) 31480, 1480, 31480 02960016 + 1480 CONTINUE 02970016 + IVON01=1 02980016 + IF ( LADN1D(2) ) IVON01=0 02990016 + GO TO 41480 03000016 +31480 IVDELE = IVDELE + 1 03010016 + WRITE (I02,80003) IVTNUM 03020016 + IF (ICZERO) 41480, 1491, 41480 03030016 +41480 IF ( IVON01 - 1 ) 21480, 11480, 21480 03040016 +11480 IVPASS = IVPASS + 1 03050016 + WRITE (I02,80001) IVTNUM 03060016 + GO TO 1491 03070016 +21480 IVFAIL = IVFAIL + 1 03080016 + IVCOMP=IVON01 03090016 + IVCORR=1 03100016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03110016 + 1491 CONTINUE 03120016 + IVTNUM = 149 03130016 +C TEST 149 - LIKE TEST 145 EXCEPT THAT THE ARRAY DECLARATION WAS 03140016 +C IN A DIMENSION STATEMENT RATHER THAN IN THE TYPE STATEMENT. 03150016 +C 03160016 + IF (ICZERO) 31490, 1490, 31490 03170016 + 1490 CONTINUE 03180016 + LADN1B(1)=.TRUE. 03190016 + IVON01=0 03200016 + IF ( LADN1B(1) ) IVON01=1 03210016 + GO TO 41490 03220016 +31490 IVDELE = IVDELE + 1 03230016 + WRITE (I02,80003) IVTNUM 03240016 + IF (ICZERO) 41490, 1501, 41490 03250016 +41490 IF ( IVON01 - 1 ) 21490, 11490, 21490 03260016 +11490 IVPASS = IVPASS + 1 03270016 + WRITE (I02,80001) IVTNUM 03280016 + GO TO 1501 03290016 +21490 IVFAIL = IVFAIL + 1 03300016 + IVCOMP=IVON01 03310016 + IVCORR=1 03320016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03330016 +C 03340016 +C FOR TESTS 150 THRU 156 THE TRUE PATH IS USED.. 03350016 +C 03360016 + 1501 CONTINUE 03370016 + IVTNUM = 150 03380016 +C TEST 150 - RELATIONAL EXPRESSION WITH INTEGER CONSTANTS .LT. 03390016 +C 03400016 + IF (ICZERO) 31500, 1500, 31500 03410016 + 1500 CONTINUE 03420016 + IVON01=0 03430016 + IF ( 3 .LT. 76 ) IVON01=1 03440016 + GO TO 41500 03450016 +31500 IVDELE = IVDELE + 1 03460016 + WRITE (I02,80003) IVTNUM 03470016 + IF (ICZERO) 41500, 1511, 41500 03480016 +41500 IF ( IVON01 - 1 ) 21500, 11500, 21500 03490016 +11500 IVPASS = IVPASS + 1 03500016 + WRITE (I02,80001) IVTNUM 03510016 + GO TO 1511 03520016 +21500 IVFAIL = IVFAIL + 1 03530016 + IVCOMP=IVON01 03540016 + IVCORR=1 03550016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03560016 + 1511 CONTINUE 03570016 + IVTNUM = 151 03580016 +C TEST 151 - TEST WITH RELATIONAL EXPRESSION .LE. 03590016 +C 03600016 + IF (ICZERO) 31510, 1510, 31510 03610016 + 1510 CONTINUE 03620016 + IVON01=0 03630016 + IF ( 587 .LE. 587 ) IVON01=1 03640016 + GO TO 41510 03650016 +31510 IVDELE = IVDELE + 1 03660016 + WRITE (I02,80003) IVTNUM 03670016 + IF (ICZERO) 41510, 1521, 41510 03680016 +41510 IF ( IVON01 - 1 ) 21510, 11510, 21510 03690016 +11510 IVPASS = IVPASS + 1 03700016 + WRITE (I02,80001) IVTNUM 03710016 + GO TO 1521 03720016 +21510 IVFAIL = IVFAIL + 1 03730016 + IVCOMP=IVON01 03740016 + IVCORR=1 03750016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03760016 + 1521 CONTINUE 03770016 + IVTNUM = 152 03780016 +C TEST 152 - TEST OF RELATIONAL EXPRESSION WITH INTEGER CONSTANTS 03790016 +C RELATIONAL OPERATOR IS .EQ. 03800016 +C 03810016 + IF (ICZERO) 31520, 1520, 31520 03820016 + 1520 CONTINUE 03830016 + IVON01=0 03840016 + IF ( 9999 .EQ. 9999 ) IVON01=1 03850016 + GO TO 41520 03860016 +31520 IVDELE = IVDELE + 1 03870016 + WRITE (I02,80003) IVTNUM 03880016 + IF (ICZERO) 41520, 1531, 41520 03890016 +41520 IF ( IVON01 - 1 ) 21520, 11520, 21520 03900016 +11520 IVPASS = IVPASS + 1 03910016 + WRITE (I02,80001) IVTNUM 03920016 + GO TO 1531 03930016 +21520 IVFAIL = IVFAIL + 1 03940016 + IVCOMP=IVON01 03950016 + IVCORR=1 03960016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03970016 + 1531 CONTINUE 03980016 + IVTNUM = 153 03990016 +C TEST 153 - TEST OF RELATIONAL EXPRESSION WITH INTEGER CONSTANTS 04000016 +C RELATIONAL OPERATOR IS .NE. 04010016 +C 04020016 + IF (ICZERO) 31530, 1530, 31530 04030016 + 1530 CONTINUE 04040016 + IVON01=0 04050016 + IF ( 0 .NE. 32767 ) IVON01=1 04060016 + GO TO 41530 04070016 +31530 IVDELE = IVDELE + 1 04080016 + WRITE (I02,80003) IVTNUM 04090016 + IF (ICZERO) 41530, 1541, 41530 04100016 +41530 IF ( IVON01 - 1 ) 21530, 11530, 21530 04110016 +11530 IVPASS = IVPASS + 1 04120016 + WRITE (I02,80001) IVTNUM 04130016 + GO TO 1541 04140016 +21530 IVFAIL = IVFAIL + 1 04150016 + IVCOMP=IVON01 04160016 + IVCORR=1 04170016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04180016 + 1541 CONTINUE 04190016 + IVTNUM = 154 04200016 +C TEST 154 - TEST OF RELATIONAL EXPRESSION WITH INTEGER CONSTANTS 04210016 +C RELATIONAL OPERATOR IS .GT. 04220016 +C 04230016 + IF (ICZERO) 31540, 1540, 31540 04240016 + 1540 CONTINUE 04250016 + IVON01=0 04260016 + IF ( 32767 .GT. 76 ) IVON01=1 04270016 + GO TO 41540 04280016 +31540 IVDELE = IVDELE + 1 04290016 + WRITE (I02,80003) IVTNUM 04300016 + IF (ICZERO) 41540, 1551, 41540 04310016 +41540 IF ( IVON01 - 1 ) 21540, 11540, 21540 04320016 +11540 IVPASS = IVPASS + 1 04330016 + WRITE (I02,80001) IVTNUM 04340016 + GO TO 1551 04350016 +21540 IVFAIL = IVFAIL + 1 04360016 + IVCOMP=IVON01 04370016 + IVCORR=1 04380016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04390016 + 1551 CONTINUE 04400016 + IVTNUM = 155 04410016 +C TEST 155 - TEST OF RELATIONAL EXPRESSION WITH INTEGER CONSTANTS 04420016 +C RELATIONAL OPERATOR IS .GE. 04430016 +C 04440016 + IF (ICZERO) 31550, 1550, 31550 04450016 + 1550 CONTINUE 04460016 + IVON01=0 04470016 + IF ( 32767 .GE. 76 ) IVON01=1 04480016 + GO TO 41550 04490016 +31550 IVDELE = IVDELE + 1 04500016 + WRITE (I02,80003) IVTNUM 04510016 + IF (ICZERO) 41550, 1561, 41550 04520016 +41550 IF ( IVON01 - 1 ) 21550, 11550, 21550 04530016 +11550 IVPASS = IVPASS + 1 04540016 + WRITE (I02,80001) IVTNUM 04550016 + GO TO 1561 04560016 +21550 IVFAIL = IVFAIL + 1 04570016 + IVCOMP=IVON01 04580016 + IVCORR=1 04590016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04600016 + 1561 CONTINUE 04610016 + IVTNUM = 156 04620016 +C TEST 156 - TEST OF RELATIONAL EXPRESSION WITH INTEGER CONSTANTS 04630016 +C RELATIONAL OPERATOR IS .GE. 04640016 +C 04650016 + IF (ICZERO) 31560, 1560, 31560 04660016 + 1560 CONTINUE 04670016 + IVON01=0 04680016 + IF ( 32767 .GE. 32767 ) IVON01=1 04690016 + GO TO 41560 04700016 +31560 IVDELE = IVDELE + 1 04710016 + WRITE (I02,80003) IVTNUM 04720016 + IF (ICZERO) 41560, 1571, 41560 04730016 +41560 IF ( IVON01 - 1 ) 21560, 11560, 21560 04740016 +11560 IVPASS = IVPASS + 1 04750016 + WRITE (I02,80001) IVTNUM 04760016 + GO TO 1571 04770016 +21560 IVFAIL = IVFAIL + 1 04780016 + IVCOMP=IVON01 04790016 + IVCORR=1 04800016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04810016 +C 04820016 +C FOR TESTS 157 THRU 162 THE FALSE PATH IS USED.. 04830016 +C 04840016 + 1571 CONTINUE 04850016 + IVTNUM = 157 04860016 +C TEST 157 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH 04870016 +C RELATIONAL OPERATOR IS .LT. 04880016 +C 04890016 + IF (ICZERO) 31570, 1570, 31570 04900016 + 1570 CONTINUE 04910016 + IVON01=1 04920016 + IF ( 76 .LT. 3 ) IVON01=0 04930016 + GO TO 41570 04940016 +31570 IVDELE = IVDELE + 1 04950016 + WRITE (I02,80003) IVTNUM 04960016 + IF (ICZERO) 41570, 1581, 41570 04970016 +41570 IF ( IVON01 - 1 ) 21570, 11570, 21570 04980016 +11570 IVPASS = IVPASS + 1 04990016 + WRITE (I02,80001) IVTNUM 05000016 + GO TO 1581 05010016 +21570 IVFAIL = IVFAIL + 1 05020016 + IVCOMP=IVON01 05030016 + IVCORR=1 05040016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05050016 + 1581 CONTINUE 05060016 + IVTNUM = 158 05070016 +C TEST 158 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH 05080016 +C RELATIONAL OPERATOR IS .LE. 05090016 +C 05100016 + IF (ICZERO) 31580, 1580, 31580 05110016 + 1580 CONTINUE 05120016 + IVON01=1 05130016 + IF ( 76 .LE. 3 ) IVON01=0 05140016 + GO TO 41580 05150016 +31580 IVDELE = IVDELE + 1 05160016 + WRITE (I02,80003) IVTNUM 05170016 + IF (ICZERO) 41580, 1591, 41580 05180016 +41580 IF ( IVON01 - 1 ) 21580, 11580, 21580 05190016 +11580 IVPASS = IVPASS + 1 05200016 + WRITE (I02,80001) IVTNUM 05210016 + GO TO 1591 05220016 +21580 IVFAIL = IVFAIL + 1 05230016 + IVCOMP=IVON01 05240016 + IVCORR=1 05250016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05260016 + 1591 CONTINUE 05270016 + IVTNUM = 159 05280016 +C TEST 159 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH 05290016 +C RELATIONAL OPERATOR IS .EQ. 05300016 +C 05310016 + IF (ICZERO) 31590, 1590, 31590 05320016 + 1590 CONTINUE 05330016 + IVON01=1 05340016 + IF ( 9999 .EQ. 587 ) IVON01=0 05350016 + GO TO 41590 05360016 +31590 IVDELE = IVDELE + 1 05370016 + WRITE (I02,80003) IVTNUM 05380016 + IF (ICZERO) 41590, 1601, 41590 05390016 +41590 IF ( IVON01 - 1 ) 21590, 11590, 21590 05400016 +11590 IVPASS = IVPASS + 1 05410016 + WRITE (I02,80001) IVTNUM 05420016 + GO TO 1601 05430016 +21590 IVFAIL = IVFAIL + 1 05440016 + IVCOMP=IVON01 05450016 + IVCORR=1 05460016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05470016 + 1601 CONTINUE 05480016 + IVTNUM = 160 05490016 +C TEST 160 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH 05500016 +C RELATIONAL OPERATOR IS .NE. 05510016 +C 05520016 + IF (ICZERO) 31600, 1600, 31600 05530016 + 1600 CONTINUE 05540016 + IVON01=1 05550016 + IF ( 3 .NE. 3 ) IVON01=0 05560016 + GO TO 41600 05570016 +31600 IVDELE = IVDELE + 1 05580016 + WRITE (I02,80003) IVTNUM 05590016 + IF (ICZERO) 41600, 1611, 41600 05600016 +41600 IF ( IVON01 - 1 ) 21600, 11600, 21600 05610016 +11600 IVPASS = IVPASS + 1 05620016 + WRITE (I02,80001) IVTNUM 05630016 + GO TO 1611 05640016 +21600 IVFAIL = IVFAIL + 1 05650016 + IVCOMP=IVON01 05660016 + IVCORR=1 05670016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05680016 + 1611 CONTINUE 05690016 + IVTNUM=161 05700016 +C 05710016 +C TEST 161 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH 05720016 +C RELATIONAL OPERATOR IS .GT. 05730016 +C 05740016 + IF ( ICZERO ) 31610, 1610, 31610 05750016 + 1610 CONTINUE 05760016 + IVON01=1 05770016 + IF ( 76 .GT. 32767 ) IVON01=0 05780016 + GO TO 41610 05790016 +31610 IVDELE = IVDELE + 1 05800016 + WRITE (I02,80003) IVTNUM 05810016 + IF ( ICZERO ) 41610, 1621, 41610 05820016 +41610 IF ( IVON01 - 1 ) 21610, 11610, 21610 05830016 +11610 IVPASS = IVPASS+ 1 05840016 + WRITE (I02,80001) IVTNUM 05850016 + GO TO 1621 05860016 +21610 IVFAIL = IVFAIL + 1 05870016 + IVCOMP=IVON01 05880016 + IVCORR=1 05890016 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05900016 + 1621 CONTINUE 05910016 + IVTNUM = 162 05920016 +C 05930016 +C 05940016 +C **** TEST 162 **** 05950016 +C 05960016 +C TEST 162 - RELATIONAL EXPRESSION INTEGER CONSTANTS FALSE PATH 05970016 +C RELATIONAL OPERATOR IS .GE. 05980016 +C 05990016 + IF (ICZERO) 31620, 1620, 31620 06000016 + 1620 CONTINUE 06010016 + IVON01=1 06020016 + IF ( 76 .GE. 32767 ) IVON01 = 0 06030016 + GO TO 41620 06040016 +31620 IVDELE = IVDELE + 1 06050016 + WRITE (I02,80003) IVTNUM 06060016 + IF (ICZERO) 41620, 1631, 41620 06070016 +41620 IF ( IVON01 - 1 ) 21620, 11620, 21620 06080016 +11620 IVPASS = IVPASS + 1 06090016 + WRITE (I02,80001) IVTNUM 06100016 + GO TO 1631 06110016 +21620 IVFAIL = IVFAIL + 1 06120016 + IVCOMP=IVON01 06130016 + IVCORR=1 06140016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06150016 + 1631 CONTINUE 06160016 + IVTNUM = 163 06170016 +C 06180016 +C **** TEST 163 **** 06190016 +C TEST 163 - RELATIONAL EXPRESSION WITH INTEGER VARIABLE 06200016 +C REFERENCES (IC) (RO) (IVR). TRUE PATH. USE .LT. 06210016 +C 06220016 +C 06230016 + IF (ICZERO) 31630, 1630, 31630 06240016 + 1630 CONTINUE 06250016 + IVON01 = 76 06260016 + IVON02 = 0 06270016 + IF ( 3 .LT. IVON01 ) IVON02 = 1 06280016 + GO TO 41630 06290016 +31630 IVDELE = IVDELE + 1 06300016 + WRITE (I02,80003) IVTNUM 06310016 + IF (ICZERO) 41630, 1641, 41630 06320016 +41630 IF ( IVON02 - 1 ) 21630, 11630, 21630 06330016 +11630 IVPASS = IVPASS + 1 06340016 + WRITE (I02,80001) IVTNUM 06350016 + GO TO 1641 06360016 +21630 IVFAIL = IVFAIL + 1 06370016 + IVCOMP = IVON02 06380016 + IVCORR = 1 06390016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06400016 + 1641 CONTINUE 06410016 + IVTNUM = 164 06420016 +C 06430016 +C **** TEST 164 **** 06440016 +C TEST 164 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCES. 06450016 +C TRUE PATH. .LE. 06460016 +C 06470016 +C 06480016 + IF (ICZERO) 31640, 1640, 31640 06490016 + 1640 CONTINUE 06500016 + IVON01 = 587 06510016 + IVON02 = 0 06520016 + IF ( 587 .LE. IVON01 ) IVON02 = 1 06530016 + GO TO 41640 06540016 +31640 IVDELE = IVDELE + 1 06550016 + WRITE (I02,80003) IVTNUM 06560016 + IF (ICZERO) 41640, 1651, 41640 06570016 +41640 IF ( IVON02 - 1 ) 21640, 11640, 21640 06580016 +11640 IVPASS = IVPASS + 1 06590016 + WRITE (I02,80001) IVTNUM 06600016 + GO TO 1651 06610016 +21640 IVFAIL = IVFAIL + 1 06620016 + IVCOMP = IVON02 06630016 + IVCORR = 1 06640016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06650016 + 1651 CONTINUE 06660016 + IVTNUM = 165 06670016 +C 06680016 +C **** TEST 165 **** 06690016 +C TEST 165 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE. 06700016 +C TRUE PATH. .EQ. 06710016 +C 06720016 +C 06730016 + IF (ICZERO) 31650, 1650, 31650 06740016 + 1650 CONTINUE 06750016 + IVON01 = 9999 06760016 + IVON02 = 0 06770016 + IF ( 9999 .EQ. IVON01 ) IVON02 = 1 06780016 + GO TO 41650 06790016 +31650 IVDELE = IVDELE + 1 06800016 + WRITE (I02,80003) IVTNUM 06810016 + IF (ICZERO) 41650, 1661, 41650 06820016 +41650 IF ( IVON02 - 1 ) 21650, 11650, 21650 06830016 +11650 IVPASS = IVPASS + 1 06840016 + WRITE (I02,80001) IVTNUM 06850016 + GO TO 1661 06860016 +21650 IVFAIL = IVFAIL + 1 06870016 + IVCOMP = IVON02 06880016 + IVCORR = 1 06890016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06900016 + 1661 CONTINUE 06910016 + IVTNUM = 166 06920016 +C 06930016 +C **** TEST 166 **** 06940016 +C TEST 166 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE. 06950016 +C TRUE PATH. .NE. 06960016 +C 06970016 +C 06980016 + IF (ICZERO) 31660, 1660, 31660 06990016 + 1660 CONTINUE 07000016 + IVON01 = 32767 07010016 + IVON02 = 0 07020016 + IF ( 0 .NE. IVON01 ) IVON02 = 1 07030016 + GO TO 41660 07040016 +31660 IVDELE = IVDELE + 1 07050016 + WRITE (I02,80003) IVTNUM 07060016 + IF (ICZERO) 41660, 1671, 41660 07070016 +41660 IF ( IVON02 - 1 ) 21660, 11660, 21660 07080016 +11660 IVPASS = IVPASS + 1 07090016 + WRITE (I02,80001) IVTNUM 07100016 + GO TO 1671 07110016 +21660 IVFAIL = IVFAIL + 1 07120016 + IVCOMP = IVON02 07130016 + IVCORR = 1 07140016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07150016 + 1671 CONTINUE 07160016 + IVTNUM = 167 07170016 +C 07180016 +C **** TEST 167 **** 07190016 +C TEST 167 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE. 07200016 +C TRUE PATH. .GT. 07210016 +C 07220016 +C 07230016 + IF (ICZERO) 31670, 1670, 31670 07240016 + 1670 CONTINUE 07250016 + IVON01 = 76 07260016 + IVON02 = 0 07270016 + IF ( 32767 .GT. IVON01 ) IVON02 = 1 07280016 + GO TO 41670 07290016 +31670 IVDELE = IVDELE + 1 07300016 + WRITE (I02,80003) IVTNUM 07310016 + IF (ICZERO) 41670, 1681, 41670 07320016 +41670 IF ( IVON02 - 1 ) 21670, 11670, 21670 07330016 +11670 IVPASS = IVPASS + 1 07340016 + WRITE (I02,80001) IVTNUM 07350016 + GO TO 1681 07360016 +21670 IVFAIL = IVFAIL + 1 07370016 + IVCOMP = IVON02 07380016 + IVCORR = 1 07390016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07400016 + 1681 CONTINUE 07410016 + IVTNUM = 168 07420016 +C 07430016 +C **** TEST 168 **** 07440016 +C TEST 168 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE. 07450016 +C TRUE PATH. .GE. 07460016 +C 07470016 +C 07480016 + IF (ICZERO) 31680, 1680, 31680 07490016 + 1680 CONTINUE 07500016 + IVON01 = 76 07510016 + IVON02 = 0 07520016 + IF ( 32767 .GE. IVON01 ) IVON02 = 1 07530016 + GO TO 41680 07540016 +31680 IVDELE = IVDELE + 1 07550016 + WRITE (I02,80003) IVTNUM 07560016 + IF (ICZERO) 41680, 1691, 41680 07570016 +41680 IF ( IVON02 - 1 ) 21680, 11680, 21680 07580016 +11680 IVPASS = IVPASS + 1 07590016 + WRITE (I02,80001) IVTNUM 07600016 + GO TO 1691 07610016 +21680 IVFAIL = IVFAIL + 1 07620016 + IVCOMP = IVON02 07630016 + IVCORR = 1 07640016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07650016 + 1691 CONTINUE 07660016 + IVTNUM = 169 07670016 +C 07680016 +C **** TEST 169 **** 07690016 +C TEST 169 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE. 07700016 +C TRUE PATH. .EQ. 07710016 +C 07720016 +C 07730016 + IF (ICZERO) 31690, 1690, 31690 07740016 + 1690 CONTINUE 07750016 + IVON01 = 32767 07760016 + IVON02 = 0 07770016 + IF ( 32767 .EQ. IVON01 ) IVON02 = 1 07780016 + GO TO 41690 07790016 +31690 IVDELE = IVDELE + 1 07800016 + WRITE (I02,80003) IVTNUM 07810016 + IF (ICZERO) 41690, 1701, 41690 07820016 +41690 IF ( IVON02 - 1 ) 21690, 11690, 21690 07830016 +11690 IVPASS = IVPASS + 1 07840016 + WRITE (I02,80001) IVTNUM 07850016 + GO TO 1701 07860016 +21690 IVFAIL = IVFAIL + 1 07870016 + IVCOMP = IVON02 07880016 + IVCORR = 1 07890016 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07900016 + 1701 CONTINUE 07910016 +C 07920016 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07930016 +99999 CONTINUE 07940016 + WRITE (I02,90002) 07950016 + WRITE (I02,90006) 07960016 + WRITE (I02,90002) 07970016 + WRITE (I02,90002) 07980016 + WRITE (I02,90007) 07990016 + WRITE (I02,90002) 08000016 + WRITE (I02,90008) IVFAIL 08010016 + WRITE (I02,90009) IVPASS 08020016 + WRITE (I02,90010) IVDELE 08030016 +C 08040016 +C 08050016 +C TERMINATE ROUTINE EXECUTION 08060016 + STOP 08070016 +C 08080016 +C FORMAT STATEMENTS FOR PAGE HEADERS 08090016 +90000 FORMAT ("1") 08100016 +90002 FORMAT (" ") 08110016 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08120016 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08130016 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08140016 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08150016 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08160016 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08170016 +C 08180016 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08190016 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08200016 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08210016 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08220016 +C 08230016 +C FORMAT STATEMENTS FOR TEST RESULTS 08240016 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08250016 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08260016 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08270016 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08280016 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08290016 +C 08300016 +90007 FORMAT (" ",20X,"END OF PROGRAM FM016" ) 08310016 + END 08320016 diff --git a/Fortran/UnitTests/fcvs21_f95/FM016.reference_output b/Fortran/UnitTests/fcvs21_f95/FM016.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM016.reference_output @@ -0,0 +1,55 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 139 PASS + 140 PASS + 141 PASS + 142 PASS + 143 PASS + 144 PASS + 145 PASS + 146 PASS + 147 PASS + 148 PASS + 149 PASS + 150 PASS + 151 PASS + 152 PASS + 153 PASS + 154 PASS + 155 PASS + 156 PASS + 157 PASS + 158 PASS + 159 PASS + 160 PASS + 161 PASS + 162 PASS + 163 PASS + 164 PASS + 165 PASS + 166 PASS + 167 PASS + 168 PASS + 169 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM016 + + 0 ERRORS ENCOUNTERED + 31 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM017.f b/Fortran/UnitTests/fcvs21_f95/FM017.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM017.f @@ -0,0 +1,888 @@ + PROGRAM FM017 + +C 00010017 +C COMMENT SECTION. 00020017 +C 00030017 +C FM017 00040017 +C 00050017 +C THIS ROUTINE CONTINUES TESTS OF THE FORTRAN 00060017 +C LOGICAL IF STATEMENT IN ALL OF THE VARIOUS FORMS. THE 00070017 +C FOLLOWING LOGICAL OPERANDS ARE USED FOR THIS ROUTINE - LOGICAL 00080017 +C CONSTANTS, LOGICAL VARIABLES, LOGICAL ARRAY ELEMENTS, AND 00090017 +C ARITHMETIC EXPRESSIONS WITH VARIOUS RELATIONAL OPERATORS. BOTH 00100017 +C THE TRUE AND FALSE BRANCHES ARE TESTED IN THE SERIES OF TESTS. 00110017 +C 00120017 +C REFERENCES 00130017 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140017 +C X3.9-1978 00150017 +C 00160017 +C SECTION 4.7.1, LOGICAL CONSTANT 00170017 +C SECTION 6, EXPRESSIONS 00180017 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00190017 +C SECTION 6.3, RELATIONAL EXPRESSIONS 00200017 +C SECTION 6.4, LOGICAL EXPRESSIONS 00210017 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00220017 +C SECTION 10, ASSIGNMENT STATEMENTS 00230017 +C SECTION 10.2, LOGICAL ASSIGNMENT STATEMENT 00240017 +C SECTION 11.5, LOGICAL IF STATEMENT 00250017 +C 00260017 + DIMENSION IADN11(3) 00270017 + LOGICAL LATN1A(2), LCTNT1, LCTNT2 00280017 +C 00290017 +C ********************************************************** 00300017 +C 00310017 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00320017 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00330017 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00340017 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00350017 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00360017 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00370017 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00380017 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00390017 +C OF EXECUTING THESE TESTS. 00400017 +C 00410017 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00420017 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00430017 +C 00440017 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00450017 +C 00460017 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00470017 +C SOFTWARE STANDARDS VALIDATION GROUP 00480017 +C BUILDING 225 RM A266 00490017 +C GAITHERSBURG, MD 20899 00500017 +C ********************************************************** 00510017 +C 00520017 +C 00530017 +C 00540017 +C INITIALIZATION SECTION 00550017 +C 00560017 +C INITIALIZE CONSTANTS 00570017 +C ************** 00580017 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00590017 + I01 = 5 00600017 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00610017 + I02 = 6 00620017 +C SYSTEM ENVIRONMENT SECTION 00630017 +C 00640017 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00650017 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00660017 +C (UNIT NUMBER FOR CARD READER). 00670017 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00680017 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00690017 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00700017 +C 00710017 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00720017 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00730017 +C (UNIT NUMBER FOR PRINTER). 00740017 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00750017 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00760017 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00770017 +C 00780017 + IVPASS=0 00790017 + IVFAIL=0 00800017 + IVDELE=0 00810017 + ICZERO=0 00820017 +C 00830017 +C WRITE PAGE HEADERS 00840017 + WRITE (I02,90000) 00850017 + WRITE (I02,90001) 00860017 + WRITE (I02,90002) 00870017 + WRITE (I02, 90002) 00880017 + WRITE (I02,90003) 00890017 + WRITE (I02,90002) 00900017 + WRITE (I02,90004) 00910017 + WRITE (I02,90002) 00920017 + WRITE (I02,90011) 00930017 + WRITE (I02,90002) 00940017 + WRITE (I02,90002) 00950017 + WRITE (I02,90005) 00960017 + WRITE (I02,90006) 00970017 + WRITE (I02,90002) 00980017 + IVTNUM = 170 00990017 +C 01000017 +C **** TEST 170 **** 01010017 +C TEST 170 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE. 01020017 +C FALSE PATH. .LT. 01030017 +C 01040017 +C 01050017 + IF (ICZERO) 31700, 1700, 31700 01060017 + 1700 CONTINUE 01070017 + IVON01 = 3 01080017 + IVON02 = 1 01090017 + IF ( 76 .LT. IVON01 ) IVON02 = 0 01100017 + GO TO 41700 01110017 +31700 IVDELE = IVDELE + 1 01120017 + WRITE (I02,80003) IVTNUM 01130017 + IF (ICZERO) 41700, 1711, 41700 01140017 +41700 IF ( IVON02 - 1 ) 21700, 11700, 21700 01150017 +11700 IVPASS = IVPASS + 1 01160017 + WRITE (I02,80001) IVTNUM 01170017 + GO TO 1711 01180017 +21700 IVFAIL = IVFAIL + 1 01190017 + IVCOMP = IVON02 01200017 + IVCORR = 1 01210017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01220017 + 1711 CONTINUE 01230017 + IVTNUM = 171 01240017 +C 01250017 +C **** TEST 171 **** 01260017 +C TEST 171 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE. 01270017 +C FALSE PATH. .LE. 01280017 +C 01290017 +C 01300017 + IF (ICZERO) 31710, 1710, 31710 01310017 + 1710 CONTINUE 01320017 + IVON01 = 3 01330017 + IVON02 = 1 01340017 + IF ( 76 .LE. IVON01 ) IVON02 = 0 01350017 + GO TO 41710 01360017 +31710 IVDELE = IVDELE + 1 01370017 + WRITE (I02,80003) IVTNUM 01380017 + IF (ICZERO) 41710, 1721, 41710 01390017 +41710 IF ( IVON02 - 1 ) 21710, 11710, 21710 01400017 +11710 IVPASS = IVPASS + 1 01410017 + WRITE (I02,80001) IVTNUM 01420017 + GO TO 1721 01430017 +21710 IVFAIL = IVFAIL + 1 01440017 + IVCOMP = IVON02 01450017 + IVCORR = 1 01460017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01470017 + 1721 CONTINUE 01480017 + IVTNUM = 172 01490017 +C 01500017 +C **** TEST 172 **** 01510017 +C TEST 172 - RELATIONAL EXPRESSIONAL. INTEGER VARIABLE REFERENCE.01520017 +C FALSE PATH. .EQ. 01530017 +C 01540017 +C 01550017 + IF (ICZERO) 31720, 1720, 31720 01560017 + 1720 CONTINUE 01570017 + IVON01 = 587 01580017 + IVON02 = 1 01590017 + IF ( 9999 .EQ. IVON01 ) IVON02 = 0 01600017 + GO TO 41720 01610017 +31720 IVDELE = IVDELE + 1 01620017 + WRITE (I02,80003) IVTNUM 01630017 + IF (ICZERO) 41720, 1731, 41720 01640017 +41720 IF ( IVON02 - 1 ) 21720, 11720, 21720 01650017 +11720 IVPASS = IVPASS + 1 01660017 + WRITE (I02,80001) IVTNUM 01670017 + GO TO 1731 01680017 +21720 IVFAIL = IVFAIL + 1 01690017 + IVCOMP = IVON02 01700017 + IVCORR = 1 01710017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01720017 + 1731 CONTINUE 01730017 + IVTNUM = 173 01740017 +C 01750017 +C **** TEST 173 **** 01760017 +C TEST 173 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE. 01770017 +C FALSE PATH. .NE. 01780017 +C 01790017 +C 01800017 + IF (ICZERO) 31730, 1730, 31730 01810017 + 1730 CONTINUE 01820017 + IVON01 = 3 01830017 + IVON02 = 1 01840017 + IF ( 3 .NE. IVON01 ) IVON02 = 0 01850017 + GO TO 41730 01860017 +31730 IVDELE = IVDELE + 1 01870017 + WRITE (I02,80003) IVTNUM 01880017 + IF (ICZERO) 41730, 1741, 41730 01890017 +41730 IF ( IVON02 - 1 ) 21730, 11730, 21730 01900017 +11730 IVPASS = IVPASS + 1 01910017 + WRITE (I02,80001) IVTNUM 01920017 + GO TO 1741 01930017 +21730 IVFAIL = IVFAIL + 1 01940017 + IVCOMP = IVON02 01950017 + IVCORR = 1 01960017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01970017 + 1741 CONTINUE 01980017 + IVTNUM = 174 01990017 +C 02000017 +C **** TEST 174 **** 02010017 +C TEST 174 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE. 02020017 +C FALSE PATH. .GT. 02030017 +C 02040017 +C 02050017 + IF (ICZERO) 31740, 1740, 31740 02060017 + 1740 CONTINUE 02070017 + IVON01 = 32767 02080017 + IVON02 = 1 02090017 + IF ( 76 .GT. IVON01 ) IVON02 = 0 02100017 + GO TO 41740 02110017 +31740 IVDELE = IVDELE + 1 02120017 + WRITE (I02,80003) IVTNUM 02130017 + IF (ICZERO) 41740, 1751, 41740 02140017 +41740 IF ( IVON02 - 1 ) 21740, 11740, 21740 02150017 +11740 IVPASS = IVPASS + 1 02160017 + WRITE (I02,80001) IVTNUM 02170017 + GO TO 1751 02180017 +21740 IVFAIL = IVFAIL + 1 02190017 + IVCOMP = IVON02 02200017 + IVCORR = 1 02210017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02220017 + 1751 CONTINUE 02230017 + IVTNUM = 175 02240017 +C 02250017 +C **** TEST 175 **** 02260017 +C TEST 175 - RELATIONAL EXPRESSION. INTEGER VARIABLE REFERENCE. 02270017 +C FALSE PATH. .GE. 02280017 +C 02290017 +C 02300017 + IF (ICZERO) 31750, 1750, 31750 02310017 + 1750 CONTINUE 02320017 + IVON01 = 32767 02330017 + IVON02 = 1 02340017 + IF ( 76 .GE. IVON01 ) IVON02 = 0 02350017 + GO TO 41750 02360017 +31750 IVDELE = IVDELE + 1 02370017 + WRITE (I02,80003) IVTNUM 02380017 + IF (ICZERO) 41750, 1761, 41750 02390017 +41750 IF ( IVON02 - 1 ) 21750, 11750, 21750 02400017 +11750 IVPASS = IVPASS + 1 02410017 + WRITE (I02,80001) IVTNUM 02420017 + GO TO 1761 02430017 +21750 IVFAIL = IVFAIL + 1 02440017 + IVCOMP = IVON02 02450017 + IVCORR = 1 02460017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02470017 + 1761 CONTINUE 02480017 + IVTNUM = 176 02490017 +C 02500017 +C **** TEST 176 **** 02510017 +C TEST 176 - RELATIONAL EXPRESSION. (IVR) (RO) (IC) 02520017 +C INTEGER VARIABLE REFERENCE WITH INTEGER CONSTANT 02530017 +C TRUE PATH. .LT. 02540017 +C 02550017 +C 02560017 + IF (ICZERO) 31760, 1760, 31760 02570017 + 1760 CONTINUE 02580017 + IVON01 = 3 02590017 + IVON02 = 0 02600017 + IF ( IVON01 .LT. 76 ) IVON02 = 1 02610017 + GO TO 41760 02620017 +31760 IVDELE = IVDELE + 1 02630017 + WRITE (I02,80003) IVTNUM 02640017 + IF (ICZERO) 41760, 1771, 41760 02650017 +41760 IF ( IVON02 - 1 ) 21760, 11760, 21760 02660017 +11760 IVPASS = IVPASS + 1 02670017 + WRITE (I02,80001) IVTNUM 02680017 + GO TO 1771 02690017 +21760 IVFAIL = IVFAIL + 1 02700017 + IVCOMP = IVON02 02710017 + IVCORR = 1 02720017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02730017 + 1771 CONTINUE 02740017 + IVTNUM = 177 02750017 +C 02760017 +C **** TEST 177 **** 02770017 +C TEST 177 - LIKE TEST 176. FALSE PATH. .EQ. 02780017 +C 02790017 +C 02800017 + IF (ICZERO) 31770, 1770, 31770 02810017 + 1770 CONTINUE 02820017 + IVON01 = 587 02830017 + IVON02 = 1 02840017 + IF ( IVON01 .EQ. 9999 ) IVON02=0 02850017 + GO TO 41770 02860017 +31770 IVDELE = IVDELE + 1 02870017 + WRITE (I02,80003) IVTNUM 02880017 + IF (ICZERO) 41770, 1781, 41770 02890017 +41770 IF ( IVON02 - 1 ) 21770, 11770, 21770 02900017 +11770 IVPASS = IVPASS + 1 02910017 + WRITE (I02,80001) IVTNUM 02920017 + GO TO 1781 02930017 +21770 IVFAIL = IVFAIL + 1 02940017 + IVCOMP = IVON02 02950017 + IVCORR = 1 02960017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02970017 + 1781 CONTINUE 02980017 + IVTNUM = 178 02990017 +C 03000017 +C **** TEST 178 **** 03010017 +C TEST 178 - LIKE TEST 176. TRUE PATH. .GE. 03020017 +C 03030017 +C 03040017 + IF (ICZERO) 31780, 1780, 31780 03050017 + 1780 CONTINUE 03060017 + IVON01 = 32767 03070017 + IVON02 = 0 03080017 + IF ( IVON01 .GE. 32767 ) IVON02 = 1 03090017 + GO TO 41780 03100017 +31780 IVDELE = IVDELE + 1 03110017 + WRITE (I02,80003) IVTNUM 03120017 + IF (ICZERO) 41780, 1791, 41780 03130017 +41780 IF ( IVON02 - 1 ) 21780, 11780, 21780 03140017 +11780 IVPASS = IVPASS + 1 03150017 + WRITE (I02,80001) IVTNUM 03160017 + GO TO 1791 03170017 +21780 IVFAIL = IVFAIL + 1 03180017 + IVCOMP = IVON02 03190017 + IVCORR = 1 03200017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03210017 + 1791 CONTINUE 03220017 + IVTNUM = 179 03230017 +C 03240017 +C **** TEST 179 **** 03250017 +C TEST 179 - RELATIONAL EXPRESSION. INTEGER ARRAY ELEMENT 03260017 +C REFERENCE. (IC) (RO) (IAER) FALSE PATH. .LT. 03270017 +C 03280017 +C 03290017 + IF (ICZERO) 31790, 1790, 31790 03300017 + 1790 CONTINUE 03310017 + IVON01 = 1 03320017 + IADN11(1) = 3 03330017 + IF ( 76 .LT. IADN11(1) ) IVON01 = 0 03340017 + GO TO 41790 03350017 +31790 IVDELE = IVDELE + 1 03360017 + WRITE (I02,80003) IVTNUM 03370017 + IF (ICZERO) 41790, 1801, 41790 03380017 +41790 IF ( IVON01 - 1 ) 21790, 11790, 21790 03390017 +11790 IVPASS = IVPASS + 1 03400017 + WRITE (I02,80001) IVTNUM 03410017 + GO TO 1801 03420017 +21790 IVFAIL = IVFAIL + 1 03430017 + IVCOMP = IVON01 03440017 + IVCORR = 1 03450017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03460017 + 1801 CONTINUE 03470017 + IVTNUM = 180 03480017 +C 03490017 +C **** TEST 180 **** 03500017 +C TEST 180 - LIKE TEST 179. TRUE PATH. .LE. 03510017 +C 03520017 +C 03530017 + IF (ICZERO) 31800, 1800, 31800 03540017 + 1800 CONTINUE 03550017 + IVON01 = 0 03560017 + IADN11(2) = 587 03570017 + IF ( 587 .LE. IADN11(2) ) IVON01 = 1 03580017 + GO TO 41800 03590017 +31800 IVDELE = IVDELE + 1 03600017 + WRITE (I02,80003) IVTNUM 03610017 + IF (ICZERO) 41800, 1811, 41800 03620017 +41800 IF ( IVON01 - 1 ) 21800, 11800, 21800 03630017 +11800 IVPASS = IVPASS + 1 03640017 + WRITE (I02,80001) IVTNUM 03650017 + GO TO 1811 03660017 +21800 IVFAIL = IVFAIL + 1 03670017 + IVCOMP = IVON01 03680017 + IVCORR = 1 03690017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03700017 + 1811 CONTINUE 03710017 + IVTNUM = 181 03720017 +C 03730017 +C **** TEST 181 **** 03740017 +C TEST 181 - LIKE TEST 179. FALSE PATH. .GE. 03750017 +C 03760017 +C 03770017 + IF (ICZERO) 31810, 1810, 31810 03780017 + 1810 CONTINUE 03790017 + IVON01 = 1 03800017 + IADN11(3) = 32767 03810017 + IF ( 76 .GE. IADN11(3) ) IVON01 = 0 03820017 + GO TO 41810 03830017 +31810 IVDELE = IVDELE + 1 03840017 + WRITE (I02,80003) IVTNUM 03850017 + IF (ICZERO) 41810, 1821, 41810 03860017 +41810 IF ( IVON01 - 1 ) 21810, 11810, 21810 03870017 +11810 IVPASS = IVPASS + 1 03880017 + WRITE (I02,80001) IVTNUM 03890017 + GO TO 1821 03900017 +21810 IVFAIL = IVFAIL + 1 03910017 + IVCOMP = IVON01 03920017 + IVCORR = 1 03930017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03940017 + 1821 CONTINUE 03950017 + IVTNUM = 182 03960017 +C 03970017 +C **** TEST 182 **** 03980017 +C TEST 182 - RELATIONAL EXPRESSION (IAER) (RO) (IC). TRUE 03990017 +C PATH. .EQ. 04000017 +C 04010017 +C 04020017 + IF (ICZERO) 31820, 1820, 31820 04030017 + 1820 CONTINUE 04040017 + IVON01 = 0 04050017 + IADN11(2) = 32767 04060017 + IF ( IADN11(2) .EQ. 32767 ) IVON01 = 1 04070017 + GO TO 41820 04080017 +31820 IVDELE = IVDELE + 1 04090017 + WRITE (I02,80003) IVTNUM 04100017 + IF (ICZERO) 41820, 1831, 41820 04110017 +41820 IF ( IVON01 - 1 ) 21820, 11820, 21820 04120017 +11820 IVPASS = IVPASS + 1 04130017 + WRITE (I02,80001) IVTNUM 04140017 + GO TO 1831 04150017 +21820 IVFAIL = IVFAIL + 1 04160017 + IVCOMP = IVON01 04170017 + IVCORR = 1 04180017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04190017 + 1831 CONTINUE 04200017 + IVTNUM = 183 04210017 +C 04220017 +C **** TEST 183 **** 04230017 +C TEST 183 - RELATIONAL EXPRESSION (IVR) (RO) (IAER) 04240017 +C FALSE PATH. .NE. 04250017 +C 04260017 +C 04270017 + IF (ICZERO) 31830, 1830, 31830 04280017 + 1830 CONTINUE 04290017 + IVON01 = 1 04300017 + IVON02 = 587 04310017 + IADN11(1) = 587 04320017 + IF ( IVON02 .NE. IADN11(1) ) IVON01 = 0 04330017 + GO TO 41830 04340017 +31830 IVDELE = IVDELE + 1 04350017 + WRITE (I02,80003) IVTNUM 04360017 + IF (ICZERO) 41830, 1841, 41830 04370017 +41830 IF ( IVON01 - 1 ) 21830, 11830, 21830 04380017 +11830 IVPASS = IVPASS + 1 04390017 + WRITE (I02,80001) IVTNUM 04400017 + GO TO 1841 04410017 +21830 IVFAIL = IVFAIL + 1 04420017 + IVCOMP = IVON01 04430017 + IVCORR = 1 04440017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04450017 + 1841 CONTINUE 04460017 + IVTNUM = 184 04470017 +C 04480017 +C **** TEST 184 **** 04490017 +C TEST 184 - RELATIONAL EXPRESSION (IAER) (RO) (IVR) 04500017 +C TRUE PATH .NE. 04510017 +C 04520017 +C 04530017 + IF (ICZERO) 31840, 1840, 31840 04540017 + 1840 CONTINUE 04550017 + IVON01 = 0 04560017 + IADN11(3) = 3 04570017 + IVON02 = 32767 04580017 + IF ( IADN11(3) .NE. IVON02 ) IVON01 = 1 04590017 + GO TO 41840 04600017 +31840 IVDELE = IVDELE + 1 04610017 + WRITE (I02,80003) IVTNUM 04620017 + IF (ICZERO) 41840, 1851, 41840 04630017 +41840 IF ( IVON01 - 1 ) 21840, 11840, 21840 04640017 +11840 IVPASS = IVPASS + 1 04650017 + WRITE (I02,80001) IVTNUM 04660017 + GO TO 1851 04670017 +21840 IVFAIL = IVFAIL + 1 04680017 + IVCOMP = IVON01 04690017 + IVCORR = 1 04700017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04710017 + 1851 CONTINUE 04720017 + IVTNUM = 185 04730017 +C 04740017 +C **** TEST 185 **** 04750017 +C TEST 185 - TEST OF PARENTHESES ( (LE) ) 04760017 +C TRUE PATH LOGICAL CONSTANT .TRUE. 04770017 +C 04780017 +C 04790017 + IF (ICZERO) 31850, 1850, 31850 04800017 + 1850 CONTINUE 04810017 + IVON01 = 0 04820017 + IF ( ( .TRUE. ) ) IVON01 = 1 04830017 + GO TO 41850 04840017 +31850 IVDELE = IVDELE + 1 04850017 + WRITE (I02,80003) IVTNUM 04860017 + IF (ICZERO) 41850, 1861, 41850 04870017 +41850 IF ( IVON01 - 1 ) 21850, 11850, 21850 04880017 +11850 IVPASS = IVPASS + 1 04890017 + WRITE (I02,80001) IVTNUM 04900017 + GO TO 1861 04910017 +21850 IVFAIL = IVFAIL + 1 04920017 + IVCOMP = IVON01 04930017 + IVCORR = 1 04940017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04950017 + 1861 CONTINUE 04960017 + IVTNUM = 186 04970017 +C 04980017 +C **** TEST 186 **** 04990017 +C TEST 186 - LIKE TEST 185 05000017 +C FALSE PATH LOGICAL CONSTANT .FALSE. 05010017 +C 05020017 +C 05030017 + IF (ICZERO) 31860, 1860, 31860 05040017 + 1860 CONTINUE 05050017 + IVON01 = 1 05060017 + IF ((( .FALSE. ))) IVON01 = 0 05070017 + GO TO 41860 05080017 +31860 IVDELE = IVDELE + 1 05090017 + WRITE (I02,80003) IVTNUM 05100017 + IF (ICZERO) 41860, 1871, 41860 05110017 +41860 IF ( IVON01 - 1 ) 21860, 11860, 21860 05120017 +11860 IVPASS = IVPASS + 1 05130017 + WRITE (I02,80001) IVTNUM 05140017 + GO TO 1871 05150017 +21860 IVFAIL = IVFAIL + 1 05160017 + IVCOMP = IVON01 05170017 + IVCORR = 1 05180017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05190017 + 1871 CONTINUE 05200017 + IVTNUM = 187 05210017 +C 05220017 +C **** TEST 187 **** 05230017 +C TEST 187 - PARENS AROUND LOGICAL VARIABLE REFERENCE ( (LVR) ) 05240017 +C TRUE PATH 05250017 +C 05260017 +C 05270017 + IF (ICZERO) 31870, 1870, 31870 05280017 + 1870 CONTINUE 05290017 + IVON01 = 0 05300017 + LCTNT1 = .TRUE. 05310017 + IF ( ( LCTNT1 ) ) IVON01 = 1 05320017 + GO TO 41870 05330017 +31870 IVDELE = IVDELE + 1 05340017 + WRITE (I02,80003) IVTNUM 05350017 + IF (ICZERO) 41870, 1881, 41870 05360017 +41870 IF ( IVON01 - 1 ) 21870, 11870, 21870 05370017 +11870 IVPASS = IVPASS + 1 05380017 + WRITE (I02,80001) IVTNUM 05390017 + GO TO 1881 05400017 +21870 IVFAIL = IVFAIL + 1 05410017 + IVCOMP = IVON01 05420017 + IVCORR = 1 05430017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05440017 + 1881 CONTINUE 05450017 + IVTNUM = 188 05460017 +C 05470017 +C **** TEST 188 **** 05480017 +C TEST 188 - PARENS AROUND LOGICAL ARRAY REFERENCE ( ( LAER ) ) 05490017 +C FALSE PATH 05500017 +C 05510017 + IF (ICZERO) 31880, 1880, 31880 05520017 + 1880 CONTINUE 05530017 + IVON01 = 1 05540017 + LATN1A(1) = .FALSE. 05550017 + IF ( ( LATN1A(1) ) ) IVON01 = 0 05560017 + GO TO 41880 05570017 +31880 IVDELE = IVDELE + 1 05580017 + WRITE (I02,80003) IVTNUM 05590017 + IF (ICZERO) 41880, 1891, 41880 05600017 +41880 IF ( IVON01 - 1 ) 21880, 11880, 21880 05610017 +11880 IVPASS = IVPASS + 1 05620017 + WRITE (I02,80001) IVTNUM 05630017 + GO TO 1891 05640017 +21880 IVFAIL = IVFAIL + 1 05650017 + IVCOMP = IVON01 05660017 + IVCORR = 1 05670017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05680017 + 1891 CONTINUE 05690017 + IVTNUM = 189 05700017 +C 05710017 +C **** TEST 189 **** 05720017 +C TEST 189 - USE OF .NOT. WITH A LOGICAL PRIMARY .NOT. (LP) 05730017 +C FALSE PATH .NOT. .TRUE. 05740017 +C 05750017 +C 05760017 + IF (ICZERO) 31890, 1890, 31890 05770017 + 1890 CONTINUE 05780017 + IVON01 = 1 05790017 + IF ( .NOT. .TRUE. ) IVON01 = 0 05800017 + GO TO 41890 05810017 +31890 IVDELE = IVDELE + 1 05820017 + WRITE (I02,80003) IVTNUM 05830017 + IF (ICZERO) 41890, 1901, 41890 05840017 +41890 IF ( IVON01 - 1 ) 21890, 11890, 21890 05850017 +11890 IVPASS = IVPASS + 1 05860017 + WRITE (I02,80001) IVTNUM 05870017 + GO TO 1901 05880017 +21890 IVFAIL = IVFAIL + 1 05890017 + IVCOMP = IVON01 05900017 + IVCORR = 1 05910017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05920017 + 1901 CONTINUE 05930017 + IVTNUM = 190 05940017 +C 05950017 +C **** TEST 190 **** 05960017 +C TEST 190 - LIKE TEST 189 TRUE PATH .NOT. .FALSE. 05970017 +C 05980017 +C 05990017 + IF (ICZERO) 31900, 1900, 31900 06000017 + 1900 CONTINUE 06010017 + IVON01 = 0 06020017 + IF ( .NOT. .FALSE. ) IVON01 = 1 06030017 + GO TO 41900 06040017 +31900 IVDELE = IVDELE + 1 06050017 + WRITE (I02,80003) IVTNUM 06060017 + IF (ICZERO) 41900, 1911, 41900 06070017 +41900 IF ( IVON01 - 1 ) 21900, 11900, 21900 06080017 +11900 IVPASS = IVPASS + 1 06090017 + WRITE (I02,80001) IVTNUM 06100017 + GO TO 1911 06110017 +21900 IVFAIL = IVFAIL + 1 06120017 + IVCOMP = IVON01 06130017 + IVCORR = 1 06140017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06150017 + 1911 CONTINUE 06160017 + IVTNUM = 191 06170017 +C 06180017 +C **** TEST 191 **** 06190017 +C TEST 191 - TESTS .NOT. WITH A LOGICAL VARIABLE SET TO .FALSE. 06200017 +C IN A LOGICAL ASSIGNMENT STATEMENT TRUE PATH 06210017 +C 06220017 +C 06230017 + IF (ICZERO) 31910, 1910, 31910 06240017 + 1910 CONTINUE 06250017 + IVON01 = 0 06260017 + LCTNT1 = .FALSE. 06270017 + IF ( .NOT. LCTNT1 ) IVON01 = 1 06280017 + GO TO 41910 06290017 +31910 IVDELE = IVDELE + 1 06300017 + WRITE (I02,80003) IVTNUM 06310017 + IF (ICZERO) 41910, 1921, 41910 06320017 +41910 IF ( IVON01 - 1 ) 21910, 11910, 21910 06330017 +11910 IVPASS = IVPASS + 1 06340017 + WRITE (I02,80001) IVTNUM 06350017 + GO TO 1921 06360017 +21910 IVFAIL = IVFAIL + 1 06370017 + IVCOMP = IVON01 06380017 + IVCORR = 1 06390017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06400017 + 1921 CONTINUE 06410017 + IVTNUM = 192 06420017 +C 06430017 +C **** TEST 192 **** 06440017 +C TEST 192 - LIKE TEST 191 ONLY USES A LOGICAL ARRAY ELEMENT 06450017 +C SET TO .FALSE. IN A LOGICAL ASSIGNMENT STATEMENT TRUE 06460017 +C 06470017 +C 06480017 + IF (ICZERO) 31920, 1920, 31920 06490017 + 1920 CONTINUE 06500017 + IVON01 = 0 06510017 + LATN1A(2) = .FALSE. 06520017 + IF ( .NOT. LATN1A(2) ) IVON01 = 1 06530017 + GO TO 41920 06540017 +31920 IVDELE = IVDELE + 1 06550017 + WRITE (I02,80003) IVTNUM 06560017 + IF (ICZERO) 41920, 1931, 41920 06570017 +41920 IF ( IVON01 - 1 ) 21920, 11920, 21920 06580017 +11920 IVPASS = IVPASS + 1 06590017 + WRITE (I02,80001) IVTNUM 06600017 + GO TO 1931 06610017 +21920 IVFAIL = IVFAIL + 1 06620017 + IVCOMP = IVON01 06630017 + IVCORR = 1 06640017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06650017 + 1931 CONTINUE 06660017 + IVTNUM = 193 06670017 +C 06680017 +C **** TEST 193 **** 06690017 +C TEST 193 - USE OF LOGICAL .AND. (LT) .AND. (LF) 06700017 +C USES TWO LOGICAL VARIABLES EACH SET TO .FALSE. 06710017 +C FALSE .AND. FALSE FALSE PATH 06720017 +C 06730017 +C 06740017 + IF (ICZERO) 31930, 1930, 31930 06750017 + 1930 CONTINUE 06760017 + IVON01 = 1 06770017 + LCTNT1 = .FALSE. 06780017 + LCTNT2 = .FALSE. 06790017 + IF ( LCTNT1 .AND. LCTNT2 ) IVON01 = 0 06800017 + GO TO 41930 06810017 +31930 IVDELE = IVDELE + 1 06820017 + WRITE (I02,80003) IVTNUM 06830017 + IF (ICZERO) 41930, 1941, 41930 06840017 +41930 IF ( IVON01 - 1 ) 21930, 11930, 21930 06850017 +11930 IVPASS = IVPASS + 1 06860017 + WRITE (I02,80001) IVTNUM 06870017 + GO TO 1941 06880017 +21930 IVFAIL = IVFAIL + 1 06890017 + IVCOMP = IVON01 06900017 + IVCORR = 1 06910017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06920017 + 1941 CONTINUE 06930017 + IVTNUM = 194 06940017 +C 06950017 +C **** TEST 194 **** 06960017 +C TEST 194 - LIKE TEST 193 FALSE .AND. TRUE FALSE PATH 06970017 +C 06980017 +C 06990017 + IF (ICZERO) 31940, 1940, 31940 07000017 + 1940 CONTINUE 07010017 + IVON01 = 1 07020017 + LCTNT1 = .FALSE. 07030017 + LCTNT2 = .TRUE. 07040017 + IF ( LCTNT1 .AND. LCTNT2 ) IVON01 = 0 07050017 + GO TO 41940 07060017 +31940 IVDELE = IVDELE + 1 07070017 + WRITE (I02,80003) IVTNUM 07080017 + IF (ICZERO) 41940, 1951, 41940 07090017 +41940 IF ( IVON01 - 1 ) 21940, 11940, 21940 07100017 +11940 IVPASS = IVPASS + 1 07110017 + WRITE (I02,80001) IVTNUM 07120017 + GO TO 1951 07130017 +21940 IVFAIL = IVFAIL + 1 07140017 + IVCOMP = IVON01 07150017 + IVCORR = 1 07160017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07170017 + 1951 CONTINUE 07180017 + IVTNUM = 195 07190017 +C 07200017 +C **** TEST 195 **** 07210017 +C TEST 195 - LIKE TEST 193 TRUE .AND. FALSE FALSE PATH 07220017 +C 07230017 +C 07240017 + IF (ICZERO) 31950, 1950, 31950 07250017 + 1950 CONTINUE 07260017 + IVON01 = 1 07270017 + LCTNT1 = .TRUE. 07280017 + LCTNT2 = .FALSE. 07290017 + IF ( LCTNT1 .AND. LCTNT2 ) IVON01 = 0 07300017 + GO TO 41950 07310017 +31950 IVDELE = IVDELE + 1 07320017 + WRITE (I02,80003) IVTNUM 07330017 + IF (ICZERO) 41950, 1961, 41950 07340017 +41950 IF ( IVON01 - 1 ) 21950, 11950, 21950 07350017 +11950 IVPASS = IVPASS + 1 07360017 + WRITE (I02,80001) IVTNUM 07370017 + GO TO 1961 07380017 +21950 IVFAIL = IVFAIL + 1 07390017 + IVCOMP = IVON01 07400017 + IVCORR = 1 07410017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07420017 + 1961 CONTINUE 07430017 + IVTNUM = 196 07440017 +C 07450017 +C **** TEST 196 **** 07460017 +C TEST 196 - LIKE TEST 193 TRUE .AND. TRUE TRUE PATH 07470017 +C 07480017 +C 07490017 + IF (ICZERO) 31960, 1960, 31960 07500017 + 1960 CONTINUE 07510017 + IVON01 = 0 07520017 + LCTNT1 = .TRUE. 07530017 + LCTNT2 = .TRUE. 07540017 + IF ( LCTNT1 .AND. LCTNT2 ) IVON01 = 1 07550017 + GO TO 41960 07560017 +31960 IVDELE = IVDELE + 1 07570017 + WRITE (I02,80003) IVTNUM 07580017 + IF (ICZERO) 41960, 1971, 41960 07590017 +41960 IF ( IVON01 - 1 ) 21960, 11960, 21960 07600017 +11960 IVPASS = IVPASS + 1 07610017 + WRITE (I02,80001) IVTNUM 07620017 + GO TO 1971 07630017 +21960 IVFAIL = IVFAIL + 1 07640017 + IVCOMP = IVON01 07650017 + IVCORR = 1 07660017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07670017 + 1971 CONTINUE 07680017 + IVTNUM = 197 07690017 +C 07700017 +C **** TEST 197 **** 07710017 +C TEST 197 - TEST OF THE INCLUSIVE .OR. . (LE) .OR. (LT) 07720017 +C USES LOGICAL VARIABLES SET IN LOGICAL ASSIGNMENT STATEMENTS 07730017 +C FALSE .OR. FALSE FALSE PATH 07740017 +C 07750017 +C 07760017 + IF (ICZERO) 31970, 1970, 31970 07770017 + 1970 CONTINUE 07780017 + IVON01 = 1 07790017 + LCTNT1 = .FALSE. 07800017 + LCTNT2 = .FALSE. 07810017 + IF ( LCTNT1 .OR. LCTNT2 ) IVON01 = 0 07820017 + GO TO 41970 07830017 +31970 IVDELE = IVDELE + 1 07840017 + WRITE (I02,80003) IVTNUM 07850017 + IF (ICZERO) 41970, 1981, 41970 07860017 +41970 IF ( IVON01 - 1 ) 21970, 11970, 21970 07870017 +11970 IVPASS = IVPASS + 1 07880017 + WRITE (I02,80001) IVTNUM 07890017 + GO TO 1981 07900017 +21970 IVFAIL = IVFAIL + 1 07910017 + IVCOMP = IVON01 07920017 + IVCORR = 1 07930017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07940017 + 1981 CONTINUE 07950017 + IVTNUM = 198 07960017 +C 07970017 +C **** TEST 198 **** 07980017 +C TEST 198 - LIKE TEST 197 FALSE .OR. TRUE TRUE PATH 07990017 +C 08000017 +C 08010017 + IF (ICZERO) 31980, 1980, 31980 08020017 + 1980 CONTINUE 08030017 + IVON01 = 0 08040017 + LCTNT1 = .FALSE. 08050017 + LCTNT2 = .TRUE. 08060017 + IF ( LCTNT1 .OR. LCTNT2 ) IVON01 = 1 08070017 + GO TO 41980 08080017 +31980 IVDELE = IVDELE + 1 08090017 + WRITE (I02,80003) IVTNUM 08100017 + IF (ICZERO) 41980, 1991, 41980 08110017 +41980 IF ( IVON01 - 1 ) 21980, 11980, 21980 08120017 +11980 IVPASS = IVPASS + 1 08130017 + WRITE (I02,80001) IVTNUM 08140017 + GO TO 1991 08150017 +21980 IVFAIL = IVFAIL + 1 08160017 + IVCOMP = IVON01 08170017 + IVCORR = 1 08180017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08190017 + 1991 CONTINUE 08200017 + IVTNUM = 199 08210017 +C 08220017 +C **** TEST 199 **** 08230017 +C TEST 199 - LIKE TEST 197. TRUE .OR. FALSE TRUE PATH. 08240017 +C 08250017 +C 08260017 + IF (ICZERO) 31990, 1990, 31990 08270017 + 1990 CONTINUE 08280017 + IVON01 = 0 08290017 + LCTNT1 = .TRUE. 08300017 + LCTNT2 = .FALSE. 08310017 + IF ( LCTNT1 .OR. LCTNT2 ) IVON01 = 1 08320017 + GO TO 41990 08330017 +31990 IVDELE = IVDELE + 1 08340017 + WRITE (I02,80003) IVTNUM 08350017 + IF (ICZERO) 41990, 5001, 41990 08360017 +41990 IF ( IVON01 - 1 ) 21990, 11990, 21990 08370017 +11990 IVPASS = IVPASS + 1 08380017 + WRITE (I02,80001) IVTNUM 08390017 + GO TO 5001 08400017 +21990 IVFAIL = IVFAIL + 1 08410017 + IVCOMP = IVON01 08420017 + IVCORR = 1 08430017 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08440017 + 5001 CONTINUE 08450017 +C 08460017 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08470017 +99999 CONTINUE 08480017 + WRITE (I02,90002) 08490017 + WRITE (I02,90006) 08500017 + WRITE (I02,90002) 08510017 + WRITE (I02,90002) 08520017 + WRITE (I02,90007) 08530017 + WRITE (I02,90002) 08540017 + WRITE (I02,90008) IVFAIL 08550017 + WRITE (I02,90009) IVPASS 08560017 + WRITE (I02,90010) IVDELE 08570017 +C 08580017 +C 08590017 +C TERMINATE ROUTINE EXECUTION 08600017 + STOP 08610017 +C 08620017 +C FORMAT STATEMENTS FOR PAGE HEADERS 08630017 +90000 FORMAT ("1") 08640017 +90002 FORMAT (" ") 08650017 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08660017 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08670017 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08680017 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08690017 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08700017 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08710017 +C 08720017 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08730017 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08740017 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08750017 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08760017 +C 08770017 +C FORMAT STATEMENTS FOR TEST RESULTS 08780017 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08790017 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08800017 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08810017 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08820017 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08830017 +C 08840017 +90007 FORMAT (" ",20X,"END OF PROGRAM FM017" ) 08850017 + END 08860017 diff --git a/Fortran/UnitTests/fcvs21_f95/FM017.reference_output b/Fortran/UnitTests/fcvs21_f95/FM017.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM017.reference_output @@ -0,0 +1,54 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 170 PASS + 171 PASS + 172 PASS + 173 PASS + 174 PASS + 175 PASS + 176 PASS + 177 PASS + 178 PASS + 179 PASS + 180 PASS + 181 PASS + 182 PASS + 183 PASS + 184 PASS + 185 PASS + 186 PASS + 187 PASS + 188 PASS + 189 PASS + 190 PASS + 191 PASS + 192 PASS + 193 PASS + 194 PASS + 195 PASS + 196 PASS + 197 PASS + 198 PASS + 199 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM017 + + 0 ERRORS ENCOUNTERED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM018.f b/Fortran/UnitTests/fcvs21_f95/FM018.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM018.f @@ -0,0 +1,899 @@ + PROGRAM FM018 + +C 00010018 +C COMMENT SECTION. 00020018 +C 00030018 +C FM018 00040018 +C 00050018 +C THIS ROUTINE CONTINUES TESTS OF THE FORTRAN 00060018 +C LOGICAL IF STATEMENT IN ALL OF THE VARIOUS FORMS. THE 00070018 +C FOLLOWING LOGICAL OPERANDS ARE USED FOR THIS ROUTINE - LOGICAL 00080018 +C CONSTANTS, LOGICAL VARIABLES, LOGICAL ARRAY ELEMENTS, AND 00090018 +C ARITHMETIC EXPRESSIONS WITH VARIOUS RELATIONAL OPERATORS. BOTH 00100018 +C THE TRUE AND FALSE BRANCHES ARE TESTED IN THE SERIES OF TESTS. 00110018 +C 00120018 +C REFERENCES 00130018 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140018 +C X3.9-1978 00150018 +C 00160018 +C SECTION 4.7.1, LOGICAL CONSTANT 00170018 +C SECTION 6, EXPRESSIONS 00180018 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00190018 +C SECTION 6.3, RELATIONAL EXPRESSIONS 00200018 +C SECTION 6.4, LOGICAL EXPRESSIONS 00210018 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00220018 +C SECTION 10, ASSIGNMENT STATEMENTS 00230018 +C SECTION 10.2, LOGICAL ASSIGNMENT STATEMENT 00240018 +C SECTION 11.5, LOGICAL IF STATEMENT 00250018 +C 00260018 + LOGICAL LCTNT1, LCTNT2, LATN1A(2) 00270018 + DIMENSION IADN11(2) 00280018 +C 00290018 +C ********************************************************** 00300018 +C 00310018 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00320018 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00330018 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00340018 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00350018 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00360018 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00370018 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00380018 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00390018 +C OF EXECUTING THESE TESTS. 00400018 +C 00410018 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00420018 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00430018 +C 00440018 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00450018 +C 00460018 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00470018 +C SOFTWARE STANDARDS VALIDATION GROUP 00480018 +C BUILDING 225 RM A266 00490018 +C GAITHERSBURG, MD 20899 00500018 +C ********************************************************** 00510018 +C 00520018 +C 00530018 +C 00540018 +C INITIALIZATION SECTION 00550018 +C 00560018 +C INITIALIZE CONSTANTS 00570018 +C ************** 00580018 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00590018 + I01 = 5 00600018 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00610018 + I02 = 6 00620018 +C SYSTEM ENVIRONMENT SECTION 00630018 +C 00640018 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00650018 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00660018 +C (UNIT NUMBER FOR CARD READER). 00670018 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00680018 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00690018 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00700018 +C 00710018 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00720018 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00730018 +C (UNIT NUMBER FOR PRINTER). 00740018 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00750018 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00760018 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00770018 +C 00780018 + IVPASS=0 00790018 + IVFAIL=0 00800018 + IVDELE=0 00810018 + ICZERO=0 00820018 +C 00830018 +C WRITE PAGE HEADERS 00840018 + WRITE (I02,90000) 00850018 + WRITE (I02,90001) 00860018 + WRITE (I02,90002) 00870018 + WRITE (I02, 90002) 00880018 + WRITE (I02,90003) 00890018 + WRITE (I02,90002) 00900018 + WRITE (I02,90004) 00910018 + WRITE (I02,90002) 00920018 + WRITE (I02,90011) 00930018 + WRITE (I02,90002) 00940018 + WRITE (I02,90002) 00950018 + WRITE (I02,90005) 00960018 + WRITE (I02,90006) 00970018 + WRITE (I02,90002) 00980018 + IVTNUM = 500 00990018 +C 01000018 +C **** TEST 500 **** 01010018 +C TEST 500 - LIKE TEST 197. TRUE .OR. TRUE TRUE PATH 01020018 +C TEST OF THE FORTRAN INCLUSIVE OR (LE) .OR. (LT) 01030018 +C 01040018 +C 01050018 + IF (ICZERO) 35000, 5000, 35000 01060018 + 5000 CONTINUE 01070018 + IVON01 = 0 01080018 + LCTNT1 = .TRUE. 01090018 + LCTNT2 = .TRUE. 01100018 + IF ( LCTNT1 .OR. LCTNT2 ) IVON01 = 1 01110018 + GO TO 45000 01120018 +35000 IVDELE = IVDELE + 1 01130018 + WRITE (I02,80003) IVTNUM 01140018 + IF (ICZERO) 45000, 5011, 45000 01150018 +45000 IF ( IVON01 - 1 ) 25000, 15000, 25000 01160018 +15000 IVPASS = IVPASS + 1 01170018 + WRITE (I02,80001) IVTNUM 01180018 + GO TO 5011 01190018 +25000 IVFAIL = IVFAIL + 1 01200018 + IVCOMP = IVON01 01210018 + IVCORR = 1 01220018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01230018 + 5011 CONTINUE 01240018 + IVTNUM = 501 01250018 +C 01260018 +C **** TEST 501 **** 01270018 +C TEST 501 - TEST OF PARENTHESES AROUND A LOGICAL EXPRESSION 01280018 +C ( (LE) ) .OR. (LT) 01290018 +C USES LOGICAL VARIABLES SET IN LOGICAL ASSIGNMENT STATEMENTS01300018 +C ( FALSE ) .OR. FALSE FALSE PATH 01310018 +C 01320018 +C 01330018 + IF (ICZERO) 35010, 5010, 35010 01340018 + 5010 CONTINUE 01350018 + IVON01 = 1 01360018 + LCTNT1 = .FALSE. 01370018 + LCTNT2 = .FALSE. 01380018 + IF ( (LCTNT1) .OR. LCTNT2 ) IVON01 = 0 01390018 + GO TO 45010 01400018 +35010 IVDELE = IVDELE + 1 01410018 + WRITE (I02,80003) IVTNUM 01420018 + IF (ICZERO) 45010, 5021, 45010 01430018 +45010 IF ( IVON01 - 1 ) 25010, 15010, 25010 01440018 +15010 IVPASS = IVPASS + 1 01450018 + WRITE (I02,80001) IVTNUM 01460018 + GO TO 5021 01470018 +25010 IVFAIL = IVFAIL + 1 01480018 + IVCOMP = IVON01 01490018 + IVCORR = 1 01500018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01510018 + 5021 CONTINUE 01520018 + IVTNUM = 502 01530018 +C 01540018 +C **** TEST 502 **** 01550018 +C TEST 502 - LIKE TEST 501 EXCEPT THAT IT IT IS OF THE FORM 01560018 +C (LE) .OR. ( (LT) ) TRUE .OR. (TRUE) 01570018 +C TRUE PATH 01580018 +C 01590018 +C 01600018 + IF (ICZERO) 35020, 5020, 35020 01610018 + 5020 CONTINUE 01620018 + IVON01 = 0 01630018 + LCTNT1 = .TRUE. 01640018 + LCTNT2 = .TRUE. 01650018 + IF ( LCTNT1 .OR. ( LCTNT2 ) ) IVON01 = 1 01660018 + GO TO 45020 01670018 +35020 IVDELE = IVDELE + 1 01680018 + WRITE (I02,80003) IVTNUM 01690018 + IF (ICZERO) 45020, 5031, 45020 01700018 +45020 IF ( IVON01 - 1 ) 25020, 15020, 25020 01710018 +15020 IVPASS = IVPASS + 1 01720018 + WRITE (I02,80001) IVTNUM 01730018 + GO TO 5031 01740018 +25020 IVFAIL = IVFAIL + 1 01750018 + IVCOMP = IVON01 01760018 + IVCORR = 1 01770018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01780018 + 5031 CONTINUE 01790018 + IVTNUM = 503 01800018 +C 01810018 +C **** TEST 503 **** 01820018 +C TEST 503 - TEST OF PARENTHESES IN LOGICAL EXPRESSIONS 01830018 +C ( (LE) ) .OR. ( (LT) ) 01840018 +C (FALSE) .OR. (TRUE) TRUE PATH 01850018 +C 01860018 +C 01870018 + IF (ICZERO) 35030, 5030, 35030 01880018 + 5030 CONTINUE 01890018 + IVON01 = 0 01900018 + LCTNT1 = .FALSE. 01910018 + LCTNT2 = .TRUE. 01920018 + IF ( (LCTNT1) .OR. (LCTNT2) ) IVON01 = 1 01930018 + GO TO 45030 01940018 +35030 IVDELE = IVDELE + 1 01950018 + WRITE (I02,80003) IVTNUM 01960018 + IF (ICZERO) 45030, 5041, 45030 01970018 +45030 IF ( IVON01 - 1 ) 25030, 15030, 25030 01980018 +15030 IVPASS = IVPASS + 1 01990018 + WRITE (I02,80001) IVTNUM 02000018 + GO TO 5041 02010018 +25030 IVFAIL = IVFAIL + 1 02020018 + IVCOMP = IVON01 02030018 + IVCORR = 1 02040018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02050018 + 5041 CONTINUE 02060018 + IVTNUM = 504 02070018 +C 02080018 +C **** TEST 504 **** 02090018 +C TEST 504 - LIKE TEST 503 ONLY MORE PARENTHESES TRUE PATH 02100018 +C 02110018 +C 02120018 + IF (ICZERO) 35040, 5040, 35040 02130018 + 5040 CONTINUE 02140018 + IVON01 = 0 02150018 + LCTNT1 = .TRUE. 02160018 + LCTNT2 = .FALSE. 02170018 + IF ( ( (LCTNT1) .OR. (LCTNT2) ) ) IVON01 = 1 02180018 + GO TO 45040 02190018 +35040 IVDELE = IVDELE + 1 02200018 + WRITE (I02,80003) IVTNUM 02210018 + IF (ICZERO) 45040, 5051, 45040 02220018 +45040 IF ( IVON01 - 1 ) 25040, 15040, 25040 02230018 +15040 IVPASS = IVPASS + 1 02240018 + WRITE (I02,80001) IVTNUM 02250018 + GO TO 5051 02260018 +25040 IVFAIL = IVFAIL + 1 02270018 + IVCOMP = IVON01 02280018 + IVCORR = 1 02290018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02300018 + 5051 CONTINUE 02310018 + IVTNUM = 505 02320018 +C 02330018 +C **** TEST 505 **** 02340018 +C TEST 505 - TEST OF PARENTHESES WITH .AND. FALSE PATH 02350018 +C 02360018 +C 02370018 + IF (ICZERO) 35050, 5050, 35050 02380018 + 5050 CONTINUE 02390018 + IVON01 = 1 02400018 + LCTNT1 = .FALSE. 02410018 + LCTNT2 = .FALSE. 02420018 + IF ( (LCTNT1) .AND. LCTNT2 ) IVON01 = 0 02430018 + GO TO 45050 02440018 +35050 IVDELE = IVDELE + 1 02450018 + WRITE (I02,80003) IVTNUM 02460018 + IF (ICZERO) 45050, 5061, 45050 02470018 +45050 IF ( IVON01 - 1 ) 25050, 15050, 25050 02480018 +15050 IVPASS = IVPASS + 1 02490018 + WRITE (I02,80001) IVTNUM 02500018 + GO TO 5061 02510018 +25050 IVFAIL = IVFAIL + 1 02520018 + IVCOMP = IVON01 02530018 + IVCORR = 1 02540018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02550018 + 5061 CONTINUE 02560018 + IVTNUM = 506 02570018 +C 02580018 +C **** TEST 506 **** 02590018 +C TEST 506 - LIKE TEST 505 FALSE PATH 02600018 +C 02610018 +C 02620018 + IF (ICZERO) 35060, 5060, 35060 02630018 + 5060 CONTINUE 02640018 + IVON01 = 1 02650018 + LCTNT1 = .FALSE. 02660018 + LCTNT2 = .TRUE. 02670018 + IF ( LCTNT1 .AND. (LCTNT2) ) IVON01 = 0 02680018 + GO TO 45060 02690018 +35060 IVDELE = IVDELE + 1 02700018 + WRITE (I02,80003) IVTNUM 02710018 + IF (ICZERO) 45060, 5071, 45060 02720018 +45060 IF ( IVON01 - 1 ) 25060, 15060, 25060 02730018 +15060 IVPASS = IVPASS + 1 02740018 + WRITE (I02,80001) IVTNUM 02750018 + GO TO 5071 02760018 +25060 IVFAIL = IVFAIL + 1 02770018 + IVCOMP = IVON01 02780018 + IVCORR = 1 02790018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02800018 + 5071 CONTINUE 02810018 + IVTNUM = 507 02820018 +C 02830018 +C **** TEST 507 **** 02840018 +C TEST 507 - MORE PARENTHESES WITH LOGICAL .AND. FALSE PATH 02850018 +C 02860018 +C 02870018 + IF (ICZERO) 35070, 5070, 35070 02880018 + 5070 CONTINUE 02890018 + IVON01 = 1 02900018 + LCTNT1 = .TRUE. 02910018 + LCTNT2 = .FALSE. 02920018 + IF ( (LCTNT1) .AND. (LCTNT2) ) IVON01 = 0 02930018 + GO TO 45070 02940018 +35070 IVDELE = IVDELE + 1 02950018 + WRITE (I02,80003) IVTNUM 02960018 + IF (ICZERO) 45070, 5081, 45070 02970018 +45070 IF ( IVON01 - 1 ) 25070, 15070, 25070 02980018 +15070 IVPASS = IVPASS + 1 02990018 + WRITE (I02,80001) IVTNUM 03000018 + GO TO 5081 03010018 +25070 IVFAIL = IVFAIL + 1 03020018 + IVCOMP = IVON01 03030018 + IVCORR = 1 03040018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03050018 + 5081 CONTINUE 03060018 + IVTNUM = 508 03070018 +C 03080018 +C **** TEST 508 **** 03090018 +C TEST 508 - TEST OF LOGICAL .NOT. WITH PARENTHESES AROUND A LOGIC03100018 +C PRIMARY. FOR THIS TEST A LOGICAL ARRAY ELEMENT IS USED AS 03110018 +C THE LOGICAL PRIMARY. .NOT. (FALSE) TRUE PATH. 03120018 +C 03130018 +C 03140018 + IF (ICZERO) 35080, 5080, 35080 03150018 + 5080 CONTINUE 03160018 + IVON01 = 0 03170018 + LATN1A(1) = .FALSE. 03180018 + IF ( .NOT. (LATN1A(1)) ) IVON01 = 1 03190018 + GO TO 45080 03200018 +35080 IVDELE = IVDELE + 1 03210018 + WRITE (I02,80003) IVTNUM 03220018 + IF (ICZERO) 45080, 5091, 45080 03230018 +45080 IF ( IVON01 - 1 ) 25080, 15080, 25080 03240018 +15080 IVPASS = IVPASS + 1 03250018 + WRITE (I02,80001) IVTNUM 03260018 + GO TO 5091 03270018 +25080 IVFAIL = IVFAIL + 1 03280018 + IVCOMP = IVON01 03290018 + IVCORR = 1 03300018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03310018 + 5091 CONTINUE 03320018 + IVTNUM = 509 03330018 +C 03340018 +C **** TEST 509 **** 03350018 +C TEST 509 - LIKE TEST 508 EXCEPT THAT THE WHOLE EXPRESSION 03360018 +C IS IN PARENTHESES. FALSE PATH 03370018 +C 03380018 +C 03390018 + IF (ICZERO) 35090, 5090, 35090 03400018 + 5090 CONTINUE 03410018 + IVON01 = 1 03420018 + LATN1A(2) = .TRUE. 03430018 + IF ( ( .NOT. (LATN1A(2)) ) ) IVON01 = 0 03440018 + GO TO 45090 03450018 +35090 IVDELE = IVDELE + 1 03460018 + WRITE (I02,80003) IVTNUM 03470018 + IF (ICZERO) 45090, 5101, 45090 03480018 +45090 IF ( IVON01 - 1 ) 25090, 15090, 25090 03490018 +15090 IVPASS = IVPASS + 1 03500018 + WRITE (I02,80001) IVTNUM 03510018 + GO TO 5101 03520018 +25090 IVFAIL = IVFAIL + 1 03530018 + IVCOMP = IVON01 03540018 + IVCORR = 1 03550018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03560018 + 5101 CONTINUE 03570018 + IVTNUM = 510 03580018 +C 03590018 +C **** TEST 510 **** 03600018 +C TEST 510 - INTEGER CONSTANT EXPONIENTATION 03610018 +C RELATIONAL EXPRESSION USING .EQ. TRUE PATH 03620018 +C 03630018 +C 03640018 + IF (ICZERO) 35100, 5100, 35100 03650018 + 5100 CONTINUE 03660018 + IVON01 = 0 03670018 + IF ( 3 ** 3 .EQ. 27 ) IVON01 = 1 03680018 + GO TO 45100 03690018 +35100 IVDELE = IVDELE + 1 03700018 + WRITE (I02,80003) IVTNUM 03710018 + IF (ICZERO) 45100, 5111, 45100 03720018 +45100 IF ( IVON01 - 1 ) 25100, 15100, 25100 03730018 +15100 IVPASS = IVPASS + 1 03740018 + WRITE (I02,80001) IVTNUM 03750018 + GO TO 5111 03760018 +25100 IVFAIL = IVFAIL + 1 03770018 + IVCOMP = IVON01 03780018 + IVCORR = 1 03790018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03800018 + 5111 CONTINUE 03810018 + IVTNUM = 511 03820018 +C 03830018 +C **** TEST 511 **** 03840018 +C TEST 511 - EXPONIENTIATION USING AN INTEGER VARIABLE 03850018 +C RELATIONAL EXPRESSION USING .NE. FALSE PATH 03860018 +C 03870018 +C 03880018 + IF (ICZERO) 35110, 5110, 35110 03890018 + 5110 CONTINUE 03900018 + IVON01 = 1 03910018 + IVON02 = 3 03920018 + IF ( IVON02 ** 3 .NE. 27 ) IVON01 = 0 03930018 + GO TO 45110 03940018 +35110 IVDELE = IVDELE + 1 03950018 + WRITE (I02,80003) IVTNUM 03960018 + IF (ICZERO) 45110, 5121, 45110 03970018 +45110 IF ( IVON01 - 1 ) 25110, 15110, 25110 03980018 +15110 IVPASS = IVPASS + 1 03990018 + WRITE (I02,80001) IVTNUM 04000018 + GO TO 5121 04010018 +25110 IVFAIL = IVFAIL + 1 04020018 + IVCOMP = IVON01 04030018 + IVCORR = 1 04040018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04050018 + 5121 CONTINUE 04060018 + IVTNUM = 512 04070018 +C 04080018 +C **** TEST 512 **** 04090018 +C TEST 512 - LIKE TEST 511 USES .LE. TRUE PATH 04100018 +C 04110018 +C 04120018 + IF (ICZERO) 35120, 5120, 35120 04130018 + 5120 CONTINUE 04140018 + IVON01 = 0 04150018 + IVON02 = 3 04160018 + IF ( 3 ** IVON02 .LE. 27 ) IVON01 = 1 04170018 + GO TO 45120 04180018 +35120 IVDELE = IVDELE + 1 04190018 + WRITE (I02,80003) IVTNUM 04200018 + IF (ICZERO) 45120, 5131, 45120 04210018 +45120 IF ( IVON01 - 1 ) 25120, 15120, 25120 04220018 +15120 IVPASS = IVPASS + 1 04230018 + WRITE (I02,80001) IVTNUM 04240018 + GO TO 5131 04250018 +25120 IVFAIL = IVFAIL + 1 04260018 + IVCOMP = IVON01 04270018 + IVCORR = 1 04280018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04290018 + 5131 CONTINUE 04300018 + IVTNUM = 513 04310018 +C 04320018 +C **** TEST 513 **** 04330018 +C TEST 513 - LIKE TEST 511 BUT USES ALL INTEGER VARIABLES 04340018 +C RELATIONAL EXPRESSION USES .LT. FALSE PATH 04350018 +C 04360018 +C 04370018 + IF (ICZERO) 35130, 5130, 35130 04380018 + 5130 CONTINUE 04390018 + IVON01 = 1 04400018 + IVON02 = 3 04410018 + IVON03 = 27 04420018 + IF ( IVON02 ** IVON02 .LT. IVON03 ) IVON01 = 0 04430018 + GO TO 45130 04440018 +35130 IVDELE = IVDELE + 1 04450018 + WRITE (I02,80003) IVTNUM 04460018 + IF (ICZERO) 45130, 5141, 45130 04470018 +45130 IF ( IVON01 - 1 ) 25130, 15130, 25130 04480018 +15130 IVPASS = IVPASS + 1 04490018 + WRITE (I02,80001) IVTNUM 04500018 + GO TO 5141 04510018 +25130 IVFAIL = IVFAIL + 1 04520018 + IVCOMP = IVON01 04530018 + IVCORR = 1 04540018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04550018 + 5141 CONTINUE 04560018 + IVTNUM = 514 04570018 +C 04580018 +C **** TEST 514 **** 04590018 +C TEST 514 - LIKE TEST 511 BUT USES INTEGER ARRAY ELEMENTS 04600018 +C RELATIONAL EXPRESSION USES .GE. TRUE PATH 04610018 +C 04620018 +C 04630018 + IF (ICZERO) 35140, 5140, 35140 04640018 + 5140 CONTINUE 04650018 + IVON01 = 0 04660018 + IVON02 = 3 04670018 + IADN11(1) = 3 04680018 + IADN11(2) = 27 04690018 + IF ( IADN11(1) ** IVON02 .GE. IADN11(2) ) IVON01 = 1 04700018 + GO TO 45140 04710018 +35140 IVDELE = IVDELE + 1 04720018 + WRITE (I02,80003) IVTNUM 04730018 + IF (ICZERO) 45140, 5151, 45140 04740018 +45140 IF ( IVON01 - 1 ) 25140, 15140, 25140 04750018 +15140 IVPASS = IVPASS + 1 04760018 + WRITE (I02,80001) IVTNUM 04770018 + GO TO 5151 04780018 +25140 IVFAIL = IVFAIL + 1 04790018 + IVCOMP = IVON01 04800018 + IVCORR = 1 04810018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04820018 + 5151 CONTINUE 04830018 + IVTNUM = 515 04840018 +C 04850018 +C **** TEST 515 **** 04860018 +C TEST 515 - LIKE TEST 514 BUT USES ALL INTEGER ARRAY ELEMENTS 04870018 +C RELATIONAL EXPRESSION USES .GT. FALSE PATH 04880018 +C 04890018 +C 04900018 + IF (ICZERO) 35150, 5150, 35150 04910018 + 5150 CONTINUE 04920018 + IVON01 = 1 04930018 + IADN11(1) = 3 04940018 + IADN11(2) = 27 04950018 + IF ( IADN11(1) ** IADN11(1) .GT. IADN11(2) ) IVON01 = 0 04960018 + GO TO 45150 04970018 +35150 IVDELE = IVDELE + 1 04980018 + WRITE (I02,80003) IVTNUM 04990018 + IF (ICZERO) 45150, 5161, 45150 05000018 +45150 IF ( IVON01 - 1 ) 25150, 15150, 25150 05010018 +15150 IVPASS = IVPASS + 1 05020018 + WRITE (I02,80001) IVTNUM 05030018 + GO TO 5161 05040018 +25150 IVFAIL = IVFAIL + 1 05050018 + IVCOMP = IVON01 05060018 + IVCORR = 1 05070018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05080018 + 5161 CONTINUE 05090018 + IVTNUM = 516 05100018 +C 05110018 +C **** TEST 516 **** 05120018 +C TEST 516 - TEST OF INTEGER MULTIPLICATION USING INTEGER 05130018 +C CONSTANTS. RELATIONAL EXPRESSION USES .LT. TRUE PATH 05140018 +C 05150018 +C 05160018 + IF (ICZERO) 35160, 5160, 35160 05170018 + 5160 CONTINUE 05180018 + IVON01 = 0 05190018 + IVON02 = 587 05200018 + IF ( 3 * 3 .LT. IVON02 ) IVON01 = 1 05210018 + GO TO 45160 05220018 +35160 IVDELE = IVDELE + 1 05230018 + WRITE (I02,80003) IVTNUM 05240018 + IF (ICZERO) 45160, 5171, 45160 05250018 +45160 IF ( IVON01 - 1 ) 25160, 15160, 25160 05260018 +15160 IVPASS = IVPASS + 1 05270018 + WRITE (I02,80001) IVTNUM 05280018 + GO TO 5171 05290018 +25160 IVFAIL = IVFAIL + 1 05300018 + IVCOMP = IVON01 05310018 + IVCORR = 1 05320018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05330018 + 5171 CONTINUE 05340018 + IVTNUM = 517 05350018 +C 05360018 +C **** TEST 517 **** 05370018 +C TEST 517 - INTEGER MULTIPLICATION WITH INTEGER CONSTANTS, 05380018 +C VARIABLES, AND ARRAY ELEMENTS. RELATIONAL EXPRESSION USES 05390018 +C .GT. FALSE PATH 05400018 +C 05410018 +C 05420018 + IF (ICZERO) 35170, 5170, 35170 05430018 + 5170 CONTINUE 05440018 + IVON01 = 1 05450018 + IVON02 = 32767 05460018 + IADN11(1) = 3 05470018 + IF ( IADN11(1) * 587 .GT. IVON02 ) IVON01 = 0 05480018 + GO TO 45170 05490018 +35170 IVDELE = IVDELE + 1 05500018 + WRITE (I02,80003) IVTNUM 05510018 + IF (ICZERO) 45170, 5181, 45170 05520018 +45170 IF ( IVON01 - 1 ) 25170, 15170, 25170 05530018 +15170 IVPASS = IVPASS + 1 05540018 + WRITE (I02,80001) IVTNUM 05550018 + GO TO 5181 05560018 +25170 IVFAIL = IVFAIL + 1 05570018 + IVCOMP = IVON01 05580018 + IVCORR = 1 05590018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05600018 + 5181 CONTINUE 05610018 + IVTNUM = 518 05620018 +C 05630018 +C **** TEST 518 **** 05640018 +C TEST 518 - INTEGER MULTIPLICATION AND EXPONIENTATION 05650018 +C RELATIONAL EXPRESSION USES .EQ. TRUE PATH 05660018 +C 05670018 +C 05680018 + IF (ICZERO) 35180, 5180, 35180 05690018 + 5180 CONTINUE 05700018 + IVON01 = 0 05710018 + IVON02 = 3 05720018 + IVON03 = 27 05730018 + IADN11(2) = 3 05740018 + IF ( IADN11(2) ** 2 * IVON02 .EQ. IVON03 ) IVON01 = 1 05750018 + GO TO 45180 05760018 +35180 IVDELE = IVDELE + 1 05770018 + WRITE (I02,80003) IVTNUM 05780018 + IF (ICZERO) 45180, 5191, 45180 05790018 +45180 IF ( IVON01 - 1 ) 25180, 15180, 25180 05800018 +15180 IVPASS = IVPASS + 1 05810018 + WRITE (I02,80001) IVTNUM 05820018 + GO TO 5191 05830018 +25180 IVFAIL = IVFAIL + 1 05840018 + IVCOMP = IVON01 05850018 + IVCORR = 1 05860018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05870018 + 5191 CONTINUE 05880018 + IVTNUM = 519 05890018 +C 05900018 +C **** TEST 519 **** 05910018 +C TEST 519 - INTEGER DIVISION. RELATIONAL EXPRESSION .NE. 05920018 +C FALSE PATH 05930018 +C 05940018 +C 05950018 + IF (ICZERO) 35190, 5190, 35190 05960018 + 5190 CONTINUE 05970018 + IVON01 = 1 05980018 + IVON02 = 27 05990018 + IADN11(1) = 3 06000018 + IF ( IVON02 / 9 .NE. IADN11(1) ) IVON01 = 0 06010018 + GO TO 45190 06020018 +35190 IVDELE = IVDELE + 1 06030018 + WRITE (I02,80003) IVTNUM 06040018 + IF (ICZERO) 45190, 5201, 45190 06050018 +45190 IF ( IVON01 - 1 ) 25190, 15190, 25190 06060018 +15190 IVPASS = IVPASS + 1 06070018 + WRITE (I02,80001) IVTNUM 06080018 + GO TO 5201 06090018 +25190 IVFAIL = IVFAIL + 1 06100018 + IVCOMP = IVON01 06110018 + IVCORR = 1 06120018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06130018 + 5201 CONTINUE 06140018 + IVTNUM = 520 06150018 +C 06160018 +C **** TEST 520 **** 06170018 +C TEST 520 - INTEGER VARIABLE DIVISION. RELATIONAL EXPRESSION 06180018 +C USES .GE. TRUE PATH 06190018 +C 06200018 +C 06210018 + IF (ICZERO) 35200, 5200, 35200 06220018 + 5200 CONTINUE 06230018 + IVON01 = 0 06240018 + IVON02 = 32767 06250018 + IVON03 = 3 06260018 + IVON04 = 9999 06270018 + IVON05 = 587 06280018 + IF ( IVON02 / IVON03 .GE. IVON04 / IVON05 ) IVON01 = 1 06290018 + GO TO 45200 06300018 +35200 IVDELE = IVDELE + 1 06310018 + WRITE (I02,80003) IVTNUM 06320018 + IF (ICZERO) 45200, 5211, 45200 06330018 +45200 IF ( IVON01 - 1 ) 25200, 15200, 25200 06340018 +15200 IVPASS = IVPASS + 1 06350018 + WRITE (I02,80001) IVTNUM 06360018 + GO TO 5211 06370018 +25200 IVFAIL = IVFAIL + 1 06380018 + IVCOMP = IVON01 06390018 + IVCORR = 1 06400018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06410018 + 5211 CONTINUE 06420018 + IVTNUM = 521 06430018 +C 06440018 +C **** TEST 521 **** 06450018 +C TEST 521 - INTEGER DIVISION AND EXPONIENTATION 06460018 +C RELATIONAL EXPRESSION USES .LT. FALSE PATH 06470018 +C 06480018 +C 06490018 + IF (ICZERO) 35210, 5210, 35210 06500018 + 5210 CONTINUE 06510018 + IVON01 = 1 06520018 + IVON02 = 587 06530018 + IVON03 = 3 06540018 + IADN11(2) = 3 06550018 + IF ( IVON02 / IADN11(2) ** 3 .LT. 3 ** IVON03 / IVON02 ) IVON01 =006560018 + IF ( IVON02 / IADN11(2) ** 3 .LT. 3 ** IVON03 / IVON02 ) IVON01=006570018 + GO TO 45210 06580018 +35210 IVDELE = IVDELE + 1 06590018 + WRITE (I02,80003) IVTNUM 06600018 + IF (ICZERO) 45210, 5221, 45210 06610018 +45210 IF ( IVON01 - 1 ) 25210, 15210, 25210 06620018 +15210 IVPASS = IVPASS + 1 06630018 + WRITE (I02,80001) IVTNUM 06640018 + GO TO 5221 06650018 +25210 IVFAIL = IVFAIL + 1 06660018 + IVCOMP = IVON01 06670018 + IVCORR = 1 06680018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06690018 + 5221 CONTINUE 06700018 + IVTNUM = 522 06710018 +C 06720018 +C **** TEST 522 **** 06730018 +C TEST 522 - TESTS 522 THRU 535 ARE TESTS OF SIGNED TERMS 06740018 +C +(T) ALSO -(T) 06750018 +C RELATIONAL EXPRESSION USES .GT. TRUE PATH 06760018 +C 06770018 +C 06780018 + IF (ICZERO) 35220, 5220, 35220 06790018 + 5220 CONTINUE 06800018 + IVON01 = 0 06810018 + IF ( 3 .GT. -3 ) IVON01 = 1 06820018 + GO TO 45220 06830018 +35220 IVDELE = IVDELE + 1 06840018 + WRITE (I02,80003) IVTNUM 06850018 + IF (ICZERO) 45220, 5231, 45220 06860018 +45220 IF ( IVON01 - 1 ) 25220, 15220, 25220 06870018 +15220 IVPASS = IVPASS + 1 06880018 + WRITE (I02,80001) IVTNUM 06890018 + GO TO 5231 06900018 +25220 IVFAIL = IVFAIL + 1 06910018 + IVCOMP = IVON01 06920018 + IVCORR = 1 06930018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06940018 + 5231 CONTINUE 06950018 + IVTNUM = 523 06960018 +C 06970018 +C **** TEST 523 **** 06980018 +C TEST 523 - TEST OF SIGNED ZERO .LT. FALSE PATH 06990018 +C 07000018 +C 07010018 + IF (ICZERO) 35230, 5230, 35230 07020018 + 5230 CONTINUE 07030018 + IVON01 = 1 07040018 + IF ( 0 .LT. -0 ) IVON01 = 0 07050018 + GO TO 45230 07060018 +35230 IVDELE = IVDELE + 1 07070018 + WRITE (I02,80003) IVTNUM 07080018 + IF (ICZERO) 45230, 5241, 45230 07090018 +45230 IF ( IVON01 - 1 ) 25230, 15230, 25230 07100018 +15230 IVPASS = IVPASS + 1 07110018 + WRITE (I02,80001) IVTNUM 07120018 + GO TO 5241 07130018 +25230 IVFAIL = IVFAIL + 1 07140018 + IVCOMP = IVON01 07150018 + IVCORR = 1 07160018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07170018 + 5241 CONTINUE 07180018 + IVTNUM = 524 07190018 +C 07200018 +C **** TEST 524 **** 07210018 +C TEST 524 - TEST OF SIGNED ZERO .LE. TRUE PATH 07220018 +C 07230018 +C 07240018 + IF (ICZERO) 35240, 5240, 35240 07250018 + 5240 CONTINUE 07260018 + IVON01 = 0 07270018 + IF ( 0 .LE. -0 ) IVON01 = 1 07280018 + GO TO 45240 07290018 +35240 IVDELE = IVDELE + 1 07300018 + WRITE (I02,80003) IVTNUM 07310018 + IF (ICZERO) 45240, 5251, 45240 07320018 +45240 IF ( IVON01 - 1 ) 25240, 15240, 25240 07330018 +15240 IVPASS = IVPASS + 1 07340018 + WRITE (I02,80001) IVTNUM 07350018 + GO TO 5251 07360018 +25240 IVFAIL = IVFAIL + 1 07370018 + IVCOMP = IVON01 07380018 + IVCORR = 1 07390018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07400018 + 5251 CONTINUE 07410018 + IVTNUM = 525 07420018 +C 07430018 +C **** TEST 525 **** 07440018 +C TEST 525 - TEST OF SIGNED ZERO .EQ. TRUE PATH 07450018 +C 07460018 +C 07470018 + IF (ICZERO) 35250, 5250, 35250 07480018 + 5250 CONTINUE 07490018 + IVON01 = 0 07500018 + IF ( 0 .EQ. -0 ) IVON01 = 1 07510018 + GO TO 45250 07520018 +35250 IVDELE = IVDELE + 1 07530018 + WRITE (I02,80003) IVTNUM 07540018 + IF (ICZERO) 45250, 5261, 45250 07550018 +45250 IF ( IVON01 - 1 ) 25250, 15250, 25250 07560018 +15250 IVPASS = IVPASS + 1 07570018 + WRITE (I02,80001) IVTNUM 07580018 + GO TO 5261 07590018 +25250 IVFAIL = IVFAIL + 1 07600018 + IVCOMP = IVON01 07610018 + IVCORR = 1 07620018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07630018 + 5261 CONTINUE 07640018 + IVTNUM = 526 07650018 +C 07660018 +C **** TEST 526 **** 07670018 +C TEST 526 - TEST OF SIGNED ZERO .NE. FALSE PATH 07680018 +C 07690018 +C 07700018 + IF (ICZERO) 35260, 5260, 35260 07710018 + 5260 CONTINUE 07720018 + IVON01 = 1 07730018 + IF ( 0 .NE. -0 ) IVON01 = 0 07740018 + GO TO 45260 07750018 +35260 IVDELE = IVDELE + 1 07760018 + WRITE (I02,80003) IVTNUM 07770018 + IF (ICZERO) 45260, 5271, 45260 07780018 +45260 IF ( IVON01 - 1 ) 25260, 15260, 25260 07790018 +15260 IVPASS = IVPASS + 1 07800018 + WRITE (I02,80001) IVTNUM 07810018 + GO TO 5271 07820018 +25260 IVFAIL = IVFAIL + 1 07830018 + IVCOMP = IVON01 07840018 + IVCORR = 1 07850018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07860018 + 5271 CONTINUE 07870018 + IVTNUM = 527 07880018 +C 07890018 +C **** TEST 527 **** 07900018 +C TEST 527 - TEST OF SIGNED ZERO .GE. TRUE PATH 07910018 +C 07920018 +C 07930018 + IF (ICZERO) 35270, 5270, 35270 07940018 + 5270 CONTINUE 07950018 + IVON01 = 0 07960018 + IF ( 0 .GE. -0 ) IVON01 = 1 07970018 + GO TO 45270 07980018 +35270 IVDELE = IVDELE + 1 07990018 + WRITE (I02,80003) IVTNUM 08000018 + IF (ICZERO) 45270, 5281, 45270 08010018 +45270 IF ( IVON01 - 1 ) 25270, 15270, 25270 08020018 +15270 IVPASS = IVPASS + 1 08030018 + WRITE (I02,80001) IVTNUM 08040018 + GO TO 5281 08050018 +25270 IVFAIL = IVFAIL + 1 08060018 + IVCOMP = IVON01 08070018 + IVCORR = 1 08080018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08090018 + 5281 CONTINUE 08100018 + IVTNUM = 528 08110018 +C 08120018 +C **** TEST 528 **** 08130018 +C TEST 528 - TEST OF SIGNED ZERO .GT. FALSE PATH 08140018 +C 08150018 +C 08160018 + IF (ICZERO) 35280, 5280, 35280 08170018 + 5280 CONTINUE 08180018 + IVON01 = 1 08190018 + IF ( 0 .GT. -0 ) IVON01 = 0 08200018 + GO TO 45280 08210018 +35280 IVDELE = IVDELE + 1 08220018 + WRITE (I02,80003) IVTNUM 08230018 + IF (ICZERO) 45280, 5291, 45280 08240018 +45280 IF ( IVON01 - 1 ) 25280, 15280, 25280 08250018 +15280 IVPASS = IVPASS + 1 08260018 + WRITE (I02,80001) IVTNUM 08270018 + GO TO 5291 08280018 +25280 IVFAIL = IVFAIL + 1 08290018 + IVCOMP = IVON01 08300018 + IVCORR = 1 08310018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08320018 + 5291 CONTINUE 08330018 + IVTNUM = 529 08340018 +C 08350018 +C **** TEST 529 **** 08360018 +C TEST 529 - TEST OF 32767 AND -32766 .GT. TRUE PATH 08370018 +C 08380018 +C 08390018 + IF (ICZERO) 35290, 5290, 35290 08400018 + 5290 CONTINUE 08410018 + IVON01 = 0 08420018 + IF ( 32767 .GT. -32766 ) IVON01 = 1 08430018 + GO TO 45290 08440018 +35290 IVDELE = IVDELE + 1 08450018 + WRITE (I02,80003) IVTNUM 08460018 + IF (ICZERO) 45290, 5301, 45290 08470018 +45290 IF ( IVON01 - 1 ) 25290, 15290, 25290 08480018 +15290 IVPASS = IVPASS + 1 08490018 + WRITE (I02,80001) IVTNUM 08500018 + GO TO 5301 08510018 +25290 IVFAIL = IVFAIL + 1 08520018 + IVCOMP = IVON01 08530018 + IVCORR = 1 08540018 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08550018 + 5301 CONTINUE 08560018 +C 08570018 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08580018 +99999 CONTINUE 08590018 + WRITE (I02,90002) 08600018 + WRITE (I02,90006) 08610018 + WRITE (I02,90002) 08620018 + WRITE (I02,90002) 08630018 + WRITE (I02,90007) 08640018 + WRITE (I02,90002) 08650018 + WRITE (I02,90008) IVFAIL 08660018 + WRITE (I02,90009) IVPASS 08670018 + WRITE (I02,90010) IVDELE 08680018 +C 08690018 +C 08700018 +C TERMINATE ROUTINE EXECUTION 08710018 + STOP 08720018 +C 08730018 +C FORMAT STATEMENTS FOR PAGE HEADERS 08740018 +90000 FORMAT ("1") 08750018 +90002 FORMAT (" ") 08760018 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08770018 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08780018 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08790018 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08800018 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08810018 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08820018 +C 08830018 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08840018 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08850018 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08860018 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08870018 +C 08880018 +C FORMAT STATEMENTS FOR TEST RESULTS 08890018 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08900018 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08910018 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08920018 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08930018 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08940018 +C 08950018 +90007 FORMAT (" ",20X,"END OF PROGRAM FM018" ) 08960018 + END 08970018 diff --git a/Fortran/UnitTests/fcvs21_f95/FM018.reference_output b/Fortran/UnitTests/fcvs21_f95/FM018.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM018.reference_output @@ -0,0 +1,54 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 500 PASS + 501 PASS + 502 PASS + 503 PASS + 504 PASS + 505 PASS + 506 PASS + 507 PASS + 508 PASS + 509 PASS + 510 PASS + 511 PASS + 512 PASS + 513 PASS + 514 PASS + 515 PASS + 516 PASS + 517 PASS + 518 PASS + 519 PASS + 520 PASS + 521 PASS + 522 PASS + 523 PASS + 524 PASS + 525 PASS + 526 PASS + 527 PASS + 528 PASS + 529 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM018 + + 0 ERRORS ENCOUNTERED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM019.f b/Fortran/UnitTests/fcvs21_f95/FM019.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM019.f @@ -0,0 +1,704 @@ + PROGRAM FM019 + +C 00010019 +C COMMENT SECTION. 00020019 +C 00030019 +C FM019 00040019 +C 00050019 +C THIS ROUTINE CONTINUES TESTS OF THE FORTRAN LOGICAL IF STATE00060019 +C BY TESTING VARIOUS FORMS OF RELATIONAL EXPRESSIONS WITH ARITHMETIC00070019 +C EXPRESSIONS . POSITIVE AND NEGATIVE SIGNS ARE USED IN CONJUNCTION00080019 +C WITH PARENTHESES. COMBINATIONS OF LOGICAL .AND. .OR. 00090019 +C .NOT. ARE USED TO TEST THE MORE COMPLEX EXPRESSIONS. 00100019 +C 00110019 +C REFERENCES 00120019 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130019 +C X3.9-1978 00140019 +C 00150019 +C SECTION 4.7.1, LOGICAL CONSTANT 00160019 +C SECTION 6, EXPRESSIONS 00170019 +C SECTION 11.5, LOGICAL IF STATEMENT 00180019 +C 00190019 + LOGICAL LCTNT1, LCTNT2 00200019 +C 00210019 +C ********************************************************** 00220019 +C 00230019 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00240019 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00250019 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00260019 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00270019 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00280019 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00290019 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00300019 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00310019 +C OF EXECUTING THESE TESTS. 00320019 +C 00330019 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00340019 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00350019 +C 00360019 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00370019 +C 00380019 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00390019 +C SOFTWARE STANDARDS VALIDATION GROUP 00400019 +C BUILDING 225 RM A266 00410019 +C GAITHERSBURG, MD 20899 00420019 +C ********************************************************** 00430019 +C 00440019 +C 00450019 +C 00460019 +C INITIALIZATION SECTION 00470019 +C 00480019 +C INITIALIZE CONSTANTS 00490019 +C ************** 00500019 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00510019 + I01 = 5 00520019 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00530019 + I02 = 6 00540019 +C SYSTEM ENVIRONMENT SECTION 00550019 +C 00560019 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00570019 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00580019 +C (UNIT NUMBER FOR CARD READER). 00590019 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00600019 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00610019 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00620019 +C 00630019 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00640019 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00650019 +C (UNIT NUMBER FOR PRINTER). 00660019 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00670019 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00680019 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00690019 +C 00700019 + IVPASS=0 00710019 + IVFAIL=0 00720019 + IVDELE=0 00730019 + ICZERO=0 00740019 +C 00750019 +C WRITE PAGE HEADERS 00760019 + WRITE (I02,90000) 00770019 + WRITE (I02,90001) 00780019 + WRITE (I02,90002) 00790019 + WRITE (I02, 90002) 00800019 + WRITE (I02,90003) 00810019 + WRITE (I02,90002) 00820019 + WRITE (I02,90004) 00830019 + WRITE (I02,90002) 00840019 + WRITE (I02,90011) 00850019 + WRITE (I02,90002) 00860019 + WRITE (I02,90002) 00870019 + WRITE (I02,90005) 00880019 + WRITE (I02,90006) 00890019 + WRITE (I02,90002) 00900019 + IVTNUM = 530 00910019 +C 00920019 +C **** TEST 530 **** 00930019 +C TEST 530 - TEST OF POSITIVELY SIGNED TERM +(IC) (RO) -(IC) 00940019 +C .LT. FALSE PATH 00950019 +C 00960019 + IF (ICZERO) 35300, 5300, 35300 00970019 + 5300 CONTINUE 00980019 + IVON01 = 1 00990019 + IF ( +3 .LT. -3) IVON01 = 0 01000019 + GO TO 45300 01010019 +35300 IVDELE = IVDELE + 1 01020019 + WRITE (I02,80003) IVTNUM 01030019 + IF (ICZERO) 45300, 5311, 45300 01040019 +45300 IF ( IVON01 - 1 ) 25300, 15300, 25300 01050019 +15300 IVPASS = IVPASS + 1 01060019 + WRITE (I02,80001) IVTNUM 01070019 + GO TO 5311 01080019 +25300 IVFAIL = IVFAIL + 1 01090019 + IVCOMP = IVON01 01100019 + IVCORR = 1 01110019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01120019 + 5311 CONTINUE 01130019 + IVTNUM = 531 01140019 +C 01150019 +C **** TEST 531 **** 01160019 +C TEST 531 - TEST OF SIGNED ZERO .LT. FALSE PATH 01170019 +C 01180019 +C 01190019 + IF (ICZERO) 35310, 5310, 35310 01200019 + 5310 CONTINUE 01210019 + IVON01 = 1 01220019 + IF ( +0 .LT. -0 ) IVON01 = 0 01230019 + GO TO 45310 01240019 +35310 IVDELE = IVDELE + 1 01250019 + WRITE (I02,80003) IVTNUM 01260019 + IF (ICZERO) 45310, 5321, 45310 01270019 +45310 IF ( IVON01 - 1 ) 25310, 15310, 25310 01280019 +15310 IVPASS = IVPASS + 1 01290019 + WRITE (I02,80001) IVTNUM 01300019 + GO TO 5321 01310019 +25310 IVFAIL = IVFAIL + 1 01320019 + IVCOMP = IVON01 01330019 + IVCORR = 1 01340019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01350019 + 5321 CONTINUE 01360019 + IVTNUM = 532 01370019 +C 01380019 +C **** TEST 532 **** 01390019 +C TEST 532 - TEST OF SIGNED ZERO .LE. TRUE PATH 01400019 +C 01410019 +C 01420019 + IF (ICZERO) 35320, 5320, 35320 01430019 + 5320 CONTINUE 01440019 + IVON01 = 0 01450019 + IF ( +0 .LE. -0 ) IVON01 = 1 01460019 + GO TO 45320 01470019 +35320 IVDELE = IVDELE + 1 01480019 + WRITE (I02,80003) IVTNUM 01490019 + IF (ICZERO) 45320, 5331, 45320 01500019 +45320 IF ( IVON01 - 1 ) 25320, 15320, 25320 01510019 +15320 IVPASS = IVPASS + 1 01520019 + WRITE (I02,80001) IVTNUM 01530019 + GO TO 5331 01540019 +25320 IVFAIL = IVFAIL + 1 01550019 + IVCOMP = IVON01 01560019 + IVCORR = 1 01570019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01580019 + 5331 CONTINUE 01590019 + IVTNUM = 533 01600019 +C 01610019 +C **** TEST 533 **** 01620019 +C TEST 533 - TEST OF SIGNED ZERO .EQ. TRUE PATH 01630019 +C 01640019 +C 01650019 + IF (ICZERO) 35330, 5330, 35330 01660019 + 5330 CONTINUE 01670019 + IVON01 = 0 01680019 + IF ( +0 .EQ. -0 ) IVON01 = 1 01690019 + GO TO 45330 01700019 +35330 IVDELE = IVDELE + 1 01710019 + WRITE (I02,80003) IVTNUM 01720019 + IF (ICZERO) 45330, 5341, 45330 01730019 +45330 IF ( IVON01 - 1 ) 25330, 15330, 25330 01740019 +15330 IVPASS = IVPASS + 1 01750019 + WRITE (I02,80001) IVTNUM 01760019 + GO TO 5341 01770019 +25330 IVFAIL = IVFAIL + 1 01780019 + IVCOMP = IVON01 01790019 + IVCORR = 1 01800019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01810019 + 5341 CONTINUE 01820019 + IVTNUM = 534 01830019 +C 01840019 +C **** TEST 534 **** 01850019 +C TEST 534 - TEST OF SIGNED ZERO .NE. FALSE PATH 01860019 +C 01870019 +C 01880019 + IF (ICZERO) 35340, 5340, 35340 01890019 + 5340 CONTINUE 01900019 + IVON01 = 1 01910019 + IF ( +0 .NE. -0 ) IVON01 = 0 01920019 + GO TO 45340 01930019 +35340 IVDELE = IVDELE + 1 01940019 + WRITE (I02,80003) IVTNUM 01950019 + IF (ICZERO) 45340, 5351, 45340 01960019 +45340 IF ( IVON01 - 1 ) 25340, 15340, 25340 01970019 +15340 IVPASS = IVPASS + 1 01980019 + WRITE (I02,80001) IVTNUM 01990019 + GO TO 5351 02000019 +25340 IVFAIL = IVFAIL + 1 02010019 + IVCOMP = IVON01 02020019 + IVCORR = 1 02030019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02040019 + 5351 CONTINUE 02050019 + IVTNUM = 535 02060019 +C 02070019 +C **** TEST 535 **** 02080019 +C TEST 535 - TEST OF SIGNED ZERO .GE. TRUE PATH 02090019 +C 02100019 +C 02110019 + IF (ICZERO) 35350, 5350, 35350 02120019 + 5350 CONTINUE 02130019 + IVON01 = 0 02140019 + IF ( +0 .GE. -0 ) IVON01 = 1 02150019 + GO TO 45350 02160019 +35350 IVDELE = IVDELE + 1 02170019 + WRITE (I02,80003) IVTNUM 02180019 + IF (ICZERO) 45350, 5361, 45350 02190019 +45350 IF ( IVON01 - 1 ) 25350, 15350, 25350 02200019 +15350 IVPASS = IVPASS + 1 02210019 + WRITE (I02,80001) IVTNUM 02220019 + GO TO 5361 02230019 +25350 IVFAIL = IVFAIL + 1 02240019 + IVCOMP = IVON01 02250019 + IVCORR = 1 02260019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02270019 + 5361 CONTINUE 02280019 + IVTNUM = 536 02290019 +C 02300019 +C **** TEST 536 **** 02310019 +C TEST 536 - TEST OF SIGNED ZERO .GT. FALSE PATH 02320019 +C 02330019 +C 02340019 + IF (ICZERO) 35360, 5360, 35360 02350019 + 5360 CONTINUE 02360019 + IVON01 = 1 02370019 + IF ( +0 .GT. -0 ) IVON01 = 0 02380019 + GO TO 45360 02390019 +35360 IVDELE = IVDELE + 1 02400019 + WRITE (I02,80003) IVTNUM 02410019 + IF (ICZERO) 45360, 5371, 45360 02420019 +45360 IF ( IVON01 - 1 ) 25360, 15360, 25360 02430019 +15360 IVPASS = IVPASS + 1 02440019 + WRITE (I02,80001) IVTNUM 02450019 + GO TO 5371 02460019 +25360 IVFAIL = IVFAIL + 1 02470019 + IVCOMP = IVON01 02480019 + IVCORR = 1 02490019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02500019 + 5371 CONTINUE 02510019 + IVTNUM = 537 02520019 +C 02530019 +C **** TEST 537 **** 02540019 +C TEST 537 - TEST OF +32767 .EQ. -32766 FALSE PATH 02550019 +C 02560019 +C 02570019 + IF (ICZERO) 35370, 5370, 35370 02580019 + 5370 CONTINUE 02590019 + IVON01 = 1 02600019 + IF ( +32767 .EQ. -32766 ) IVON01 = 0 02610019 + GO TO 45370 02620019 +35370 IVDELE = IVDELE + 1 02630019 + WRITE (I02,80003) IVTNUM 02640019 + IF (ICZERO) 45370, 5381, 45370 02650019 +45370 IF ( IVON01 - 1 ) 25370, 15370, 25370 02660019 +15370 IVPASS = IVPASS + 1 02670019 + WRITE (I02,80001) IVTNUM 02680019 + GO TO 5381 02690019 +25370 IVFAIL = IVFAIL + 1 02700019 + IVCOMP = IVON01 02710019 + IVCORR = 1 02720019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02730019 + 5381 CONTINUE 02740019 + IVTNUM = 538 02750019 +C 02760019 +C **** TEST 538 **** 02770019 +C TEST 538 - TESTS MINUS SIGN WITH INTEGER VARIABLES 02780019 +C RELATIONAL EXPRESSION USES .LE. TRUE PATH 02790019 +C 02800019 +C 02810019 + IF (ICZERO) 35380, 5380, 35380 02820019 + 5380 CONTINUE 02830019 + IVON01 = 0 02840019 + IVON02 = 3 02850019 + IF ( -IVON02 .LE. -IVON02 ) IVON01 = 1 02860019 + GO TO 45380 02870019 +35380 IVDELE = IVDELE + 1 02880019 + WRITE (I02,80003) IVTNUM 02890019 + IF (ICZERO) 45380, 5391, 45380 02900019 +45380 IF ( IVON01 - 1 ) 25380, 15380, 25380 02910019 +15380 IVPASS = IVPASS + 1 02920019 + WRITE (I02,80001) IVTNUM 02930019 + GO TO 5391 02940019 +25380 IVFAIL = IVFAIL + 1 02950019 + IVCOMP = IVON01 02960019 + IVCORR = 1 02970019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02980019 + 5391 CONTINUE 02990019 + IVTNUM = 539 03000019 +C 03010019 +C **** TEST 539 **** 03020019 +C TEST 539 - TEST IS LIKE TEST 538 USES .GE. TRUE PATH 03030019 +C 03040019 +C 03050019 + IF (ICZERO) 35390, 5390, 35390 03060019 + 5390 CONTINUE 03070019 + IVON01 = 0 03080019 + IVON02 = 32766 03090019 + IF ( -IVON02 .GE. -IVON02 ) IVON01 = 1 03100019 + GO TO 45390 03110019 +35390 IVDELE = IVDELE + 1 03120019 + WRITE (I02,80003) IVTNUM 03130019 + IF (ICZERO) 45390, 5401, 45390 03140019 +45390 IF ( IVON01 - 1 ) 25390, 15390, 25390 03150019 +15390 IVPASS = IVPASS + 1 03160019 + WRITE (I02,80001) IVTNUM 03170019 + GO TO 5401 03180019 +25390 IVFAIL = IVFAIL + 1 03190019 + IVCOMP = IVON01 03200019 + IVCORR = 1 03210019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03220019 + 5401 CONTINUE 03230019 + IVTNUM = 540 03240019 +C 03250019 +C **** TEST 540 **** 03260019 +C TEST 540 - INTEGER EXPONIENTIATION AND MINUS SIGN USES .NE. 03270019 +C FALSE PATH 03280019 +C 03290019 +C 03300019 + IF (ICZERO) 35400, 5400, 35400 03310019 + 5400 CONTINUE 03320019 + IVON01 = 1 03330019 + IVON02 = 3 03340019 + IF ( -IVON02 ** 3 .NE. -27 ) IVON01 = 0 03350019 + GO TO 45400 03360019 +35400 IVDELE = IVDELE + 1 03370019 + WRITE (I02,80003) IVTNUM 03380019 + IF (ICZERO) 45400, 5411, 45400 03390019 +45400 IF ( IVON01 - 1 ) 25400, 15400, 25400 03400019 +15400 IVPASS = IVPASS + 1 03410019 + WRITE (I02,80001) IVTNUM 03420019 + GO TO 5411 03430019 +25400 IVFAIL = IVFAIL + 1 03440019 + IVCOMP = IVON01 03450019 + IVCORR = 1 03460019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03470019 + 5411 CONTINUE 03480019 + IVTNUM = 541 03490019 +C 03500019 +C **** TEST 541 **** 03510019 +C TEST 541 - LIKE TEST 540 USES .LE. TRUE PATH 03520019 +C 03530019 +C 03540019 + IF (ICZERO) 35410, 5410, 35410 03550019 + 5410 CONTINUE 03560019 + IVON01 = 0 03570019 + IVON02 = 3 03580019 + IF ( -3 ** IVON02 .LE. -27 ) IVON01 = 1 03590019 + GO TO 45410 03600019 +35410 IVDELE = IVDELE + 1 03610019 + WRITE (I02,80003) IVTNUM 03620019 + IF (ICZERO) 45410, 5421, 45410 03630019 +45410 IF ( IVON01 - 1 ) 25410, 15410, 25410 03640019 +15410 IVPASS = IVPASS + 1 03650019 + WRITE (I02,80001) IVTNUM 03660019 + GO TO 5421 03670019 +25410 IVFAIL = IVFAIL + 1 03680019 + IVCOMP = IVON01 03690019 + IVCORR = 1 03700019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03710019 + 5421 CONTINUE 03720019 + IVTNUM = 542 03730019 +C 03740019 +C **** TEST 542 **** 03750019 +C TEST 542 - INTEGER EXPONIENTIATION AND MULTIPLICATION 03760019 +C USES .EQ. TRUE PATH 03770019 +C 03780019 +C 03790019 + IF (ICZERO) 35420, 5420, 35420 03800019 + 5420 CONTINUE 03810019 + IVON01 = 0 03820019 + IVON02 = 3 03830019 + IVON03 = 27 03840019 + IF ( -IVON02 ** 2 * IVON02 .EQ. -IVON03 ) IVON01 = 1 03850019 + GO TO 45420 03860019 +35420 IVDELE = IVDELE + 1 03870019 + WRITE (I02,80003) IVTNUM 03880019 + IF (ICZERO) 45420, 5431, 45420 03890019 +45420 IF ( IVON01 - 1 ) 25420, 15420, 25420 03900019 +15420 IVPASS = IVPASS + 1 03910019 + WRITE (I02,80001) IVTNUM 03920019 + GO TO 5431 03930019 +25420 IVFAIL = IVFAIL + 1 03940019 + IVCOMP = IVON01 03950019 + IVCORR = 1 03960019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03970019 + 5431 CONTINUE 03980019 + IVTNUM = 543 03990019 +C 04000019 +C **** TEST 543 **** 04010019 +C TEST 543 - INTEGER EXPONIENTIATION AND DIVISION 04020019 +C USES .LT. TRUE PATH 04030019 +C 04040019 +C 04050019 + IF (ICZERO) 35430, 5430, 35430 04060019 + 5430 CONTINUE 04070019 + IVON01 = 0 04080019 + IVON02 = 587 04090019 + IVON03 = 3 04100019 + IVON04 = 3 04110019 + IF ( -IVON02/IVON04 ** 3 .LT. -3 ** IVON03/IVON02 ) IVON01 = 1 04120019 + GO TO 45430 04130019 +35430 IVDELE = IVDELE + 1 04140019 + WRITE (I02,80003) IVTNUM 04150019 + IF (ICZERO) 45430, 5441, 45430 04160019 +45430 IF ( IVON01 - 1 ) 25430, 15430, 25430 04170019 +15430 IVPASS = IVPASS + 1 04180019 + WRITE (I02,80001) IVTNUM 04190019 + GO TO 5441 04200019 +25430 IVFAIL = IVFAIL + 1 04210019 + IVCOMP = IVON01 04220019 + IVCORR = 1 04230019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04240019 + 5441 CONTINUE 04250019 + IVTNUM = 544 04260019 +C 04270019 +C **** TEST 544 **** 04280019 +C TEST 544 - INTEGER ADDITION AND SUBTRACTION 04290019 +C USES .EQ. TRUE PATH 04300019 +C 04310019 +C 04320019 + IF (ICZERO) 35440, 5440, 35440 04330019 + 5440 CONTINUE 04340019 + IVON01 = 0 04350019 + IVON02 = 3 04360019 + IVON03 = 587 04370019 + IF ( IVON02 - IVON03 .EQ. -IVON03 + IVON02 ) IVON01 = 1 04380019 + GO TO 45440 04390019 +35440 IVDELE = IVDELE + 1 04400019 + WRITE (I02,80003) IVTNUM 04410019 + IF (ICZERO) 45440, 5451, 45440 04420019 +45440 IF ( IVON01 - 1 ) 25440, 15440, 25440 04430019 +15440 IVPASS = IVPASS + 1 04440019 + WRITE (I02,80001) IVTNUM 04450019 + GO TO 5451 04460019 +25440 IVFAIL = IVFAIL + 1 04470019 + IVCOMP = IVON01 04480019 + IVCORR = 1 04490019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04500019 + 5451 CONTINUE 04510019 + IVTNUM = 545 04520019 +C 04530019 +C **** TEST 545 **** 04540019 +C TEST 545 - INTEGER ADDITION AND SUBTRACTION WITH PARENTHESES 04550019 +C USES .EQ. TRUE PATH LIKE TEST 544 04560019 +C 04570019 +C 04580019 + IF (ICZERO) 35450, 5450, 35450 04590019 + 5450 CONTINUE 04600019 + IVON01 = 0 04610019 + IVON02 = 3 04620019 + IVON03 = 587 04630019 + IF ( (IVON02 - IVON03) .EQ. (-IVON03 + IVON02) ) IVON01 = 1 04640019 + GO TO 45450 04650019 +35450 IVDELE = IVDELE + 1 04660019 + WRITE (I02,80003) IVTNUM 04670019 + IF (ICZERO) 45450, 5461, 45450 04680019 +45450 IF ( IVON01 - 1 ) 25450, 15450, 25450 04690019 +15450 IVPASS = IVPASS + 1 04700019 + WRITE (I02,80001) IVTNUM 04710019 + GO TO 5461 04720019 +25450 IVFAIL = IVFAIL + 1 04730019 + IVCOMP = IVON01 04740019 + IVCORR = 1 04750019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04760019 + 5461 CONTINUE 04770019 + IVTNUM = 546 04780019 +C 04790019 +C **** TEST 546 **** 04800019 +C TEST 546 - INTEGER EXPONIENTIATION AND DIVISION WITH PARENS 04810019 +C USES .LT. TRUE PATH 04820019 +C 04830019 +C 04840019 + IF (ICZERO) 35460, 5460, 35460 04850019 + 5460 CONTINUE 04860019 + IVON01 = 0 04870019 + IVON02 = 587 04880019 + IVON03 = 3 04890019 + IVON04 = 3 04900019 + IF ((-IVON02/(IVON04**3)).LT.((-3**IVON03)/IVON02))IVON01=1 04910019 + GO TO 45460 04920019 +35460 IVDELE = IVDELE + 1 04930019 + WRITE (I02,80003) IVTNUM 04940019 + IF (ICZERO) 45460, 5471, 45460 04950019 +45460 IF ( IVON01 - 1 ) 25460, 15460, 25460 04960019 +15460 IVPASS = IVPASS + 1 04970019 + WRITE (I02,80001) IVTNUM 04980019 + GO TO 5471 04990019 +25460 IVFAIL = IVFAIL + 1 05000019 + IVCOMP = IVON01 05010019 + IVCORR = 1 05020019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05030019 + 5471 CONTINUE 05040019 + IVTNUM = 547 05050019 +C 05060019 +C **** TEST 547 **** 05070019 +C TEST 547 - INTEGER MULTIPLICATION WITH PARENTHESES .LT. FALSE 05080019 +C 05090019 +C 05100019 + IF (ICZERO) 35470, 5470, 35470 05110019 + 5470 CONTINUE 05120019 + IVON01 = 1 05130019 + IVON02 = 587 05140019 + IF ((-3)*(-3).LT.(-IVON02))IVON01=0 05150019 + GO TO 45470 05160019 +35470 IVDELE = IVDELE + 1 05170019 + WRITE (I02,80003) IVTNUM 05180019 + IF (ICZERO) 45470, 5481, 45470 05190019 +45470 IF ( IVON01 - 1 ) 25470, 15470, 25470 05200019 +15470 IVPASS = IVPASS + 1 05210019 + WRITE (I02,80001) IVTNUM 05220019 + GO TO 5481 05230019 +25470 IVFAIL = IVFAIL + 1 05240019 + IVCOMP = IVON01 05250019 + IVCORR = 1 05260019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05270019 + 5481 CONTINUE 05280019 + IVTNUM = 548 05290019 +C 05300019 +C **** TEST 548 **** 05310019 +C TEST 548 - INTEGER EXPONIENTIATION, MINUS SIGNS, AND PARENTHESES05320019 +C USES .LE. TRUE PATH 05330019 +C 05340019 +C 05350019 + IF (ICZERO) 35480, 5480, 35480 05360019 + 5480 CONTINUE 05370019 + IVON01 = 0 05380019 + IVON02 = 3 05390019 + IVON03 = 27 05400019 + IF ( ((-IVON02) ** IVON02 .LE. (-IVON03))) IVON01 = 1 05410019 + GO TO 45480 05420019 +35480 IVDELE = IVDELE + 1 05430019 + WRITE (I02,80003) IVTNUM 05440019 + IF (ICZERO) 45480, 5491, 45480 05450019 +45480 IF ( IVON01 - 1 ) 25480, 15480, 25480 05460019 +15480 IVPASS = IVPASS + 1 05470019 + WRITE (I02,80001) IVTNUM 05480019 + GO TO 5491 05490019 +25480 IVFAIL = IVFAIL + 1 05500019 + IVCOMP = IVON01 05510019 + IVCORR = 1 05520019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05530019 + 5491 CONTINUE 05540019 + IVTNUM = 549 05550019 +C 05560019 +C **** TEST 549 **** 05570019 +C TEST 549 - TEST THE ORDER OF INTEGER ARITHMETIC OPERATIONS 05580019 +C USES INTEGER EXPONIENTIATION, ADDITION, MULTIPLICATION, 05590019 +C AND PARENTHESES. ALSO USES .EQ. TRUE PATH 05600019 +C SEE SECTION 6.1, ARITHMETIC EXPRESSIONS. 05610019 +C 05620019 +C 05630019 + IF (ICZERO) 35490, 5490, 35490 05640019 + 5490 CONTINUE 05650019 + IVON01 = 0 05660019 + IVON02 = 3 05670019 + IF(IVON02 * IVON02/(IVON02+IVON02)**IVON02+IVON02 .EQ. 3) IVON01=105680019 + GO TO 45490 05690019 +35490 IVDELE = IVDELE + 1 05700019 + WRITE (I02,80003) IVTNUM 05710019 + IF (ICZERO) 45490, 5501, 45490 05720019 +45490 IF ( IVON01 - 1 ) 25490, 15490, 25490 05730019 +15490 IVPASS = IVPASS + 1 05740019 + WRITE (I02,80001) IVTNUM 05750019 + GO TO 5501 05760019 +25490 IVFAIL = IVFAIL + 1 05770019 + IVCOMP = IVON01 05780019 + IVCORR = 1 05790019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05800019 + 5501 CONTINUE 05810019 + IVTNUM = 550 05820019 +C 05830019 +C **** TEST 550 **** 05840019 +C TEST 550 - COMBINATION OF LOGICAL .NOT. AND .AND. 05850019 +C .NOT. (LP) .AND. .NOT. (LP) 05860019 +C TRUE PATH 05870019 +C 05880019 +C 05890019 + IF (ICZERO) 35500, 5500, 35500 05900019 + 5500 CONTINUE 05910019 + IVON01 = 0 05920019 + LCTNT1 = .FALSE. 05930019 + IF ( .NOT. .FALSE. .AND. .NOT. LCTNT1 ) IVON01 = 1 05940019 + GO TO 45500 05950019 +35500 IVDELE = IVDELE + 1 05960019 + WRITE (I02,80003) IVTNUM 05970019 + IF (ICZERO) 45500, 5511, 45500 05980019 +45500 IF ( IVON01 - 1 ) 25500, 15500, 25500 05990019 +15500 IVPASS = IVPASS + 1 06000019 + WRITE (I02,80001) IVTNUM 06010019 + GO TO 5511 06020019 +25500 IVFAIL = IVFAIL + 1 06030019 + IVCOMP = IVON01 06040019 + IVCORR = 1 06050019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06060019 + 5511 CONTINUE 06070019 + IVTNUM = 551 06080019 +C 06090019 +C **** TEST 551 **** 06100019 +C TEST 551 - COMBINATION OF LOGICAL .OR. AND .NOT. 06110019 +C .NOT. (LP) .OR. .NOT. (LP) 06120019 +C TRUE PATH 06130019 +C 06140019 +C 06150019 + IF (ICZERO) 35510, 5510, 35510 06160019 + 5510 CONTINUE 06170019 + IVON01 = 0 06180019 + LCTNT1 = .TRUE. 06190019 + LCTNT2 = .FALSE. 06200019 + IF ( .NOT. LCTNT1 .OR. .NOT. LCTNT2 ) IVON01 = 1 06210019 + GO TO 45510 06220019 +35510 IVDELE = IVDELE + 1 06230019 + WRITE (I02,80003) IVTNUM 06240019 + IF (ICZERO) 45510, 5521, 45510 06250019 +45510 IF ( IVON01 - 1 ) 25510, 15510, 25510 06260019 +15510 IVPASS = IVPASS + 1 06270019 + WRITE (I02,80001) IVTNUM 06280019 + GO TO 5521 06290019 +25510 IVFAIL = IVFAIL + 1 06300019 + IVCOMP = IVON01 06310019 + IVCORR = 1 06320019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06330019 + 5521 CONTINUE 06340019 + IVTNUM = 552 06350019 +C 06360019 +C **** TEST 552 **** 06370019 +C TEST 552 - COMBINATION OF LOGICAL .AND. .OR. AND .NOT. 06380019 +C .NOT. ( (LE) .OR. (LT) ) .AND. .NOT. ( (LT) .AND. (LF) ) 06390019 +C .NOT. IS APPLIED TO A LOGICAL EXPRESSION INCLOSED IN PARENS 06400019 +C FALSE PATH 06410019 +C 06420019 + IF (ICZERO) 35520, 5520, 35520 06430019 + 5520 CONTINUE 06440019 + IVON01 = 1 06450019 + LCTNT1 = .FALSE. 06460019 + LCTNT2 = .TRUE. 06470019 + IF(.NOT.(LCTNT1.OR.LCTNT2).AND..NOT.(LCTNT1.AND.LCTNT2))IVON01 = 006480019 + GO TO 45520 06490019 +35520 IVDELE = IVDELE + 1 06500019 + WRITE (I02,80003) IVTNUM 06510019 + IF (ICZERO) 45520, 5531, 45520 06520019 +45520 IF ( IVON01 - 1 ) 25520, 15520, 25520 06530019 +15520 IVPASS = IVPASS + 1 06540019 + WRITE (I02,80001) IVTNUM 06550019 + GO TO 5531 06560019 +25520 IVFAIL = IVFAIL + 1 06570019 + IVCOMP = IVON01 06580019 + IVCORR = 1 06590019 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06600019 + 5531 CONTINUE 06610019 +C 06620019 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 06630019 +99999 CONTINUE 06640019 + WRITE (I02,90002) 06650019 + WRITE (I02,90006) 06660019 + WRITE (I02,90002) 06670019 + WRITE (I02,90002) 06680019 + WRITE (I02,90007) 06690019 + WRITE (I02,90002) 06700019 + WRITE (I02,90008) IVFAIL 06710019 + WRITE (I02,90009) IVPASS 06720019 + WRITE (I02,90010) IVDELE 06730019 +C 06740019 +C 06750019 +C TERMINATE ROUTINE EXECUTION 06760019 + STOP 06770019 +C 06780019 +C FORMAT STATEMENTS FOR PAGE HEADERS 06790019 +90000 FORMAT ("1") 06800019 +90002 FORMAT (" ") 06810019 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06820019 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 06830019 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 06840019 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 06850019 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 06860019 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 06870019 +C 06880019 +C FORMAT STATEMENTS FOR RUN SUMMARIES 06890019 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 06900019 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 06910019 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 06920019 +C 06930019 +C FORMAT STATEMENTS FOR TEST RESULTS 06940019 +80001 FORMAT (" ",4X,I5,7X,"PASS") 06950019 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 06960019 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 06970019 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 06980019 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 06990019 +C 07000019 +90007 FORMAT (" ",20X,"END OF PROGRAM FM019" ) 07010019 + END 07020019 diff --git a/Fortran/UnitTests/fcvs21_f95/FM019.reference_output b/Fortran/UnitTests/fcvs21_f95/FM019.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM019.reference_output @@ -0,0 +1,47 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 530 PASS + 531 PASS + 532 PASS + 533 PASS + 534 PASS + 535 PASS + 536 PASS + 537 PASS + 538 PASS + 539 PASS + 540 PASS + 541 PASS + 542 PASS + 543 PASS + 544 PASS + 545 PASS + 546 PASS + 547 PASS + 548 PASS + 549 PASS + 550 PASS + 551 PASS + 552 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM019 + + 0 ERRORS ENCOUNTERED + 23 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM020.f b/Fortran/UnitTests/fcvs21_f95/FM020.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM020.f @@ -0,0 +1,483 @@ + PROGRAM FM020 + +C 00010020 +C COMMENT SECTION. 00020020 +C 00030020 +C FM020 00040020 +C 00050020 +C THIS ROUTINE TESTS THE FORTRAN IN-LINE STATEMENT FUNCTION 00060020 +C OF TYPE LOGICAL AND INTEGER. INTEGER CONSTANTS, LOGICAL CONSTANTS00070020 +C INTEGER VARIABLES, LOGICAL VARIABLES, INTEGER ARITHMETIC EXPRESS- 00080020 +C IONS ARE ALL USED TO TEST THE STATEMENT FUNCTION DEFINITION AND 00090020 +C THE VALUE RETURNED FOR THE STATEMENT FUNCTION WHEN IT IS USED 00100020 +C IN THE MAIN BODY OF THE PROGRAM. 00110020 +C 00120020 +C REFERENCES 00130020 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140020 +C X3.9-1978 00150020 +C 00160020 +C SECTION 8.4.1, INTEGER, REAL, DOUBLE PRECISION, COMPLEX, AND 00170020 +C LOGICAL TYPE-STATEMENTS 00180020 +C SECTION 15.3.2, INTRINSIC FUNCTION REFERENCES 00190020 +C SECTION 15.4, STATEMENT FUNCTIONS 00200020 +C SECTION 15.4.1, FORMS OF A FUNCTION STATEMENT 00210020 +C SECTION 15.4.2, REFERENCING A STATEMENT FUNCTION 00220020 +C SECTION 15.5.2, EXTERNAL FUNCTION REFERENCES 00230020 +C 00240020 + LOGICAL LFTN01, LDTN01 00250020 + LOGICAL LFTN02, LDTN02 00260020 + LOGICAL LFTN03, LDTN03, LCTN03 00270020 + LOGICAL LFTN04, LDTN04, LCTN04 00280020 + DIMENSION IADN11(2) 00290020 +C 00300020 +C..... TEST 553 00310020 + IFON01(IDON01) = 32767 00320020 +C 00330020 +C..... TEST 554 00340020 + LFTN01(LDTN01) = .TRUE. 00350020 +C 00360020 +C..... TEST 555 00370020 + IFON02 ( IDON02 ) = IDON02 00380020 +C 00390020 +C..... TEST 556 00400020 + LFTN02( LDTN02 ) = LDTN02 00410020 +C 00420020 +C..... TEST 557 00430020 + IFON03 (IDON03 )= IDON03 00440020 +C 00450020 +C..... TEST 558 00460020 + LFTN03(LDTN03) = LDTN03 00470020 +C 00480020 +C..... TEST 559 00490020 + LFTN04(LDTN04) = .NOT. LDTN04 00500020 +C 00510020 +C..... TEST 560 00520020 + IFON04(IDON04) = IDON04 ** 2 00530020 +C 00540020 +C..... TEST 561 00550020 + IFON05(IDON05, IDON06) = IDON05 + IDON06 00560020 +C 00570020 +C..... TEST 562 00580020 + IFON06(IDON07, IDON08) = SQRT(FLOAT(IDON07**2)+FLOAT(IDON08**2)) 00590020 +C 00600020 +C..... TEST 563 00610020 + IFON07(IDON09) = IDON09 ** 2 00620020 + IFON08(I,J)=SQRT(FLOAT(IFON07(I))+FLOAT(IFON07(J))) 00630020 +C 00640020 +C..... TEST 564 00650020 + IFON09(K,L) = K / L + K ** L - K * L 00660020 +C 00670020 +C 00680020 +C 00690020 +C ********************************************************** 00700020 +C 00710020 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00720020 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00730020 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00740020 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00750020 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00760020 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00770020 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00780020 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00790020 +C OF EXECUTING THESE TESTS. 00800020 +C 00810020 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00820020 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00830020 +C 00840020 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00850020 +C 00860020 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00870020 +C SOFTWARE STANDARDS VALIDATION GROUP 00880020 +C BUILDING 225 RM A266 00890020 +C GAITHERSBURG, MD 20899 00900020 +C ********************************************************** 00910020 +C 00920020 +C 00930020 +C 00940020 +C INITIALIZATION SECTION 00950020 +C 00960020 +C INITIALIZE CONSTANTS 00970020 +C ************** 00980020 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00990020 + I01 = 5 01000020 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01010020 + I02 = 6 01020020 +C SYSTEM ENVIRONMENT SECTION 01030020 +C 01040020 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 01050020 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01060020 +C (UNIT NUMBER FOR CARD READER). 01070020 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01080020 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01090020 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01100020 +C 01110020 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 01120020 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01130020 +C (UNIT NUMBER FOR PRINTER). 01140020 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01150020 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01160020 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01170020 +C 01180020 + IVPASS=0 01190020 + IVFAIL=0 01200020 + IVDELE=0 01210020 + ICZERO=0 01220020 +C 01230020 +C WRITE PAGE HEADERS 01240020 + WRITE (I02,90000) 01250020 + WRITE (I02,90001) 01260020 + WRITE (I02,90002) 01270020 + WRITE (I02, 90002) 01280020 + WRITE (I02,90003) 01290020 + WRITE (I02,90002) 01300020 + WRITE (I02,90004) 01310020 + WRITE (I02,90002) 01320020 + WRITE (I02,90011) 01330020 + WRITE (I02,90002) 01340020 + WRITE (I02,90002) 01350020 + WRITE (I02,90005) 01360020 + WRITE (I02,90006) 01370020 + WRITE (I02,90002) 01380020 + IVTNUM = 553 01390020 +C 01400020 +C **** TEST 553 **** 01410020 +C TEST 553 - THE VALUE OF THE INTEGER FUNCTION IS SET TO A 01420020 +C CONSTANT OF 32767 REGARDLESS OF THE VALUE OF THE ARGUEMENT 01430020 +C SUPPLIED TO THE DUMMY ARGUEMENT. TEST OF POSITIVE INTEGER 01440020 +C CONSTANTS FOR A STATEMENT FUNCTION. 01450020 +C 01460020 +C 01470020 + IF (ICZERO) 35530, 5530, 35530 01480020 + 5530 CONTINUE 01490020 + IVCOMP = IFON01(3) 01500020 + GO TO 45530 01510020 +35530 IVDELE = IVDELE + 1 01520020 + WRITE (I02,80003) IVTNUM 01530020 + IF (ICZERO) 45530, 5541, 45530 01540020 +45530 IF ( IVCOMP - 32767 ) 25530, 15530, 25530 01550020 +15530 IVPASS = IVPASS + 1 01560020 + WRITE (I02,80001) IVTNUM 01570020 + GO TO 5541 01580020 +25530 IVFAIL = IVFAIL + 1 01590020 + IVCORR = 32767 01600020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01610020 + 5541 CONTINUE 01620020 + IVTNUM = 554 01630020 +C 01640020 +C **** TEST 554 **** 01650020 +C TEST 554 - TEST OF THE STATEMENT FUNCTION OF TYPE LOGICAL 01660020 +C SET TO THE LOGICAL CONSTANT .TRUE. REGARDLESS OF THE 01670020 +C ARGUEMENT SUPPLIED TO THE DUMMY ARGUEMENT. 01680020 +C A LOGICAL IF STATEMENT IS USED IN CONJUNCTION WITH THE LOGICAL 01690020 +C STATEMENT FUNCTION. THE TRUE PATH IS TESTED. 01700020 +C 01710020 +C 01720020 + IF (ICZERO) 35540, 5540, 35540 01730020 + 5540 CONTINUE 01740020 + IVON01 = 0 01750020 + IF ( LFTN01(.FALSE.) ) IVON01 = 1 01760020 + GO TO 45540 01770020 +35540 IVDELE = IVDELE + 1 01780020 + WRITE (I02,80003) IVTNUM 01790020 + IF (ICZERO) 45540, 5551, 45540 01800020 +45540 IF ( IVON01 - 1 ) 25540, 15540, 25540 01810020 +15540 IVPASS = IVPASS + 1 01820020 + WRITE (I02,80001) IVTNUM 01830020 + GO TO 5551 01840020 +25540 IVFAIL = IVFAIL + 1 01850020 + IVCOMP = IVON01 01860020 + IVCORR = 1 01870020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01880020 + 5551 CONTINUE 01890020 + IVTNUM = 555 01900020 +C 01910020 +C **** TEST 555 **** 01920020 +C TEST 555 - THE INTEGER STATEMENT FUNCTION IS SET TO THE VALUE 01930020 +C OF THE ARGEUMENT SUPPLIED. 01940020 +C 01950020 +C 01960020 + IF (ICZERO) 35550, 5550, 35550 01970020 + 5550 CONTINUE 01980020 + IVCOMP = IFON02 ( 32767 ) 01990020 + GO TO 45550 02000020 +35550 IVDELE = IVDELE + 1 02010020 + WRITE (I02,80003) IVTNUM 02020020 + IF (ICZERO) 45550, 5561, 45550 02030020 +45550 IF ( IVCOMP - 32767 ) 25550, 15550, 25550 02040020 +15550 IVPASS = IVPASS + 1 02050020 + WRITE (I02,80001) IVTNUM 02060020 + GO TO 5561 02070020 +25550 IVFAIL = IVFAIL + 1 02080020 + IVCORR = 32767 02090020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02100020 + 5561 CONTINUE 02110020 + IVTNUM = 556 02120020 +C 02130020 +C **** TEST 556 **** 02140020 +C TEST 556 - TEST OF A LOGICAL STATEMENT FUNCTION SET TO THE 02150020 +C VALUE OF THE ARGUEMENT SUPPLIED. THE FALSE PATH OF A LOGICAL 02160020 +C IF STATEMENT IS USED IN CONJUNCTION WITH THE LOGICAL 02170020 +C STATEMENT FUNCTION. 02180020 +C 02190020 +C 02200020 + IF (ICZERO) 35560, 5560, 35560 02210020 + 5560 CONTINUE 02220020 + IVON01 = 1 02230020 + IF ( LFTN02(.FALSE.) ) IVON01 = 0 02240020 + GO TO 45560 02250020 +35560 IVDELE = IVDELE + 1 02260020 + WRITE (I02,80003) IVTNUM 02270020 + IF (ICZERO) 45560, 5571, 45560 02280020 +45560 IF ( IVON01 - 1 ) 25560, 15560, 25560 02290020 +15560 IVPASS = IVPASS + 1 02300020 + WRITE (I02,80001) IVTNUM 02310020 + GO TO 5571 02320020 +25560 IVFAIL = IVFAIL + 1 02330020 + IVCOMP = IVON01 02340020 + IVCORR = 1 02350020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02360020 + 5571 CONTINUE 02370020 + IVTNUM = 557 02380020 +C 02390020 +C **** TEST 557 **** 02400020 +C TEST 557 - THE VALUE OF AN INTEGER FUNCTION IS SET EQUAL TO 02410020 +C VALUE OF THE ARGUEMENT SUPPLIED. THIS VALUE IS AN INTEGER 02420020 +C VARIABLE SET TO 32767. 02430020 +C 02440020 +C 02450020 + IF (ICZERO) 35570, 5570, 35570 02460020 + 5570 CONTINUE 02470020 + ICON01 = 32767 02480020 + IVCOMP = IFON03 ( ICON01 ) 02490020 + GO TO 45570 02500020 +35570 IVDELE = IVDELE + 1 02510020 + WRITE (I02,80003) IVTNUM 02520020 + IF (ICZERO) 45570, 5581, 45570 02530020 +45570 IF ( IVCOMP - 32767 ) 25570, 15570, 25570 02540020 +15570 IVPASS = IVPASS + 1 02550020 + WRITE (I02,80001) IVTNUM 02560020 + GO TO 5581 02570020 +25570 IVFAIL = IVFAIL + 1 02580020 + IVCORR = 32767 02590020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02600020 + 5581 CONTINUE 02610020 + IVTNUM = 558 02620020 +C 02630020 +C **** TEST 558 **** 02640020 +C TEST 558 - A LOGICAL STATEMENT FUNCTION IS SET EQUAL TO THE 02650020 +C VALUE OF THE ARGUEMENT SUPPLIED. THIS VALUE IS A LOGICAL 02660020 +C VARIABLE SET TO .TRUE. THE TRUE PATH OF A LOGICAL IF 02670020 +C STATEMENT IS USED IN CONJUNCTION WITH THE LOGICAL STATEMENT 02680020 +C FUNCTION. 02690020 +C 02700020 +C 02710020 + IF (ICZERO) 35580, 5580, 35580 02720020 + 5580 CONTINUE 02730020 + IVON01 = 0 02740020 + LCTN03 = .TRUE. 02750020 + IF ( LFTN03(LCTN03) ) IVON01 = 1 02760020 + GO TO 45580 02770020 +35580 IVDELE = IVDELE + 1 02780020 + WRITE (I02,80003) IVTNUM 02790020 + IF (ICZERO) 45580, 5591, 45580 02800020 +45580 IF ( IVON01 - 1 ) 25580, 15580, 25580 02810020 +15580 IVPASS = IVPASS + 1 02820020 + WRITE (I02,80001) IVTNUM 02830020 + GO TO 5591 02840020 +25580 IVFAIL = IVFAIL + 1 02850020 + IVCOMP = IVON01 02860020 + IVCORR = 1 02870020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02880020 + 5591 CONTINUE 02890020 + IVTNUM = 559 02900020 +C 02910020 +C **** TEST 559 **** 02920020 +C TEST 559 - LIKE TEST 558 ONLY THE LOGICAL .NOT. IS USED 02930020 +C IN THE LOGICAL STATEMENT FUNCTION DEFINITION THE FALSE PATH 02940020 +C OF A LOGICAL IF STATEMENT IS USED IN CONJUNCTION WITH THE 02950020 +C LOGICAL STATEMENT FUNCTION. 02960020 +C 02970020 +C 02980020 + IF (ICZERO) 35590, 5590, 35590 02990020 + 5590 CONTINUE 03000020 + IVON01 = 1 03010020 + LCTN04 = .TRUE. 03020020 + IF ( LFTN04(LCTN04) ) IVON01 = 0 03030020 + GO TO 45590 03040020 +35590 IVDELE = IVDELE + 1 03050020 + WRITE (I02,80003) IVTNUM 03060020 + IF (ICZERO) 45590, 5601, 45590 03070020 +45590 IF ( IVON01 - 1 ) 25590, 15590, 25590 03080020 +15590 IVPASS = IVPASS + 1 03090020 + WRITE (I02,80001) IVTNUM 03100020 + GO TO 5601 03110020 +25590 IVFAIL = IVFAIL + 1 03120020 + IVCOMP = IVON01 03130020 + IVCORR = 1 03140020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03150020 + 5601 CONTINUE 03160020 + IVTNUM = 560 03170020 +C 03180020 +C **** TEST 560 **** 03190020 +C TEST 560 - INTEGER EXPONIENTIATION USED IN AN INTEGER 03200020 +C STATEMENT FUNCTION. 03210020 +C 03220020 +C 03230020 + IF (ICZERO) 35600, 5600, 35600 03240020 + 5600 CONTINUE 03250020 + ICON04 = 3 03260020 + IVCOMP = IFON04(ICON04) 03270020 + GO TO 45600 03280020 +35600 IVDELE = IVDELE + 1 03290020 + WRITE (I02,80003) IVTNUM 03300020 + IF (ICZERO) 45600, 5611, 45600 03310020 +45600 IF ( IVCOMP - 9 ) 25600, 15600, 25600 03320020 +15600 IVPASS = IVPASS + 1 03330020 + WRITE (I02,80001) IVTNUM 03340020 + GO TO 5611 03350020 +25600 IVFAIL = IVFAIL + 1 03360020 + IVCORR = 9 03370020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03380020 + 5611 CONTINUE 03390020 + IVTNUM = 561 03400020 +C 03410020 +C **** TEST 561 **** 03420020 +C TEST 561 - TEST OF INTEGER ADDITION USING TWO (2) DUMMY 03430020 +C ARGUEMENTS. 03440020 +C 03450020 +C 03460020 + IF (ICZERO) 35610, 5610, 35610 03470020 + 5610 CONTINUE 03480020 + ICON05 = 9 03490020 + ICON06 = 16 03500020 + IVCOMP = IFON05(ICON05, ICON06) 03510020 + GO TO 45610 03520020 +35610 IVDELE = IVDELE + 1 03530020 + WRITE (I02,80003) IVTNUM 03540020 + IF (ICZERO) 45610, 5621, 45610 03550020 +45610 IF ( IVCOMP - 25 ) 25610, 15610, 25610 03560020 +15610 IVPASS = IVPASS + 1 03570020 + WRITE (I02,80001) IVTNUM 03580020 + GO TO 5621 03590020 +25610 IVFAIL = IVFAIL + 1 03600020 + IVCORR = 25 03610020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03620020 + 5621 CONTINUE 03630020 + IVTNUM = 562 03640020 +C 03650020 +C **** TEST 562 **** 03660020 +C TEST 562 - THIS TEST IS THE SOLUTION OF A RIGHT TRIANGLE 03670020 +C USING INTEGER STATEMENT FUNCTIONS WHICH REFERENCE THE 03680020 +C INTRINSIC FUNCTIONS SQRT AND FLOAT. THIS IS A 3-4-5 03690020 +C RIGHT TRIANGLE. 03700020 +C 03710020 +C 03720020 + IF (ICZERO) 35620, 5620, 35620 03730020 + 5620 CONTINUE 03740020 + ICON07 = 3 03750020 + ICON08 = 4 03760020 + IVCOMP = IFON06(ICON07, ICON08) 03770020 + GO TO 45620 03780020 +35620 IVDELE = IVDELE + 1 03790020 + WRITE (I02,80003) IVTNUM 03800020 + IF (ICZERO) 45620, 5631, 45620 03810020 +45620 IF ( IVCOMP - 5 ) 5622, 15620, 5622 03820020 + 5622 IF ( IVCOMP - 4 ) 25620, 15620, 25620 03830020 +15620 IVPASS = IVPASS + 1 03840020 + WRITE (I02,80001) IVTNUM 03850020 + GO TO 5631 03860020 +25620 IVFAIL = IVFAIL + 1 03870020 + IVCORR = 5 03880020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03890020 + 5631 CONTINUE 03900020 + IVTNUM = 563 03910020 +C 03920020 +C **** TEST 563 **** 03930020 +C TEST 563 - SOLUTION OF A 3-4-5 RIGHT TRIANGLE LIKE TEST 562 03940020 +C EXCEPT THAT BOTH INTRINSIC AND PREVIOUSLY DEFINED STATEMENT 03950020 +C FUNCTIONS ARE USED. 03960020 +C 03970020 +C 03980020 + IF (ICZERO) 35630, 5630, 35630 03990020 + 5630 CONTINUE 04000020 + ICON09 = 3 04010020 + ICON10 = 4 04020020 + IVCOMP = IFON08(ICON09, ICON10) 04030020 + GO TO 45630 04040020 +35630 IVDELE = IVDELE + 1 04050020 + WRITE (I02,80003) IVTNUM 04060020 + IF (ICZERO) 45630, 5641, 45630 04070020 +45630 IF ( IVCOMP - 5 ) 5632, 15630, 5632 04080020 + 5632 IF ( IVCOMP - 4 ) 25630, 15630, 25630 04090020 +15630 IVPASS = IVPASS + 1 04100020 + WRITE (I02,80001) IVTNUM 04110020 + GO TO 5641 04120020 +25630 IVFAIL = IVFAIL + 1 04130020 + IVCORR = 5 04140020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04150020 + 5641 CONTINUE 04160020 + IVTNUM = 564 04170020 +C 04180020 +C **** TEST 564 **** 04190020 +C TEST 564 - USE OF ARRAY ELEMENTS IN AN INTEGER STATEMENT 04200020 +C FUNCTION WHICH USES THE OPERATIONS OF + - * / . 04210020 +C 04220020 +C 04230020 + IF (ICZERO) 35640, 5640, 35640 04240020 + 5640 CONTINUE 04250020 + IADN11(1) = 2 04260020 + IADN11(2) = 2 04270020 + IVCOMP = IFON09( IADN11(1), IADN11(2) ) 04280020 + GO TO 45640 04290020 +35640 IVDELE = IVDELE + 1 04300020 + WRITE (I02,80003) IVTNUM 04310020 + IF (ICZERO) 45640, 5651, 45640 04320020 +45640 IF ( IVCOMP - 1 ) 25640, 15640, 25640 04330020 +15640 IVPASS = IVPASS + 1 04340020 + WRITE (I02,80001) IVTNUM 04350020 + GO TO 5651 04360020 +25640 IVFAIL = IVFAIL + 1 04370020 + IVCORR = 1 04380020 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04390020 + 5651 CONTINUE 04400020 +C 04410020 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 04420020 +99999 CONTINUE 04430020 + WRITE (I02,90002) 04440020 + WRITE (I02,90006) 04450020 + WRITE (I02,90002) 04460020 + WRITE (I02,90002) 04470020 + WRITE (I02,90007) 04480020 + WRITE (I02,90002) 04490020 + WRITE (I02,90008) IVFAIL 04500020 + WRITE (I02,90009) IVPASS 04510020 + WRITE (I02,90010) IVDELE 04520020 +C 04530020 +C 04540020 +C TERMINATE ROUTINE EXECUTION 04550020 + STOP 04560020 +C 04570020 +C FORMAT STATEMENTS FOR PAGE HEADERS 04580020 +90000 FORMAT ("1") 04590020 +90002 FORMAT (" ") 04600020 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04610020 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 04620020 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 04630020 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 04640020 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 04650020 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 04660020 +C 04670020 +C FORMAT STATEMENTS FOR RUN SUMMARIES 04680020 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 04690020 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 04700020 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 04710020 +C 04720020 +C FORMAT STATEMENTS FOR TEST RESULTS 04730020 +80001 FORMAT (" ",4X,I5,7X,"PASS") 04740020 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 04750020 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 04760020 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 04770020 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 04780020 +C 04790020 +90007 FORMAT (" ",20X,"END OF PROGRAM FM020" ) 04800020 + END 04810020 diff --git a/Fortran/UnitTests/fcvs21_f95/FM020.reference_output b/Fortran/UnitTests/fcvs21_f95/FM020.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM020.reference_output @@ -0,0 +1,36 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 553 PASS + 554 PASS + 555 PASS + 556 PASS + 557 PASS + 558 PASS + 559 PASS + 560 PASS + 561 PASS + 562 PASS + 563 PASS + 564 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM020 + + 0 ERRORS ENCOUNTERED + 12 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM021.f b/Fortran/UnitTests/fcvs21_f95/FM021.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM021.f @@ -0,0 +1,1028 @@ + PROGRAM FM021 + +C 00010021 +C COMMENT SECTION. 00020021 +C 00030021 +C FM021 00040021 +C 00050021 +C THIS ROUTINE TESTS THE FORTRAN DATA INITIALIZATION 00060021 +C STATEMENT. INTEGER, REAL, AND LOGICAL DATA TYPES ARE TESTED 00070021 +C USING UNSIGNED CONSTANTS, SIGNED CONSTANTS, AND LOGICAL 00080021 +C CONSTANTS.. INTEGER, REAL, LOGICAL, AND MIXED TYPE ARRAYS 00090021 +C ARE ALSO TESTED. 00100021 +C 00110021 +C REFERENCES 00120021 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130021 +C X3.9-1978 00140021 +C 00150021 +C SECTION 4.1.3, DATA TYPE PREPARATION 00160021 +C SECTION 4.4.3, REAL CONSTANT 00170021 +C SECTION 9, DATA STATEMENT 00180021 +C 00190021 + INTEGER RATN11(3) 00200021 + LOGICAL LCTN01, LCTN02, LATN11(3), LADN11 00210021 + REAL IATN11(3) 00220021 + DIMENSION IADN11(3), RADN11(4), LADN11(6), RADN13(4), IADN12(4) 00230021 + DIMENSION IADN13(4) 00240021 +C 00250021 + DATA ICON01/0/ 00260021 + DATA ICON02/3/ 00270021 + DATA ICON03/76/ 00280021 + DATA ICON04/587/ 00290021 + DATA ICON05/9999/ 00300021 + DATA ICON06/32767/ 00310021 + DATA ICON07/-0/ 00320021 + DATA ICON08/-32766/ 00330021 + DATA ICON09/00003/ 00340021 + DATA ICON10/ 3 2 7 6 7 / 00350021 + DATA LCTN01/.TRUE./ 00360021 + DATA LCTN02/.FALSE./ 00370021 + DATA RCON01/0./ 00380021 + DATA RCON02 /.0/ 00390021 + DATA RCON03/0.0/ 00400021 + DATA RCON04/32767./ 00410021 + DATA RCON05/-32766./ 00420021 + DATA RCON06/-000587./ 00430021 + DATA RCON07/99.99/ 00440021 + DATA RCON08/ -03. 2 7 6 6/ 00450021 + DATA IADN11(1)/3/, IADN11(3)/-587/, IADN11(2)/32767/ 00460021 + DATA IADN12/4*9999/ 00470021 + DATA IADN13/0,2*-32766,-587/ 00480021 + DATA LADN11/.TRUE., .FALSE., 2*.TRUE., 2*.FALSE./ 00490021 + DATA RADN11/32767., -32.766, 2*587./ 00500021 + DATA LATN11/.TRUE., 2*.FALSE./, IATN11/2*32767., -32766./ 00510021 + DATA RATN11/3*-32766/ 00520021 + DATA RADN13/32.767E03, -3.2766E-01, .587E+03, 9E1/ 00530021 +C 00540021 +C 00550021 +C ********************************************************** 00560021 +C 00570021 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00580021 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00590021 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00600021 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00610021 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00620021 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00630021 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00640021 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00650021 +C OF EXECUTING THESE TESTS. 00660021 +C 00670021 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00680021 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00690021 +C 00700021 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00710021 +C 00720021 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00730021 +C SOFTWARE STANDARDS VALIDATION GROUP 00740021 +C BUILDING 225 RM A266 00750021 +C GAITHERSBURG, MD 20899 00760021 +C ********************************************************** 00770021 +C 00780021 +C 00790021 +C 00800021 +C INITIALIZATION SECTION 00810021 +C 00820021 +C INITIALIZE CONSTANTS 00830021 +C ************** 00840021 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00850021 + I01 = 5 00860021 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00870021 + I02 = 6 00880021 +C SYSTEM ENVIRONMENT SECTION 00890021 +C 00900021 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00910021 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00920021 +C (UNIT NUMBER FOR CARD READER). 00930021 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00940021 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00950021 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00960021 +C 00970021 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00980021 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00990021 +C (UNIT NUMBER FOR PRINTER). 01000021 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01010021 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01020021 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01030021 +C 01040021 + IVPASS=0 01050021 + IVFAIL=0 01060021 + IVDELE=0 01070021 + ICZERO=0 01080021 +C 01090021 +C WRITE PAGE HEADERS 01100021 + WRITE (I02,90000) 01110021 + WRITE (I02,90001) 01120021 + WRITE (I02,90002) 01130021 + WRITE (I02, 90002) 01140021 + WRITE (I02,90003) 01150021 + WRITE (I02,90002) 01160021 + WRITE (I02,90004) 01170021 + WRITE (I02,90002) 01180021 + WRITE (I02,90011) 01190021 + WRITE (I02,90002) 01200021 + WRITE (I02,90002) 01210021 + WRITE (I02,90005) 01220021 + WRITE (I02,90006) 01230021 + WRITE (I02,90002) 01240021 + IVTNUM = 565 01250021 +C 01260021 +C **** TEST 565 **** 01270021 +C TEST 565 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER 01280021 +C CONSTANT ZERO. 01290021 +C 01300021 +C 01310021 + IF (ICZERO) 35650, 5650, 35650 01320021 + 5650 CONTINUE 01330021 + GO TO 45650 01340021 +35650 IVDELE = IVDELE + 1 01350021 + WRITE (I02,80003) IVTNUM 01360021 + IF (ICZERO) 45650, 5661, 45650 01370021 +45650 IF ( ICON01 - 0 ) 25650, 15650, 25650 01380021 +15650 IVPASS = IVPASS + 1 01390021 + WRITE (I02,80001) IVTNUM 01400021 + GO TO 5661 01410021 +25650 IVFAIL = IVFAIL + 1 01420021 + IVCOMP = ICON01 01430021 + IVCORR = 0 01440021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01450021 + 5661 CONTINUE 01460021 + IVTNUM = 566 01470021 +C 01480021 +C **** TEST 566 **** 01490021 +C TEST 566 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER 01500021 +C CONSTANT 3. 01510021 +C 01520021 +C 01530021 + IF (ICZERO) 35660, 5660, 35660 01540021 + 5660 CONTINUE 01550021 + GO TO 45660 01560021 +35660 IVDELE = IVDELE + 1 01570021 + WRITE (I02,80003) IVTNUM 01580021 + IF (ICZERO) 45660, 5671, 45660 01590021 +45660 IF ( ICON02 - 3 ) 25660, 15660, 25660 01600021 +15660 IVPASS = IVPASS + 1 01610021 + WRITE (I02,80001) IVTNUM 01620021 + GO TO 5671 01630021 +25660 IVFAIL = IVFAIL + 1 01640021 + IVCOMP = ICON02 01650021 + IVCORR = 3 01660021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01670021 + 5671 CONTINUE 01680021 + IVTNUM = 567 01690021 +C 01700021 +C **** TEST 567 **** 01710021 +C TEST 567 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER 01720021 +C CONSTANT 76. 01730021 +C 01740021 +C 01750021 + IF (ICZERO) 35670, 5670, 35670 01760021 + 5670 CONTINUE 01770021 + GO TO 45670 01780021 +35670 IVDELE = IVDELE + 1 01790021 + WRITE (I02,80003) IVTNUM 01800021 + IF (ICZERO) 45670, 5681, 45670 01810021 +45670 IF ( ICON03 - 76 ) 25670, 15670, 25670 01820021 +15670 IVPASS = IVPASS + 1 01830021 + WRITE (I02,80001) IVTNUM 01840021 + GO TO 5681 01850021 +25670 IVFAIL = IVFAIL + 1 01860021 + IVCOMP = ICON03 01870021 + IVCORR = 76 01880021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01890021 + 5681 CONTINUE 01900021 + IVTNUM = 568 01910021 +C 01920021 +C **** TEST 568 **** 01930021 +C TEST 568 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER 01940021 +C CONSTANT 587. 01950021 +C 01960021 +C 01970021 + IF (ICZERO) 35680, 5680, 35680 01980021 + 5680 CONTINUE 01990021 + GO TO 45680 02000021 +35680 IVDELE = IVDELE + 1 02010021 + WRITE (I02,80003) IVTNUM 02020021 + IF (ICZERO) 45680, 5691, 45680 02030021 +45680 IF ( ICON04 - 587 ) 25680, 15680, 25680 02040021 +15680 IVPASS = IVPASS + 1 02050021 + WRITE (I02,80001) IVTNUM 02060021 + GO TO 5691 02070021 +25680 IVFAIL = IVFAIL + 1 02080021 + IVCOMP = ICON04 02090021 + IVCORR = 587 02100021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02110021 + 5691 CONTINUE 02120021 + IVTNUM = 569 02130021 +C 02140021 +C **** TEST 569 **** 02150021 +C TEST 569 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER 02160021 +C CONSTANT 9999. 02170021 +C 02180021 +C 02190021 + IF (ICZERO) 35690, 5690, 35690 02200021 + 5690 CONTINUE 02210021 + GO TO 45690 02220021 +35690 IVDELE = IVDELE + 1 02230021 + WRITE (I02,80003) IVTNUM 02240021 + IF (ICZERO) 45690, 5701, 45690 02250021 +45690 IF ( ICON05 - 9999 ) 25690, 15690, 25690 02260021 +15690 IVPASS = IVPASS + 1 02270021 + WRITE (I02,80001) IVTNUM 02280021 + GO TO 5701 02290021 +25690 IVFAIL = IVFAIL + 1 02300021 + IVCOMP = ICON05 02310021 + IVCORR = 9999 02320021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02330021 + 5701 CONTINUE 02340021 + IVTNUM = 570 02350021 +C 02360021 +C **** TEST 570 **** 02370021 +C TEST 570 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER 02380021 +C CONSTANT 32767. 02390021 +C 02400021 +C 02410021 + IF (ICZERO) 35700, 5700, 35700 02420021 + 5700 CONTINUE 02430021 + GO TO 45700 02440021 +35700 IVDELE = IVDELE + 1 02450021 + WRITE (I02,80003) IVTNUM 02460021 + IF (ICZERO) 45700, 5711, 45700 02470021 +45700 IF ( ICON06 - 32767 ) 25700, 15700, 25700 02480021 +15700 IVPASS = IVPASS + 1 02490021 + WRITE (I02,80001) IVTNUM 02500021 + GO TO 5711 02510021 +25700 IVFAIL = IVFAIL + 1 02520021 + IVCOMP = ICON06 02530021 + IVCORR = 32767 02540021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02550021 + 5711 CONTINUE 02560021 + IVTNUM = 571 02570021 +C 02580021 +C **** TEST 571 **** 02590021 +C TEST 571 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER 02600021 +C CONSTANT -0. NOTE THAT SIGNED ZERO AND UNSIGNED ZERO 02610021 +C SHOULD BE EQUAL FOR ANY INTEGER OPERATION. 02620021 +C 02630021 +C 02640021 + IF (ICZERO) 35710, 5710, 35710 02650021 + 5710 CONTINUE 02660021 + GO TO 45710 02670021 +35710 IVDELE = IVDELE + 1 02680021 + WRITE (I02,80003) IVTNUM 02690021 + IF (ICZERO) 45710, 5721, 45710 02700021 +45710 IF ( ICON07 - 0 ) 25710, 15710, 25710 02710021 +15710 IVPASS = IVPASS + 1 02720021 + WRITE (I02,80001) IVTNUM 02730021 + GO TO 5721 02740021 +25710 IVFAIL = IVFAIL + 1 02750021 + IVCOMP = ICON07 02760021 + IVCORR = -0 02770021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02780021 + 5721 CONTINUE 02790021 + IVTNUM = 572 02800021 +C 02810021 +C **** TEST 572 **** 02820021 +C TEST 572 - TEST OF AN INTEGER VARIABLE SET TO THE INTEGER 02830021 +C CONSTANT (SIGNED) -32766. 02840021 +C 02850021 +C 02860021 + IF (ICZERO) 35720, 5720, 35720 02870021 + 5720 CONTINUE 02880021 + GO TO 45720 02890021 +35720 IVDELE = IVDELE + 1 02900021 + WRITE (I02,80003) IVTNUM 02910021 + IF (ICZERO) 45720, 5731, 45720 02920021 +45720 IF ( ICON08 + 32766 ) 25720, 15720, 25720 02930021 +15720 IVPASS = IVPASS + 1 02940021 + WRITE (I02,80001) IVTNUM 02950021 + GO TO 5731 02960021 +25720 IVFAIL = IVFAIL + 1 02970021 + IVCOMP = ICON08 02980021 + IVCORR = -32766 02990021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03000021 + 5731 CONTINUE 03010021 + IVTNUM = 573 03020021 +C 03030021 +C **** TEST 573 **** 03040021 +C TEST 573 - TEST THE EFFECT OF LEADING ZERO ON AN INTEGER 03050021 +C CONSTANT 00003. 03060021 +C 03070021 +C 03080021 + IF (ICZERO) 35730, 5730, 35730 03090021 + 5730 CONTINUE 03100021 + GO TO 45730 03110021 +35730 IVDELE = IVDELE + 1 03120021 + WRITE (I02,80003) IVTNUM 03130021 + IF (ICZERO) 45730, 5741, 45730 03140021 +45730 IF ( ICON09 - 3 ) 25730, 15730, 25730 03150021 +15730 IVPASS = IVPASS + 1 03160021 + WRITE (I02,80001) IVTNUM 03170021 + GO TO 5741 03180021 +25730 IVFAIL = IVFAIL + 1 03190021 + IVCOMP = ICON09 03200021 + IVCORR = 3 03210021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03220021 + 5741 CONTINUE 03230021 + IVTNUM = 574 03240021 +C 03250021 +C **** TEST 574 **** 03260021 +C TEST 574 - TEST OF BLANKS IMBEDDED IN AN INTEGER CONSTANT 03270021 +C WHICH WAS / 3 2 7 6 7/ IN THE DATA INITIALIZATION STATEMENT. 03280021 +C 03290021 +C 03300021 + IF (ICZERO) 35740, 5740, 35740 03310021 + 5740 CONTINUE 03320021 + GO TO 45740 03330021 +35740 IVDELE = IVDELE + 1 03340021 + WRITE (I02,80003) IVTNUM 03350021 + IF (ICZERO) 45740, 5751, 45740 03360021 +45740 IF ( ICON10 - 32767 ) 25740, 15740, 25740 03370021 +15740 IVPASS = IVPASS + 1 03380021 + WRITE (I02,80001) IVTNUM 03390021 + GO TO 5751 03400021 +25740 IVFAIL = IVFAIL + 1 03410021 + IVCOMP = ICON10 03420021 + IVCORR = 32767 03430021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03440021 + 5751 CONTINUE 03450021 + IVTNUM = 575 03460021 +C 03470021 +C **** TEST 575 **** 03480021 +C TEST 575 - TEST OF A LOGICAL VARIABLE SET TO THE LOGICAL 03490021 +C CONSTANT .TRUE. 03500021 +C TRUE PATH OF A LOGICAL IF STATEMENT IS USED IN THE TEST. 03510021 +C 03520021 +C 03530021 + IF (ICZERO) 35750, 5750, 35750 03540021 + 5750 CONTINUE 03550021 + IVON01 = 0 03560021 + IF ( LCTN01 ) IVON01 = 1 03570021 + GO TO 45750 03580021 +35750 IVDELE = IVDELE + 1 03590021 + WRITE (I02,80003) IVTNUM 03600021 + IF (ICZERO) 45750, 5761, 45750 03610021 +45750 IF ( IVON01 - 1 ) 25750, 15750, 25750 03620021 +15750 IVPASS = IVPASS + 1 03630021 + WRITE (I02,80001) IVTNUM 03640021 + GO TO 5761 03650021 +25750 IVFAIL = IVFAIL + 1 03660021 + IVCOMP = IVON01 03670021 + IVCORR = 1 03680021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03690021 + 5761 CONTINUE 03700021 + IVTNUM = 576 03710021 +C 03720021 +C **** TEST 576 **** 03730021 +C TEST 576 - TEST OF A LOGICAL VARIABLE SET TO THE LOGICAL 03740021 +C CONSTANT .FALSE. THE FALSE PATH OF A LOGICAL IF STATEMENT 03750021 +C IS ALSO USED IN THE TEST. 03760021 +C 03770021 +C 03780021 + IF (ICZERO) 35760, 5760, 35760 03790021 + 5760 CONTINUE 03800021 + IVON01 = 1 03810021 + IF ( LCTN02 ) IVON01 = 0 03820021 + GO TO 45760 03830021 +35760 IVDELE = IVDELE + 1 03840021 + WRITE (I02,80003) IVTNUM 03850021 + IF (ICZERO) 45760, 5771, 45760 03860021 +45760 IF ( IVON01 - 1 ) 25760, 15760, 25760 03870021 +15760 IVPASS = IVPASS + 1 03880021 + WRITE (I02,80001) IVTNUM 03890021 + GO TO 5771 03900021 +25760 IVFAIL = IVFAIL + 1 03910021 + IVCOMP = IVON01 03920021 + IVCORR = 1 03930021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03940021 + 5771 CONTINUE 03950021 + IVTNUM = 577 03960021 +C 03970021 +C **** TEST 577 **** 03980021 +C TEST 577 - REAL VARIABLE SET TO 0. 03990021 +C 04000021 +C 04010021 + IF (ICZERO) 35770, 5770, 35770 04020021 + 5770 CONTINUE 04030021 + GO TO 45770 04040021 +35770 IVDELE = IVDELE + 1 04050021 + WRITE (I02,80003) IVTNUM 04060021 + IF (ICZERO) 45770, 5781, 45770 04070021 +45770 IF ( RCON01 - 0. ) 25770, 15770, 25770 04080021 +15770 IVPASS = IVPASS + 1 04090021 + WRITE (I02,80001) IVTNUM 04100021 + GO TO 5781 04110021 +25770 IVFAIL = IVFAIL + 1 04120021 + IVCOMP = RCON01 04130021 + IVCORR = 0 04140021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04150021 + 5781 CONTINUE 04160021 + IVTNUM = 578 04170021 +C 04180021 +C **** TEST 578 **** 04190021 +C TEST 578 - REAL VARIABLE SET TO .0 04200021 +C 04210021 +C 04220021 + IF (ICZERO) 35780, 5780, 35780 04230021 + 5780 CONTINUE 04240021 + GO TO 45780 04250021 +35780 IVDELE = IVDELE + 1 04260021 + WRITE (I02,80003) IVTNUM 04270021 + IF (ICZERO) 45780, 5791, 45780 04280021 +45780 IF ( RCON02 - .0 ) 25780, 15780, 25780 04290021 +15780 IVPASS = IVPASS + 1 04300021 + WRITE (I02,80001) IVTNUM 04310021 + GO TO 5791 04320021 +25780 IVFAIL = IVFAIL + 1 04330021 + IVCOMP = RCON02 04340021 + IVCORR = 0 04350021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04360021 + 5791 CONTINUE 04370021 + IVTNUM = 579 04380021 +C 04390021 +C **** TEST 579 **** 04400021 +C TEST 579 - REAL VARIABLE SET TO 0.0 04410021 +C 04420021 +C 04430021 + IF (ICZERO) 35790, 5790, 35790 04440021 + 5790 CONTINUE 04450021 + GO TO 45790 04460021 +35790 IVDELE = IVDELE + 1 04470021 + WRITE (I02,80003) IVTNUM 04480021 + IF (ICZERO) 45790, 5801, 45790 04490021 +45790 IF ( RCON03 - 0.0 ) 25790, 15790, 25790 04500021 +15790 IVPASS = IVPASS + 1 04510021 + WRITE (I02,80001) IVTNUM 04520021 + GO TO 5801 04530021 +25790 IVFAIL = IVFAIL + 1 04540021 + IVCOMP = RCON03 04550021 + IVCORR = 0 04560021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04570021 + 5801 CONTINUE 04580021 + IVTNUM = 580 04590021 +C 04600021 +C **** TEST 580 **** 04610021 +C TEST 580 - REAL VARIABLE SET TO 32767. 04620021 +C 04630021 +C 04640021 + IF (ICZERO) 35800, 5800, 35800 04650021 + 5800 CONTINUE 04660021 + GO TO 45800 04670021 +35800 IVDELE = IVDELE + 1 04680021 + WRITE (I02,80003) IVTNUM 04690021 + IF (ICZERO) 45800, 5811, 45800 04700021 +45800 IF ( RCON04 - 32767. ) 25800, 15800, 25800 04710021 +15800 IVPASS = IVPASS + 1 04720021 + WRITE (I02,80001) IVTNUM 04730021 + GO TO 5811 04740021 +25800 IVFAIL = IVFAIL + 1 04750021 + IVCOMP = RCON04 04760021 + IVCORR = 32767 04770021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04780021 + 5811 CONTINUE 04790021 + IVTNUM = 581 04800021 +C 04810021 +C **** TEST 581 **** 04820021 +C TEST 581 - REAL VARIABLE SET TO -32766. 04830021 +C 04840021 +C 04850021 + IF (ICZERO) 35810, 5810, 35810 04860021 + 5810 CONTINUE 04870021 + GO TO 45810 04880021 +35810 IVDELE = IVDELE + 1 04890021 + WRITE (I02,80003) IVTNUM 04900021 + IF (ICZERO) 45810, 5821, 45810 04910021 +45810 IF ( RCON05 + 32766 ) 25810, 15810, 25810 04920021 +15810 IVPASS = IVPASS + 1 04930021 + WRITE (I02,80001) IVTNUM 04940021 + GO TO 5821 04950021 +25810 IVFAIL = IVFAIL + 1 04960021 + IVCOMP = RCON05 04970021 + IVCORR = -32766 04980021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04990021 + 5821 CONTINUE 05000021 + IVTNUM = 582 05010021 +C 05020021 +C **** TEST 582 **** 05030021 +C TEST 582 - REAL VARIABLE SET TO -000587. TEST OF LEADING SIGN 05040021 +C AND LEADING ZEROS ON A REAL CONSTANT. 05050021 +C 05060021 +C 05070021 + IF (ICZERO) 35820, 5820, 35820 05080021 + 5820 CONTINUE 05090021 + GO TO 45820 05100021 +35820 IVDELE = IVDELE + 1 05110021 + WRITE (I02,80003) IVTNUM 05120021 + IF (ICZERO) 45820, 5831, 45820 05130021 +45820 IF ( RCON06 + 587. ) 25820, 15820, 25820 05140021 +15820 IVPASS = IVPASS + 1 05150021 + WRITE (I02,80001) IVTNUM 05160021 + GO TO 5831 05170021 +25820 IVFAIL = IVFAIL + 1 05180021 + IVCOMP = RCON06 05190021 + IVCORR = -587 05200021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05210021 + 5831 CONTINUE 05220021 + IVTNUM = 583 05230021 +C 05240021 +C **** TEST 583 **** 05250021 +C TEST 583 - REAL VARIABLE SET TO 99.99 05260021 +C 05270021 +C 05280021 + IF (ICZERO) 35830, 5830, 35830 05290021 + 5830 CONTINUE 05300021 + GO TO 45830 05310021 +35830 IVDELE = IVDELE + 1 05320021 + WRITE (I02,80003) IVTNUM 05330021 + IF (ICZERO) 45830, 5841, 45830 05340021 +45830 IF ( RCON07 - 99.99 ) 25830, 15830, 25830 05350021 +15830 IVPASS = IVPASS + 1 05360021 + WRITE (I02,80001) IVTNUM 05370021 + GO TO 5841 05380021 +25830 IVFAIL = IVFAIL + 1 05390021 + IVCOMP = RCON07 05400021 + IVCORR = 99 05410021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05420021 + 5841 CONTINUE 05430021 + IVTNUM = 584 05440021 +C 05450021 +C **** TEST 584 **** 05460021 +C TEST 584 - REAL VARIABLE SET TO /-03. 2 7 6 6/ TO TEST 05470021 +C THE EFFECT OF BLANKS IMBEDDED IN A REAL CONSTANT. 05480021 +C 05490021 +C 05500021 + IF (ICZERO) 35840, 5840, 35840 05510021 + 5840 CONTINUE 05520021 + GO TO 45840 05530021 +35840 IVDELE = IVDELE + 1 05540021 + WRITE (I02,80003) IVTNUM 05550021 + IF (ICZERO) 45840, 5851, 45840 05560021 +45840 IF ( RCON08 + 3.2766 ) 25840, 15840, 25840 05570021 +15840 IVPASS = IVPASS + 1 05580021 + WRITE (I02,80001) IVTNUM 05590021 + GO TO 5851 05600021 +25840 IVFAIL = IVFAIL + 1 05610021 + IVCOMP = RCON08 05620021 + IVCORR = -3 05630021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05640021 + 5851 CONTINUE 05650021 + IVTNUM = 585 05660021 +C 05670021 +C **** TEST 585 **** 05680021 +C TEST 585 - INTEGER ARRAY ELEMENT SET TO 3 05690021 +C 05700021 +C 05710021 + IF (ICZERO) 35850, 5850, 35850 05720021 + 5850 CONTINUE 05730021 + GO TO 45850 05740021 +35850 IVDELE = IVDELE + 1 05750021 + WRITE (I02,80003) IVTNUM 05760021 + IF (ICZERO) 45850, 5861, 45850 05770021 +45850 IF ( IADN11(1) - 3 ) 25850, 15850, 25850 05780021 +15850 IVPASS = IVPASS + 1 05790021 + WRITE (I02,80001) IVTNUM 05800021 + GO TO 5861 05810021 +25850 IVFAIL = IVFAIL + 1 05820021 + IVCOMP = IADN11(1) 05830021 + IVCORR = 3 05840021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05850021 + 5861 CONTINUE 05860021 + IVTNUM = 586 05870021 +C 05880021 +C **** TEST 586 **** 05890021 +C TEST 586 - INTEGER ARRAY ELEMENT SET TO 32767 05900021 +C 05910021 +C 05920021 + IF (ICZERO) 35860, 5860, 35860 05930021 + 5860 CONTINUE 05940021 + GO TO 45860 05950021 +35860 IVDELE = IVDELE + 1 05960021 + WRITE (I02,80003) IVTNUM 05970021 + IF (ICZERO) 45860, 5871, 45860 05980021 +45860 IF ( IADN11(2) - 32767 ) 25860, 15860, 25860 05990021 +15860 IVPASS = IVPASS + 1 06000021 + WRITE (I02,80001) IVTNUM 06010021 + GO TO 5871 06020021 +25860 IVFAIL = IVFAIL + 1 06030021 + IVCOMP = IADN11(2) 06040021 + IVCORR = 32767 06050021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06060021 + 5871 CONTINUE 06070021 + IVTNUM = 587 06080021 +C 06090021 +C **** TEST 587 **** 06100021 +C TEST 587 - INTEGER ARRAY ELEMENT SET TO -587 06110021 +C 06120021 +C 06130021 + IF (ICZERO) 35870, 5870, 35870 06140021 + 5870 CONTINUE 06150021 + GO TO 45870 06160021 +35870 IVDELE = IVDELE + 1 06170021 + WRITE (I02,80003) IVTNUM 06180021 + IF (ICZERO) 45870, 5881, 45870 06190021 +45870 IF ( IADN11(3) + 587 ) 25870, 15870, 25870 06200021 +15870 IVPASS = IVPASS + 1 06210021 + WRITE (I02,80001) IVTNUM 06220021 + GO TO 5881 06230021 +25870 IVFAIL = IVFAIL + 1 06240021 + IVCOMP = IADN11(3) 06250021 + IVCORR = -587 06260021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06270021 + 5881 CONTINUE 06280021 + IVTNUM = 588 06290021 +C 06300021 +C **** TEST 588 **** 06310021 +C TEST 588 - TEST OF THE REPEAT FIELD /4*999/ IN A DATA STATE. 06320021 +C 06330021 +C 06340021 + IF (ICZERO) 35880, 5880, 35880 06350021 + 5880 CONTINUE 06360021 + GO TO 45880 06370021 +35880 IVDELE = IVDELE + 1 06380021 + WRITE (I02,80003) IVTNUM 06390021 + IF (ICZERO) 45880, 5891, 45880 06400021 +45880 IF ( IADN12(3) - 9999 ) 25880, 15880, 25880 06410021 +15880 IVPASS = IVPASS + 1 06420021 + WRITE (I02,80001) IVTNUM 06430021 + GO TO 5891 06440021 +25880 IVFAIL = IVFAIL + 1 06450021 + IVCOMP = IADN12(3) 06460021 + IVCORR = 9999 06470021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06480021 + 5891 CONTINUE 06490021 + IVTNUM = 589 06500021 +C 06510021 +C **** TEST 589 **** 06520021 +C TEST 589 - TEST OF SETTING THE WHOLE INTEGER ARRAY ELEMENTS 06530021 +C IN ONE DATA INITIALIZATION STATEMENT. THE FIRST ELEMENT 06540021 +C IS SET TO 0 06550021 +C 06560021 +C 06570021 + IF (ICZERO) 35890, 5890, 35890 06580021 + 5890 CONTINUE 06590021 + GO TO 45890 06600021 +35890 IVDELE = IVDELE + 1 06610021 + WRITE (I02,80003) IVTNUM 06620021 + IF (ICZERO) 45890, 5901, 45890 06630021 +45890 IF ( IADN13(1) - 0 ) 25890, 15890, 25890 06640021 +15890 IVPASS = IVPASS + 1 06650021 + WRITE (I02,80001) IVTNUM 06660021 + GO TO 5901 06670021 +25890 IVFAIL = IVFAIL + 1 06680021 + IVCOMP = IADN13(1) 06690021 + IVCORR = 0 06700021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06710021 + 5901 CONTINUE 06720021 + IVTNUM = 590 06730021 +C 06740021 +C **** TEST 590 **** 06750021 +C TEST 590 - SEE TEST 589. THE SECOND ELEMENT WAS SET TO -32766 06760021 +C 06770021 +C 06780021 + IF (ICZERO) 35900, 5900, 35900 06790021 + 5900 CONTINUE 06800021 + GO TO 45900 06810021 +35900 IVDELE = IVDELE + 1 06820021 + WRITE (I02,80003) IVTNUM 06830021 + IF (ICZERO) 45900, 5911, 45900 06840021 +45900 IF ( IADN13(2) + 32766 ) 25900, 15900, 25900 06850021 +15900 IVPASS = IVPASS + 1 06860021 + WRITE (I02,80001) IVTNUM 06870021 + GO TO 5911 06880021 +25900 IVFAIL = IVFAIL + 1 06890021 + IVCOMP = IADN13(2) 06900021 + IVCORR = -32766 06910021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06920021 + 5911 CONTINUE 06930021 + IVTNUM = 591 06940021 +C 06950021 +C **** TEST 591 **** 06960021 +C TEST 591 - SEE TEST 589. THE THIRD ELEMENT WAS SET TO -32766 06970021 +C 06980021 +C 06990021 + IF (ICZERO) 35910, 5910, 35910 07000021 + 5910 CONTINUE 07010021 + GO TO 45910 07020021 +35910 IVDELE = IVDELE + 1 07030021 + WRITE (I02,80003) IVTNUM 07040021 + IF (ICZERO) 45910, 5921, 45910 07050021 +45910 IF ( IADN13(3) + 32766 ) 25910, 15910, 25910 07060021 +15910 IVPASS = IVPASS + 1 07070021 + WRITE (I02,80001) IVTNUM 07080021 + GO TO 5921 07090021 +25910 IVFAIL = IVFAIL + 1 07100021 + IVCOMP = IADN13(3) 07110021 + IVCORR = -32766 07120021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07130021 + 5921 CONTINUE 07140021 + IVTNUM = 592 07150021 +C 07160021 +C **** TEST 592 **** 07170021 +C TEST 592 - SEE TEST 589. THE FOURTH ELEMENT WAS SET TO -587 07180021 +C 07190021 +C 07200021 + IF (ICZERO) 35920, 5920, 35920 07210021 + 5920 CONTINUE 07220021 + GO TO 45920 07230021 +35920 IVDELE = IVDELE + 1 07240021 + WRITE (I02,80003) IVTNUM 07250021 + IF (ICZERO) 45920, 5931, 45920 07260021 +45920 IF ( IADN13(4) + 587 ) 25920, 15920, 25920 07270021 +15920 IVPASS = IVPASS + 1 07280021 + WRITE (I02,80001) IVTNUM 07290021 + GO TO 5931 07300021 +25920 IVFAIL = IVFAIL + 1 07310021 + IVCOMP = IADN13(4) 07320021 + IVCORR = -587 07330021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07340021 + 5931 CONTINUE 07350021 + IVTNUM = 593 07360021 +C 07370021 +C **** TEST 593 **** 07380021 +C TEST 593 - TEST OF SETTING THE WHOLE LOGICAL ARRAY IN ONE 07390021 +C DATA INITIALIZATION STATEMENT. THE FIRST ELEMENT IS .TRUE. 07400021 +C THE SECOND AND THIRD ELEMENTS ARE .FALSE. 07410021 +C THE FALSE PATH OF A LOGICAL IF STATEMENT IS USED TESTING 2. 07420021 +C 07430021 +C 07440021 + IF (ICZERO) 35930, 5930, 35930 07450021 + 5930 CONTINUE 07460021 + IVON01 = 1 07470021 + IF ( LADN11(2) ) IVON01 = 0 07480021 + GO TO 45930 07490021 +35930 IVDELE = IVDELE + 1 07500021 + WRITE (I02,80003) IVTNUM 07510021 + IF (ICZERO) 45930, 5941, 45930 07520021 +45930 IF ( IVON01 - 1 ) 25930, 15930, 25930 07530021 +15930 IVPASS = IVPASS + 1 07540021 + WRITE (I02,80001) IVTNUM 07550021 + GO TO 5941 07560021 +25930 IVFAIL = IVFAIL + 1 07570021 + IVCOMP = IVON01 07580021 + IVCORR = 1 07590021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07600021 + 5941 CONTINUE 07610021 + IVTNUM = 594 07620021 +C 07630021 +C **** TEST 594 **** 07640021 +C TEST 594 - SEE TEST 593. THE FOURTH ELEMENT IS TESTED 07650021 +C WITH THE TRUE PATH OF THE LOGICAL IF STATEMENT. 07660021 +C 07670021 +C 07680021 + IF (ICZERO) 35940, 5940, 35940 07690021 + 5940 CONTINUE 07700021 + IVON01 = 0 07710021 + IF ( LADN11(4) ) IVON01 = 1 07720021 + GO TO 45940 07730021 +35940 IVDELE = IVDELE + 1 07740021 + WRITE (I02,80003) IVTNUM 07750021 + IF (ICZERO) 45940, 5951, 45940 07760021 +45940 IF ( IVON01 - 1 ) 25940, 15940, 25940 07770021 +15940 IVPASS = IVPASS + 1 07780021 + WRITE (I02,80001) IVTNUM 07790021 + GO TO 5951 07800021 +25940 IVFAIL = IVFAIL + 1 07810021 + IVCOMP = IVON01 07820021 + IVCORR = 1 07830021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07840021 + 5951 CONTINUE 07850021 + IVTNUM = 595 07860021 +C 07870021 +C **** TEST 595 **** 07880021 +C TEST 595 - A WHOLE REAL ARRAY IS SET IN ONE DATA INITIALIZATION 07890021 +C STATEMENT. THE SECOND ELEMENT IS -32.766 07900021 +C 07910021 +C 07920021 + IF (ICZERO) 35950, 5950, 35950 07930021 + 5950 CONTINUE 07940021 + GO TO 45950 07950021 +35950 IVDELE = IVDELE + 1 07960021 + WRITE (I02,80003) IVTNUM 07970021 + IF (ICZERO) 45950, 5961, 45950 07980021 +45950 IF ( RADN11(2) + 32.766 ) 25950, 15950, 25950 07990021 +15950 IVPASS = IVPASS + 1 08000021 + WRITE (I02,80001) IVTNUM 08010021 + GO TO 5961 08020021 +25950 IVFAIL = IVFAIL + 1 08030021 + IVCOMP = RADN11(2) 08040021 + IVCORR = -32 08050021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08060021 + 5961 CONTINUE 08070021 + IVTNUM = 596 08080021 +C 08090021 +C **** TEST 596 **** 08100021 +C TEST 596 - SEE TEST 595. THE FOURTH ELEMENT IS SET TO 587 08110021 +C BY A REPEAT FIELD. 08120021 +C 08130021 +C 08140021 + IF (ICZERO) 35960, 5960, 35960 08150021 + 5960 CONTINUE 08160021 + GO TO 45960 08170021 +35960 IVDELE = IVDELE + 1 08180021 + WRITE (I02,80003) IVTNUM 08190021 + IF (ICZERO) 45960, 5971, 45960 08200021 +45960 IF ( RADN11(4) - 587 ) 25960, 15960, 25960 08210021 +15960 IVPASS = IVPASS + 1 08220021 + WRITE (I02,80001) IVTNUM 08230021 + GO TO 5971 08240021 +25960 IVFAIL = IVFAIL + 1 08250021 + IVCOMP = RADN11(4) 08260021 + IVCORR = 587 08270021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08280021 + 5971 CONTINUE 08290021 + IVTNUM = 597 08300021 +C 08310021 +C **** TEST 597 **** 08320021 +C TEST 597 - TEST OF MIXED ARRAY ELEMENT TYPES IN A SINGLE DATA 08330021 +C INITIALIZATION STATEMENT. THE TYPE LOGICAL STATEMENT CONTAINS08340021 +C THE ARRAY DECLARATIONS. THE FALSE PATH OF A LOGICAL 08350021 +C IF STATEMENT TESTS THE LOGICAL RESULTS. 08360021 +C 08370021 +C 08380021 + IF (ICZERO) 35970, 5970, 35970 08390021 + 5970 CONTINUE 08400021 + IVON01 = 1 08410021 + IF ( LATN11(2) ) IVON01 = 0 08420021 + GO TO 45970 08430021 +35970 IVDELE = IVDELE + 1 08440021 + WRITE (I02,80003) IVTNUM 08450021 + IF (ICZERO) 45970, 5981, 45970 08460021 +45970 IF ( IVON01 - 1 ) 25970, 15970, 25970 08470021 +15970 IVPASS = IVPASS + 1 08480021 + WRITE (I02,80001) IVTNUM 08490021 + GO TO 5981 08500021 +25970 IVFAIL = IVFAIL + 1 08510021 + IVCOMP = IVON01 08520021 + IVCORR = 1 08530021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08540021 + 5981 CONTINUE 08550021 + IVTNUM = 598 08560021 +C 08570021 +C **** TEST 598 **** 08580021 +C TEST 598 - TYPE OF THE DATA WAS SET EXPLICITLY REAL IN THE 08590021 +C DECLARATIVE FOR THE ARRAY. DATA SHOULD BE SET TO 32767. 08600021 +C 08610021 +C 08620021 + IF (ICZERO) 35980, 5980, 35980 08630021 + 5980 CONTINUE 08640021 + GO TO 45980 08650021 +35980 IVDELE = IVDELE + 1 08660021 + WRITE (I02,80003) IVTNUM 08670021 + IF (ICZERO) 45980, 5991, 45980 08680021 +45980 IF ( IATN11(2) - 32767. ) 25980, 15980, 25980 08690021 +15980 IVPASS = IVPASS + 1 08700021 + WRITE (I02,80001) IVTNUM 08710021 + GO TO 5991 08720021 +25980 IVFAIL = IVFAIL + 1 08730021 + IVCOMP = IATN11(2) 08740021 + IVCORR = 32767 08750021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08760021 + 5991 CONTINUE 08770021 + IVTNUM = 599 08780021 +C 08790021 +C **** TEST 599 **** 08800021 +C TEST 599 - TYPE OF THE DATA WAS SET EXPLICITLY INTEGER IN THE 08810021 +C DECLARATIVE FOR THE ARRAY. DATA SHOULD BE SET TO -32766 08820021 +C 08830021 +C 08840021 + IF (ICZERO) 35990, 5990, 35990 08850021 + 5990 CONTINUE 08860021 + GO TO 45990 08870021 +35990 IVDELE = IVDELE + 1 08880021 + WRITE (I02,80003) IVTNUM 08890021 + IF (ICZERO) 45990, 6001, 45990 08900021 +45990 IF ( RATN11(2) + 32766 ) 25990, 15990, 25990 08910021 +15990 IVPASS = IVPASS + 1 08920021 + WRITE (I02,80001) IVTNUM 08930021 + GO TO 6001 08940021 +25990 IVFAIL = IVFAIL + 1 08950021 + IVCOMP = RATN11(2) 08960021 + IVCORR = -32766 08970021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08980021 + 6001 CONTINUE 08990021 + IVTNUM = 600 09000021 +C 09010021 +C **** TEST 600 **** 09020021 +C TEST 600 - TEST OF REAL DECIMAL CONSTANTS USING E-NOTATION. 09030021 +C SEE SECTION 4.4.2. THE VALUE OF THE ELEMENT SHOULD 09040021 +C BE SET TO 32767. 09050021 +C 09060021 +C 09070021 + IF (ICZERO) 36000, 6000, 36000 09080021 + 6000 CONTINUE 09090021 + GO TO 46000 09100021 +36000 IVDELE = IVDELE + 1 09110021 + WRITE (I02,80003) IVTNUM 09120021 + IF (ICZERO) 46000, 6011, 46000 09130021 +46000 IF ( RADN13(1) - 32767. ) 26000, 16000, 26000 09140021 +16000 IVPASS = IVPASS + 1 09150021 + WRITE (I02,80001) IVTNUM 09160021 + GO TO 6011 09170021 +26000 IVFAIL = IVFAIL + 1 09180021 + IVCOMP = RADN13(1) 09190021 + IVCORR = 32767 09200021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 09210021 + 6011 CONTINUE 09220021 + IVTNUM = 601 09230021 +C 09240021 +C **** TEST 601 **** 09250021 +C TEST 601 - LIKE TEST 600. REAL DECIMAL CONSTANT VALUE -.32766 09260021 +C 09270021 +C 09280021 + IF (ICZERO) 36010, 6010, 36010 09290021 + 6010 CONTINUE 09300021 + GO TO 46010 09310021 +36010 IVDELE = IVDELE + 1 09320021 + WRITE (I02,80003) IVTNUM 09330021 + IF (ICZERO) 46010, 6021, 46010 09340021 +46010 IF ( RADN13(2) + .32766 ) 26010, 16010, 26010 09350021 +16010 IVPASS = IVPASS + 1 09360021 + WRITE (I02,80001) IVTNUM 09370021 + GO TO 6021 09380021 +26010 IVFAIL = IVFAIL + 1 09390021 + IVCOMP = RADN13(2) 09400021 + IVCORR = 0 09410021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 09420021 + 6021 CONTINUE 09430021 + IVTNUM = 602 09440021 +C 09450021 +C **** TEST 602 **** 09460021 +C TEST 602 - LIKE TEST 600. REAL DECIMAL CONSTANT VALUE 587. 09470021 +C 09480021 +C 09490021 + IF (ICZERO) 36020, 6020, 36020 09500021 + 6020 CONTINUE 09510021 + GO TO 46020 09520021 +36020 IVDELE = IVDELE + 1 09530021 + WRITE (I02,80003) IVTNUM 09540021 + IF (ICZERO) 46020, 6031, 46020 09550021 +46020 IF ( RADN13(3) - 587 ) 26020, 16020, 26020 09560021 +16020 IVPASS = IVPASS + 1 09570021 + WRITE (I02,80001) IVTNUM 09580021 + GO TO 6031 09590021 +26020 IVFAIL = IVFAIL + 1 09600021 + IVCOMP = RADN13(3) 09610021 + IVCORR = 587 09620021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 09630021 + 6031 CONTINUE 09640021 + IVTNUM = 603 09650021 +C 09660021 +C **** TEST 603 **** 09670021 +C TEST 603 - LIKE TEST 600. REAL DECIMAL CONSTANT VALUE 90. 09680021 +C 09690021 +C 09700021 + IF (ICZERO) 36030, 6030, 36030 09710021 + 6030 CONTINUE 09720021 + GO TO 46030 09730021 +36030 IVDELE = IVDELE + 1 09740021 + WRITE (I02,80003) IVTNUM 09750021 + IF (ICZERO) 46030, 6041, 46030 09760021 +46030 IF ( RADN13(4) - 90. ) 26030, 16030, 26030 09770021 +16030 IVPASS = IVPASS + 1 09780021 + WRITE (I02,80001) IVTNUM 09790021 + GO TO 6041 09800021 +26030 IVFAIL = IVFAIL + 1 09810021 + IVCOMP = RADN13(4) 09820021 + IVCORR = 90 09830021 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 09840021 + 6041 CONTINUE 09850021 +C 09860021 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 09870021 +99999 CONTINUE 09880021 + WRITE (I02,90002) 09890021 + WRITE (I02,90006) 09900021 + WRITE (I02,90002) 09910021 + WRITE (I02,90002) 09920021 + WRITE (I02,90007) 09930021 + WRITE (I02,90002) 09940021 + WRITE (I02,90008) IVFAIL 09950021 + WRITE (I02,90009) IVPASS 09960021 + WRITE (I02,90010) IVDELE 09970021 +C 09980021 +C 09990021 +C TERMINATE ROUTINE EXECUTION 10000021 + STOP 10010021 +C 10020021 +C FORMAT STATEMENTS FOR PAGE HEADERS 10030021 +90000 FORMAT ("1") 10040021 +90002 FORMAT (" ") 10050021 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 10060021 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 10070021 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 10080021 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 10090021 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 10100021 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 10110021 +C 10120021 +C FORMAT STATEMENTS FOR RUN SUMMARIES 10130021 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 10140021 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 10150021 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 10160021 +C 10170021 +C FORMAT STATEMENTS FOR TEST RESULTS 10180021 +80001 FORMAT (" ",4X,I5,7X,"PASS") 10190021 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 10200021 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 10210021 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 10220021 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 10230021 +C 10240021 +90007 FORMAT (" ",20X,"END OF PROGRAM FM021" ) 10250021 + END 10260021 diff --git a/Fortran/UnitTests/fcvs21_f95/FM021.reference_output b/Fortran/UnitTests/fcvs21_f95/FM021.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM021.reference_output @@ -0,0 +1,63 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 565 PASS + 566 PASS + 567 PASS + 568 PASS + 569 PASS + 570 PASS + 571 PASS + 572 PASS + 573 PASS + 574 PASS + 575 PASS + 576 PASS + 577 PASS + 578 PASS + 579 PASS + 580 PASS + 581 PASS + 582 PASS + 583 PASS + 584 PASS + 585 PASS + 586 PASS + 587 PASS + 588 PASS + 589 PASS + 590 PASS + 591 PASS + 592 PASS + 593 PASS + 594 PASS + 595 PASS + 596 PASS + 597 PASS + 598 PASS + 599 PASS + 600 PASS + 601 PASS + 602 PASS + 603 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM021 + + 0 ERRORS ENCOUNTERED + 39 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM022.f b/Fortran/UnitTests/fcvs21_f95/FM022.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM022.f @@ -0,0 +1,812 @@ + PROGRAM FM022 + +C COMMENT SECTION. 00010022 +C 00020022 +C FM022 00030022 +C 00040022 +C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS00050022 +C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES 00060022 +C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE 00070022 +C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS 00080022 +C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO 00090022 +C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY 00100022 +C USE OF THE EQUIVALENCE STATEMENT. 00110022 +C 00120022 +C REFERENCES 00130022 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140022 +C X3.9-1978 00150022 +C 00160022 +C SECTION 8, SPECIFICATION STATEMENTS 00170022 +C SECTION 8.1, DIMENSION STATEMENT 00180022 +C SECTION 8.2, EQUIVALENCE STATEMENT 00190022 +C SECTION 8.3, COMMON STATEMENT 00200022 +C SECTION 8.4, TYPE-STATEMENTS 00210022 +C SECTION 9, DATA STATEMENT 00220022 +C 00230022 +C 00240022 +C 00250022 + COMMON IADN14(5), RADN14(5), LADN13(2) 00260022 +C 00270022 + DIMENSION IADN11(5), RADN11(5), LADN11(2) 00280022 + DIMENSION IADN12(5), RADN12(5), LADN12(2) 00290022 + DIMENSION IADN15(2), RADN15(2) 00300022 + DIMENSION IADN16(4), IADN17(4) 00310022 +C 00320022 + INTEGER RADN13(5) 00330022 + REAL IADN13(5) 00340022 + LOGICAL LADN11, LADN12, LADN13, LCTN01 00350022 +C 00360022 + EQUIVALENCE (IADN14(1), IADN15(1)), (RADN14(2),RADN15(2)) 00370022 + EQUIVALENCE (LADN13(1),LCTN01), (IADN14(5), ICON02) 00380022 + EQUIVALENCE (RADN14(5), RCON01) 00390022 + EQUIVALENCE ( IADN16(3), IADN17(2) ) 00400022 +C 00410022 + DATA IADN12(1)/3/, RADN12(1)/-512./, IADN13(1)/0.5/, RADN13(1)/-3/00420022 +C 00430022 +C 00440022 +C 00450022 +C ********************************************************** 00460022 +C 00470022 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00480022 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00490022 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00500022 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00510022 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00520022 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00530022 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00540022 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00550022 +C OF EXECUTING THESE TESTS. 00560022 +C 00570022 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00580022 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00590022 +C 00600022 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00610022 +C 00620022 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00630022 +C SOFTWARE STANDARDS VALIDATION GROUP 00640022 +C BUILDING 225 RM A266 00650022 +C GAITHERSBURG, MD 20899 00660022 +C ********************************************************** 00670022 +C 00680022 +C 00690022 +C 00700022 +C INITIALIZATION SECTION 00710022 +C 00720022 +C INITIALIZE CONSTANTS 00730022 +C ************** 00740022 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00750022 + I01 = 5 00760022 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00770022 + I02 = 6 00780022 +C SYSTEM ENVIRONMENT SECTION 00790022 +C 00800022 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00810022 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00820022 +C (UNIT NUMBER FOR CARD READER). 00830022 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00840022 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850022 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00860022 +C 00870022 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00880022 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00890022 +C (UNIT NUMBER FOR PRINTER). 00900022 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00910022 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00920022 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00930022 +C 00940022 + IVPASS=0 00950022 + IVFAIL=0 00960022 + IVDELE=0 00970022 + ICZERO=0 00980022 +C 00990022 +C WRITE PAGE HEADERS 01000022 + WRITE (I02,90000) 01010022 + WRITE (I02,90001) 01020022 + WRITE (I02,90002) 01030022 + WRITE (I02, 90002) 01040022 + WRITE (I02,90003) 01050022 + WRITE (I02,90002) 01060022 + WRITE (I02,90004) 01070022 + WRITE (I02,90002) 01080022 + WRITE (I02,90011) 01090022 + WRITE (I02,90002) 01100022 + WRITE (I02,90002) 01110022 + WRITE (I02,90005) 01120022 + WRITE (I02,90006) 01130022 + WRITE (I02,90002) 01140022 + IVTNUM = 604 01150022 +C 01160022 +C **** TEST 604 **** 01170022 +C TEST 604 - THIS TESTS A SIMPLE ASSIGNMENT STATEMENT IN SETTING 01180022 +C AN INTEGER ARRAY ELEMENT TO A POSITIVE VALUE OF 32767. 01190022 +C 01200022 + IF (ICZERO) 36040, 6040, 36040 01210022 + 6040 CONTINUE 01220022 + IADN11(5) = 32767 01230022 + IVCOMP = IADN11(5) 01240022 + GO TO 46040 01250022 +36040 IVDELE = IVDELE + 1 01260022 + WRITE (I02,80003) IVTNUM 01270022 + IF (ICZERO) 46040, 6051, 46040 01280022 +46040 IF ( IVCOMP - 32767 ) 26040, 16040, 26040 01290022 +16040 IVPASS = IVPASS + 1 01300022 + WRITE (I02,80001) IVTNUM 01310022 + GO TO 6051 01320022 +26040 IVFAIL = IVFAIL + 1 01330022 + IVCORR = 32767 01340022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01350022 + 6051 CONTINUE 01360022 + IVTNUM = 605 01370022 +C 01380022 +C **** TEST 605 **** 01390022 +C TEST 605 - TEST OF A SIMPLE ASSIGN WITH A NEGATIVE VALUE -32766 01400022 +C 01410022 + IF (ICZERO) 36050, 6050, 36050 01420022 + 6050 CONTINUE 01430022 + IADN11(1) = -32766 01440022 + IVCOMP = IADN11(1) 01450022 + GO TO 46050 01460022 +36050 IVDELE = IVDELE + 1 01470022 + WRITE (I02,80003) IVTNUM 01480022 + IF (ICZERO) 46050, 6061, 46050 01490022 +46050 IF ( IVCOMP + 32766 ) 26050, 16050, 26050 01500022 +16050 IVPASS = IVPASS + 1 01510022 + WRITE (I02,80001) IVTNUM 01520022 + GO TO 6061 01530022 +26050 IVFAIL = IVFAIL + 1 01540022 + IVCORR = -32766 01550022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01560022 + 6061 CONTINUE 01570022 + IVTNUM = 606 01580022 +C 01590022 +C **** TEST 606 **** 01600022 +C TEST 606 - TEST OF UNSIGNED ZERO SET TO AN ARRAY ELEMENT 01610022 +C BY A SIMPLE ASSIGNMENT STATEMENT. 01620022 +C 01630022 + IF (ICZERO) 36060, 6060, 36060 01640022 + 6060 CONTINUE 01650022 + IADN11(3) = 0 01660022 + IVCOMP = IADN11(3) 01670022 + GO TO 46060 01680022 +36060 IVDELE = IVDELE + 1 01690022 + WRITE (I02,80003) IVTNUM 01700022 + IF (ICZERO) 46060, 6071, 46060 01710022 +46060 IF ( IVCOMP - 0 ) 26060, 16060, 26060 01720022 +16060 IVPASS = IVPASS + 1 01730022 + WRITE (I02,80001) IVTNUM 01740022 + GO TO 6071 01750022 +26060 IVFAIL = IVFAIL + 1 01760022 + IVCORR = 0 01770022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01780022 + 6071 CONTINUE 01790022 + IVTNUM = 607 01800022 +C 01810022 +C **** TEST 607 **** 01820022 +C TEST 607 - TEST OF A NEGATIVELY SIGNED ZERO COMPARED TO A 01830022 +C ZERO UNSIGNED BOTH VALUES SET AS INTEGER ARRAY ELEMENTS. 01840022 +C 01850022 + IF (ICZERO) 36070, 6070, 36070 01860022 + 6070 CONTINUE 01870022 + IADN11(2) = -0 01880022 + IADN11(3) = 0 01890022 + ICON01 = 0 01900022 + IF ( IADN11(2) .EQ. IADN11(3) ) ICON01 = 1 01910022 + GO TO 46070 01920022 +36070 IVDELE = IVDELE + 1 01930022 + WRITE (I02,80003) IVTNUM 01940022 + IF (ICZERO) 46070, 6081, 46070 01950022 +46070 IF ( ICON01 - 1 ) 26070, 16070, 26070 01960022 +16070 IVPASS = IVPASS + 1 01970022 + WRITE (I02,80001) IVTNUM 01980022 + GO TO 6081 01990022 +26070 IVFAIL = IVFAIL + 1 02000022 + IVCOMP = ICON01 02010022 + IVCORR = 1 02020022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02030022 + 6081 CONTINUE 02040022 + IVTNUM = 608 02050022 +C 02060022 +C **** TEST 608 **** 02070022 +C TEST 608 - TEST OF SETTING ONE INTEGER ARRAY ELEMENT EQUAL TO 02080022 +C THE VALUE OF ANOTHER INTEGER ARRAY ELEMENT. THE VALUE IS 32767. 02090022 +C 02100022 + IF (ICZERO) 36080, 6080, 36080 02110022 + 6080 CONTINUE 02120022 + IADN11(1) = 32767 02130022 + IADN12(5) = IADN11(1) 02140022 + IVCOMP = IADN12(5) 02150022 + GO TO 46080 02160022 +36080 IVDELE = IVDELE + 1 02170022 + WRITE (I02,80003) IVTNUM 02180022 + IF (ICZERO) 46080, 6091, 46080 02190022 +46080 IF ( IVCOMP - 32767 ) 26080, 16080, 26080 02200022 +16080 IVPASS = IVPASS + 1 02210022 + WRITE (I02,80001) IVTNUM 02220022 + GO TO 6091 02230022 +26080 IVFAIL = IVFAIL + 1 02240022 + IVCORR = 32767 02250022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02260022 + 6091 CONTINUE 02270022 + IVTNUM = 609 02280022 +C 02290022 +C **** TEST 609 **** 02300022 +C TEST 609 - TEST OF AN ARRAY ELEMENT SET TO ANOTHER ARRAY ELEMENT02310022 +C WHICH HAD BEEN SET AT COMPILE TIME BY A DATA INITIALIZATION 02320022 +C STATEMENT. AN INTEGER ARRAY IS USED WITH THE VALUE 3. 02330022 +C 02340022 + IF (ICZERO) 36090, 6090, 36090 02350022 + 6090 CONTINUE 02360022 + IADN11(4) = IADN12(1) 02370022 + IVCOMP = IADN11(4) 02380022 + GO TO 46090 02390022 +36090 IVDELE = IVDELE + 1 02400022 + WRITE (I02,80003) IVTNUM 02410022 + IF (ICZERO) 46090, 6101, 46090 02420022 +46090 IF ( IVCOMP - 3 ) 26090, 16090, 26090 02430022 +16090 IVPASS = IVPASS + 1 02440022 + WRITE (I02,80001) IVTNUM 02450022 + GO TO 6101 02460022 +26090 IVFAIL = IVFAIL + 1 02470022 + IVCORR = 3 02480022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02490022 + 6101 CONTINUE 02500022 + IVTNUM = 610 02510022 +C 02520022 +C **** TEST 610 **** 02530022 +C TEST 610 - TEST OF SETTING A REAL ARRAY ELEMENT TO A POSITIVE 02540022 +C VALUE IN A SIMPLE ASSIGNMENT STATEMENT. VALUE IS 32767. 02550022 +C 02560022 + IF (ICZERO) 36100, 6100, 36100 02570022 + 6100 CONTINUE 02580022 + RADN11(5) = 32767. 02590022 + IVCOMP = RADN11(5) 02600022 + GO TO 46100 02610022 +36100 IVDELE = IVDELE + 1 02620022 + WRITE (I02,80003) IVTNUM 02630022 + IF (ICZERO) 46100, 6111, 46100 02640022 +46100 IF ( IVCOMP - 32767 ) 26100, 16100, 26100 02650022 +16100 IVPASS = IVPASS + 1 02660022 + WRITE (I02,80001) IVTNUM 02670022 + GO TO 6111 02680022 +26100 IVFAIL = IVFAIL + 1 02690022 + IVCORR = 32767 02700022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02710022 + 6111 CONTINUE 02720022 + IVTNUM = 611 02730022 +C 02740022 +C **** TEST 611 **** 02750022 +C TEST 611 - TEST OF SETTING A REAL ARRAY ELEMENT TO A NEGATIVE 02760022 +C VALUE IN A SIMPLE ASSIGNMENT STATEMENT. VALUE IS -32766. 02770022 +C 02780022 + IF (ICZERO) 36110, 6110, 36110 02790022 + 6110 CONTINUE 02800022 + RADN11(1) = -32766. 02810022 + IVCOMP = RADN11(1) 02820022 + GO TO 46110 02830022 +36110 IVDELE = IVDELE + 1 02840022 + WRITE (I02,80003) IVTNUM 02850022 + IF (ICZERO) 46110, 6121, 46110 02860022 +46110 IF ( IVCOMP + 32766 ) 26110, 16110, 26110 02870022 +16110 IVPASS = IVPASS + 1 02880022 + WRITE (I02,80001) IVTNUM 02890022 + GO TO 6121 02900022 +26110 IVFAIL = IVFAIL + 1 02910022 + IVCORR = -32766 02920022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02930022 + 6121 CONTINUE 02940022 + IVTNUM = 612 02950022 +C 02960022 +C **** TEST 612 **** 02970022 +C TEST 612 - TEST OF SETTING A REAL ARRAY ELEMENT TO UNSIGNED ZERO02980022 +C IN A SIMPLE ASSIGNMENT STATEMENT. 02990022 +C 03000022 + IF (ICZERO) 36120, 6120, 36120 03010022 + 6120 CONTINUE 03020022 + RADN11(3) = 0. 03030022 + IVCOMP = RADN11(3) 03040022 + GO TO 46120 03050022 +36120 IVDELE = IVDELE + 1 03060022 + WRITE (I02,80003) IVTNUM 03070022 + IF (ICZERO) 46120, 6131, 46120 03080022 +46120 IF ( IVCOMP - 0 ) 26120, 16120, 26120 03090022 +16120 IVPASS = IVPASS + 1 03100022 + WRITE (I02,80001) IVTNUM 03110022 + GO TO 6131 03120022 +26120 IVFAIL = IVFAIL + 1 03130022 + IVCORR = 0 03140022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03150022 + 6131 CONTINUE 03160022 + IVTNUM = 613 03170022 +C 03180022 +C **** TEST 613 **** 03190022 +C TEST 613 - TEST OF A NEGATIVELY SIGNED ZERO IN A REAL ARRAY 03200022 +C ELEMENT COMPARED TO A REAL ELEMENT SET TO AN UNSIGNED ZERO. 03210022 +C 03220022 + IF (ICZERO) 36130, 6130, 36130 03230022 + 6130 CONTINUE 03240022 + RADN11(2) = -0.0 03250022 + RADN11(3) = 0.0 03260022 + ICON01 = 0 03270022 + IF ( RADN11(2) .EQ. RADN11(3) ) ICON01 = 1 03280022 + GO TO 46130 03290022 +36130 IVDELE = IVDELE + 1 03300022 + WRITE (I02,80003) IVTNUM 03310022 + IF (ICZERO) 46130, 6141, 46130 03320022 +46130 IF ( ICON01 - 1 ) 26130, 16130, 26130 03330022 +16130 IVPASS = IVPASS + 1 03340022 + WRITE (I02,80001) IVTNUM 03350022 + GO TO 6141 03360022 +26130 IVFAIL = IVFAIL + 1 03370022 + IVCOMP = ICON01 03380022 + IVCORR = 1 03390022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03400022 + 6141 CONTINUE 03410022 + IVTNUM = 614 03420022 +C 03430022 +C **** TEST 614 **** 03440022 +C TEST 614 - TEST OF SETTING ONE REAL ARRAY ELEMENT EQUAL TO THE 03450022 +C VALUE OF ANOTHER REAL ARRAY ELEMENT. THE VALUE IS 32767. 03460022 +C 03470022 + IF (ICZERO) 36140, 6140, 36140 03480022 + 6140 CONTINUE 03490022 + RADN11(1) = 32767. 03500022 + RADN12(5) = RADN11(1) 03510022 + IVCOMP = RADN12(5) 03520022 + GO TO 46140 03530022 +36140 IVDELE = IVDELE + 1 03540022 + WRITE (I02,80003) IVTNUM 03550022 + IF (ICZERO) 46140, 6151, 46140 03560022 +46140 IF ( IVCOMP - 32767 ) 26140, 16140, 26140 03570022 +16140 IVPASS = IVPASS + 1 03580022 + WRITE (I02,80001) IVTNUM 03590022 + GO TO 6151 03600022 +26140 IVFAIL = IVFAIL + 1 03610022 + IVCORR = 32767 03620022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03630022 + 6151 CONTINUE 03640022 + IVTNUM = 615 03650022 +C 03660022 +C **** TEST 615 **** 03670022 +C TEST 615 - TEST OF A REAL ARRAY ELEMENT SET TO ANOTHER REAL 03680022 +C ARRAY ELEMENT WHICH HAD BEEN SET AT COMPILE TIME BY A DATA 03690022 +C INITIALIZATION STATEMENT. THE VALUE IS -512. 03700022 +C 03710022 + IF (ICZERO) 36150, 6150, 36150 03720022 + 6150 CONTINUE 03730022 + RADN11(4) = RADN12(1) 03740022 + IVCOMP = RADN11(4) 03750022 + GO TO 46150 03760022 +36150 IVDELE = IVDELE + 1 03770022 + WRITE (I02,80003) IVTNUM 03780022 + IF (ICZERO) 46150, 6161, 46150 03790022 +46150 IF ( IVCOMP + 512 ) 26150, 16150, 26150 03800022 +16150 IVPASS = IVPASS + 1 03810022 + WRITE (I02,80001) IVTNUM 03820022 + GO TO 6161 03830022 +26150 IVFAIL = IVFAIL + 1 03840022 + IVCORR = - 512 03850022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03860022 + 6161 CONTINUE 03870022 + IVTNUM = 616 03880022 +C 03890022 +C **** TEST 616 **** 03900022 +C TEST 616 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT03910022 +C BY AN ARITHMETIC EXPRESSION. 03920022 +C 03930022 + IF (ICZERO) 36160, 6160, 36160 03940022 + 6160 CONTINUE 03950022 + ICON01 = 1 03960022 + IADN11(3) = ICON01 + 1 03970022 + IVCOMP = IADN11(3) 03980022 + GO TO 46160 03990022 +36160 IVDELE = IVDELE + 1 04000022 + WRITE (I02,80003) IVTNUM 04010022 + IF (ICZERO) 46160, 6171, 46160 04020022 +46160 IF ( IVCOMP - 2 ) 26160, 16160, 26160 04030022 +16160 IVPASS = IVPASS + 1 04040022 + WRITE (I02,80001) IVTNUM 04050022 + GO TO 6171 04060022 +26160 IVFAIL = IVFAIL + 1 04070022 + IVCORR = 2 04080022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04090022 + 6171 CONTINUE 04100022 + IVTNUM = 617 04110022 +C 04120022 +C **** TEST 617 **** 04130022 +C TEST 617 - TEST OF SETTING THE VALUE OF A REAL ARRAY ELEMENT 04140022 +C BY AN ARITHMETIC EXPRESSION. 04150022 +C 04160022 + IF (ICZERO) 36170, 6170, 36170 04170022 + 6170 CONTINUE 04180022 + RCON01 = 1. 04190022 + RADN11(3) = RCON01 + 1. 04200022 + IVCOMP = RADN11(3) 04210022 + GO TO 46170 04220022 +36170 IVDELE = IVDELE + 1 04230022 + WRITE (I02,80003) IVTNUM 04240022 + IF (ICZERO) 46170, 6181, 46170 04250022 +46170 IF ( IVCOMP - 2 ) 26170, 16170, 26170 04260022 +16170 IVPASS = IVPASS + 1 04270022 + WRITE (I02,80001) IVTNUM 04280022 + GO TO 6181 04290022 +26170 IVFAIL = IVFAIL + 1 04300022 + IVCORR = 2 04310022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04320022 + 6181 CONTINUE 04330022 + IVTNUM = 618 04340022 +C 04350022 +C **** TEST 618 **** 04360022 +C TEST 618 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT04370022 +C TO ANOTHER INTEGER ARRAY ELEMENT AND CHANGING THE SIGN. 04380022 +C 04390022 + IF (ICZERO) 36180, 6180, 36180 04400022 + 6180 CONTINUE 04410022 + IADN11(2) = 32766 04420022 + IADN11(4) = - IADN11(2) 04430022 + IVCOMP = IADN11(4) 04440022 + GO TO 46180 04450022 +36180 IVDELE = IVDELE + 1 04460022 + WRITE (I02,80003) IVTNUM 04470022 + IF (ICZERO) 46180, 6191, 46180 04480022 +46180 IF ( IVCOMP + 32766 ) 26180, 16180, 26180 04490022 +16180 IVPASS = IVPASS + 1 04500022 + WRITE (I02,80001) IVTNUM 04510022 + GO TO 6191 04520022 +26180 IVFAIL = IVFAIL + 1 04530022 + IVCORR = -32766 04540022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04550022 + 6191 CONTINUE 04560022 + IVTNUM = 619 04570022 +C 04580022 +C **** TEST 619 **** 04590022 +C TEST 619 - TEST OF SETTING THE VALUE OF A REAL ARRAY ELEMENT 04600022 +C TO THE VALUE OF ANOTHER REAL ARRAY ELEMENT AND CHANGING THE SIGN. 04610022 +C 04620022 + IF (ICZERO) 36190, 6190, 36190 04630022 + 6190 CONTINUE 04640022 + RADN11(2) = 32766. 04650022 + RADN11(4) = - RADN11(2) 04660022 + IVCOMP = RADN11(4) 04670022 + GO TO 46190 04680022 +36190 IVDELE = IVDELE + 1 04690022 + WRITE (I02,80003) IVTNUM 04700022 + IF (ICZERO) 46190, 6201, 46190 04710022 +46190 IF ( IVCOMP + 32766 ) 26190, 16190, 26190 04720022 +16190 IVPASS = IVPASS + 1 04730022 + WRITE (I02,80001) IVTNUM 04740022 + GO TO 6201 04750022 +26190 IVFAIL = IVFAIL + 1 04760022 + IVCORR = -32766 04770022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04780022 + 6201 CONTINUE 04790022 + IVTNUM = 620 04800022 +C 04810022 +C **** TEST 620 **** 04820022 +C TEST 620 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 04830022 +C TO THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT. 04840022 +C 04850022 + IF (ICZERO) 36200, 6200, 36200 04860022 + 6200 CONTINUE 04870022 + LADN11(1) = .TRUE. 04880022 + LADN12(1) = LADN11(1) 04890022 + ICON01 = 0 04900022 + IF ( LADN12(1) ) ICON01 = 1 04910022 + GO TO 46200 04920022 +36200 IVDELE = IVDELE + 1 04930022 + WRITE (I02,80003) IVTNUM 04940022 + IF (ICZERO) 46200, 6211, 46200 04950022 +46200 IF ( ICON01 - 1 ) 26200, 16200, 26200 04960022 +16200 IVPASS = IVPASS + 1 04970022 + WRITE (I02,80001) IVTNUM 04980022 + GO TO 6211 04990022 +26200 IVFAIL = IVFAIL + 1 05000022 + IVCOMP = ICON01 05010022 + IVCORR = 1 05020022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05030022 + 6211 CONTINUE 05040022 + IVTNUM = 621 05050022 +C 05060022 +C **** TEST 621 **** 05070022 +C TEST 621 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 05080022 +C TO THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT AND CHANGING 05090022 +C THE VALUE FROM .TRUE. TO .FALSE. BY USING THE .NOT. STATEMENT. 05100022 +C 05110022 + IF (ICZERO) 36210, 6210, 36210 05120022 + 6210 CONTINUE 05130022 + LADN11(2) = .TRUE. 05140022 + LADN12(2) = .NOT. LADN11(2) 05150022 + ICON01 = 1 05160022 + IF ( LADN12(2) ) ICON01 = 0 05170022 + GO TO 46210 05180022 +36210 IVDELE = IVDELE + 1 05190022 + WRITE (I02,80003) IVTNUM 05200022 + IF (ICZERO) 46210, 6221, 46210 05210022 +46210 IF ( ICON01 - 1 ) 26210, 16210, 26210 05220022 +16210 IVPASS = IVPASS + 1 05230022 + WRITE (I02,80001) IVTNUM 05240022 + GO TO 6221 05250022 +26210 IVFAIL = IVFAIL + 1 05260022 + IVCOMP = ICON01 05270022 + IVCORR = 1 05280022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05290022 + 6221 CONTINUE 05300022 + IVTNUM = 622 05310022 +C 05320022 +C **** TEST 622 **** 05330022 +C TEST 622 - TEST OF THE TYPE STATEMENT AND THE DATA 05340022 +C INITIALIZATION STATEMENT. THE EXPLICITLY REAL ARRAY ELEMENT 05350022 +C SHOULD HAVE THE VALUE OF .5 05360022 +C 05370022 + IF (ICZERO) 36220, 6220, 36220 05380022 + 6220 CONTINUE 05390022 + IVCOMP = 2. * IADN13(1) 05400022 + GO TO 46220 05410022 +36220 IVDELE = IVDELE + 1 05420022 + WRITE (I02,80003) IVTNUM 05430022 + IF (ICZERO) 46220, 6231, 46220 05440022 +46220 IF ( IVCOMP - 1 ) 26220, 16220, 26220 05450022 +16220 IVPASS = IVPASS + 1 05460022 + WRITE (I02,80001) IVTNUM 05470022 + GO TO 6231 05480022 +26220 IVFAIL = IVFAIL + 1 05490022 + IVCORR = 1 05500022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05510022 + 6231 CONTINUE 05520022 + IVTNUM = 623 05530022 +C 05540022 +C **** TEST 623 **** 05550022 +C TEST 623 - TEST OF REAL TO INTEGER CONVERSION USING ARRAYS. 05560022 +C THE INITIALIZED VALUE OF 0.5 SHOULD BE TRUNCATED TO ZERO. 05570022 +C 05580022 + IF (ICZERO) 36230, 6230, 36230 05590022 + 6230 CONTINUE 05600022 + IADN11(1) = IADN13(1) 05610022 + IVCOMP = IADN11(1) 05620022 + GO TO 46230 05630022 +36230 IVDELE = IVDELE + 1 05640022 + WRITE (I02,80003) IVTNUM 05650022 + IF (ICZERO) 46230, 6241, 46230 05660022 +46230 IF ( IVCOMP - 0 ) 26230, 16230, 26230 05670022 +16230 IVPASS = IVPASS + 1 05680022 + WRITE (I02,80001) IVTNUM 05690022 + GO TO 6241 05700022 +26230 IVFAIL = IVFAIL + 1 05710022 + IVCORR = 0 05720022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05730022 + 6241 CONTINUE 05740022 + IVTNUM = 624 05750022 +C 05760022 +C **** TEST 624 **** 05770022 +C TEST 624 - TEST OF THE COMMON STATEMENT BY SETTING THE VALUE OF 05780022 +C AN INTEGER ARRAY ELEMENT IN A DIMENSIONED ARRAY TO THE VALUE 05790022 +C OF A REAL ARRAY ELEMENT IN COMMON. THE ELEMENT IN COMMON HAD ITS 05800022 +C VALUE SET IN A SIMPLE ASSIGNMENT STATEMENT TO 9999. 05810022 +C 05820022 + IF (ICZERO) 36240, 6240, 36240 05830022 + 6240 CONTINUE 05840022 + RADN14(1) = 9999. 05850022 + IADN11(1) = RADN14(1) 05860022 + IVCOMP = IADN11(1) 05870022 + GO TO 46240 05880022 +36240 IVDELE = IVDELE + 1 05890022 + WRITE (I02,80003) IVTNUM 05900022 + IF (ICZERO) 46240, 6251, 46240 05910022 +46240 IF ( IVCOMP - 9999 ) 26240, 16240, 26240 05920022 +16240 IVPASS = IVPASS + 1 05930022 + WRITE (I02,80001) IVTNUM 05940022 + GO TO 6251 05950022 +26240 IVFAIL = IVFAIL + 1 05960022 + IVCORR = 9999 05970022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05980022 + 6251 CONTINUE 05990022 + IVTNUM = 625 06000022 +C 06010022 +C **** TEST 625 **** 06020022 +C TEST 625 - TEST OF SETTING THE VALUE OF AN INTEGER ARRAY ELEMENT06030022 +C IN COMMON TO THE VALUE OF A REAL ARRAY ELEMENT ALSO IN BLANK 06040022 +C COMMON AND CHANGING THE SIGN. THE VALUE USED IS 9999. 06050022 +C 06060022 + IF (ICZERO) 36250, 6250, 36250 06070022 + 6250 CONTINUE 06080022 + RADN14(1) = 9999. 06090022 + IADN14(1) = - RADN14(1) 06100022 + IVCOMP = IADN14(1) 06110022 + GO TO 46250 06120022 +36250 IVDELE = IVDELE + 1 06130022 + WRITE (I02,80003) IVTNUM 06140022 + IF (ICZERO) 46250, 6261, 46250 06150022 +46250 IF ( IVCOMP + 9999 ) 26250, 16250, 26250 06160022 +16250 IVPASS = IVPASS + 1 06170022 + WRITE (I02,80001) IVTNUM 06180022 + GO TO 6261 06190022 +26250 IVFAIL = IVFAIL + 1 06200022 + IVCORR = - 9999 06210022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06220022 + 6261 CONTINUE 06230022 + IVTNUM = 626 06240022 +C 06250022 +C **** TEST 626 **** 06260022 +C TEST 626 - TEST OF SETTING THE VALUE OF A LOGICAL ARRAY ELEMENT 06270022 +C IN BLANK COMMON TO .NOT. .TRUE. 06280022 +C THE VALUE OF ANOTHER LOGICAL ARRAY ELEMENT ALSO IN COMMON IS THEN 06290022 +C SET TO .NOT. OF THE VALUE OF THE FIRST. 06300022 +C VALUE OF THE FIRST ELEMENT SHOULD BE .FALSE. 06310022 +C VALUE OF THE SECOND ELEMENT SHOULD BE .TRUE. 06320022 +C 06330022 + IF (ICZERO) 36260, 6260, 36260 06340022 + 6260 CONTINUE 06350022 + LADN13(1) = .NOT. .TRUE. 06360022 + LADN13(2) = .NOT. LADN13(1) 06370022 + ICON01 = 0 06380022 + IF ( LADN13(2) ) ICON01 = 1 06390022 + GO TO 46260 06400022 +36260 IVDELE = IVDELE + 1 06410022 + WRITE (I02,80003) IVTNUM 06420022 + IF (ICZERO) 46260, 6271, 46260 06430022 +46260 IF ( ICON01 - 1 ) 26260, 16260, 26260 06440022 +16260 IVPASS = IVPASS + 1 06450022 + WRITE (I02,80001) IVTNUM 06460022 + GO TO 6271 06470022 +26260 IVFAIL = IVFAIL + 1 06480022 + IVCOMP = ICON01 06490022 + IVCORR = 1 06500022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06510022 + 6271 CONTINUE 06520022 + IVTNUM = 627 06530022 +C 06540022 +C **** TEST 627 **** 06550022 +C TEST 627 - TEST OF EQUIVALENCE ON THE FIRST ELEMENTS OF INTEGER 06560022 +C ARRAYS ONE OF WHICH IS IN COMMON AND THE OTHER ONE IS DIMENSIONED.06570022 +C 06580022 + IF (ICZERO) 36270, 6270, 36270 06590022 + 6270 CONTINUE 06600022 + IADN14(2) = 32767 06610022 + IVCOMP = IADN15(2) 06620022 + GO TO 46270 06630022 +36270 IVDELE = IVDELE + 1 06640022 + WRITE (I02,80003) IVTNUM 06650022 + IF (ICZERO) 46270, 6281, 46270 06660022 +46270 IF ( IVCOMP - 32767 ) 26270, 16270, 26270 06670022 +16270 IVPASS = IVPASS + 1 06680022 + WRITE (I02,80001) IVTNUM 06690022 + GO TO 6281 06700022 +26270 IVFAIL = IVFAIL + 1 06710022 + IVCORR = 32767 06720022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06730022 + 6281 CONTINUE 06740022 + IVTNUM = 628 06750022 +C 06760022 +C **** TEST 628 **** 06770022 +C TEST 628 - TEST OF EQUIVALENCE ON REAL ARRAYS ONE OF WHICH IS 06780022 +C IN COMMON AND THE OTHER ONE IS DIMENSIONED. THE ARRAYS WERE 06790022 +C ALIGNED ON THEIR SECOND ELEMENTS. 06800022 +C 06810022 + IF (ICZERO) 36280, 6280, 36280 06820022 + 6280 CONTINUE 06830022 + RADN15(1) = -32766. 06840022 + IVCOMP = RADN14(1) 06850022 + GO TO 46280 06860022 +36280 IVDELE = IVDELE + 1 06870022 + WRITE (I02,80003) IVTNUM 06880022 + IF (ICZERO) 46280, 6291, 46280 06890022 +46280 IF ( IVCOMP + 32766 ) 26280, 16280, 26280 06900022 +16280 IVPASS = IVPASS + 1 06910022 + WRITE (I02,80001) IVTNUM 06920022 + GO TO 6291 06930022 +26280 IVFAIL = IVFAIL + 1 06940022 + IVCORR = -32766 06950022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06960022 + 6291 CONTINUE 06970022 + IVTNUM = 629 06980022 +C 06990022 +C **** TEST 629 **** 07000022 +C TEST 629 - TEST OF EQUIVALENCE WITH LOGICAL ELEMENTS. AN ARRAY 07010022 +C ELEMENT IN COMMON IS EQUIVALENCED TO A LOGICAL VARIABLE. 07020022 +C 07030022 + IF (ICZERO) 36290, 6290, 36290 07040022 + 6290 CONTINUE 07050022 + LADN13(2) = .TRUE. 07060022 + LCTN01 = .NOT. LADN13(2) 07070022 + ICON01 = 1 07080022 + IF ( LADN13(1) ) ICON01 = 0 07090022 + GO TO 46290 07100022 +36290 IVDELE = IVDELE + 1 07110022 + WRITE (I02,80003) IVTNUM 07120022 + IF (ICZERO) 46290, 6301, 46290 07130022 +46290 IF ( ICON01 - 1 ) 26290, 16290, 26290 07140022 +16290 IVPASS = IVPASS + 1 07150022 + WRITE (I02,80001) IVTNUM 07160022 + GO TO 6301 07170022 +26290 IVFAIL = IVFAIL + 1 07180022 + IVCOMP = ICON01 07190022 + IVCORR = 1 07200022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07210022 + 6301 CONTINUE 07220022 + IVTNUM = 630 07230022 +C 07240022 +C **** TEST 630 **** 07250022 +C TEST 630 - TEST OF EQUIVALENCE WITH REAL AND INTEGER ELEMENTS 07260022 +C WHICH ARE EQUIVALENCED TO ARRAY ELEMENTS IN COMMON. 07270022 +C 07280022 + IF (ICZERO) 36300, 6300, 36300 07290022 + 6300 CONTINUE 07300022 + RCON01 = 1. 07310022 + ICON02 = - RADN14(5) 07320022 + IVCOMP = IADN14(5) 07330022 + GO TO 46300 07340022 +36300 IVDELE = IVDELE + 1 07350022 + WRITE (I02,80003) IVTNUM 07360022 + IF (ICZERO) 46300, 6311, 46300 07370022 +46300 IF ( IVCOMP + 1 ) 26300, 16300, 26300 07380022 +16300 IVPASS = IVPASS + 1 07390022 + WRITE (I02,80001) IVTNUM 07400022 + GO TO 6311 07410022 +26300 IVFAIL = IVFAIL + 1 07420022 + IVCORR = -1 07430022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07440022 + 6311 CONTINUE 07450022 + IVTNUM = 631 07460022 +C 07470022 +C **** TEST 631 **** 07480022 +C TEST 631 - TEST OF EQUIVALENCE ON INTEGER ARRAY ELEMENTS. 07490022 +C BOTH ARRAYS ARE DIMENSIONED. THE FOURTH ELEMENT 07500022 +C OF THE FIRST OF THE ARRAYS SHOULD BE EQUAL TO THE THIRD ELEMENT OF07510022 +C THE SECOND ARRAY. 07520022 +C 07530022 + IF (ICZERO) 36310, 6310, 36310 07540022 + 6310 CONTINUE 07550022 + IADN16(4) = 9999 07560022 + IVCOMP = IADN17(3) 07570022 + GO TO 46310 07580022 +36310 IVDELE = IVDELE + 1 07590022 + WRITE (I02,80003) IVTNUM 07600022 + IF (ICZERO) 46310, 6321, 46310 07610022 +46310 IF ( IVCOMP - 9999 ) 26310, 16310, 26310 07620022 +16310 IVPASS = IVPASS + 1 07630022 + WRITE (I02,80001) IVTNUM 07640022 + GO TO 6321 07650022 +26310 IVFAIL = IVFAIL + 1 07660022 + IVCORR = 9999 07670022 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07680022 + 6321 CONTINUE 07690022 +C 07700022 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07710022 +99999 CONTINUE 07720022 + WRITE (I02,90002) 07730022 + WRITE (I02,90006) 07740022 + WRITE (I02,90002) 07750022 + WRITE (I02,90002) 07760022 + WRITE (I02,90007) 07770022 + WRITE (I02,90002) 07780022 + WRITE (I02,90008) IVFAIL 07790022 + WRITE (I02,90009) IVPASS 07800022 + WRITE (I02,90010) IVDELE 07810022 +C 07820022 +C 07830022 +C TERMINATE ROUTINE EXECUTION 07840022 + STOP 07850022 +C 07860022 +C FORMAT STATEMENTS FOR PAGE HEADERS 07870022 +90000 FORMAT ("1") 07880022 +90002 FORMAT (" ") 07890022 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07900022 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07910022 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07920022 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07930022 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07940022 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07950022 +C 07960022 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07970022 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07980022 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07990022 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08000022 +C 08010022 +C FORMAT STATEMENTS FOR TEST RESULTS 08020022 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08030022 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08040022 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08050022 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08060022 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08070022 +C 08080022 +90007 FORMAT (" ",20X,"END OF PROGRAM FM022" ) 08090022 + END 08100022 diff --git a/Fortran/UnitTests/fcvs21_f95/FM022.reference_output b/Fortran/UnitTests/fcvs21_f95/FM022.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM022.reference_output @@ -0,0 +1,52 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 604 PASS + 605 PASS + 606 PASS + 607 PASS + 608 PASS + 609 PASS + 610 PASS + 611 PASS + 612 PASS + 613 PASS + 614 PASS + 615 PASS + 616 PASS + 617 PASS + 618 PASS + 619 PASS + 620 PASS + 621 PASS + 622 PASS + 623 PASS + 624 PASS + 625 PASS + 626 PASS + 627 PASS + 628 PASS + 629 PASS + 630 PASS + 631 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM022 + + 0 ERRORS ENCOUNTERED + 28 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM023.f b/Fortran/UnitTests/fcvs21_f95/FM023.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM023.f @@ -0,0 +1,453 @@ + PROGRAM FM023 + +C COMMENT SECTION. 00010023 +C 00020023 +C FM023 00030023 +C 00040023 +C TWO DIMENSIONED ARRAYS ARE USED IN THIS ROUTINE. 00050023 +C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS00060023 +C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES 00070023 +C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE 00080023 +C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS 00090023 +C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO 00100023 +C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY 00110023 +C USE OF THE EQUIVALENCE STATEMENT. 00120023 +C 00130023 +C 00140023 +C REFERENCES 00150023 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160023 +C X3.9-1978 00170023 +C 00180023 +C SECTION 8, SPECIFICATION STATEMENTS 00190023 +C SECTION 8.1, DIMENSION STATEMENT 00200023 +C SECTION 8.2, EQUIVALENCE STATEMENT 00210023 +C SECTION 8.3, COMMON STATEMENT 00220023 +C SECTION 8.4, TYPE-STATEMENTS 00230023 +C SECTION 9, DATA STATEMENT 00240023 +C 00250023 + COMMON IADN22(2,2), RADN22(2,2), ICOE01, RCOE01 00260023 + DIMENSION IADN21(2,2), RADN21(2,2) 00270023 + DIMENSION IADE23(2,2), IADE24(2,2), RADE23(2,2), RADE24(2,2) 00280023 + EQUIVALENCE (IADE23(2,2),IADN22(2,2),IADE24(2,2)) 00290023 + EQUIVALENCE (RADE23(2,2),RADN22(2,2),RADE24(2,2)) 00300023 + EQUIVALENCE (ICOE01,ICOE02,ICOE03,ICOE04), (RCOE01,RCOE02,RCOE03) 00310023 + INTEGER RADN11(2), RADN25(2,2) 00320023 + LOGICAL LADN21(2,2) 00330023 + DATA RADN21(2,2)/-512./ 00340023 + DATA LADN21/4*.TRUE./ 00350023 +C 00360023 +C ********************************************************** 00370023 +C 00380023 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00390023 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00400023 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00410023 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00420023 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00430023 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00440023 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00450023 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00460023 +C OF EXECUTING THESE TESTS. 00470023 +C 00480023 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00490023 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00500023 +C 00510023 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00520023 +C 00530023 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00540023 +C SOFTWARE STANDARDS VALIDATION GROUP 00550023 +C BUILDING 225 RM A266 00560023 +C GAITHERSBURG, MD 20899 00570023 +C ********************************************************** 00580023 +C 00590023 +C 00600023 +C 00610023 +C INITIALIZATION SECTION 00620023 +C 00630023 +C INITIALIZE CONSTANTS 00640023 +C ************** 00650023 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660023 + I01 = 5 00670023 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680023 + I02 = 6 00690023 +C SYSTEM ENVIRONMENT SECTION 00700023 +C 00710023 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00720023 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00730023 +C (UNIT NUMBER FOR CARD READER). 00740023 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00750023 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00760023 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00770023 +C 00780023 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00790023 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00800023 +C (UNIT NUMBER FOR PRINTER). 00810023 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00820023 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00830023 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00840023 +C 00850023 + IVPASS=0 00860023 + IVFAIL=0 00870023 + IVDELE=0 00880023 + ICZERO=0 00890023 +C 00900023 +C WRITE PAGE HEADERS 00910023 + WRITE (I02,90000) 00920023 + WRITE (I02,90001) 00930023 + WRITE (I02,90002) 00940023 + WRITE (I02, 90002) 00950023 + WRITE (I02,90003) 00960023 + WRITE (I02,90002) 00970023 + WRITE (I02,90004) 00980023 + WRITE (I02,90002) 00990023 + WRITE (I02,90011) 01000023 + WRITE (I02,90002) 01010023 + WRITE (I02,90002) 01020023 + WRITE (I02,90005) 01030023 + WRITE (I02,90006) 01040023 + WRITE (I02,90002) 01050023 + IVTNUM = 632 01060023 +C 01070023 +C **** TEST 632 **** 01080023 +C TEST 632 - TESTS SETTING AN INTEGER ARRAY ELEMENT BY A 01090023 +C SIMPLE ASSIGNMENT STATEMENT TO THE VALUE 9999. 01100023 +C 01110023 + IF (ICZERO) 36320, 6320, 36320 01120023 + 6320 CONTINUE 01130023 + IADN21(1,1) = 9999 01140023 + IVCOMP = IADN21(1,1) 01150023 + GO TO 46320 01160023 +36320 IVDELE = IVDELE + 1 01170023 + WRITE (I02,80003) IVTNUM 01180023 + IF (ICZERO) 46320, 6331, 46320 01190023 +46320 IF ( IVCOMP - 9999 ) 26320, 16320, 26320 01200023 +16320 IVPASS = IVPASS + 1 01210023 + WRITE (I02,80001) IVTNUM 01220023 + GO TO 6331 01230023 +26320 IVFAIL = IVFAIL + 1 01240023 + IVCORR = 9999 01250023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01260023 + 6331 CONTINUE 01270023 + IVTNUM = 633 01280023 +C 01290023 +C **** TEST 633 **** 01300023 +C TEST 633 - TESTS SETTING A REAL ARRAY ELEMENT BY A SIMPLE 01310023 +C ASSIGNMENT STATEMENT TO THE VALUE -32766. 01320023 +C 01330023 + IF (ICZERO) 36330, 6330, 36330 01340023 + 6330 CONTINUE 01350023 + RADN21(1,2) = -32766. 01360023 + IVCOMP = RADN21(1,2) 01370023 + GO TO 46330 01380023 +36330 IVDELE = IVDELE + 1 01390023 + WRITE (I02,80003) IVTNUM 01400023 + IF (ICZERO) 46330, 6341, 46330 01410023 +46330 IF ( IVCOMP + 32766 ) 26330, 16330, 26330 01420023 +16330 IVPASS = IVPASS + 1 01430023 + WRITE (I02,80001) IVTNUM 01440023 + GO TO 6341 01450023 +26330 IVFAIL = IVFAIL + 1 01460023 + IVCORR = -32766 01470023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01480023 + 6341 CONTINUE 01490023 + IVTNUM = 634 01500023 +C 01510023 +C **** TEST 634 **** 01520023 +C TEST 634 - TEST OF THE DATA INITIALIZATION STATEMENT AND SETTING01530023 +C AN INTEGER ARRAY ELEMENT EQUAL TO THE VALUE OF A REAL ARRAY 01540023 +C ELEMENT. THE VALUE USED IS -512. 01550023 +C 01560023 + IF (ICZERO) 36340, 6340, 36340 01570023 + 6340 CONTINUE 01580023 + IADN21(2,2) = RADN21(2,2) 01590023 + IVCOMP = IADN21(2,2) 01600023 + GO TO 46340 01610023 +36340 IVDELE = IVDELE + 1 01620023 + WRITE (I02,80003) IVTNUM 01630023 + IF (ICZERO) 46340, 6351, 46340 01640023 +46340 IF ( IVCOMP + 512 ) 26340, 16340, 26340 01650023 +16340 IVPASS = IVPASS + 1 01660023 + WRITE (I02,80001) IVTNUM 01670023 + GO TO 6351 01680023 +26340 IVFAIL = IVFAIL + 1 01690023 + IVCORR = -512 01700023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01710023 + 6351 CONTINUE 01720023 + IVTNUM = 635 01730023 +C 01740023 +C **** TEST 635 **** 01750023 +C TEST 635 - TEST OF SETTING A TWO DIMENSIONED ARRAY ELEMENT 01760023 +C EQUAL TO THE VALUE OF A ONE DIMENSIONED ARRAY ELEMENT. 01770023 +C BOTH ARRAYS ARE SET INTEGER BY THE TYPE STATEMENT AND THE TWO 01780023 +C DIMENSIONED ARRAY ELEMENT IS MINUS THE VALUE OF THE ONE DIMENSION 01790023 +C ELEMENT. THE VALUE USED IS 3. 01800023 +C 01810023 + IF (ICZERO) 36350, 6350, 36350 01820023 + 6350 CONTINUE 01830023 + RADN11(1) = 3 01840023 + RADN25(2,2) = - RADN11(1) 01850023 + IVCOMP = RADN25(2,2) 01860023 + GO TO 46350 01870023 +36350 IVDELE = IVDELE + 1 01880023 + WRITE (I02,80003) IVTNUM 01890023 + IF (ICZERO) 46350, 6361, 46350 01900023 +46350 IF ( IVCOMP + 3 ) 26350, 16350, 26350 01910023 +16350 IVPASS = IVPASS + 1 01920023 + WRITE (I02,80001) IVTNUM 01930023 + GO TO 6361 01940023 +26350 IVFAIL = IVFAIL + 1 01950023 + IVCORR = -3 01960023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01970023 + 6361 CONTINUE 01980023 + IVTNUM = 636 01990023 +C 02000023 +C **** TEST 636 **** 02010023 +C TEST 636 - TEST OF LOGICAL ARRAY ELEMENTS SET BY DATA STATEMENTS02020023 +C 02030023 + IF (ICZERO) 36360, 6360, 36360 02040023 + 6360 CONTINUE 02050023 + ICON01 = 0 02060023 + IF ( LADN21(2,1) ) ICON01 = 1 02070023 + GO TO 46360 02080023 +36360 IVDELE = IVDELE + 1 02090023 + WRITE (I02,80003) IVTNUM 02100023 + IF (ICZERO) 46360, 6371, 46360 02110023 +46360 IF ( ICON01 - 1 ) 26360, 16360, 26360 02120023 +16360 IVPASS = IVPASS + 1 02130023 + WRITE (I02,80001) IVTNUM 02140023 + GO TO 6371 02150023 +26360 IVFAIL = IVFAIL + 1 02160023 + IVCOMP = ICON01 02170023 + IVCORR = 1 02180023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02190023 + 6371 CONTINUE 02200023 + IVTNUM = 637 02210023 +C 02220023 +C **** TEST 637 **** 02230023 +C TEST 637 - TEST OF REAL TO INTEGER CONVERSION AND SETTING 02240023 +C INTEGER ARRAY ELEMENTS TO THE VALUE OBTAINED IN AN ARITHMETIC 02250023 +C EXPRESSION USING REAL ARRAY ELEMENTS. .5 + .5 = 1 02260023 +C 02270023 + IF (ICZERO) 36370, 6370, 36370 02280023 + 6370 CONTINUE 02290023 + RADN21(1,2) = 00000.5 02300023 + RADN21(2,1) = .500000 02310023 + IADN21(2,1) = RADN21(1,2) + RADN21(2,1) 02320023 + IVCOMP = IADN21(2,1) 02330023 + GO TO 46370 02340023 +36370 IVDELE = IVDELE + 1 02350023 + WRITE (I02,80003) IVTNUM 02360023 + IF (ICZERO) 46370, 6381, 46370 02370023 +46370 IF ( IVCOMP - 1 ) 26370, 16370, 26370 02380023 +16370 IVPASS = IVPASS + 1 02390023 + WRITE (I02,80001) IVTNUM 02400023 + GO TO 6381 02410023 +26370 IVFAIL = IVFAIL + 1 02420023 + IVCORR = 1 02430023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02440023 + 6381 CONTINUE 02450023 + IVTNUM = 638 02460023 +C 02470023 +C **** TEST 638 **** 02480023 +C TEST 638 - TEST OF EQUIVALENCE OF THREE INTEGER ARRAYS ONE OF 02490023 +C WHICH IS IN COMMON. 02500023 +C 02510023 + IF (ICZERO) 36380, 6380, 36380 02520023 + 6380 CONTINUE 02530023 + IADN22(2,1) = -9999 02540023 + IVCOMP = IADE23(2,1) 02550023 + GO TO 46380 02560023 +36380 IVDELE = IVDELE + 1 02570023 + WRITE (I02,80003) IVTNUM 02580023 + IF (ICZERO) 46380, 6391, 46380 02590023 +46380 IF ( IVCOMP + 9999 ) 26380, 16380, 26380 02600023 +16380 IVPASS = IVPASS + 1 02610023 + WRITE (I02,80001) IVTNUM 02620023 + GO TO 6391 02630023 +26380 IVFAIL = IVFAIL + 1 02640023 + IVCORR = -9999 02650023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02660023 + 6391 CONTINUE 02670023 + IVTNUM = 639 02680023 +C 02690023 +C **** TEST 639 **** 02700023 +C TEST 639 - LIKE TEST 638 ONLY THE OTHER EQUIVALENCED ARRAY IS 02710023 +C TESTED FOR THE VALUE -9999. 02720023 +C 02730023 + IF (ICZERO) 36390, 6390, 36390 02740023 + 6390 CONTINUE 02750023 + IADE23(2,1) = -9999 02760023 + IVCOMP = IADE24(2,1) 02770023 + GO TO 46390 02780023 +36390 IVDELE = IVDELE + 1 02790023 + WRITE (I02,80003) IVTNUM 02800023 + IF (ICZERO) 46390, 6401, 46390 02810023 +46390 IF ( IVCOMP + 9999 ) 26390, 16390, 26390 02820023 +16390 IVPASS = IVPASS + 1 02830023 + WRITE (I02,80001) IVTNUM 02840023 + GO TO 6401 02850023 +26390 IVFAIL = IVFAIL + 1 02860023 + IVCORR = -9999 02870023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02880023 + 6401 CONTINUE 02890023 + IVTNUM = 640 02900023 +C 02910023 +C **** TEST 640 **** 02920023 +C TEST 640 - TEST OF THREE REAL ARRAYS THAT ARE EQUIVALENCED. 02930023 +C ONE OF THE ARRAYS IS IN COMMON. THE VALUE 512 IS SET INTO ONE OF 02940023 +C THE DIMENSIONED ARRAY ELEMENTS BY AN INTEGER TO REAL CONVERSION 02950023 +C ASSIGNMENT STATEMENT. 02960023 +C 02970023 + IF (ICZERO) 36400, 6400, 36400 02980023 + 6400 CONTINUE 02990023 + RADE24(2,2) = 512 03000023 + IVCOMP = RADN22(2,2) 03010023 + GO TO 46400 03020023 +36400 IVDELE = IVDELE + 1 03030023 + WRITE (I02,80003) IVTNUM 03040023 + IF (ICZERO) 46400, 6411, 46400 03050023 +46400 IF ( IVCOMP - 512 ) 26400, 16400, 26400 03060023 +16400 IVPASS = IVPASS + 1 03070023 + WRITE (I02,80001) IVTNUM 03080023 + GO TO 6411 03090023 +26400 IVFAIL = IVFAIL + 1 03100023 + IVCORR = 512 03110023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03120023 + 6411 CONTINUE 03130023 + IVTNUM = 641 03140023 +C 03150023 +C **** TEST 641 **** 03160023 +C TEST 641 - LIKE TEST 640 ONLY THE OTHER EQUIVALENCED ARRAY IS 03170023 +C TESTED FOR THE VALUE 512. 03180023 +C 03190023 + IF (ICZERO) 36410, 6410, 36410 03200023 + 6410 CONTINUE 03210023 + RADN22(2,2) = 512 03220023 + IVCOMP = RADE23(2,2) 03230023 + GO TO 46410 03240023 +36410 IVDELE = IVDELE + 1 03250023 + WRITE (I02,80003) IVTNUM 03260023 + IF (ICZERO) 46410, 6421, 46410 03270023 +46410 IF ( IVCOMP - 512 ) 26410, 16410, 26410 03280023 +16410 IVPASS = IVPASS + 1 03290023 + WRITE (I02,80001) IVTNUM 03300023 + GO TO 6421 03310023 +26410 IVFAIL = IVFAIL + 1 03320023 + IVCORR = 512 03330023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03340023 + 6421 CONTINUE 03350023 + IVTNUM = 642 03360023 +C 03370023 +C **** TEST 642 **** 03380023 +C TEST 642 - TEST OF FOUR INTEGER VARIABLES THAT ARE EQUIVALENCED.03390023 +C ONE OF THE INTEGER VARIABLES IS IN BLANK COMMON. THE VALUE USED 03400023 +C IS 3 SET BY AN ASSIGNMENT STATEMENT. 03410023 +C 03420023 + IF (ICZERO) 36420, 6420, 36420 03430023 + 6420 CONTINUE 03440023 + ICOE03 = 3 03450023 + IVCOMP = ICOE01 03460023 + GO TO 46420 03470023 +36420 IVDELE = IVDELE + 1 03480023 + WRITE (I02,80003) IVTNUM 03490023 + IF (ICZERO) 46420, 6431, 46420 03500023 +46420 IF ( IVCOMP - 3 ) 26420, 16420, 26420 03510023 +16420 IVPASS = IVPASS + 1 03520023 + WRITE (I02,80001) IVTNUM 03530023 + GO TO 6431 03540023 +26420 IVFAIL = IVFAIL + 1 03550023 + IVCORR = 3 03560023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03570023 + 6431 CONTINUE 03580023 + IVTNUM = 643 03590023 +C 03600023 +C **** TEST 643 **** 03610023 +C TEST 643 - LIKE TEST 642 BUT ANOTHER OF THE ELEMENTS IS TESTED 03620023 +C BY AN ARITHMETIC EXPRESSION USING THE EQUIVALENCED ELEMENTS. 03630023 +C THE VALUE OF ALL OF THE ELEMENTS SHOULD INITITIALLY BE 3 SINCE 03640023 +C THEY ALL SHOULD SHARE THE SAME STORAGE LOCATION. ICOE04 = 3+3+3+3 03650023 +C ICOE04 = 12 THEN THE ELEMENT ICOE02 IS TESTED FOR THE VALUE 12. 03660023 +C 03670023 + IF (ICZERO) 36430, 6430, 36430 03680023 + 6430 CONTINUE 03690023 + ICOE01 = 3 03700023 + ICOE04 = ICOE01 + ICOE02 + ICOE03 + ICOE04 03710023 + IVCOMP = ICOE02 03720023 + GO TO 46430 03730023 +36430 IVDELE = IVDELE + 1 03740023 + WRITE (I02,80003) IVTNUM 03750023 + IF (ICZERO) 46430, 6441, 46430 03760023 +46430 IF ( IVCOMP - 12 ) 26430, 16430, 26430 03770023 +16430 IVPASS = IVPASS + 1 03780023 + WRITE (I02,80001) IVTNUM 03790023 + GO TO 6441 03800023 +26430 IVFAIL = IVFAIL + 1 03810023 + IVCORR = 12 03820023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03830023 + 6441 CONTINUE 03840023 + IVTNUM = 644 03850023 +C 03860023 +C **** TEST 644 **** 03870023 +C TEST 644 - TEST OF EQUIVALENCE WITH THREE REAL VARIABLES ONE 03880023 +C OF WHICH IS IN BLANK COMMON. THE ELEMENTS ARE SET INITIALLY TO .503890023 +C THEN ALL OF THE ELEMENTS ARE USED IN AN ARITHMETIC EXPRESSION 03900023 +C RCOE01 =(.5 + .5 + .5) * 2. SO RCOE01 = 3. ELEMENT RCOE02 03910023 +C IS TESTED FOR THE VALUE 3. 03920023 +C 03930023 + IF (ICZERO) 36440, 6440, 36440 03940023 + 6440 CONTINUE 03950023 + RCOE02 = 0.5 03960023 + RCOE01 = ( RCOE01 + RCOE02 + RCOE03 ) * 2. 03970023 + IVCOMP = RCOE02 03980023 + GO TO 46440 03990023 +36440 IVDELE = IVDELE + 1 04000023 + WRITE (I02,80003) IVTNUM 04010023 + IF (ICZERO) 46440, 6451, 46440 04020023 +46440 IF ( IVCOMP - 3 ) 26440, 16440, 26440 04030023 +16440 IVPASS = IVPASS + 1 04040023 + WRITE (I02,80001) IVTNUM 04050023 + GO TO 6451 04060023 +26440 IVFAIL = IVFAIL + 1 04070023 + IVCORR = 3 04080023 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04090023 + 6451 CONTINUE 04100023 +C 04110023 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 04120023 +99999 CONTINUE 04130023 + WRITE (I02,90002) 04140023 + WRITE (I02,90006) 04150023 + WRITE (I02,90002) 04160023 + WRITE (I02,90002) 04170023 + WRITE (I02,90007) 04180023 + WRITE (I02,90002) 04190023 + WRITE (I02,90008) IVFAIL 04200023 + WRITE (I02,90009) IVPASS 04210023 + WRITE (I02,90010) IVDELE 04220023 +C 04230023 +C 04240023 +C TERMINATE ROUTINE EXECUTION 04250023 + STOP 04260023 +C 04270023 +C FORMAT STATEMENTS FOR PAGE HEADERS 04280023 +90000 FORMAT ("1") 04290023 +90002 FORMAT (" ") 04300023 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04310023 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 04320023 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 04330023 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 04340023 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 04350023 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 04360023 +C 04370023 +C FORMAT STATEMENTS FOR RUN SUMMARIES 04380023 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 04390023 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 04400023 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 04410023 +C 04420023 +C FORMAT STATEMENTS FOR TEST RESULTS 04430023 +80001 FORMAT (" ",4X,I5,7X,"PASS") 04440023 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 04450023 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 04460023 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 04470023 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 04480023 +C 04490023 +90007 FORMAT (" ",20X,"END OF PROGRAM FM023" ) 04500023 + END 04510023 diff --git a/Fortran/UnitTests/fcvs21_f95/FM023.reference_output b/Fortran/UnitTests/fcvs21_f95/FM023.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM023.reference_output @@ -0,0 +1,37 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 632 PASS + 633 PASS + 634 PASS + 635 PASS + 636 PASS + 637 PASS + 638 PASS + 639 PASS + 640 PASS + 641 PASS + 642 PASS + 643 PASS + 644 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM023 + + 0 ERRORS ENCOUNTERED + 13 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM024.f b/Fortran/UnitTests/fcvs21_f95/FM024.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM024.f @@ -0,0 +1,362 @@ + PROGRAM FM024 + +C COMMENT SECTION. 00010024 +C 00020024 +C FM024 00030024 +C 00040024 +C THREE DIMENSIONED ARRAYS ARE USED IN THIS ROUTINE. 00050024 +C THIS ROUTINE TESTS ARRAYS WITH FIXED DIMENSION AND SIZE LIMITS00060024 +C SET EITHER IN A BLANK COMMON OR DIMENSION STATEMENT. THE VALUES 00070024 +C OF THE ARRAY ELEMENTS ARE SET IN VARIOUS WAYS SUCH AS SIMPLE 00080024 +C ASSIGNMENT STATEMENTS, SET TO THE VALUES OF OTHER ARRAY ELEMENTS 00090024 +C (EITHER POSITIVE OR NEGATIVE), SET BY INTEGER TO REAL OR REAL TO 00100024 +C INTEGER CONVERSION, SET BY ARITHMETIC EXPRESSIONS, OR SET BY 00110024 +C USE OF THE EQUIVALENCE STATEMENT. 00120024 +C 00130024 +C 00140024 +C REFERENCES 00150024 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160024 +C X3.9-1978 00170024 +C 00180024 +C SECTION 8, SPECIFICATION STATEMENTS 00190024 +C SECTION 8.1, DIMENSION STATEMENT 00200024 +C SECTION 8.2, EQUIVALENCE STATEMENT 00210024 +C SECTION 8.3, COMMON STATEMENT 00220024 +C SECTION 8.4, TYPE-STATEMENTS 00230024 +C SECTION 9, DATA STATEMENT 00240024 +C 00250024 + COMMON ICOE01, RCOE01, LCOE01 00260024 + COMMON IADE31(3,3,3), RADE31(3,3,3), LADE31(3,3,3) 00270024 + COMMON IADN31(2,2,2), RADN31(2,2,2), LADN31(2,2,2) 00280024 +C 00290024 + DIMENSION IADE32(3,3,3), RADE32(3,3,3), LADE32(3,3,3) 00300024 + DIMENSION IADN32(2,2,2), IADN21(2,2), IADN11(2) 00310024 + DIMENSION IADE21(2,2), IADE11(4) 00320024 +C 00330024 + EQUIVALENCE (IADE31(1,1,1), IADE32(1,1,1) ) 00340024 + EQUIVALENCE ( RADE31(1,1,1), RADE32(1,1,1) ) 00350024 + EQUIVALENCE ( LADE31(1,1,1), LADE32(1,1,1) ) 00360024 + EQUIVALENCE ( IADE31(1,1,1), IADE21(1,1), IADE11(1) ) 00370024 + EQUIVALENCE ( ICOE01, ICOE02, ICOE03 ) 00380024 +C 00390024 + LOGICAL LADE31, LADN31, LADE32, LCOE01 00400024 + INTEGER RADN33(2,2,2), RADN21(2,4), RADN11(8) 00410024 + REAL IADN33(2,2,2), IADN22(2,4), IADN12(8) 00420024 +C 00430024 +C 00440024 +C ********************************************************** 00450024 +C 00460024 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00470024 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00480024 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00490024 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00500024 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00510024 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00520024 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00530024 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00540024 +C OF EXECUTING THESE TESTS. 00550024 +C 00560024 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00570024 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00580024 +C 00590024 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00600024 +C 00610024 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00620024 +C SOFTWARE STANDARDS VALIDATION GROUP 00630024 +C BUILDING 225 RM A266 00640024 +C GAITHERSBURG, MD 20899 00650024 +C ********************************************************** 00660024 +C 00670024 +C 00680024 +C 00690024 +C INITIALIZATION SECTION 00700024 +C 00710024 +C INITIALIZE CONSTANTS 00720024 +C ************** 00730024 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00740024 + I01 = 5 00750024 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00760024 + I02 = 6 00770024 +C SYSTEM ENVIRONMENT SECTION 00780024 +C 00790024 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00800024 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00810024 +C (UNIT NUMBER FOR CARD READER). 00820024 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00830024 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00840024 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00850024 +C 00860024 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00870024 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00880024 +C (UNIT NUMBER FOR PRINTER). 00890024 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00900024 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00910024 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00920024 +C 00930024 + IVPASS=0 00940024 + IVFAIL=0 00950024 + IVDELE=0 00960024 + ICZERO=0 00970024 +C 00980024 +C WRITE PAGE HEADERS 00990024 + WRITE (I02,90000) 01000024 + WRITE (I02,90001) 01010024 + WRITE (I02,90002) 01020024 + WRITE (I02, 90002) 01030024 + WRITE (I02,90003) 01040024 + WRITE (I02,90002) 01050024 + WRITE (I02,90004) 01060024 + WRITE (I02,90002) 01070024 + WRITE (I02,90011) 01080024 + WRITE (I02,90002) 01090024 + WRITE (I02,90002) 01100024 + WRITE (I02,90005) 01110024 + WRITE (I02,90006) 01120024 + WRITE (I02,90002) 01130024 + IVTNUM = 645 01140024 +C 01150024 +C **** TEST 645 **** 01160024 +C TEST 645 - TESTS SETTING A THREE DIMENSION INTEGER ARRAY ELEMENT01170024 +C BY A SIMPLE INTEGER ASSIGNMENT STATEMENT. 01180024 +C 01190024 + IF (ICZERO) 36450, 6450, 36450 01200024 + 6450 CONTINUE 01210024 + IADN31(2,2,2) = -9999 01220024 + IVCOMP = IADN31(2,2,2) 01230024 + GO TO 46450 01240024 +36450 IVDELE = IVDELE + 1 01250024 + WRITE (I02,80003) IVTNUM 01260024 + IF (ICZERO) 46450, 6461, 46450 01270024 +46450 IF ( IVCOMP + 9999 ) 26450, 16450, 26450 01280024 +16450 IVPASS = IVPASS + 1 01290024 + WRITE (I02,80001) IVTNUM 01300024 + GO TO 6461 01310024 +26450 IVFAIL = IVFAIL + 1 01320024 + IVCORR = -9999 01330024 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01340024 + 6461 CONTINUE 01350024 + IVTNUM = 646 01360024 +C 01370024 +C **** TEST 646 **** 01380024 +C TEST 646 - TESTS SETTING A THREE DIMENSION REAL ARRAY ELEMENT 01390024 +C BY A SIMPLE REAL ASSIGNMENT STATEMENT. 01400024 +C 01410024 + IF (ICZERO) 36460, 6460, 36460 01420024 + 6460 CONTINUE 01430024 + RADN31(1,2,1) = 512. 01440024 + IVCOMP = RADN31(1,2,1) 01450024 + GO TO 46460 01460024 +36460 IVDELE = IVDELE + 1 01470024 + WRITE (I02,80003) IVTNUM 01480024 + IF (ICZERO) 46460, 6471, 46460 01490024 +46460 IF ( IVCOMP - 512 ) 26460, 16460, 26460 01500024 +16460 IVPASS = IVPASS + 1 01510024 + WRITE (I02,80001) IVTNUM 01520024 + GO TO 6471 01530024 +26460 IVFAIL = IVFAIL + 1 01540024 + IVCORR = 512 01550024 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01560024 + 6471 CONTINUE 01570024 + IVTNUM = 647 01580024 +C 01590024 +C **** TEST 647 **** 01600024 +C TEST 647 - TESTS SETTING A THREE DIMENSION LOGICAL ARRAY ELEMENT01610024 +C BY A SIMPLE LOGICAL ASSIGNMENT STATEMENT. 01620024 +C 01630024 + IF (ICZERO) 36470, 6470, 36470 01640024 + 6470 CONTINUE 01650024 + LADN31(1,2,2) = .TRUE. 01660024 + ICON01 = 0 01670024 + IF ( LADN31(1,2,2) ) ICON01 = 1 01680024 + GO TO 46470 01690024 +36470 IVDELE = IVDELE + 1 01700024 + WRITE (I02,80003) IVTNUM 01710024 + IF (ICZERO) 46470, 6481, 46470 01720024 +46470 IF ( ICON01 - 1 ) 26470, 16470, 26470 01730024 +16470 IVPASS = IVPASS + 1 01740024 + WRITE (I02,80001) IVTNUM 01750024 + GO TO 6481 01760024 +26470 IVFAIL = IVFAIL + 1 01770024 + IVCOMP = ICON01 01780024 + IVCORR = 1 01790024 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01800024 + 6481 CONTINUE 01810024 + IVTNUM = 648 01820024 +C 01830024 +C **** TEST 648 **** 01840024 +C TEST 648 - TESTS SETTING A ONE, TWO, AND THREE DIMENSION ARRAY 01850024 +C ELEMENT TO A VALUE IN ARITHMETIC ASSIGNMENT STATEMENTS. ALL THREE01860024 +C ELEMENTS ARE INTEGERS. THE INTEGER ARRAY ELEMENTS ARE THEN USED 01870024 +C IN AN ARITHMETIC STATEMENT AND THE RESULT IS STORED BY INTEGER 01880024 +C TO REAL CONVERSION INTO A THREE DIMENSION REAL ARRAY ELEMENT. 01890024 +C 01900024 + IF (ICZERO) 36480, 6480, 36480 01910024 + 6480 CONTINUE 01920024 + IADN11(2) = 1 01930024 + IADN21(2,2) = 2 01940024 + IADN32(2,2,2) = 3 01950024 + RADN31(2,2,1) = IADN11(2) + IADN21(2,2) + IADN32(2,2,2) 01960024 + IVCOMP = RADN31(2,2,1) 01970024 + GO TO 46480 01980024 +36480 IVDELE = IVDELE + 1 01990024 + WRITE (I02,80003) IVTNUM 02000024 + IF (ICZERO) 46480, 6491, 46480 02010024 +46480 IF ( IVCOMP - 6) 26480, 16480, 26480 02020024 +16480 IVPASS = IVPASS + 1 02030024 + WRITE (I02,80001) IVTNUM 02040024 + GO TO 6491 02050024 +26480 IVFAIL = IVFAIL + 1 02060024 + IVCORR = 6 02070024 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02080024 + 6491 CONTINUE 02090024 + IVTNUM = 649 02100024 +C 02110024 +C **** TEST 649 **** 02120024 +C TEST 649 - TESTS OF ONE, TWO, AND THREE DIMENSION ARRAY ELEMENTS02130024 +C SET EXPLICITLY INTEGER BY THE INTEGER TYPE STATEMENT. ALL ELEMENT02140024 +C VALUES SHOULD BE ZERO FROM REAL TO INTEGER TRUNCATION FROM A VALUE02150024 +C OF 0.5. ALL THREE ELEMENTS ARE USED IN AN ARITHMETIC EXPRESSION. 02160024 +C THE VALUE OF THE SUM OF THE ELEMENTS SHOULD BE ZERO. 02170024 +C 02180024 + IF (ICZERO) 36490, 6490, 36490 02190024 + 6490 CONTINUE 02200024 + RADN11(8) = 0000.50000 02210024 + RADN21(2,4) = .50000 02220024 + RADN33(2,2,2) = 00000.5 02230024 + RADN11(1) = RADN11(8) + RADN21(2,4) + RADN33(2,2,2) 02240024 + IVCOMP = RADN11(1) 02250024 + GO TO 46490 02260024 +36490 IVDELE = IVDELE + 1 02270024 + WRITE (I02,80003) IVTNUM 02280024 + IF (ICZERO) 46490, 6501, 46490 02290024 +46490 IF ( IVCOMP - 0 ) 26490, 16490, 26490 02300024 +16490 IVPASS = IVPASS + 1 02310024 + WRITE (I02,80001) IVTNUM 02320024 + GO TO 6501 02330024 +26490 IVFAIL = IVFAIL + 1 02340024 + IVCORR = 0 02350024 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02360024 + 6501 CONTINUE 02370024 + IVTNUM = 650 02380024 +C 02390024 +C **** TEST 650 **** 02400024 +C TEST 650 - TEST OF THE EQUIVALENCE STATEMENT. A REAL ARRAY 02410024 +C ELEMENT IS SET BY AN ASSIGNMENT STATEMENT. ITS EQUIVALENT ELEMENT02420024 +C IN COMMON IS USED TO SET THE VALUE OF AN INTEGER ARRAY ELEMENT 02430024 +C ALSO IN COMMON. FINALLY THE DIMENSIONED EQUIVALENT INTEGER 02440024 +C ARRAY ELEMENT IS TESTED FOR THE VALUE USED THROUGHOUT 32767. 02450024 +C 02460024 + IF (ICZERO) 36500, 6500, 36500 02470024 + 6500 CONTINUE 02480024 + RADE32(2,2,2) = 32767. 02490024 + IADE31(2,2,2) = RADE31(2,2,2) 02500024 + IVCOMP = IADE32(2,2,2) 02510024 + GO TO 46500 02520024 +36500 IVDELE = IVDELE + 1 02530024 + WRITE (I02,80003) IVTNUM 02540024 + IF (ICZERO) 46500, 6511, 46500 02550024 +46500 IF ( IVCOMP - 32767 ) 26500, 16500, 26500 02560024 +16500 IVPASS = IVPASS + 1 02570024 + WRITE (I02,80001) IVTNUM 02580024 + GO TO 6511 02590024 +26500 IVFAIL = IVFAIL + 1 02600024 + IVCORR = 32767 02610024 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02620024 + 6511 CONTINUE 02630024 + IVTNUM = 651 02640024 +C 02650024 +C **** TEST 651 **** 02660024 +C TEST 651 - THIS IS A TEST OF COMMON AND DIMENSION AS WELL AS A 02670024 +C TEST OF THE EQUIVALENCE STATEMENT USING LOGICAL ARRAY ELEMENTS 02680024 +C BOTH IN COMMON AND DIMENSIONED. A LOGICAL VARIABLE IN COMMON IS 02690024 +C SET TO A VALUE OF .NOT. THE VALUE USED IN THE EQUIVALENCED ARRAY 02700024 +C ELEMENTS WHICH WERE SET IN A LOGICAL ASSIGNMENT STATEMENT. 02710024 +C 02720024 + IF (ICZERO) 36510, 6510, 36510 02730024 + 6510 CONTINUE 02740024 + LADE31(1,2,3) = .FALSE. 02750024 + LCOE01 = .NOT. LADE32(1,2,3) 02760024 + ICON01 = 0 02770024 + IF ( LCOE01 ) ICON01 = 1 02780024 + GO TO 46510 02790024 +36510 IVDELE = IVDELE + 1 02800024 + WRITE (I02,80003) IVTNUM 02810024 + IF (ICZERO) 46510, 6521, 46510 02820024 +46510 IF ( ICON01 - 1 ) 26510, 16510, 26510 02830024 +16510 IVPASS = IVPASS + 1 02840024 + WRITE (I02,80001) IVTNUM 02850024 + GO TO 6521 02860024 +26510 IVFAIL = IVFAIL + 1 02870024 + IVCOMP = ICON01 02880024 + IVCORR = 1 02890024 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02900024 + 6521 CONTINUE 02910024 + IVTNUM = 652 02920024 +C 02930024 +C **** TEST 652 **** 02940024 +C TEST 652 - TESTS OF ONE, TWO, AND THREE DIMENSION ARRAY ELEMENTS02950024 +C SET EXPLICITLY REAL BY THE REAL TYPE STATEMENT. ALL ELEMENT 02960024 +C VALUES SHOULD BE 0.5 FROM THE REAL ASSIGNMENT STATEMENT. THE 02970024 +C ARRAY ELEMENTS ARE SUMMED AND THEN THE SUM MULTIPLIED BY 2. 02980024 +C FINALLY 0.2 IS ADDED TO THE RESULT AND THE FINAL RESULT CONVERTED 02990024 +C TO AN INTEGER ( ( .5 + .5 + .5 ) * 2. ) + 0.2 03000024 +C 03010024 + IF (ICZERO) 36520, 6520, 36520 03020024 + 6520 CONTINUE 03030024 + IADN12(5) = 0.5 03040024 + IADN22(1,3) = 0.5 03050024 + IADN33(1,2,2) = 0.5 03060024 + IVCOMP = ( ( IADN12(5) + IADN22(1,3) + IADN33(1,2,2) ) * 2. ) + .203070024 + GO TO 46520 03080024 +36520 IVDELE = IVDELE + 1 03090024 + WRITE (I02,80003) IVTNUM 03100024 + IF (ICZERO) 46520, 6531, 46520 03110024 +46520 IF ( IVCOMP - 3 ) 26520, 16520, 26520 03120024 +16520 IVPASS = IVPASS + 1 03130024 + WRITE (I02,80001) IVTNUM 03140024 + GO TO 6531 03150024 +26520 IVFAIL = IVFAIL + 1 03160024 + IVCORR = 3 03170024 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03180024 + 6531 CONTINUE 03190024 +C 03200024 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03210024 +99999 CONTINUE 03220024 + WRITE (I02,90002) 03230024 + WRITE (I02,90006) 03240024 + WRITE (I02,90002) 03250024 + WRITE (I02,90002) 03260024 + WRITE (I02,90007) 03270024 + WRITE (I02,90002) 03280024 + WRITE (I02,90008) IVFAIL 03290024 + WRITE (I02,90009) IVPASS 03300024 + WRITE (I02,90010) IVDELE 03310024 +C 03320024 +C 03330024 +C TERMINATE ROUTINE EXECUTION 03340024 + STOP 03350024 +C 03360024 +C FORMAT STATEMENTS FOR PAGE HEADERS 03370024 +90000 FORMAT ("1") 03380024 +90002 FORMAT (" ") 03390024 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03400024 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03410024 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03420024 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03430024 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03440024 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03450024 +C 03460024 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03470024 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03480024 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03490024 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03500024 +C 03510024 +C FORMAT STATEMENTS FOR TEST RESULTS 03520024 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03530024 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03540024 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03550024 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03560024 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03570024 +C 03580024 +90007 FORMAT (" ",20X,"END OF PROGRAM FM024" ) 03590024 + END 03600024 diff --git a/Fortran/UnitTests/fcvs21_f95/FM024.reference_output b/Fortran/UnitTests/fcvs21_f95/FM024.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM024.reference_output @@ -0,0 +1,32 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 645 PASS + 646 PASS + 647 PASS + 648 PASS + 649 PASS + 650 PASS + 651 PASS + 652 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM024 + + 0 ERRORS ENCOUNTERED + 8 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM025.f b/Fortran/UnitTests/fcvs21_f95/FM025.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM025.f @@ -0,0 +1,439 @@ + PROGRAM FM025 + +C COMMENT SECTION. 00010025 +C 00020025 +C FM025 00030025 +C 00040025 +C THIS ROUTINE TESTS ARRAYS WITH IF STATEMENTS, DO LOOPS, 00050025 +C ASSIGNED AND COMPUTED GO TO STATEMENTS IN CONJUNCTION WITH ARRAY 00060025 +C ELEMENTS IN COMMON OR DIMENSIONED. ONE, TWO, AND THREE 00070025 +C DIMENSIONED ARRAYS ARE USED. THE SUBSCRIPTS ARE INTEGER CONSTANTS00080025 +C OR SOMETIMES INTEGER VARIABLES WHEN THE ELEMENTS ARE IN LOOPS 00090025 +C AND ALL ARRAYS HAVE FIXED SIZE LIMITS. INTEGER, REAL, AND LOGICAL00100025 +C ARRAYS ARE USED WITH THE TYPE SOMETIMES SPECIFIED WITH THE 00110025 +C EXPLICIT TYPE STATEMENT. 00120025 +C 00130025 +C REFERENCES 00140025 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150025 +C X3.9-1978 00160025 +C 00170025 +C SECTION 8, SPECIFICATION STATEMENTS 00180025 +C SECTION 8.1, DIMENSION STATEMENT 00190025 +C SECTION 8.3, COMMON STATEMENT 00200025 +C SECTION 8.4, TYPE-STATEMENTS 00210025 +C SECTION 9, DATA STATEMENT 00220025 +C SECTION 11.2, COMPUTED GO TO STATEMENT 00230025 +C SECTION 11.3, ASSIGNED GO TO STATEMENT 00240025 +C SECTION 11.10, DO STATEMENT 00250025 +C 00260025 + COMMON IADN31(2,2,2), RADN31(2,2,2), LADN31(2,2,2) 00270025 +C 00280025 + DIMENSION IADN32(2,2,2), IADN21(2,2), IADN11(2) 00290025 +C 00300025 + LOGICAL LADN31 00310025 + INTEGER RADN33(2,2,2), RADN21(2,4), RADN11(8) 00320025 + REAL IADN33(2,2,2), IADN22(2,4), IADN12(8) 00330025 +C 00340025 +C 00350025 +C ********************************************************** 00360025 +C 00370025 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00380025 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00390025 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00400025 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00410025 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00420025 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00430025 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00440025 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00450025 +C OF EXECUTING THESE TESTS. 00460025 +C 00470025 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00480025 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00490025 +C 00500025 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00510025 +C 00520025 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00530025 +C SOFTWARE STANDARDS VALIDATION GROUP 00540025 +C BUILDING 225 RM A266 00550025 +C GAITHERSBURG, MD 20899 00560025 +C ********************************************************** 00570025 +C 00580025 +C 00590025 +C 00600025 +C INITIALIZATION SECTION 00610025 +C 00620025 +C INITIALIZE CONSTANTS 00630025 +C ************** 00640025 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650025 + I01 = 5 00660025 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670025 + I02 = 6 00680025 +C SYSTEM ENVIRONMENT SECTION 00690025 +C 00700025 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00710025 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720025 +C (UNIT NUMBER FOR CARD READER). 00730025 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00740025 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00750025 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00760025 +C 00770025 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00780025 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00790025 +C (UNIT NUMBER FOR PRINTER). 00800025 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00810025 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00820025 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00830025 +C 00840025 + IVPASS=0 00850025 + IVFAIL=0 00860025 + IVDELE=0 00870025 + ICZERO=0 00880025 +C 00890025 +C WRITE PAGE HEADERS 00900025 + WRITE (I02,90000) 00910025 + WRITE (I02,90001) 00920025 + WRITE (I02,90002) 00930025 + WRITE (I02, 90002) 00940025 + WRITE (I02,90003) 00950025 + WRITE (I02,90002) 00960025 + WRITE (I02,90004) 00970025 + WRITE (I02,90002) 00980025 + WRITE (I02,90011) 00990025 + WRITE (I02,90002) 01000025 + WRITE (I02,90002) 01010025 + WRITE (I02,90005) 01020025 + WRITE (I02,90006) 01030025 + WRITE (I02,90002) 01040025 + IVTNUM = 653 01050025 +C 01060025 +C **** TEST 653 **** 01070025 +C TEST 653 - TEST OF SETTING ALL VALUES OF AN INTEGER ARRAY 01080025 +C BY THE INTEGER INDEX OF A DO LOOP. THE ARRAY HAS ONE DIMENSION. 01090025 +C 01100025 + IF (ICZERO) 36530, 6530, 36530 01110025 + 6530 CONTINUE 01120025 + DO 6532 I = 1,2,1 01130025 + IADN11(I) = I 01140025 + 6532 CONTINUE 01150025 + IVCOMP = IADN11(1) 01160025 + GO TO 46530 01170025 +36530 IVDELE = IVDELE + 1 01180025 + WRITE (I02,80003) IVTNUM 01190025 + IF (ICZERO) 46530, 6541, 46530 01200025 +46530 IF ( IVCOMP - 1 ) 26530, 16530, 26530 01210025 +16530 IVPASS = IVPASS + 1 01220025 + WRITE (I02,80001) IVTNUM 01230025 + GO TO 6541 01240025 +26530 IVFAIL = IVFAIL + 1 01250025 + IVCORR = 1 01260025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01270025 + 6541 CONTINUE 01280025 + IVTNUM = 654 01290025 +C 01300025 +C **** TEST 654 **** 01310025 +C TEST 654 - SEE TEST 653. THIS TEST CHECKS THE SECOND ELEMENT OF01320025 +C THE INTEGER ARRAY IADN11(2). 01330025 +C 01340025 + IF (ICZERO) 36540, 6540, 36540 01350025 + 6540 CONTINUE 01360025 + IVCOMP = IADN11(2) 01370025 + GO TO 46540 01380025 +36540 IVDELE = IVDELE + 1 01390025 + WRITE (I02,80003) IVTNUM 01400025 + IF (ICZERO) 46540, 6551, 46540 01410025 +46540 IF ( IVCOMP - 2 ) 26540, 16540, 26540 01420025 +16540 IVPASS = IVPASS + 1 01430025 + WRITE (I02,80001) IVTNUM 01440025 + GO TO 6551 01450025 +26540 IVFAIL = IVFAIL + 1 01460025 + IVCORR = 2 01470025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01480025 + 6551 CONTINUE 01490025 + IVTNUM = 655 01500025 +C 01510025 +C **** TEST 655 **** 01520025 +C TEST 655 - TEST OF SETTING THE VALUES OF THE COLUMN OF A TWO 01530025 +C DIMENSION INTEGER ARRAY BY A DO LOOP. THE VALUES FOR THE ELEMENTS01540025 +C IN A COLUMN IS THE NUMBER OF THE COLUMN AS SET BY THE DO LOOP 01550025 +C INDEX. ROW NUMBERS ARE INTEGER CONSTANTS. 01560025 +C THE VALUES FOR THE ELEMENTS ARE AS FOLLOWS 01570025 +C 1 2 01580025 +C 1 2 01590025 +C 01600025 + IF (ICZERO) 36550, 6550, 36550 01610025 + 6550 CONTINUE 01620025 + DO 6552 J = 1, 2 01630025 + IADN21(1,J) = J 01640025 + IADN21(2,J) = J 01650025 + 6552 CONTINUE 01660025 + IVCOMP = IADN21(1,1) 01670025 + GO TO 46550 01680025 +36550 IVDELE = IVDELE + 1 01690025 + WRITE (I02,80003) IVTNUM 01700025 + IF (ICZERO) 46550, 6561, 46550 01710025 +46550 IF ( IVCOMP - 1 ) 26550, 16550, 26550 01720025 +16550 IVPASS = IVPASS + 1 01730025 + WRITE (I02,80001) IVTNUM 01740025 + GO TO 6561 01750025 +26550 IVFAIL = IVFAIL + 1 01760025 + IVCORR = 1 01770025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01780025 + 6561 CONTINUE 01790025 + IVTNUM = 656 01800025 +C 01810025 +C **** TEST 656 **** 01820025 +C TEST 656 - SEE TEST 655. THIS TEST CHECKS THE VALUE OF THE 01830025 +C INTEGER ARRAY IADN21(2,2) 01840025 +C 01850025 + IF (ICZERO) 36560, 6560, 36560 01860025 + 6560 CONTINUE 01870025 + IVCOMP = IADN21(2,2) 01880025 + GO TO 46560 01890025 +36560 IVDELE = IVDELE + 1 01900025 + WRITE (I02,80003) IVTNUM 01910025 + IF (ICZERO) 46560, 6571, 46560 01920025 +46560 IF ( IVCOMP - 2 ) 26560, 16560, 26560 01930025 +16560 IVPASS = IVPASS + 1 01940025 + WRITE (I02,80001) IVTNUM 01950025 + GO TO 6571 01960025 +26560 IVFAIL = IVFAIL + 1 01970025 + IVCORR = 2 01980025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01990025 + 6571 CONTINUE 02000025 + IVTNUM = 657 02010025 +C 02020025 +C **** TEST 657 **** 02030025 +C TEST 657 - THIS TESTS SETTING BOTH THE ROW AND COLUMN SUBSCRIPTS02040025 +C IN A TWO DIMENSION INTEGER ARRAY WITH A DOUBLE NESTED DO LOOP. 02050025 +C THE ELEMENT VALUES ARE SET BY AN INTEGER COUNTER. ELEMENT VALUES 02060025 +C ARE AS FOLLOWS 1 2 02070025 +C 3 4 02080025 +C 02090025 + IF (ICZERO) 36570, 6570, 36570 02100025 + 6570 CONTINUE 02110025 + ICON01 = 0 02120025 + DO 6573 I = 1, 2 02130025 + DO 6572 J = 1, 2 02140025 + ICON01 = ICON01 + 1 02150025 + IADN21(I,J) = ICON01 02160025 + 6572 CONTINUE 02170025 + 6573 CONTINUE 02180025 + IVCOMP = IADN21(1,2) 02190025 + GO TO 46570 02200025 +36570 IVDELE = IVDELE + 1 02210025 + WRITE (I02,80003) IVTNUM 02220025 + IF (ICZERO) 46570, 6581, 46570 02230025 +46570 IF ( IVCOMP - 2 ) 26570, 16570, 26570 02240025 +16570 IVPASS = IVPASS + 1 02250025 + WRITE (I02,80001) IVTNUM 02260025 + GO TO 6581 02270025 +26570 IVFAIL = IVFAIL + 1 02280025 + IVCORR = 2 02290025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02300025 + 6581 CONTINUE 02310025 + IVTNUM = 658 02320025 +C 02330025 +C **** TEST 658 **** 02340025 +C TEST 658 - SEE TEST 657. THIS TEST CHECKS THE VALUE OF ARRAY 02350025 +C ELEMENT IADN21(2,1) = 3 02360025 +C 02370025 + IF (ICZERO) 36580, 6580, 36580 02380025 + 6580 CONTINUE 02390025 + IVCOMP = IADN21(2,1) 02400025 + GO TO 46580 02410025 +36580 IVDELE = IVDELE + 1 02420025 + WRITE (I02,80003) IVTNUM 02430025 + IF (ICZERO) 46580, 6591, 46580 02440025 +46580 IF ( IVCOMP - 3 ) 26580, 16580, 26580 02450025 +16580 IVPASS = IVPASS + 1 02460025 + WRITE (I02,80001) IVTNUM 02470025 + GO TO 6591 02480025 +26580 IVFAIL = IVFAIL + 1 02490025 + IVCORR = 3 02500025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02510025 + 6591 CONTINUE 02520025 + IVTNUM = 659 02530025 +C 02540025 +C **** TEST 659 **** 02550025 +C TEST 659 - THIS TEST USES A TRIPLE NESTED DO LOOP TO SET THE 02560025 +C ELEMENTS IN ALL THREE DIMENSIONS OF AN INTEGER ARRAY THAT IS 02570025 +C DIMENSIONED. THE VALUES FOR THE ELEMENTS ARE AS FOLLOWS 02580025 +C FOR ELEMENT (I,J,K) = I + J + K 02590025 +C SO FOR ELEMENT (1,1,2) = 1 + 1 + 2 = 4 02600025 +C 02610025 + IF (ICZERO) 36590, 6590, 36590 02620025 + 6590 CONTINUE 02630025 + DO 6594 I = 1, 2 02640025 + DO 6593 J = 1, 2 02650025 + DO 6592 K = 1, 2 02660025 + IADN32( I, J, K ) = I + J + K 02670025 + 6592 CONTINUE 02680025 + 6593 CONTINUE 02690025 + 6594 CONTINUE 02700025 + IVCOMP = IADN32(1,1,2) 02710025 + GO TO 46590 02720025 +36590 IVDELE = IVDELE + 1 02730025 + WRITE (I02,80003) IVTNUM 02740025 + IF (ICZERO) 46590, 6601, 46590 02750025 +46590 IF ( IVCOMP - 4 ) 26590, 16590, 26590 02760025 +16590 IVPASS = IVPASS + 1 02770025 + WRITE (I02,80001) IVTNUM 02780025 + GO TO 6601 02790025 +26590 IVFAIL = IVFAIL + 1 02800025 + IVCORR = 4 02810025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02820025 + 6601 CONTINUE 02830025 + IVTNUM = 660 02840025 +C 02850025 +C **** TEST 660 **** 02860025 +C TEST 660 - SEE TEST 659. THIS CHECKS FOR IADN32(2,2,2) = 6 02870025 +C 02880025 + IF (ICZERO) 36600, 6600, 36600 02890025 + 6600 CONTINUE 02900025 + IVCOMP = IADN32(2,2,2) 02910025 + GO TO 46600 02920025 +36600 IVDELE = IVDELE + 1 02930025 + WRITE (I02,80003) IVTNUM 02940025 + IF (ICZERO) 46600, 6611, 46600 02950025 +46600 IF ( IVCOMP - 6 ) 26600, 16600, 26600 02960025 +16600 IVPASS = IVPASS + 1 02970025 + WRITE (I02,80001) IVTNUM 02980025 + GO TO 6611 02990025 +26600 IVFAIL = IVFAIL + 1 03000025 + IVCORR = 6 03010025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03020025 + 6611 CONTINUE 03030025 + IVTNUM = 661 03040025 +C 03050025 +C **** TEST 661 **** 03060025 +C TEST 661 - THIS TEST SETS THE ELEMENTS OF AN INTEGER ARRAY IN 03070025 +C COMMON TO MINUS THE VALUE OF THE INTEGER ARRAY SET IN TEST 659. 03080025 +C ELEMENT IADN32(1,1,2) = 4 SO ELEMENT IADN31(1,1,2) = -4 03090025 +C THE SAME INTEGER ASSIGNMENT STATEMENT IS USED AS THE TERMINATING 03100025 +C STATEMENT FOR ALL THREE DO LOOPS USED TO SET THE ARRAY VALUES 03110025 +C OF INTEGER ARRAY IADN31. 03120025 +C IF TEST 659 FAILS, THEN THIS TEST SHOULD ALSO FAIL. HOWEVER, THE 03130025 +C COMPUTED VALUES SHOULD RELATE IN THAT THE COMPUTED VALUE FOR 03140025 +C TEST 661 SHOULD BE MINUS THE COMPUTED VALUE FOR TEST 659. 03150025 +C 03160025 + IF (ICZERO) 36610, 6610, 36610 03170025 + 6610 CONTINUE 03180025 + DO 6612 I = 1, 2 03190025 + DO 6612 J = 1, 2 03200025 + DO 6612 K = 1, 2 03210025 + 6612 IADN31(I,J,K) = - IADN32 ( I, J, K ) 03220025 + IVCOMP = IADN31(1,1,2) 03230025 + GO TO 46610 03240025 +36610 IVDELE = IVDELE + 1 03250025 + WRITE (I02,80003) IVTNUM 03260025 + IF (ICZERO) 46610, 6621, 46610 03270025 +46610 IF ( IVCOMP + 4 ) 26610, 16610, 26610 03280025 +16610 IVPASS = IVPASS + 1 03290025 + WRITE (I02,80001) IVTNUM 03300025 + GO TO 6621 03310025 +26610 IVFAIL = IVFAIL + 1 03320025 + IVCORR = -4 03330025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03340025 + 6621 CONTINUE 03350025 + IVTNUM = 662 03360025 +C 03370025 +C **** TEST 662 **** 03380025 +C TEST 662 - THIS IS A TEST OF A TRIPLE NESTED DO LOOP USED TO 03390025 +C SET THE VALUES OF A LOGICAL ARRAY LADN31. UNLIKE THE OTHER TESTS 03400025 +C THE THIRD DIMENSION IS SET LAST, THE FIRST DIMENSION IS SET SECOND03410025 +C AND THE SECOND DIMENSION IS SET FIRST. ALL ARRAY ELEMENTS ARE SET03420025 +C TO THE LOGICAL CONSTANT .FALSE. 03430025 +C 03440025 + IF (ICZERO) 36620, 6620, 36620 03450025 + 6620 CONTINUE 03460025 + DO 6622 K = 1, 2 03470025 + DO 6622 I = 1, 2 03480025 + DO 6622 J = 1, 2 03490025 + LADN31( I, J, K ) = .FALSE. 03500025 + 6622 CONTINUE 03510025 + ICON01 = 1 03520025 + IF ( LADN31(2,1,2) ) ICON01 = 0 03530025 + GO TO 46620 03540025 +36620 IVDELE = IVDELE + 1 03550025 + WRITE (I02,80003) IVTNUM 03560025 + IF (ICZERO) 46620, 6631, 46620 03570025 +46620 IF ( ICON01 - 1 ) 26620, 16620, 26620 03580025 +16620 IVPASS = IVPASS + 1 03590025 + WRITE (I02,80001) IVTNUM 03600025 + GO TO 6631 03610025 +26620 IVFAIL = IVFAIL + 1 03620025 + IVCOMP = ICON01 03630025 + IVCORR = 1 03640025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03650025 + 6631 CONTINUE 03660025 + IVTNUM = 665 04030025 +C 04040025 +C **** TEST 665 **** 04050025 +C TEST 665 - ARRAY ELEMENTS SET TO TYPE REAL BY THE EXPLICIT 04060025 +C REAL STATEMENT ARE SET TO THE VALUE 0.5 AND USED TO SET THE VALUE 04070025 +C OF AN ARRAY ELEMENT SET TO TYPE INTEGER BY THE INTEGER STATEMENT. 04080025 +C THIS LAST INTEGER ELEMENT IS USED IN A LOGICAL IF STATEMENT 04090025 +C THAT SHOULD COMPARE TRUE. ( .5 + .5 + .5 ) * 2. .EQ. 3 04100025 +C 04110025 + IF (ICZERO) 36650, 6650, 36650 04120025 + 6650 CONTINUE 04130025 + IADN33(2,2,2) = 0.5 04140025 + IADN22(2,4) = 0.5 04150025 + IADN12(8) = 0.5 04160025 + RADN11(8) = ( IADN33(2,2,2) + IADN22(2,4) + IADN12(8) ) * 2. 04170025 + ICON01 = 0 04180025 + IF ( RADN11(8) .EQ. 3 ) ICON01 = 1 04190025 + GO TO 46650 04200025 +36650 IVDELE = IVDELE + 1 04210025 + WRITE (I02,80003) IVTNUM 04220025 + IF (ICZERO) 46650, 6661, 46650 04230025 +46650 IF ( ICON01 - 1 ) 26650, 16650, 26650 04240025 +16650 IVPASS = IVPASS + 1 04250025 + WRITE (I02,80001) IVTNUM 04260025 + GO TO 6661 04270025 +26650 IVFAIL = IVFAIL + 1 04280025 + IVCOMP = ICON01 04290025 + IVCORR = 1 04300025 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04310025 + 6661 CONTINUE 04320025 +C 04330025 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 04340025 +99999 CONTINUE 04350025 + WRITE (I02,90002) 04360025 + WRITE (I02,90006) 04370025 + WRITE (I02,90002) 04380025 + WRITE (I02,90002) 04390025 + WRITE (I02,90007) 04400025 + WRITE (I02,90002) 04410025 + WRITE (I02,90008) IVFAIL 04420025 + WRITE (I02,90009) IVPASS 04430025 + WRITE (I02,90010) IVDELE 04440025 +C 04450025 +C 04460025 +C TERMINATE ROUTINE EXECUTION 04470025 + STOP 04480025 +C 04490025 +C FORMAT STATEMENTS FOR PAGE HEADERS 04500025 +90000 FORMAT ("1") 04510025 +90002 FORMAT (" ") 04520025 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04530025 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 04540025 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 04550025 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 04560025 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 04570025 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 04580025 +C 04590025 +C FORMAT STATEMENTS FOR RUN SUMMARIES 04600025 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 04610025 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 04620025 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 04630025 +C 04640025 +C FORMAT STATEMENTS FOR TEST RESULTS 04650025 +80001 FORMAT (" ",4X,I5,7X,"PASS") 04660025 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 04670025 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 04680025 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 04690025 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 04700025 +C 04710025 +90007 FORMAT (" ",20X,"END OF PROGRAM FM025" ) 04720025 + END 04730025 diff --git a/Fortran/UnitTests/fcvs21_f95/FM025.reference_output b/Fortran/UnitTests/fcvs21_f95/FM025.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM025.reference_output @@ -0,0 +1,35 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 653 PASS + 654 PASS + 655 PASS + 656 PASS + 657 PASS + 658 PASS + 659 PASS + 660 PASS + 661 PASS + 662 PASS + 665 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM025 + + 0 ERRORS ENCOUNTERED + 11 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM026.f b/Fortran/UnitTests/fcvs21_f95/FM026.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM026.f @@ -0,0 +1,260 @@ + 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 diff --git a/Fortran/UnitTests/fcvs21_f95/FM026.reference_output b/Fortran/UnitTests/fcvs21_f95/FM026.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM026.reference_output @@ -0,0 +1,28 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 666 PASS + 667 PASS + 668 PASS + 669 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM026 + + 0 ERRORS ENCOUNTERED + 4 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM028.f b/Fortran/UnitTests/fcvs21_f95/FM028.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM028.f @@ -0,0 +1,266 @@ + 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 diff --git a/Fortran/UnitTests/fcvs21_f95/FM028.reference_output b/Fortran/UnitTests/fcvs21_f95/FM028.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM028.reference_output @@ -0,0 +1,28 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 670 PASS + 671 PASS + 672 PASS + 673 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM028 + + 0 ERRORS ENCOUNTERED + 4 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM030.f b/Fortran/UnitTests/fcvs21_f95/FM030.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM030.f @@ -0,0 +1,849 @@ + PROGRAM FM030 + +C COMMENT SECTION. 00010030 +C 00020030 +C FM030 00030030 +C 00040030 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050030 +C FORM 00060030 +C INTEGER VARIABLE = ARITHMETIC EXPRESSION 00070030 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00080030 +C OPERATOR -, INTEGER CONSTANTS AND INTEGER VARIABLES. 00090030 +C SOME OF THE TESTS USE PARENTHESES TO GROUP ELEMENTS IN THE 00100030 +C ARITHMETIC EXPRESSION. 00110030 +C 00120030 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00130030 +C (1) INTEGER CONSTANT - INTEGER CONSTANT 00140030 +C (2) INTEGER CONSTANT - INTEGER CONSTANT - INTEGER CONSTANT00150030 +C (3) SAME AS (2) BUT WITH PARENTHESES TO GROUP ELEMENTS 00160030 +C (4) INTEGER VARIABLE - INTEGER CONSTANT 00170030 +C INTEGER CONSTANT - INTEGER VARIABLE 00180030 +C 00190030 +C REFERENCES 00200030 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00210030 +C X3.9-1978 00220030 +C 00230030 +C SECTION 4.3, INTEGER TYPE 00240030 +C SECTION 4.3.1, INTEGER CONSTANT 00250030 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00260030 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00270030 +C 00280030 +C 00290030 +C ********************************************************** 00300030 +C 00310030 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00320030 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00330030 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00340030 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00350030 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00360030 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00370030 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00380030 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00390030 +C OF EXECUTING THESE TESTS. 00400030 +C 00410030 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00420030 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00430030 +C 00440030 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00450030 +C 00460030 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00470030 +C SOFTWARE STANDARDS VALIDATION GROUP 00480030 +C BUILDING 225 RM A266 00490030 +C GAITHERSBURG, MD 20899 00500030 +C ********************************************************** 00510030 +C 00520030 +C 00530030 +C 00540030 +C INITIALIZATION SECTION 00550030 +C 00560030 +C INITIALIZE CONSTANTS 00570030 +C ************** 00580030 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00590030 + I01 = 5 00600030 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00610030 + I02 = 6 00620030 +C SYSTEM ENVIRONMENT SECTION 00630030 +C 00640030 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00650030 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00660030 +C (UNIT NUMBER FOR CARD READER). 00670030 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00680030 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00690030 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00700030 +C 00710030 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00720030 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00730030 +C (UNIT NUMBER FOR PRINTER). 00740030 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00750030 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00760030 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00770030 +C 00780030 + IVPASS=0 00790030 + IVFAIL=0 00800030 + IVDELE=0 00810030 + ICZERO=0 00820030 +C 00830030 +C WRITE PAGE HEADERS 00840030 + WRITE (I02,90000) 00850030 + WRITE (I02,90001) 00860030 + WRITE (I02,90002) 00870030 + WRITE (I02, 90002) 00880030 + WRITE (I02,90003) 00890030 + WRITE (I02,90002) 00900030 + WRITE (I02,90004) 00910030 + WRITE (I02,90002) 00920030 + WRITE (I02,90011) 00930030 + WRITE (I02,90002) 00940030 + WRITE (I02,90002) 00950030 + WRITE (I02,90005) 00960030 + WRITE (I02,90006) 00970030 + WRITE (I02,90002) 00980030 +C TEST SECTION 00990030 +C 01000030 +C ARITHMETIC ASSIGNMENT STATEMENT 01010030 +C 01020030 +C TEST 265 THROUGH TEST 270 CONTAIN TWO INTEGER CONSTANTS AND 01030030 +C OPERATOR - IN AN ARITHMETIC EXPRESSION. THE FORM TESTED IS 01040030 +C INTEGER VARIABLE = INTEGER CONSTANT - INTEGER CONSTANT 01050030 +C 01060030 + 2651 CONTINUE 01070030 + IVTNUM = 265 01080030 +C 01090030 +C **** TEST 265 **** 01100030 +C 01110030 + IF (ICZERO) 32650, 2650, 32650 01120030 + 2650 CONTINUE 01130030 + IVCOMP = 3-2 01140030 + GO TO 42650 01150030 +32650 IVDELE = IVDELE + 1 01160030 + WRITE (I02,80003) IVTNUM 01170030 + IF (ICZERO) 42650, 2661, 42650 01180030 +42650 IF (IVCOMP - 1) 22650,12650,22650 01190030 +12650 IVPASS = IVPASS + 1 01200030 + WRITE (I02,80001) IVTNUM 01210030 + GO TO 2661 01220030 +22650 IVFAIL = IVFAIL + 1 01230030 + IVCORR = 1 01240030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01250030 + 2661 CONTINUE 01260030 + IVTNUM = 266 01270030 +C 01280030 +C **** TEST 266 **** 01290030 +C 01300030 + IF (ICZERO) 32660, 2660, 32660 01310030 + 2660 CONTINUE 01320030 + IVCOMP = 51 - 52 01330030 + GO TO 42660 01340030 +32660 IVDELE = IVDELE + 1 01350030 + WRITE (I02,80003) IVTNUM 01360030 + IF (ICZERO) 42660, 2671, 42660 01370030 +42660 IF (IVCOMP +1) 22660,12660,22660 01380030 +12660 IVPASS = IVPASS + 1 01390030 + WRITE (I02,80001) IVTNUM 01400030 + GO TO 2671 01410030 +22660 IVFAIL = IVFAIL + 1 01420030 + IVCORR = -1 01430030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01440030 + 2671 CONTINUE 01450030 + IVTNUM = 267 01460030 +C 01470030 +C **** TEST 267 *** 01480030 +C 01490030 + IF (ICZERO) 32670, 2670, 32670 01500030 + 2670 CONTINUE 01510030 + IVCOMP = 865 - 189 01520030 + GO TO 42670 01530030 +32670 IVDELE = IVDELE + 1 01540030 + WRITE (I02,80003) IVTNUM 01550030 + IF (ICZERO) 42670, 2681, 42670 01560030 +42670 IF (IVCOMP -676) 22670,12670,22670 01570030 +12670 IVPASS = IVPASS + 1 01580030 + WRITE (I02,80001) IVTNUM 01590030 + GO TO 2681 01600030 +22670 IVFAIL = IVFAIL + 1 01610030 + IVCORR = 676 01620030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01630030 + 2681 CONTINUE 01640030 + IVTNUM = 268 01650030 +C 01660030 +C **** TEST 268 **** 01670030 +C 01680030 + IF (ICZERO) 32680, 2680, 32680 01690030 + 2680 CONTINUE 01700030 + IVCOMP =1358-9359 01710030 + GO TO 42680 01720030 +32680 IVDELE = IVDELE + 1 01730030 + WRITE (I02,80003) IVTNUM 01740030 + IF (ICZERO) 42680, 2691, 42680 01750030 +42680 IF (IVCOMP+8001) 22680,12680,22680 01760030 +12680 IVPASS = IVPASS + 1 01770030 + WRITE (I02,80001) IVTNUM 01780030 + GO TO 2691 01790030 +22680 IVFAIL = IVFAIL + 1 01800030 + IVCORR = -8001 01810030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01820030 + 2691 CONTINUE 01830030 + IVTNUM = 269 01840030 +C 01850030 +C **** TEST 269 **** 01860030 +C 01870030 + IF (ICZERO) 32690, 2690, 32690 01880030 + 2690 CONTINUE 01890030 + IVCOMP =21113-10001 01900030 + GO TO 42690 01910030 +32690 IVDELE = IVDELE + 1 01920030 + WRITE (I02,80003) IVTNUM 01930030 + IF (ICZERO) 42690, 2701, 42690 01940030 +42690 IF (IVCOMP-11112) 22690,12690,22690 01950030 +12690 IVPASS = IVPASS + 1 01960030 + WRITE (I02,80001) IVTNUM 01970030 + GO TO 2701 01980030 +22690 IVFAIL = IVFAIL + 1 01990030 + IVCORR=11112 02000030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02010030 + 2701 CONTINUE 02020030 + IVTNUM = 270 02030030 +C 02040030 +C **** TEST 270 **** 02050030 +C 02060030 + IF (ICZERO) 32700, 2700, 32700 02070030 + 2700 CONTINUE 02080030 + IVCOMP = 32767-1 02090030 + GO TO 42700 02100030 +32700 IVDELE = IVDELE + 1 02110030 + WRITE (I02,80003) IVTNUM 02120030 + IF (ICZERO) 42700, 2711, 42700 02130030 +42700 IF (IVCOMP -32766) 22700,12700,22700 02140030 +12700 IVPASS = IVPASS + 1 02150030 + WRITE (I02,80001) IVTNUM 02160030 + GO TO 2711 02170030 +22700 IVFAIL = IVFAIL + 1 02180030 + IVCORR = 32766 02190030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02200030 +C 02210030 +C TEST 271 THROUGH TEST 274 CONTAIN THREE INTEGER CONSTANTS 02220030 +C AND OPERATOR - IN AN ARITHMETIC EXPRESSION. THE FORM TESTED IS 02230030 +C IV = IC - IC - IC 02240030 +C 02250030 + 2711 CONTINUE 02260030 + IVTNUM = 271 02270030 +C 02280030 +C **** TEST 271 **** 02290030 +C 02300030 + IF (ICZERO) 32710, 2710, 32710 02310030 + 2710 CONTINUE 02320030 + IVCOMP=9-4-3 02330030 + GO TO 42710 02340030 +32710 IVDELE = IVDELE + 1 02350030 + WRITE (I02,80003) IVTNUM 02360030 + IF (ICZERO) 42710, 2721, 42710 02370030 +42710 IF (IVCOMP -2) 22710,12710,22710 02380030 +12710 IVPASS = IVPASS + 1 02390030 + WRITE (I02,80001) IVTNUM 02400030 + GO TO 2721 02410030 +22710 IVFAIL = IVFAIL + 1 02420030 + IVCORR =2 02430030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02440030 + 2721 CONTINUE 02450030 + IVTNUM = 272 02460030 +C 02470030 +C **** TEST 272 **** 02480030 +C 02490030 + IF (ICZERO) 32720, 2720, 32720 02500030 + 2720 CONTINUE 02510030 + IVCOMP = 51-52-53 02520030 + GO TO 42720 02530030 +32720 IVDELE = IVDELE + 1 02540030 + WRITE (I02,80003) IVTNUM 02550030 + IF (ICZERO) 42720, 2731, 42720 02560030 +42720 IF (IVCOMP +54) 22720,12720,22720 02570030 +12720 IVPASS = IVPASS + 1 02580030 + WRITE (I02,80001) IVTNUM 02590030 + GO TO 2731 02600030 +22720 IVFAIL = IVFAIL + 1 02610030 + IVCORR = -54 02620030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02630030 + 2731 CONTINUE 02640030 + IVTNUM = 273 02650030 +C 02660030 +C **** TEST 273 **** 02670030 +C 02680030 + IF (ICZERO) 32730, 2730, 32730 02690030 + 2730 CONTINUE 02700030 + IVCOMP = 966 -676 -189 02710030 + GO TO 42730 02720030 +32730 IVDELE = IVDELE + 1 02730030 + WRITE (I02,80003) IVTNUM 02740030 + IF (ICZERO) 42730, 2741, 42730 02750030 +42730 IF (IVCOMP -101) 22730,12730,22730 02760030 +12730 IVPASS = IVPASS + 1 02770030 + WRITE (I02,80001) IVTNUM 02780030 + GO TO 2741 02790030 +22730 IVFAIL = IVFAIL + 1 02800030 + IVCORR = 101 02810030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02820030 + 2741 CONTINUE 02830030 + IVTNUM = 274 02840030 +C 02850030 +C **** TEST 274 **** 02860030 +C 02870030 + IF (ICZERO) 32740, 2740, 32740 02880030 + 2740 CONTINUE 02890030 + IVCOMP = 1358-8001-2188 02900030 + GO TO 42740 02910030 +32740 IVDELE = IVDELE + 1 02920030 + WRITE (I02,80003) IVTNUM 02930030 + IF (ICZERO) 42740, 2751, 42740 02940030 +42740 IF (IVCOMP + 8831) 22740,12740,22740 02950030 +12740 IVPASS = IVPASS + 1 02960030 + WRITE (I02,80001) IVTNUM 02970030 + GO TO 2751 02980030 +22740 IVFAIL = IVFAIL + 1 02990030 + IVCORR = -8831 03000030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03010030 +C 03020030 +C TEST 275 THROUGH TEST 282 ARE THE SAME AS TESTS 271-274 EXCEPT 03030030 +C PARENTHESES ARE USED TO GROUP THE CONSTANTS. 03040030 +C 03050030 + 2751 CONTINUE 03060030 + IVTNUM = 275 03070030 +C 03080030 +C **** TEST 275 **** 03090030 +C 03100030 + IF (ICZERO) 32750, 2750, 32750 03110030 + 2750 CONTINUE 03120030 + IVCOMP =(9-4)-3 03130030 + GO TO 42750 03140030 +32750 IVDELE = IVDELE + 1 03150030 + WRITE (I02,80003) IVTNUM 03160030 + IF (ICZERO) 42750, 2761, 42750 03170030 +42750 IF (IVCOMP -2) 22750,12750,22750 03180030 +12750 IVPASS = IVPASS + 1 03190030 + WRITE (I02,80001) IVTNUM 03200030 + GO TO 2761 03210030 +22750 IVFAIL = IVFAIL + 1 03220030 + IVCORR = 2 03230030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03240030 + 2761 CONTINUE 03250030 + IVTNUM = 276 03260030 +C 03270030 +C **** TEST 276 **** 03280030 +C 03290030 + IF (ICZERO) 32760, 2760, 32760 03300030 + 2760 CONTINUE 03310030 + IVCOMP =9-(4-3) 03320030 + GO TO 42760 03330030 +32760 IVDELE = IVDELE + 1 03340030 + WRITE (I02,80003) IVTNUM 03350030 + IF (ICZERO) 42760, 2771, 42760 03360030 +42760 IF (IVCOMP -8) 22760,12760,22760 03370030 +12760 IVPASS = IVPASS + 1 03380030 + WRITE (I02,80001) IVTNUM 03390030 + GO TO 2771 03400030 +22760 IVFAIL = IVFAIL + 1 03410030 + IVCORR =8 03420030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03430030 + 2771 CONTINUE 03440030 + IVTNUM = 277 03450030 +C 03460030 +C **** TEST 277 **** 03470030 +C 03480030 + IF (ICZERO) 32770, 2770, 32770 03490030 + 2770 CONTINUE 03500030 + IVCOMP =(51-52)-53 03510030 + GO TO 42770 03520030 +32770 IVDELE = IVDELE + 1 03530030 + WRITE (I02,80003) IVTNUM 03540030 + IF (ICZERO) 42770, 2781, 42770 03550030 +42770 IF (IVCOMP +54) 22770,12770,22770 03560030 +12770 IVPASS = IVPASS + 1 03570030 + WRITE (I02,80001) IVTNUM 03580030 + GO TO 2781 03590030 +22770 IVFAIL = IVFAIL + 1 03600030 + IVCORR = -54 03610030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03620030 + 2781 CONTINUE 03630030 + IVTNUM = 278 03640030 +C 03650030 +C **** TEST 278 **** 03660030 +C 03670030 + IF (ICZERO) 32780, 2780, 32780 03680030 + 2780 CONTINUE 03690030 + IVCOMP=51-(52-53) 03700030 + GO TO 42780 03710030 +32780 IVDELE = IVDELE + 1 03720030 + WRITE (I02,80003) IVTNUM 03730030 + IF (ICZERO) 42780, 2791, 42780 03740030 +42780 IF (IVCOMP-52) 22780,12780,22780 03750030 +12780 IVPASS = IVPASS + 1 03760030 + WRITE (I02,80001) IVTNUM 03770030 + GO TO 2791 03780030 +22780 IVFAIL = IVFAIL + 1 03790030 + IVCORR = 52 03800030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03810030 + 2791 CONTINUE 03820030 + IVTNUM = 279 03830030 +C 03840030 +C **** TEST 279 **** 03850030 +C 03860030 + IF (ICZERO) 32790, 2790, 32790 03870030 + 2790 CONTINUE 03880030 + IVCOMP =(966-676)-189 03890030 + GO TO 42790 03900030 +32790 IVDELE = IVDELE + 1 03910030 + WRITE (I02,80003) IVTNUM 03920030 + IF (ICZERO) 42790, 2801, 42790 03930030 +42790 IF (IVCOMP - 101) 22790,12790,22790 03940030 +12790 IVPASS = IVPASS + 1 03950030 + WRITE (I02,80001) IVTNUM 03960030 + GO TO 2801 03970030 +22790 IVFAIL = IVFAIL + 1 03980030 + IVCORR = 101 03990030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04000030 + 2801 CONTINUE 04010030 + IVTNUM = 280 04020030 +C 04030030 +C **** TEST 280 **** 04040030 +C 04050030 + IF (ICZERO) 32800, 2800, 32800 04060030 + 2800 CONTINUE 04070030 + IVCOMP =966-(676-189) 04080030 + GO TO 42800 04090030 +32800 IVDELE = IVDELE + 1 04100030 + WRITE (I02,80003) IVTNUM 04110030 + IF (ICZERO) 42800, 2811, 42800 04120030 +42800 IF (IVCOMP - 479) 22800,12800,22800 04130030 +12800 IVPASS = IVPASS + 1 04140030 + WRITE (I02,80001) IVTNUM 04150030 + GO TO 2811 04160030 +22800 IVFAIL = IVFAIL + 1 04170030 + IVCORR = 479 04180030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04190030 + 2811 CONTINUE 04200030 + IVTNUM = 281 04210030 +C 04220030 +C **** TEST 281 **** 04230030 +C 04240030 + IF (ICZERO) 32810, 2810, 32810 04250030 + 2810 CONTINUE 04260030 + IVCOMP = (1358-8001)-2188 04270030 + GO TO 42810 04280030 +32810 IVDELE = IVDELE + 1 04290030 + WRITE (I02,80003) IVTNUM 04300030 + IF (ICZERO) 42810, 2821, 42810 04310030 +42810 IF (IVCOMP + 8831) 22810,12810,22810 04320030 +12810 IVPASS = IVPASS + 1 04330030 + WRITE (I02,80001) IVTNUM 04340030 + GO TO 2821 04350030 +22810 IVFAIL = IVFAIL + 1 04360030 + IVCORR = -8831 04370030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04380030 + 2821 CONTINUE 04390030 + IVTNUM = 282 04400030 +C 04410030 +C **** TEST 282 **** 04420030 +C 04430030 + IF (ICZERO) 32820, 2820, 32820 04440030 + 2820 CONTINUE 04450030 + IVCOMP = 1358-(8001-2188) 04460030 + GO TO 42820 04470030 +32820 IVDELE = IVDELE + 1 04480030 + WRITE (I02,80003) IVTNUM 04490030 + IF (ICZERO) 42820, 2831, 42820 04500030 +42820 IF (IVCOMP + 4455) 22820,12820,22820 04510030 +12820 IVPASS = IVPASS + 1 04520030 + WRITE (I02,80001) IVTNUM 04530030 + GO TO 2831 04540030 +22820 IVFAIL = IVFAIL + 1 04550030 + IVCORR = -4455 04560030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04570030 +C 04580030 +C TEST 283 THROUGH TEST 299 CONTAIN INTEGER VARIABLE, INTEGER 04590030 +C CONSTANT AND OPERATOR - IN ARITHMETIC EXPRESSION. THE INTEGER 04600030 +C VARIABLE CONTAINS BOTH POSITIVE AND NEGATIVE VALUES. 04610030 +C THE FORMS TESTED ARE 04620030 +C INTEGER VARIABLE = INTEGER VARIABLE - INTEGER CONSTANT 04630030 +C INTEGER VARIABLE = INTEGER CONSTANT - INTEGER VARIABLE 04640030 +C 04650030 + 2831 CONTINUE 04660030 + IVTNUM = 283 04670030 +C 04680030 +C **** TEST 283 **** 04690030 +C 04700030 + IF (ICZERO) 32830, 2830, 32830 04710030 + 2830 CONTINUE 04720030 + IVON01 = 3 04730030 + IVCOMP = IVON01 - 2 04740030 + GO TO 42830 04750030 +32830 IVDELE = IVDELE + 1 04760030 + WRITE (I02,80003) IVTNUM 04770030 + IF (ICZERO) 42830, 2841, 42830 04780030 +42830 IF (IVCOMP - 1) 22830,12830,22830 04790030 +12830 IVPASS = IVPASS + 1 04800030 + WRITE (I02,80001) IVTNUM 04810030 + GO TO 2841 04820030 +22830 IVFAIL = IVFAIL + 1 04830030 + IVCORR = 1 04840030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04850030 + 2841 CONTINUE 04860030 + IVTNUM = 284 04870030 +C 04880030 +C **** TEST 284 **** 04890030 +C 04900030 + IF (ICZERO) 32840, 2840, 32840 04910030 + 2840 CONTINUE 04920030 + IVON01 = 2 04930030 + IVCOMP = IVON01 -3 04940030 + GO TO 42840 04950030 +32840 IVDELE = IVDELE + 1 04960030 + WRITE (I02,80003) IVTNUM 04970030 + IF (ICZERO) 42840, 2851, 42840 04980030 +42840 IF (IVCOMP +1) 22840,12840,22840 04990030 +12840 IVPASS = IVPASS + 1 05000030 + WRITE (I02,80001) IVTNUM 05010030 + GO TO 2851 05020030 +22840 IVFAIL = IVFAIL + 1 05030030 + IVCORR = -1 05040030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05050030 + 2851 CONTINUE 05060030 + IVTNUM = 285 05070030 +C 05080030 +C **** TEST 285 **** 05090030 +C 05100030 + IF (ICZERO) 32850, 2850, 32850 05110030 + 2850 CONTINUE 05120030 + IVON01 =-3 05130030 + IVCOMP = IVON01 -2 05140030 + GO TO 42850 05150030 +32850 IVDELE = IVDELE + 1 05160030 + WRITE (I02,80003) IVTNUM 05170030 + IF (ICZERO) 42850, 2861, 42850 05180030 +42850 IF (IVCOMP +5) 22850,12850,22850 05190030 +12850 IVPASS = IVPASS + 1 05200030 + WRITE (I02,80001) IVTNUM 05210030 + GO TO 2861 05220030 +22850 IVFAIL = IVFAIL + 1 05230030 + IVCORR =-5 05240030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05250030 + 2861 CONTINUE 05260030 + IVTNUM = 286 05270030 +C 05280030 +C **** TEST 286 **** 05290030 +C 05300030 + IF (ICZERO) 32860, 2860, 32860 05310030 + 2860 CONTINUE 05320030 + IVON02 =2 05330030 + IVCOMP = 3 - IVON02 05340030 + GO TO 42860 05350030 +32860 IVDELE = IVDELE + 1 05360030 + WRITE (I02,80003) IVTNUM 05370030 + IF (ICZERO) 42860, 2871, 42860 05380030 +42860 IF (IVCOMP -1) 22860,12860,22860 05390030 +12860 IVPASS = IVPASS + 1 05400030 + WRITE (I02,80001) IVTNUM 05410030 + GO TO 2871 05420030 +22860 IVFAIL = IVFAIL + 1 05430030 + IVCORR = 1 05440030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05450030 + 2871 CONTINUE 05460030 + IVTNUM = 287 05470030 +C 05480030 +C **** TEST 287 **** 05490030 +C 05500030 + IF (ICZERO) 32870, 2870, 32870 05510030 + 2870 CONTINUE 05520030 + IVON02 =3 05530030 + IVCOMP = 2 -IVON02 05540030 + GO TO 42870 05550030 +32870 IVDELE = IVDELE + 1 05560030 + WRITE (I02,80003) IVTNUM 05570030 + IF (ICZERO) 42870, 2881, 42870 05580030 +42870 IF (IVCOMP +1) 22870,12870,22870 05590030 +12870 IVPASS = IVPASS + 1 05600030 + WRITE (I02,80001) IVTNUM 05610030 + GO TO 2881 05620030 +22870 IVFAIL = IVFAIL + 1 05630030 + IVCORR =-1 05640030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05650030 + 2881 CONTINUE 05660030 + IVTNUM = 288 05670030 +C 05680030 +C **** TEST 288 **** 05690030 +C 05700030 + IF (ICZERO) 32880, 2880, 32880 05710030 + 2880 CONTINUE 05720030 + IVON02 = -2 05730030 + IVCOMP = 3 - IVON02 05740030 + GO TO 42880 05750030 +32880 IVDELE = IVDELE + 1 05760030 + WRITE (I02,80003) IVTNUM 05770030 + IF (ICZERO) 42880, 2891, 42880 05780030 +42880 IF (IVCOMP -5) 22880,12880,22880 05790030 +12880 IVPASS = IVPASS + 1 05800030 + WRITE (I02,80001) IVTNUM 05810030 + GO TO 2891 05820030 +22880 IVFAIL = IVFAIL + 1 05830030 + IVCORR =5 05840030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05850030 + 2891 CONTINUE 05860030 + IVTNUM = 289 05870030 +C 05880030 +C **** TEST 289 **** 05890030 +C 05900030 + IF (ICZERO) 32890, 2890, 32890 05910030 + 2890 CONTINUE 05920030 + IVON01 =51 05930030 + IVCOMP = IVON01 - 52 05940030 + GO TO 42890 05950030 +32890 IVDELE = IVDELE + 1 05960030 + WRITE (I02,80003) IVTNUM 05970030 + IF (ICZERO) 42890, 2901, 42890 05980030 +42890 IF (IVCOMP + 1) 22890,12890,22890 05990030 +12890 IVPASS = IVPASS + 1 06000030 + WRITE (I02,80001) IVTNUM 06010030 + GO TO 2901 06020030 +22890 IVFAIL = IVFAIL + 1 06030030 + IVCORR = -1 06040030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06050030 + 2901 CONTINUE 06060030 + IVTNUM = 290 06070030 +C 06080030 +C **** TEST 290 **** 06090030 +C 06100030 + IF (ICZERO) 32900, 2900, 32900 06110030 + 2900 CONTINUE 06120030 + IVON01 =51 06130030 + IVCOMP = IVON01 -51 06140030 + GO TO 42900 06150030 +32900 IVDELE = IVDELE + 1 06160030 + WRITE (I02,80003) IVTNUM 06170030 + IF (ICZERO) 42900, 2911, 42900 06180030 +42900 IF (IVCOMP) 22900,12900,22900 06190030 +12900 IVPASS = IVPASS + 1 06200030 + WRITE (I02,80001) IVTNUM 06210030 + GO TO 2911 06220030 +22900 IVFAIL = IVFAIL + 1 06230030 + IVCORR =0 06240030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06250030 + 2911 CONTINUE 06260030 + IVTNUM = 291 06270030 +C 06280030 +C **** TEST 291 **** 06290030 +C 06300030 + IF (ICZERO) 32910, 2910, 32910 06310030 + 2910 CONTINUE 06320030 + IVON01 =53 06330030 + IVCOMP =IVON01 -52 06340030 + GO TO 42910 06350030 +32910 IVDELE = IVDELE + 1 06360030 + WRITE (I02,80003) IVTNUM 06370030 + IF (ICZERO) 42910, 2921, 42910 06380030 +42910 IF (IVCOMP -1) 22910,12910,22910 06390030 +12910 IVPASS = IVPASS + 1 06400030 + WRITE (I02,80001) IVTNUM 06410030 + GO TO 2921 06420030 +22910 IVFAIL = IVFAIL + 1 06430030 + IVCORR = 1 06440030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06450030 + 2921 CONTINUE 06460030 + IVTNUM = 292 06470030 +C 06480030 +C **** TEST 292 **** 06490030 +C 06500030 + IF (ICZERO) 32920, 2920, 32920 06510030 + 2920 CONTINUE 06520030 + IVON02 = 676 06530030 + IVCOMP = 189 - IVON02 06540030 + GO TO 42920 06550030 +32920 IVDELE = IVDELE + 1 06560030 + WRITE (I02,80003) IVTNUM 06570030 + IF (ICZERO) 42920, 2931, 42920 06580030 +42920 IF (IVCOMP + 487) 22920,12920,22920 06590030 +12920 IVPASS = IVPASS + 1 06600030 + WRITE (I02,80001) IVTNUM 06610030 + GO TO 2931 06620030 +22920 IVFAIL = IVFAIL + 1 06630030 + IVCORR = -487 06640030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06650030 + 2931 CONTINUE 06660030 + IVTNUM = 293 06670030 +C 06680030 +C **** TEST 293 **** 06690030 +C 06700030 + IF (ICZERO) 32930, 2930, 32930 06710030 + 2930 CONTINUE 06720030 + IVON02 = -676 06730030 + IVCOMP = 189 - IVON02 06740030 + GO TO 42930 06750030 +32930 IVDELE = IVDELE + 1 06760030 + WRITE (I02,80003) IVTNUM 06770030 + IF (ICZERO) 42930, 2941, 42930 06780030 +42930 IF (IVCOMP - 865) 22930,12930,22930 06790030 +12930 IVPASS = IVPASS + 1 06800030 + WRITE (I02,80001) IVTNUM 06810030 + GO TO 2941 06820030 +22930 IVFAIL = IVFAIL + 1 06830030 + IVCORR = 865 06840030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06850030 + 2941 CONTINUE 06860030 + IVTNUM = 294 06870030 +C 06880030 +C **** TEST 294 **** 06890030 +C 06900030 + IF (ICZERO) 32940, 2940, 32940 06910030 + 2940 CONTINUE 06920030 + IVON01 = 1358 06930030 + IVCOMP = IVON01 - 8001 06940030 + GO TO 42940 06950030 +32940 IVDELE = IVDELE + 1 06960030 + WRITE (I02,80003) IVTNUM 06970030 + IF (ICZERO) 42940, 2951, 42940 06980030 +42940 IF (IVCOMP + 6643) 22940,12940,22940 06990030 +12940 IVPASS = IVPASS + 1 07000030 + WRITE (I02,80001) IVTNUM 07010030 + GO TO 2951 07020030 +22940 IVFAIL = IVFAIL + 1 07030030 + IVCORR = -6643 07040030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07050030 + 2951 CONTINUE 07060030 + IVTNUM = 295 07070030 +C 07080030 +C **** TEST 295 **** 07090030 +C 07100030 + IF (ICZERO) 32950, 2950, 32950 07110030 + 2950 CONTINUE 07120030 + IVON01 = -1358 07130030 + IVCOMP = IVON01 - 8001 07140030 + GO TO 42950 07150030 +32950 IVDELE = IVDELE + 1 07160030 + WRITE (I02,80003) IVTNUM 07170030 + IF (ICZERO) 42950, 2961, 42950 07180030 +42950 IF (IVCOMP + 9359) 22950,12950,22950 07190030 +12950 IVPASS = IVPASS + 1 07200030 + WRITE (I02,80001) IVTNUM 07210030 + GO TO 2961 07220030 +22950 IVFAIL = IVFAIL + 1 07230030 + IVCORR = -9359 07240030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07250030 + 2961 CONTINUE 07260030 + IVTNUM = 296 07270030 +C 07280030 +C **** TEST 296 **** 07290030 +C 07300030 + IF (ICZERO) 32960, 2960, 32960 07310030 + 2960 CONTINUE 07320030 + IVON01 = 15 07330030 + IVCOMP = IVON01 - 32752 07340030 + GO TO 42960 07350030 +32960 IVDELE = IVDELE + 1 07360030 + WRITE (I02,80003) IVTNUM 07370030 + IF (ICZERO) 42960, 2971, 42960 07380030 +42960 IF (IVCOMP + 32737) 22960,12960,22960 07390030 +12960 IVPASS = IVPASS + 1 07400030 + WRITE (I02,80001) IVTNUM 07410030 + GO TO 2971 07420030 +22960 IVFAIL = IVFAIL + 1 07430030 + IVCORR = -32737 07440030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07450030 + 2971 CONTINUE 07460030 + IVTNUM = 297 07470030 +C 07480030 +C **** TEST 297 **** 07490030 +C 07500030 + IF (ICZERO) 32970, 2970, 32970 07510030 + 2970 CONTINUE 07520030 + IVON01 =-32751 07530030 + IVCOMP = IVON01 - 15 07540030 + GO TO 42970 07550030 +32970 IVDELE = IVDELE + 1 07560030 + WRITE (I02,80003) IVTNUM 07570030 + IF (ICZERO) 42970, 2981, 42970 07580030 +42970 IF (IVCOMP + 32766) 22970,12970,22970 07590030 +12970 IVPASS = IVPASS + 1 07600030 + WRITE (I02,80001) IVTNUM 07610030 + GO TO 2981 07620030 +22970 IVFAIL = IVFAIL + 1 07630030 + IVCORR = -32766 07640030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07650030 + 2981 CONTINUE 07660030 + IVTNUM = 298 07670030 +C 07680030 +C **** TEST 298 **** 07690030 +C 07700030 + IF (ICZERO) 32980, 2980, 32980 07710030 + 2980 CONTINUE 07720030 + IVON02 = -32752 07730030 + IVCOMP = 15 - IVON02 07740030 + GO TO 42980 07750030 +32980 IVDELE = IVDELE + 1 07760030 + WRITE (I02,80003) IVTNUM 07770030 + IF (ICZERO) 42980, 2991, 42980 07780030 +42980 IF (IVCOMP - 32767) 22980,12980,22980 07790030 +12980 IVPASS = IVPASS + 1 07800030 + WRITE (I02,80001) IVTNUM 07810030 + GO TO 2991 07820030 +22980 IVFAIL = IVFAIL + 1 07830030 + IVCORR = 32767 07840030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07850030 + 2991 CONTINUE 07860030 + IVTNUM = 299 07870030 +C 07880030 +C **** TEST 299 **** 07890030 +C 07900030 + IF (ICZERO) 32990, 2990, 32990 07910030 + 2990 CONTINUE 07920030 + IVON02 = 15 07930030 + IVCOMP = 32752 - IVON02 07940030 + GO TO 42990 07950030 +32990 IVDELE = IVDELE + 1 07960030 + WRITE (I02,80003) IVTNUM 07970030 + IF (ICZERO) 42990, 3001, 42990 07980030 +42990 IF (IVCOMP - 32737) 22990,12990,22990 07990030 +12990 IVPASS = IVPASS + 1 08000030 + WRITE (I02,80001) IVTNUM 08010030 + GO TO 3001 08020030 +22990 IVFAIL = IVFAIL + 1 08030030 + IVCORR = 32737 08040030 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08050030 + 3001 CONTINUE 08060030 +C 08070030 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08080030 +99999 CONTINUE 08090030 + WRITE (I02,90002) 08100030 + WRITE (I02,90006) 08110030 + WRITE (I02,90002) 08120030 + WRITE (I02,90002) 08130030 + WRITE (I02,90007) 08140030 + WRITE (I02,90002) 08150030 + WRITE (I02,90008) IVFAIL 08160030 + WRITE (I02,90009) IVPASS 08170030 + WRITE (I02,90010) IVDELE 08180030 +C 08190030 +C 08200030 +C TERMINATE ROUTINE EXECUTION 08210030 + STOP 08220030 +C 08230030 +C FORMAT STATEMENTS FOR PAGE HEADERS 08240030 +90000 FORMAT ("1") 08250030 +90002 FORMAT (" ") 08260030 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08270030 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08280030 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08290030 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08300030 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08310030 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08320030 +C 08330030 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08340030 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08350030 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08360030 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08370030 +C 08380030 +C FORMAT STATEMENTS FOR TEST RESULTS 08390030 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08400030 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08410030 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08420030 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08430030 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08440030 +C 08450030 +90007 FORMAT (" ",20X,"END OF PROGRAM FM030" ) 08460030 + END 08470030 diff --git a/Fortran/UnitTests/fcvs21_f95/FM030.reference_output b/Fortran/UnitTests/fcvs21_f95/FM030.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM030.reference_output @@ -0,0 +1,59 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 265 PASS + 266 PASS + 267 PASS + 268 PASS + 269 PASS + 270 PASS + 271 PASS + 272 PASS + 273 PASS + 274 PASS + 275 PASS + 276 PASS + 277 PASS + 278 PASS + 279 PASS + 280 PASS + 281 PASS + 282 PASS + 283 PASS + 284 PASS + 285 PASS + 286 PASS + 287 PASS + 288 PASS + 289 PASS + 290 PASS + 291 PASS + 292 PASS + 293 PASS + 294 PASS + 295 PASS + 296 PASS + 297 PASS + 298 PASS + 299 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM030 + + 0 ERRORS ENCOUNTERED + 35 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM031.f b/Fortran/UnitTests/fcvs21_f95/FM031.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM031.f @@ -0,0 +1,770 @@ + PROGRAM FM031 + +C COMMENT SECTION 00010031 +C 00020031 +C FM031 00030031 +C 00040031 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050031 +C FORM 00060031 +C INTEGER VARIABLE = ARITHMETIC EXPRESSION 00070031 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00080031 +C OPERATOR -, INTEGER CONSTANTS AND INTEGER VARIABLES. SOME OF THE 00090031 +C TESTS USE PARENTHESES TO GROUP ELEMENTS IN AN ARITHMETIC 00100031 +C EXPRESSION. 00110031 +C 00120031 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00130031 +C (1) INTEGER CONSTANT-INTEGER CONSTANT-INTEGER VARIABLE 00140031 +C INTEGER CONSTANT-INTEGER VARIABLE-INTEGER CONSTANT 00150031 +C INTEGER VARIABLE-INTEGER CONSTANT-INTEGER CONSTANT 00160031 +C (2) SAME AS (1) BUT WITH PARENTHESES TO GROUP ELEMENTS 00170031 +C IN ARITHMETIC EXPRESSION. 00180031 +C (3) INTEGER VARIABLE - INTEGER VARIABLE 00190031 +C 00200031 +C REFERENCES 00210031 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00220031 +C X3.9-1978 00230031 +C 00240031 +C SECTION 4.3, INTEGER TYPE 00250031 +C SECTION 4.3.1, INTEGER CONSTANT 00260031 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00270031 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00280031 +C 00290031 +C ********************************************************** 00300031 +C 00310031 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00320031 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00330031 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00340031 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00350031 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00360031 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00370031 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00380031 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00390031 +C OF EXECUTING THESE TESTS. 00400031 +C 00410031 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00420031 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00430031 +C 00440031 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00450031 +C 00460031 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00470031 +C SOFTWARE STANDARDS VALIDATION GROUP 00480031 +C BUILDING 225 RM A266 00490031 +C GAITHERSBURG, MD 20899 00500031 +C ********************************************************** 00510031 +C 00520031 +C 00530031 +C 00540031 +C INITIALIZATION SECTION 00550031 +C 00560031 +C INITIALIZE CONSTANTS 00570031 +C ************** 00580031 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00590031 + I01 = 5 00600031 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00610031 + I02 = 6 00620031 +C SYSTEM ENVIRONMENT SECTION 00630031 +C 00640031 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00650031 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00660031 +C (UNIT NUMBER FOR CARD READER). 00670031 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00680031 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00690031 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00700031 +C 00710031 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00720031 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00730031 +C (UNIT NUMBER FOR PRINTER). 00740031 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00750031 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00760031 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00770031 +C 00780031 + IVPASS=0 00790031 + IVFAIL=0 00800031 + IVDELE=0 00810031 + ICZERO=0 00820031 +C 00830031 +C WRITE PAGE HEADERS 00840031 + WRITE (I02,90000) 00850031 + WRITE (I02,90001) 00860031 + WRITE (I02,90002) 00870031 + WRITE (I02, 90002) 00880031 + WRITE (I02,90003) 00890031 + WRITE (I02,90002) 00900031 + WRITE (I02,90004) 00910031 + WRITE (I02,90002) 00920031 + WRITE (I02,90011) 00930031 + WRITE (I02,90002) 00940031 + WRITE (I02,90002) 00950031 + WRITE (I02,90005) 00960031 + WRITE (I02,90006) 00970031 + WRITE (I02,90002) 00980031 +C 00990031 +C TEST SECTION 01000031 +C 01010031 +C TEST 300 THROUGH TEST 309 CONTAIN 2 INTEGER CONSTANTS, AN INTEGER 01020031 +C VARIABLE AND OPERATOR - IN AN ARITHMETIC EXPRESSION. 01030031 +C 01040031 + 3001 CONTINUE 01050031 + IVTNUM = 300 01060031 +C 01070031 +C **** TEST 300 **** 01080031 +C 01090031 + IF (ICZERO) 33000, 3000, 33000 01100031 + 3000 CONTINUE 01110031 + IVON01 = 9 01120031 + IVCOMP =IVON01 -3 -4 01130031 + GO TO 43000 01140031 +33000 IVDELE = IVDELE + 1 01150031 + WRITE (I02,80003) IVTNUM 01160031 + IF (ICZERO) 43000, 3011, 43000 01170031 +43000 IF (IVCOMP-2) 23000,13000,23000 01180031 +13000 IVPASS = IVPASS + 1 01190031 + WRITE (I02,80001) IVTNUM 01200031 + GO TO 3011 01210031 +23000 IVFAIL = IVFAIL + 1 01220031 + IVCORR =2 01230031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01240031 + 3011 CONTINUE 01250031 + IVTNUM = 301 01260031 +C 01270031 +C **** TEST 301 **** 01280031 +C 01290031 + IF (ICZERO) 33010, 3010, 33010 01300031 + 3010 CONTINUE 01310031 + IVON02 =3 01320031 + IVCOMP =9-IVON02-4 01330031 + GO TO 43010 01340031 +33010 IVDELE = IVDELE + 1 01350031 + WRITE (I02,80003) IVTNUM 01360031 + IF (ICZERO) 43010, 3021, 43010 01370031 +43010 IF (IVCOMP-2) 23010,13010,23010 01380031 +13010 IVPASS = IVPASS + 1 01390031 + WRITE (I02,80001) IVTNUM 01400031 + GO TO 3021 01410031 +23010 IVFAIL = IVFAIL + 1 01420031 + IVCORR =2 01430031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01440031 + 3021 CONTINUE 01450031 + IVTNUM = 302 01460031 +C 01470031 +C **** TEST 302 **** 01480031 +C 01490031 + IF (ICZERO) 33020, 3020, 33020 01500031 + 3020 CONTINUE 01510031 + IVON03 = 4 01520031 + IVCOMP = 9-3-IVON03 01530031 + GO TO 43020 01540031 +33020 IVDELE = IVDELE + 1 01550031 + WRITE (I02,80003) IVTNUM 01560031 + IF (ICZERO) 43020, 3031, 43020 01570031 +43020 IF (IVCOMP-2) 23020,13020,23020 01580031 +13020 IVPASS = IVPASS + 1 01590031 + WRITE (I02,80001) IVTNUM 01600031 + GO TO 3031 01610031 +23020 IVFAIL = IVFAIL + 1 01620031 + IVCORR =2 01630031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01640031 + 3031 CONTINUE 01650031 + IVTNUM = 303 01660031 +C 01670031 +C **** TEST 303 **** 01680031 +C 01690031 + IF (ICZERO) 33030, 3030, 33030 01700031 + 3030 CONTINUE 01710031 + IVON01 = 57 01720031 + IVCOMP = IVON01 -25-22 01730031 + GO TO 43030 01740031 +33030 IVDELE = IVDELE + 1 01750031 + WRITE (I02,80003) IVTNUM 01760031 + IF (ICZERO) 43030, 3041, 43030 01770031 +43030 IF (IVCOMP-10) 23030,13030,23030 01780031 +13030 IVPASS = IVPASS + 1 01790031 + WRITE (I02,80001) IVTNUM 01800031 + GO TO 3041 01810031 +23030 IVFAIL = IVFAIL + 1 01820031 + IVCORR = 10 01830031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01840031 + 3041 CONTINUE 01850031 + IVTNUM = 304 01860031 +C 01870031 +C **** TEST 304 **** 01880031 +C 01890031 + IF (ICZERO) 33040, 3040, 33040 01900031 + 3040 CONTINUE 01910031 + IVON02 =683 01920031 + IVCOMP = 101-IVON02-156 01930031 + GO TO 43040 01940031 +33040 IVDELE = IVDELE + 1 01950031 + WRITE (I02,80003) IVTNUM 01960031 + IF (ICZERO) 43040, 3051, 43040 01970031 +43040 IF (IVCOMP+738) 23040,13040,23040 01980031 +13040 IVPASS = IVPASS + 1 01990031 + WRITE (I02,80001) IVTNUM 02000031 + GO TO 3051 02010031 +23040 IVFAIL = IVFAIL + 1 02020031 + IVCORR = -738 02030031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02040031 + 3051 CONTINUE 02050031 + IVTNUM = 305 02060031 +C 02070031 +C **** TEST 305 **** 02080031 +C 02090031 + IF (ICZERO) 33050, 3050, 33050 02100031 + 3050 CONTINUE 02110031 + IVON03 = 1289 02120031 + IVCOMP = 8542-1122-IVON03 02130031 + GO TO 43050 02140031 +33050 IVDELE = IVDELE + 1 02150031 + WRITE (I02,80003) IVTNUM 02160031 + IF (ICZERO) 43050, 3061, 43050 02170031 +43050 IF (IVCOMP-6131) 23050,13050,23050 02180031 +13050 IVPASS = IVPASS + 1 02190031 + WRITE (I02,80001) IVTNUM 02200031 + GO TO 3061 02210031 +23050 IVFAIL = IVFAIL + 1 02220031 + IVCORR = 6131 02230031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02240031 + 3061 CONTINUE 02250031 + IVTNUM = 306 02260031 +C 02270031 +C **** TEST 306 **** 02280031 +C 02290031 + IF (ICZERO) 33060, 3060, 33060 02300031 + 3060 CONTINUE 02310031 + IVON03 = 11111 02320031 + IVCOMP = 32333-11111-IVON03 02330031 + GO TO 43060 02340031 +33060 IVDELE = IVDELE + 1 02350031 + WRITE (I02,80003) IVTNUM 02360031 + IF (ICZERO) 43060, 3071, 43060 02370031 +43060 IF (IVCOMP-10111) 23060,13060,23060 02380031 +13060 IVPASS = IVPASS + 1 02390031 + WRITE (I02,80001) IVTNUM 02400031 + GO TO 3071 02410031 +23060 IVFAIL = IVFAIL + 1 02420031 + IVCORR =10111 02430031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02440031 + 3071 CONTINUE 02450031 + IVTNUM = 307 02460031 +C 02470031 +C **** TEST 307 **** 02480031 +C 02490031 + IF (ICZERO) 33070, 3070, 33070 02500031 + 3070 CONTINUE 02510031 + IVON01 = -3 02520031 + IVCOMP = IVON01-2-4 02530031 + GO TO 43070 02540031 +33070 IVDELE = IVDELE + 1 02550031 + WRITE (I02,80003) IVTNUM 02560031 + IF (ICZERO) 43070, 3081, 43070 02570031 +43070 IF (IVCOMP +9) 23070,13070,23070 02580031 +13070 IVPASS = IVPASS + 1 02590031 + WRITE (I02,80001) IVTNUM 02600031 + GO TO 3081 02610031 +23070 IVFAIL = IVFAIL + 1 02620031 + IVCORR =-9 02630031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02640031 + 3081 CONTINUE 02650031 + IVTNUM = 308 02660031 +C 02670031 +C **** TEST 308 **** 02680031 +C 02690031 + IF (ICZERO) 33080, 3080, 33080 02700031 + 3080 CONTINUE 02710031 + IVON02 =-9 02720031 + IVCOMP =1-IVON02-4 02730031 + GO TO 43080 02740031 +33080 IVDELE = IVDELE + 1 02750031 + WRITE (I02,80003) IVTNUM 02760031 + IF (ICZERO) 43080, 3091, 43080 02770031 +43080 IF (IVCOMP-6) 23080,13080,23080 02780031 +13080 IVPASS = IVPASS + 1 02790031 + WRITE (I02,80001) IVTNUM 02800031 + GO TO 3091 02810031 +23080 IVFAIL = IVFAIL + 1 02820031 + IVCORR = 6 02830031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02840031 + 3091 CONTINUE 02850031 + IVTNUM = 309 02860031 +C 02870031 +C **** TEST 309 **** 02880031 +C 02890031 + IF (ICZERO) 33090, 3090, 33090 02900031 + 3090 CONTINUE 02910031 + IVON03 = -8542 02920031 + IVCOMP = 100-3-IVON03 02930031 + GO TO 43090 02940031 +33090 IVDELE = IVDELE + 1 02950031 + WRITE (I02,80003) IVTNUM 02960031 + IF (ICZERO) 43090, 3101, 43090 02970031 +43090 IF (IVCOMP-8639) 23090,13090,23090 02980031 +13090 IVPASS = IVPASS + 1 02990031 + WRITE (I02,80001) IVTNUM 03000031 + GO TO 3101 03010031 +23090 IVFAIL = IVFAIL + 1 03020031 + IVCORR = 8639 03030031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03040031 +C 03050031 +C TEST 310 THROUGH TEST 319 CONTAIN 2 INTEGER CONSTANTS, AN INTEGER 03060031 +C VARIABLE AND OPERATOR - IN AN ARITHMETIC EXPRESSION. PARENTHESES 03070031 +C ARE USED TO GROUP ELEMENTS IN THE ARITHMETIC EXPRESSION. 03080031 +C 03090031 + 3101 CONTINUE 03100031 + IVTNUM = 310 03110031 +C 03120031 +C **** TEST 310 **** 03130031 +C 03140031 + IF (ICZERO) 33100, 3100, 33100 03150031 + 3100 CONTINUE 03160031 + IVON01 =9 03170031 + IVCOMP = IVON01-(3-4) 03180031 + GO TO 43100 03190031 +33100 IVDELE = IVDELE + 1 03200031 + WRITE (I02,80003) IVTNUM 03210031 + IF (ICZERO) 43100, 3111, 43100 03220031 +43100 IF (IVCOMP-10) 23100,13100,23100 03230031 +13100 IVPASS = IVPASS + 1 03240031 + WRITE (I02,80001) IVTNUM 03250031 + GO TO 3111 03260031 +23100 IVFAIL = IVFAIL + 1 03270031 + IVCORR=10 03280031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03290031 + 3111 CONTINUE 03300031 + IVTNUM = 311 03310031 +C 03320031 +C **** TEST 311 **** 03330031 +C 03340031 + IF (ICZERO) 33110, 3110, 33110 03350031 + 3110 CONTINUE 03360031 + IVON01=9 03370031 + IVCOMP=(IVON01-3)-4 03380031 + GO TO 43110 03390031 +33110 IVDELE = IVDELE + 1 03400031 + WRITE (I02,80003) IVTNUM 03410031 + IF (ICZERO) 43110, 3121, 43110 03420031 +43110 IF (IVCOMP-2) 23110,13110,23110 03430031 +13110 IVPASS = IVPASS + 1 03440031 + WRITE (I02,80001) IVTNUM 03450031 + GO TO 3121 03460031 +23110 IVFAIL = IVFAIL + 1 03470031 + IVCORR =2 03480031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03490031 + 3121 CONTINUE 03500031 + IVTNUM = 312 03510031 +C 03520031 +C **** TEST 312 **** 03530031 +C 03540031 + IF (ICZERO) 33120, 3120, 33120 03550031 + 3120 CONTINUE 03560031 + IVON02 = 3 03570031 + IVCOMP = 9-(IVON02-4) 03580031 + GO TO 43120 03590031 +33120 IVDELE = IVDELE + 1 03600031 + WRITE (I02,80003) IVTNUM 03610031 + IF (ICZERO) 43120, 3131, 43120 03620031 +43120 IF (IVCOMP-10) 23120,13120,23120 03630031 +13120 IVPASS = IVPASS + 1 03640031 + WRITE (I02,80001) IVTNUM 03650031 + GO TO 3131 03660031 +23120 IVFAIL = IVFAIL + 1 03670031 + IVCORR = 10 03680031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03690031 + 3131 CONTINUE 03700031 + IVTNUM = 313 03710031 +C 03720031 +C **** TEST 313 **** 03730031 +C 03740031 + IF (ICZERO) 33130, 3130, 33130 03750031 + 3130 CONTINUE 03760031 + IVON02 = 3 03770031 + IVCOMP = (9-IVON02) -4 03780031 + GO TO 43130 03790031 +33130 IVDELE = IVDELE + 1 03800031 + WRITE (I02,80003) IVTNUM 03810031 + IF (ICZERO) 43130, 3141, 43130 03820031 +43130 IF (IVCOMP-2) 23130,13130,23130 03830031 +13130 IVPASS = IVPASS + 1 03840031 + WRITE (I02,80001) IVTNUM 03850031 + GO TO 3141 03860031 +23130 IVFAIL = IVFAIL + 1 03870031 + IVCORR = 2 03880031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03890031 + 3141 CONTINUE 03900031 + IVTNUM = 314 03910031 +C 03920031 +C **** TEST 314 **** 03930031 +C 03940031 + IF (ICZERO) 33140, 3140, 33140 03950031 + 3140 CONTINUE 03960031 + IVON03 = 4 03970031 + IVCOMP = 9 -(3-IVON03) 03980031 + GO TO 43140 03990031 +33140 IVDELE = IVDELE + 1 04000031 + WRITE (I02,80003) IVTNUM 04010031 + IF (ICZERO) 43140, 3151, 43140 04020031 +43140 IF (IVCOMP-10) 23140,13140,23140 04030031 +13140 IVPASS = IVPASS + 1 04040031 + WRITE (I02,80001) IVTNUM 04050031 + GO TO 3151 04060031 +23140 IVFAIL = IVFAIL + 1 04070031 + IVCORR = 10 04080031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04090031 + 3151 CONTINUE 04100031 + IVTNUM = 315 04110031 +C 04120031 +C **** TEST 315 **** 04130031 +C 04140031 + IF (ICZERO) 33150, 3150, 33150 04150031 + 3150 CONTINUE 04160031 + IVON03 = 4 04170031 + IVCOMP = (9-3)-IVON03 04180031 + GO TO 43150 04190031 +33150 IVDELE = IVDELE + 1 04200031 + WRITE (I02,80003) IVTNUM 04210031 + IF (ICZERO) 43150, 3161, 43150 04220031 +43150 IF (IVCOMP-2) 23150,13150,23150 04230031 +13150 IVPASS = IVPASS + 1 04240031 + WRITE (I02,80001) IVTNUM 04250031 + GO TO 3161 04260031 +23150 IVFAIL = IVFAIL + 1 04270031 + IVCORR = 2 04280031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04290031 + 3161 CONTINUE 04300031 + IVTNUM = 316 04310031 +C 04320031 +C **** TEST 316 **** 04330031 +C 04340031 + IF (ICZERO) 33160, 3160, 33160 04350031 + 3160 CONTINUE 04360031 + IVON01 = -9 04370031 + IVCOMP = (IVON01-3)-4 04380031 + GO TO 43160 04390031 +33160 IVDELE = IVDELE + 1 04400031 + WRITE (I02,80003) IVTNUM 04410031 + IF (ICZERO) 43160, 3171, 43160 04420031 +43160 IF (IVCOMP +16) 23160,13160,23160 04430031 +13160 IVPASS = IVPASS + 1 04440031 + WRITE (I02,80001) IVTNUM 04450031 + GO TO 3171 04460031 +23160 IVFAIL = IVFAIL + 1 04470031 + IVCORR = -16 04480031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04490031 + 3171 CONTINUE 04500031 + IVTNUM = 317 04510031 +C 04520031 +C **** TEST 317 **** 04530031 +C 04540031 + IF (ICZERO) 33170, 3170, 33170 04550031 + 3170 CONTINUE 04560031 + IVON02 = -3 04570031 + IVCOMP = 9-(IVON02-4) 04580031 + GO TO 43170 04590031 +33170 IVDELE = IVDELE + 1 04600031 + WRITE (I02,80003) IVTNUM 04610031 + IF (ICZERO) 43170, 3181, 43170 04620031 +43170 IF (IVCOMP-16) 23170,13170,23170 04630031 +13170 IVPASS = IVPASS + 1 04640031 + WRITE (I02,80001) IVTNUM 04650031 + GO TO 3181 04660031 +23170 IVFAIL = IVFAIL + 1 04670031 + IVCORR = 16 04680031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04690031 + 3181 CONTINUE 04700031 + IVTNUM = 318 04710031 +C 04720031 +C **** TEST 318 **** 04730031 +C 04740031 + IF (ICZERO) 33180, 3180, 33180 04750031 + 3180 CONTINUE 04760031 + IVON03 = +4 04770031 + IVCOMP = 9 - (3 - IVON03) 04780031 + GO TO 43180 04790031 +33180 IVDELE = IVDELE + 1 04800031 + WRITE (I02,80003) IVTNUM 04810031 + IF (ICZERO) 43180, 3191, 43180 04820031 +43180 IF (IVCOMP - 10) 23180,13180,23180 04830031 +13180 IVPASS = IVPASS + 1 04840031 + WRITE (I02,80001) IVTNUM 04850031 + GO TO 3191 04860031 +23180 IVFAIL = IVFAIL + 1 04870031 + IVCORR= 10 04880031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04890031 + 3191 CONTINUE 04900031 + IVTNUM = 319 04910031 +C 04920031 +C **** TEST 319 **** 04930031 +C 04940031 + IF (ICZERO) 33190, 3190, 33190 04950031 + 3190 CONTINUE 04960031 + IVON02 = 11111 04970031 + IVCOMP = (32333-IVON02) -11111 04980031 + GO TO 43190 04990031 +33190 IVDELE = IVDELE + 1 05000031 + WRITE (I02,80003) IVTNUM 05010031 + IF (ICZERO) 43190, 3201, 43190 05020031 +43190 IF (IVCOMP - 10111) 23190,13190,23190 05030031 +13190 IVPASS = IVPASS + 1 05040031 + WRITE (I02,80001) IVTNUM 05050031 + GO TO 3201 05060031 +23190 IVFAIL = IVFAIL + 1 05070031 + IVCORR = 10111 05080031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05090031 +C 05100031 +C TEST 320 THROUGH TEST 329 CONTAIN 2 INTEGER VARIABLES AND 05110031 +C OPERATOR - IN AN ARITHMETIC EXPRESSION. THE INTEGER VARIABLES 05120031 +C CONTAIN POSITIVE AND NEGATIVE VALUES. 05130031 +C 05140031 + 3201 CONTINUE 05150031 + IVTNUM = 320 05160031 +C 05170031 +C **** TEST 320 **** 05180031 +C 05190031 + IF (ICZERO) 33200, 3200, 33200 05200031 + 3200 CONTINUE 05210031 + IVON01 = 3 05220031 + IVON02 = 2 05230031 + IVCOMP = IVON01 - IVON02 05240031 + GO TO 43200 05250031 +33200 IVDELE = IVDELE + 1 05260031 + WRITE (I02,80003) IVTNUM 05270031 + IF (ICZERO) 43200, 3211, 43200 05280031 +43200 IF (IVCOMP - 1) 23200,13200,23200 05290031 +13200 IVPASS = IVPASS + 1 05300031 + WRITE (I02,80001) IVTNUM 05310031 + GO TO 3211 05320031 +23200 IVFAIL = IVFAIL + 1 05330031 + IVCORR = 1 05340031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05350031 + 3211 CONTINUE 05360031 + IVTNUM = 321 05370031 +C 05380031 +C **** TEST 321 **** 05390031 +C 05400031 + IF (ICZERO) 33210, 3210, 33210 05410031 + 3210 CONTINUE 05420031 + IVON01 =2 05430031 + IVON02 =3 05440031 + IVCOMP = IVON01 - IVON02 05450031 + GO TO 43210 05460031 +33210 IVDELE = IVDELE + 1 05470031 + WRITE (I02,80003) IVTNUM 05480031 + IF (ICZERO) 43210, 3221, 43210 05490031 +43210 IF (IVCOMP +1) 23210,13210,23210 05500031 +13210 IVPASS = IVPASS + 1 05510031 + WRITE (I02,80001) IVTNUM 05520031 + GO TO 3221 05530031 +23210 IVFAIL = IVFAIL + 1 05540031 + IVCORR = -1 05550031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05560031 + 3221 CONTINUE 05570031 + IVTNUM = 322 05580031 +C 05590031 +C **** TEST 322 **** 05600031 +C 05610031 + IF (ICZERO) 33220, 3220, 33220 05620031 + 3220 CONTINUE 05630031 + IVON01 = -2 05640031 + IVON02 = 3 05650031 + IVCOMP = IVON01 - IVON02 05660031 + GO TO 43220 05670031 +33220 IVDELE = IVDELE + 1 05680031 + WRITE (I02,80003) IVTNUM 05690031 + IF (ICZERO) 43220, 3231, 43220 05700031 +43220 IF (IVCOMP +5) 23220,13220,23220 05710031 +13220 IVPASS = IVPASS + 1 05720031 + WRITE (I02,80001) IVTNUM 05730031 + GO TO 3231 05740031 +23220 IVFAIL = IVFAIL + 1 05750031 + IVCORR =-5 05760031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05770031 + 3231 CONTINUE 05780031 + IVTNUM = 323 05790031 +C 05800031 +C **** TEST 323 **** 05810031 +C 05820031 + IF (ICZERO) 33230, 3230, 33230 05830031 + 3230 CONTINUE 05840031 + IVON01 = -2 05850031 + IVON02 = -3 05860031 + IVCOMP = IVON01 - IVON02 05870031 + GO TO 43230 05880031 +33230 IVDELE = IVDELE + 1 05890031 + WRITE (I02,80003) IVTNUM 05900031 + IF (ICZERO) 43230, 3241, 43230 05910031 +43230 IF (IVCOMP -1) 23230,13230,23230 05920031 +13230 IVPASS = IVPASS + 1 05930031 + WRITE (I02,80001) IVTNUM 05940031 + GO TO 3241 05950031 +23230 IVFAIL = IVFAIL + 1 05960031 + IVCORR = 1 05970031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05980031 + 3241 CONTINUE 05990031 + IVTNUM = 324 06000031 +C 06010031 +C **** TEST 324 **** 06020031 +C 06030031 + IF (ICZERO) 33240, 3240, 33240 06040031 + 3240 CONTINUE 06050031 + IVON01 = 51 06060031 + IVON02 = 52 06070031 + IVCOMP = IVON01 - IVON02 06080031 + GO TO 43240 06090031 +33240 IVDELE = IVDELE + 1 06100031 + WRITE (I02,80003) IVTNUM 06110031 + IF (ICZERO) 43240, 3251, 43240 06120031 +43240 IF (IVCOMP + 1) 23240,13240,23240 06130031 +13240 IVPASS = IVPASS + 1 06140031 + WRITE (I02,80001) IVTNUM 06150031 + GO TO 3251 06160031 +23240 IVFAIL = IVFAIL + 1 06170031 + IVCORR = -1 06180031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06190031 + 3251 CONTINUE 06200031 + IVTNUM = 325 06210031 +C 06220031 +C **** TEST 325 **** 06230031 +C 06240031 + IF (ICZERO) 33250, 3250, 33250 06250031 + 3250 CONTINUE 06260031 + IVON01 = 676 06270031 + IVON02 =-189 06280031 + IVCOMP = IVON01 - IVON02 06290031 + GO TO 43250 06300031 +33250 IVDELE = IVDELE + 1 06310031 + WRITE (I02,80003) IVTNUM 06320031 + IF (ICZERO) 43250, 3261, 43250 06330031 +43250 IF (IVCOMP - 865) 23250,13250,23250 06340031 +13250 IVPASS = IVPASS + 1 06350031 + WRITE (I02,80001) IVTNUM 06360031 + GO TO 3261 06370031 +23250 IVFAIL = IVFAIL + 1 06380031 + IVCORR = 865 06390031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06400031 + 3261 CONTINUE 06410031 + IVTNUM = 326 06420031 +C 06430031 +C **** TEST 326 **** 06440031 +C 06450031 + IF (ICZERO) 33260, 3260, 33260 06460031 + 3260 CONTINUE 06470031 + IVON01 = 1358 06480031 + IVON02 = -8001 06490031 + IVCOMP = IVON01 - IVON02 06500031 + GO TO 43260 06510031 +33260 IVDELE = IVDELE + 1 06520031 + WRITE (I02,80003) IVTNUM 06530031 + IF (ICZERO) 43260, 3271, 43260 06540031 +43260 IF (IVCOMP - 9359) 23260,13260,23260 06550031 +13260 IVPASS = IVPASS + 1 06560031 + WRITE (I02,80001) IVTNUM 06570031 + GO TO 3271 06580031 +23260 IVFAIL = IVFAIL + 1 06590031 + IVCORR = 9359 06600031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06610031 + 3271 CONTINUE 06620031 + IVTNUM = 327 06630031 +C 06640031 +C **** TEST 327 **** 06650031 +C 06660031 + IF (ICZERO) 33270, 3270, 33270 06670031 + 3270 CONTINUE 06680031 + IVON01 =-16383 06690031 + IVON02 = 16383 06700031 + IVCOMP = IVON01 - IVON02 06710031 + GO TO 43270 06720031 +33270 IVDELE = IVDELE + 1 06730031 + WRITE (I02,80003) IVTNUM 06740031 + IF (ICZERO) 43270, 3281, 43270 06750031 +43270 IF (IVCOMP + 32766) 23270,13270,23270 06760031 +13270 IVPASS = IVPASS + 1 06770031 + WRITE (I02,80001) IVTNUM 06780031 + GO TO 3281 06790031 +23270 IVFAIL = IVFAIL + 1 06800031 + IVCORR = -32766 06810031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06820031 + 3281 CONTINUE 06830031 + IVTNUM = 328 06840031 +C 06850031 +C **** TEST 328 **** 06860031 +C 06870031 + IF (ICZERO) 33280, 3280, 33280 06880031 + 3280 CONTINUE 06890031 + IVON01 = 9876 06900031 + IVON02 = 189 06910031 + IVCOMP = IVON01 - IVON02 06920031 + GO TO 43280 06930031 +33280 IVDELE = IVDELE + 1 06940031 + WRITE (I02,80003) IVTNUM 06950031 + IF (ICZERO) 43280, 3291, 43280 06960031 +43280 IF (IVCOMP - 9687) 23280,13280,23280 06970031 +13280 IVPASS = IVPASS + 1 06980031 + WRITE (I02,80001) IVTNUM 06990031 + GO TO 3291 07000031 +23280 IVFAIL = IVFAIL + 1 07010031 + IVCORR = 9687 07020031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07030031 + 3291 CONTINUE 07040031 + IVTNUM = 329 07050031 +C 07060031 +C **** TEST 329 **** 07070031 +C 07080031 + IF (ICZERO) 33290, 3290, 33290 07090031 + 3290 CONTINUE 07100031 + IVON01 = 11112 07110031 + IVON02 = 11112 07120031 + IVCOMP = IVON01 - IVON02 07130031 + GO TO 43290 07140031 +33290 IVDELE = IVDELE + 1 07150031 + WRITE (I02,80003) IVTNUM 07160031 + IF (ICZERO) 43290, 3301, 43290 07170031 +43290 IF (IVCOMP) 23290,13290,23290 07180031 +13290 IVPASS = IVPASS + 1 07190031 + WRITE (I02,80001) IVTNUM 07200031 + GO TO 3301 07210031 +23290 IVFAIL = IVFAIL + 1 07220031 + IVCORR = 0 07230031 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07240031 +C 07250031 +C **** END OF TESTS **** 07260031 + 3301 CONTINUE 07270031 +C 07280031 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07290031 +99999 CONTINUE 07300031 + WRITE (I02,90002) 07310031 + WRITE (I02,90006) 07320031 + WRITE (I02,90002) 07330031 + WRITE (I02,90002) 07340031 + WRITE (I02,90007) 07350031 + WRITE (I02,90002) 07360031 + WRITE (I02,90008) IVFAIL 07370031 + WRITE (I02,90009) IVPASS 07380031 + WRITE (I02,90010) IVDELE 07390031 +C 07400031 +C 07410031 +C TERMINATE ROUTINE EXECUTION 07420031 + STOP 07430031 +C 07440031 +C FORMAT STATEMENTS FOR PAGE HEADERS 07450031 +90000 FORMAT ("1") 07460031 +90002 FORMAT (" ") 07470031 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07480031 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07490031 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07500031 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07510031 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07520031 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07530031 +C 07540031 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07550031 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07560031 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07570031 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07580031 +C 07590031 +C FORMAT STATEMENTS FOR TEST RESULTS 07600031 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07610031 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07620031 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07630031 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07640031 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07650031 +C 07660031 +90007 FORMAT (" ",20X,"END OF PROGRAM FM031" ) 07670031 + END 07680031 diff --git a/Fortran/UnitTests/fcvs21_f95/FM031.reference_output b/Fortran/UnitTests/fcvs21_f95/FM031.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM031.reference_output @@ -0,0 +1,54 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 300 PASS + 301 PASS + 302 PASS + 303 PASS + 304 PASS + 305 PASS + 306 PASS + 307 PASS + 308 PASS + 309 PASS + 310 PASS + 311 PASS + 312 PASS + 313 PASS + 314 PASS + 315 PASS + 316 PASS + 317 PASS + 318 PASS + 319 PASS + 320 PASS + 321 PASS + 322 PASS + 323 PASS + 324 PASS + 325 PASS + 326 PASS + 327 PASS + 328 PASS + 329 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM031 + + 0 ERRORS ENCOUNTERED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM032.f b/Fortran/UnitTests/fcvs21_f95/FM032.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM032.f @@ -0,0 +1,796 @@ + PROGRAM FM032 + +C COMMENT SECTION 00010032 +C 00020032 +C FM032 00030032 +C 00040032 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050032 +C FORM 00060032 +C INTEGER VARIABLE = ARITHMETIC EXPRESSION 00070032 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00080032 +C OPERATOR -, INTEGER CONSTANTS AND INTEGER VARIABLES. SOME OF THE 00090032 +C TESTS USE PARENTHESES TO GROUP ELEMENTS IN AN ARITHMETIC 00100032 +C EXPRESSION. 00110032 +C 00120032 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00130032 +C (1) INTEGER VAR.= INT. VAR. - INT.VAR.-INT.CON 00140032 +C = INT. VAR. - INT.CON.-INT.VAR 00150032 +C = INT. CON. - INT.VAR -INT.VAR. 00160032 +C (2) SAME FORMS AS (1) BUT WITH PARENTHESES TO GROUP ELEMENTS 00170032 +C IN ARITHMETIC EXPRESSION. 00180032 +C 00190032 +C REFERENCES 00200032 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00210032 +C X3.9-1978 00220032 +C 00230032 +C SECTION 4.3, INTEGER TYPE 00240032 +C SECTION 4.3.1, INTEGER CONSTANT 00250032 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00260032 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00270032 +C 00280032 +C 00290032 +C ********************************************************** 00300032 +C 00310032 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00320032 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00330032 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00340032 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00350032 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00360032 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00370032 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00380032 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00390032 +C OF EXECUTING THESE TESTS. 00400032 +C 00410032 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00420032 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00430032 +C 00440032 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00450032 +C 00460032 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00470032 +C SOFTWARE STANDARDS VALIDATION GROUP 00480032 +C BUILDING 225 RM A266 00490032 +C GAITHERSBURG, MD 20899 00500032 +C ********************************************************** 00510032 +C 00520032 +C 00530032 +C 00540032 +C INITIALIZATION SECTION 00550032 +C 00560032 +C INITIALIZE CONSTANTS 00570032 +C ************** 00580032 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00590032 + I01 = 5 00600032 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00610032 + I02 = 6 00620032 +C SYSTEM ENVIRONMENT SECTION 00630032 +C 00640032 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00650032 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00660032 +C (UNIT NUMBER FOR CARD READER). 00670032 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00680032 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00690032 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00700032 +C 00710032 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00720032 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00730032 +C (UNIT NUMBER FOR PRINTER). 00740032 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00750032 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00760032 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00770032 +C 00780032 + IVPASS=0 00790032 + IVFAIL=0 00800032 + IVDELE=0 00810032 + ICZERO=0 00820032 +C 00830032 +C WRITE PAGE HEADERS 00840032 + WRITE (I02,90000) 00850032 + WRITE (I02,90001) 00860032 + WRITE (I02,90002) 00870032 + WRITE (I02, 90002) 00880032 + WRITE (I02,90003) 00890032 + WRITE (I02,90002) 00900032 + WRITE (I02,90004) 00910032 + WRITE (I02,90002) 00920032 + WRITE (I02,90011) 00930032 + WRITE (I02,90002) 00940032 + WRITE (I02,90002) 00950032 + WRITE (I02,90005) 00960032 + WRITE (I02,90006) 00970032 + WRITE (I02,90002) 00980032 +C TEST SECTION 00990032 +C 01000032 +C ARITHMETIC ASSIGNMENT STATEMENT 01010032 +C 01020032 +C TEST 330 THROUGH TEST 347 CONTAIN TWO INTEGER VARIABLES, AN 01030032 +C INTEGER CONSTANT AND OPERATOR - IN AN ARITHMETIC EXPRESSION. THE 01040032 +C INTEGER VARIABLES CONTAIN POSITIVE AND NEGATIVE VALUES. 01050032 +C 01060032 +C TEST 330 THROUGH TEST 337 IV = IV -IV -IC 01070032 +C 01080032 + 3301 CONTINUE 01090032 + IVTNUM = 330 01100032 +C 01110032 +C **** TEST 330 **** 01120032 +C 01130032 + IF (ICZERO) 33300, 3300, 33300 01140032 + 3300 CONTINUE 01150032 + IVON01 =9 01160032 + IVON02 =4 01170032 + IVCOMP = IVON01-IVON02-2 01180032 + GO TO 43300 01190032 +33300 IVDELE = IVDELE + 1 01200032 + WRITE (I02,80003) IVTNUM 01210032 + IF (ICZERO) 43300, 3311, 43300 01220032 +43300 IF (IVCOMP-3) 23300,13300,23300 01230032 +13300 IVPASS = IVPASS + 1 01240032 + WRITE (I02,80001) IVTNUM 01250032 + GO TO 3311 01260032 +23300 IVFAIL = IVFAIL + 1 01270032 + IVCORR= 3 01280032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01290032 + 3311 CONTINUE 01300032 + IVTNUM = 331 01310032 +C 01320032 +C **** TEST 331 **** 01330032 +C 01340032 + IF (ICZERO) 33310, 3310, 33310 01350032 + 3310 CONTINUE 01360032 + IVON01 =-9 01370032 + IVON02 = 4 01380032 + IVCOMP = IVON01-IVON02-2 01390032 + GO TO 43310 01400032 +33310 IVDELE = IVDELE + 1 01410032 + WRITE (I02,80003) IVTNUM 01420032 + IF (ICZERO) 43310, 3321, 43310 01430032 +43310 IF (IVCOMP +15) 23310,13310,23310 01440032 +13310 IVPASS = IVPASS + 1 01450032 + WRITE (I02,80001) IVTNUM 01460032 + GO TO 3321 01470032 +23310 IVFAIL = IVFAIL + 1 01480032 + IVCORR = -15 01490032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01500032 + 3321 CONTINUE 01510032 + IVTNUM = 332 01520032 +C 01530032 +C **** TEST 332 **** 01540032 +C 01550032 + IF (ICZERO) 33320, 3320, 33320 01560032 + 3320 CONTINUE 01570032 + IVON01 =9 01580032 + IVON02 =-4 01590032 + IVCOMP =IVON01-IVON02-2 01600032 + GO TO 43320 01610032 +33320 IVDELE = IVDELE + 1 01620032 + WRITE (I02,80003) IVTNUM 01630032 + IF (ICZERO) 43320, 3331, 43320 01640032 +43320 IF (IVCOMP-11) 23320,13320,23320 01650032 +13320 IVPASS = IVPASS + 1 01660032 + WRITE (I02,80001) IVTNUM 01670032 + GO TO 3331 01680032 +23320 IVFAIL = IVFAIL + 1 01690032 + IVCORR = 11 01700032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01710032 + 3331 CONTINUE 01720032 + IVTNUM = 333 01730032 +C 01740032 +C **** TEST 333 **** 01750032 +C 01760032 + IF (ICZERO) 33330, 3330, 33330 01770032 + 3330 CONTINUE 01780032 + IVON01 =57 01790032 + IVON02 =25 01800032 + IVCOMP=IVON01-IVON02-22 01810032 + GO TO 43330 01820032 +33330 IVDELE = IVDELE + 1 01830032 + WRITE (I02,80003) IVTNUM 01840032 + IF (ICZERO) 43330, 3341, 43330 01850032 +43330 IF (IVCOMP -10) 23330,13330,23330 01860032 +13330 IVPASS = IVPASS + 1 01870032 + WRITE (I02,80001) IVTNUM 01880032 + GO TO 3341 01890032 +23330 IVFAIL = IVFAIL + 1 01900032 + IVCORR = 10 01910032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01920032 + 3341 CONTINUE 01930032 + IVTNUM = 334 01940032 +C 01950032 +C **** TEST 334 **** 01960032 +C 01970032 + IF (ICZERO) 33340, 3340, 33340 01980032 + 3340 CONTINUE 01990032 + IVON01 = 101 02000032 + IVON02 = 683 02010032 + IVCOMP = IVON01 - IVON02 - 156 02020032 + GO TO 43340 02030032 +33340 IVDELE = IVDELE + 1 02040032 + WRITE (I02,80003) IVTNUM 02050032 + IF (ICZERO) 43340, 3351, 43340 02060032 +43340 IF (IVCOMP +738) 23340,13340,23340 02070032 +13340 IVPASS = IVPASS + 1 02080032 + WRITE (I02,80001) IVTNUM 02090032 + GO TO 3351 02100032 +23340 IVFAIL = IVFAIL + 1 02110032 + IVCORR = -738 02120032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02130032 + 3351 CONTINUE 02140032 + IVTNUM = 335 02150032 +C 02160032 +C **** TEST 335 **** 02170032 +C 02180032 + IF (ICZERO) 33350, 3350, 33350 02190032 + 3350 CONTINUE 02200032 + IVON01=8542 02210032 + IVON02=1122 02220032 + IVCOMP=IVON01-IVON02-1289 02230032 + GO TO 43350 02240032 +33350 IVDELE = IVDELE + 1 02250032 + WRITE (I02,80003) IVTNUM 02260032 + IF (ICZERO) 43350, 3361, 43350 02270032 +43350 IF (IVCOMP -6131) 23350,13350,23350 02280032 +13350 IVPASS = IVPASS + 1 02290032 + WRITE (I02,80001) IVTNUM 02300032 + GO TO 3361 02310032 +23350 IVFAIL = IVFAIL + 1 02320032 + IVCORR = 6131 02330032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02340032 + 3361 CONTINUE 02350032 + IVTNUM = 336 02360032 +C 02370032 +C **** TEST 336 **** 02380032 +C 02390032 + IF (ICZERO) 33360, 3360, 33360 02400032 + 3360 CONTINUE 02410032 + IVON01 = 31333 02420032 + IVON02 = 11111 02430032 + IVCOMP = IVON01-IVON02-10111 02440032 + GO TO 43360 02450032 +33360 IVDELE = IVDELE + 1 02460032 + WRITE (I02,80003) IVTNUM 02470032 + IF (ICZERO) 43360, 3371, 43360 02480032 +43360 IF (IVCOMP -10111) 23360,13360,23360 02490032 +13360 IVPASS = IVPASS + 1 02500032 + WRITE (I02,80001) IVTNUM 02510032 + GO TO 3371 02520032 +23360 IVFAIL = IVFAIL + 1 02530032 + IVCORR = 10111 02540032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02550032 + 3371 CONTINUE 02560032 + IVTNUM = 337 02570032 +C 02580032 +C **** TEST 337 **** 02590032 +C 02600032 + IF (ICZERO) 33370, 3370, 33370 02610032 + 3370 CONTINUE 02620032 + IVON01 = -31444 02630032 + IVON02 = +1001 02640032 + IVCOMP = IVON01-IVON02-300 02650032 + GO TO 43370 02660032 +33370 IVDELE = IVDELE + 1 02670032 + WRITE (I02,80003) IVTNUM 02680032 + IF (ICZERO) 43370, 3381, 43370 02690032 +43370 IF (IVCOMP +32745) 23370,13370,23370 02700032 +13370 IVPASS = IVPASS + 1 02710032 + WRITE (I02,80001) IVTNUM 02720032 + GO TO 3381 02730032 +23370 IVFAIL = IVFAIL + 1 02740032 + IVCORR = -32745 02750032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02760032 +C 02770032 +C TEST 338 THROUGH TEST 343 IV=IV-IC-IV 02780032 +C 02790032 + 3381 CONTINUE 02800032 + IVTNUM = 338 02810032 +C 02820032 +C **** TEST 338 **** 02830032 +C 02840032 + IF (ICZERO) 33380, 3380, 33380 02850032 + 3380 CONTINUE 02860032 + IVON01 =9 02870032 + IVON03 =2 02880032 + IVCOMP = IVON01-4-IVON03 02890032 + GO TO 43380 02900032 +33380 IVDELE = IVDELE + 1 02910032 + WRITE (I02,80003) IVTNUM 02920032 + IF (ICZERO) 43380, 3391, 43380 02930032 +43380 IF (IVCOMP -3) 23380,13380,23380 02940032 +13380 IVPASS = IVPASS + 1 02950032 + WRITE (I02,80001) IVTNUM 02960032 + GO TO 3391 02970032 +23380 IVFAIL = IVFAIL + 1 02980032 + IVCORR = 3 02990032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03000032 + 3391 CONTINUE 03010032 + IVTNUM = 339 03020032 +C 03030032 +C **** TEST 339 **** 03040032 +C 03050032 + IF (ICZERO) 33390, 3390, 33390 03060032 + 3390 CONTINUE 03070032 + IVON01 = -9 03080032 + IVON03 = 2 03090032 + IVCOMP = IVON01-4-IVON03 03100032 + GO TO 43390 03110032 +33390 IVDELE = IVDELE + 1 03120032 + WRITE (I02,80003) IVTNUM 03130032 + IF (ICZERO) 43390, 3401, 43390 03140032 +43390 IF (IVCOMP+15) 23390,13390,23390 03150032 +13390 IVPASS = IVPASS + 1 03160032 + WRITE (I02,80001) IVTNUM 03170032 + GO TO 3401 03180032 +23390 IVFAIL = IVFAIL + 1 03190032 + IVCORR = -15 03200032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03210032 + 3401 CONTINUE 03220032 + IVTNUM = 340 03230032 +C 03240032 +C **** TEST 340 **** 03250032 +C 03260032 + IF (ICZERO) 33400, 3400, 33400 03270032 + 3400 CONTINUE 03280032 + IVON01 = 9 03290032 + IVON03 =-2 03300032 + IVCOMP =IVON01-4-IVON03 03310032 + GO TO 43400 03320032 +33400 IVDELE = IVDELE + 1 03330032 + WRITE (I02,80003) IVTNUM 03340032 + IF (ICZERO) 43400, 3411, 43400 03350032 +43400 IF (IVCOMP-7) 23400,13400,23400 03360032 +13400 IVPASS = IVPASS + 1 03370032 + WRITE (I02,80001) IVTNUM 03380032 + GO TO 3411 03390032 +23400 IVFAIL = IVFAIL + 1 03400032 + IVCORR=7 03410032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03420032 + 3411 CONTINUE 03430032 + IVTNUM = 341 03440032 +C 03450032 +C **** TEST 341 **** 03460032 +C 03470032 + IF (ICZERO) 33410, 3410, 33410 03480032 + 3410 CONTINUE 03490032 + IVON01=-57 03500032 + IVON03=22 03510032 + IVCOMP=IVON01-25-IVON03 03520032 + GO TO 43410 03530032 +33410 IVDELE = IVDELE + 1 03540032 + WRITE (I02,80003) IVTNUM 03550032 + IF (ICZERO) 43410, 3421, 43410 03560032 +43410 IF (IVCOMP+104) 23410,13410,23410 03570032 +13410 IVPASS = IVPASS + 1 03580032 + WRITE (I02,80001) IVTNUM 03590032 + GO TO 3421 03600032 +23410 IVFAIL = IVFAIL + 1 03610032 + IVCORR = -104 03620032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03630032 + 3421 CONTINUE 03640032 + IVTNUM = 342 03650032 +C 03660032 +C **** TEST 342 **** 03670032 +C 03680032 + IF (ICZERO) 33420, 3420, 33420 03690032 + 3420 CONTINUE 03700032 + IVON01=8542 03710032 + IVON03=3 03720032 + IVCOMP=IVON01-125-IVON03 03730032 + GO TO 43420 03740032 +33420 IVDELE = IVDELE + 1 03750032 + WRITE (I02,80003) IVTNUM 03760032 + IF (ICZERO) 43420, 3431, 43420 03770032 +43420 IF (IVCOMP-8414) 23420,13420,23420 03780032 +13420 IVPASS = IVPASS + 1 03790032 + WRITE (I02,80001) IVTNUM 03800032 + GO TO 3431 03810032 +23420 IVFAIL = IVFAIL + 1 03820032 + IVCORR = 8414 03830032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03840032 + 3431 CONTINUE 03850032 + IVTNUM = 343 03860032 +C 03870032 +C **** TEST 343 **** 03880032 +C 03890032 + IF (ICZERO) 33430, 3430, 33430 03900032 + 3430 CONTINUE 03910032 + IVON01 = -32111 03920032 + IVON03 = -111 03930032 + IVCOMP = IVON01-111-IVON03 03940032 + GO TO 43430 03950032 +33430 IVDELE = IVDELE + 1 03960032 + WRITE (I02,80003) IVTNUM 03970032 + IF (ICZERO) 43430, 3441, 43430 03980032 +43430 IF (IVCOMP + 32111) 23430,13430,23430 03990032 +13430 IVPASS = IVPASS + 1 04000032 + WRITE (I02,80001) IVTNUM 04010032 + GO TO 3441 04020032 +23430 IVFAIL = IVFAIL + 1 04030032 + IVCORR = -32111 04040032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04050032 +C 04060032 +C TEST 344 THROUGH TEST 347 IV=IC-IV-IV 04070032 +C 04080032 + 3441 CONTINUE 04090032 + IVTNUM = 344 04100032 +C 04110032 +C **** TEST 344 **** 04120032 +C 04130032 + IF (ICZERO) 33440, 3440, 33440 04140032 + 3440 CONTINUE 04150032 + IVON02=4 04160032 + IVON03=2 04170032 + IVCOMP=9-IVON02-IVON03 04180032 + GO TO 43440 04190032 +33440 IVDELE = IVDELE + 1 04200032 + WRITE (I02,80003) IVTNUM 04210032 + IF (ICZERO) 43440, 3451, 43440 04220032 +43440 IF (IVCOMP -3) 23440,13440,23440 04230032 +13440 IVPASS = IVPASS + 1 04240032 + WRITE (I02,80001) IVTNUM 04250032 + GO TO 3451 04260032 +23440 IVFAIL = IVFAIL + 1 04270032 + IVCORR = 3 04280032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04290032 + 3451 CONTINUE 04300032 + IVTNUM = 345 04310032 +C 04320032 +C **** TEST 345 **** 04330032 +C 04340032 + IF (ICZERO) 33450, 3450, 33450 04350032 + 3450 CONTINUE 04360032 + IVON02=-4 04370032 + IVON03= 2 04380032 + IVCOMP= 9-IVON02-IVON03 04390032 + GO TO 43450 04400032 +33450 IVDELE = IVDELE + 1 04410032 + WRITE (I02,80003) IVTNUM 04420032 + IF (ICZERO) 43450, 3461, 43450 04430032 +43450 IF (IVCOMP -11) 23450,13450,23450 04440032 +13450 IVPASS = IVPASS + 1 04450032 + WRITE (I02,80001) IVTNUM 04460032 + GO TO 3461 04470032 +23450 IVFAIL = IVFAIL + 1 04480032 + IVCORR =11 04490032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04500032 + 3461 CONTINUE 04510032 + IVTNUM = 346 04520032 +C 04530032 +C **** TEST 346 **** 04540032 +C 04550032 + IF (ICZERO) 33460, 3460, 33460 04560032 + 3460 CONTINUE 04570032 + IVON02 = 683 04580032 + IVON03 = 156 04590032 + IVCOMP = 101 -IVON02-IVON03 04600032 + GO TO 43460 04610032 +33460 IVDELE = IVDELE + 1 04620032 + WRITE (I02,80003) IVTNUM 04630032 + IF (ICZERO) 43460, 3471, 43460 04640032 +43460 IF (IVCOMP +738) 23460,13460,23460 04650032 +13460 IVPASS = IVPASS + 1 04660032 + WRITE (I02,80001) IVTNUM 04670032 + GO TO 3471 04680032 +23460 IVFAIL = IVFAIL + 1 04690032 + IVCORR = -738 04700032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04710032 + 3471 CONTINUE 04720032 + IVTNUM = 347 04730032 +C 04740032 +C **** TEST 347 **** 04750032 +C 04760032 + IF (ICZERO) 33470, 3470, 33470 04770032 + 3470 CONTINUE 04780032 + IVON02 = 15687 04790032 + IVON03 = 387 04800032 + IVCOMP = 8542-IVON02-IVON03 04810032 + GO TO 43470 04820032 +33470 IVDELE = IVDELE + 1 04830032 + WRITE (I02,80003) IVTNUM 04840032 + IF (ICZERO) 43470, 3481, 43470 04850032 +43470 IF (IVCOMP + 7532) 23470,13470,23470 04860032 +13470 IVPASS = IVPASS + 1 04870032 + WRITE (I02,80001) IVTNUM 04880032 + GO TO 3481 04890032 +23470 IVFAIL = IVFAIL + 1 04900032 + IVCORR = -7532 04910032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04920032 +C 04930032 +C TEST 348 THROUGH TEST 359 CONTAIN TWO INTEGER VARIABLES, AN 04940032 +C INTEGER CONSTANT AND OPERATOR - IN AN ARITHMETIC EXPRESSION. 04950032 +C PARENTHESES ARE USED TO GROUP THE ELEMENTS IN THE ARITHMETIC 04960032 +C EXPRESSION. THE INTEGER VARIABLES CONTAIN POSITIVE AND NEGATIVE 04970032 +C VALUES. 04980032 +C 04990032 + 3481 CONTINUE 05000032 + IVTNUM = 348 05010032 +C 05020032 +C **** TEST 348 **** 05030032 +C 05040032 + IF (ICZERO) 33480, 3480, 33480 05050032 + 3480 CONTINUE 05060032 + IVON01= 9 05070032 + IVON02= 4 05080032 + IVCOMP=(IVON01-IVON02)-2 05090032 + GO TO 43480 05100032 +33480 IVDELE = IVDELE + 1 05110032 + WRITE (I02,80003) IVTNUM 05120032 + IF (ICZERO) 43480, 3491, 43480 05130032 +43480 IF (IVCOMP - 3) 23480,13480,23480 05140032 +13480 IVPASS = IVPASS + 1 05150032 + WRITE (I02,80001) IVTNUM 05160032 + GO TO 3491 05170032 +23480 IVFAIL = IVFAIL + 1 05180032 + IVCORR = 3 05190032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05200032 + 3491 CONTINUE 05210032 + IVTNUM = 349 05220032 +C 05230032 +C **** TEST 349 **** 05240032 +C 05250032 + IF (ICZERO) 33490, 3490, 33490 05260032 + 3490 CONTINUE 05270032 + IVON01=9 05280032 + IVON02=4 05290032 + IVCOMP=IVON01-(IVON02-2) 05300032 + GO TO 43490 05310032 +33490 IVDELE = IVDELE + 1 05320032 + WRITE (I02,80003) IVTNUM 05330032 + IF (ICZERO) 43490, 3501, 43490 05340032 +43490 IF (IVCOMP -7) 23490,13490,23490 05350032 +13490 IVPASS = IVPASS + 1 05360032 + WRITE (I02,80001) IVTNUM 05370032 + GO TO 3501 05380032 +23490 IVFAIL = IVFAIL + 1 05390032 + IVCORR=7 05400032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05410032 + 3501 CONTINUE 05420032 + IVTNUM = 350 05430032 +C 05440032 +C **** TEST 350 **** 05450032 +C 05460032 + IF (ICZERO) 33500, 3500, 33500 05470032 + 3500 CONTINUE 05480032 + IVON01 = 9 05490032 + IVON02 = -4 05500032 + IVCOMP = (IVON01-IVON02) -2 05510032 + GO TO 43500 05520032 +33500 IVDELE = IVDELE + 1 05530032 + WRITE (I02,80003) IVTNUM 05540032 + IF (ICZERO) 43500, 3511, 43500 05550032 +43500 IF (IVCOMP -11) 23500,13500,23500 05560032 +13500 IVPASS = IVPASS + 1 05570032 + WRITE (I02,80001) IVTNUM 05580032 + GO TO 3511 05590032 +23500 IVFAIL = IVFAIL + 1 05600032 + IVCORR = 11 05610032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05620032 + 3511 CONTINUE 05630032 + IVTNUM = 351 05640032 +C 05650032 +C **** TEST 351 **** 05660032 +C 05670032 + IF (ICZERO) 33510, 3510, 33510 05680032 + 3510 CONTINUE 05690032 + IVON01 = 9 05700032 + IVON02 = -4 05710032 + IVCOMP = IVON01-(IVON02-2) 05720032 + GO TO 43510 05730032 +33510 IVDELE = IVDELE + 1 05740032 + WRITE (I02,80003) IVTNUM 05750032 + IF (ICZERO) 43510, 3521, 43510 05760032 +43510 IF (IVCOMP - 15) 23510,13510,23510 05770032 +13510 IVPASS = IVPASS + 1 05780032 + WRITE (I02,80001) IVTNUM 05790032 + GO TO 3521 05800032 +23510 IVFAIL = IVFAIL + 1 05810032 + IVCORR = 15 05820032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05830032 + 3521 CONTINUE 05840032 + IVTNUM = 352 05850032 +C 05860032 +C **** TEST 352 **** 05870032 +C 05880032 + IF (ICZERO) 33520, 3520, 33520 05890032 + 3520 CONTINUE 05900032 + IVON01 = 683 05910032 + IVON03 = 156 05920032 + IVCOMP = (IVON01-101)-IVON03 05930032 + GO TO 43520 05940032 +33520 IVDELE = IVDELE + 1 05950032 + WRITE (I02,80003) IVTNUM 05960032 + IF (ICZERO) 43520, 3531, 43520 05970032 +43520 IF (IVCOMP - 426) 23520,13520,23520 05980032 +13520 IVPASS = IVPASS + 1 05990032 + WRITE (I02,80001) IVTNUM 06000032 + GO TO 3531 06010032 +23520 IVFAIL = IVFAIL + 1 06020032 + IVCORR = 426 06030032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06040032 + 3531 CONTINUE 06050032 + IVTNUM = 353 06060032 +C 06070032 +C **** TEST 353 **** 06080032 +C 06090032 + IF (ICZERO) 33530, 3530, 33530 06100032 + 3530 CONTINUE 06110032 + IVON01 = 683 06120032 + IVON03 = 156 06130032 + IVCOMP = IVON01 -(101-IVON03) 06140032 + GO TO 43530 06150032 +33530 IVDELE = IVDELE + 1 06160032 + WRITE (I02,80003) IVTNUM 06170032 + IF (ICZERO) 43530, 3541, 43530 06180032 +43530 IF (IVCOMP -738) 23530,13530,23530 06190032 +13530 IVPASS = IVPASS + 1 06200032 + WRITE (I02,80001) IVTNUM 06210032 + GO TO 3541 06220032 +23530 IVFAIL = IVFAIL + 1 06230032 + IVCORR = 738 06240032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06250032 + 3541 CONTINUE 06260032 + IVTNUM = 354 06270032 +C 06280032 +C **** TEST 354 **** 06290032 +C 06300032 + IF (ICZERO) 33540, 3540, 33540 06310032 + 3540 CONTINUE 06320032 + IVON01 = 683 06330032 + IVON03 =-156 06340032 + IVCOMP = IVON01 -(101-IVON03) 06350032 + GO TO 43540 06360032 +33540 IVDELE = IVDELE + 1 06370032 + WRITE (I02,80003) IVTNUM 06380032 + IF (ICZERO) 43540, 3551, 43540 06390032 +43540 IF (IVCOMP -426) 23540,13540,23540 06400032 +13540 IVPASS = IVPASS + 1 06410032 + WRITE (I02,80001) IVTNUM 06420032 + GO TO 3551 06430032 +23540 IVFAIL = IVFAIL + 1 06440032 + IVCORR = 426 06450032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06460032 + 3551 CONTINUE 06470032 + IVTNUM = 355 06480032 +C 06490032 +C **** TEST 355 **** 06500032 +C 06510032 + IF (ICZERO) 33550, 3550, 33550 06520032 + 3550 CONTINUE 06530032 + IVON01 = -683 06540032 + IVON03 = -156 06550032 + IVCOMP = (IVON01-101)-IVON03 06560032 + GO TO 43550 06570032 +33550 IVDELE = IVDELE + 1 06580032 + WRITE (I02,80003) IVTNUM 06590032 + IF (ICZERO) 43550, 3561, 43550 06600032 +43550 IF (IVCOMP +628) 23550,13550,23550 06610032 +13550 IVPASS = IVPASS + 1 06620032 + WRITE (I02,80001) IVTNUM 06630032 + GO TO 3561 06640032 +23550 IVFAIL = IVFAIL + 1 06650032 + IVCORR = -628 06660032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06670032 + 3561 CONTINUE 06680032 + IVTNUM = 356 06690032 +C 06700032 +C **** TEST 356 **** 06710032 +C 06720032 + IF (ICZERO) 33560, 3560, 33560 06730032 + 3560 CONTINUE 06740032 + IVON02 = 15687 06750032 + IVON03 = 387 06760032 + IVCOMP = (8542-IVON02)-IVON03 06770032 + GO TO 43560 06780032 +33560 IVDELE = IVDELE + 1 06790032 + WRITE (I02,80003) IVTNUM 06800032 + IF (ICZERO) 43560, 3571, 43560 06810032 +43560 IF (IVCOMP +7532) 23560,13560,23560 06820032 +13560 IVPASS = IVPASS + 1 06830032 + WRITE (I02,80001) IVTNUM 06840032 + GO TO 3571 06850032 +23560 IVFAIL = IVFAIL + 1 06860032 + IVCORR = -7532 06870032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06880032 + 3571 CONTINUE 06890032 + IVTNUM = 357 06900032 +C 06910032 +C **** TEST 357 **** 06920032 +C 06930032 + IF (ICZERO) 33570, 3570, 33570 06940032 + 3570 CONTINUE 06950032 + IVON02= 15687 06960032 + IVON03= 387 06970032 + IVCOMP= 8542-(IVON02-IVON03) 06980032 + GO TO 43570 06990032 +33570 IVDELE = IVDELE + 1 07000032 + WRITE (I02,80003) IVTNUM 07010032 + IF (ICZERO) 43570, 3581, 43570 07020032 +43570 IF (IVCOMP + 6758) 23570,13570,23570 07030032 +13570 IVPASS = IVPASS + 1 07040032 + WRITE (I02,80001) IVTNUM 07050032 + GO TO 3581 07060032 +23570 IVFAIL = IVFAIL + 1 07070032 + IVCORR = -6758 07080032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07090032 + 3581 CONTINUE 07100032 + IVTNUM = 358 07110032 +C 07120032 +C **** TEST 358 **** 07130032 +C 07140032 + IF (ICZERO) 33580, 3580, 33580 07150032 + 3580 CONTINUE 07160032 + IVON02 = -15687 07170032 + IVON03 = 387 07180032 + IVCOMP =(8542-IVON02)-IVON03 07190032 + GO TO 43580 07200032 +33580 IVDELE = IVDELE + 1 07210032 + WRITE (I02,80003) IVTNUM 07220032 + IF (ICZERO) 43580, 3591, 43580 07230032 +43580 IF (IVCOMP - 23842) 23580,13580,23580 07240032 +13580 IVPASS = IVPASS + 1 07250032 + WRITE (I02,80001) IVTNUM 07260032 + GO TO 3591 07270032 +23580 IVFAIL = IVFAIL + 1 07280032 + IVCORR =23842 07290032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07300032 + 3591 CONTINUE 07310032 + IVTNUM = 359 07320032 +C 07330032 +C **** TEST 359 **** 07340032 +C 07350032 + IF (ICZERO) 33590, 3590, 33590 07360032 + 3590 CONTINUE 07370032 + IVON02 = -15687 07380032 + IVON03 = 387 07390032 + IVCOMP = 8542-(IVON02-IVON03) 07400032 + GO TO 43590 07410032 +33590 IVDELE = IVDELE + 1 07420032 + WRITE (I02,80003) IVTNUM 07430032 + IF (ICZERO) 43590, 3601, 43590 07440032 +43590 IF (IVCOMP - 24616) 23590,13590,23590 07450032 +13590 IVPASS = IVPASS + 1 07460032 + WRITE (I02,80001) IVTNUM 07470032 + GO TO 3601 07480032 +23590 IVFAIL = IVFAIL + 1 07490032 + IVCORR = 24616 07500032 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07510032 +C **** END OF TESTS **** 07520032 + 3601 CONTINUE 07530032 +C 07540032 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07550032 +99999 CONTINUE 07560032 + WRITE (I02,90002) 07570032 + WRITE (I02,90006) 07580032 + WRITE (I02,90002) 07590032 + WRITE (I02,90002) 07600032 + WRITE (I02,90007) 07610032 + WRITE (I02,90002) 07620032 + WRITE (I02,90008) IVFAIL 07630032 + WRITE (I02,90009) IVPASS 07640032 + WRITE (I02,90010) IVDELE 07650032 +C 07660032 +C 07670032 +C TERMINATE ROUTINE EXECUTION 07680032 + STOP 07690032 +C 07700032 +C FORMAT STATEMENTS FOR PAGE HEADERS 07710032 +90000 FORMAT ("1") 07720032 +90002 FORMAT (" ") 07730032 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07740032 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07750032 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07760032 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07770032 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07780032 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07790032 +C 07800032 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07810032 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07820032 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07830032 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07840032 +C 07850032 +C FORMAT STATEMENTS FOR TEST RESULTS 07860032 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07870032 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07880032 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07890032 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07900032 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07910032 +C 07920032 +90007 FORMAT (" ",20X,"END OF PROGRAM FM032" ) 07930032 + END 07940032 diff --git a/Fortran/UnitTests/fcvs21_f95/FM032.reference_output b/Fortran/UnitTests/fcvs21_f95/FM032.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM032.reference_output @@ -0,0 +1,54 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 330 PASS + 331 PASS + 332 PASS + 333 PASS + 334 PASS + 335 PASS + 336 PASS + 337 PASS + 338 PASS + 339 PASS + 340 PASS + 341 PASS + 342 PASS + 343 PASS + 344 PASS + 345 PASS + 346 PASS + 347 PASS + 348 PASS + 349 PASS + 350 PASS + 351 PASS + 352 PASS + 353 PASS + 354 PASS + 355 PASS + 356 PASS + 357 PASS + 358 PASS + 359 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM032 + + 0 ERRORS ENCOUNTERED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM033.f b/Fortran/UnitTests/fcvs21_f95/FM033.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM033.f @@ -0,0 +1,842 @@ + PROGRAM FM033 + +C COMMENT SECTION 00010033 +C 00020033 +C FM033 00030033 +C 00040033 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050033 +C FORM 00060033 +C INTEGER VARIABLE = ARITHMETIC EXPRESSION 00070033 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00080033 +C OPERATOR * AND INTEGER CONSTANTS. SOME OF THE TESTS USE PARENS 00090033 +C TO GROUP ELEMENTS IN THE EXPRESSION AND TO ALLOW THE USE OF 00100033 +C NEGATIVE CONSTANTS FOLLOWING THE * OPERATOR. 00110033 +C 00120033 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00130033 +C (1) INTEGER CONSTANT * INTEGER CONSTANT 00140033 +C (2) INTEGER CONSTANT * INTEGER CONSTANT * INTEGER CONSTANT 00150033 +C (3) SAME AS (2) BUT WITH PARENS TO GROUP ELEMENTS 00160033 +C 00170033 +C REFERENCES 00180033 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00190033 +C X3.9-1978 00200033 +C 00210033 +C SECTION 4.3, INTEGER TYPE 00220033 +C SECTION 4.3.1, INTEGER CONSTANT 00230033 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00240033 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00250033 +C 00260033 +C ********************************************************** 00270033 +C 00280033 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00290033 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00300033 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00310033 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00320033 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00330033 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00340033 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00350033 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00360033 +C OF EXECUTING THESE TESTS. 00370033 +C 00380033 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00390033 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00400033 +C 00410033 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00420033 +C 00430033 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00440033 +C SOFTWARE STANDARDS VALIDATION GROUP 00450033 +C BUILDING 225 RM A266 00460033 +C GAITHERSBURG, MD 20899 00470033 +C ********************************************************** 00480033 +C 00490033 +C 00500033 +C 00510033 +C INITIALIZATION SECTION 00520033 +C 00530033 +C INITIALIZE CONSTANTS 00540033 +C ************** 00550033 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00560033 + I01 = 5 00570033 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00580033 + I02 = 6 00590033 +C SYSTEM ENVIRONMENT SECTION 00600033 +C 00610033 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00620033 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00630033 +C (UNIT NUMBER FOR CARD READER). 00640033 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00650033 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00660033 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00670033 +C 00680033 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00690033 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00700033 +C (UNIT NUMBER FOR PRINTER). 00710033 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00720033 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00730033 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00740033 +C 00750033 + IVPASS=0 00760033 + IVFAIL=0 00770033 + IVDELE=0 00780033 + ICZERO=0 00790033 +C 00800033 +C WRITE PAGE HEADERS 00810033 + WRITE (I02,90000) 00820033 + WRITE (I02,90001) 00830033 + WRITE (I02,90002) 00840033 + WRITE (I02, 90002) 00850033 + WRITE (I02,90003) 00860033 + WRITE (I02,90002) 00870033 + WRITE (I02,90004) 00880033 + WRITE (I02,90002) 00890033 + WRITE (I02,90011) 00900033 + WRITE (I02,90002) 00910033 + WRITE (I02,90002) 00920033 + WRITE (I02,90005) 00930033 + WRITE (I02,90006) 00940033 + WRITE (I02,90002) 00950033 +C 00960033 +C TEST SECTION 00970033 +C 00980033 +C ARITHMETIC ASSIGNMENT STATEMENT 00990033 +C 01000033 +C TEST 360 THROUGH TEST 376 CONTAIN TWO INTEGER CONSTANTS AND 01010033 +C OPERATOR * IN AN ARITHMETIC EXPRESSION. 01020033 +C IV = IC * IC 01030033 +C 01040033 +C TEST 360 THROUGH TEST 365 - INTEGER CONSTANTS ARE POSITIVE 01050033 +C 01060033 + 3601 CONTINUE 01070033 + IVTNUM = 360 01080033 +C 01090033 +C **** TEST 360 **** 01100033 +C 01110033 + IF (ICZERO) 33600, 3600, 33600 01120033 + 3600 CONTINUE 01130033 + IVCOMP = 2 * 3 01140033 + GO TO 43600 01150033 +33600 IVDELE = IVDELE + 1 01160033 + WRITE (I02,80003) IVTNUM 01170033 + IF (ICZERO) 43600, 3611, 43600 01180033 +43600 IF (IVCOMP - 6) 23600,13600,23600 01190033 +13600 IVPASS = IVPASS + 1 01200033 + WRITE (I02,80001) IVTNUM 01210033 + GO TO 3611 01220033 +23600 IVFAIL = IVFAIL + 1 01230033 + IVCORR=6 01240033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01250033 + 3611 CONTINUE 01260033 + IVTNUM = 361 01270033 +C 01280033 +C **** TEST 361 **** 01290033 +C 01300033 + IF (ICZERO) 33610, 3610, 33610 01310033 + 3610 CONTINUE 01320033 + IVCOMP = 3*2 01330033 + GO TO 43610 01340033 +33610 IVDELE = IVDELE + 1 01350033 + WRITE (I02,80003) IVTNUM 01360033 + IF (ICZERO) 43610, 3621, 43610 01370033 +43610 IF (IVCOMP-6) 23610,13610,23610 01380033 +13610 IVPASS = IVPASS + 1 01390033 + WRITE (I02,80001) IVTNUM 01400033 + GO TO 3621 01410033 +23610 IVFAIL = IVFAIL + 1 01420033 + IVCORR=6 01430033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01440033 + 3621 CONTINUE 01450033 + IVTNUM = 362 01460033 +C 01470033 +C **** TEST 362 **** 01480033 +C 01490033 + IF (ICZERO) 33620, 3620, 33620 01500033 + 3620 CONTINUE 01510033 + IVCOMP=13*11 01520033 + GO TO 43620 01530033 +33620 IVDELE = IVDELE + 1 01540033 + WRITE (I02,80003) IVTNUM 01550033 + IF (ICZERO) 43620, 3631, 43620 01560033 +43620 IF (IVCOMP-143) 23620,13620,23620 01570033 +13620 IVPASS = IVPASS + 1 01580033 + WRITE (I02,80001) IVTNUM 01590033 + GO TO 3631 01600033 +23620 IVFAIL = IVFAIL + 1 01610033 + IVCORR=143 01620033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01630033 + 3631 CONTINUE 01640033 + IVTNUM = 363 01650033 +C 01660033 +C **** TEST 363 **** 01670033 +C 01680033 + IF (ICZERO) 33630, 3630, 33630 01690033 + 3630 CONTINUE 01700033 + IVCOMP = 223*99 01710033 + GO TO 43630 01720033 +33630 IVDELE = IVDELE + 1 01730033 + WRITE (I02,80003) IVTNUM 01740033 + IF (ICZERO) 43630, 3641, 43630 01750033 +43630 IF (IVCOMP-22077) 23630,13630,23630 01760033 +13630 IVPASS = IVPASS + 1 01770033 + WRITE (I02,80001) IVTNUM 01780033 + GO TO 3641 01790033 +23630 IVFAIL = IVFAIL + 1 01800033 + IVCORR=22077 01810033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01820033 + 3641 CONTINUE 01830033 + IVTNUM = 364 01840033 +C 01850033 +C **** TEST 364 **** 01860033 +C 01870033 + IF (ICZERO) 33640, 3640, 33640 01880033 + 3640 CONTINUE 01890033 + IVCOMP=11235*2 01900033 + GO TO 43640 01910033 +33640 IVDELE = IVDELE + 1 01920033 + WRITE (I02,80003) IVTNUM 01930033 + IF (ICZERO) 43640, 3651, 43640 01940033 +43640 IF (IVCOMP-22470) 23640,13640,23640 01950033 +13640 IVPASS = IVPASS + 1 01960033 + WRITE (I02,80001) IVTNUM 01970033 + GO TO 3651 01980033 +23640 IVFAIL = IVFAIL + 1 01990033 + IVCORR=22470 02000033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02010033 + 3651 CONTINUE 02020033 + IVTNUM = 365 02030033 +C 02040033 +C **** TEST 365 **** 02050033 +C 02060033 + IF (ICZERO) 33650, 3650, 33650 02070033 + 3650 CONTINUE 02080033 + IVCOMP = 2*16383 02090033 + GO TO 43650 02100033 +33650 IVDELE = IVDELE + 1 02110033 + WRITE (I02,80003) IVTNUM 02120033 + IF (ICZERO) 43650, 3661, 43650 02130033 +43650 IF (IVCOMP-32766) 23650,13650,23650 02140033 +13650 IVPASS = IVPASS + 1 02150033 + WRITE (I02,80001) IVTNUM 02160033 + GO TO 3661 02170033 +23650 IVFAIL = IVFAIL + 1 02180033 + IVCORR = 32766 02190033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02200033 +C 02210033 +C TEST 366 THROUGH TEST 371 02220033 +C ONE POSITIVE AND ONE NEGATIVE CONSTANT 02230033 +C 02240033 + 3661 CONTINUE 02250033 + IVTNUM = 366 02260033 +C 02270033 +C **** TEST 366 **** 02280033 +C 02290033 + IF (ICZERO) 33660, 3660, 33660 02300033 + 3660 CONTINUE 02310033 + IVCOMP =2*(-3) 02320033 + GO TO 43660 02330033 +33660 IVDELE = IVDELE + 1 02340033 + WRITE (I02,80003) IVTNUM 02350033 + IF (ICZERO) 43660, 3671, 43660 02360033 +43660 IF (IVCOMP+6) 23660,13660,23660 02370033 +13660 IVPASS = IVPASS + 1 02380033 + WRITE (I02,80001) IVTNUM 02390033 + GO TO 3671 02400033 +23660 IVFAIL = IVFAIL + 1 02410033 + IVCORR = -6 02420033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02430033 + 3671 CONTINUE 02440033 + IVTNUM = 367 02450033 +C 02460033 +C **** TEST 367 **** 02470033 +C 02480033 + IF (ICZERO) 33670, 3670, 33670 02490033 + 3670 CONTINUE 02500033 + IVCOMP=(-2)*3 02510033 + GO TO 43670 02520033 +33670 IVDELE = IVDELE + 1 02530033 + WRITE (I02,80003) IVTNUM 02540033 + IF (ICZERO) 43670, 3681, 43670 02550033 +43670 IF (IVCOMP+6)23670,13670,23670 02560033 +13670 IVPASS = IVPASS + 1 02570033 + WRITE (I02,80001) IVTNUM 02580033 + GO TO 3681 02590033 +23670 IVFAIL = IVFAIL + 1 02600033 + IVCORR =-6 02610033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02620033 + 3681 CONTINUE 02630033 + IVTNUM = 368 02640033 +C 02650033 +C **** TEST 368 **** 02660033 +C 02670033 + IF (ICZERO) 33680, 3680, 33680 02680033 + 3680 CONTINUE 02690033 + IVCOMP= -2*3 02700033 + GO TO 43680 02710033 +33680 IVDELE = IVDELE + 1 02720033 + WRITE (I02,80003) IVTNUM 02730033 + IF (ICZERO) 43680, 3691, 43680 02740033 +43680 IF (IVCOMP +6) 23680,13680,23680 02750033 +13680 IVPASS = IVPASS + 1 02760033 + WRITE (I02,80001) IVTNUM 02770033 + GO TO 3691 02780033 +23680 IVFAIL = IVFAIL + 1 02790033 + IVCORR=-6 02800033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02810033 + 3691 CONTINUE 02820033 + IVTNUM = 369 02830033 +C 02840033 +C **** TEST 369 **** 02850033 +C 02860033 + IF (ICZERO) 33690, 3690, 33690 02870033 + 3690 CONTINUE 02880033 + IVCOMP = (-13)*11 02890033 + GO TO 43690 02900033 +33690 IVDELE = IVDELE + 1 02910033 + WRITE (I02,80003) IVTNUM 02920033 + IF (ICZERO) 43690, 3701, 43690 02930033 +43690 IF (IVCOMP+143) 23690,13690,23690 02940033 +13690 IVPASS = IVPASS + 1 02950033 + WRITE (I02,80001) IVTNUM 02960033 + GO TO 3701 02970033 +23690 IVFAIL = IVFAIL + 1 02980033 + IVCORR=-143 02990033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03000033 + 3701 CONTINUE 03010033 + IVTNUM = 370 03020033 +C 03030033 +C **** TEST 370 **** 03040033 +C 03050033 + IF (ICZERO) 33700, 3700, 33700 03060033 + 3700 CONTINUE 03070033 + IVCOMP = 223 * (-99) 03080033 + GO TO 43700 03090033 +33700 IVDELE = IVDELE + 1 03100033 + WRITE (I02,80003) IVTNUM 03110033 + IF (ICZERO) 43700, 3711, 43700 03120033 +43700 IF (IVCOMP + 22077) 23700,13700,23700 03130033 +13700 IVPASS = IVPASS + 1 03140033 + WRITE (I02,80001) IVTNUM 03150033 + GO TO 3711 03160033 +23700 IVFAIL = IVFAIL + 1 03170033 + IVCORR =-22077 03180033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03190033 + 3711 CONTINUE 03200033 + IVTNUM = 371 03210033 +C 03220033 +C **** TEST 371 **** 03230033 +C 03240033 + IF (ICZERO) 33710, 3710, 33710 03250033 + 3710 CONTINUE 03260033 + IVCOMP= -2 * 16383 03270033 + GO TO 43710 03280033 +33710 IVDELE = IVDELE + 1 03290033 + WRITE (I02,80003) IVTNUM 03300033 + IF (ICZERO) 43710, 3721, 43710 03310033 +43710 IF (IVCOMP+32766) 23710,13710,23710 03320033 +13710 IVPASS = IVPASS + 1 03330033 + WRITE (I02,80001) IVTNUM 03340033 + GO TO 3721 03350033 +23710 IVFAIL = IVFAIL + 1 03360033 + IVCORR= -32766 03370033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03380033 +C 03390033 +C TEST 372 THROUGH TEST 376 - TWO NEGATIVE CONSTANTS 03400033 +C 03410033 + 3721 CONTINUE 03420033 + IVTNUM = 372 03430033 +C 03440033 +C **** TEST 372 **** 03450033 +C 03460033 + IF (ICZERO) 33720, 3720, 33720 03470033 + 3720 CONTINUE 03480033 + IVCOMP=(-2)*(-3) 03490033 + GO TO 43720 03500033 +33720 IVDELE = IVDELE + 1 03510033 + WRITE (I02,80003) IVTNUM 03520033 + IF (ICZERO) 43720, 3731, 43720 03530033 +43720 IF (IVCOMP-6) 23720,13720,23720 03540033 +13720 IVPASS = IVPASS + 1 03550033 + WRITE (I02,80001) IVTNUM 03560033 + GO TO 3731 03570033 +23720 IVFAIL = IVFAIL + 1 03580033 + IVCORR=6 03590033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03600033 + 3731 CONTINUE 03610033 + IVTNUM = 373 03620033 +C 03630033 +C **** TEST 373 **** 03640033 +C 03650033 + IF (ICZERO) 33730, 3730, 33730 03660033 + 3730 CONTINUE 03670033 + IVCOMP = -2*(-3) 03680033 + GO TO 43730 03690033 +33730 IVDELE = IVDELE + 1 03700033 + WRITE (I02,80003) IVTNUM 03710033 + IF (ICZERO) 43730, 3741, 43730 03720033 +43730 IF (IVCOMP-6) 23730,13730,23730 03730033 +13730 IVPASS = IVPASS + 1 03740033 + WRITE (I02,80001) IVTNUM 03750033 + GO TO 3741 03760033 +23730 IVFAIL = IVFAIL + 1 03770033 + IVCORR=6 03780033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03790033 + 3741 CONTINUE 03800033 + IVTNUM = 374 03810033 +C 03820033 +C **** TEST 374 **** 03830033 +C 03840033 + IF (ICZERO) 33740, 3740, 33740 03850033 + 3740 CONTINUE 03860033 + IVCOMP=(-13)*(-11) 03870033 + GO TO 43740 03880033 +33740 IVDELE = IVDELE + 1 03890033 + WRITE (I02,80003) IVTNUM 03900033 + IF (ICZERO) 43740, 3751, 43740 03910033 +43740 IF (IVCOMP-143) 23740,13740,23740 03920033 +13740 IVPASS = IVPASS + 1 03930033 + WRITE (I02,80001) IVTNUM 03940033 + GO TO 3751 03950033 +23740 IVFAIL = IVFAIL + 1 03960033 + IVCORR = 143 03970033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03980033 + 3751 CONTINUE 03990033 + IVTNUM = 375 04000033 +C 04010033 +C **** TEST 375 **** 04020033 +C 04030033 + IF (ICZERO) 33750, 3750, 33750 04040033 + 3750 CONTINUE 04050033 + IVCOMP= -223 *(-99) 04060033 + GO TO 43750 04070033 +33750 IVDELE = IVDELE + 1 04080033 + WRITE (I02,80003) IVTNUM 04090033 + IF (ICZERO) 43750, 3761, 43750 04100033 +43750 IF (IVCOMP - 22077) 23750,13750,23750 04110033 +13750 IVPASS = IVPASS + 1 04120033 + WRITE (I02,80001) IVTNUM 04130033 + GO TO 3761 04140033 +23750 IVFAIL = IVFAIL + 1 04150033 + IVCORR = 22077 04160033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04170033 + 3761 CONTINUE 04180033 + IVTNUM = 376 04190033 +C 04200033 +C **** TEST 376 **** 04210033 +C 04220033 + IF (ICZERO) 33760, 3760, 33760 04230033 + 3760 CONTINUE 04240033 + IVCOMP = (-16383)*(-2) 04250033 + GO TO 43760 04260033 +33760 IVDELE = IVDELE + 1 04270033 + WRITE (I02,80003) IVTNUM 04280033 + IF (ICZERO) 43760, 3771, 43760 04290033 +43760 IF (IVCOMP - 32766) 23760,13760,23760 04300033 +13760 IVPASS = IVPASS + 1 04310033 + WRITE (I02,80001) IVTNUM 04320033 + GO TO 3771 04330033 +23760 IVFAIL = IVFAIL + 1 04340033 + IVCORR =32766 04350033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04360033 +C 04370033 +C TEST 377 THROUGH TEST 394 CONTAIN THREE INTEGER CONSTANTS AND 04380033 +C OPERATOR * IN AN ARITHMETIC EXPRESSION. 04390033 +C IV = IC * IC * IC 04400033 +C 04410033 +C TEST 377 THROUGH TEST 382 - CONSTANTS ARE POSITIVE 04420033 +C 04430033 + 3771 CONTINUE 04440033 + IVTNUM = 377 04450033 +C 04460033 +C **** TEST 377 **** 04470033 +C 04480033 + IF (ICZERO) 33770, 3770, 33770 04490033 + 3770 CONTINUE 04500033 + IVCOMP =2*3*4 04510033 + GO TO 43770 04520033 +33770 IVDELE = IVDELE + 1 04530033 + WRITE (I02,80003) IVTNUM 04540033 + IF (ICZERO) 43770, 3781, 43770 04550033 +43770 IF (IVCOMP-24) 23770,13770,23770 04560033 +13770 IVPASS = IVPASS + 1 04570033 + WRITE (I02,80001) IVTNUM 04580033 + GO TO 3781 04590033 +23770 IVFAIL = IVFAIL + 1 04600033 + IVCORR = 24 04610033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04620033 + 3781 CONTINUE 04630033 + IVTNUM = 378 04640033 +C 04650033 +C **** TEST 378 **** 04660033 +C 04670033 + IF (ICZERO) 33780, 3780, 33780 04680033 + 3780 CONTINUE 04690033 + IVCOMP = 2*3*55 04700033 + GO TO 43780 04710033 +33780 IVDELE = IVDELE + 1 04720033 + WRITE (I02,80003) IVTNUM 04730033 + IF (ICZERO) 43780, 3791, 43780 04740033 +43780 IF (IVCOMP-330) 23780,13780,23780 04750033 +13780 IVPASS = IVPASS + 1 04760033 + WRITE (I02,80001) IVTNUM 04770033 + GO TO 3791 04780033 +23780 IVFAIL = IVFAIL + 1 04790033 + IVCORR = 330 04800033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04810033 + 3791 CONTINUE 04820033 + IVTNUM = 379 04830033 +C 04840033 +C **** TEST 379 **** 04850033 +C 04860033 + IF (ICZERO) 33790, 3790, 33790 04870033 + 3790 CONTINUE 04880033 + IVCOMP = 23*51*13 04890033 + GO TO 43790 04900033 +33790 IVDELE = IVDELE + 1 04910033 + WRITE (I02,80003) IVTNUM 04920033 + IF (ICZERO) 43790, 3801, 43790 04930033 +43790 IF (IVCOMP-15249) 23790,13790,23790 04940033 +13790 IVPASS = IVPASS + 1 04950033 + WRITE (I02,80001) IVTNUM 04960033 + GO TO 3801 04970033 +23790 IVFAIL = IVFAIL + 1 04980033 + IVCORR = 15249 04990033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05000033 + 3801 CONTINUE 05010033 + IVTNUM = 380 05020033 +C 05030033 +C **** TEST 380 **** 05040033 +C 05050033 + IF (ICZERO) 33800, 3800, 33800 05060033 + 3800 CONTINUE 05070033 + IVCOMP = 3* 5461* 2 05080033 + GO TO 43800 05090033 +33800 IVDELE = IVDELE + 1 05100033 + WRITE (I02,80003) IVTNUM 05110033 + IF (ICZERO) 43800, 3811, 43800 05120033 +43800 IF (IVCOMP - 32766) 23800,13800,23800 05130033 +13800 IVPASS = IVPASS + 1 05140033 + WRITE (I02,80001) IVTNUM 05150033 + GO TO 3811 05160033 +23800 IVFAIL = IVFAIL + 1 05170033 + IVCORR = 32766 05180033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05190033 + 3811 CONTINUE 05200033 + IVTNUM = 381 05210033 +C 05220033 +C **** TEST 381 **** 05230033 +C 05240033 + IF (ICZERO) 33810, 3810, 33810 05250033 + 3810 CONTINUE 05260033 + IVCOMP = 16383*2*1 05270033 + GO TO 43810 05280033 +33810 IVDELE = IVDELE + 1 05290033 + WRITE (I02,80003) IVTNUM 05300033 + IF (ICZERO) 43810, 3821, 43810 05310033 +43810 IF (IVCOMP-32766) 23810,13810,23810 05320033 +13810 IVPASS = IVPASS + 1 05330033 + WRITE (I02,80001) IVTNUM 05340033 + GO TO 3821 05350033 +23810 IVFAIL = IVFAIL + 1 05360033 + IVCORR = 32766 05370033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05380033 + 3821 CONTINUE 05390033 + IVTNUM = 382 05400033 +C 05410033 +C **** TEST 382 **** 05420033 +C 05430033 + IF (ICZERO) 33820, 3820, 33820 05440033 + 3820 CONTINUE 05450033 + IVCOMP = 3*53*157 05460033 + GO TO 43820 05470033 +33820 IVDELE = IVDELE + 1 05480033 + WRITE (I02,80003) IVTNUM 05490033 + IF (ICZERO) 43820, 3831, 43820 05500033 +43820 IF (IVCOMP-24963) 23820,13820,23820 05510033 +13820 IVPASS = IVPASS + 1 05520033 + WRITE (I02,80001) IVTNUM 05530033 + GO TO 3831 05540033 +23820 IVFAIL = IVFAIL + 1 05550033 + IVCORR = 24963 05560033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05570033 +C 05580033 +C TEST 383 THROUGH TEST 386 05590033 +C THREE POSITIVE INTEGER CONSTANTS GROUPED WITH PARENS. 05600033 +C 05610033 + 3831 CONTINUE 05620033 + IVTNUM = 383 05630033 +C 05640033 +C **** TEST 383 **** 05650033 +C 05660033 + IF (ICZERO) 33830, 3830, 33830 05670033 + 3830 CONTINUE 05680033 + IVCOMP = (2*3)*4 05690033 + GO TO 43830 05700033 +33830 IVDELE = IVDELE + 1 05710033 + WRITE (I02,80003) IVTNUM 05720033 + IF (ICZERO) 43830, 3841, 43830 05730033 +43830 IF (IVCOMP-24) 23830,13830,23830 05740033 +13830 IVPASS = IVPASS + 1 05750033 + WRITE (I02,80001) IVTNUM 05760033 + GO TO 3841 05770033 +23830 IVFAIL = IVFAIL + 1 05780033 + IVCORR = 24 05790033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05800033 + 3841 CONTINUE 05810033 + IVTNUM = 384 05820033 +C 05830033 +C **** TEST 384 **** 05840033 +C 05850033 + IF (ICZERO) 33840, 3840, 33840 05860033 + 3840 CONTINUE 05870033 + IVCOMP = 2*(3*4) 05880033 + GO TO 43840 05890033 +33840 IVDELE = IVDELE + 1 05900033 + WRITE (I02,80003) IVTNUM 05910033 + IF (ICZERO) 43840, 3851, 43840 05920033 +43840 IF (IVCOMP-24) 23840,13840,23840 05930033 +13840 IVPASS = IVPASS + 1 05940033 + WRITE (I02,80001) IVTNUM 05950033 + GO TO 3851 05960033 +23840 IVFAIL = IVFAIL + 1 05970033 + IVCORR = 24 05980033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05990033 + 3851 CONTINUE 06000033 + IVTNUM = 385 06010033 +C 06020033 +C **** TEST 385 **** 06030033 +C 06040033 + IF (ICZERO) 33850, 3850, 33850 06050033 + 3850 CONTINUE 06060033 + IVCOMP = (3*(+53)) * (+157) 06070033 + GO TO 43850 06080033 +33850 IVDELE = IVDELE + 1 06090033 + WRITE (I02,80003) IVTNUM 06100033 + IF (ICZERO) 43850, 3861, 43850 06110033 +43850 IF (IVCOMP-24963) 23850,13850,23850 06120033 +13850 IVPASS = IVPASS + 1 06130033 + WRITE (I02,80001) IVTNUM 06140033 + GO TO 3861 06150033 +23850 IVFAIL = IVFAIL + 1 06160033 + IVCORR = 24963 06170033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06180033 + 3861 CONTINUE 06190033 + IVTNUM = 386 06200033 +C 06210033 +C **** TEST 386 **** 06220033 +C 06230033 + IF (ICZERO) 33860, 3860, 33860 06240033 + 3860 CONTINUE 06250033 + IVCOMP = 3 *((+53)*157) 06260033 + GO TO 43860 06270033 +33860 IVDELE = IVDELE + 1 06280033 + WRITE (I02,80003) IVTNUM 06290033 + IF (ICZERO) 43860, 3871, 43860 06300033 +43860 IF (IVCOMP-24963) 23860,13860,23860 06310033 +13860 IVPASS = IVPASS + 1 06320033 + WRITE (I02,80001) IVTNUM 06330033 + GO TO 3871 06340033 +23860 IVFAIL = IVFAIL + 1 06350033 + IVCORR=24963 06360033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06370033 +C 06380033 +C TEST 387 THROUGH TEST 391 06390033 +C BOTH POSITIVE AND NEGATIVE CONSTANTS IN ARITHMETIC EXPRESSION.06400033 +C 06410033 + 3871 CONTINUE 06420033 + IVTNUM = 387 06430033 +C 06440033 +C **** TEST 387 **** 06450033 +C 06460033 + IF (ICZERO) 33870, 3870, 33870 06470033 + 3870 CONTINUE 06480033 + IVCOMP = 2*3*(-4) 06490033 + GO TO 43870 06500033 +33870 IVDELE = IVDELE + 1 06510033 + WRITE (I02,80003) IVTNUM 06520033 + IF (ICZERO) 43870, 3881, 43870 06530033 +43870 IF (IVCOMP + 24) 23870,13870,23870 06540033 +13870 IVPASS = IVPASS + 1 06550033 + WRITE (I02,80001) IVTNUM 06560033 + GO TO 3881 06570033 +23870 IVFAIL = IVFAIL + 1 06580033 + IVCORR = -24 06590033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06600033 + 3881 CONTINUE 06610033 + IVTNUM = 388 06620033 +C 06630033 +C **** TEST 388 **** 06640033 +C 06650033 + IF (ICZERO) 33880, 3880, 33880 06660033 + 3880 CONTINUE 06670033 + IVCOMP = 2*(-3)*(+4) 06680033 + GO TO 43880 06690033 +33880 IVDELE = IVDELE + 1 06700033 + WRITE (I02,80003) IVTNUM 06710033 + IF (ICZERO) 43880, 3891, 43880 06720033 +43880 IF (IVCOMP + 24) 23880,13880,23880 06730033 +13880 IVPASS = IVPASS + 1 06740033 + WRITE (I02,80001) IVTNUM 06750033 + GO TO 3891 06760033 +23880 IVFAIL = IVFAIL + 1 06770033 + IVCORR = -24 06780033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06790033 + 3891 CONTINUE 06800033 + IVTNUM = 389 06810033 +C 06820033 +C **** TEST 389 **** 06830033 +C 06840033 + IF (ICZERO) 33890, 3890, 33890 06850033 + 3890 CONTINUE 06860033 + IVCOMP = (-2)*3*4 06870033 + GO TO 43890 06880033 +33890 IVDELE = IVDELE + 1 06890033 + WRITE (I02,80003) IVTNUM 06900033 + IF (ICZERO) 43890, 3901, 43890 06910033 +43890 IF (IVCOMP+24) 23890,13890,23890 06920033 +13890 IVPASS = IVPASS + 1 06930033 + WRITE (I02,80001) IVTNUM 06940033 + GO TO 3901 06950033 +23890 IVFAIL = IVFAIL + 1 06960033 + IVCORR = -24 06970033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06980033 + 3901 CONTINUE 06990033 + IVTNUM = 390 07000033 +C 07010033 +C **** TEST 390 **** 07020033 +C 07030033 + IF (ICZERO) 33900, 3900, 33900 07040033 + 3900 CONTINUE 07050033 + IVCOMP = -2*3*4 07060033 + GO TO 43900 07070033 +33900 IVDELE = IVDELE + 1 07080033 + WRITE (I02,80003) IVTNUM 07090033 + IF (ICZERO) 43900, 3911, 43900 07100033 +43900 IF (IVCOMP+24) 23900,13900,23900 07110033 +13900 IVPASS = IVPASS + 1 07120033 + WRITE (I02,80001) IVTNUM 07130033 + GO TO 3911 07140033 +23900 IVFAIL = IVFAIL + 1 07150033 + IVCORR = -24 07160033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07170033 + 3911 CONTINUE 07180033 + IVTNUM = 391 07190033 +C 07200033 +C **** TEST 391 **** 07210033 +C 07220033 + IF (ICZERO) 33910, 3910, 33910 07230033 + 3910 CONTINUE 07240033 + IVCOMP = +2 * (-3) * (-4) 07250033 + GO TO 43910 07260033 +33910 IVDELE = IVDELE + 1 07270033 + WRITE (I02,80003) IVTNUM 07280033 + IF (ICZERO) 43910, 3921, 43910 07290033 +43910 IF (IVCOMP - 24) 23910,13910,23910 07300033 +13910 IVPASS = IVPASS + 1 07310033 + WRITE (I02,80001) IVTNUM 07320033 + GO TO 3921 07330033 +23910 IVFAIL = IVFAIL + 1 07340033 + IVCORR = 24 07350033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07360033 +C 07370033 +C TEST 392 THROUGH TEST 394 07380033 +C ALL CONSTANTS ARE NEGATIVE. 07390033 +C 07400033 + 3921 CONTINUE 07410033 + IVTNUM = 392 07420033 +C 07430033 +C **** TEST 392 **** 07440033 +C 07450033 + IF (ICZERO) 33920, 3920, 33920 07460033 + 3920 CONTINUE 07470033 + IVCOMP = (-2)*(-3)*(-4) 07480033 + GO TO 43920 07490033 +33920 IVDELE = IVDELE + 1 07500033 + WRITE (I02,80003) IVTNUM 07510033 + IF (ICZERO) 43920, 3931, 43920 07520033 +43920 IF (IVCOMP+24) 23920,13920,23920 07530033 +13920 IVPASS = IVPASS + 1 07540033 + WRITE (I02,80001) IVTNUM 07550033 + GO TO 3931 07560033 +23920 IVFAIL = IVFAIL + 1 07570033 + IVCORR = -24 07580033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07590033 + 3931 CONTINUE 07600033 + IVTNUM = 393 07610033 +C 07620033 +C **** TEST 393 **** 07630033 +C 07640033 + IF (ICZERO) 33930, 3930, 33930 07650033 + 3930 CONTINUE 07660033 + IVCOMP = (-23)*(-51)*(-13) 07670033 + GO TO 43930 07680033 +33930 IVDELE = IVDELE + 1 07690033 + WRITE (I02,80003) IVTNUM 07700033 + IF (ICZERO) 43930, 3941, 43930 07710033 +43930 IF (IVCOMP + 15249) 23930,13930,23930 07720033 +13930 IVPASS = IVPASS + 1 07730033 + WRITE (I02,80001) IVTNUM 07740033 + GO TO 3941 07750033 +23930 IVFAIL = IVFAIL + 1 07760033 + IVCORR = -15249 07770033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07780033 + 3941 CONTINUE 07790033 + IVTNUM = 394 07800033 +C 07810033 +C **** TEST 394 **** 07820033 +C 07830033 + IF (ICZERO) 33940, 3940, 33940 07840033 + 3940 CONTINUE 07850033 + IVCOMP = -3 * (-53)*( -157) 07860033 + GO TO 43940 07870033 +33940 IVDELE = IVDELE + 1 07880033 + WRITE (I02,80003) IVTNUM 07890033 + IF (ICZERO) 43940, 3951, 43940 07900033 +43940 IF (IVCOMP +24963) 23940,13940,23940 07910033 +13940 IVPASS = IVPASS + 1 07920033 + WRITE (I02,80001) IVTNUM 07930033 + GO TO 3951 07940033 +23940 IVFAIL = IVFAIL + 1 07950033 + IVCORR = -24963 07960033 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07970033 +C **** END OF TESTS **** 07980033 + 3951 CONTINUE 07990033 +C 08000033 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08010033 +99999 CONTINUE 08020033 + WRITE (I02,90002) 08030033 + WRITE (I02,90006) 08040033 + WRITE (I02,90002) 08050033 + WRITE (I02,90002) 08060033 + WRITE (I02,90007) 08070033 + WRITE (I02,90002) 08080033 + WRITE (I02,90008) IVFAIL 08090033 + WRITE (I02,90009) IVPASS 08100033 + WRITE (I02,90010) IVDELE 08110033 +C 08120033 +C 08130033 +C TERMINATE ROUTINE EXECUTION 08140033 + STOP 08150033 +C 08160033 +C FORMAT STATEMENTS FOR PAGE HEADERS 08170033 +90000 FORMAT ("1") 08180033 +90002 FORMAT (" ") 08190033 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08200033 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08210033 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08220033 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08230033 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08240033 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08250033 +C 08260033 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08270033 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08280033 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08290033 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08300033 +C 08310033 +C FORMAT STATEMENTS FOR TEST RESULTS 08320033 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08330033 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08340033 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08350033 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08360033 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08370033 +C 08380033 +90007 FORMAT (" ",20X,"END OF PROGRAM FM033" ) 08390033 + END 08400033 diff --git a/Fortran/UnitTests/fcvs21_f95/FM033.reference_output b/Fortran/UnitTests/fcvs21_f95/FM033.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM033.reference_output @@ -0,0 +1,59 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 360 PASS + 361 PASS + 362 PASS + 363 PASS + 364 PASS + 365 PASS + 366 PASS + 367 PASS + 368 PASS + 369 PASS + 370 PASS + 371 PASS + 372 PASS + 373 PASS + 374 PASS + 375 PASS + 376 PASS + 377 PASS + 378 PASS + 379 PASS + 380 PASS + 381 PASS + 382 PASS + 383 PASS + 384 PASS + 385 PASS + 386 PASS + 387 PASS + 388 PASS + 389 PASS + 390 PASS + 391 PASS + 392 PASS + 393 PASS + 394 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM033 + + 0 ERRORS ENCOUNTERED + 35 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM034.f b/Fortran/UnitTests/fcvs21_f95/FM034.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM034.f @@ -0,0 +1,893 @@ + PROGRAM FM034 + +C COMMENT SECTION 00010034 +C 00020034 +C FM034 00030034 +C 00040034 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050034 +C FORM 00060034 +C INTEGER VARIABLE = ARITHMETIC EXPRESSION 00070034 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00080034 +C OPERATOR *, INTEGER VARIABLE AND INTEGER CONSTANT. SOME OF THE 00090034 +C TESTS USE PARENTHESES TO GROUP ELEMENTS IN THE EXPRESSION AND TO 00100034 +C ALLOW THE USE OF NEGATIVE CONSTANTS FOLLOWING THE * OPERATOR. 00110034 +C THE INTEGER VARIABLES CONTAIN POSITIVE AND NEGATIVE VALUES. 00120034 +C 00130034 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00140034 +C (1) INTEGER VARIABLE * INTEGER CONSTANT 00150034 +C INTEGER CONSTANT * INTEGER VARIABLE 00160034 +C (2) INTEGER CONSTANT * INTEGER VARIABLE * INTEGER CONSTANT 00170034 +C (3) SAME AS (2) BUT WITH PARENS TO GROUP ELEMENTS. 00180034 +C 00190034 +C REFERENCES 00200034 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00210034 +C X3.9-1978 00220034 +C 00230034 +C SECTION 4.3, INTEGER TYPE 00240034 +C SECTION 4.3.1, INTEGER CONSTANT 00250034 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00260034 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00270034 +C 00280034 +C ********************************************************** 00290034 +C 00300034 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00310034 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00320034 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00330034 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00340034 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00350034 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00360034 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00370034 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00380034 +C OF EXECUTING THESE TESTS. 00390034 +C 00400034 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00410034 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00420034 +C 00430034 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00440034 +C 00450034 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00460034 +C SOFTWARE STANDARDS VALIDATION GROUP 00470034 +C BUILDING 225 RM A266 00480034 +C GAITHERSBURG, MD 20899 00490034 +C ********************************************************** 00500034 +C 00510034 +C 00520034 +C 00530034 +C INITIALIZATION SECTION 00540034 +C 00550034 +C INITIALIZE CONSTANTS 00560034 +C ************** 00570034 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00580034 + I01 = 5 00590034 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00600034 + I02 = 6 00610034 +C SYSTEM ENVIRONMENT SECTION 00620034 +C 00630034 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00640034 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00650034 +C (UNIT NUMBER FOR CARD READER). 00660034 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00670034 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00680034 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00690034 +C 00700034 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00710034 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00720034 +C (UNIT NUMBER FOR PRINTER). 00730034 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00740034 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00750034 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00760034 +C 00770034 + IVPASS=0 00780034 + IVFAIL=0 00790034 + IVDELE=0 00800034 + ICZERO=0 00810034 +C 00820034 +C WRITE PAGE HEADERS 00830034 + WRITE (I02,90000) 00840034 + WRITE (I02,90001) 00850034 + WRITE (I02,90002) 00860034 + WRITE (I02, 90002) 00870034 + WRITE (I02,90003) 00880034 + WRITE (I02,90002) 00890034 + WRITE (I02,90004) 00900034 + WRITE (I02,90002) 00910034 + WRITE (I02,90011) 00920034 + WRITE (I02,90002) 00930034 + WRITE (I02,90002) 00940034 + WRITE (I02,90005) 00950034 + WRITE (I02,90006) 00960034 + WRITE (I02,90002) 00970034 +C 00980034 +C TEST SECTION 00990034 +C 01000034 +C ARITHMETIC ASSIGNMENT STATEMENT 01010034 +C 01020034 +C TEST 395 THROUGH TEST 414 CONTAIN AN INTEGER VARIABLE, AN INTEGER 01030034 +C CONSTANT, AND OPERATOR * IN AN ARITHMETIC EXPRESSION. 01040034 +C 01050034 +C TEST 395 THROUGH TEST 406 - IV= IV * IC 01060034 +C 01070034 +C TEST 395 THROUGH TEST 398 01080034 +C POSITIVE INTEGER VARIABLE, POSITIVE INTEGER CONSTANT 01090034 +C 01100034 + 3951 CONTINUE 01110034 + IVTNUM = 395 01120034 +C 01130034 +C **** TEST 395 **** 01140034 +C 01150034 + IF (ICZERO) 33950, 3950, 33950 01160034 + 3950 CONTINUE 01170034 + IVON01 = 2 01180034 + IVCOMP = IVON01 * 3 01190034 + GO TO 43950 01200034 +33950 IVDELE = IVDELE + 1 01210034 + WRITE (I02,80003) IVTNUM 01220034 + IF (ICZERO) 43950, 3961, 43950 01230034 +43950 IF (IVCOMP -6) 23950,13950,23950 01240034 +13950 IVPASS = IVPASS + 1 01250034 + WRITE (I02,80001) IVTNUM 01260034 + GO TO 3961 01270034 +23950 IVFAIL = IVFAIL + 1 01280034 + IVCORR =6 01290034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01300034 + 3961 CONTINUE 01310034 + IVTNUM = 396 01320034 +C 01330034 +C **** TEST 396 **** 01340034 +C 01350034 + IF (ICZERO) 33960, 3960, 33960 01360034 + 3960 CONTINUE 01370034 + IVON01 = 13 01380034 + IVCOMP = IVON01 * 11 01390034 + GO TO 43960 01400034 +33960 IVDELE = IVDELE + 1 01410034 + WRITE (I02,80003) IVTNUM 01420034 + IF (ICZERO) 43960, 3971, 43960 01430034 +43960 IF (IVCOMP - 143) 23960,13960,23960 01440034 +13960 IVPASS = IVPASS + 1 01450034 + WRITE (I02,80001) IVTNUM 01460034 + GO TO 3971 01470034 +23960 IVFAIL = IVFAIL + 1 01480034 + IVCORR = 143 01490034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01500034 + 3971 CONTINUE 01510034 + IVTNUM = 397 01520034 +C 01530034 +C **** TEST 397 **** 01540034 +C 01550034 + IF (ICZERO) 33970, 3970, 33970 01560034 + 3970 CONTINUE 01570034 + IVON01 = 223 01580034 + IVCOMP = IVON01 * 99 01590034 + GO TO 43970 01600034 +33970 IVDELE = IVDELE + 1 01610034 + WRITE (I02,80003) IVTNUM 01620034 + IF (ICZERO) 43970, 3981, 43970 01630034 +43970 IF (IVCOMP - 22077) 23970,13970,23970 01640034 +13970 IVPASS = IVPASS + 1 01650034 + WRITE (I02,80001) IVTNUM 01660034 + GO TO 3981 01670034 +23970 IVFAIL = IVFAIL + 1 01680034 + IVCORR = 22077 01690034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01700034 + 3981 CONTINUE 01710034 + IVTNUM = 398 01720034 +C 01730034 +C **** TEST 398 **** 01740034 +C 01750034 + IF (ICZERO) 33980, 3980, 33980 01760034 + 3980 CONTINUE 01770034 + IVON01 = 11235 01780034 + IVCOMP = IVON01 * 2 01790034 + GO TO 43980 01800034 +33980 IVDELE = IVDELE + 1 01810034 + WRITE (I02,80003) IVTNUM 01820034 + IF (ICZERO) 43980, 3991, 43980 01830034 +43980 IF (IVCOMP - 22470) 23980,13980,23980 01840034 +13980 IVPASS = IVPASS + 1 01850034 + WRITE (I02,80001) IVTNUM 01860034 + GO TO 3991 01870034 +23980 IVFAIL = IVFAIL + 1 01880034 + IVCORR = 22470 01890034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01900034 +C 01910034 +C TEST 399 THROUGH TEST 402 01920034 +C NEGATIVE INTEGER VARIABLE, POSITIVE INTEGER CONSTANT 01930034 +C 01940034 + 3991 CONTINUE 01950034 + IVTNUM = 399 01960034 +C 01970034 +C **** TEST 399 **** 01980034 +C 01990034 + IF (ICZERO) 33990, 3990, 33990 02000034 + 3990 CONTINUE 02010034 + IVON01 = -2 02020034 + IVCOMP = IVON01 * 3 02030034 + GO TO 43990 02040034 +33990 IVDELE = IVDELE + 1 02050034 + WRITE (I02,80003) IVTNUM 02060034 + IF (ICZERO) 43990, 4001, 43990 02070034 +43990 IF (IVCOMP +6) 23990,13990,23990 02080034 +13990 IVPASS = IVPASS + 1 02090034 + WRITE (I02,80001) IVTNUM 02100034 + GO TO 4001 02110034 +23990 IVFAIL = IVFAIL + 1 02120034 + IVCORR = -6 02130034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02140034 + 4001 CONTINUE 02150034 + IVTNUM = 400 02160034 +C 02170034 +C **** TEST 400 **** 02180034 +C 02190034 + IF (ICZERO) 34000, 4000, 34000 02200034 + 4000 CONTINUE 02210034 + IVON01 = -13 02220034 + IVCOMP =IVON01*11 02230034 + GO TO 44000 02240034 +34000 IVDELE = IVDELE + 1 02250034 + WRITE (I02,80003) IVTNUM 02260034 + IF (ICZERO) 44000, 4011, 44000 02270034 +44000 IF (IVCOMP +143) 24000,14000,24000 02280034 +14000 IVPASS = IVPASS + 1 02290034 + WRITE (I02,80001) IVTNUM 02300034 + GO TO 4011 02310034 +24000 IVFAIL = IVFAIL + 1 02320034 + IVCORR = -143 02330034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02340034 + 4011 CONTINUE 02350034 + IVTNUM = 401 02360034 +C 02370034 +C **** TEST 401 **** 02380034 +C 02390034 + IF (ICZERO) 34010, 4010, 34010 02400034 + 4010 CONTINUE 02410034 + IVON01 = -223 02420034 + IVCOMP = IVON01*99 02430034 + GO TO 44010 02440034 +34010 IVDELE = IVDELE + 1 02450034 + WRITE (I02,80003) IVTNUM 02460034 + IF (ICZERO) 44010, 4021, 44010 02470034 +44010 IF (IVCOMP + 22077) 24010,14010,24010 02480034 +14010 IVPASS = IVPASS + 1 02490034 + WRITE (I02,80001) IVTNUM 02500034 + GO TO 4021 02510034 +24010 IVFAIL = IVFAIL + 1 02520034 + IVCORR = -22077 02530034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02540034 + 4021 CONTINUE 02550034 + IVTNUM = 402 02560034 +C 02570034 +C **** TEST 402 **** 02580034 +C 02590034 + IF (ICZERO) 34020, 4020, 34020 02600034 + 4020 CONTINUE 02610034 + IVON01 = -11235 02620034 + IVCOMP = IVON01*2 02630034 + GO TO 44020 02640034 +34020 IVDELE = IVDELE + 1 02650034 + WRITE (I02,80003) IVTNUM 02660034 + IF (ICZERO) 44020, 4031, 44020 02670034 +44020 IF (IVCOMP+22470) 24020,14020,24020 02680034 +14020 IVPASS = IVPASS + 1 02690034 + WRITE (I02,80001) IVTNUM 02700034 + GO TO 4031 02710034 +24020 IVFAIL = IVFAIL + 1 02720034 + IVCORR = -22470 02730034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02740034 +C 02750034 +C TEST 403 AND TEST 404 02760034 +C NEGATIVE INTEGER VARIABLE, NEGATIVE INTEGER CONSTANT 02770034 +C 02780034 + 4031 CONTINUE 02790034 + IVTNUM = 403 02800034 +C 02810034 +C **** TEST 403 **** 02820034 +C 02830034 + IF (ICZERO) 34030, 4030, 34030 02840034 + 4030 CONTINUE 02850034 + IVON01=-2 02860034 + IVCOMP = IVON01*(-3) 02870034 + GO TO 44030 02880034 +34030 IVDELE = IVDELE + 1 02890034 + WRITE (I02,80003) IVTNUM 02900034 + IF (ICZERO) 44030, 4041, 44030 02910034 +44030 IF (IVCOMP -6) 24030,14030,24030 02920034 +14030 IVPASS = IVPASS + 1 02930034 + WRITE (I02,80001) IVTNUM 02940034 + GO TO 4041 02950034 +24030 IVFAIL = IVFAIL + 1 02960034 + IVCORR =6 02970034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02980034 + 4041 CONTINUE 02990034 + IVTNUM = 404 03000034 +C 03010034 +C **** TEST 404 **** 03020034 +C 03030034 + IF (ICZERO) 34040, 4040, 34040 03040034 + 4040 CONTINUE 03050034 + IVON01 = -13 03060034 + IVCOMP = IVON01 * (-11) 03070034 + GO TO 44040 03080034 +34040 IVDELE = IVDELE + 1 03090034 + WRITE (I02,80003) IVTNUM 03100034 + IF (ICZERO) 44040, 4051, 44040 03110034 +44040 IF (IVCOMP -143) 24040,14040,24040 03120034 +14040 IVPASS = IVPASS + 1 03130034 + WRITE (I02,80001) IVTNUM 03140034 + GO TO 4051 03150034 +24040 IVFAIL = IVFAIL + 1 03160034 + IVCORR = 143 03170034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03180034 +C 03190034 +C TEST 405 AND TEST 406 03200034 +C POSITIVE INTEGER VARIABLE, NEGATIVE INTEGER CONSTANT 03210034 +C 03220034 + 4051 CONTINUE 03230034 + IVTNUM = 405 03240034 +C 03250034 +C **** TEST 405 **** 03260034 +C 03270034 + IF (ICZERO) 34050, 4050, 34050 03280034 + 4050 CONTINUE 03290034 + IVON01 = 223 03300034 + IVCOMP = IVON01 * (-99) 03310034 + GO TO 44050 03320034 +34050 IVDELE = IVDELE + 1 03330034 + WRITE (I02,80003) IVTNUM 03340034 + IF (ICZERO) 44050, 4061, 44050 03350034 +44050 IF (IVCOMP + 22077) 24050,14050,24050 03360034 +14050 IVPASS = IVPASS + 1 03370034 + WRITE (I02,80001) IVTNUM 03380034 + GO TO 4061 03390034 +24050 IVFAIL = IVFAIL + 1 03400034 + IVCORR = -22077 03410034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03420034 + 4061 CONTINUE 03430034 + IVTNUM = 406 03440034 +C 03450034 +C **** TEST 406 **** 03460034 +C 03470034 + IF (ICZERO) 34060, 4060, 34060 03480034 + 4060 CONTINUE 03490034 + IVON01 = 11235 03500034 + IVCOMP = IVON01 * (-2) 03510034 + GO TO 44060 03520034 +34060 IVDELE = IVDELE + 1 03530034 + WRITE (I02,80003) IVTNUM 03540034 + IF (ICZERO) 44060, 4071, 44060 03550034 +44060 IF (IVCOMP + 22470) 24060,14060,24060 03560034 +14060 IVPASS = IVPASS + 1 03570034 + WRITE (I02,80001) IVTNUM 03580034 + GO TO 4071 03590034 +24060 IVFAIL = IVFAIL + 1 03600034 + IVCORR = -22470 03610034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03620034 +C 03630034 +C TEST 407 THROUGH TEST 414 - IV = IC * IV 03640034 +C 03650034 +C TEST 407 AND TEST 408 03660034 +C POSITIVE INTEGER CONSTANT, POSITIVE INTEGER VARIABLE 03670034 +C 03680034 + 4071 CONTINUE 03690034 + IVTNUM = 407 03700034 +C 03710034 +C **** TEST 407 **** 03720034 +C 03730034 + IF (ICZERO) 34070, 4070, 34070 03740034 + 4070 CONTINUE 03750034 + IVON02 = 11 03760034 + IVCOMP = 13*IVON02 03770034 + GO TO 44070 03780034 +34070 IVDELE = IVDELE + 1 03790034 + WRITE (I02,80003) IVTNUM 03800034 + IF (ICZERO) 44070, 4081, 44070 03810034 +44070 IF (IVCOMP - 143) 24070,14070,24070 03820034 +14070 IVPASS = IVPASS + 1 03830034 + WRITE (I02,80001) IVTNUM 03840034 + GO TO 4081 03850034 +24070 IVFAIL = IVFAIL + 1 03860034 + IVCORR = 143 03870034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03880034 + 4081 CONTINUE 03890034 + IVTNUM = 408 03900034 +C 03910034 +C **** TEST 408 **** 03920034 +C 03930034 + IF (ICZERO) 34080, 4080, 34080 03940034 + 4080 CONTINUE 03950034 + IVON02 = +11 03960034 + IVCOMP = +13 * IVON02 03970034 + GO TO 44080 03980034 +34080 IVDELE = IVDELE + 1 03990034 + WRITE (I02,80003) IVTNUM 04000034 + IF (ICZERO) 44080, 4091, 44080 04010034 +44080 IF (IVCOMP - 143) 24080,14080,24080 04020034 +14080 IVPASS = IVPASS + 1 04030034 + WRITE (I02,80001) IVTNUM 04040034 + GO TO 4091 04050034 +24080 IVFAIL = IVFAIL + 1 04060034 + IVCORR = 143 04070034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04080034 +C 04090034 +C TEST 409 AND TEST 410 04100034 +C POSITIVE INTEGER CONSTANT, NEGATIVE INTEGER VARIABLE 04110034 +C 04120034 + 4091 CONTINUE 04130034 + IVTNUM = 409 04140034 +C 04150034 +C **** TEST 409 **** 04160034 +C 04170034 + IF (ICZERO) 34090, 4090, 34090 04180034 + 4090 CONTINUE 04190034 + IVON02 = -99 04200034 + IVCOMP = 223 * IVON02 04210034 + GO TO 44090 04220034 +34090 IVDELE = IVDELE + 1 04230034 + WRITE (I02,80003) IVTNUM 04240034 + IF (ICZERO) 44090, 4101, 44090 04250034 +44090 IF (IVCOMP + 22077) 24090,14090,24090 04260034 +14090 IVPASS = IVPASS + 1 04270034 + WRITE (I02,80001) IVTNUM 04280034 + GO TO 4101 04290034 +24090 IVFAIL = IVFAIL + 1 04300034 + IVCORR =-22077 04310034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04320034 + 4101 CONTINUE 04330034 + IVTNUM = 410 04340034 +C 04350034 +C **** TEST 410 **** 04360034 +C 04370034 + IF (ICZERO) 34100, 4100, 34100 04380034 + 4100 CONTINUE 04390034 + IVON02 = -99 04400034 + IVCOMP = +223*IVON02 04410034 + GO TO 44100 04420034 +34100 IVDELE = IVDELE + 1 04430034 + WRITE (I02,80003) IVTNUM 04440034 + IF (ICZERO) 44100, 4111, 44100 04450034 +44100 IF (IVCOMP + 22077) 24100,14100,24100 04460034 +14100 IVPASS = IVPASS + 1 04470034 + WRITE (I02,80001) IVTNUM 04480034 + GO TO 4111 04490034 +24100 IVFAIL = IVFAIL + 1 04500034 + IVCORR = -22077 04510034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04520034 +C 04530034 +C TEST 411 AND TEST 412 04540034 +C NEGATIVE INTEGER CONSTANT, POSITIVE INTEGER VARIABLE 04550034 +C 04560034 + 4111 CONTINUE 04570034 + IVTNUM = 411 04580034 +C 04590034 +C **** TEST 411 **** 04600034 +C 04610034 + IF (ICZERO) 34110, 4110, 34110 04620034 + 4110 CONTINUE 04630034 + IVON02 = 2 04640034 + IVCOMP = (-11235) * IVON02 04650034 + GO TO 44110 04660034 +34110 IVDELE = IVDELE + 1 04670034 + WRITE (I02,80003) IVTNUM 04680034 + IF (ICZERO) 44110, 4121, 44110 04690034 +44110 IF (IVCOMP + 22470) 24110,14110,24110 04700034 +14110 IVPASS = IVPASS + 1 04710034 + WRITE (I02,80001) IVTNUM 04720034 + GO TO 4121 04730034 +24110 IVFAIL = IVFAIL + 1 04740034 + IVCORR = -22470 04750034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04760034 + 4121 CONTINUE 04770034 + IVTNUM = 412 04780034 +C 04790034 +C **** TEST 412 **** 04800034 +C 04810034 + IF (ICZERO) 34120, 4120, 34120 04820034 + 4120 CONTINUE 04830034 + IVON02 = +2 04840034 + IVCOMP = -11235 * IVON02 04850034 + GO TO 44120 04860034 +34120 IVDELE = IVDELE + 1 04870034 + WRITE (I02,80003) IVTNUM 04880034 + IF (ICZERO) 44120, 4131, 44120 04890034 +44120 IF (IVCOMP + 22470) 24120,14120,24120 04900034 +14120 IVPASS=IVPASS + 1 04910034 + WRITE (I02,80001) IVTNUM 04920034 + GO TO 4131 04930034 +24120 IVFAIL = IVFAIL + 1 04940034 + IVCORR = -22470 04950034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04960034 +C 04970034 +C TEST 413 AND TEST 414 04980034 +C NEGATIVE INTEGER CONSTANT, NEGATIVE INTEGER VARIABLE 04990034 +C 05000034 + 4131 CONTINUE 05010034 + IVTNUM = 413 05020034 +C 05030034 +C **** TEST 413 **** 05040034 +C 05050034 + IF (ICZERO) 34130, 4130, 34130 05060034 + 4130 CONTINUE 05070034 + IVON02 = -3 05080034 + IVCOMP = (-2) * IVON02 05090034 + GO TO 44130 05100034 +34130 IVDELE = IVDELE + 1 05110034 + WRITE (I02,80003) IVTNUM 05120034 + IF (ICZERO) 44130, 4141, 44130 05130034 +44130 IF (IVCOMP - 6) 24130,14130,24130 05140034 +14130 IVPASS = IVPASS + 1 05150034 + WRITE (I02,80001) IVTNUM 05160034 + GO TO 4141 05170034 +24130 IVFAIL = IVFAIL + 1 05180034 + IVCORR = 6 05190034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05200034 + 4141 CONTINUE 05210034 + IVTNUM = 414 05220034 +C 05230034 +C **** TEST 414 **** 05240034 +C 05250034 + IF (ICZERO) 34140, 4140, 34140 05260034 + 4140 CONTINUE 05270034 + IVON02 = -3 05280034 + IVCOMP = -2 * IVON02 05290034 + GO TO 44140 05300034 +34140 IVDELE = IVDELE + 1 05310034 + WRITE (I02,80003) IVTNUM 05320034 + IF (ICZERO) 44140, 4151, 44140 05330034 +44140 IF (IVCOMP - 6) 24140,14140,24140 05340034 +14140 IVPASS = IVPASS + 1 05350034 + WRITE (I02,80001) IVTNUM 05360034 + GO TO 4151 05370034 +24140 IVFAIL = IVFAIL + 1 05380034 + IVCORR = 6 05390034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05400034 +C 05410034 +C TEST 415 THROUGH TEST 429 CONTAIN TWO INTEGER CONSTANTS, 05420034 +C ONE INTEGER VARIABLE AND OPERATOR * IN ARITHMETIC EXPRESSION. 05430034 +C 05440034 + 4151 CONTINUE 05450034 + IVTNUM = 415 05460034 +C 05470034 +C **** TEST 415 **** 05480034 +C 05490034 + IF (ICZERO) 34150, 4150, 34150 05500034 + 4150 CONTINUE 05510034 + IVON01 = 2 05520034 + IVCOMP = IVON01 * 3 * 4 05530034 + GO TO 44150 05540034 +34150 IVDELE = IVDELE + 1 05550034 + WRITE (I02,80003) IVTNUM 05560034 + IF (ICZERO) 44150, 4161, 44150 05570034 +44150 IF (IVCOMP - 24) 24150,14150,24150 05580034 +14150 IVPASS = IVPASS + 1 05590034 + WRITE (I02,80001) IVTNUM 05600034 + GO TO 4161 05610034 +24150 IVFAIL = IVFAIL + 1 05620034 + IVCORR = 24 05630034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05640034 + 4161 CONTINUE 05650034 + IVTNUM = 416 05660034 +C 05670034 +C **** TEST 416 **** 05680034 +C 05690034 + IF (ICZERO) 34160, 4160, 34160 05700034 + 4160 CONTINUE 05710034 + IVON01 = -2 05720034 + IVCOMP = IVON01 *3*4 05730034 + GO TO 44160 05740034 +34160 IVDELE = IVDELE + 1 05750034 + WRITE (I02,80003) IVTNUM 05760034 + IF (ICZERO) 44160, 4171, 44160 05770034 +44160 IF (IVCOMP +24) 24160,14160,24160 05780034 +14160 IVPASS = IVPASS + 1 05790034 + WRITE (I02,80001) IVTNUM 05800034 + GO TO 4171 05810034 +24160 IVFAIL = IVFAIL + 1 05820034 + IVCORR = -24 05830034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05840034 + 4171 CONTINUE 05850034 + IVTNUM = 417 05860034 +C 05870034 +C **** TEST 417 **** 05880034 +C 05890034 + IF (ICZERO) 34170, 4170, 34170 05900034 + 4170 CONTINUE 05910034 + IVON01 = -2 05920034 + IVCOMP = IVON01*3*(-4) 05930034 + GO TO 44170 05940034 +34170 IVDELE = IVDELE + 1 05950034 + WRITE (I02,80003) IVTNUM 05960034 + IF (ICZERO) 44170, 4181, 44170 05970034 +44170 IF (IVCOMP -24) 24170,14170,24170 05980034 +14170 IVPASS = IVPASS + 1 05990034 + WRITE (I02,80001) IVTNUM 06000034 + GO TO 4181 06010034 +24170 IVFAIL = IVFAIL + 1 06020034 + IVCORR = 24 06030034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06040034 + 4181 CONTINUE 06050034 + IVTNUM = 418 06060034 +C 06070034 +C **** TEST 418 **** 06080034 +C 06090034 + IF (ICZERO) 34180, 4180, 34180 06100034 + 4180 CONTINUE 06110034 + IVON01 = -2 06120034 + IVCOMP = IVON01*(-3)*(-4) 06130034 + GO TO 44180 06140034 +34180 IVDELE = IVDELE + 1 06150034 + WRITE (I02,80003) IVTNUM 06160034 + IF (ICZERO) 44180, 4191, 44180 06170034 +44180 IF (IVCOMP +24) 24180,14180,24180 06180034 +14180 IVPASS = IVPASS + 1 06190034 + WRITE (I02,80001) IVTNUM 06200034 + GO TO 4191 06210034 +24180 IVFAIL = IVFAIL + 1 06220034 + IVCORR = -24 06230034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06240034 + 4191 CONTINUE 06250034 + IVTNUM = 419 06260034 +C 06270034 +C **** TEST 419 **** 06280034 +C 06290034 + IF (ICZERO) 34190, 4190, 34190 06300034 + 4190 CONTINUE 06310034 + IVON02 = 51 06320034 + IVCOMP = 23*IVON02*13 06330034 + GO TO 44190 06340034 +34190 IVDELE = IVDELE + 1 06350034 + WRITE (I02,80003) IVTNUM 06360034 + IF (ICZERO) 44190, 4201, 44190 06370034 +44190 IF (IVCOMP-15249) 24190,14190,24190 06380034 +14190 IVPASS = IVPASS + 1 06390034 + WRITE (I02,80001) IVTNUM 06400034 + GO TO 4201 06410034 +24190 IVFAIL = IVFAIL + 1 06420034 + IVCORR = 15249 06430034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06440034 + 4201 CONTINUE 06450034 + IVTNUM = 420 06460034 +C 06470034 +C **** TEST 420 **** 06480034 +C 06490034 + IF (ICZERO) 34200, 4200, 34200 06500034 + 4200 CONTINUE 06510034 + IVON02 = -51 06520034 + IVCOMP = 23*IVON02*(-13) 06530034 + GO TO 44200 06540034 +34200 IVDELE = IVDELE + 1 06550034 + WRITE (I02,80003) IVTNUM 06560034 + IF (ICZERO) 44200, 4211, 44200 06570034 +44200 IF (IVCOMP - 15249) 24200,14200,24200 06580034 +14200 IVPASS = IVPASS + 1 06590034 + WRITE (I02,80001) IVTNUM 06600034 + GO TO 4211 06610034 +24200 IVFAIL = IVFAIL + 1 06620034 + IVCORR = 15249 06630034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06640034 + 4211 CONTINUE 06650034 + IVTNUM = 421 06660034 +C 06670034 +C **** TEST 421 **** 06680034 +C 06690034 + IF (ICZERO) 34210, 4210, 34210 06700034 + 4210 CONTINUE 06710034 + IVON02 = -51 06720034 + IVCOMP = 23*IVON02*13 06730034 + GO TO 44210 06740034 +34210 IVDELE = IVDELE + 1 06750034 + WRITE (I02,80003) IVTNUM 06760034 + IF (ICZERO) 44210, 4221, 44210 06770034 +44210 IF (IVCOMP+15249) 24210,14210,24210 06780034 +14210 IVPASS = IVPASS + 1 06790034 + WRITE (I02,80001) IVTNUM 06800034 + GO TO 4221 06810034 +24210 IVFAIL = IVFAIL + 1 06820034 + IVCORR = -15249 06830034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06840034 + 4221 CONTINUE 06850034 + IVTNUM = 422 06860034 +C 06870034 +C **** TEST 422 **** 06880034 +C 06890034 + IF (ICZERO) 34220, 4220, 34220 06900034 + 4220 CONTINUE 06910034 + IVON02 = -51 06920034 + IVCOMP =(-23)*IVON02*(-13) 06930034 + GO TO 44220 06940034 +34220 IVDELE = IVDELE + 1 06950034 + WRITE (I02,80003) IVTNUM 06960034 + IF (ICZERO) 44220, 4231, 44220 06970034 +44220 IF (IVCOMP+15249) 24220,14220,24220 06980034 +14220 IVPASS = IVPASS + 1 06990034 + WRITE (I02,80001) IVTNUM 07000034 + GO TO 4231 07010034 +24220 IVFAIL = IVFAIL + 1 07020034 + IVCORR = -15249 07030034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07040034 + 4231 CONTINUE 07050034 + IVTNUM = 423 07060034 +C 07070034 +C **** TEST 423 **** 07080034 +C 07090034 + IF (ICZERO) 34230, 4230, 34230 07100034 + 4230 CONTINUE 07110034 + IVON03 = 5461 07120034 + IVCOMP = 2*3*IVON03 07130034 + GO TO 44230 07140034 +34230 IVDELE = IVDELE + 1 07150034 + WRITE (I02,80003) IVTNUM 07160034 + IF (ICZERO) 44230, 4241, 44230 07170034 +44230 IF (IVCOMP - 32766) 24230,14230,24230 07180034 +14230 IVPASS = IVPASS + 1 07190034 + WRITE (I02,80001) IVTNUM 07200034 + GO TO 4241 07210034 +24230 IVFAIL = IVFAIL + 1 07220034 + IVCORR = 32766 07230034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07240034 + 4241 CONTINUE 07250034 + IVTNUM = 424 07260034 +C 07270034 +C **** TEST 424 **** 07280034 +C 07290034 + IF (ICZERO) 34240, 4240, 34240 07300034 + 4240 CONTINUE 07310034 + IVON03 = -5461 07320034 + IVCOMP = 2*3*IVON03 07330034 + GO TO 44240 07340034 +34240 IVDELE = IVDELE + 1 07350034 + WRITE (I02,80003) IVTNUM 07360034 + IF (ICZERO) 44240, 4251, 44240 07370034 +44240 IF (IVCOMP +32766) 24240,14240,24240 07380034 +14240 IVPASS = IVPASS + 1 07390034 + WRITE (I02,80001) IVTNUM 07400034 + GO TO 4251 07410034 +24240 IVFAIL = IVFAIL + 1 07420034 + IVCORR = -32766 07430034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07440034 + 4251 CONTINUE 07450034 + IVTNUM = 425 07460034 +C 07470034 +C **** TEST 425 **** 07480034 +C 07490034 + IF (ICZERO) 34250, 4250, 34250 07500034 + 4250 CONTINUE 07510034 + IVON03 = -5461 07520034 + IVCOMP = -2*3*IVON03 07530034 + GO TO 44250 07540034 +34250 IVDELE = IVDELE + 1 07550034 + WRITE (I02,80003) IVTNUM 07560034 + IF (ICZERO) 44250, 4261, 44250 07570034 +44250 IF (IVCOMP - 32766) 24250,14250,24250 07580034 +14250 IVPASS = IVPASS + 1 07590034 + WRITE (I02,80001) IVTNUM 07600034 + GO TO 4261 07610034 +24250 IVFAIL = IVFAIL + 1 07620034 + IVCORR = 32766 07630034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07640034 +C 07650034 +C TEST 426 THROUGH TEST 429 USE PARENTHESES TO GROUP ELEMENTS 07660034 +C IN ARITHMETIC EXPRESSION. 07670034 +C 07680034 + 4261 CONTINUE 07690034 + IVTNUM = 426 07700034 +C 07710034 +C **** TEST 426 **** 07720034 +C 07730034 + IF (ICZERO) 34260, 4260, 34260 07740034 + 4260 CONTINUE 07750034 + IVON02 = 51 07760034 + IVCOMP = (23*IVON02)*13 07770034 + GO TO 44260 07780034 +34260 IVDELE = IVDELE + 1 07790034 + WRITE (I02,80003) IVTNUM 07800034 + IF (ICZERO) 44260, 4271, 44260 07810034 +44260 IF (IVCOMP -15249) 24260,14260,24260 07820034 +14260 IVPASS = IVPASS + 1 07830034 + WRITE (I02,80001) IVTNUM 07840034 + GO TO 4271 07850034 +24260 IVFAIL = IVFAIL + 1 07860034 + IVCORR = 15249 07870034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07880034 + 4271 CONTINUE 07890034 + IVTNUM = 427 07900034 +C 07910034 +C **** TEST 427 **** 07920034 +C 07930034 + IF (ICZERO) 34270, 4270, 34270 07940034 + 4270 CONTINUE 07950034 + IVON02 = 51 07960034 + IVCOMP = 23*(IVON02*13) 07970034 + GO TO 44270 07980034 +34270 IVDELE = IVDELE + 1 07990034 + WRITE (I02,80003) IVTNUM 08000034 + IF (ICZERO) 44270, 4281, 44270 08010034 +44270 IF (IVCOMP-15249) 24270,14270,24270 08020034 +14270 IVPASS = IVPASS + 1 08030034 + WRITE (I02,80001) IVTNUM 08040034 + GO TO 4281 08050034 +24270 IVFAIL = IVFAIL + 1 08060034 + IVCORR = 15249 08070034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08080034 + 4281 CONTINUE 08090034 + IVTNUM = 428 08100034 +C 08110034 +C **** TEST 428 **** 08120034 +C 08130034 + IF (ICZERO) 34280, 4280, 34280 08140034 + 4280 CONTINUE 08150034 + IVON02 = -51 08160034 + IVCOMP = -23 * (IVON02*(+13)) 08170034 + GO TO 44280 08180034 +34280 IVDELE = IVDELE + 1 08190034 + WRITE (I02,80003) IVTNUM 08200034 + IF (ICZERO) 44280, 4291, 44280 08210034 +44280 IF (IVCOMP - 15249)24280,14280,24280 08220034 +14280 IVPASS = IVPASS + 1 08230034 + WRITE (I02,80001) IVTNUM 08240034 + GO TO 4291 08250034 +24280 IVFAIL = IVFAIL + 1 08260034 + IVCORR = 15249 08270034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08280034 + 4291 CONTINUE 08290034 + IVTNUM = 429 08300034 +C 08310034 +C **** TEST 429 **** 08320034 +C 08330034 + IF (ICZERO) 34290, 4290, 34290 08340034 + 4290 CONTINUE 08350034 + IVON02 = -51 08360034 + IVCOMP = (-23)*(IVON02*(-13)) 08370034 + GO TO 44290 08380034 +34290 IVDELE = IVDELE + 1 08390034 + WRITE (I02,80003) IVTNUM 08400034 + IF (ICZERO) 44290, 4301, 44290 08410034 +44290 IF (IVCOMP + 15249) 24290,14290,24290 08420034 +14290 IVPASS = IVPASS + 1 08430034 + WRITE (I02,80001) IVTNUM 08440034 + GO TO 4301 08450034 +24290 IVFAIL = IVFAIL + 1 08460034 + IVCORR = -15249 08470034 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08480034 +C **** END OF TESTS **** 08490034 + 4301 CONTINUE 08500034 +C 08510034 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08520034 +99999 CONTINUE 08530034 + WRITE (I02,90002) 08540034 + WRITE (I02,90006) 08550034 + WRITE (I02,90002) 08560034 + WRITE (I02,90002) 08570034 + WRITE (I02,90007) 08580034 + WRITE (I02,90002) 08590034 + WRITE (I02,90008) IVFAIL 08600034 + WRITE (I02,90009) IVPASS 08610034 + WRITE (I02,90010) IVDELE 08620034 +C 08630034 +C 08640034 +C TERMINATE ROUTINE EXECUTION 08650034 + STOP 08660034 +C 08670034 +C FORMAT STATEMENTS FOR PAGE HEADERS 08680034 +90000 FORMAT ("1") 08690034 +90002 FORMAT (" ") 08700034 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08710034 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08720034 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08730034 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08740034 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08750034 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08760034 +C 08770034 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08780034 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08790034 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08800034 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08810034 +C 08820034 +C FORMAT STATEMENTS FOR TEST RESULTS 08830034 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08840034 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08850034 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08860034 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08870034 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08880034 +C 08890034 +90007 FORMAT (" ",20X,"END OF PROGRAM FM034" ) 08900034 + END 08910034 diff --git a/Fortran/UnitTests/fcvs21_f95/FM034.reference_output b/Fortran/UnitTests/fcvs21_f95/FM034.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM034.reference_output @@ -0,0 +1,59 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 395 PASS + 396 PASS + 397 PASS + 398 PASS + 399 PASS + 400 PASS + 401 PASS + 402 PASS + 403 PASS + 404 PASS + 405 PASS + 406 PASS + 407 PASS + 408 PASS + 409 PASS + 410 PASS + 411 PASS + 412 PASS + 413 PASS + 414 PASS + 415 PASS + 416 PASS + 417 PASS + 418 PASS + 419 PASS + 420 PASS + 421 PASS + 422 PASS + 423 PASS + 424 PASS + 425 PASS + 426 PASS + 427 PASS + 428 PASS + 429 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM034 + + 0 ERRORS ENCOUNTERED + 35 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM035.f b/Fortran/UnitTests/fcvs21_f95/FM035.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM035.f @@ -0,0 +1,849 @@ + PROGRAM FM035 + +C COMMENT SECTION 00010035 +C 00020035 +C FM035 00030035 +C 00040035 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050035 +C FORM 00060035 +C INTEGER VARIABLE = ARITHMETIC EXPRESSION 00070035 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00080035 +C OPERATOR *, INTEGER VARIABLES AND INTEGER CONSTANT. SOME OF THE 00090035 +C TESTS USE PARENTHESES TO GROUP ELEMENTS IN THE EXPRESSION AND TO 00100035 +C ALLOW THE USE OF NEGATIVE CONSTANTS FOLLOWING THE * OPERATOR. 00110035 +C THE INTEGER VARIABLES CONTAIN POSITIVE AND NEGATIVE VALUES. 00120035 +C 00130035 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00140035 +C (1) INTEGER VARIABLE * INTEGER VARIABLE 00150035 +C (2) INTEGER VARIABLE * INTEGER VARIABLE * INTEGER CONSTANT 00160035 +C INTEGER VARIABLE * INTEGER CONSTANT * INTEGER VARIABLE 00170035 +C INTEGER CONSTANT * INTEGER VARIABLE * INTEGER VARIABLE 00180035 +C (3) SAME AS (2) BUT WITH PARENTHESES TO GROUP ELEMENTS. 00190035 +C 00200035 +C REFERENCES 00210035 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00220035 +C X3.9-1978 00230035 +C 00240035 +C SECTION 4.3, INTEGER TYPE 00250035 +C SECTION 4.3.1, INTEGER CONSTANT 00260035 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00270035 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00280035 +C 00290035 +C ********************************************************** 00300035 +C 00310035 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00320035 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00330035 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00340035 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00350035 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00360035 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00370035 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00380035 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00390035 +C OF EXECUTING THESE TESTS. 00400035 +C 00410035 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00420035 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00430035 +C 00440035 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00450035 +C 00460035 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00470035 +C SOFTWARE STANDARDS VALIDATION GROUP 00480035 +C BUILDING 225 RM A266 00490035 +C GAITHERSBURG, MD 20899 00500035 +C ********************************************************** 00510035 +C 00520035 +C 00530035 +C 00540035 +C INITIALIZATION SECTION 00550035 +C 00560035 +C INITIALIZE CONSTANTS 00570035 +C ************** 00580035 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00590035 + I01 = 5 00600035 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00610035 + I02 = 6 00620035 +C SYSTEM ENVIRONMENT SECTION 00630035 +C 00640035 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00650035 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00660035 +C (UNIT NUMBER FOR CARD READER). 00670035 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00680035 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00690035 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00700035 +C 00710035 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00720035 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00730035 +C (UNIT NUMBER FOR PRINTER). 00740035 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00750035 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00760035 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00770035 +C 00780035 + IVPASS=0 00790035 + IVFAIL=0 00800035 + IVDELE=0 00810035 + ICZERO=0 00820035 +C 00830035 +C WRITE PAGE HEADERS 00840035 + WRITE (I02,90000) 00850035 + WRITE (I02,90001) 00860035 + WRITE (I02,90002) 00870035 + WRITE (I02, 90002) 00880035 + WRITE (I02,90003) 00890035 + WRITE (I02,90002) 00900035 + WRITE (I02,90004) 00910035 + WRITE (I02,90002) 00920035 + WRITE (I02,90011) 00930035 + WRITE (I02,90002) 00940035 + WRITE (I02,90002) 00950035 + WRITE (I02,90005) 00960035 + WRITE (I02,90006) 00970035 + WRITE (I02,90002) 00980035 +C 00990035 +C TEST SECTION 01000035 +C 01010035 +C ARITHMETIC ASSIGNMENT STATEMENT 01020035 +C 01030035 +C TEST 430 THROUGH TEST 441 CONTAIN TWO INTEGER VARIABLES AND 01040035 +C OPERATOR * IN AN ARITHMETIC EXPRESSION. 01050035 +C THE FORM IS IV = IV * IV 01060035 +C 01070035 +C TEST 430 THROUGH TEST 433 - TWO POSITIVE VARIABLES 01080035 +C 01090035 + 4301 CONTINUE 01100035 + IVTNUM = 430 01110035 +C 01120035 +C **** TEST 430 **** 01130035 +C 01140035 + IF (ICZERO) 34300, 4300, 34300 01150035 + 4300 CONTINUE 01160035 + IVON01 = 2 01170035 + IVON02 = 3 01180035 + IVCOMP = IVON01 * IVON02 01190035 + GO TO 44300 01200035 +34300 IVDELE = IVDELE + 1 01210035 + WRITE (I02,80003) IVTNUM 01220035 + IF (ICZERO) 44300, 4311, 44300 01230035 +44300 IF (IVCOMP - 6) 24300,14300,24300 01240035 +14300 IVPASS = IVPASS + 1 01250035 + WRITE (I02,80001) IVTNUM 01260035 + GO TO 4311 01270035 +24300 IVFAIL = IVFAIL + 1 01280035 + IVCORR = 6 01290035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01300035 + 4311 CONTINUE 01310035 + IVTNUM = 431 01320035 +C 01330035 +C **** TEST 431 **** 01340035 +C 01350035 + IF (ICZERO) 34310, 4310, 34310 01360035 + 4310 CONTINUE 01370035 + IVON01 = 13 01380035 + IVON02 = 11 01390035 + IVCOMP = IVON01 * IVON02 01400035 + GO TO 44310 01410035 +34310 IVDELE = IVDELE + 1 01420035 + WRITE (I02,80003) IVTNUM 01430035 + IF (ICZERO) 44310, 4321, 44310 01440035 +44310 IF (IVCOMP - 143) 24310,14310,24310 01450035 +14310 IVPASS = IVPASS + 1 01460035 + WRITE (I02,80001) IVTNUM 01470035 + GO TO 4321 01480035 +24310 IVFAIL = IVFAIL + 1 01490035 + IVCORR = 143 01500035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01510035 + 4321 CONTINUE 01520035 + IVTNUM = 432 01530035 +C 01540035 +C **** TEST 432 **** 01550035 +C 01560035 + IF (ICZERO) 34320, 4320, 34320 01570035 + 4320 CONTINUE 01580035 + IVON01 = 223 01590035 + IVON02 = 99 01600035 + IVCOMP = IVON01 * IVON02 01610035 + GO TO 44320 01620035 +34320 IVDELE = IVDELE + 1 01630035 + WRITE (I02,80003) IVTNUM 01640035 + IF (ICZERO) 44320, 4331, 44320 01650035 +44320 IF (IVCOMP - 22077) 24320,14320,24320 01660035 +14320 IVPASS = IVPASS + 1 01670035 + WRITE (I02,80001) IVTNUM 01680035 + GO TO 4331 01690035 +24320 IVFAIL = IVFAIL + 1 01700035 + IVCORR = 22077 01710035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01720035 + 4331 CONTINUE 01730035 + IVTNUM = 433 01740035 +C 01750035 +C **** TEST 433 **** 01760035 +C 01770035 + IF (ICZERO) 34330, 4330, 34330 01780035 + 4330 CONTINUE 01790035 + IVON01 = 11235 01800035 + IVON02 = 2 01810035 + IVCOMP = IVON01*IVON02 01820035 + GO TO 44330 01830035 +34330 IVDELE = IVDELE + 1 01840035 + WRITE (I02,80003) IVTNUM 01850035 + IF (ICZERO) 44330, 4341, 44330 01860035 +44330 IF (IVCOMP - 22470) 24330,14330,24330 01870035 +14330 IVPASS = IVPASS + 1 01880035 + WRITE (I02,80001) IVTNUM 01890035 + GO TO 4341 01900035 +24330 IVFAIL = IVFAIL + 1 01910035 + IVCORR = 22470 01920035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01930035 +C 01940035 +C TEST 434 THROUGH TEST 437 01950035 +C ONE NEGATIVE VARIABLE, ONE POSITIVE VARIABLE 01960035 +C 01970035 + 4341 CONTINUE 01980035 + IVTNUM = 434 01990035 +C 02000035 +C **** TEST 434 **** 02010035 +C 02020035 + IF (ICZERO) 34340, 4340, 34340 02030035 + 4340 CONTINUE 02040035 + IVON01 = -2 02050035 + IVON02 = 3 02060035 + IVCOMP = IVON01 * IVON02 02070035 + GO TO 44340 02080035 +34340 IVDELE = IVDELE + 1 02090035 + WRITE (I02,80003) IVTNUM 02100035 + IF (ICZERO) 44340, 4351, 44340 02110035 +44340 IF (IVCOMP +6) 24340,14340,24340 02120035 +14340 IVPASS = IVPASS + 1 02130035 + WRITE (I02,80001) IVTNUM 02140035 + GO TO 4351 02150035 +24340 IVFAIL = IVFAIL + 1 02160035 + IVCORR = -6 02170035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02180035 + 4351 CONTINUE 02190035 + IVTNUM = 435 02200035 +C 02210035 +C **** TEST 435 **** 02220035 +C 02230035 + IF (ICZERO) 34350, 4350, 34350 02240035 + 4350 CONTINUE 02250035 + IVON01 = -13 02260035 + IVON02 = +11 02270035 + IVCOMP = IVON01*IVON02 02280035 + GO TO 44350 02290035 +34350 IVDELE = IVDELE + 1 02300035 + WRITE (I02,80003) IVTNUM 02310035 + IF (ICZERO) 44350, 4361, 44350 02320035 +44350 IF (IVCOMP + 143) 24350,14350,24350 02330035 +14350 IVPASS = IVPASS + 1 02340035 + WRITE (I02,80001) IVTNUM 02350035 + GO TO 4361 02360035 +24350 IVFAIL = IVFAIL + 1 02370035 + IVCORR = -143 02380035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02390035 + 4361 CONTINUE 02400035 + IVTNUM = 436 02410035 +C 02420035 +C **** TEST 436 **** 02430035 +C 02440035 + IF (ICZERO) 34360, 4360, 34360 02450035 + 4360 CONTINUE 02460035 + IVON01 = -223 02470035 + IVON02 = 99 02480035 + IVCOMP = IVON01 * IVON02 02490035 + GO TO 44360 02500035 +34360 IVDELE = IVDELE + 1 02510035 + WRITE (I02,80003) IVTNUM 02520035 + IF (ICZERO) 44360, 4371, 44360 02530035 +44360 IF (IVCOMP + 22077) 24360,14360,24360 02540035 +14360 IVPASS = IVPASS + 1 02550035 + WRITE (I02,80001) IVTNUM 02560035 + GO TO 4371 02570035 +24360 IVFAIL = IVFAIL + 1 02580035 + IVCORR = -22077 02590035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02600035 + 4371 CONTINUE 02610035 + IVTNUM = 437 02620035 +C 02630035 +C **** TEST 437 **** 02640035 +C 02650035 + IF (ICZERO) 34370, 4370, 34370 02660035 + 4370 CONTINUE 02670035 + IVON01 = -11235 02680035 + IVON02 = 2 02690035 + IVCOMP = IVON01 * IVON02 02700035 + GO TO 44370 02710035 +34370 IVDELE = IVDELE + 1 02720035 + WRITE (I02,80003) IVTNUM 02730035 + IF (ICZERO) 44370, 4381, 44370 02740035 +44370 IF (IVCOMP + 22470) 24370,14370,24370 02750035 +14370 IVPASS = IVPASS + 1 02760035 + WRITE (I02,80001) IVTNUM 02770035 + GO TO 4381 02780035 +24370 IVFAIL = IVFAIL + 1 02790035 + IVCORR = -22470 02800035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02810035 +C 02820035 +C TEST 438 THROUGH TEST 441 - TWO NEGATIVE VARIABLES 02830035 + 4381 CONTINUE 02840035 + IVTNUM = 438 02850035 +C 02860035 +C **** TEST 438 **** 02870035 +C 02880035 + IF (ICZERO) 34380, 4380, 34380 02890035 + 4380 CONTINUE 02900035 + IVON01 = -2 02910035 + IVON02 = -3 02920035 + IVCOMP = IVON01 * IVON02 02930035 + GO TO 44380 02940035 +34380 IVDELE = IVDELE + 1 02950035 + WRITE (I02,80003) IVTNUM 02960035 + IF (ICZERO) 44380, 4391, 44380 02970035 +44380 IF (IVCOMP - 6) 24380,14380,24380 02980035 +14380 IVPASS = IVPASS + 1 02990035 + WRITE (I02,80001) IVTNUM 03000035 + GO TO 4391 03010035 +24380 IVFAIL = IVFAIL + 1 03020035 + IVCORR = 6 03030035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03040035 + 4391 CONTINUE 03050035 + IVTNUM = 439 03060035 +C 03070035 +C **** TEST 439 **** 03080035 +C 03090035 + IF (ICZERO) 34390, 4390, 34390 03100035 + 4390 CONTINUE 03110035 + IVON01 = -13 03120035 + IVON02 = -11 03130035 + IVCOMP = IVON01 * IVON02 03140035 + GO TO 44390 03150035 +34390 IVDELE = IVDELE + 1 03160035 + WRITE (I02,80003) IVTNUM 03170035 + IF (ICZERO) 44390, 4401, 44390 03180035 +44390 IF (IVCOMP - 143) 24390,14390,24390 03190035 +14390 IVPASS = IVPASS + 1 03200035 + WRITE (I02,80001) IVTNUM 03210035 + GO TO 4401 03220035 +24390 IVFAIL = IVFAIL + 1 03230035 + IVCORR = 143 03240035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03250035 + 4401 CONTINUE 03260035 + IVTNUM = 440 03270035 +C 03280035 +C **** TEST 440 **** 03290035 +C 03300035 + IF (ICZERO) 34400, 4400, 34400 03310035 + 4400 CONTINUE 03320035 + IVON01 = -223 03330035 + IVON02 = -99 03340035 + IVCOMP = IVON01*IVON02 03350035 + GO TO 44400 03360035 +34400 IVDELE = IVDELE + 1 03370035 + WRITE (I02,80003) IVTNUM 03380035 + IF (ICZERO) 44400, 4411, 44400 03390035 +44400 IF (IVCOMP - 22077) 24400,14400,24400 03400035 +14400 IVPASS = IVPASS + 1 03410035 + WRITE (I02,80001) IVTNUM 03420035 + GO TO 4411 03430035 +24400 IVFAIL = IVFAIL + 1 03440035 + IVCORR = 22077 03450035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03460035 + 4411 CONTINUE 03470035 + IVTNUM = 441 03480035 +C 03490035 +C **** TEST 441 **** 03500035 +C 03510035 + IF (ICZERO) 34410, 4410, 34410 03520035 + 4410 CONTINUE 03530035 + IVON01 = -5461 03540035 + IVON02 = -6 03550035 + IVCOMP = IVON01 * IVON02 03560035 + GO TO 44410 03570035 +34410 IVDELE = IVDELE + 1 03580035 + WRITE (I02,80003) IVTNUM 03590035 + IF (ICZERO) 44410, 4421, 44410 03600035 +44410 IF (IVCOMP - 32766) 24410, 14410, 24410 03610035 +14410 IVPASS = IVPASS + 1 03620035 + WRITE (I02,80001) IVTNUM 03630035 + GO TO 4421 03640035 +24410 IVFAIL = IVFAIL + 1 03650035 + IVCORR = 32766 03660035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03670035 +C 03680035 +C TEST 442 THROUGH TEST 445 CONTAIN SIGNED INTEGER VARIABLES AND 03690035 +C OPERATOR * IN AN ARITHMETIC EXPRESSION. 03700035 + 4421 CONTINUE 03710035 + IVTNUM = 442 03720035 +C 03730035 +C **** TEST 442 **** 03740035 +C FORM IS IV = -IV*IV 03750035 +C 03760035 + IF (ICZERO) 34420, 4420, 34420 03770035 + 4420 CONTINUE 03780035 + IVON01 = 2 03790035 + IVON02 = 3 03800035 + IVCOMP = -IVON01 * IVON02 03810035 + GO TO 44420 03820035 +34420 IVDELE = IVDELE + 1 03830035 + WRITE (I02,80003) IVTNUM 03840035 + IF (ICZERO) 44420, 4431, 44420 03850035 +44420 IF (IVCOMP + 6) 24420,14420,24420 03860035 +14420 IVPASS = IVPASS + 1 03870035 + WRITE (I02,80001) IVTNUM 03880035 + GO TO 4431 03890035 +24420 IVFAIL = IVFAIL + 1 03900035 + IVCORR = -6 03910035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03920035 + 4431 CONTINUE 03930035 + IVTNUM = 443 03940035 +C 03950035 +C **** TEST 443 **** 03960035 +C FORM IS IV = IV*(-IV) 03970035 +C 03980035 + IF (ICZERO) 34430, 4430, 34430 03990035 + 4430 CONTINUE 04000035 + IVON01 = 2 04010035 + IVON02 = 3 04020035 + IVCOMP = IVON01 * (-IVON02) 04030035 + GO TO 44430 04040035 +34430 IVDELE = IVDELE + 1 04050035 + WRITE (I02,80003) IVTNUM 04060035 + IF (ICZERO) 44430, 4441, 44430 04070035 +44430 IF (IVCOMP +6) 24430,14430,24430 04080035 +14430 IVPASS = IVPASS + 1 04090035 + WRITE (I02,80001) IVTNUM 04100035 + GO TO 4441 04110035 +24430 IVFAIL = IVFAIL + 1 04120035 + IVCORR = -6 04130035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04140035 + 4441 CONTINUE 04150035 + IVTNUM = 444 04160035 +C 04170035 +C **** TEST 444 **** 04180035 +C FORM IS IV = (-IV)*(-IV) 04190035 +C 04200035 + IF (ICZERO) 34440, 4440, 34440 04210035 + 4440 CONTINUE 04220035 + IVON01 = 2 04230035 + IVON02 = 3 04240035 + IVCOMP = (-IVON01) * (-IVON02) 04250035 + GO TO 44440 04260035 +34440 IVDELE = IVDELE + 1 04270035 + WRITE (I02,80003) IVTNUM 04280035 + IF (ICZERO) 44440, 4451, 44440 04290035 +44440 IF (IVCOMP - 6) 24440,14440,24440 04300035 +14440 IVPASS = IVPASS + 1 04310035 + WRITE (I02,80001) IVTNUM 04320035 + GO TO 4451 04330035 +24440 IVFAIL = IVFAIL + 1 04340035 + IVCORR = 6 04350035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04360035 + 4451 CONTINUE 04370035 + IVTNUM = 445 04380035 +C 04390035 +C **** TEST 445 **** 04400035 +C FORM IS IV = -IV * IV 04410035 +C 04420035 + IF (ICZERO) 34450, 4450, 34450 04430035 + 4450 CONTINUE 04440035 + IVON01 = -11235 04450035 + IVON02 = -2 04460035 + IVCOMP = -IVON01 * IVON02 04470035 + GO TO 44450 04480035 +34450 IVDELE = IVDELE + 1 04490035 + WRITE (I02,80003) IVTNUM 04500035 + IF (ICZERO) 44450, 4461, 44450 04510035 +44450 IF (IVCOMP + 22470) 24450,14450,24450 04520035 +14450 IVPASS = IVPASS + 1 04530035 + WRITE (I02,80001) IVTNUM 04540035 + GO TO 4461 04550035 +24450 IVFAIL = IVFAIL + 1 04560035 + IVCORR = -22470 04570035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04580035 +C 04590035 +C TEST 446 THROUGH TEST 452 CONTAIN TWO INTEGER VARIABLES, AN 04600035 +C INTEGER CONSTANT AND OPERATOR * IN AN ARITHMETIC EXPRESSION. 04610035 +C 04620035 + 4461 CONTINUE 04630035 + IVTNUM = 446 04640035 +C 04650035 +C **** TEST 446 **** 04660035 +C 04670035 + IF (ICZERO) 34460, 4460, 34460 04680035 + 4460 CONTINUE 04690035 + IVON01 = 2 04700035 + IVON02 = 3 04710035 + IVCOMP = IVON01 * IVON02 * 4 04720035 + GO TO 44460 04730035 +34460 IVDELE = IVDELE + 1 04740035 + WRITE (I02,80003) IVTNUM 04750035 + IF (ICZERO) 44460, 4471, 44460 04760035 +44460 IF (IVCOMP -24) 24460,14460,24460 04770035 +14460 IVPASS = IVPASS + 1 04780035 + WRITE (I02,80001) IVTNUM 04790035 + GO TO 4471 04800035 +24460 IVFAIL = IVFAIL + 1 04810035 + IVCORR = 24 04820035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04830035 + 4471 CONTINUE 04840035 + IVTNUM = 447 04850035 +C 04860035 +C **** TEST 447 **** 04870035 +C 04880035 + IF (ICZERO) 34470, 4470, 34470 04890035 + 4470 CONTINUE 04900035 + IVON01 = -2 04910035 + IVON02 = 3 04920035 + IVCOMP = IVON01 * IVON02 * 4 04930035 + GO TO 44470 04940035 +34470 IVDELE = IVDELE + 1 04950035 + WRITE (I02,80003) IVTNUM 04960035 + IF (ICZERO) 44470, 4481, 44470 04970035 +44470 IF (IVCOMP +24) 24470,14470,24470 04980035 +14470 IVPASS = IVPASS + 1 04990035 + WRITE (I02,80001) IVTNUM 05000035 + GO TO 4481 05010035 +24470 IVFAIL = IVFAIL + 1 05020035 + IVCORR = -24 05030035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05040035 + 4481 CONTINUE 05050035 + IVTNUM = 448 05060035 +C 05070035 +C **** TEST 448 **** 05080035 +C 05090035 + IF (ICZERO) 34480, 4480, 34480 05100035 + 4480 CONTINUE 05110035 + IVON01 = -2 05120035 + IVON02 = 3 05130035 + IVCOMP = IVON01 * IVON02 * (-4) 05140035 + GO TO 44480 05150035 +34480 IVDELE = IVDELE + 1 05160035 + WRITE (I02,80003) IVTNUM 05170035 + IF (ICZERO) 44480, 4491, 44480 05180035 +44480 IF (IVCOMP -24) 24480,14480,24480 05190035 +14480 IVPASS = IVPASS + 1 05200035 + WRITE (I02,80001) IVTNUM 05210035 + GO TO 4491 05220035 +24480 IVFAIL = IVFAIL + 1 05230035 + IVCORR = 24 05240035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05250035 + 4491 CONTINUE 05260035 + IVTNUM = 449 05270035 +C 05280035 +C **** TEST 449 **** 05290035 +C 05300035 + IF (ICZERO) 34490, 4490, 34490 05310035 + 4490 CONTINUE 05320035 + IVON01 = 51 05330035 + IVON03 = 13 05340035 + IVCOMP = IVON01 * 23 * IVON03 05350035 + GO TO 44490 05360035 +34490 IVDELE = IVDELE + 1 05370035 + WRITE (I02,80003) IVTNUM 05380035 + IF (ICZERO) 44490, 4501, 44490 05390035 +44490 IF (IVCOMP - 15249) 24490,14490,24490 05400035 +14490 IVPASS = IVPASS + 1 05410035 + WRITE (I02,80001) IVTNUM 05420035 + GO TO 4501 05430035 +24490 IVFAIL = IVFAIL + 1 05440035 + IVCORR = 15249 05450035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05460035 + 4501 CONTINUE 05470035 + IVTNUM = 450 05480035 +C 05490035 +C **** TEST 450 **** 05500035 +C 05510035 + IF (ICZERO) 34500, 4500, 34500 05520035 + 4500 CONTINUE 05530035 + IVON02 = 2 05540035 + IVON03 = 5461 05550035 + IVCOMP = 3 * IVON02 * IVON03 05560035 + GO TO 44500 05570035 +34500 IVDELE = IVDELE + 1 05580035 + WRITE (I02,80003) IVTNUM 05590035 + IF (ICZERO) 44500, 4511, 44500 05600035 +44500 IF (IVCOMP -32766) 24500,14500,24500 05610035 +14500 IVPASS = IVPASS + 1 05620035 + WRITE (I02,80001) IVTNUM 05630035 + GO TO 4511 05640035 +24500 IVFAIL = IVFAIL + 1 05650035 + IVCORR = 32766 05660035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05670035 + 4511 CONTINUE 05680035 + IVTNUM = 451 05690035 +C 05700035 +C **** TEST 451 **** 05710035 +C 05720035 + IF (ICZERO) 34510, 4510, 34510 05730035 + 4510 CONTINUE 05740035 + IVON01 = -51 05750035 + IVON03 = 13 05760035 + IVCOMP = IVON01 * 23 * (-IVON03) 05770035 + GO TO 44510 05780035 +34510 IVDELE = IVDELE + 1 05790035 + WRITE (I02,80003) IVTNUM 05800035 + IF (ICZERO) 44510, 4521, 44510 05810035 +44510 IF (IVCOMP - 15249) 24510,14510,24510 05820035 +14510 IVPASS = IVPASS + 1 05830035 + WRITE (I02,80001) IVTNUM 05840035 + GO TO 4521 05850035 +24510 IVFAIL = IVFAIL + 1 05860035 + IVCORR = 15249 05870035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05880035 + 4521 CONTINUE 05890035 + IVTNUM = 452 05900035 +C 05910035 +C **** TEST 452 **** 05920035 +C 05930035 + IF (ICZERO) 34520, 4520, 34520 05940035 + 4520 CONTINUE 05950035 + IVON01 = -5461 05960035 + IVON03 = 2 05970035 + IVCOMP = IVON01 * (-3) * IVON03 05980035 + GO TO 44520 05990035 +34520 IVDELE = IVDELE + 1 06000035 + WRITE (I02,80003) IVTNUM 06010035 + IF (ICZERO) 44520, 4531, 44520 06020035 +44520 IF (IVCOMP - 32766) 24520,14520,24520 06030035 +14520 IVPASS = IVPASS + 1 06040035 + WRITE (I02,80001) IVTNUM 06050035 + GO TO 4531 06060035 +24520 IVFAIL = IVFAIL + 1 06070035 + IVCORR = 32766 06080035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06090035 +C 06100035 +C TEST 453 THROUGH TEST 461 CONTAIN TWO INTEGER VARIABLES AND ONE 06110035 +C INTEGER CONSTANT IN AN ARITHMETIC EXPRESSION. PARENTHESES ARE 06120035 +C USED TO GROUP ELEMENTS IN THE ARITHMETIC EXPRESSIONS IN THESE 06130035 +C TESTS. 06140035 +C 06150035 + 4531 CONTINUE 06160035 + IVTNUM = 453 06170035 +C 06180035 +C **** TEST 453 **** 06190035 +C 06200035 + IF (ICZERO) 34530, 4530, 34530 06210035 + 4530 CONTINUE 06220035 + IVON01 = 2 06230035 + IVON02 = 3 06240035 + IVCOMP = IVON01 * (IVON02 * 4) 06250035 + GO TO 44530 06260035 +34530 IVDELE = IVDELE + 1 06270035 + WRITE (I02,80003) IVTNUM 06280035 + IF (ICZERO) 44530, 4541, 44530 06290035 +44530 IF (IVCOMP - 24) 24530,14530,24530 06300035 +14530 IVPASS = IVPASS + 1 06310035 + WRITE (I02,80001) IVTNUM 06320035 + GO TO 4541 06330035 +24530 IVFAIL = IVFAIL + 1 06340035 + IVCORR = 24 06350035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06360035 + 4541 CONTINUE 06370035 + IVTNUM = 454 06380035 +C 06390035 +C **** TEST 454 **** 06400035 +C 06410035 + IF (ICZERO) 34540, 4540, 34540 06420035 + 4540 CONTINUE 06430035 + IVON01 = 2 06440035 + IVON02 = 3 06450035 + IVCOMP = (IVON01 * IVON02) * 4 06460035 + GO TO 44540 06470035 +34540 IVDELE = IVDELE + 1 06480035 + WRITE (I02,80003) IVTNUM 06490035 + IF (ICZERO) 44540, 4551, 44540 06500035 +44540 IF (IVCOMP -24) 24540,14540,24540 06510035 +14540 IVPASS = IVPASS + 1 06520035 + WRITE (I02,80001) IVTNUM 06530035 + GO TO 4551 06540035 +24540 IVFAIL = IVFAIL + 1 06550035 + IVCORR = 24 06560035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06570035 + 4551 CONTINUE 06580035 + IVTNUM = 455 06590035 +C 06600035 +C **** TEST 455 **** 06610035 +C 06620035 + IF (ICZERO) 34550, 4550, 34550 06630035 + 4550 CONTINUE 06640035 + IVON01 = -2 06650035 + IVON02 = 3 06660035 + IVCOMP = IVON01 *(IVON02 * (-4)) 06670035 + GO TO 44550 06680035 +34550 IVDELE = IVDELE + 1 06690035 + WRITE (I02,80003) IVTNUM 06700035 + IF (ICZERO) 44550, 4561, 44550 06710035 +44550 IF (IVCOMP - 24) 24550,14550,24550 06720035 +14550 IVPASS = IVPASS + 1 06730035 + WRITE (I02,80001) IVTNUM 06740035 + GO TO 4561 06750035 +24550 IVFAIL = IVFAIL + 1 06760035 + IVCORR = 24 06770035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06780035 + 4561 CONTINUE 06790035 + IVTNUM = 456 06800035 +C 06810035 +C **** TEST 456 **** 06820035 +C 06830035 + IF (ICZERO) 34560, 4560, 34560 06840035 + 4560 CONTINUE 06850035 + IVON01 = -2 06860035 + IVON02 = -3 06870035 + IVCOMP = IVON01 * (IVON02 * 4) 06880035 + GO TO 44560 06890035 +34560 IVDELE = IVDELE + 1 06900035 + WRITE (I02,80003) IVTNUM 06910035 + IF (ICZERO) 44560, 4571, 44560 06920035 +44560 IF (IVCOMP -24) 24560,14560,24560 06930035 +14560 IVPASS = IVPASS + 1 06940035 + WRITE (I02,80001) IVTNUM 06950035 + GO TO 4571 06960035 +24560 IVFAIL = IVFAIL + 1 06970035 + IVCORR = 24 06980035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06990035 + 4571 CONTINUE 07000035 + IVTNUM = 457 07010035 +C 07020035 +C **** TEST 457 **** 07030035 +C 07040035 + IF (ICZERO) 34570, 4570, 34570 07050035 + 4570 CONTINUE 07060035 + IVON01 = -2 07070035 + IVON02 = -3 07080035 + IVCOMP = (IVON01*IVON02) * (-4) 07090035 + GO TO 44570 07100035 +34570 IVDELE = IVDELE + 1 07110035 + WRITE (I02,80003) IVTNUM 07120035 + IF (ICZERO) 44570, 4581, 44570 07130035 +44570 IF (IVCOMP +24) 24570,14570,24570 07140035 +14570 IVPASS = IVPASS + 1 07150035 + WRITE (I02,80001) IVTNUM 07160035 + GO TO 4581 07170035 +24570 IVFAIL = IVFAIL + 1 07180035 + IVCORR = -24 07190035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07200035 + 4581 CONTINUE 07210035 + IVTNUM = 458 07220035 +C 07230035 +C **** TEST 458 **** 07240035 +C 07250035 + IF (ICZERO) 34580, 4580, 34580 07260035 + 4580 CONTINUE 07270035 + IVON01 = 23 07280035 + IVON03 = 13 07290035 + IVCOMP = IVON01 * (51 * IVON03) 07300035 + GO TO 44580 07310035 +34580 IVDELE = IVDELE + 1 07320035 + WRITE (I02,80003) IVTNUM 07330035 + IF (ICZERO) 44580, 4591, 44580 07340035 +44580 IF (IVCOMP -15249) 24580,14580,24580 07350035 +14580 IVPASS = IVPASS + 1 07360035 + WRITE (I02,80001) IVTNUM 07370035 + GO TO 4591 07380035 +24580 IVFAIL = IVFAIL + 1 07390035 + IVCORR = 15249 07400035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07410035 + 4591 CONTINUE 07420035 + IVTNUM = 459 07430035 +C 07440035 +C **** TEST 459 **** 07450035 +C 07460035 + IF (ICZERO) 34590, 4590, 34590 07470035 + 4590 CONTINUE 07480035 + IVON02 = 51 07490035 + IVON03 = 13 07500035 + IVCOMP = (23 * IVON02) * IVON03 07510035 + GO TO 44590 07520035 +34590 IVDELE = IVDELE + 1 07530035 + WRITE (I02,80003) IVTNUM 07540035 + IF (ICZERO) 44590, 4601, 44590 07550035 +44590 IF (IVCOMP - 15249) 24590,14590,24590 07560035 +14590 IVPASS = IVPASS + 1 07570035 + WRITE (I02,80001) IVTNUM 07580035 + GO TO 4601 07590035 +24590 IVFAIL = IVFAIL + 1 07600035 + IVCORR = 15249 07610035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07620035 + 4601 CONTINUE 07630035 + IVTNUM = 460 07640035 +C 07650035 +C **** TEST 460 **** 07660035 +C 07670035 + IF (ICZERO) 34600, 4600, 34600 07680035 + 4600 CONTINUE 07690035 + IVON01 = -23 07700035 + IVON03 = 13 07710035 + IVCOMP = (IVON01 * (-51)) * (-IVON03) 07720035 + GO TO 44600 07730035 +34600 IVDELE = IVDELE + 1 07740035 + WRITE (I02,80003) IVTNUM 07750035 + IF (ICZERO) 44600, 4611, 44600 07760035 +44600 IF (IVCOMP + 15249) 24600,14600,24600 07770035 +14600 IVPASS = IVPASS + 1 07780035 + WRITE (I02,80001) IVTNUM 07790035 + GO TO 4611 07800035 +24600 IVFAIL = IVFAIL + 1 07810035 + IVCORR = -15249 07820035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07830035 + 4611 CONTINUE 07840035 + IVTNUM = 461 07850035 +C 07860035 +C **** TEST 461 **** 07870035 +C 07880035 + IF (ICZERO) 34610, 4610, 34610 07890035 + 4610 CONTINUE 07900035 + IVON02 = 51 07910035 + IVON03 = 13 07920035 + IVCOMP = -23 * (IVON02*IVON03) 07930035 + GO TO 44610 07940035 +34610 IVDELE = IVDELE + 1 07950035 + WRITE (I02,80003) IVTNUM 07960035 + IF (ICZERO) 44610, 4621, 44610 07970035 +44610 IF (IVCOMP + 15249) 24610,14610,24610 07980035 +14610 IVPASS = IVPASS + 1 07990035 + WRITE (I02,80001) IVTNUM 08000035 + GO TO 4621 08010035 +24610 IVFAIL = IVFAIL + 1 08020035 + IVCORR = -15249 08030035 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08040035 +C **** END OF TESTS **** 08050035 + 4621 CONTINUE 08060035 +C 08070035 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08080035 +99999 CONTINUE 08090035 + WRITE (I02,90002) 08100035 + WRITE (I02,90006) 08110035 + WRITE (I02,90002) 08120035 + WRITE (I02,90002) 08130035 + WRITE (I02,90007) 08140035 + WRITE (I02,90002) 08150035 + WRITE (I02,90008) IVFAIL 08160035 + WRITE (I02,90009) IVPASS 08170035 + WRITE (I02,90010) IVDELE 08180035 +C 08190035 +C 08200035 +C TERMINATE ROUTINE EXECUTION 08210035 + STOP 08220035 +C 08230035 +C FORMAT STATEMENTS FOR PAGE HEADERS 08240035 +90000 FORMAT ("1") 08250035 +90002 FORMAT (" ") 08260035 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08270035 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08280035 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08290035 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08300035 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08310035 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08320035 +C 08330035 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08340035 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08350035 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08360035 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08370035 +C 08380035 +C FORMAT STATEMENTS FOR TEST RESULTS 08390035 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08400035 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08410035 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08420035 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08430035 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08440035 +C 08450035 +90007 FORMAT (" ",20X,"END OF PROGRAM FM035" ) 08460035 + END 08470035 diff --git a/Fortran/UnitTests/fcvs21_f95/FM035.reference_output b/Fortran/UnitTests/fcvs21_f95/FM035.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM035.reference_output @@ -0,0 +1,56 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 430 PASS + 431 PASS + 432 PASS + 433 PASS + 434 PASS + 435 PASS + 436 PASS + 437 PASS + 438 PASS + 439 PASS + 440 PASS + 441 PASS + 442 PASS + 443 PASS + 444 PASS + 445 PASS + 446 PASS + 447 PASS + 448 PASS + 449 PASS + 450 PASS + 451 PASS + 452 PASS + 453 PASS + 454 PASS + 455 PASS + 456 PASS + 457 PASS + 458 PASS + 459 PASS + 460 PASS + 461 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM035 + + 0 ERRORS ENCOUNTERED + 32 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM036.f b/Fortran/UnitTests/fcvs21_f95/FM036.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM036.f @@ -0,0 +1,724 @@ + PROGRAM FM036 + +C COMMENT SECTION 00010036 +C 00020036 +C FM036 00030036 +C 00040036 +C THIS ROUTINE TESTS ARITHMETIC ASIGNMENT STATEMENTS OF THE 00050036 +C FORM 00060036 +C INTEGER VARIABLE = ARITHMETIC EXPRESSION 00070036 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00080036 +C OPERATOR / AND INTEGER CONSTANTS. BOTH POSITIVE AND NEGATIVE 00090036 +C CONSTANTS ARE USED IN THE ARITHMETIC EXPRESSION. 00100036 +C 00110036 +C THERE ARE TESTS WHICH REQUIRE NO TRUNCATION OF THE RESULT 00120036 +C AND TESTS WHERE THE RESULT MUST BE TRUNCATED BEFORE BEING STORED 00130036 +C IN THE RESULTANT INTEGER VARIABLE. THE STANDARD STATES 'THE VALUE00140036 +C OF AN INTEGER FACTOR OR TERM IS THE NEAREST INTEGER WHOSE 00150036 +C MAGNITUDE DOES NOT EXCEED THE MAGNITUDE OF THE MATHEMATICAL VALUE 00160036 +C REPRESENTED BY THAT FACTOR OR TERM.' 00170036 +C 00180036 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00190036 +C (1) INTEGER CONSTANT/INTEGER CONSTANT 00200036 +C NO TRUNCATION REQUIRED, 00210036 +C (2) INTEGER CONSTANT/INTEGER CONSTANT 00220036 +C TRUNCATION REQUIRED. 00230036 +C 00240036 +C REFERENCES 00250036 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260036 +C X3.9-1978 00270036 +C 00280036 +C SECTION 4.3, INTEGER TYPE 00290036 +C SECTION 4.3.1, INTEGER CONSTANT 00300036 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00310036 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00320036 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00330036 +C 00340036 +C ********************************************************** 00350036 +C 00360036 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00370036 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00380036 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00390036 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00400036 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00410036 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00420036 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00430036 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00440036 +C OF EXECUTING THESE TESTS. 00450036 +C 00460036 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00470036 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00480036 +C 00490036 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00500036 +C 00510036 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00520036 +C SOFTWARE STANDARDS VALIDATION GROUP 00530036 +C BUILDING 225 RM A266 00540036 +C GAITHERSBURG, MD 20899 00550036 +C ********************************************************** 00560036 +C 00570036 +C 00580036 +C 00590036 +C INITIALIZATION SECTION 00600036 +C 00610036 +C INITIALIZE CONSTANTS 00620036 +C ************** 00630036 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640036 + I01 = 5 00650036 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660036 + I02 = 6 00670036 +C SYSTEM ENVIRONMENT SECTION 00680036 +C 00690036 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00700036 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710036 +C (UNIT NUMBER FOR CARD READER). 00720036 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00730036 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00740036 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00750036 +C 00760036 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00770036 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00780036 +C (UNIT NUMBER FOR PRINTER). 00790036 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00800036 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00810036 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00820036 +C 00830036 + IVPASS=0 00840036 + IVFAIL=0 00850036 + IVDELE=0 00860036 + ICZERO=0 00870036 +C 00880036 +C WRITE PAGE HEADERS 00890036 + WRITE (I02,90000) 00900036 + WRITE (I02,90001) 00910036 + WRITE (I02,90002) 00920036 + WRITE (I02, 90002) 00930036 + WRITE (I02,90003) 00940036 + WRITE (I02,90002) 00950036 + WRITE (I02,90004) 00960036 + WRITE (I02,90002) 00970036 + WRITE (I02,90011) 00980036 + WRITE (I02,90002) 00990036 + WRITE (I02,90002) 01000036 + WRITE (I02,90005) 01010036 + WRITE (I02,90006) 01020036 + WRITE (I02,90002) 01030036 +C 01040036 +C TEST SECTION 01050036 +C ARITHMETIC ASSIGNMENT STATEMENT 01060036 +C 01070036 +C TEST 462 THROUGH TEST 490 CONTAIN TWO INTEGER CONSTANTS AND 01080036 +C OPERATOR / IN AN ARITHMETIC EXPRESSION. THE FORM TESTED IS 01090036 +C INTEGER VARIABLE = INTEGER CONSTANT/INTEGER CONSTANT 01100036 +C 01110036 +C TEST 462 THROUGH TEST 469 - POSITIVE CONSTANTS 01120036 +C NO TRUNCATION REQUIRED 01130036 +C 01140036 + 4621 CONTINUE 01150036 + IVTNUM = 462 01160036 +C 01170036 +C **** TEST 462 **** 01180036 +C 01190036 + IF (ICZERO) 34620, 4620, 34620 01200036 + 4620 CONTINUE 01210036 + IVCOMP = 4/2 01220036 + GO TO 44620 01230036 +34620 IVDELE = IVDELE + 1 01240036 + WRITE (I02,80003) IVTNUM 01250036 + IF (ICZERO) 44620, 4631, 44620 01260036 +44620 IF (IVCOMP - 2) 24620,14620,24620 01270036 +14620 IVPASS = IVPASS + 1 01280036 + WRITE (I02,80001) IVTNUM 01290036 + GO TO 4631 01300036 +24620 IVFAIL = IVFAIL + 1 01310036 + IVCORR = 2 01320036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01330036 + 4631 CONTINUE 01340036 + IVTNUM = 463 01350036 +C 01360036 +C **** TEST 463 **** 01370036 +C 01380036 + IF (ICZERO) 34630, 4630, 34630 01390036 + 4630 CONTINUE 01400036 + IVCOMP = 75 / 25 01410036 + GO TO 44630 01420036 +34630 IVDELE = IVDELE + 1 01430036 + WRITE (I02,80003) IVTNUM 01440036 + IF (ICZERO) 44630, 4641, 44630 01450036 +44630 IF (IVCOMP - 3) 24630,14630,24630 01460036 +14630 IVPASS = IVPASS + 1 01470036 + WRITE (I02,80001) IVTNUM 01480036 + GO TO 4641 01490036 +24630 IVFAIL = IVFAIL + 1 01500036 + IVCORR = 3 01510036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01520036 + 4641 CONTINUE 01530036 + IVTNUM = 464 01540036 +C 01550036 +C **** TEST 464 **** 01560036 +C 01570036 + IF (ICZERO) 34640, 4640, 34640 01580036 + 4640 CONTINUE 01590036 + IVCOMP = 3575/143 01600036 + GO TO 44640 01610036 +34640 IVDELE = IVDELE + 1 01620036 + WRITE (I02,80003) IVTNUM 01630036 + IF (ICZERO) 44640, 4651, 44640 01640036 +44640 IF (IVCOMP - 25) 24640,14640,24640 01650036 +14640 IVPASS = IVPASS + 1 01660036 + WRITE (I02,80001) IVTNUM 01670036 + GO TO 4651 01680036 +24640 IVFAIL = IVFAIL + 1 01690036 + IVCORR = 25 01700036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01710036 + 4651 CONTINUE 01720036 + IVTNUM = 465 01730036 +C 01740036 +C **** TEST 465 **** 01750036 +C 01760036 + IF (ICZERO) 34650, 4650, 34650 01770036 + 4650 CONTINUE 01780036 + IVCOMP = 3575/25 01790036 + GO TO 44650 01800036 +34650 IVDELE = IVDELE + 1 01810036 + WRITE (I02,80003) IVTNUM 01820036 + IF (ICZERO) 44650, 4661, 44650 01830036 +44650 IF (IVCOMP - 143) 24650,14650,24650 01840036 +14650 IVPASS = IVPASS + 1 01850036 + WRITE (I02,80001) IVTNUM 01860036 + GO TO 4661 01870036 +24650 IVFAIL = IVFAIL + 1 01880036 + IVCORR = 143 01890036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01900036 + 4661 CONTINUE 01910036 + IVTNUM = 466 01920036 +C 01930036 +C **** TEST 466 **** 01940036 +C 01950036 + IF (ICZERO) 34660, 4660, 34660 01960036 + 4660 CONTINUE 01970036 + IVCOMP = 6170/1234 01980036 + GO TO 44660 01990036 +34660 IVDELE = IVDELE + 1 02000036 + WRITE (I02,80003) IVTNUM 02010036 + IF (ICZERO) 44660, 4671, 44660 02020036 +44660 IF (IVCOMP - 5) 24660,14660,24660 02030036 +14660 IVPASS = IVPASS + 1 02040036 + WRITE (I02,80001) IVTNUM 02050036 + GO TO 4671 02060036 +24660 IVFAIL = IVFAIL + 1 02070036 + IVCORR = 5 02080036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02090036 + 4671 CONTINUE 02100036 + IVTNUM = 467 02110036 +C 02120036 +C **** TEST 467 **** 02130036 +C 02140036 + IF (ICZERO) 34670, 4670, 34670 02150036 + 4670 CONTINUE 02160036 + IVCOMP = 28600/8 02170036 + GO TO 44670 02180036 +34670 IVDELE = IVDELE + 1 02190036 + WRITE (I02,80003) IVTNUM 02200036 + IF (ICZERO) 44670, 4681, 44670 02210036 +44670 IF (IVCOMP - 3575) 24670,14670,24670 02220036 +14670 IVPASS = IVPASS + 1 02230036 + WRITE (I02,80001) IVTNUM 02240036 + GO TO 4681 02250036 +24670 IVFAIL = IVFAIL + 1 02260036 + IVCORR = 3575 02270036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02280036 + 4681 CONTINUE 02290036 + IVTNUM = 468 02300036 +C 02310036 +C **** TEST 468 **** 02320036 +C 02330036 + IF (ICZERO) 34680, 4680, 34680 02340036 + 4680 CONTINUE 02350036 + IVCOMP = 32766/2 02360036 + GO TO 44680 02370036 +34680 IVDELE = IVDELE + 1 02380036 + WRITE (I02,80003) IVTNUM 02390036 + IF (ICZERO) 44680, 4691, 44680 02400036 +44680 IF (IVCOMP - 16383) 24680,14680,24680 02410036 +14680 IVPASS = IVPASS + 1 02420036 + WRITE (I02,80001) IVTNUM 02430036 + GO TO 4691 02440036 +24680 IVFAIL = IVFAIL + 1 02450036 + IVCORR = 16383 02460036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02470036 + 4691 CONTINUE 02480036 + IVTNUM = 469 02490036 +C 02500036 +C **** TEST 469 **** 02510036 +C 02520036 + IF (ICZERO) 34690, 4690, 34690 02530036 + 4690 CONTINUE 02540036 + IVCOMP = 32767/1 02550036 + GO TO 44690 02560036 +34690 IVDELE = IVDELE + 1 02570036 + WRITE (I02,80003) IVTNUM 02580036 + IF (ICZERO) 44690, 4701, 44690 02590036 +44690 IF (IVCOMP - 32767) 24690,14690,24690 02600036 +14690 IVPASS = IVPASS + 1 02610036 + WRITE (I02,80001) IVTNUM 02620036 + GO TO 4701 02630036 +24690 IVFAIL = IVFAIL + 1 02640036 + IVCORR = 32767 02650036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02660036 +C 02670036 +C TEST 470 THROUGH TEST 478 - POSITIVE CONSTANTS 02680036 +C TRUNCATION REQUIRED 02690036 +C 02700036 + 4701 CONTINUE 02710036 + IVTNUM = 470 02720036 +C 02730036 +C **** TEST 470 **** 02740036 +C 02750036 + IF (ICZERO) 34700, 4700, 34700 02760036 + 4700 CONTINUE 02770036 + IVCOMP = 5/2 02780036 + GO TO 44700 02790036 +34700 IVDELE = IVDELE + 1 02800036 + WRITE (I02,80003) IVTNUM 02810036 + IF (ICZERO) 44700, 4711, 44700 02820036 +44700 IF (IVCOMP - 2) 24700,14700,24700 02830036 +14700 IVPASS = IVPASS + 1 02840036 + WRITE (I02,80001) IVTNUM 02850036 + GO TO 4711 02860036 +24700 IVFAIL = IVFAIL + 1 02870036 + IVCORR = 2 02880036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02890036 + 4711 CONTINUE 02900036 + IVTNUM = 471 02910036 +C 02920036 +C **** TEST 471 **** 02930036 +C 02940036 + IF (ICZERO) 34710, 4710, 34710 02950036 + 4710 CONTINUE 02960036 + IVCOMP = 2/3 02970036 + GO TO 44710 02980036 +34710 IVDELE = IVDELE + 1 02990036 + WRITE (I02,80003) IVTNUM 03000036 + IF (ICZERO) 44710, 4721, 44710 03010036 +44710 IF (IVCOMP - 0) 24710,14710,24710 03020036 +14710 IVPASS = IVPASS + 1 03030036 + WRITE (I02,80001) IVTNUM 03040036 + GO TO 4721 03050036 +24710 IVFAIL = IVFAIL + 1 03060036 + IVCORR = 0 03070036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03080036 + 4721 CONTINUE 03090036 + IVTNUM = 472 03100036 +C 03110036 +C **** TEST 472 **** 03120036 +C 03130036 + IF (ICZERO) 34720, 4720, 34720 03140036 + 4720 CONTINUE 03150036 + IVCOMP = 80/15 03160036 + GO TO 44720 03170036 +34720 IVDELE = IVDELE + 1 03180036 + WRITE (I02,80003) IVTNUM 03190036 + IF (ICZERO) 44720, 4731, 44720 03200036 +44720 IF (IVCOMP - 5) 24720,14720,24720 03210036 +14720 IVPASS = IVPASS + 1 03220036 + WRITE (I02,80001) IVTNUM 03230036 + GO TO 4731 03240036 +24720 IVFAIL = IVFAIL + 1 03250036 + IVCORR = 5 03260036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03270036 + 4731 CONTINUE 03280036 + IVTNUM = 473 03290036 +C 03300036 +C **** TEST 473 **** 03310036 +C 03320036 + IF (ICZERO) 34730, 4730, 34730 03330036 + 4730 CONTINUE 03340036 + IVCOMP = 959/120 03350036 + GO TO 44730 03360036 +34730 IVDELE = IVDELE + 1 03370036 + WRITE (I02,80003) IVTNUM 03380036 + IF (ICZERO) 44730, 4741, 44730 03390036 +44730 IF (IVCOMP - 7) 24730,14730,24730 03400036 +14730 IVPASS = IVPASS + 1 03410036 + WRITE (I02,80001) IVTNUM 03420036 + GO TO 4741 03430036 +24730 IVFAIL = IVFAIL + 1 03440036 + IVCORR = 7 03450036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03460036 + 4741 CONTINUE 03470036 + IVTNUM = 474 03480036 +C 03490036 +C **** TEST 474 **** 03500036 +C 03510036 + IF (ICZERO) 34740, 4740, 34740 03520036 + 4740 CONTINUE 03530036 + IVCOMP = 959 / 12 03540036 + GO TO 44740 03550036 +34740 IVDELE = IVDELE + 1 03560036 + WRITE (I02,80003) IVTNUM 03570036 + IF (ICZERO) 44740, 4751, 44740 03580036 +44740 IF (IVCOMP - 79) 24740,14740,24740 03590036 +14740 IVPASS = IVPASS + 1 03600036 + WRITE (I02,80001) IVTNUM 03610036 + GO TO 4751 03620036 +24740 IVFAIL = IVFAIL + 1 03630036 + IVCORR = 79 03640036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03650036 + 4751 CONTINUE 03660036 + IVTNUM = 475 03670036 +C 03680036 +C **** TEST 475 **** 03690036 +C 03700036 + IF (ICZERO) 34750, 4750, 34750 03710036 + 4750 CONTINUE 03720036 + IVCOMP = 959/6 03730036 + GO TO 44750 03740036 +34750 IVDELE = IVDELE + 1 03750036 + WRITE (I02,80003) IVTNUM 03760036 + IF (ICZERO) 44750, 4761, 44750 03770036 +44750 IF (IVCOMP - 159) 24750,14750,24750 03780036 +14750 IVPASS = IVPASS + 1 03790036 + WRITE (I02,80001) IVTNUM 03800036 + GO TO 4761 03810036 +24750 IVFAIL = IVFAIL + 1 03820036 + IVCORR = 159 03830036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03840036 + 4761 CONTINUE 03850036 + IVTNUM = 476 03860036 +C 03870036 +C **** TEST 476 **** 03880036 +C 03890036 + IF (ICZERO) 34760, 4760, 34760 03900036 + 4760 CONTINUE 03910036 + IVCOMP = 28606/8 03920036 + GO TO 44760 03930036 +34760 IVDELE = IVDELE + 1 03940036 + WRITE (I02,80003) IVTNUM 03950036 + IF (ICZERO) 44760, 4771, 44760 03960036 +44760 IF (IVCOMP - 3575) 24760,14760,24760 03970036 +14760 IVPASS = IVPASS + 1 03980036 + WRITE (I02,80001) IVTNUM 03990036 + GO TO 4771 04000036 +24760 IVFAIL = IVFAIL + 1 04010036 + IVCORR = 3575 04020036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04030036 + 4771 CONTINUE 04040036 + IVTNUM = 477 04050036 +C 04060036 +C **** TEST 477 **** 04070036 +C 04080036 + IF (ICZERO) 34770, 4770, 34770 04090036 + 4770 CONTINUE 04100036 + IVCOMP = 25603/2 04110036 + GO TO 44770 04120036 +34770 IVDELE = IVDELE + 1 04130036 + WRITE (I02,80003) IVTNUM 04140036 + IF (ICZERO) 44770, 4781, 44770 04150036 +44770 IF (IVCOMP - 12801) 24770,14770,24770 04160036 +14770 IVPASS = IVPASS + 1 04170036 + WRITE (I02,80001) IVTNUM 04180036 + GO TO 4781 04190036 +24770 IVFAIL = IVFAIL + 1 04200036 + IVCORR = 12801 04210036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04220036 + 4781 CONTINUE 04230036 + IVTNUM = 478 04240036 +C 04250036 +C **** TEST 478 **** 04260036 +C 04270036 + IF (ICZERO) 34780, 4780, 34780 04280036 + 4780 CONTINUE 04290036 + IVCOMP = 25603/10354 04300036 + GO TO 44780 04310036 +34780 IVDELE = IVDELE + 1 04320036 + WRITE (I02,80003) IVTNUM 04330036 + IF (ICZERO) 44780, 4791, 44780 04340036 +44780 IF (IVCOMP - 2) 24780,14780,24780 04350036 +14780 IVPASS = IVPASS + 1 04360036 + WRITE (I02,80001) IVTNUM 04370036 + GO TO 4791 04380036 +24780 IVFAIL = IVFAIL + 1 04390036 + IVCORR = 2 04400036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04410036 +C 04420036 +C TEST 479 THROUGH TEST 482 - NEGATIVE CONSTANTS INCLUDED 04430036 +C NO TRUNCATION REQUIRED 04440036 +C 04450036 + 4791 CONTINUE 04460036 + IVTNUM = 479 04470036 +C 04480036 +C **** TEST 479 **** 04490036 +C 04500036 + IF (ICZERO) 34790, 4790, 34790 04510036 + 4790 CONTINUE 04520036 + IVCOMP = -4/2 04530036 + GO TO 44790 04540036 +34790 IVDELE = IVDELE + 1 04550036 + WRITE (I02,80003) IVTNUM 04560036 + IF (ICZERO) 44790, 4801, 44790 04570036 +44790 IF (IVCOMP + 2) 24790,14790,24790 04580036 +14790 IVPASS = IVPASS + 1 04590036 + WRITE (I02,80001) IVTNUM 04600036 + GO TO 4801 04610036 +24790 IVFAIL = IVFAIL + 1 04620036 + IVCORR = -2 04630036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04640036 + 4801 CONTINUE 04650036 + IVTNUM = 480 04660036 +C 04670036 +C **** TEST 480 **** 04680036 +C 04690036 + IF (ICZERO) 34800, 4800, 34800 04700036 + 4800 CONTINUE 04710036 + IVCOMP = 75 / (-25) 04720036 + GO TO 44800 04730036 +34800 IVDELE = IVDELE + 1 04740036 + WRITE (I02,80003) IVTNUM 04750036 + IF (ICZERO) 44800, 4811, 44800 04760036 +44800 IF (IVCOMP + 3) 24800,14800,24800 04770036 +14800 IVPASS = IVPASS + 1 04780036 + WRITE (I02,80001) IVTNUM 04790036 + GO TO 4811 04800036 +24800 IVFAIL = IVFAIL + 1 04810036 + IVCORR = -3 04820036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04830036 + 4811 CONTINUE 04840036 + IVTNUM = 481 04850036 +C 04860036 +C **** TEST 481 **** 04870036 +C 04880036 + IF (ICZERO) 34810, 4810, 34810 04890036 + 4810 CONTINUE 04900036 + IVCOMP= (-6170) / (-1234) 04910036 + GO TO 44810 04920036 +34810 IVDELE = IVDELE + 1 04930036 + WRITE (I02,80003) IVTNUM 04940036 + IF (ICZERO) 44810, 4821, 44810 04950036 +44810 IF (IVCOMP - 5) 24810,14810,24810 04960036 +14810 IVPASS = IVPASS + 1 04970036 + WRITE (I02,80001) IVTNUM 04980036 + GO TO 4821 04990036 +24810 IVFAIL = IVFAIL + 1 05000036 + IVCORR = 5 05010036 + 05020036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05030036 + 4821 CONTINUE 05040036 + IVTNUM = 482 05050036 +C 05060036 +C **** TEST 482 **** 05070036 +C 05080036 + IF (ICZERO) 34820, 4820, 34820 05090036 + 4820 CONTINUE 05100036 + IVCOMP = -32766/(-2) 05110036 + GO TO 44820 05120036 +34820 IVDELE = IVDELE + 1 05130036 + WRITE (I02,80003) IVTNUM 05140036 + IF (ICZERO) 44820, 4831, 44820 05150036 +44820 IF (IVCOMP - 16383) 24820,14820,24820 05160036 +14820 IVPASS = IVPASS + 1 05170036 + WRITE (I02,80001) IVTNUM 05180036 + GO TO 4831 05190036 +24820 IVFAIL = IVFAIL + 1 05200036 + IVCORR = 16383 05210036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05220036 +C 05230036 +C TEST 483 THROUGH TEST 490 - NEGATIVE CONSTANTS INCLUDED 05240036 +C TRUNCATION REQUIRED 05250036 +C 05260036 + 4831 CONTINUE 05270036 + IVTNUM = 483 05280036 +C 05290036 +C **** TEST 483 **** 05300036 +C 05310036 + IF (ICZERO) 34830, 4830, 34830 05320036 + 4830 CONTINUE 05330036 + IVCOMP = -5/2 05340036 + GO TO 44830 05350036 +34830 IVDELE = IVDELE + 1 05360036 + WRITE (I02,80003) IVTNUM 05370036 + IF (ICZERO) 44830, 4841, 44830 05380036 +44830 IF (IVCOMP +2) 24830,14830,24830 05390036 +14830 IVPASS = IVPASS + 1 05400036 + WRITE (I02,80001) IVTNUM 05410036 + GO TO 4841 05420036 +24830 IVFAIL = IVFAIL + 1 05430036 + IVCORR = -2 05440036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05450036 + 4841 CONTINUE 05460036 + IVTNUM = 484 05470036 +C 05480036 +C **** TEST 484 **** 05490036 +C 05500036 + IF (ICZERO) 34840, 4840, 34840 05510036 + 4840 CONTINUE 05520036 + IVCOMP = -2/3 05530036 + GO TO 44840 05540036 +34840 IVDELE = IVDELE + 1 05550036 + WRITE (I02,80003) IVTNUM 05560036 + IF (ICZERO) 44840, 4851, 44840 05570036 +44840 IF (IVCOMP) 24840,14840,24840 05580036 +14840 IVPASS = IVPASS + 1 05590036 + WRITE (I02,80001) IVTNUM 05600036 + GO TO 4851 05610036 +24840 IVFAIL = IVFAIL + 1 05620036 + IVCORR = 0 05630036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05640036 + 4851 CONTINUE 05650036 + IVTNUM = 485 05660036 +C 05670036 +C **** TEST 485 **** 05680036 +C 05690036 + IF (ICZERO) 34850, 4850, 34850 05700036 + 4850 CONTINUE 05710036 + IVCOMP = 80/(-15) 05720036 + GO TO 44850 05730036 +34850 IVDELE = IVDELE + 1 05740036 + WRITE (I02,80003) IVTNUM 05750036 + IF (ICZERO) 44850, 4861, 44850 05760036 +44850 IF (IVCOMP +5) 24850,14850,24850 05770036 +14850 IVPASS = IVPASS + 1 05780036 + WRITE (I02,80001) IVTNUM 05790036 + GO TO 4861 05800036 +24850 IVFAIL = IVFAIL + 1 05810036 + IVCORR = -5 05820036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05830036 + 4861 CONTINUE 05840036 + IVTNUM = 486 05850036 +C 05860036 +C **** TEST 486 **** 05870036 +C 05880036 + IF (ICZERO) 34860, 4860, 34860 05890036 + 4860 CONTINUE 05900036 + IVCOMP = -959/(-120) 05910036 + GO TO 44860 05920036 +34860 IVDELE = IVDELE + 1 05930036 + WRITE (I02,80003) IVTNUM 05940036 + IF (ICZERO) 44860, 4871, 44860 05950036 +44860 IF (IVCOMP - 7) 24860,14860,24860 05960036 +14860 IVPASS = IVPASS + 1 05970036 + WRITE (I02,80001) IVTNUM 05980036 + GO TO 4871 05990036 +24860 IVFAIL = IVFAIL + 1 06000036 + IVCORR = 7 06010036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06020036 + 4871 CONTINUE 06030036 + IVTNUM = 487 06040036 +C 06050036 +C **** TEST 487 **** 06060036 +C 06070036 + IF (ICZERO) 34870, 4870, 34870 06080036 + 4870 CONTINUE 06090036 + IVCOMP = -959/6 06100036 + GO TO 44870 06110036 +34870 IVDELE = IVDELE + 1 06120036 + WRITE (I02,80003) IVTNUM 06130036 + IF (ICZERO) 44870, 4881, 44870 06140036 +44870 IF (IVCOMP + 159) 24870,14870,24870 06150036 +14870 IVPASS = IVPASS + 1 06160036 + WRITE (I02,80001) IVTNUM 06170036 + GO TO 4881 06180036 +24870 IVFAIL = IVFAIL + 1 06190036 + IVCORR = -159 06200036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06210036 + 4881 CONTINUE 06220036 + IVTNUM = 488 06230036 +C 06240036 +C **** TEST 488 **** 06250036 +C 06260036 + IF (ICZERO) 34880, 4880, 34880 06270036 + 4880 CONTINUE 06280036 + IVCOMP = -28606/(-8) 06290036 + GO TO 44880 06300036 +34880 IVDELE = IVDELE + 1 06310036 + WRITE (I02,80003) IVTNUM 06320036 + IF (ICZERO) 44880, 4891, 44880 06330036 +44880 IF (IVCOMP - 3575) 24880,14880,24880 06340036 +14880 IVPASS = IVPASS + 1 06350036 + WRITE (I02,80001) IVTNUM 06360036 + GO TO 4891 06370036 +24880 IVFAIL = IVFAIL + 1 06380036 + IVCORR = 3575 06390036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06400036 + 4891 CONTINUE 06410036 + IVTNUM = 489 06420036 +C 06430036 +C **** TEST 489 **** 06440036 +C 06450036 + IF (ICZERO) 34890, 4890, 34890 06460036 + 4890 CONTINUE 06470036 + IVCOMP = -25603/2 06480036 + GO TO 44890 06490036 +34890 IVDELE = IVDELE + 1 06500036 + WRITE (I02,80003) IVTNUM 06510036 + IF (ICZERO) 44890, 4901, 44890 06520036 +44890 IF (IVCOMP + 12801) 24890,14890,24890 06530036 +14890 IVPASS = IVPASS + 1 06540036 + WRITE (I02,80001) IVTNUM 06550036 + GO TO 4901 06560036 +24890 IVFAIL = IVFAIL + 1 06570036 + IVCORR = -12801 06580036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06590036 + 4901 CONTINUE 06600036 + IVTNUM = 490 06610036 +C 06620036 +C **** TEST 490 **** 06630036 +C 06640036 + IF (ICZERO) 34900, 4900, 34900 06650036 + 4900 CONTINUE 06660036 + IVCOMP = -25603/(-10354) 06670036 + GO TO 44900 06680036 +34900 IVDELE = IVDELE + 1 06690036 + WRITE (I02,80003) IVTNUM 06700036 + IF (ICZERO) 44900, 4911, 44900 06710036 +44900 IF (IVCOMP - 2) 24900,14900,24900 06720036 +14900 IVPASS = IVPASS + 1 06730036 + WRITE (I02,80001) IVTNUM 06740036 + GO TO 4911 06750036 +24900 IVFAIL = IVFAIL + 1 06760036 + IVCORR = 2 06770036 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06780036 +C 06790036 +C **** END OF TESTS **** 06800036 + 4911 CONTINUE 06810036 +C 06820036 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 06830036 +99999 CONTINUE 06840036 + WRITE (I02,90002) 06850036 + WRITE (I02,90006) 06860036 + WRITE (I02,90002) 06870036 + WRITE (I02,90002) 06880036 + WRITE (I02,90007) 06890036 + WRITE (I02,90002) 06900036 + WRITE (I02,90008) IVFAIL 06910036 + WRITE (I02,90009) IVPASS 06920036 + WRITE (I02,90010) IVDELE 06930036 +C 06940036 +C 06950036 +C TERMINATE ROUTINE EXECUTION 06960036 + STOP 06970036 +C 06980036 +C FORMAT STATEMENTS FOR PAGE HEADERS 06990036 +90000 FORMAT ("1") 07000036 +90002 FORMAT (" ") 07010036 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07020036 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07030036 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07040036 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07050036 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07060036 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07070036 +C 07080036 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07090036 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07100036 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07110036 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07120036 +C 07130036 +C FORMAT STATEMENTS FOR TEST RESULTS 07140036 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07150036 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07160036 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07170036 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07180036 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07190036 +C 07200036 +90007 FORMAT (" ",20X,"END OF PROGRAM FM036" ) 07210036 + END 07220036 diff --git a/Fortran/UnitTests/fcvs21_f95/FM036.reference_output b/Fortran/UnitTests/fcvs21_f95/FM036.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM036.reference_output @@ -0,0 +1,53 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 462 PASS + 463 PASS + 464 PASS + 465 PASS + 466 PASS + 467 PASS + 468 PASS + 469 PASS + 470 PASS + 471 PASS + 472 PASS + 473 PASS + 474 PASS + 475 PASS + 476 PASS + 477 PASS + 478 PASS + 479 PASS + 480 PASS + 481 PASS + 482 PASS + 483 PASS + 484 PASS + 485 PASS + 486 PASS + 487 PASS + 488 PASS + 489 PASS + 490 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM036 + + 0 ERRORS ENCOUNTERED + 29 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM037.f b/Fortran/UnitTests/fcvs21_f95/FM037.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM037.f @@ -0,0 +1,731 @@ + PROGRAM FM037 + +C COMMENT SECTION 00010037 +C 00020037 +C FM037 00030037 +C 00040037 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050037 +C FORM 00060037 +C INTEGER VARIABLE = ARITHMETIC EXPRESSION 00070037 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THREE INTEGER 00080037 +C CONSTANTS AND THE ARITHMETIC OPERATOR /. BOTH POSITIVE AND NEGA- 00090037 +C TIVE CONSTANTS ARE USED IN THE ARITHMETIC EXPRESSION. 00100037 +C 00110037 +C THERE ARE TESTS WHICH REQUIRE NO TRUNCATION OF THE RESULT 00120037 +C AND TESTS WHERE THE RESULT MUST BE TRUNCATED BEFORE BEING STORED 00130037 +C IN THE RESULTANT INTEGER VARIABLE. THE STANDARD STATES 'THE VALUE00140037 +C OF AN INTEGER FACTOR OR TERM IS THE NEAREST INTEGER WHOSE MAGNI- 00150037 +C TUDE DOES NOT EXCEED THE MAGNITUDE OF THE MATHEMATICAL VALUE 00160037 +C REPRESENTED BY THAT FACTOR OR TERM. THE ASSOCIATIVE AND COMMUTA- 00170037 +C TIVE LAWS DO NOT APPLY IN THE EVALUATION OF INTEGER TERMS CON- 00180037 +C TAINING DIVISION, HENCE THE EVALUATION OF SUCH TERMS MUST EFFEC- 00190037 +C TIVELY PROCEED FROM LEFT TO RIGHT.' 00200037 +C 00210037 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00220037 +C (1) INTEGER CONSTANT/INTEGER CONSTANT/INTEGER CONSTANT 00230037 +C NO TRUNCATION REQUIRED 00240037 +C (2) INTEGER CONSTANT/INTEGER CONSTANT/INTEGER CONSTANT 00250037 +C TRUNCATION REQUIRED 00260037 +C 00270037 +C REFERENCES 00280037 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00290037 +C X3.9-1978 00300037 +C 00310037 +C SECTION 4.3, INTEGER TYPE 00320037 +C SECTION 4.3.1, INTEGER CONSTANT 00330037 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00340037 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00350037 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00360037 +C 00370037 +C ********************************************************** 00380037 +C 00390037 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00400037 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00410037 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00420037 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00430037 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00440037 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00450037 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00460037 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00470037 +C OF EXECUTING THESE TESTS. 00480037 +C 00490037 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00500037 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00510037 +C 00520037 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00530037 +C 00540037 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00550037 +C SOFTWARE STANDARDS VALIDATION GROUP 00560037 +C BUILDING 225 RM A266 00570037 +C GAITHERSBURG, MD 20899 00580037 +C ********************************************************** 00590037 +C 00600037 +C 00610037 +C 00620037 +C INITIALIZATION SECTION 00630037 +C 00640037 +C INITIALIZE CONSTANTS 00650037 +C ************** 00660037 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00670037 + I01 = 5 00680037 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00690037 + I02 = 6 00700037 +C SYSTEM ENVIRONMENT SECTION 00710037 +C 00720037 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00730037 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740037 +C (UNIT NUMBER FOR CARD READER). 00750037 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00760037 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00770037 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00780037 +C 00790037 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00800037 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00810037 +C (UNIT NUMBER FOR PRINTER). 00820037 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00830037 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00840037 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00850037 +C 00860037 + IVPASS=0 00870037 + IVFAIL=0 00880037 + IVDELE=0 00890037 + ICZERO=0 00900037 +C 00910037 +C WRITE PAGE HEADERS 00920037 + WRITE (I02,90000) 00930037 + WRITE (I02,90001) 00940037 + WRITE (I02,90002) 00950037 + WRITE (I02, 90002) 00960037 + WRITE (I02,90003) 00970037 + WRITE (I02,90002) 00980037 + WRITE (I02,90004) 00990037 + WRITE (I02,90002) 01000037 + WRITE (I02,90011) 01010037 + WRITE (I02,90002) 01020037 + WRITE (I02,90002) 01030037 + WRITE (I02,90005) 01040037 + WRITE (I02,90006) 01050037 + WRITE (I02,90002) 01060037 +C 01070037 +C TEST SECTION 01080037 +C 01090037 +C ARITHMETIC ASSIGNMENT STATEMENT 01100037 +C 01110037 +C TEST 491 THROUGH TEST 519 CONTAIN THREE INTEGER CONSTANTS AND 01120037 +C OPERATOR / IN AN ARITHMETIC EXPRESSION. THE FORM TESTED IS 01130037 +C INTEGER VARIABLE = INTEGER CONSTANT/INTEGER CONSTANT/INT.CON. 01140037 +C 01150037 +C 01160037 +C TEST 491 THROUGH TEST 496 - POSITIVE INTEGER CONSTANTS 01170037 +C NO TRUNCATION REQUIRED 01180037 +C 01190037 + 4911 CONTINUE 01200037 + IVTNUM = 491 01210037 +C 01220037 +C **** TEST 491 **** 01230037 +C 01240037 + IF (ICZERO) 34910, 4910, 34910 01250037 + 4910 CONTINUE 01260037 + IVCOMP = 24/3/4 01270037 + GO TO 44910 01280037 +34910 IVDELE = IVDELE + 1 01290037 + WRITE (I02,80003) IVTNUM 01300037 + IF (ICZERO) 44910, 4921, 44910 01310037 +44910 IF (IVCOMP - 2) 24910,14910,24910 01320037 +14910 IVPASS = IVPASS + 1 01330037 + WRITE (I02,80001) IVTNUM 01340037 + GO TO 4921 01350037 +24910 IVFAIL = IVFAIL + 1 01360037 + IVCORR = 2 01370037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01380037 + 4921 CONTINUE 01390037 + IVTNUM = 492 01400037 +C 01410037 +C **** TEST 492 **** 01420037 +C 01430037 + IF (ICZERO) 34920, 4920, 34920 01440037 + 4920 CONTINUE 01450037 + IVCOMP = 330/3/2 01460037 + GO TO 44920 01470037 +34920 IVDELE = IVDELE + 1 01480037 + WRITE (I02,80003) IVTNUM 01490037 + IF (ICZERO) 44920, 4931, 44920 01500037 +44920 IF (IVCOMP - 55) 24920,14920,24920 01510037 +14920 IVPASS = IVPASS + 1 01520037 + WRITE (I02,80001) IVTNUM 01530037 + GO TO 4931 01540037 +24920 IVFAIL = IVFAIL + 1 01550037 + IVCORR = 55 01560037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01570037 + 4931 CONTINUE 01580037 + IVTNUM = 493 01590037 +C 01600037 +C **** TEST 493 **** 01610037 +C 01620037 + IF (ICZERO) 34930, 4930, 34930 01630037 + 4930 CONTINUE 01640037 + IVCOMP = 15249/13/51 01650037 + GO TO 44930 01660037 +34930 IVDELE = IVDELE + 1 01670037 + WRITE (I02,80003) IVTNUM 01680037 + IF (ICZERO) 44930, 4941, 44930 01690037 +44930 IF (IVCOMP - 23) 24930,14930,24930 01700037 +14930 IVPASS = IVPASS + 1 01710037 + WRITE (I02,80001) IVTNUM 01720037 + GO TO 4941 01730037 +24930 IVFAIL = IVFAIL + 1 01740037 + IVCORR = 23 01750037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01760037 + 4941 CONTINUE 01770037 + IVTNUM = 494 01780037 +C 01790037 +C **** TEST 494 **** 01800037 +C 01810037 + IF (ICZERO) 34940, 4940, 34940 01820037 + 4940 CONTINUE 01830037 + IVCOMP = 7150/2/25 01840037 + GO TO 44940 01850037 +34940 IVDELE = IVDELE + 1 01860037 + WRITE (I02,80003) IVTNUM 01870037 + IF (ICZERO) 44940, 4951, 44940 01880037 +44940 IF (IVCOMP - 143) 24940,14940,24940 01890037 +14940 IVPASS = IVPASS + 1 01900037 + WRITE (I02,80001) IVTNUM 01910037 + GO TO 4951 01920037 +24940 IVFAIL = IVFAIL + 1 01930037 + IVCORR = 143 01940037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01950037 + 4951 CONTINUE 01960037 + IVTNUM = 495 01970037 +C 01980037 +C **** TEST 495 **** 01990037 +C 02000037 + IF (ICZERO) 34950, 4950, 34950 02010037 + 4950 CONTINUE 02020037 + IVCOMP = 32766/2/3 02030037 + GO TO 44950 02040037 +34950 IVDELE = IVDELE + 1 02050037 + WRITE (I02,80003) IVTNUM 02060037 + IF (ICZERO) 44950, 4961, 44950 02070037 +44950 IF (IVCOMP - 5461) 24950,14950,24950 02080037 +14950 IVPASS = IVPASS + 1 02090037 + WRITE (I02,80001) IVTNUM 02100037 + GO TO 4961 02110037 +24950 IVFAIL = IVFAIL + 1 02120037 + IVCORR = 5461 02130037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02140037 + 4961 CONTINUE 02150037 + IVTNUM = 496 02160037 +C 02170037 +C **** TEST 496 **** 02180037 +C 02190037 + IF (ICZERO) 34960, 4960, 34960 02200037 + 4960 CONTINUE 02210037 + IVCOMP = 32766/1/1 02220037 + GO TO 44960 02230037 +34960 IVDELE = IVDELE + 1 02240037 + WRITE (I02,80003) IVTNUM 02250037 + IF (ICZERO) 44960, 4971, 44960 02260037 +44960 IF (IVCOMP - 32766) 24960,14960,24960 02270037 +14960 IVPASS = IVPASS + 1 02280037 + WRITE (I02,80001) IVTNUM 02290037 + GO TO 4971 02300037 +24960 IVFAIL = IVFAIL + 1 02310037 + IVCORR = 32766 02320037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02330037 +C 02340037 +C TEST 497 THROUGH TEST 502 - POSITIVE INTEGER CONSTANTS 02350037 +C TRUNCATION REQUIRED 02360037 +C 02370037 + 4971 CONTINUE 02380037 + IVTNUM = 497 02390037 +C 02400037 +C **** TEST 497 **** 02410037 +C 02420037 + IF (ICZERO) 34970, 4970, 34970 02430037 + 4970 CONTINUE 02440037 + IVCOMP = 24/3/3 02450037 + GO TO 44970 02460037 +34970 IVDELE = IVDELE + 1 02470037 + WRITE (I02,80003) IVTNUM 02480037 + IF (ICZERO) 44970, 4981, 44970 02490037 +44970 IF (IVCOMP -2) 24970,14970,24970 02500037 +14970 IVPASS = IVPASS + 1 02510037 + WRITE (I02,80001) IVTNUM 02520037 + GO TO 4981 02530037 +24970 IVFAIL = IVFAIL + 1 02540037 + IVCORR = 2 02550037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02560037 + 4981 CONTINUE 02570037 + IVTNUM = 498 02580037 +C 02590037 +C **** TEST 498 **** 02600037 +C 02610037 + IF (ICZERO) 34980, 4980, 34980 02620037 + 4980 CONTINUE 02630037 + IVCOMP = 230/2/3 02640037 + GO TO 44980 02650037 +34980 IVDELE = IVDELE + 1 02660037 + WRITE (I02,80003) IVTNUM 02670037 + IF (ICZERO) 44980, 4991, 44980 02680037 +44980 IF (IVCOMP - 38) 24980,14980,24980 02690037 +14980 IVPASS = IVPASS + 1 02700037 + WRITE (I02,80001) IVTNUM 02710037 + GO TO 4991 02720037 +24980 IVFAIL = IVFAIL + 1 02730037 + IVCORR = 38 02740037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02750037 + 4991 CONTINUE 02760037 + IVTNUM = 499 02770037 +C 02780037 +C **** TEST 499 **** 02790037 +C 02800037 + IF (ICZERO) 34990, 4990, 34990 02810037 + 4990 CONTINUE 02820037 + IVCOMP = 7151/3/10 02830037 + GO TO 44990 02840037 +34990 IVDELE = IVDELE + 1 02850037 + WRITE (I02,80003) IVTNUM 02860037 + IF (ICZERO) 44990, 5001, 44990 02870037 +44990 IF (IVCOMP - 238) 24990,14990,24990 02880037 +14990 IVPASS = IVPASS + 1 02890037 + WRITE (I02,80001) IVTNUM 02900037 + GO TO 5001 02910037 +24990 IVFAIL = IVFAIL + 1 02920037 + IVCORR = 238 02930037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02940037 + 5001 CONTINUE 02950037 + IVTNUM = 500 02960037 +C 02970037 +C **** TEST 500 **** 02980037 +C 02990037 + IF (ICZERO) 35000, 5000, 35000 03000037 + 5000 CONTINUE 03010037 + IVCOMP = 15248/51/13 03020037 + GO TO 45000 03030037 +35000 IVDELE = IVDELE + 1 03040037 + WRITE (I02,80003) IVTNUM 03050037 + IF (ICZERO) 45000, 5011, 45000 03060037 +45000 IF (IVCOMP - 22) 25000,15000,25000 03070037 +15000 IVPASS = IVPASS + 1 03080037 + WRITE (I02,80001) IVTNUM 03090037 + GO TO 5011 03100037 +25000 IVFAIL = IVFAIL + 1 03110037 + IVCORR = 22 03120037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03130037 + 5011 CONTINUE 03140037 + IVTNUM = 501 03150037 +C 03160037 +C **** TEST 501 **** 03170037 +C 03180037 + IF (ICZERO) 35010, 5010, 35010 03190037 + 5010 CONTINUE 03200037 + IVCOMP = 27342/4/3 03210037 + GO TO 45010 03220037 +35010 IVDELE = IVDELE + 1 03230037 + WRITE (I02,80003) IVTNUM 03240037 + IF (ICZERO) 45010, 5021, 45010 03250037 +45010 IF (IVCOMP - 2278) 25010,15010,25010 03260037 +15010 IVPASS = IVPASS + 1 03270037 + WRITE (I02,80001) IVTNUM 03280037 + GO TO 5021 03290037 +25010 IVFAIL = IVFAIL + 1 03300037 + IVCORR = 2278 03310037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03320037 + 5021 CONTINUE 03330037 + IVTNUM = 502 03340037 +C 03350037 +C **** TEST 502 **** 03360037 +C 03370037 + IF (ICZERO) 35020, 5020, 35020 03380037 + 5020 CONTINUE 03390037 + IVCOMP = 32767/2/1 03400037 + GO TO 45020 03410037 +35020 IVDELE = IVDELE + 1 03420037 + WRITE (I02,80003) IVTNUM 03430037 + IF (ICZERO) 45020, 5031, 45020 03440037 +45020 IF (IVCOMP - 16383) 25020,15020,25020 03450037 +15020 IVPASS = IVPASS + 1 03460037 + WRITE (I02,80001) IVTNUM 03470037 + GO TO 5031 03480037 +25020 IVFAIL = IVFAIL + 1 03490037 + IVCORR = 16383 03500037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03510037 +C 03520037 +C TEST 503 THROUGH TEST 507 - NEGATIVE INTEGER CONSTANTS INCLUDED 03530037 +C NO TRUNCATION REQUIRED 03540037 +C 03550037 + 5031 CONTINUE 03560037 + IVTNUM = 503 03570037 +C 03580037 +C **** TEST 503 **** 03590037 +C 03600037 + IF (ICZERO) 35030, 5030, 35030 03610037 + 5030 CONTINUE 03620037 + IVCOMP = -24/3/4 03630037 + GO TO 45030 03640037 +35030 IVDELE = IVDELE + 1 03650037 + WRITE (I02,80003) IVTNUM 03660037 + IF (ICZERO) 45030, 5041, 45030 03670037 +45030 IF (IVCOMP +2) 25030,15030,25030 03680037 +15030 IVPASS = IVPASS + 1 03690037 + WRITE (I02,80001) IVTNUM 03700037 + GO TO 5041 03710037 +25030 IVFAIL = IVFAIL + 1 03720037 + IVCORR = -2 03730037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03740037 + 5041 CONTINUE 03750037 + IVTNUM = 504 03760037 +C 03770037 +C **** TEST 504 **** 03780037 +C 03790037 + IF (ICZERO) 35040, 5040, 35040 03800037 + 5040 CONTINUE 03810037 + IVCOMP = 330/(-3)/2 03820037 + GO TO 45040 03830037 +35040 IVDELE = IVDELE + 1 03840037 + WRITE (I02,80003) IVTNUM 03850037 + IF (ICZERO) 45040, 5051, 45040 03860037 +45040 IF (IVCOMP + 55) 25040,15040,25040 03870037 +15040 IVPASS = IVPASS + 1 03880037 + WRITE (I02,80001) IVTNUM 03890037 + GO TO 5051 03900037 +25040 IVFAIL = IVFAIL + 1 03910037 + IVCORR = -55 03920037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03930037 + 5051 CONTINUE 03940037 + IVTNUM = 505 03950037 +C 03960037 +C **** TEST 505 **** 03970037 +C 03980037 + IF (ICZERO) 35050, 5050, 35050 03990037 + 5050 CONTINUE 04000037 + IVCOMP = 15249/(-13)/(-51) 04010037 + GO TO 45050 04020037 +35050 IVDELE = IVDELE + 1 04030037 + WRITE (I02,80003) IVTNUM 04040037 + IF (ICZERO) 45050, 5061, 45050 04050037 +45050 IF (IVCOMP - 23) 25050,15050,25050 04060037 +15050 IVPASS = IVPASS + 1 04070037 + WRITE (I02,80001) IVTNUM 04080037 + GO TO 5061 04090037 +25050 IVFAIL = IVFAIL + 1 04100037 + IVCORR = 23 04110037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04120037 + 5061 CONTINUE 04130037 + IVTNUM = 506 04140037 +C 04150037 +C **** TEST 506 **** 04160037 +C 04170037 + IF (ICZERO) 35060, 5060, 35060 04180037 + 5060 CONTINUE 04190037 + IVCOMP = -7150/(-2)/(-25) 04200037 + GO TO 45060 04210037 +35060 IVDELE = IVDELE + 1 04220037 + WRITE (I02,80003) IVTNUM 04230037 + IF (ICZERO) 45060, 5071, 45060 04240037 +45060 IF (IVCOMP + 143) 25060,15060,25060 04250037 +15060 IVPASS = IVPASS + 1 04260037 + WRITE (I02,80001) IVTNUM 04270037 + GO TO 5071 04280037 +25060 IVFAIL = IVFAIL + 1 04290037 + IVCORR = -143 04300037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04310037 + 5071 CONTINUE 04320037 + IVTNUM = 507 04330037 +C 04340037 +C **** TEST 507 **** 04350037 +C 04360037 + IF (ICZERO) 35070, 5070, 35070 04370037 + 5070 CONTINUE 04380037 + IVCOMP = (-32766)/(-2)/(-3) 04390037 + GO TO 45070 04400037 +35070 IVDELE = IVDELE + 1 04410037 + WRITE (I02,80003) IVTNUM 04420037 + IF (ICZERO) 45070, 5081, 45070 04430037 +45070 IF (IVCOMP + 5461) 25070,15070,25070 04440037 +15070 IVPASS = IVPASS + 1 04450037 + WRITE (I02,80001) IVTNUM 04460037 + GO TO 5081 04470037 +25070 IVFAIL = IVFAIL + 1 04480037 + IVCORR = -5461 04490037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04500037 +C 04510037 +C TEST 508 THROUGH TEST 513 - NEGATIVE INTEGER CONSTANTS INCLUDED 04520037 +C TRUNCATION REQUIRED 04530037 +C 04540037 + 5081 CONTINUE 04550037 + IVTNUM = 508 04560037 +C 04570037 +C **** TEST 508 **** 04580037 +C 04590037 + IF (ICZERO) 35080, 5080, 35080 04600037 + 5080 CONTINUE 04610037 + IVCOMP = -24/3/3 04620037 + GO TO 45080 04630037 +35080 IVDELE = IVDELE + 1 04640037 + WRITE (I02,80003) IVTNUM 04650037 + IF (ICZERO) 45080, 5091, 45080 04660037 +45080 IF (IVCOMP + 2) 25080,15080,25080 04670037 +15080 IVPASS = IVPASS + 1 04680037 + WRITE (I02,80001) IVTNUM 04690037 + GO TO 5091 04700037 +25080 IVFAIL = IVFAIL + 1 04710037 + IVCORR = -2 04720037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04730037 + 5091 CONTINUE 04740037 + IVTNUM = 509 04750037 +C 04760037 +C **** TEST 509 **** 04770037 +C 04780037 + IF (ICZERO) 35090, 5090, 35090 04790037 + 5090 CONTINUE 04800037 + IVCOMP = 230/(-2)/3 04810037 + GO TO 45090 04820037 +35090 IVDELE = IVDELE + 1 04830037 + WRITE (I02,80003) IVTNUM 04840037 + IF (ICZERO) 45090, 5101, 45090 04850037 +45090 IF (IVCOMP + 38) 25090,15090,25090 04860037 +15090 IVPASS = IVPASS + 1 04870037 + WRITE (I02,80001) IVTNUM 04880037 + GO TO 5101 04890037 +25090 IVFAIL = IVFAIL + 1 04900037 + IVCORR = -38 04910037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04920037 + 5101 CONTINUE 04930037 + IVTNUM = 510 04940037 +C 04950037 +C **** TEST 510 **** 04960037 +C 04970037 + IF (ICZERO) 35100, 5100, 35100 04980037 + 5100 CONTINUE 04990037 + IVCOMP = 7151/(-3)/(-10) 05000037 + GO TO 45100 05010037 +35100 IVDELE = IVDELE + 1 05020037 + WRITE (I02,80003) IVTNUM 05030037 + IF (ICZERO) 45100, 5111, 45100 05040037 +45100 IF (IVCOMP - 238) 25100,15100,25100 05050037 +15100 IVPASS = IVPASS + 1 05060037 + WRITE (I02,80001) IVTNUM 05070037 + GO TO 5111 05080037 +25100 IVFAIL = IVFAIL + 1 05090037 + IVCORR = 238 05100037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05110037 + 5111 CONTINUE 05120037 + IVTNUM = 511 05130037 +C 05140037 +C **** TEST 511 **** 05150037 +C 05160037 + IF (ICZERO) 35110, 5110, 35110 05170037 + 5110 CONTINUE 05180037 + IVCOMP = -15248/(-51)/(-13) 05190037 + GO TO 45110 05200037 +35110 IVDELE = IVDELE + 1 05210037 + WRITE (I02,80003) IVTNUM 05220037 + IF (ICZERO) 45110, 5121, 45110 05230037 +45110 IF (IVCOMP + 22) 25110,15110,25110 05240037 +15110 IVPASS = IVPASS + 1 05250037 + WRITE (I02,80001) IVTNUM 05260037 + GO TO 5121 05270037 +25110 IVFAIL = IVFAIL + 1 05280037 + IVCORR = -22 05290037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05300037 + 5121 CONTINUE 05310037 + IVTNUM = 512 05320037 +C 05330037 +C **** TEST 512 **** 05340037 +C 05350037 + IF (ICZERO) 35120, 5120, 35120 05360037 + 5120 CONTINUE 05370037 + IVCOMP = (-27342)/(-4)/(-3) 05380037 + GO TO 45120 05390037 +35120 IVDELE = IVDELE + 1 05400037 + WRITE (I02,80003) IVTNUM 05410037 + IF (ICZERO) 45120, 5131, 45120 05420037 +45120 IF (IVCOMP + 2278) 25120,15120,25120 05430037 +15120 IVPASS = IVPASS + 1 05440037 + WRITE (I02,80001) IVTNUM 05450037 + GO TO 5131 05460037 +25120 IVFAIL = IVFAIL + 1 05470037 + IVCORR = -2278 05480037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05490037 + 5131 CONTINUE 05500037 + IVTNUM = 513 05510037 +C 05520037 +C **** TEST 513 **** 05530037 +C 05540037 + IF (ICZERO) 35130, 5130, 35130 05550037 + 5130 CONTINUE 05560037 + IVCOMP = 32767/2/(-1) 05570037 + GO TO 45130 05580037 +35130 IVDELE = IVDELE + 1 05590037 + WRITE (I02,80003) IVTNUM 05600037 + IF (ICZERO) 45130, 5141, 45130 05610037 +45130 IF (IVCOMP + 16383) 25130,15130,25130 05620037 +15130 IVPASS = IVPASS + 1 05630037 + WRITE (I02,80001) IVTNUM 05640037 + GO TO 5141 05650037 +25130 IVFAIL = IVFAIL + 1 05660037 + IVCORR = -16383 05670037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05680037 +C 05690037 +C TEST 514 THROUGH TEST 519 - POSITIVE AND NEGATIVE SIGNED INTEGER 05700037 +C CONSTANTS IN ARITHMETIC EXPRESSION. 05710037 +C 05720037 + 5141 CONTINUE 05730037 + IVTNUM = 514 05740037 +C 05750037 +C **** TEST 514 **** 05760037 +C 05770037 + IF (ICZERO) 35140, 5140, 35140 05780037 + 5140 CONTINUE 05790037 + IVCOMP = +24/(-3)/4 05800037 + GO TO 45140 05810037 +35140 IVDELE = IVDELE + 1 05820037 + WRITE (I02,80003) IVTNUM 05830037 + IF (ICZERO) 45140, 5151, 45140 05840037 +45140 IF (IVCOMP +2) 25140,15140,25140 05850037 +15140 IVPASS = IVPASS + 1 05860037 + WRITE (I02,80001) IVTNUM 05870037 + GO TO 5151 05880037 +25140 IVFAIL = IVFAIL + 1 05890037 + IVCORR = -2 05900037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05910037 + 5151 CONTINUE 05920037 + IVTNUM = 515 05930037 +C 05940037 +C **** TEST 515 **** 05950037 +C 05960037 + IF (ICZERO) 35150, 5150, 35150 05970037 + 5150 CONTINUE 05980037 + IVCOMP = 24/(+3)/(-4) 05990037 + GO TO 45150 06000037 +35150 IVDELE = IVDELE + 1 06010037 + WRITE (I02,80003) IVTNUM 06020037 + IF (ICZERO) 45150, 5161, 45150 06030037 +45150 IF (IVCOMP +2) 25150,15150,25150 06040037 +15150 IVPASS = IVPASS + 1 06050037 + WRITE (I02,80001) IVTNUM 06060037 + GO TO 5161 06070037 +25150 IVFAIL = IVFAIL + 1 06080037 + IVCORR = -2 06090037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06100037 + 5161 CONTINUE 06110037 + IVTNUM = 516 06120037 +C 06130037 +C **** TEST 516 **** 06140037 +C 06150037 + IF (ICZERO) 35160, 5160, 35160 06160037 + 5160 CONTINUE 06170037 + IVCOMP = -24/(-3)/(+4) 06180037 + GO TO 45160 06190037 +35160 IVDELE = IVDELE + 1 06200037 + WRITE (I02,80003) IVTNUM 06210037 + IF (ICZERO) 45160, 5171, 45160 06220037 +45160 IF (IVCOMP -2) 25160,15160,25160 06230037 +15160 IVPASS = IVPASS + 1 06240037 + WRITE (I02,80001) IVTNUM 06250037 + GO TO 5171 06260037 +25160 IVFAIL = IVFAIL + 1 06270037 + IVCORR = 2 06280037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06290037 + 5171 CONTINUE 06300037 + IVTNUM = 517 06310037 +C 06320037 +C **** TEST 517 **** 06330037 +C 06340037 + IF (ICZERO) 35170, 5170, 35170 06350037 + 5170 CONTINUE 06360037 + IVCOMP = -16811/(-16812)/(+1) 06370037 + GO TO 45170 06380037 +35170 IVDELE = IVDELE + 1 06390037 + WRITE (I02,80003) IVTNUM 06400037 + IF (ICZERO) 45170, 5181, 45170 06410037 +45170 IF (IVCOMP - 0) 25170,15170,25170 06420037 +15170 IVPASS = IVPASS + 1 06430037 + WRITE (I02,80001) IVTNUM 06440037 + GO TO 5181 06450037 +25170 IVFAIL = IVFAIL + 1 06460037 + IVCORR = 0 06470037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06480037 + 5181 CONTINUE 06490037 + IVTNUM = 518 06500037 +C 06510037 +C **** TEST 518 **** 06520037 +C 06530037 + IF (ICZERO) 35180, 5180, 35180 06540037 + 5180 CONTINUE 06550037 + IVCOMP = (-16811) / (+16811) / (+1) 06560037 + GO TO 45180 06570037 +35180 IVDELE = IVDELE + 1 06580037 + WRITE (I02,80003) IVTNUM 06590037 + IF (ICZERO) 45180, 5191, 45180 06600037 +45180 IF (IVCOMP +1) 25180,15180,25180 06610037 +15180 IVPASS = IVPASS + 1 06620037 + WRITE (I02,80001) IVTNUM 06630037 + GO TO 5191 06640037 +25180 IVFAIL = IVFAIL + 1 06650037 + IVCORR = -1 06660037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06670037 + 5191 CONTINUE 06680037 + IVTNUM = 519 06690037 +C 06700037 +C **** TEST 519 **** 06710037 +C 06720037 + IF (ICZERO) 35190, 5190, 35190 06730037 + 5190 CONTINUE 06740037 + IVCOMP = (-335)/(+168)/(+1) 06750037 + GO TO 45190 06760037 +35190 IVDELE = IVDELE + 1 06770037 + WRITE (I02,80003) IVTNUM 06780037 + IF (ICZERO) 45190, 5201, 45190 06790037 +45190 IF (IVCOMP + 1) 25190,15190,25190 06800037 +15190 IVPASS = IVPASS + 1 06810037 + WRITE (I02,80001) IVTNUM 06820037 + GO TO 5201 06830037 +25190 IVFAIL = IVFAIL + 1 06840037 + IVCORR = -1 06850037 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06860037 +C **** END OF TESTS **** 06870037 + 5201 CONTINUE 06880037 +C 06890037 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 06900037 +99999 CONTINUE 06910037 + WRITE (I02,90002) 06920037 + WRITE (I02,90006) 06930037 + WRITE (I02,90002) 06940037 + WRITE (I02,90002) 06950037 + WRITE (I02,90007) 06960037 + WRITE (I02,90002) 06970037 + WRITE (I02,90008) IVFAIL 06980037 + WRITE (I02,90009) IVPASS 06990037 + WRITE (I02,90010) IVDELE 07000037 +C 07010037 +C 07020037 +C TERMINATE ROUTINE EXECUTION 07030037 + STOP 07040037 +C 07050037 +C FORMAT STATEMENTS FOR PAGE HEADERS 07060037 +90000 FORMAT ("1") 07070037 +90002 FORMAT (" ") 07080037 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07090037 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07100037 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07110037 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07120037 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07130037 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07140037 +C 07150037 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07160037 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07170037 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07180037 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07190037 +C 07200037 +C FORMAT STATEMENTS FOR TEST RESULTS 07210037 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07220037 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07230037 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07240037 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07250037 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07260037 +C 07270037 +90007 FORMAT (" ",20X,"END OF PROGRAM FM037" ) 07280037 + END 07290037 diff --git a/Fortran/UnitTests/fcvs21_f95/FM037.reference_output b/Fortran/UnitTests/fcvs21_f95/FM037.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM037.reference_output @@ -0,0 +1,53 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 491 PASS + 492 PASS + 493 PASS + 494 PASS + 495 PASS + 496 PASS + 497 PASS + 498 PASS + 499 PASS + 500 PASS + 501 PASS + 502 PASS + 503 PASS + 504 PASS + 505 PASS + 506 PASS + 507 PASS + 508 PASS + 509 PASS + 510 PASS + 511 PASS + 512 PASS + 513 PASS + 514 PASS + 515 PASS + 516 PASS + 517 PASS + 518 PASS + 519 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM037 + + 0 ERRORS ENCOUNTERED + 29 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM038.f b/Fortran/UnitTests/fcvs21_f95/FM038.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM038.f @@ -0,0 +1,799 @@ + PROGRAM FM038 + +C COMMENT SECTION 00010038 +C 00020038 +C FM038 00030038 +C 00040038 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050038 +C FORM INTEGER VARIABLE = ARITHMETIC EXPRESSION 00060038 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00070038 +C OPERATOR /, INTEGER CONSTANTS AND AN INTEGER VARIABLE. BOTH 00080038 +C POSITIVE AND NEGATIVE VALUES ARE USED FOR THE INTEGER CONSTANTS 00090038 +C AND THE INTEGER VARIABLE. 00100038 +C 00110038 +C THERE ARE TESTS WHICH REQUIRE NO TRUNCATION OF THE RESULT 00120038 +C AND TESTS WHERE THE RESULT MUST BE TRUNCATED BEFORE BEING STORED 00130038 +C IN THE RESULTANT INTEGER VARIABLE. SOME OF THE TESTS USE PARENS 00140038 +C TO GROUP ELEMENTS IN THE ARITHMETIC EXPRESSION. 00150038 +C 00160038 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00170038 +C (1) (INTEGER CONSTANT/INTEGER CONSTANT)/INTEGER CONSTANT 00180038 +C (2) INTEGER CONSTANT/(INTEGER CONSTANT/INTEGER CONSTANT) 00190038 +C (3) INTEGER VARIABLE/INTEGER CONSTANT 00200038 +C (4) INTEGER CONSTANT/INTEGER VARIABLE 00210038 +C 00220038 +C REFERENCES 00230038 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00240038 +C X3.9-1978 00250038 +C 00260038 +C SECTION 4.3, INTEGER TYPE 00270038 +C SECTION 4.3.1, INTEGER CONSTANT 00280038 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00290038 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00300038 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00310038 +C 00320038 +C ********************************************************** 00330038 +C 00340038 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350038 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360038 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370038 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380038 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390038 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400038 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410038 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420038 +C OF EXECUTING THESE TESTS. 00430038 +C 00440038 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450038 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460038 +C 00470038 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480038 +C 00490038 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00500038 +C SOFTWARE STANDARDS VALIDATION GROUP 00510038 +C BUILDING 225 RM A266 00520038 +C GAITHERSBURG, MD 20899 00530038 +C ********************************************************** 00540038 +C 00550038 +C 00560038 +C 00570038 +C INITIALIZATION SECTION 00580038 +C 00590038 +C INITIALIZE CONSTANTS 00600038 +C ************** 00610038 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620038 + I01 = 5 00630038 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640038 + I02 = 6 00650038 +C SYSTEM ENVIRONMENT SECTION 00660038 +C 00670038 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00680038 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690038 +C (UNIT NUMBER FOR CARD READER). 00700038 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710038 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720038 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730038 +C 00740038 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00750038 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760038 +C (UNIT NUMBER FOR PRINTER). 00770038 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780038 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790038 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800038 +C 00810038 + IVPASS=0 00820038 + IVFAIL=0 00830038 + IVDELE=0 00840038 + ICZERO=0 00850038 +C 00860038 +C WRITE PAGE HEADERS 00870038 + WRITE (I02,90000) 00880038 + WRITE (I02,90001) 00890038 + WRITE (I02,90002) 00900038 + WRITE (I02, 90002) 00910038 + WRITE (I02,90003) 00920038 + WRITE (I02,90002) 00930038 + WRITE (I02,90004) 00940038 + WRITE (I02,90002) 00950038 + WRITE (I02,90011) 00960038 + WRITE (I02,90002) 00970038 + WRITE (I02,90002) 00980038 + WRITE (I02,90005) 00990038 + WRITE (I02,90006) 01000038 + WRITE (I02,90002) 01010038 +C 01020038 +C TEST SECTION 01030038 +C 01040038 +C ARITHMETIC ASSIGNMENT STATEMENT 01050038 +C 01060038 +C TEST 520 THROUGH TEST 525 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS01070038 +C OF THE FORM INTEGER VARIABLE = (INT.CON./INT.CON.)/INT.CON. 01080038 +C NO TRUNCATION OF THE RESULT IS REQUIRED. BOTH POSITIVE AND 01090038 +C NEGATIVE CONSTANTS ARE INCLUDED. 01100038 +C 01110038 + 5201 CONTINUE 01120038 + IVTNUM = 520 01130038 +C 01140038 +C **** TEST 520 **** 01150038 +C 01160038 + IF (ICZERO) 35200, 5200, 35200 01170038 + 5200 CONTINUE 01180038 + IVCOMP = (24/3)/4 01190038 + GO TO 45200 01200038 +35200 IVDELE = IVDELE + 1 01210038 + WRITE (I02,80003) IVTNUM 01220038 + IF (ICZERO) 45200, 5211, 45200 01230038 +45200 IF (IVCOMP - 2) 25200,15200,25200 01240038 +15200 IVPASS = IVPASS + 1 01250038 + WRITE (I02,80001) IVTNUM 01260038 + GO TO 5211 01270038 +25200 IVFAIL = IVFAIL + 1 01280038 + IVCORR = 2 01290038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01300038 + 5211 CONTINUE 01310038 + IVTNUM = 521 01320038 +C 01330038 +C **** TEST 521 **** 01340038 +C 01350038 + IF (ICZERO) 35210, 5210, 35210 01360038 + 5210 CONTINUE 01370038 + IVCOMP = (7150/2)/25 01380038 + GO TO 45210 01390038 +35210 IVDELE = IVDELE + 1 01400038 + WRITE (I02,80003) IVTNUM 01410038 + IF (ICZERO) 45210, 5221, 45210 01420038 +45210 IF (IVCOMP - 143) 25210,15210,25210 01430038 +15210 IVPASS = IVPASS + 1 01440038 + WRITE (I02,80001) IVTNUM 01450038 + GO TO 5221 01460038 +25210 IVFAIL = IVFAIL + 1 01470038 + IVCORR = 143 01480038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01490038 + 5221 CONTINUE 01500038 + IVTNUM = 522 01510038 +C 01520038 +C **** TEST 522 **** 01530038 +C 01540038 + IF (ICZERO) 35220, 5220, 35220 01550038 + 01560038 + 5220 CONTINUE 01570038 + IVCOMP = (-24/3)/4 01580038 + GO TO 45220 01590038 +35220 IVDELE = IVDELE + 1 01600038 + WRITE (I02,80003) IVTNUM 01610038 + IF (ICZERO) 45220, 5231, 45220 01620038 +45220 IF (IVCOMP + 2) 25220,15220,25220 01630038 +15220 IVPASS = IVPASS + 1 01640038 + WRITE (I02,80001) IVTNUM 01650038 + GO TO 5231 01660038 +25220 IVFAIL = IVFAIL + 1 01670038 + IVCORR = -2 01680038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01690038 + 5231 CONTINUE 01700038 + IVTNUM = 523 01710038 +C 01720038 +C **** TEST 523 **** 01730038 +C 01740038 + IF (ICZERO) 35230, 5230, 35230 01750038 + 5230 CONTINUE 01760038 + IVCOMP = (330/(-3))/2 01770038 + GO TO 45230 01780038 +35230 IVDELE = IVDELE + 1 01790038 + WRITE (I02,80003) IVTNUM 01800038 + IF (ICZERO) 45230, 5241, 45230 01810038 +45230 IF (IVCOMP + 55) 25230,15230,25230 01820038 +15230 IVPASS = IVPASS + 1 01830038 + WRITE (I02,80001) IVTNUM 01840038 + GO TO 5241 01850038 +25230 IVFAIL = IVFAIL + 1 01860038 + IVCORR = -55 01870038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01880038 + 5241 CONTINUE 01890038 + IVTNUM = 524 01900038 +C 01910038 +C **** TEST 524 **** 01920038 +C 01930038 + IF (ICZERO) 35240, 5240, 35240 01940038 + 5240 CONTINUE 01950038 + IVCOMP = ((-7150)/(-2))/(-25) 01960038 + GO TO 45240 01970038 +35240 IVDELE = IVDELE + 1 01980038 + WRITE (I02,80003) IVTNUM 01990038 + IF (ICZERO) 45240, 5251, 45240 02000038 +45240 IF (IVCOMP + 143) 25240,15240,25240 02010038 +15240 IVPASS = IVPASS + 1 02020038 + WRITE (I02,80001) IVTNUM 02030038 + GO TO 5251 02040038 +25240 IVFAIL = IVFAIL + 1 02050038 + IVCORR = -143 02060038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02070038 + 5251 CONTINUE 02080038 + IVTNUM = 525 02090038 +C 02100038 +C **** TEST 525 **** 02110038 +C 02120038 + IF (ICZERO) 35250, 5250, 35250 02130038 + 5250 CONTINUE 02140038 + IVCOMP = (15249/(-13))/(-51) 02150038 + GO TO 45250 02160038 +35250 IVDELE = IVDELE + 1 02170038 + WRITE (I02,80003) IVTNUM 02180038 + IF (ICZERO) 45250, 5261, 45250 02190038 +45250 IF (IVCOMP - 23) 25250,15250,25250 02200038 +15250 IVPASS = IVPASS + 1 02210038 + WRITE (I02,80001) IVTNUM 02220038 + GO TO 5261 02230038 +25250 IVFAIL = IVFAIL + 1 02240038 + IVCORR = 23 02250038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02260038 +C 02270038 +C TEST 526 THROUGH TEST 531 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS02280038 +C OF THE FORM IV = (IC/IC)/IC. 02290038 +C TRUNCATION OF THE RESULT IS REQUIRED. BOTH POSITIVE AND 02300038 +C NEGATIVE CONSTANTS ARE INCLUDED. 02310038 +C 02320038 + 5261 CONTINUE 02330038 + IVTNUM = 526 02340038 +C 02350038 +C **** TEST 526 **** 02360038 +C 02370038 + IF (ICZERO) 35260, 5260, 35260 02380038 + 5260 CONTINUE 02390038 + IVCOMP = (24/3)/3 02400038 + GO TO 45260 02410038 +35260 IVDELE = IVDELE + 1 02420038 + WRITE (I02,80003) IVTNUM 02430038 + IF (ICZERO) 45260, 5271, 45260 02440038 +45260 IF (IVCOMP - 2) 25260,15260,25260 02450038 +15260 IVPASS = IVPASS + 1 02460038 + WRITE (I02,80001) IVTNUM 02470038 + GO TO 5271 02480038 +25260 IVFAIL = IVFAIL + 1 02490038 + IVCORR = 2 02500038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02510038 + 5271 CONTINUE 02520038 + IVTNUM = 527 02530038 +C 02540038 +C **** TEST 527 **** 02550038 +C 02560038 + IF (ICZERO) 35270, 5270, 35270 02570038 + 5270 CONTINUE 02580038 + IVCOMP = (7151/3)/10 02590038 + GO TO 45270 02600038 +35270 IVDELE = IVDELE + 1 02610038 + WRITE (I02,80003) IVTNUM 02620038 + IF (ICZERO) 45270, 5281, 45270 02630038 +45270 IF (IVCOMP - 238) 25270,15270,25270 02640038 +15270 IVPASS = IVPASS + 1 02650038 + WRITE (I02,80001) IVTNUM 02660038 + GO TO 5281 02670038 +25270 IVFAIL = IVFAIL + 1 02680038 + IVCORR = 238 02690038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02700038 + 5281 CONTINUE 02710038 + IVTNUM = 528 02720038 +C 02730038 +C **** TEST 528 **** 02740038 +C 02750038 + IF (ICZERO) 35280, 5280, 35280 02760038 + 5280 CONTINUE 02770038 + IVCOMP = (-24/3)/3 02780038 + GO TO 45280 02790038 +35280 IVDELE = IVDELE + 1 02800038 + WRITE (I02,80003) IVTNUM 02810038 + IF (ICZERO) 45280, 5291, 45280 02820038 +45280 IF (IVCOMP + 2) 25280,15280,25280 02830038 +15280 IVPASS = IVPASS + 1 02840038 + WRITE (I02,80001) IVTNUM 02850038 + GO TO 5291 02860038 +25280 IVFAIL = IVFAIL + 1 02870038 + IVCORR = -2 02880038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02890038 + 5291 CONTINUE 02900038 + IVTNUM = 529 02910038 +C 02920038 +C **** TEST 529 **** 02930038 +C 02940038 + IF (ICZERO) 35290, 5290, 35290 02950038 + 5290 CONTINUE 02960038 + IVCOMP = (7151/(-3))/10 02970038 + GO TO 45290 02980038 +35290 IVDELE = IVDELE + 1 02990038 + WRITE (I02,80003) IVTNUM 03000038 + IF (ICZERO) 45290, 5301, 45290 03010038 +45290 IF (IVCOMP + 238) 25290,15290,25290 03020038 +15290 IVPASS = IVPASS + 1 03030038 + WRITE (I02,80001) IVTNUM 03040038 + GO TO 5301 03050038 +25290 IVFAIL = IVFAIL + 1 03060038 + IVCORR = -238 03070038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03080038 + 5301 CONTINUE 03090038 + IVTNUM = 530 03100038 +C 03110038 +C **** TEST 530 **** 03120038 +C 03130038 + IF (ICZERO) 35300, 5300, 35300 03140038 + 5300 CONTINUE 03150038 + IVCOMP = (15248/(-51))/(-23) 03160038 + GO TO 45300 03170038 +35300 IVDELE = IVDELE + 1 03180038 + WRITE (I02,80003) IVTNUM 03190038 + IF (ICZERO) 45300, 5311, 45300 03200038 +45300 IF (IVCOMP - 12) 25300,15300,25300 03210038 +15300 IVPASS = IVPASS + 1 03220038 + WRITE (I02,80001) IVTNUM 03230038 + GO TO 5311 03240038 +25300 IVFAIL = IVFAIL + 1 03250038 + IVCORR = 12 03260038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03270038 + 5311 CONTINUE 03280038 + IVTNUM = 531 03290038 +C 03300038 +C **** TEST 531 **** 03310038 +C 03320038 + IF (ICZERO) 35310, 5310, 35310 03330038 + 5310 CONTINUE 03340038 + IVCOMP = ((-27342)/(-4))/(-3) 03350038 + GO TO 45310 03360038 +35310 IVDELE = IVDELE + 1 03370038 + WRITE (I02,80003) IVTNUM 03380038 + IF (ICZERO) 45310, 5321, 45310 03390038 +45310 IF (IVCOMP + 2278) 25310,15310,25310 03400038 +15310 IVPASS = IVPASS + 1 03410038 + WRITE (I02,80001) IVTNUM 03420038 + GO TO 5321 03430038 +25310 IVFAIL = IVFAIL + 1 03440038 + IVCORR = -2278 03450038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03460038 +C 03470038 +C TEST 532 THROUGH TEST 537 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS03480038 +C OF THE FORM IV = IC/(IC/IC). 03490038 +C NO TRUNCATION OF THE RESULT IS REQUIRED. BOTH POSITIVE AND 03500038 +C NEGATIVE CONSTANTS ARE INCLUDED. 03510038 +C 03520038 + 5321 CONTINUE 03530038 + IVTNUM = 532 03540038 +C 03550038 +C **** TEST 532 **** 03560038 +C 03570038 + IF (ICZERO) 35320, 5320, 35320 03580038 + 5320 CONTINUE 03590038 + IVCOMP = 24/(8/4) 03600038 + GO TO 45320 03610038 +35320 IVDELE = IVDELE + 1 03620038 + WRITE (I02,80003) IVTNUM 03630038 + IF (ICZERO) 45320, 5331, 45320 03640038 +45320 IF (IVCOMP - 12) 25320,15320,25320 03650038 +15320 IVPASS = IVPASS + 1 03660038 + WRITE (I02,80001) IVTNUM 03670038 + GO TO 5331 03680038 +25320 IVFAIL = IVFAIL + 1 03690038 + IVCORR = 12 03700038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03710038 + 5331 CONTINUE 03720038 + IVTNUM = 533 03730038 +C 03740038 +C **** TEST 533 **** 03750038 +C 03760038 + IF (ICZERO) 35330, 5330, 35330 03770038 + 5330 CONTINUE 03780038 + IVCOMP = 7150/(25/5) 03790038 + GO TO 45330 03800038 +35330 IVDELE = IVDELE + 1 03810038 + WRITE (I02,80003) IVTNUM 03820038 + IF (ICZERO) 45330, 5341, 45330 03830038 +45330 IF (IVCOMP - 1430) 25330,15330,25330 03840038 +15330 IVPASS = IVPASS + 1 03850038 + WRITE (I02,80001) IVTNUM 03860038 + GO TO 5341 03870038 +25330 IVFAIL = IVFAIL + 1 03880038 + IVCORR = 1430 03890038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03900038 + 5341 CONTINUE 03910038 + IVTNUM = 534 03920038 +C 03930038 +C **** TEST 534 **** 03940038 +C 03950038 + IF (ICZERO) 35340, 5340, 35340 03960038 + 5340 CONTINUE 03970038 + IVCOMP = -24/(8/4) 03980038 + GO TO 45340 03990038 +35340 IVDELE = IVDELE + 1 04000038 + WRITE (I02,80003) IVTNUM 04010038 + IF (ICZERO) 45340, 5351, 45340 04020038 +45340 IF (IVCOMP + 12) 25340,15340,25340 04030038 +15340 IVPASS = IVPASS + 1 04040038 + WRITE (I02,80001) IVTNUM 04050038 + GO TO 5351 04060038 +25340 IVFAIL = IVFAIL + 1 04070038 + IVCORR = -12 04080038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04090038 + 5351 CONTINUE 04100038 + IVTNUM = 535 04110038 +C 04120038 +C **** TEST 535 **** 04130038 +C 04140038 + IF (ICZERO) 35350, 5350, 35350 04150038 + 5350 CONTINUE 04160038 + IVCOMP = 24/((-8)/4) 04170038 + GO TO 45350 04180038 +35350 IVDELE = IVDELE + 1 04190038 + WRITE (I02,80003) IVTNUM 04200038 + IF (ICZERO) 45350, 5361, 45350 04210038 +45350 IF (IVCOMP + 12) 25350,15350,25350 04220038 +15350 IVPASS = IVPASS + 1 04230038 + WRITE (I02,80001) IVTNUM 04240038 + GO TO 5361 04250038 +25350 IVFAIL = IVFAIL + 1 04260038 + IVCORR = -12 04270038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04280038 + 5361 CONTINUE 04290038 + IVTNUM = 536 04300038 +C 04310038 +C **** TEST 536 **** 04320038 +C 04330038 + IF (ICZERO) 35360, 5360, 35360 04340038 + 5360 CONTINUE 04350038 + IVCOMP = (-7150)/((-25)/(-5)) 04360038 + GO TO 45360 04370038 +35360 IVDELE = IVDELE + 1 04380038 + WRITE (I02,80003) IVTNUM 04390038 + IF (ICZERO) 45360, 5371, 45360 04400038 +45360 IF (IVCOMP + 1430) 25360,15360,25360 04410038 +15360 IVPASS = IVPASS + 1 04420038 + WRITE (I02,80001) IVTNUM 04430038 + GO TO 5371 04440038 +25360 IVFAIL = IVFAIL + 1 04450038 + IVCORR = -1430 04460038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04470038 + 5371 CONTINUE 04480038 + IVTNUM = 537 04490038 +C 04500038 +C **** TEST 537 **** 04510038 +C 04520038 + IF (ICZERO) 35370, 5370, 35370 04530038 + 5370 CONTINUE 04540038 + IVCOMP = -7150/(25/(-5)) 04550038 + GO TO 45370 04560038 +35370 IVDELE = IVDELE + 1 04570038 + WRITE (I02,80003) IVTNUM 04580038 + IF (ICZERO) 45370, 5381, 45370 04590038 +45370 IF (IVCOMP - 1430) 25370,15370,25370 04600038 +15370 IVPASS = IVPASS + 1 04610038 + WRITE (I02,80001) IVTNUM 04620038 + GO TO 5381 04630038 +25370 IVFAIL = IVFAIL + 1 04640038 + IVCORR = 1430 04650038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04660038 +C 04670038 +C TEST 538 THROUGH TEST 543 CONTAIN ARITHMETIC ASSIGMMENT STATEMENTS04680038 +C OF THE FORM IV = IC/(IC/IC). 04690038 +C TRUNCATION OF THE RESULT IS REQUIRED. BOTH POSITIVE AND 04700038 +C NEGATIVE CONSTANTS ARE INCLUDED. 04710038 +C 04720038 + 5381 CONTINUE 04730038 + IVTNUM = 538 04740038 +C 04750038 +C **** TEST 538 **** 04760038 +C 04770038 + IF (ICZERO) 35380, 5380, 35380 04780038 + 5380 CONTINUE 04790038 + IVCOMP = 29/(5/2) 04800038 + GO TO 45380 04810038 +35380 IVDELE = IVDELE + 1 04820038 + WRITE (I02,80003) IVTNUM 04830038 + IF (ICZERO) 45380, 5391, 45380 04840038 +45380 IF (IVCOMP - 14) 25380,15380,25380 04850038 +15380 IVPASS = IVPASS + 1 04860038 + WRITE (I02,80001) IVTNUM 04870038 + GO TO 5391 04880038 +25380 IVFAIL = IVFAIL + 1 04890038 + IVCORR = 14 04900038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04910038 + 5391 CONTINUE 04920038 + IVTNUM = 539 04930038 +C 04940038 +C **** TEST 539 **** 04950038 +C 04960038 + IF (ICZERO) 35390, 5390, 35390 04970038 + 5390 CONTINUE 04980038 + IVCOMP = 7154/(26/5) 04990038 + GO TO 45390 05000038 +35390 IVDELE = IVDELE + 1 05010038 + WRITE (I02,80003) IVTNUM 05020038 + IF (ICZERO) 45390, 5401, 45390 05030038 +45390 IF (IVCOMP - 1430) 25390,15390,25390 05040038 +15390 IVPASS = IVPASS + 1 05050038 + WRITE (I02,80001) IVTNUM 05060038 + GO TO 5401 05070038 +25390 IVFAIL = IVFAIL + 1 05080038 + IVCORR = 1430 05090038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05100038 + 5401 CONTINUE 05110038 + IVTNUM = 540 05120038 +C 05130038 +C **** TEST 540 **** 05140038 +C 05150038 + IF (ICZERO) 35400, 5400, 35400 05160038 + 5400 CONTINUE 05170038 + IVCOMP = -7154/(26/5) 05180038 + GO TO 45400 05190038 +35400 IVDELE = IVDELE + 1 05200038 + WRITE (I02,80003) IVTNUM 05210038 + IF (ICZERO) 45400, 5411, 45400 05220038 +45400 IF (IVCOMP + 1430) 25400,15400,25400 05230038 +15400 IVPASS = IVPASS + 1 05240038 + WRITE (I02,80001) IVTNUM 05250038 + GO TO 5411 05260038 +25400 IVFAIL = IVFAIL + 1 05270038 + IVCORR = -1430 05280038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05290038 + 5411 CONTINUE 05300038 + IVTNUM = 541 05310038 +C 05320038 +C **** TEST 541 **** 05330038 +C 05340038 + IF (ICZERO) 35410, 5410, 35410 05350038 + 5410 CONTINUE 05360038 + IVCOMP = (-7154)/((-26)/5) 05370038 + GO TO 45410 05380038 +35410 IVDELE = IVDELE + 1 05390038 + WRITE (I02,80003) IVTNUM 05400038 + IF (ICZERO) 45410, 5421, 45410 05410038 +45410 IF (IVCOMP - 1430) 25410,15410,25410 05420038 +15410 IVPASS = IVPASS + 1 05430038 + WRITE (I02,80001) IVTNUM 05440038 + GO TO 5421 05450038 +25410 IVFAIL = IVFAIL + 1 05460038 + IVCORR = 1430 05470038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05480038 + 5421 CONTINUE 05490038 + IVTNUM = 542 05500038 +C 05510038 +C **** TEST 542 **** 05520038 +C 05530038 + IF (ICZERO) 35420, 5420, 35420 05540038 + 5420 CONTINUE 05550038 + IVCOMP = 7154/((-26)/(-5)) 05560038 + GO TO 45420 05570038 +35420 IVDELE = IVDELE + 1 05580038 + WRITE (I02,80003) IVTNUM 05590038 + IF (ICZERO) 45420, 5431, 45420 05600038 +45420 IF (IVCOMP - 1430) 25420,15420,25420 05610038 +15420 IVPASS = IVPASS + 1 05620038 + WRITE (I02,80001) IVTNUM 05630038 + GO TO 5431 05640038 +25420 IVFAIL = IVFAIL + 1 05650038 + IVCORR = 1430 05660038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05670038 + 5431 CONTINUE 05680038 + IVTNUM = 543 05690038 +C 05700038 +C **** TEST 543 **** 05710038 +C 05720038 + IF (ICZERO) 35430, 5430, 35430 05730038 + 5430 CONTINUE 05740038 + IVCOMP = (-7154)/((-26)/(-5)) 05750038 + GO TO 45430 05760038 +35430 IVDELE = IVDELE + 1 05770038 + WRITE (I02,80003) IVTNUM 05780038 + IF (ICZERO) 45430, 5441, 45430 05790038 +45430 IF (IVCOMP + 1430) 25430,15430,25430 05800038 +15430 IVPASS = IVPASS + 1 05810038 + WRITE (I02,80001) IVTNUM 05820038 + GO TO 5441 05830038 +25430 IVFAIL = IVFAIL + 1 05840038 + IVCORR = -1430 05850038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05860038 +C 05870038 +C TEST 544 THROUGH TEST 547 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS05880038 +C OF THE FORM INTEGER VARIABLE = INTEGER VARIABLE/INTEGER CONSTANT05890038 +C 05900038 + 5441 CONTINUE 05910038 + IVTNUM = 544 05920038 +C 05930038 +C **** TEST 544 **** 05940038 +C 05950038 + IF (ICZERO) 35440, 5440, 35440 05960038 + 5440 CONTINUE 05970038 + IVON01 = 75 05980038 + IVCOMP = IVON01/25 05990038 + GO TO 45440 06000038 +35440 IVDELE = IVDELE + 1 06010038 + WRITE (I02,80003) IVTNUM 06020038 + IF (ICZERO) 45440, 5451, 45440 06030038 +45440 IF (IVCOMP - 3) 25440,15440,25440 06040038 +15440 IVPASS = IVPASS + 1 06050038 + WRITE (I02,80001) IVTNUM 06060038 + GO TO 5451 06070038 +25440 IVFAIL = IVFAIL + 1 06080038 + IVCORR = 3 06090038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06100038 + 5451 CONTINUE 06110038 + IVTNUM = 545 06120038 +C 06130038 +C **** TEST 545 **** 06140038 +C 06150038 + IF (ICZERO) 35450, 5450, 35450 06160038 + 5450 CONTINUE 06170038 + IVON01 = -3575 06180038 + IVCOMP = IVON01/25 06190038 + GO TO 45450 06200038 +35450 IVDELE = IVDELE + 1 06210038 + WRITE (I02,80003) IVTNUM 06220038 + IF (ICZERO) 45450, 5461, 45450 06230038 +45450 IF (IVCOMP + 143) 25450,15450,25450 06240038 +15450 IVPASS = IVPASS + 1 06250038 + WRITE (I02,80001) IVTNUM 06260038 + GO TO 5461 06270038 +25450 IVFAIL = IVFAIL + 1 06280038 + IVCORR = -143 06290038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06300038 + 5461 CONTINUE 06310038 + IVTNUM = 546 06320038 +C 06330038 +C **** TEST 546 **** 06340038 +C 06350038 + IF (ICZERO) 35460, 5460, 35460 06360038 + 5460 CONTINUE 06370038 + IVON01 = 3575 06380038 + IVCOMP = IVON01/(-143) 06390038 + GO TO 45460 06400038 +35460 IVDELE = IVDELE + 1 06410038 + WRITE (I02,80003) IVTNUM 06420038 + IF (ICZERO) 45460, 5471, 45460 06430038 +45460 IF (IVCOMP + 25) 25460,15460,25460 06440038 +15460 IVPASS = IVPASS + 1 06450038 + WRITE (I02,80001) IVTNUM 06460038 + GO TO 5471 06470038 +25460 IVFAIL = IVFAIL + 1 06480038 + IVCORR = -25 06490038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06500038 + 5471 CONTINUE 06510038 + IVTNUM = 547 06520038 +C 06530038 +C **** TEST 547 **** 06540038 +C 06550038 + IF (ICZERO) 35470, 5470, 35470 06560038 + 5470 CONTINUE 06570038 + IVON01 = 959 06580038 + IVCOMP = IVON01/120 06590038 + GO TO 45470 06600038 +35470 IVDELE = IVDELE + 1 06610038 + WRITE (I02,80003) IVTNUM 06620038 + IF (ICZERO) 45470, 5481, 45470 06630038 +45470 IF (IVCOMP -7) 25470,15470,25470 06640038 +15470 IVPASS = IVPASS + 1 06650038 + WRITE (I02,80001) IVTNUM 06660038 + GO TO 5481 06670038 +25470 IVFAIL = IVFAIL + 1 06680038 + IVCORR = 7 06690038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06700038 +C 06710038 +C TEST 548 THROUGH TEST 551 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS06720038 +C OF THE FORM INTEGER VARIABLE =INTEGER CONSTANT/INTEGER VARIABLE.06730038 +C 06740038 + 5481 CONTINUE 06750038 + IVTNUM = 548 06760038 +C 06770038 +C **** TEST 548 **** 06780038 +C 06790038 + IF (ICZERO) 35480, 5480, 35480 06800038 + 5480 CONTINUE 06810038 + IVON02 = 25 06820038 + IVCOMP = 75/IVON02 06830038 + GO TO 45480 06840038 +35480 IVDELE = IVDELE + 1 06850038 + WRITE (I02,80003) IVTNUM 06860038 + IF (ICZERO) 45480, 5491, 45480 06870038 +45480 IF (IVCOMP - 3) 25480,15480,25480 06880038 +15480 IVPASS = IVPASS + 1 06890038 + WRITE (I02,80001) IVTNUM 06900038 + GO TO 5491 06910038 +25480 IVFAIL = IVFAIL + 1 06920038 + IVCORR = 3 06930038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06940038 + 5491 CONTINUE 06950038 + IVTNUM = 549 06960038 +C 06970038 +C **** TEST 549 **** 06980038 +C 06990038 + IF (ICZERO) 35490, 5490, 35490 07000038 + 5490 CONTINUE 07010038 + IVON02 = -25 07020038 + IVCOMP = 3579/IVON02 07030038 + GO TO 45490 07040038 +35490 IVDELE = IVDELE + 1 07050038 + WRITE (I02,80003) IVTNUM 07060038 + IF (ICZERO) 45490, 5501, 45490 07070038 +45490 IF (IVCOMP + 143) 25490,15490,25490 07080038 +15490 IVPASS = IVPASS + 1 07090038 + WRITE (I02,80001) IVTNUM 07100038 + GO TO 5501 07110038 +25490 IVFAIL = IVFAIL + 1 07120038 + IVCORR = -143 07130038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07140038 + 5501 CONTINUE 07150038 + IVTNUM = 550 07160038 +C 07170038 +C **** TEST 550 **** 07180038 +C 07190038 + IF (ICZERO) 35500, 5500, 35500 07200038 + 5500 CONTINUE 07210038 + IVON02 = -143 07220038 + IVCOMP = (-3575)/IVON02 07230038 + GO TO 45500 07240038 +35500 IVDELE = IVDELE + 1 07250038 + WRITE (I02,80003) IVTNUM 07260038 + IF (ICZERO) 45500, 5511, 45500 07270038 +45500 IF (IVCOMP - 25) 25500,15500,25500 07280038 +15500 IVPASS = IVPASS + 1 07290038 + WRITE (I02,80001) IVTNUM 07300038 + GO TO 5511 07310038 +25500 IVFAIL = IVFAIL + 1 07320038 + IVCORR = 25 07330038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07340038 + 5511 CONTINUE 07350038 + IVTNUM = 551 07360038 +C 07370038 +C **** TEST 551 **** 07380038 +C 07390038 + IF (ICZERO) 35510, 5510, 35510 07400038 + 5510 CONTINUE 07410038 + IVON02 = 120 07420038 + IVCOMP = -959/IVON02 07430038 + GO TO 45510 07440038 +35510 IVDELE = IVDELE + 1 07450038 + WRITE (I02,80003) IVTNUM 07460038 + IF (ICZERO) 45510, 5521, 45510 07470038 +45510 IF (IVCOMP + 7) 25510,15510,25510 07480038 +15510 IVPASS = IVPASS + 1 07490038 + WRITE (I02,80001) IVTNUM 07500038 + GO TO 5521 07510038 +25510 IVFAIL = IVFAIL + 1 07520038 + IVCORR = -7 07530038 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07540038 +C **** END OF TESTS **** 07550038 + 5521 CONTINUE 07560038 +C 07570038 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07580038 +99999 CONTINUE 07590038 + WRITE (I02,90002) 07600038 + WRITE (I02,90006) 07610038 + WRITE (I02,90002) 07620038 + WRITE (I02,90002) 07630038 + WRITE (I02,90007) 07640038 + WRITE (I02,90002) 07650038 + WRITE (I02,90008) IVFAIL 07660038 + WRITE (I02,90009) IVPASS 07670038 + WRITE (I02,90010) IVDELE 07680038 +C 07690038 +C 07700038 +C TERMINATE ROUTINE EXECUTION 07710038 + STOP 07720038 +C 07730038 +C FORMAT STATEMENTS FOR PAGE HEADERS 07740038 +90000 FORMAT ("1") 07750038 +90002 FORMAT (" ") 07760038 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07770038 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07780038 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07790038 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07800038 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07810038 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07820038 +C 07830038 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07840038 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07850038 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07860038 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07870038 +C 07880038 +C FORMAT STATEMENTS FOR TEST RESULTS 07890038 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07900038 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07910038 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07920038 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07930038 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07940038 +C 07950038 +90007 FORMAT (" ",20X,"END OF PROGRAM FM038" ) 07960038 + END 07970038 diff --git a/Fortran/UnitTests/fcvs21_f95/FM038.reference_output b/Fortran/UnitTests/fcvs21_f95/FM038.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM038.reference_output @@ -0,0 +1,56 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 520 PASS + 521 PASS + 522 PASS + 523 PASS + 524 PASS + 525 PASS + 526 PASS + 527 PASS + 528 PASS + 529 PASS + 530 PASS + 531 PASS + 532 PASS + 533 PASS + 534 PASS + 535 PASS + 536 PASS + 537 PASS + 538 PASS + 539 PASS + 540 PASS + 541 PASS + 542 PASS + 543 PASS + 544 PASS + 545 PASS + 546 PASS + 547 PASS + 548 PASS + 549 PASS + 550 PASS + 551 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM038 + + 0 ERRORS ENCOUNTERED + 32 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM039.f b/Fortran/UnitTests/fcvs21_f95/FM039.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM039.f @@ -0,0 +1,782 @@ + PROGRAM FM039 + +C COMMENT SECTION 00010039 +C 00020039 +C FM039 00030039 +C 00040039 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050039 +C FORM INTEGER VARIABLE = ARITHMETIC EXPRESSION 00060039 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00070039 +C OPERATOR /, INTEGER CONSTANTS AND AN INTEGER VARIABLE. BOTH 00080039 +C POSITIVE AND NEGATIVE VALUES ARE USED FOR THE INTEGER CONSTANTS 00090039 +C AND THE INTEGER VARIABLE. 00100039 +C 00110039 +C THERE ARE TESTS WHICH REQUIRE NO TRUNCATION OF THE RESULT 00120039 +C AND TESTS WHERE THE RESULT MUST BE TRUNCATED BEFORE BEING STORED 00130039 +C IN THE RESULTANT INTEGER VARIABLE. SOME OF THE TESTS USE PARENS 00140039 +C TO GROUP ELEMENTS IN THE ARITHMETIC EXPRESSION. 00150039 +C 00160039 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00170039 +C (1) INTEGER VARIABLE/INTEGER CONSTANT/INTEGER CONSTANT 00180039 +C INTEGER CONSTANT/INTEGER VARIABLE/INTEGER CONSTANT 00190039 +C INTEGER CONSTANT/INTEGER CONSTANT/INTEGER VARIABLE 00200039 +C (2) SAME AS (1) BUT WITH PARENTHESES TO GROUP ELEMENTS 00210039 +C IN THE ARITHMETIC EXPRESSION. 00220039 +C 00230039 +C REFERENCES 00240039 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00250039 +C X3.9-1978 00260039 +C 00270039 +C SECTION 4.3, INTEGER TYPE 00280039 +C SECTION 4.3.1, INTEGER CONSTANT 00290039 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00300039 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00310039 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00320039 +C 00330039 +C ********************************************************** 00340039 +C 00350039 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00360039 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00370039 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00380039 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00390039 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00400039 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00410039 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00420039 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00430039 +C OF EXECUTING THESE TESTS. 00440039 +C 00450039 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00460039 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00470039 +C 00480039 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00490039 +C 00500039 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00510039 +C SOFTWARE STANDARDS VALIDATION GROUP 00520039 +C BUILDING 225 RM A266 00530039 +C GAITHERSBURG, MD 20899 00540039 +C ********************************************************** 00550039 +C 00560039 +C 00570039 +C 00580039 +C INITIALIZATION SECTION 00590039 +C 00600039 +C INITIALIZE CONSTANTS 00610039 +C ************** 00620039 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00630039 + I01 = 5 00640039 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00650039 + I02 = 6 00660039 +C SYSTEM ENVIRONMENT SECTION 00670039 +C 00680039 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00690039 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700039 +C (UNIT NUMBER FOR CARD READER). 00710039 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00720039 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00730039 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00740039 +C 00750039 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00760039 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00770039 +C (UNIT NUMBER FOR PRINTER). 00780039 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00790039 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00800039 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00810039 +C 00820039 + IVPASS=0 00830039 + IVFAIL=0 00840039 + IVDELE=0 00850039 + ICZERO=0 00860039 +C 00870039 +C WRITE PAGE HEADERS 00880039 + WRITE (I02,90000) 00890039 + WRITE (I02,90001) 00900039 + WRITE (I02,90002) 00910039 + WRITE (I02, 90002) 00920039 + WRITE (I02,90003) 00930039 + WRITE (I02,90002) 00940039 + WRITE (I02,90004) 00950039 + WRITE (I02,90002) 00960039 + WRITE (I02,90011) 00970039 + WRITE (I02,90002) 00980039 + WRITE (I02,90002) 00990039 + WRITE (I02,90005) 01000039 + WRITE (I02,90006) 01010039 + WRITE (I02,90002) 01020039 +C 01030039 +C TEST SECTION 01040039 +C 01050039 +C ARITHMETIC ASSIGNMENT STATEMENT 01060039 +C 01070039 +C TEST 552 THROUGH TEST 557 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS01080039 +C OF THE FORM IV = IV/IC/IC. 01090039 +C 01100039 + 5521 CONTINUE 01110039 + IVTNUM = 552 01120039 +C 01130039 +C **** TEST 552 **** 01140039 +C 01150039 + IF (ICZERO) 35520, 5520, 35520 01160039 + 5520 CONTINUE 01170039 + IVON01 = 24 01180039 + IVCOMP = IVON01/3/4 01190039 + GO TO 45520 01200039 +35520 IVDELE = IVDELE + 1 01210039 + WRITE (I02,80003) IVTNUM 01220039 + IF (ICZERO) 45520, 5531, 45520 01230039 +45520 IF (IVCOMP - 2) 25520,15520,25520 01240039 +15520 IVPASS = IVPASS + 1 01250039 + WRITE (I02,80001) IVTNUM 01260039 + GO TO 5531 01270039 +25520 IVFAIL = IVFAIL + 1 01280039 + IVCORR = 2 01290039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01300039 + 5531 CONTINUE 01310039 + IVTNUM = 553 01320039 +C 01330039 +C **** TEST 553 **** 01340039 +C 01350039 + IF (ICZERO) 35530, 5530, 35530 01360039 + 5530 CONTINUE 01370039 + IVON01 = 7151 01380039 + IVCOMP = IVON01/3/10 01390039 + GO TO 45530 01400039 +35530 IVDELE = IVDELE + 1 01410039 + WRITE (I02,80003) IVTNUM 01420039 + IF (ICZERO) 45530, 5541, 45530 01430039 +45530 IF (IVCOMP - 238) 25530,15530,25530 01440039 +15530 IVPASS = IVPASS + 1 01450039 + WRITE (I02,80001) IVTNUM 01460039 + GO TO 5541 01470039 +25530 IVFAIL = IVFAIL + 1 01480039 + IVCORR = 238 01490039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01500039 + 5541 CONTINUE 01510039 + IVTNUM = 554 01520039 +C 01530039 +C **** TEST 554 **** 01540039 +C 01550039 + IF (ICZERO) 35540, 5540, 35540 01560039 + 5540 CONTINUE 01570039 + IVON01 = -330 01580039 + IVCOMP = IVON01/3/2 01590039 + GO TO 45540 01600039 +35540 IVDELE = IVDELE + 1 01610039 + WRITE (I02,80003) IVTNUM 01620039 + IF (ICZERO) 45540, 5551, 45540 01630039 +45540 IF (IVCOMP + 55) 25540,15540,25540 01640039 +15540 IVPASS = IVPASS + 1 01650039 + WRITE (I02,80001) IVTNUM 01660039 + GO TO 5551 01670039 +25540 IVFAIL = IVFAIL + 1 01680039 + IVCORR = -55 01690039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01700039 + 5551 CONTINUE 01710039 + IVTNUM = 555 01720039 +C 01730039 +C **** TEST 555 **** 01740039 +C 01750039 + IF (ICZERO) 35550, 5550, 35550 01760039 + 5550 CONTINUE 01770039 + IVON01 = 15249 01780039 + IVCOMP = IVON01/(-13)/51 01790039 + GO TO 45550 01800039 +35550 IVDELE = IVDELE + 1 01810039 + WRITE (I02,80003) IVTNUM 01820039 + IF (ICZERO) 45550, 5561, 45550 01830039 +45550 IF (IVCOMP + 23) 25550,15550,25550 01840039 +15550 IVPASS = IVPASS + 1 01850039 + WRITE (I02,80001) IVTNUM 01860039 + GO TO 5561 01870039 +25550 IVFAIL = IVFAIL + 1 01880039 + IVCORR = -23 01890039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01900039 + 5561 CONTINUE 01910039 + IVTNUM = 556 01920039 +C 01930039 +C **** TEST 556 **** 01940039 +C 01950039 + IF (ICZERO) 35560, 5560, 35560 01960039 + 5560 CONTINUE 01970039 + IVON01 = -27342 01980039 + IVCOMP = IVON01/(-4)/(-3) 01990039 + GO TO 45560 02000039 +35560 IVDELE = IVDELE + 1 02010039 + WRITE (I02,80003) IVTNUM 02020039 + IF (ICZERO) 45560, 5571, 45560 02030039 +45560 IF (IVCOMP + 2278) 25560,15560,25560 02040039 +15560 IVPASS = IVPASS + 1 02050039 + WRITE (I02,80001) IVTNUM 02060039 + GO TO 5571 02070039 +25560 IVFAIL = IVFAIL + 1 02080039 + IVCORR = -2278 02090039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02100039 + 5571 CONTINUE 02110039 + IVTNUM = 557 02120039 +C 02130039 +C **** TEST 557 **** 02140039 +C 02150039 + IF (ICZERO) 35570, 5570, 35570 02160039 + 5570 CONTINUE 02170039 + IVON01 = -27342 02180039 + IVCOMP = -IVON01/4/(-3) 02190039 + GO TO 45570 02200039 +35570 IVDELE = IVDELE + 1 02210039 + WRITE (I02,80003) IVTNUM 02220039 + IF (ICZERO) 45570, 5581, 45570 02230039 +45570 IF (IVCOMP + 2278) 25570,15570,25570 02240039 +15570 IVPASS = IVPASS + 1 02250039 + WRITE (I02,80001) IVTNUM 02260039 + GO TO 5581 02270039 +25570 IVFAIL = IVFAIL + 1 02280039 + IVCORR = -2278 02290039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02300039 +C 02310039 +C TEST 558 THROUGH TEST 563 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS02320039 +C OF THE FORM IV=IC/IV/IC. 02330039 +C 02340039 + 5581 CONTINUE 02350039 + IVTNUM = 558 02360039 +C 02370039 +C **** TEST 558 **** 02380039 +C 02390039 + IF (ICZERO) 35580, 5580, 35580 02400039 + 5580 CONTINUE 02410039 + IVON02 = 3 02420039 + IVCOMP = 24/IVON02/4 02430039 + GO TO 45580 02440039 +35580 IVDELE = IVDELE + 1 02450039 + WRITE (I02,80003) IVTNUM 02460039 + IF (ICZERO) 45580, 5591, 45580 02470039 +45580 IF (IVCOMP - 2) 25580,15580,25580 02480039 +15580 IVPASS = IVPASS + 1 02490039 + WRITE (I02,80001) IVTNUM 02500039 + GO TO 5591 02510039 +25580 IVFAIL = IVFAIL + 1 02520039 + IVCORR = 2 02530039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02540039 + 5591 CONTINUE 02550039 + IVTNUM = 559 02560039 +C 02570039 +C **** TEST 559 **** 02580039 +C 02590039 + IF (ICZERO) 35590, 5590, 35590 02600039 + 5590 CONTINUE 02610039 + IVON02 = 3 02620039 + IVCOMP = 7151/IVON02/10 02630039 + GO TO 45590 02640039 +35590 IVDELE = IVDELE + 1 02650039 + WRITE (I02,80003) IVTNUM 02660039 + IF (ICZERO) 45590, 5601, 45590 02670039 +45590 IF (IVCOMP - 238) 25590,15590,25590 02680039 +15590 IVPASS = IVPASS + 1 02690039 + WRITE (I02,80001) IVTNUM 02700039 + GO TO 5601 02710039 +25590 IVFAIL = IVFAIL + 1 02720039 + IVCORR = 238 02730039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02740039 + 5601 CONTINUE 02750039 + IVTNUM = 560 02760039 +C 02770039 +C **** TEST 560 **** 02780039 +C 02790039 + IF (ICZERO) 35600, 5600, 35600 02800039 + 5600 CONTINUE 02810039 + IVON02 = -3 02820039 + IVCOMP = 330/IVON02/2 02830039 + GO TO 45600 02840039 +35600 IVDELE = IVDELE + 1 02850039 + WRITE (I02,80003) IVTNUM 02860039 + IF (ICZERO) 45600, 5611, 45600 02870039 +45600 IF (IVCOMP +55) 25600,15600,25600 02880039 +15600 IVPASS = IVPASS + 1 02890039 + WRITE (I02,80001) IVTNUM 02900039 + GO TO 5611 02910039 +25600 IVFAIL = IVFAIL + 1 02920039 + IVCORR = -55 02930039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02940039 + 5611 CONTINUE 02950039 + IVTNUM = 561 02960039 +C 02970039 +C **** TEST 561 **** 02980039 +C 02990039 + IF (ICZERO) 35610, 5610, 35610 03000039 + 5610 CONTINUE 03010039 + IVON02 = +13 03020039 + IVCOMP = 15249/IVON02/(-51) 03030039 + GO TO 45610 03040039 +35610 IVDELE = IVDELE + 1 03050039 + WRITE (I02,80003) IVTNUM 03060039 + IF (ICZERO) 45610, 5621, 45610 03070039 +45610 IF (IVCOMP + 23) 25610,15610,25610 03080039 +15610 IVPASS = IVPASS + 1 03090039 + WRITE (I02,80001) IVTNUM 03100039 + GO TO 5621 03110039 +25610 IVFAIL = IVFAIL + 1 03120039 + IVCORR = -23 03130039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03140039 + 5621 CONTINUE 03150039 + IVTNUM = 562 03160039 +C 03170039 +C **** TEST 562 **** 03180039 +C 03190039 + IF (ICZERO) 35620, 5620, 35620 03200039 + 5620 CONTINUE 03210039 + IVON02 = -4 03220039 + IVCOMP = (-27342)/IVON02/(-3) 03230039 + GO TO 45620 03240039 +35620 IVDELE = IVDELE + 1 03250039 + WRITE (I02,80003) IVTNUM 03260039 + IF (ICZERO) 45620, 5631, 45620 03270039 +45620 IF (IVCOMP + 2278) 25620,15620,25620 03280039 +15620 IVPASS = IVPASS + 1 03290039 + WRITE (I02,80001) IVTNUM 03300039 + GO TO 5631 03310039 +25620 IVFAIL = IVFAIL + 1 03320039 + IVCORR = -2278 03330039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03340039 + 5631 CONTINUE 03350039 + IVTNUM = 563 03360039 +C 03370039 +C **** TEST 563 **** 03380039 +C 03390039 + IF (ICZERO) 35630, 5630, 35630 03400039 + 5630 CONTINUE 03410039 + IVON02 = -4 03420039 + IVCOMP = -27342/(-IVON02)/(-3) 03430039 + GO TO 45630 03440039 +35630 IVDELE = IVDELE + 1 03450039 + WRITE (I02,80003) IVTNUM 03460039 + IF (ICZERO) 45630, 5641, 45630 03470039 +45630 IF (IVCOMP - 2278) 25630,15630,25630 03480039 +15630 IVPASS = IVPASS + 1 03490039 + WRITE (I02,80001) IVTNUM 03500039 + GO TO 5641 03510039 +25630 IVFAIL = IVFAIL + 1 03520039 + IVCORR = 2278 03530039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03540039 +C 03550039 +C TEST 564 THROUGH TEST 569 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS03560039 +C OF THE FORM IV = IC/IC/IV. 03570039 +C 03580039 + 5641 CONTINUE 03590039 + IVTNUM = 564 03600039 +C 03610039 +C **** TEST 564 **** 03620039 +C 03630039 + IF (ICZERO) 35640, 5640, 35640 03640039 + 5640 CONTINUE 03650039 + IVON03 = 4 03660039 + IVCOMP = 24/3/IVON03 03670039 + GO TO 45640 03680039 +35640 IVDELE = IVDELE + 1 03690039 + WRITE (I02,80003) IVTNUM 03700039 + IF (ICZERO) 45640, 5651, 45640 03710039 +45640 IF (IVCOMP -2) 25640,15640,25640 03720039 +15640 IVPASS = IVPASS + 1 03730039 + WRITE (I02,80001) IVTNUM 03740039 + GO TO 5651 03750039 +25640 IVFAIL = IVFAIL + 1 03760039 + IVCORR = 2 03770039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03780039 + 5651 CONTINUE 03790039 + IVTNUM = 565 03800039 +C 03810039 +C **** TEST 565 **** 03820039 +C 03830039 + IF (ICZERO) 35650, 5650, 35650 03840039 + 5650 CONTINUE 03850039 + IVON03 = 10 03860039 + IVCOMP = 7151/3/IVON03 03870039 + GO TO 45650 03880039 +35650 IVDELE = IVDELE + 1 03890039 + WRITE (I02,80003) IVTNUM 03900039 + IF (ICZERO) 45650, 5661, 45650 03910039 +45650 IF (IVCOMP - 238) 25650,15650,25650 03920039 +15650 IVPASS = IVPASS + 1 03930039 + WRITE (I02,80001) IVTNUM 03940039 + GO TO 5661 03950039 +25650 IVFAIL = IVFAIL + 1 03960039 + IVCORR = 238 03970039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03980039 + 5661 CONTINUE 03990039 + IVTNUM = 566 04000039 +C 04010039 +C **** TEST 566 **** 04020039 +C 04030039 + IF (ICZERO) 35660, 5660, 35660 04040039 + 5660 CONTINUE 04050039 + IVON03 = -2 04060039 + IVCOMP = 330/3/IVON03 04070039 + GO TO 45660 04080039 +35660 IVDELE = IVDELE + 1 04090039 + WRITE (I02,80003) IVTNUM 04100039 + IF (ICZERO) 45660, 5671, 45660 04110039 +45660 IF (IVCOMP + 55) 25660,15660,25660 04120039 +15660 IVPASS = IVPASS + 1 04130039 + WRITE (I02,80001) IVTNUM 04140039 + GO TO 5671 04150039 +25660 IVFAIL = IVFAIL + 1 04160039 + IVCORR = -55 04170039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04180039 + 5671 CONTINUE 04190039 + IVTNUM = 567 04200039 +C 04210039 +C **** TEST 567 **** 04220039 +C 04230039 + IF (ICZERO) 35670, 5670, 35670 04240039 + 5670 CONTINUE 04250039 + IVON03 = +51 04260039 + IVCOMP = 15249/(-13)/IVON03 04270039 + GO TO 45670 04280039 +35670 IVDELE = IVDELE + 1 04290039 + WRITE (I02,80003) IVTNUM 04300039 + IF (ICZERO) 45670, 5681, 45670 04310039 +45670 IF (IVCOMP + 23) 25670,15670,25670 04320039 +15670 IVPASS = IVPASS + 1 04330039 + WRITE (I02,80001) IVTNUM 04340039 + GO TO 5681 04350039 +25670 IVFAIL = IVFAIL + 1 04360039 + IVCORR = -23 04370039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04380039 + 5681 CONTINUE 04390039 + IVTNUM = 568 04400039 +C 04410039 +C **** TEST 568 **** 04420039 +C 04430039 + IF (ICZERO) 35680, 5680, 35680 04440039 + 5680 CONTINUE 04450039 + IVON03 = -3 04460039 + IVCOMP = (-27342)/(-4)/IVON03 04470039 + GO TO 45680 04480039 +35680 IVDELE = IVDELE + 1 04490039 + WRITE (I02,80003) IVTNUM 04500039 + IF (ICZERO) 45680, 5691, 45680 04510039 +45680 IF (IVCOMP + 2278) 25680,15680,25680 04520039 +15680 IVPASS = IVPASS + 1 04530039 + WRITE (I02,80001) IVTNUM 04540039 + GO TO 5691 04550039 +25680 IVFAIL = IVFAIL + 1 04560039 + IVCORR = -2278 04570039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04580039 + 5691 CONTINUE 04590039 + IVTNUM = 569 04600039 +C 04610039 +C **** TEST 569 **** 04620039 +C 04630039 + IF (ICZERO) 35690, 5690, 35690 04640039 + 5690 CONTINUE 04650039 + IVON03 = -3 04660039 + IVCOMP = -27342/(-4)/(-IVON03) 04670039 + GO TO 45690 04680039 +35690 IVDELE = IVDELE + 1 04690039 + WRITE (I02,80003) IVTNUM 04700039 + IF (ICZERO) 45690, 5701, 45690 04710039 +45690 IF (IVCOMP - 2278) 25690,15690,25690 04720039 +15690 IVPASS = IVPASS + 1 04730039 + WRITE (I02,80001) IVTNUM 04740039 + GO TO 5701 04750039 +25690 IVFAIL = IVFAIL + 1 04760039 + IVCORR = 2278 04770039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04780039 +C 04790039 +C TEST 570 AND TEST 571 - IV =(IV/IC)/IC 04800039 +C 04810039 + 5701 CONTINUE 04820039 + IVTNUM = 570 04830039 +C 04840039 +C **** TEST 570 **** 04850039 +C 04860039 + IF (ICZERO) 35700, 5700, 35700 04870039 + 5700 CONTINUE 04880039 + IVON01 = 24 04890039 + IVCOMP = (IVON01/3)/4 04900039 + GO TO 45700 04910039 +35700 IVDELE = IVDELE + 1 04920039 + WRITE (I02,80003) IVTNUM 04930039 + IF (ICZERO) 45700, 5711, 45700 04940039 +45700 IF (IVCOMP -2) 25700,15700,25700 04950039 +15700 IVPASS = IVPASS + 1 04960039 + WRITE (I02,80001) IVTNUM 04970039 + GO TO 5711 04980039 +25700 IVFAIL = IVFAIL + 1 04990039 + IVCORR = 2 05000039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05010039 + 5711 CONTINUE 05020039 + IVTNUM = 571 05030039 +C 05040039 +C **** TEST 571 **** 05050039 +C 05060039 + IF (ICZERO) 35710, 5710, 35710 05070039 + 5710 CONTINUE 05080039 + IVON01 = -330 05090039 + IVCOMP = (IVON01/(-3))/4 05100039 + GO TO 45710 05110039 +35710 IVDELE = IVDELE + 1 05120039 + WRITE (I02,80003) IVTNUM 05130039 + IF (ICZERO) 45710, 5721, 45710 05140039 +45710 IF (IVCOMP - 27) 25710,15710,25710 05150039 +15710 IVPASS = IVPASS + 1 05160039 + WRITE (I02,80001) IVTNUM 05170039 + GO TO 5721 05180039 +25710 IVFAIL = IVFAIL + 1 05190039 + IVCORR = 27 05200039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05210039 +C 05220039 +C TEST 572 AND TEST 573 - IV= IV/(IC/IC) 05230039 +C 05240039 + 5721 CONTINUE 05250039 + IVTNUM = 572 05260039 +C 05270039 +C **** TEST 572 **** 05280039 +C 05290039 + IF (ICZERO) 35720, 5720, 35720 05300039 + 5720 CONTINUE 05310039 + IVON01 = 24 05320039 + IVCOMP = IVON01/(8/4) 05330039 + GO TO 45720 05340039 +35720 IVDELE = IVDELE + 1 05350039 + WRITE (I02,80003) IVTNUM 05360039 + IF (ICZERO) 45720, 5731, 45720 05370039 +45720 IF (IVCOMP - 12) 25720,15720,25720 05380039 +15720 IVPASS = IVPASS + 1 05390039 + WRITE (I02,80001) IVTNUM 05400039 + GO TO 5731 05410039 +25720 IVFAIL = IVFAIL + 1 05420039 + IVCORR = 12 05430039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05440039 + 5731 CONTINUE 05450039 + IVTNUM = 573 05460039 +C 05470039 +C **** TEST 573 **** 05480039 +C 05490039 + IF (ICZERO) 35730, 5730, 35730 05500039 + 5730 CONTINUE 05510039 + IVON01 = -7154 05520039 + IVCOMP = -IVON01/((-26)/5) 05530039 + GO TO 45730 05540039 +35730 IVDELE = IVDELE + 1 05550039 + WRITE (I02,80003) IVTNUM 05560039 + IF (ICZERO) 45730, 5741, 45730 05570039 +45730 IF (IVCOMP + 1430) 25730,15730,25730 05580039 +15730 IVPASS = IVPASS + 1 05590039 + WRITE (I02,80001) IVTNUM 05600039 + GO TO 5741 05610039 +25730 IVFAIL = IVFAIL + 1 05620039 + IVCORR = -1430 05630039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05640039 +C 05650039 +C TEST 574 AND TEST 575 - IV=(IC/IV)/IC 05660039 +C 05670039 + 5741 CONTINUE 05680039 + IVTNUM = 574 05690039 +C 05700039 +C **** TEST 574 **** 05710039 +C 05720039 + IF (ICZERO) 35740, 5740, 35740 05730039 + 5740 CONTINUE 05740039 + IVON02 = 3 05750039 + IVCOMP = (24/IVON02)/4 05760039 + GO TO 45740 05770039 +35740 IVDELE = IVDELE + 1 05780039 + WRITE (I02,80003) IVTNUM 05790039 + IF (ICZERO) 45740, 5751, 45740 05800039 +45740 IF (IVCOMP -2) 25740,15740,25740 05810039 +15740 IVPASS = IVPASS + 1 05820039 + WRITE (I02,80001) IVTNUM 05830039 + GO TO 5751 05840039 +25740 IVFAIL = IVFAIL + 1 05850039 + IVCORR = 2 05860039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05870039 + 5751 CONTINUE 05880039 + IVTNUM = 575 05890039 +C 05900039 +C **** TEST 575 **** 05910039 +C 05920039 + IF (ICZERO) 35750, 5750, 35750 05930039 + 5750 CONTINUE 05940039 + IVON02 = -3 05950039 + IVCOMP = (-330/IVON02)/(-4) 05960039 + GO TO 45750 05970039 +35750 IVDELE = IVDELE + 1 05980039 + WRITE (I02,80003) IVTNUM 05990039 + IF (ICZERO) 45750, 5761, 45750 06000039 +45750 IF (IVCOMP + 27) 25750,15750,25750 06010039 +15750 IVPASS = IVPASS + 1 06020039 + WRITE (I02,80001) IVTNUM 06030039 + GO TO 5761 06040039 +25750 IVFAIL = IVFAIL + 1 06050039 + IVCORR = -27 06060039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06070039 +C 06080039 +C TEST 576 AND TEST 577 - IV=IC/(IV/IC) 06090039 +C 06100039 + 5761 CONTINUE 06110039 + IVTNUM = 576 06120039 +C 06130039 +C **** TEST 576 **** 06140039 +C 06150039 + IF (ICZERO) 35760, 5760, 35760 06160039 + 5760 CONTINUE 06170039 + IVON02 = 8 06180039 + IVCOMP = 24/(IVON02/4) 06190039 + GO TO 45760 06200039 +35760 IVDELE = IVDELE + 1 06210039 + WRITE (I02,80003) IVTNUM 06220039 + IF (ICZERO) 45760, 5771, 45760 06230039 +45760 IF (IVCOMP - 12) 25760,15760,25760 06240039 +15760 IVPASS = IVPASS + 1 06250039 + WRITE (I02,80001) IVTNUM 06260039 + GO TO 5771 06270039 +25760 IVFAIL = IVFAIL + 1 06280039 + IVCORR = 12 06290039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06300039 + 5771 CONTINUE 06310039 + IVTNUM = 577 06320039 +C 06330039 +C **** TEST 577 **** 06340039 +C 06350039 + IF (ICZERO) 35770, 5770, 35770 06360039 + 5770 CONTINUE 06370039 + IVON02 = -26 06380039 + IVCOMP = 7154/((-IVON02)/(-5)) 06390039 + GO TO 45770 06400039 +35770 IVDELE = IVDELE + 1 06410039 + WRITE (I02,80003) IVTNUM 06420039 + IF (ICZERO) 45770, 5781, 45770 06430039 +45770 IF (IVCOMP + 1430) 25770,15770,25770 06440039 +15770 IVPASS = IVPASS + 1 06450039 + WRITE (I02,80001) IVTNUM 06460039 + GO TO 5781 06470039 +25770 IVFAIL = IVFAIL + 1 06480039 + IVCORR = -1430 06490039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06500039 +C 06510039 +C TEST 578 AND TEST 579 - IV=(IC/IC)/IV 06520039 +C 06530039 + 5781 CONTINUE 06540039 + IVTNUM = 578 06550039 +C 06560039 +C **** TEST 578 **** 06570039 +C 06580039 + IF (ICZERO) 35780, 5780, 35780 06590039 + 5780 CONTINUE 06600039 + IVON03 = 4 06610039 + IVCOMP = (24/3)/IVON03 06620039 + GO TO 45780 06630039 +35780 IVDELE = IVDELE + 1 06640039 + WRITE (I02,80003) IVTNUM 06650039 + IF (ICZERO) 45780, 5791, 45780 06660039 +45780 IF (IVCOMP - 2) 25780,15780,25780 06670039 +15780 IVPASS = IVPASS + 1 06680039 + WRITE (I02,80001) IVTNUM 06690039 + GO TO 5791 06700039 +25780 IVFAIL = IVFAIL + 1 06710039 + IVCORR = 2 06720039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06730039 + 5791 CONTINUE 06740039 + IVTNUM = 579 06750039 +C 06760039 +C **** TEST 579 **** 06770039 +C 06780039 + IF (ICZERO) 35790, 5790, 35790 06790039 + 5790 CONTINUE 06800039 + IVON03 = -4 06810039 + IVCOMP = (330/(-3))/IVON03 06820039 + GO TO 45790 06830039 +35790 IVDELE = IVDELE + 1 06840039 + WRITE (I02,80003) IVTNUM 06850039 + IF (ICZERO) 45790, 5801, 45790 06860039 +45790 IF (IVCOMP - 27) 25790,15790,25790 06870039 +15790 IVPASS = IVPASS + 1 06880039 + WRITE (I02,80001) IVTNUM 06890039 + GO TO 5801 06900039 +25790 IVFAIL = IVFAIL + 1 06910039 + IVCORR = 27 06920039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06930039 +C 06940039 +C TEST 580 AND TEST 581 - IV= IC/(IC/IV) 06950039 +C 06960039 + 5801 CONTINUE 06970039 + IVTNUM = 580 06980039 +C 06990039 +C **** TEST 580 **** 07000039 +C 07010039 + IF (ICZERO) 35800, 5800, 35800 07020039 + 5800 CONTINUE 07030039 + IVON03 = 4 07040039 + IVCOMP = 24/(8/IVON03) 07050039 + GO TO 45800 07060039 +35800 IVDELE = IVDELE + 1 07070039 + WRITE (I02,80003) IVTNUM 07080039 + IF (ICZERO) 45800, 5811, 45800 07090039 +45800 IF (IVCOMP - 12) 25800,15800,25800 07100039 +15800 IVPASS = IVPASS + 1 07110039 + WRITE (I02,80001) IVTNUM 07120039 + GO TO 5811 07130039 +25800 IVFAIL = IVFAIL + 1 07140039 + IVCORR = 12 07150039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07160039 + 5811 CONTINUE 07170039 + IVTNUM = 581 07180039 +C 07190039 +C **** TEST 581 **** 07200039 +C 07210039 + IF (ICZERO) 35810, 5810, 35810 07220039 + 5810 CONTINUE 07230039 + IVON03 = -5 07240039 + IVCOMP = -7154/((-26)/IVON03) 07250039 + GO TO 45810 07260039 +35810 IVDELE = IVDELE + 1 07270039 + WRITE (I02,80003) IVTNUM 07280039 + IF (ICZERO) 45810, 5821, 45810 07290039 +45810 IF (IVCOMP + 1430) 25810,15810,25810 07300039 +15810 IVPASS = IVPASS + 1 07310039 + WRITE (I02,80001) IVTNUM 07320039 + GO TO 5821 07330039 +25810 IVFAIL = IVFAIL + 1 07340039 + IVCORR = -1430 07350039 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07360039 +C 07370039 +C **** END OF TESTS **** 07380039 + 5821 CONTINUE 07390039 +C 07400039 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07410039 +99999 CONTINUE 07420039 + WRITE (I02,90002) 07430039 + WRITE (I02,90006) 07440039 + WRITE (I02,90002) 07450039 + WRITE (I02,90002) 07460039 + WRITE (I02,90007) 07470039 + WRITE (I02,90002) 07480039 + WRITE (I02,90008) IVFAIL 07490039 + WRITE (I02,90009) IVPASS 07500039 + WRITE (I02,90010) IVDELE 07510039 +C 07520039 +C 07530039 +C TERMINATE ROUTINE EXECUTION 07540039 + STOP 07550039 +C 07560039 +C FORMAT STATEMENTS FOR PAGE HEADERS 07570039 +90000 FORMAT ("1") 07580039 +90002 FORMAT (" ") 07590039 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07600039 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07610039 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07620039 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07630039 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07640039 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07650039 +C 07660039 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07670039 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07680039 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07690039 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07700039 +C 07710039 +C FORMAT STATEMENTS FOR TEST RESULTS 07720039 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07730039 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07740039 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07750039 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07760039 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07770039 +C 07780039 +90007 FORMAT (" ",20X,"END OF PROGRAM FM039" ) 07790039 + END 07800039 diff --git a/Fortran/UnitTests/fcvs21_f95/FM039.reference_output b/Fortran/UnitTests/fcvs21_f95/FM039.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM039.reference_output @@ -0,0 +1,54 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 552 PASS + 553 PASS + 554 PASS + 555 PASS + 556 PASS + 557 PASS + 558 PASS + 559 PASS + 560 PASS + 561 PASS + 562 PASS + 563 PASS + 564 PASS + 565 PASS + 566 PASS + 567 PASS + 568 PASS + 569 PASS + 570 PASS + 571 PASS + 572 PASS + 573 PASS + 574 PASS + 575 PASS + 576 PASS + 577 PASS + 578 PASS + 579 PASS + 580 PASS + 581 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM039 + + 0 ERRORS ENCOUNTERED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM040.f b/Fortran/UnitTests/fcvs21_f95/FM040.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM040.f @@ -0,0 +1,898 @@ + PROGRAM FM040 + +C COMMENT SECTION 00010040 +C 00020040 +C FM040 00030040 +C 00040040 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050040 +C FORM INTEGER VARIABLE = ARITHMETIC EXPRESSION 00060040 +C WHERE THE ARITHMETIC EXPRESSION IS FORMED WITH THE ARITHMETIC 00070040 +C OPERATOR /, INTEGER VARIABLES AND AN INTEGER CONSTANT. BOTH 00080040 +C POSITIVE AND NEGATIVE VALUES ARE USED FOR THE INTEGER VARIABLES 00090040 +C AND THE INTEGER CONSTANT. 00100040 +C 00110040 +C THERE ARE TESTS WHICH REQUIRE NO TRUNCATION OF THE RESULT AND 00120040 +C TESTS WHERE THE RESULT MUST BE TRUNCATED BEFORE BEING STORED IN 00130040 +C THE RESULTANT INTEGER VARIABLE. SOME OF THE TESTS USE PARENS 00140040 +C TO GROUP ELEMENTS IN THE ARITHMETIC EXPRESSION. 00150040 +C 00160040 +C THERE ARE TESTS WHERE THE ARITHMETIC EXPRESSION CONTAINS 00170040 +C (1) INTEGER VARIABLE/INTEGER VARIABLE 00180040 +C (2) INTEGER VARIABLE/INTEGER VARIABLE/INTEGER CONSTANT 00190040 +C INTEGER VARIABLE/INTEGER CONSTANT/INTEGER VARIABLE 00200040 +C INTEGER CONSTANT/INTEGER VARIABLE/INTEGER VARIABLE 00210040 +C (3) SAME AS (2) BUT WITH PARENTHESES TO GROUP ELEMENTS 00220040 +C IN THE ARITHMETIC EXPRESSION. 00230040 +C 00240040 +C REFERENCES 00250040 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260040 +C X3.9-1978 00270040 +C 00280040 +C SECTION 4.3, INTEGER TYPE 00290040 +C SECTION 4.3.1, INTEGER CONSTANT 00300040 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00310040 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00320040 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00330040 +C 00340040 +C ********************************************************** 00350040 +C 00360040 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00370040 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00380040 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00390040 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00400040 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00410040 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00420040 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00430040 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00440040 +C OF EXECUTING THESE TESTS. 00450040 +C 00460040 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00470040 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00480040 +C 00490040 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00500040 +C 00510040 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00520040 +C SOFTWARE STANDARDS VALIDATION GROUP 00530040 +C BUILDING 225 RM A266 00540040 +C GAITHERSBURG, MD 20899 00550040 +C ********************************************************** 00560040 +C 00570040 +C 00580040 +C 00590040 +C INITIALIZATION SECTION 00600040 +C 00610040 +C INITIALIZE CONSTANTS 00620040 +C ************** 00630040 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640040 + I01 = 5 00650040 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660040 + I02 = 6 00670040 +C SYSTEM ENVIRONMENT SECTION 00680040 +C 00690040 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00700040 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710040 +C (UNIT NUMBER FOR CARD READER). 00720040 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00730040 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00740040 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00750040 +C 00760040 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00770040 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00780040 +C (UNIT NUMBER FOR PRINTER). 00790040 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00800040 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00810040 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00820040 +C 00830040 + IVPASS=0 00840040 + IVFAIL=0 00850040 + IVDELE=0 00860040 + ICZERO=0 00870040 +C 00880040 +C WRITE PAGE HEADERS 00890040 + WRITE (I02,90000) 00900040 + WRITE (I02,90001) 00910040 + WRITE (I02,90002) 00920040 + WRITE (I02, 90002) 00930040 + WRITE (I02,90003) 00940040 + WRITE (I02,90002) 00950040 + WRITE (I02,90004) 00960040 + WRITE (I02,90002) 00970040 + WRITE (I02,90011) 00980040 + WRITE (I02,90002) 00990040 + WRITE (I02,90002) 01000040 + WRITE (I02,90005) 01010040 + WRITE (I02,90006) 01020040 + WRITE (I02,90002) 01030040 +C 01040040 +C TEST SECTION 01050040 +C 01060040 +C ARITHMETIC ASSIGNMENT STATEMENT 01070040 +C 01080040 +C TEST 582 THROUGH TEST 597 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS01090040 +C OF THE FORM INTEGER VARIABLE=INTEGER VARIABLE/INTEGER VAR. 01100040 +C 01110040 +C TEST 582 THROUGH TEST 585 - POSITIVE VALUES 01120040 +C NO TRUNCATION REQUIRED 01130040 +C 01140040 + 5821 CONTINUE 01150040 + IVTNUM = 582 01160040 +C 01170040 +C **** TEST 582 **** 01180040 +C 01190040 + IF (ICZERO) 35820, 5820, 35820 01200040 + 5820 CONTINUE 01210040 + IVON01 = 4 01220040 + IVON02 = 2 01230040 + IVCOMP = IVON01 / IVON02 01240040 + GO TO 45820 01250040 +35820 IVDELE = IVDELE + 1 01260040 + WRITE (I02,80003) IVTNUM 01270040 + IF (ICZERO) 45820, 5831, 45820 01280040 +45820 IF (IVCOMP -2) 25820,15820,25820 01290040 +15820 IVPASS = IVPASS + 1 01300040 + WRITE (I02,80001) IVTNUM 01310040 + GO TO 5831 01320040 +25820 IVFAIL = IVFAIL + 1 01330040 + IVCORR = 2 01340040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01350040 + 5831 CONTINUE 01360040 + IVTNUM = 583 01370040 +C 01380040 +C **** TEST 583 **** 01390040 +C 01400040 + IF (ICZERO) 35830, 5830, 35830 01410040 + 5830 CONTINUE 01420040 + IVON01 = 3575 01430040 + IVON02 = 25 01440040 + IVCOMP = IVON01/IVON02 01450040 + GO TO 45830 01460040 +35830 IVDELE = IVDELE + 1 01470040 + WRITE (I02,80003) IVTNUM 01480040 + IF (ICZERO) 45830, 5841, 45830 01490040 +45830 IF (IVCOMP - 143) 25830,15830,25830 01500040 +15830 IVPASS = IVPASS + 1 01510040 + WRITE (I02,80001) IVTNUM 01520040 + GO TO 5841 01530040 +25830 IVFAIL = IVFAIL + 1 01540040 + IVCORR = 143 01550040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01560040 + 5841 CONTINUE 01570040 + IVTNUM = 584 01580040 +C 01590040 +C **** TEST 584 **** 01600040 +C 01610040 + IF (ICZERO) 35840, 5840, 35840 01620040 + 5840 CONTINUE 01630040 + IVON01 = 6170 01640040 + IVON02 = 1234 01650040 + IVCOMP = IVON01/IVON02 01660040 + GO TO 45840 01670040 +35840 IVDELE = IVDELE + 1 01680040 + WRITE (I02,80003) IVTNUM 01690040 + IF (ICZERO) 45840, 5851, 45840 01700040 +45840 IF (IVCOMP - 5) 25840,15840,25840 01710040 +15840 IVPASS = IVPASS + 1 01720040 + WRITE (I02,80001) IVTNUM 01730040 + GO TO 5851 01740040 +25840 IVFAIL = IVFAIL + 1 01750040 + IVCORR = 5 01760040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01770040 + 5851 CONTINUE 01780040 + IVTNUM = 585 01790040 +C 01800040 +C **** TEST 585 **** 01810040 +C 01820040 + IF (ICZERO) 35850, 5850, 35850 01830040 + 5850 CONTINUE 01840040 + IVON01 = 32767 01850040 + IVON02 = 1 01860040 + IVCOMP = IVON01/IVON02 01870040 + GO TO 45850 01880040 +35850 IVDELE = IVDELE + 1 01890040 + WRITE (I02,80003) IVTNUM 01900040 + IF (ICZERO) 45850, 5861, 45850 01910040 +45850 IF (IVCOMP - 32767) 25850,15850,25850 01920040 +15850 IVPASS = IVPASS + 1 01930040 + WRITE (I02,80001) IVTNUM 01940040 + GO TO 5861 01950040 +25850 IVFAIL = IVFAIL + 1 01960040 + IVCORR = 32767 01970040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01980040 +C 01990040 +C TEST 586 THROUGH TEST 589 - POSITIVE VALUES 02000040 +C TRUNCATION OF RESULT REQUIRED 02010040 +C 02020040 + 5861 CONTINUE 02030040 + IVTNUM = 586 02040040 +C 02050040 +C **** TEST 586 **** 02060040 +C 02070040 + IF (ICZERO) 35860, 5860, 35860 02080040 + 5860 CONTINUE 02090040 + IVON01 = 2 02100040 + IVON02 = 3 02110040 + IVCOMP = IVON01/IVON02 02120040 + GO TO 45860 02130040 +35860 IVDELE = IVDELE + 1 02140040 + WRITE (I02,80003) IVTNUM 02150040 + IF (ICZERO) 45860, 5871, 45860 02160040 +45860 IF (IVCOMP) 25860,15860,25860 02170040 +15860 IVPASS = IVPASS + 1 02180040 + WRITE (I02,80001) IVTNUM 02190040 + GO TO 5871 02200040 +25860 IVFAIL = IVFAIL + 1 02210040 + IVCORR = 0 02220040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02230040 + 5871 CONTINUE 02240040 + IVTNUM = 587 02250040 +C 02260040 +C **** TEST 587 **** 02270040 +C 02280040 + IF (ICZERO) 35870, 5870, 35870 02290040 + 5870 CONTINUE 02300040 + IVON01 = 959 02310040 + IVON02 = 120 02320040 + IVCOMP = IVON01/IVON02 02330040 + GO TO 45870 02340040 +35870 IVDELE = IVDELE + 1 02350040 + WRITE (I02,80003) IVTNUM 02360040 + IF (ICZERO) 45870, 5881, 45870 02370040 +45870 IF (IVCOMP - 7) 25870,15870,25870 02380040 +15870 IVPASS = IVPASS + 1 02390040 + WRITE (I02,80001) IVTNUM 02400040 + GO TO 5881 02410040 +25870 IVFAIL = IVFAIL + 1 02420040 + IVCORR = 7 02430040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02440040 + 5881 CONTINUE 02450040 + IVTNUM = 588 02460040 +C 02470040 +C **** TEST 588 **** 02480040 +C 02490040 + IF (ICZERO) 35880, 5880, 35880 02500040 + 5880 CONTINUE 02510040 + IVON01 = 26606 02520040 + IVON02 = 8 02530040 + IVCOMP = IVON01/IVON02 02540040 + GO TO 45880 02550040 +35880 IVDELE = IVDELE + 1 02560040 + WRITE (I02,80003) IVTNUM 02570040 + IF (ICZERO) 45880, 5891, 45880 02580040 +45880 IF (IVCOMP - 3325) 25880,15880,25880 02590040 +15880 IVPASS = IVPASS + 1 02600040 + WRITE (I02,80001) IVTNUM 02610040 + GO TO 5891 02620040 +25880 IVFAIL = IVFAIL + 1 02630040 + IVCORR = 3325 02640040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02650040 + 5891 CONTINUE 02660040 + IVTNUM = 589 02670040 +C 02680040 +C **** TEST 589 **** 02690040 +C 02700040 + IF (ICZERO) 35890, 5890, 35890 02710040 + 5890 CONTINUE 02720040 + IVON01 = 25603 02730040 + IVON02 = 10354 02740040 + IVCOMP = IVON01/IVON02 02750040 + GO TO 45890 02760040 +35890 IVDELE = IVDELE + 1 02770040 + WRITE (I02,80003) IVTNUM 02780040 + IF (ICZERO) 45890, 5901, 45890 02790040 +45890 IF (IVCOMP - 2) 25890,15890,25890 02800040 +15890 IVPASS = IVPASS + 1 02810040 + WRITE (I02,80001) IVTNUM 02820040 + GO TO 5901 02830040 +25890 IVFAIL = IVFAIL + 1 02840040 + IVCORR = 2 02850040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02860040 +C 02870040 +C TEST 590 THROUGH TEST 593 - NEGATIVE VALUES INCLUDED 02880040 +C NO TRUNCATION REQUIRED 02890040 +C 02900040 + 5901 CONTINUE 02910040 + IVTNUM = 590 02920040 +C 02930040 +C **** TEST 590 **** 02940040 +C 02950040 + IF (ICZERO) 35900, 5900, 35900 02960040 + 5900 CONTINUE 02970040 + IVON01 = 75 02980040 + IVON02 = -25 02990040 + IVCOMP = IVON01/IVON02 03000040 + GO TO 45900 03010040 +35900 IVDELE = IVDELE + 1 03020040 + WRITE (I02,80003) IVTNUM 03030040 + IF (ICZERO) 45900, 5911, 45900 03040040 +45900 IF (IVCOMP + 3) 25900,15900,25900 03050040 +15900 IVPASS = IVPASS + 1 03060040 + WRITE (I02,80001) IVTNUM 03070040 + GO TO 5911 03080040 +25900 IVFAIL = IVFAIL + 1 03090040 + IVCORR = -3 03100040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03110040 + 5911 CONTINUE 03120040 + IVTNUM = 591 03130040 +C 03140040 +C **** TEST 591 **** 03150040 +C 03160040 + IF (ICZERO) 35910, 5910, 35910 03170040 + 5910 CONTINUE 03180040 + IVON01 = -6170 03190040 + IVON02 = -1234 03200040 + IVCOMP = IVON01/IVON02 03210040 + GO TO 45910 03220040 +35910 IVDELE = IVDELE + 1 03230040 + WRITE (I02,80003) IVTNUM 03240040 + IF (ICZERO) 45910, 5921, 45910 03250040 +45910 IF (IVCOMP -5) 25910,15910,25910 03260040 +15910 IVPASS = IVPASS + 1 03270040 + WRITE (I02,80001) IVTNUM 03280040 + GO TO 5921 03290040 +25910 IVFAIL = IVFAIL + 1 03300040 + IVCORR = 5 03310040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03320040 + 5921 CONTINUE 03330040 + IVTNUM = 592 03340040 +C 03350040 +C **** TEST 592 **** 03360040 +C 03370040 + IF (ICZERO) 35920, 5920, 35920 03380040 + 5920 CONTINUE 03390040 + IVON01 = 32766 03400040 + IVON02 = -2 03410040 + IVCOMP =-IVON01/IVON02 03420040 + GO TO 45920 03430040 +35920 IVDELE = IVDELE + 1 03440040 + WRITE (I02,80003) IVTNUM 03450040 + IF (ICZERO) 45920, 5931, 45920 03460040 +45920 IF (IVCOMP - 16383) 25920,15920,25920 03470040 +15920 IVPASS = IVPASS + 1 03480040 + WRITE (I02,80001) IVTNUM 03490040 + GO TO 5931 03500040 +25920 IVFAIL = IVFAIL + 1 03510040 + IVCORR = 16383 03520040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03530040 + 5931 CONTINUE 03540040 + IVTNUM = 593 03550040 +C 03560040 +C **** TEST 593 **** 03570040 +C 03580040 + IF (ICZERO) 35930, 5930, 35930 03590040 + 5930 CONTINUE 03600040 + IVON01 = 4 03610040 + IVON02 = 2 03620040 + IVCOMP = IVON01/(-IVON02) 03630040 + GO TO 45930 03640040 +35930 IVDELE = IVDELE + 1 03650040 + WRITE (I02,80003) IVTNUM 03660040 + IF (ICZERO) 45930, 5941, 45930 03670040 +45930 IF (IVCOMP + 2) 25930,15930,25930 03680040 +15930 IVPASS = IVPASS + 1 03690040 + WRITE (I02,80001) IVTNUM 03700040 + GO TO 5941 03710040 +25930 IVFAIL = IVFAIL + 1 03720040 + IVCORR = -2 03730040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03740040 +C 03750040 +C TEST 594 THROUGH TEST 597 - NEGATIVE VALUES INCLUDED 03760040 +C TRUNCATION OF RESULT REQUIRED 03770040 +C 03780040 + 5941 CONTINUE 03790040 + IVTNUM = 594 03800040 +C 03810040 +C **** TEST 594 **** 03820040 +C 03830040 + IF (ICZERO) 35940, 5940, 35940 03840040 + 5940 CONTINUE 03850040 + IVON01 = -5 03860040 + IVON02 = 2 03870040 + IVCOMP = IVON01/IVON02 03880040 + GO TO 45940 03890040 +35940 IVDELE = IVDELE + 1 03900040 + WRITE (I02,80003) IVTNUM 03910040 + IF (ICZERO) 45940, 5951, 45940 03920040 +45940 IF (IVCOMP + 2) 25940,15940,25940 03930040 +15940 IVPASS = IVPASS + 1 03940040 + WRITE (I02,80001) IVTNUM 03950040 + GO TO 5951 03960040 +25940 IVFAIL = IVFAIL + 1 03970040 + IVCORR = -2 03980040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03990040 + 5951 CONTINUE 04000040 + IVTNUM = 595 04010040 +C 04020040 +C **** TEST 595 **** 04030040 +C 04040040 + IF (ICZERO) 35950, 5950, 35950 04050040 + 5950 CONTINUE 04060040 + IVON01 = -25603 04070040 + IVON02 = -10354 04080040 + IVCOMP = IVON01/IVON02 04090040 + GO TO 45950 04100040 +35950 IVDELE = IVDELE + 1 04110040 + WRITE (I02,80003) IVTNUM 04120040 + IF (ICZERO) 45950, 5961, 45950 04130040 +45950 IF (IVCOMP -2) 25950,15950,25950 04140040 +15950 IVPASS = IVPASS + 1 04150040 + WRITE (I02,80001) IVTNUM 04160040 + GO TO 5961 04170040 +25950 IVFAIL = IVFAIL + 1 04180040 + IVCORR =2 04190040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04200040 + 5961 CONTINUE 04210040 + IVTNUM = 596 04220040 +C 04230040 +C **** TEST 596 **** 04240040 +C 04250040 + IF (ICZERO) 35960, 5960, 35960 04260040 + 5960 CONTINUE 04270040 + IVON01 = 25603 04280040 + IVON02 = 10354 04290040 + IVCOMP = -IVON01/IVON02 04300040 + GO TO 45960 04310040 +35960 IVDELE = IVDELE + 1 04320040 + WRITE (I02,80003) IVTNUM 04330040 + IF (ICZERO) 45960, 5971, 45960 04340040 +45960 IF (IVCOMP +2) 25960,15960,25960 04350040 +15960 IVPASS = IVPASS + 1 04360040 + WRITE (I02,80001) IVTNUM 04370040 + GO TO 5971 04380040 +25960 IVFAIL = IVFAIL + 1 04390040 + IVCORR = -2 04400040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04410040 + 5971 CONTINUE 04420040 + IVTNUM = 597 04430040 +C 04440040 +C **** TEST 597 **** 04450040 +C 04460040 + IF (ICZERO) 35970, 5970, 35970 04470040 + 5970 CONTINUE 04480040 + IVON01 = 25603 04490040 + IVON02 = -2 04500040 + IVCOMP = -(IVON01/IVON02) 04510040 + GO TO 45970 04520040 +35970 IVDELE = IVDELE + 1 04530040 + WRITE (I02,80003) IVTNUM 04540040 + IF (ICZERO) 45970, 5981, 45970 04550040 +45970 IF (IVCOMP - 12801) 25970,15970,25970 04560040 +15970 IVPASS = IVPASS + 1 04570040 + WRITE (I02,80001) IVTNUM 04580040 + GO TO 5981 04590040 +25970 IVFAIL = IVFAIL + 1 04600040 + IVCORR = 12801 04610040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04620040 +C 04630040 +C TEST 598 THROUGH TEST 614 CONTAIN TWO INTEGER VARIABLES, AN 04640040 +C INTEGER CONSTANT AND OPERATOR / IN AN ARITHMETIC EXPRESSION. 04650040 +C 04660040 +C TEST 598 THROUGH TEST 603 - NO PARENS TO GROUP ELEMENTS BUT 04670040 +C THERE ARE PARENS SURROUNDING NEGATIVE CONSTANTS 04680040 +C 04690040 +C TEST 598 AND TEST 599 - IV = IV/IV/IC. 04700040 +C 04710040 + 5981 CONTINUE 04720040 + IVTNUM = 598 04730040 +C 04740040 +C **** TEST 598 **** 04750040 +C 04760040 + IF (ICZERO) 35980, 5980, 35980 04770040 + 5980 CONTINUE 04780040 + IVON01 = 32766 04790040 + IVON02 = 2 04800040 + IVCOMP = IVON01/IVON02/3 04810040 + GO TO 45980 04820040 +35980 IVDELE = IVDELE + 1 04830040 + WRITE (I02,80003) IVTNUM 04840040 + IF (ICZERO) 45980, 5991, 45980 04850040 +45980 IF (IVCOMP - 5461) 25980,15980,25980 04860040 +15980 IVPASS = IVPASS + 1 04870040 + WRITE (I02,80001) IVTNUM 04880040 + GO TO 5991 04890040 +25980 IVFAIL = IVFAIL + 1 04900040 + IVCORR = 5461 04910040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04920040 + 5991 CONTINUE 04930040 + IVTNUM = 599 04940040 +C 04950040 +C **** TEST 599 **** 04960040 +C 04970040 + IF (ICZERO) 35990, 5990, 35990 04980040 + 5990 CONTINUE 04990040 + IVON01 = 7151 05000040 + IVON02 = 3 05010040 + IVCOMP = IVON01/IVON02/10 05020040 + GO TO 45990 05030040 +35990 IVDELE = IVDELE + 1 05040040 + WRITE (I02,80003) IVTNUM 05050040 + IF (ICZERO) 45990, 6001, 45990 05060040 +45990 IF (IVCOMP -238) 25990,15990,25990 05070040 +15990 IVPASS = IVPASS + 1 05080040 + WRITE (I02,80001) IVTNUM 05090040 + GO TO 6001 05100040 +25990 IVFAIL = IVFAIL + 1 05110040 + IVCORR = 238 05120040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05130040 +C 05140040 +C TEST 600 AND TEST 601 - IV= IV/IC/IV. 05150040 +C 05160040 + 6001 CONTINUE 05170040 + IVTNUM = 600 05180040 +C 05190040 +C **** TEST 600 **** 05200040 +C 05210040 + IF (ICZERO) 36000, 6000, 36000 05220040 + 6000 CONTINUE 05230040 + IVON01 = -7150 05240040 + IVON03 = -25 05250040 + IVCOMP = IVON01/(-2)/IVON03 05260040 + GO TO 46000 05270040 +36000 IVDELE = IVDELE + 1 05280040 + WRITE (I02,80003) IVTNUM 05290040 + IF (ICZERO) 46000, 6011, 46000 05300040 +46000 IF (IVCOMP + 143) 26000,16000,26000 05310040 +16000 IVPASS = IVPASS + 1 05320040 + WRITE (I02,80001) IVTNUM 05330040 + GO TO 6011 05340040 +26000 IVFAIL = IVFAIL + 1 05350040 + IVCORR = -143 05360040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05370040 + 6011 CONTINUE 05380040 + IVTNUM = 601 05390040 +C 05400040 +C **** TEST 601 **** 05410040 +C 05420040 + IF (ICZERO) 36010, 6010, 36010 05430040 + 6010 CONTINUE 05440040 + IVON01 = 32767 05450040 + IVON03 = -1 05460040 + IVCOMP = IVON01/2/IVON03 05470040 + GO TO 46010 05480040 +36010 IVDELE = IVDELE + 1 05490040 + WRITE (I02,80003) IVTNUM 05500040 + IF (ICZERO) 46010, 6021, 46010 05510040 +46010 IF (IVCOMP + 16383) 26010,16010,26010 05520040 +16010 IVPASS = IVPASS + 1 05530040 + WRITE (I02,80001) IVTNUM 05540040 + GO TO 6021 05550040 +26010 IVFAIL = IVFAIL + 1 05560040 + IVCORR = -16383 05570040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05580040 + 6021 CONTINUE 05590040 + IVTNUM = 602 05600040 +C 05610040 +C **** TEST 602 **** 05620040 +C 05630040 +C TEST 602 AND TEST 603 - IV=IC/IV/IV 05640040 +C 05650040 +C 05660040 + IF (ICZERO) 36020, 6020, 36020 05670040 + 6020 CONTINUE 05680040 + IVON02 = 13 05690040 + IVON03 = 51 05700040 + IVCOMP = 15249/IVON02/IVON03 05710040 + GO TO 46020 05720040 +36020 IVDELE = IVDELE + 1 05730040 + WRITE (I02,80003) IVTNUM 05740040 + IF (ICZERO) 46020, 6031, 46020 05750040 +46020 IF (IVCOMP - 23) 26020,16020,26020 05760040 +16020 IVPASS = IVPASS + 1 05770040 + WRITE (I02,80001) IVTNUM 05780040 + GO TO 6031 05790040 +26020 IVFAIL = IVFAIL + 1 05800040 + IVCORR = 23 05810040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05820040 + 6031 CONTINUE 05830040 + IVTNUM = 603 05840040 +C 05850040 +C **** TEST 603 **** 05860040 +C 05870040 + IF (ICZERO) 36030, 6030, 36030 05880040 + 6030 CONTINUE 05890040 + IVON02 = -13 05900040 + IVON03 = -51 05910040 + IVCOMP = -15249/IVON02/IVON03 05920040 + GO TO 46030 05930040 +36030 IVDELE = IVDELE + 1 05940040 + WRITE (I02,80003) IVTNUM 05950040 + IF (ICZERO) 46030, 6041, 46030 05960040 +46030 IF (IVCOMP +23) 26030,16030,26030 05970040 +16030 IVPASS = IVPASS + 1 05980040 + WRITE (I02,80001) IVTNUM 05990040 + GO TO 6041 06000040 +26030 IVFAIL = IVFAIL + 1 06010040 + IVCORR = -23 06020040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06030040 +C 06040040 +C TEST 604 THROUGH TEST 614 - PARENTHESES ARE USED TO GROUP 06050040 +C ELEMENTS IN THE ARITHMETIC EXPRESSIONS. 06060040 +C 06070040 +C TEST 604 AND TEST 605 - IV=(IV/IV)/IC. 06080040 +C 06090040 + 6041 CONTINUE 06100040 + IVTNUM = 604 06110040 +C 06120040 +C **** TEST 604 **** 06130040 +C 06140040 + IF (ICZERO) 36040, 6040, 36040 06150040 + 6040 CONTINUE 06160040 + IVON01 = 32766 06170040 + IVON02 = 2 06180040 + IVCOMP =(IVON01/IVON02)/3 06190040 + GO TO 46040 06200040 +36040 IVDELE = IVDELE + 1 06210040 + WRITE (I02,80003) IVTNUM 06220040 + IF (ICZERO) 46040, 6051, 46040 06230040 +46040 IF (IVCOMP -5461) 26040,16040,26040 06240040 +16040 IVPASS = IVPASS + 1 06250040 + WRITE (I02,80001) IVTNUM 06260040 + GO TO 6051 06270040 +26040 IVFAIL = IVFAIL + 1 06280040 + IVCORR = 5461 06290040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06300040 + 6051 CONTINUE 06310040 + IVTNUM = 605 06320040 +C 06330040 +C **** TEST 605 **** 06340040 +C 06350040 + IF (ICZERO) 36050, 6050, 36050 06360040 + 6050 CONTINUE 06370040 + IVON01 = 7151 06380040 + IVON02 = 3 06390040 + IVCOMP = (IVON01/IVON02)/10 06400040 + GO TO 46050 06410040 +36050 IVDELE = IVDELE + 1 06420040 + WRITE (I02,80003) IVTNUM 06430040 + IF (ICZERO) 46050, 6061, 46050 06440040 +46050 IF (IVCOMP - 238) 26050,16050,26050 06450040 +16050 IVPASS = IVPASS + 1 06460040 + WRITE (I02,80001) IVTNUM 06470040 + GO TO 6061 06480040 +26050 IVFAIL = IVFAIL + 1 06490040 + IVCORR = 238 06500040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06510040 +C 06520040 +C TEST 606 AND TEST 607 - IV=IV/(IV/IC). 06530040 +C 06540040 + 6061 CONTINUE 06550040 + IVTNUM = 606 06560040 +C 06570040 +C **** TEST 606 **** 06580040 +C 06590040 + IF (ICZERO) 36060, 6060, 36060 06600040 + 6060 CONTINUE 06610040 + IVON01 = -7154 06620040 + IVON02 = 26 06630040 + IVCOMP = IVON01/(IVON02/5) 06640040 + GO TO 46060 06650040 +36060 IVDELE = IVDELE + 1 06660040 + WRITE (I02,80003) IVTNUM 06670040 + IF (ICZERO) 46060, 6071, 46060 06680040 +46060 IF (IVCOMP + 1430) 26060,16060,26060 06690040 +16060 IVPASS = IVPASS + 1 06700040 + WRITE (I02,80001) IVTNUM 06710040 + GO TO 6071 06720040 +26060 IVFAIL = IVFAIL + 1 06730040 + IVCORR = -1430 06740040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06750040 + 6071 CONTINUE 06760040 + IVTNUM = 607 06770040 +C 06780040 +C **** TEST 607 **** 06790040 +C 06800040 + IF (ICZERO) 36070, 6070, 36070 06810040 + 6070 CONTINUE 06820040 + IVON01 = 29 06830040 + IVON02 = -5 06840040 + IVCOMP = IVON01/(IVON02/2) 06850040 + GO TO 46070 06860040 +36070 IVDELE = IVDELE + 1 06870040 + WRITE (I02,80003) IVTNUM 06880040 + IF (ICZERO) 46070, 6081, 46070 06890040 +46070 IF (IVCOMP + 14) 26070,16070,26070 06900040 +16070 IVPASS = IVPASS + 1 06910040 + WRITE (I02,80001) IVTNUM 06920040 + GO TO 6081 06930040 +26070 IVFAIL = IVFAIL + 1 06940040 + IVCORR = -14 06950040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06960040 +C 06970040 +C TEST 608 AND TEST 609 - IV = (IV/IC)/IV. 06980040 +C 06990040 + 6081 CONTINUE 07000040 + IVTNUM = 608 07010040 +C 07020040 +C **** TEST 608 **** 07030040 +C 07040040 + IF (ICZERO) 36080, 6080, 36080 07050040 + 6080 CONTINUE 07060040 + IVON01 = 24 07070040 + IVON03 = 3 07080040 + IVCOMP = (IVON01/3)/IVON03 07090040 + GO TO 46080 07100040 +36080 IVDELE = IVDELE + 1 07110040 + WRITE (I02,80003) IVTNUM 07120040 + IF (ICZERO) 46080, 6091, 46080 07130040 +46080 IF (IVCOMP -2) 26080,16080,26080 07140040 +16080 IVPASS = IVPASS + 1 07150040 + WRITE (I02,80001) IVTNUM 07160040 + GO TO 6091 07170040 +26080 IVFAIL = IVFAIL + 1 07180040 + IVCORR = 2 07190040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07200040 + 6091 CONTINUE 07210040 + IVTNUM = 609 07220040 +C 07230040 +C **** TEST 609 **** 07240040 +C 07250040 + IF (ICZERO) 36090, 6090, 36090 07260040 + 6090 CONTINUE 07270040 + IVON01 = 7151 07280040 + IVON03 = 10 07290040 + IVCOMP = (IVON01/(-3))/IVON03 07300040 + GO TO 46090 07310040 +36090 IVDELE = IVDELE + 1 07320040 + WRITE (I02,80003) IVTNUM 07330040 + IF (ICZERO) 46090, 6101, 46090 07340040 +46090 IF (IVCOMP + 238) 26090,16090,26090 07350040 +16090 IVPASS = IVPASS + 1 07360040 + WRITE (I02,80001) IVTNUM 07370040 + GO TO 6101 07380040 +26090 IVFAIL = IVFAIL + 1 07390040 + IVCORR = -238 07400040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07410040 +C 07420040 +C TEST 610 AND TEST 611 - IV=IV(IC/IV) 07430040 +C 07440040 + 6101 CONTINUE 07450040 + IVTNUM = 610 07460040 +C 07470040 +C **** TEST 610 **** 07480040 +C 07490040 + IF (ICZERO) 36100, 6100, 36100 07500040 + 6100 CONTINUE 07510040 + IVON01 = -7154 07520040 + IVON03 = -5 07530040 + IVCOMP = IVON01/((-26)/IVON03) 07540040 + GO TO 46100 07550040 +36100 IVDELE = IVDELE + 1 07560040 + WRITE (I02,80003) IVTNUM 07570040 + IF (ICZERO) 46100, 6111, 46100 07580040 +46100 IF (IVCOMP + 1430) 26100,16100,26100 07590040 +16100 IVPASS = IVPASS + 1 07600040 + WRITE (I02,80001) IVTNUM 07610040 + GO TO 6111 07620040 +26100 IVFAIL = IVFAIL + 1 07630040 + IVCORR = -1430 07640040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07650040 + 6111 CONTINUE 07660040 + IVTNUM = 611 07670040 +C 07680040 +C **** TEST 611 **** 07690040 +C 07700040 + IF (ICZERO) 36110, 6110, 36110 07710040 + 6110 CONTINUE 07720040 + IVON01 = 7150 07730040 + IVON03 = 5 07740040 + IVCOMP = IVON01/((+25)/IVON03) 07750040 + GO TO 46110 07760040 +36110 IVDELE = IVDELE + 1 07770040 + WRITE (I02,80003) IVTNUM 07780040 + IF (ICZERO) 46110, 6121, 46110 07790040 +46110 IF (IVCOMP -1430) 26110,16110,26110 07800040 +16110 IVPASS = IVPASS + 1 07810040 + WRITE (I02,80001) IVTNUM 07820040 + GO TO 6121 07830040 +26110 IVFAIL = IVFAIL + 1 07840040 + IVCORR = 1430 07850040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07860040 + 6121 CONTINUE 07870040 + IVTNUM = 612 07880040 +C 07890040 +C **** TEST 612 **** 07900040 +C TEST 612 - IV= (IC/IV)/IV 07910040 +C 07920040 + IF (ICZERO) 36120, 6120, 36120 07930040 + 6120 CONTINUE 07940040 + IVON02 = -3 07950040 + IVON03 = -10 07960040 + IVCOMP = (-7154/IVON02)/IVON03 07970040 + GO TO 46120 07980040 +36120 IVDELE = IVDELE + 1 07990040 + WRITE (I02,80003) IVTNUM 08000040 + IF (ICZERO) 46120, 6131, 46120 08010040 +46120 IF (IVCOMP + 238) 26120,16120,26120 08020040 +16120 IVPASS = IVPASS + 1 08030040 + WRITE (I02,80001) IVTNUM 08040040 + GO TO 6131 08050040 +26120 IVFAIL = IVFAIL + 1 08060040 + IVCORR = -238 08070040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08080040 +C 08090040 +C TEST 613 AND TEST 614 - IV=IC/(IV/IV) 08100040 +C 08110040 + 6131 CONTINUE 08120040 + IVTNUM = 613 08130040 +C 08140040 +C **** TEST 613 **** 08150040 +C 08160040 + IF (ICZERO) 36130, 6130, 36130 08170040 + 6130 CONTINUE 08180040 + IVON02 = 8 08190040 + IVON03 = 4 08200040 + IVCOMP = 24/(IVON02/IVON03) 08210040 + GO TO 46130 08220040 +36130 IVDELE = IVDELE + 1 08230040 + WRITE (I02,80003) IVTNUM 08240040 + IF (ICZERO) 46130, 6141, 46130 08250040 +46130 IF (IVCOMP - 12) 26130,16130,26130 08260040 +16130 IVPASS = IVPASS + 1 08270040 + WRITE (I02,80001) IVTNUM 08280040 + GO TO 6141 08290040 +26130 IVFAIL = IVFAIL + 1 08300040 + IVCORR = 12 08310040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08320040 + 6141 CONTINUE 08330040 + IVTNUM = 614 08340040 +C 08350040 +C **** TEST 614 **** 08360040 +C 08370040 + IF (ICZERO) 36140, 6140, 36140 08380040 + 6140 CONTINUE 08390040 + IVON02 = 25 08400040 + IVON03 = 5 08410040 + IVCOMP = 7150/(-(IVON02/IVON03)) 08420040 + GO TO 46140 08430040 +36140 IVDELE = IVDELE + 1 08440040 + WRITE (I02,80003) IVTNUM 08450040 + IF (ICZERO) 46140, 6151, 46140 08460040 +46140 IF (IVCOMP + 1430) 26140,16140,26140 08470040 +16140 IVPASS = IVPASS + 1 08480040 + WRITE (I02,80001) IVTNUM 08490040 + GO TO 6151 08500040 +26140 IVFAIL = IVFAIL + 1 08510040 + IVCORR = -1430 08520040 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 08530040 +C **** END OF TESTS **** 08540040 + 6151 CONTINUE 08550040 +C 08560040 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08570040 +99999 CONTINUE 08580040 + WRITE (I02,90002) 08590040 + WRITE (I02,90006) 08600040 + WRITE (I02,90002) 08610040 + WRITE (I02,90002) 08620040 + WRITE (I02,90007) 08630040 + WRITE (I02,90002) 08640040 + WRITE (I02,90008) IVFAIL 08650040 + WRITE (I02,90009) IVPASS 08660040 + WRITE (I02,90010) IVDELE 08670040 +C 08680040 +C 08690040 +C TERMINATE ROUTINE EXECUTION 08700040 + STOP 08710040 +C 08720040 +C FORMAT STATEMENTS FOR PAGE HEADERS 08730040 +90000 FORMAT ("1") 08740040 +90002 FORMAT (" ") 08750040 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08760040 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08770040 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08780040 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08790040 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08800040 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08810040 +C 08820040 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08830040 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08840040 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08850040 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08860040 +C 08870040 +C FORMAT STATEMENTS FOR TEST RESULTS 08880040 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08890040 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08900040 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08910040 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08920040 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08930040 +C 08940040 +90007 FORMAT (" ",20X,"END OF PROGRAM FM040" ) 08950040 + END 08960040 diff --git a/Fortran/UnitTests/fcvs21_f95/FM040.reference_output b/Fortran/UnitTests/fcvs21_f95/FM040.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM040.reference_output @@ -0,0 +1,57 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 582 PASS + 583 PASS + 584 PASS + 585 PASS + 586 PASS + 587 PASS + 588 PASS + 589 PASS + 590 PASS + 591 PASS + 592 PASS + 593 PASS + 594 PASS + 595 PASS + 596 PASS + 597 PASS + 598 PASS + 599 PASS + 600 PASS + 601 PASS + 602 PASS + 603 PASS + 604 PASS + 605 PASS + 606 PASS + 607 PASS + 608 PASS + 609 PASS + 610 PASS + 611 PASS + 612 PASS + 613 PASS + 614 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM040 + + 0 ERRORS ENCOUNTERED + 33 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM041.f b/Fortran/UnitTests/fcvs21_f95/FM041.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM041.f @@ -0,0 +1,843 @@ + PROGRAM FM041 + +C COMMENT SECTION 00010041 +C 00020041 +C FM041 00030041 +C 00040041 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS OF THE 00050041 +C FORM INTEGER VARIABLE = PRIMARY ** PRIMARY 00060041 +C WHERE THE FIRST OF TWO PRIMARIES IS AN INTEGER VARIABLE OR AN 00070041 +C INTEGER CONSTANT AND THE SECOND PRIMARY IS AN INTEGER CONSTANT. 00080041 +C 00090041 +C REFERENCES 00100041 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110041 +C X3.9-1978 00120041 +C 00130041 +C SECTION 4.3, INTEGER TYPE 00140041 +C SECTION 4.3.1, INTEGER CONSTANT 00150041 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00160041 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00170041 +C 00180041 +C 00190041 +C ********************************************************** 00200041 +C 00210041 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00220041 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00230041 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00240041 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00250041 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00260041 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00270041 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00280041 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00290041 +C OF EXECUTING THESE TESTS. 00300041 +C 00310041 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00320041 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00330041 +C 00340041 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00350041 +C 00360041 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00370041 +C SOFTWARE STANDARDS VALIDATION GROUP 00380041 +C BUILDING 225 RM A266 00390041 +C GAITHERSBURG, MD 20899 00400041 +C ********************************************************** 00410041 +C 00420041 +C 00430041 +C 00440041 +C INITIALIZATION SECTION 00450041 +C 00460041 +C INITIALIZE CONSTANTS 00470041 +C ************** 00480041 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00490041 + I01 = 5 00500041 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00510041 + I02 = 6 00520041 +C SYSTEM ENVIRONMENT SECTION 00530041 +C 00540041 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00550041 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00560041 +C (UNIT NUMBER FOR CARD READER). 00570041 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00580041 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00590041 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00600041 +C 00610041 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00620041 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00630041 +C (UNIT NUMBER FOR PRINTER). 00640041 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00650041 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00660041 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00670041 +C 00680041 + IVPASS=0 00690041 + IVFAIL=0 00700041 + IVDELE=0 00710041 + ICZERO=0 00720041 +C 00730041 +C WRITE PAGE HEADERS 00740041 + WRITE (I02,90000) 00750041 + WRITE (I02,90001) 00760041 + WRITE (I02,90002) 00770041 + WRITE (I02, 90002) 00780041 + WRITE (I02,90003) 00790041 + WRITE (I02,90002) 00800041 + WRITE (I02,90004) 00810041 + WRITE (I02,90002) 00820041 + WRITE (I02,90011) 00830041 + WRITE (I02,90002) 00840041 + WRITE (I02,90002) 00850041 + WRITE (I02,90005) 00860041 + WRITE (I02,90006) 00870041 + WRITE (I02,90002) 00880041 +C 00890041 +C TEST SECTION 00900041 +C 00910041 +C ARITHMETIC ASSIGNMENT STATEMENT 00920041 +C 00930041 +C TEST 615 THROUGH TEST 631 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS00940041 +C OF THE FORM INTEGER VARIABLE = INTEGER CONSTANT ** INTEGER CON.00950041 +C 00960041 +C TEST 632 THROUGH TEST 648 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS00970041 +C OF THE FORM INTEGER VARIABLE = INTEGER VARIABLE ** INTEGER CON.00980041 +C 00990041 +C 01000041 + IVTNUM = 615 01010041 +C 01020041 +C **** TEST 615 **** 01030041 +C TEST 615 - SMALL NUMBER BASE; ZERO EXPONENT 01040041 +C 01050041 + IF (ICZERO) 36150, 6150, 36150 01060041 + 6150 CONTINUE 01070041 + IVCOMP = 1 ** 0 01080041 + GO TO 46150 01090041 +36150 IVDELE = IVDELE + 1 01100041 + WRITE (I02,80003) IVTNUM 01110041 + IF (ICZERO) 46150, 6161, 46150 01120041 +46150 IF (IVCOMP - 1) 26150,16150,26150 01130041 +16150 IVPASS = IVPASS + 1 01140041 + WRITE (I02,80001) IVTNUM 01150041 + GO TO 6161 01160041 +26150 IVFAIL = IVFAIL + 1 01170041 + IVCORR = 1 01180041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01190041 + 6161 CONTINUE 01200041 + IVTNUM = 616 01210041 +C 01220041 +C **** TEST 616 **** 01230041 +C TEST 616 - ZERO BASE TO FIRST POWER 01240041 +C 01250041 + IF (ICZERO) 36160, 6160, 36160 01260041 + 6160 CONTINUE 01270041 + IVCOMP = 0 ** 1 01280041 + GO TO 46160 01290041 +36160 IVDELE = IVDELE + 1 01300041 + WRITE (I02,80003) IVTNUM 01310041 + IF (ICZERO) 46160, 6171, 46160 01320041 +46160 IF (IVCOMP) 26160,16160,26160 01330041 +16160 IVPASS = IVPASS + 1 01340041 + WRITE (I02,80001) IVTNUM 01350041 + GO TO 6171 01360041 +26160 IVFAIL = IVFAIL + 1 01370041 + IVCORR = 0 01380041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01390041 + 6171 CONTINUE 01400041 + IVTNUM = 617 01410041 +C 01420041 +C **** TEST 617 **** 01430041 +C TEST 617 - BASE =1; EXPONENT = 1 01440041 +C 01450041 + IF (ICZERO) 36170, 6170, 36170 01460041 + 6170 CONTINUE 01470041 + IVCOMP = 1 ** 1 01480041 + GO TO 46170 01490041 +36170 IVDELE = IVDELE + 1 01500041 + WRITE (I02,80003) IVTNUM 01510041 + IF (ICZERO) 46170, 6181, 46170 01520041 +46170 IF (IVCOMP - 1) 26170,16170,26170 01530041 +16170 IVPASS = IVPASS + 1 01540041 + WRITE (I02,80001) IVTNUM 01550041 + GO TO 6181 01560041 +26170 IVFAIL = IVFAIL + 1 01570041 + IVCORR = 1 01580041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01590041 + 6181 CONTINUE 01600041 + IVTNUM = 618 01610041 +C 01620041 +C **** TEST 618 **** 01630041 +C TEST 618 - LARGE NUMBER BASE; EXPONENT = 1 01640041 +C 01650041 + IF (ICZERO) 36180, 6180, 36180 01660041 + 6180 CONTINUE 01670041 + IVCOMP = 32767 ** 1 01680041 + GO TO 46180 01690041 +36180 IVDELE = IVDELE + 1 01700041 + WRITE (I02,80003) IVTNUM 01710041 + IF (ICZERO) 46180, 6191, 46180 01720041 +46180 IF (IVCOMP - 32767) 26180,16180,26180 01730041 +16180 IVPASS = IVPASS + 1 01740041 + WRITE (I02,80001) IVTNUM 01750041 + GO TO 6191 01760041 +26180 IVFAIL = IVFAIL + 1 01770041 + IVCORR = 32767 01780041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01790041 + 6191 CONTINUE 01800041 + IVTNUM = 619 01810041 +C 01820041 +C **** TEST 619 **** 01830041 +C TEST 619 - LARGE EXPONENT 01840041 +C 01850041 + IF (ICZERO) 36190, 6190, 36190 01860041 + 6190 CONTINUE 01870041 + IVCOMP = 1 ** 32767 01880041 + GO TO 46190 01890041 +36190 IVDELE = IVDELE + 1 01900041 + WRITE (I02,80003) IVTNUM 01910041 + IF (ICZERO) 46190, 6201, 46190 01920041 +46190 IF (IVCOMP - 1) 26190,16190,26190 01930041 +16190 IVPASS = IVPASS + 1 01940041 + WRITE (I02,80001) IVTNUM 01950041 + GO TO 6201 01960041 +26190 IVFAIL = IVFAIL + 1 01970041 + IVCORR = 1 01980041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01990041 + 6201 CONTINUE 02000041 + IVTNUM = 620 02010041 +C 02020041 +C **** TEST 620 **** 02030041 +C TEST 620 - ZERO BASE; LARGE NUMBER EXPONENT 02040041 +C 02050041 + IF (ICZERO) 36200, 6200, 36200 02060041 + 6200 CONTINUE 02070041 + IVCOMP = 0 ** 32767 02080041 + GO TO 46200 02090041 +36200 IVDELE = IVDELE + 1 02100041 + WRITE (I02,80003) IVTNUM 02110041 + IF (ICZERO) 46200, 6211, 46200 02120041 +46200 IF (IVCOMP) 26200,16200,26200 02130041 +16200 IVPASS = IVPASS + 1 02140041 + WRITE (I02,80001) IVTNUM 02150041 + GO TO 6211 02160041 +26200 IVFAIL = IVFAIL + 1 02170041 + IVCORR = 0 02180041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02190041 + 6211 CONTINUE 02200041 + IVTNUM = 621 02210041 +C 02220041 +C **** TEST 621 **** 02230041 +C TEST 621 -LARGE NUMBER BASE; ZERO EXPONENT 02240041 +C 02250041 + IF (ICZERO) 36210, 6210, 36210 02260041 + 6210 CONTINUE 02270041 + IVCOMP = 32767 ** 0 02280041 + GO TO 46210 02290041 +36210 IVDELE = IVDELE + 1 02300041 + WRITE (I02,80003) IVTNUM 02310041 + IF (ICZERO) 46210, 6221, 46210 02320041 +46210 IF (IVCOMP - 1) 26210,16210,26210 02330041 +16210 IVPASS = IVPASS + 1 02340041 + WRITE (I02,80001) IVTNUM 02350041 + GO TO 6221 02360041 +26210 IVFAIL = IVFAIL + 1 02370041 + IVCORR = 1 02380041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02390041 + 6221 CONTINUE 02400041 + IVTNUM = 622 02410041 +C 02420041 +C **** TEST 622 **** 02430041 +C TEST 622 -EXPONENT IS POWER OF TWO 02440041 +C 02450041 + IF (ICZERO) 36220, 6220, 36220 02460041 + 6220 CONTINUE 02470041 + IVCOMP = 181 ** 2 02480041 + GO TO 46220 02490041 +36220 IVDELE = IVDELE + 1 02500041 + WRITE (I02,80003) IVTNUM 02510041 + IF (ICZERO) 46220, 6231, 46220 02520041 +46220 IF (IVCOMP - 32761) 26220,16220,26220 02530041 +16220 IVPASS = IVPASS + 1 02540041 + WRITE (I02,80001) IVTNUM 02550041 + GO TO 6231 02560041 +26220 IVFAIL = IVFAIL + 1 02570041 + IVCORR = 32761 02580041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02590041 + 6231 CONTINUE 02600041 + IVTNUM = 623 02610041 +C 02620041 +C **** TEST 623 **** 02630041 +C TEST 623 - BASE AND EXPONENT ARE BOTH POWERS OF TWO 02640041 +C 02650041 + IF (ICZERO) 36230, 6230, 36230 02660041 + 6230 CONTINUE 02670041 + IVCOMP = 2 ** 8 02680041 + GO TO 46230 02690041 +36230 IVDELE = IVDELE + 1 02700041 + WRITE (I02,80003) IVTNUM 02710041 + IF (ICZERO) 46230, 6241, 46230 02720041 +46230 IF (IVCOMP - 256) 26230,16230,26230 02730041 +16230 IVPASS = IVPASS + 1 02740041 + WRITE (I02,80001) IVTNUM 02750041 + GO TO 6241 02760041 +26230 IVFAIL = IVFAIL + 1 02770041 + IVCORR = 256 02780041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02790041 + 6241 CONTINUE 02800041 +C 02810041 +C TESTS 624 AND 625 TEST TO ENSURE EXPONENTIATION OPERATOR IS 02820041 +C NOT COMMUTATIVE 02830041 +C 02840041 + IVTNUM = 624 02850041 +C 02860041 +C **** TEST 624 **** 02870041 +C 02880041 + IF (ICZERO) 36240, 6240, 36240 02890041 + 6240 CONTINUE 02900041 + IVCOMP = 3 ** 9 02910041 + GO TO 46240 02920041 +36240 IVDELE = IVDELE + 1 02930041 + WRITE (I02,80003) IVTNUM 02940041 + IF (ICZERO) 46240, 6251, 46240 02950041 +46240 IF (IVCOMP - 19683) 26240,16240,26240 02960041 +16240 IVPASS = IVPASS + 1 02970041 + WRITE (I02,80001) IVTNUM 02980041 + GO TO 6251 02990041 +26240 IVFAIL = IVFAIL + 1 03000041 + IVCORR = 19683 03010041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03020041 + 6251 CONTINUE 03030041 + IVTNUM = 625 03040041 +C 03050041 +C **** TEST 625 **** 03060041 +C 03070041 + IF (ICZERO) 36250, 6250, 36250 03080041 + 6250 CONTINUE 03090041 + IVCOMP = 9 ** 3 03100041 + GO TO 46250 03110041 +36250 IVDELE = IVDELE + 1 03120041 + WRITE (I02,80003) IVTNUM 03130041 + IF (ICZERO) 46250, 6261, 46250 03140041 +46250 IF (IVCOMP - 729) 26250,16250,26250 03150041 +16250 IVPASS = IVPASS + 1 03160041 + WRITE (I02,80001) IVTNUM 03170041 + GO TO 6261 03180041 +26250 IVFAIL = IVFAIL + 1 03190041 + IVCORR = 729 03200041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03210041 + 6261 CONTINUE 03220041 +C 03230041 +C TESTS 626 THROUGH 631 TEST POSITIVE AND NEGATIVE BASES TO POSITIVE03240041 +C ODD AND EVEN NUMBER POWERS CHECKING THE SIGN03250041 +C OF THE RESULTS 03260041 +C 03270041 + IVTNUM = 626 03280041 +C 03290041 +C **** TEST 626 **** 03300041 +C 03310041 + IF (ICZERO) 36260, 6260, 36260 03320041 + 6260 CONTINUE 03330041 + IVCOMP = 1 ** 2 03340041 + GO TO 46260 03350041 +36260 IVDELE = IVDELE + 1 03360041 + WRITE (I02,80003) IVTNUM 03370041 + IF (ICZERO) 46260, 6271, 46260 03380041 +46260 IF (IVCOMP - 1) 26260,16260,26260 03390041 +16260 IVPASS = IVPASS + 1 03400041 + WRITE (I02,80001) IVTNUM 03410041 + GO TO 6271 03420041 +26260 IVFAIL = IVFAIL + 1 03430041 + IVCORR = 1 03440041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03450041 + 6271 CONTINUE 03460041 + IVTNUM = 627 03470041 +C 03480041 +C **** TEST 627 **** 03490041 +C 03500041 + IF (ICZERO) 36270, 6270, 36270 03510041 + 6270 CONTINUE 03520041 + IVCOMP= (-1) ** 2 03530041 + GO TO 46270 03540041 +36270 IVDELE = IVDELE + 1 03550041 + WRITE (I02,80003) IVTNUM 03560041 + IF (ICZERO) 46270, 6281, 46270 03570041 +46270 IF (IVCOMP - 1) 26270,16270,26270 03580041 +16270 IVPASS = IVPASS + 1 03590041 + WRITE (I02,80001) IVTNUM 03600041 + GO TO 6281 03610041 +26270 IVFAIL = IVFAIL + 1 03620041 + IVCORR = 1 03630041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03640041 + 6281 CONTINUE 03650041 + IVTNUM = 628 03660041 +C 03670041 +C **** TEST 628 **** 03680041 +C 03690041 + IF (ICZERO) 36280, 6280, 36280 03700041 + 6280 CONTINUE 03710041 + IVCOMP = 7 ** 3 03720041 + GO TO 46280 03730041 +36280 IVDELE = IVDELE + 1 03740041 + WRITE (I02,80003) IVTNUM 03750041 + IF (ICZERO) 46280, 6291, 46280 03760041 +46280 IF (IVCOMP - 343) 26280,16280,26280 03770041 +16280 IVPASS = IVPASS + 1 03780041 + WRITE (I02,80001) IVTNUM 03790041 + GO TO 6291 03800041 +26280 IVFAIL = IVFAIL + 1 03810041 + IVCORR = 343 03820041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03830041 + 6291 CONTINUE 03840041 + IVTNUM = 629 03850041 +C 03860041 +C **** TEST 629 **** 03870041 +C 03880041 + IF (ICZERO) 36290, 6290, 36290 03890041 + 6290 CONTINUE 03900041 + IVCOMP = (-7) ** 3 03910041 + GO TO 46290 03920041 +36290 IVDELE = IVDELE + 1 03930041 + WRITE (I02,80003) IVTNUM 03940041 + IF (ICZERO) 46290, 6301, 46290 03950041 +46290 IF (IVCOMP + 343) 26290,16290,26290 03960041 +16290 IVPASS = IVPASS + 1 03970041 + WRITE (I02,80001) IVTNUM 03980041 + GO TO 6301 03990041 +26290 IVFAIL = IVFAIL + 1 04000041 + IVCORR = -343 04010041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04020041 + 6301 CONTINUE 04030041 + IVTNUM = 630 04040041 +C 04050041 +C **** TEST 630 **** 04060041 +C 04070041 + IF (ICZERO) 36300, 6300, 36300 04080041 + 6300 CONTINUE 04090041 + IVCOMP = 7 ** 4 04100041 + GO TO 46300 04110041 +36300 IVDELE = IVDELE + 1 04120041 + WRITE (I02,80003) IVTNUM 04130041 + IF (ICZERO) 46300, 6311, 46300 04140041 +46300 IF (IVCOMP - 2401) 26300,16300,26300 04150041 +16300 IVPASS = IVPASS + 1 04160041 + WRITE (I02,80001) IVTNUM 04170041 + GO TO 6311 04180041 +26300 IVFAIL = IVFAIL + 1 04190041 + IVCORR = 2401 04200041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04210041 + 6311 CONTINUE 04220041 + IVTNUM = 631 04230041 +C 04240041 +C **** TEST 631 **** 04250041 +C 04260041 + IF (ICZERO) 36310, 6310, 36310 04270041 + 6310 CONTINUE 04280041 + IVCOMP = (-7) ** 4 04290041 + GO TO 46310 04300041 +36310 IVDELE = IVDELE + 1 04310041 + WRITE (I02,80003) IVTNUM 04320041 + IF (ICZERO) 46310, 6321, 46310 04330041 +46310 IF (IVCOMP - 2401) 26310,16310,26310 04340041 +16310 IVPASS = IVPASS + 1 04350041 + WRITE (I02,80001) IVTNUM 04360041 + GO TO 6321 04370041 +26310 IVFAIL = IVFAIL + 1 04380041 + IVCORR = 2401 04390041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04400041 + 6321 CONTINUE 04410041 + IVTNUM = 632 04420041 +C 04430041 +C **** TEST 632 **** 04440041 +C TEST 632 - SMALL NUMBER BASE; ZERO EXPONENT 04450041 +C 04460041 + IF (ICZERO) 36320, 6320, 36320 04470041 + 6320 CONTINUE 04480041 + IVON01 = 1 04490041 + IVCOMP = IVON01 ** 1 04500041 + GO TO 46320 04510041 +36320 IVDELE = IVDELE + 1 04520041 + WRITE (I02,80003) IVTNUM 04530041 + IF (ICZERO) 46320, 6331, 46320 04540041 +46320 IF (IVCOMP - 1) 26320,16320,26320 04550041 +16320 IVPASS = IVPASS + 1 04560041 + WRITE (I02,80001) IVTNUM 04570041 + GO TO 6331 04580041 +26320 IVFAIL = IVFAIL + 1 04590041 + IVCORR = 1 04600041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04610041 + 6331 CONTINUE 04620041 + IVTNUM = 633 04630041 +C 04640041 +C **** TEST 633 **** 04650041 +C TEST 633 - ZERO BASE TO FIRST POWER 04660041 +C 04670041 + IF (ICZERO) 36330, 6330, 36330 04680041 + 6330 CONTINUE 04690041 + IVON01 = 0 04700041 + IVCOMP = IVON01 ** 1 04710041 + GO TO 46330 04720041 +36330 IVDELE = IVDELE + 1 04730041 + WRITE (I02,80003) IVTNUM 04740041 + IF (ICZERO) 46330, 6341, 46330 04750041 +46330 IF (IVCOMP) 26330,16330,26330 04760041 +16330 IVPASS = IVPASS + 1 04770041 + WRITE (I02,80001) IVTNUM 04780041 + GO TO 6341 04790041 +26330 IVFAIL = IVFAIL + 1 04800041 + IVCORR = 0 04810041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 04820041 + 6341 CONTINUE 04830041 + IVTNUM = 634 04840041 +C 04850041 +C **** TEST 634 **** 04860041 +C TEST 634 - BASE =1; EXPONENT = 1 04870041 +C 04880041 + IF (ICZERO) 36340, 6340, 36340 04890041 + 6340 CONTINUE 04900041 + IVON01 = 1 04910041 + IVCOMP = IVON01 ** 1 04920041 + GO TO 46340 04930041 +36340 IVDELE = IVDELE + 1 04940041 + WRITE (I02,80003) IVTNUM 04950041 + IF (ICZERO) 46340, 6351, 46340 04960041 +46340 IF (IVCOMP - 1) 26340,16340,26340 04970041 +16340 IVPASS = IVPASS + 1 04980041 + WRITE (I02,80001) IVTNUM 04990041 + GO TO 6351 05000041 +26340 IVFAIL = IVFAIL + 1 05010041 + IVCORR = 1 05020041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05030041 + 6351 CONTINUE 05040041 + IVTNUM = 635 05050041 +C 05060041 +C **** TEST 635 **** 05070041 +C TEST 635 - LARGE EXPONENT 05080041 +C 05090041 + IF (ICZERO) 36350, 6350, 36350 05100041 + 6350 CONTINUE 05110041 + IVON01 = 1 05120041 + IVCOMP = IVON01 ** 32767 05130041 + GO TO 46350 05140041 +36350 IVDELE = IVDELE + 1 05150041 + WRITE (I02,80003) IVTNUM 05160041 + IF (ICZERO) 46350, 6361, 46350 05170041 +46350 IF (IVCOMP - 1) 26350,16350,26350 05180041 +16350 IVPASS = IVPASS + 1 05190041 + WRITE (I02,80001) IVTNUM 05200041 + GO TO 6361 05210041 +26350 IVFAIL = IVFAIL + 1 05220041 + IVCORR = 1 05230041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05240041 + 6361 CONTINUE 05250041 + IVTNUM = 636 05260041 +C 05270041 +C **** TEST 636 **** 05280041 +C TEST 636 - LARGE NUMBER BASE; EXPONENT = 1 05290041 +C 05300041 + IF (ICZERO) 36360, 6360, 36360 05310041 + 6360 CONTINUE 05320041 + IVON01 = 32767 05330041 + IVCOMP = IVON01 ** 1 05340041 + GO TO 46360 05350041 +36360 IVDELE = IVDELE + 1 05360041 + WRITE (I02,80003) IVTNUM 05370041 + IF (ICZERO) 46360, 6371, 46360 05380041 +46360 IF (IVCOMP - 32767) 26360,16360,26360 05390041 +16360 IVPASS = IVPASS + 1 05400041 + WRITE (I02,80001) IVTNUM 05410041 + GO TO 6371 05420041 +26360 IVFAIL = IVFAIL + 1 05430041 + IVCORR = 32767 05440041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05450041 + 6371 CONTINUE 05460041 + IVTNUM = 637 05470041 +C 05480041 +C **** TEST 637 **** 05490041 +C TEST 637 - ZERO BASE; LARGE NUMBER EXPONENT 05500041 +C 05510041 + IF (ICZERO) 36370, 6370, 36370 05520041 + 6370 CONTINUE 05530041 + IVON01 = 0 05540041 + IVCOMP = IVON01 ** 32767 05550041 + GO TO 46370 05560041 +36370 IVDELE = IVDELE + 1 05570041 + WRITE (I02,80003) IVTNUM 05580041 + IF (ICZERO) 46370, 6381, 46370 05590041 +46370 IF (IVCOMP) 26370,16370,26370 05600041 +16370 IVPASS = IVPASS + 1 05610041 + WRITE (I02,80001) IVTNUM 05620041 + GO TO 6381 05630041 +26370 IVFAIL = IVFAIL +1 05640041 + IVCORR = 0 05650041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05660041 + 6381 CONTINUE 05670041 + IVTNUM = 638 05680041 +C 05690041 +C **** TEST 638 **** 05700041 +C TEST 638 -LARGE NUMBER BASE; ZERO EXPONENT 05710041 +C 05720041 + IF (ICZERO) 36380, 6380, 36380 05730041 + 6380 CONTINUE 05740041 + IVON01 = 32767 05750041 + IVCOMP = IVON01 ** 0 05760041 + GO TO 46380 05770041 +36380 IVDELE = IVDELE + 1 05780041 + WRITE (I02,80003) IVTNUM 05790041 + IF (ICZERO) 46380, 6391, 46380 05800041 +46380 IF (IVCOMP - 1) 26380,16380,26380 05810041 +16380 IVPASS = IVPASS + 1 05820041 + WRITE (I02,80001) IVTNUM 05830041 + GO TO 6391 05840041 +26380 IVFAIL = IVFAIL + 1 05850041 + IVCORR = 1 05860041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 05870041 + 6391 CONTINUE 05880041 + IVTNUM = 639 05890041 +C 05900041 +C **** TEST 639 **** 05910041 +C TEST 639 -EXPONENT IS POWER OF TWO 05920041 +C 05930041 + IF (ICZERO) 36390, 6390, 36390 05940041 + 6390 CONTINUE 05950041 + IVON01 = 181 05960041 + IVCOMP = IVON01 ** 2 05970041 + GO TO 46390 05980041 +36390 IVDELE = IVDELE + 1 05990041 + WRITE (I02,80003) IVTNUM 06000041 + IF (ICZERO) 46390, 6401, 46390 06010041 +46390 IF (IVCOMP - 32761) 26390,16390,26390 06020041 +16390 IVPASS = IVPASS + 1 06030041 + WRITE (I02,80001) IVTNUM 06040041 + GO TO 6401 06050041 +26390 IVFAIL = IVFAIL + 1 06060041 + IVCORR = 32761 06070041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06080041 + 6401 CONTINUE 06090041 + IVTNUM = 640 06100041 +C 06110041 +C **** TEST 640 **** 06120041 +C TEST 640 - BASE AND EXPONENT ARE BOTH POWERS OF TWO 06130041 +C 06140041 + IF (ICZERO) 36400, 6400, 36400 06150041 + 6400 CONTINUE 06160041 + IVON01 = 2 06170041 + IVCOMP = IVON01 ** 8 06180041 + GO TO 46400 06190041 +36400 IVDELE = IVDELE + 1 06200041 + WRITE (I02,80003) IVTNUM 06210041 + IF (ICZERO) 46400, 6411, 46400 06220041 +46400 IF (IVCOMP - 256) 26400,16400,26400 06230041 +16400 IVPASS = IVPASS + 1 06240041 + WRITE (I02,80001) IVTNUM 06250041 + GO TO 6411 06260041 +26400 IVFAIL = IVFAIL + 1 06270041 + IVCORR = 256 06280041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06290041 + 6411 CONTINUE 06300041 +C 06310041 +C TESTS 641 AND 642 TEST TO ENSURE EXPONENTIATION OPERATOR IS 06320041 +C NOT COMMUTATIVE 06330041 +C 06340041 + IVTNUM = 641 06350041 +C 06360041 +C **** TEST 641 **** 06370041 +C 06380041 + IF (ICZERO) 36410, 6410, 36410 06390041 + 6410 CONTINUE 06400041 + IVON01 = 3 06410041 + IVCOMP = IVON01 ** 9 06420041 + GO TO 46410 06430041 +36410 IVDELE = IVDELE + 1 06440041 + WRITE (I02,80003) IVTNUM 06450041 + IF (ICZERO) 46410, 6421, 46410 06460041 +46410 IF (IVCOMP - 19683) 26410,16410,26410 06470041 +16410 IVPASS = IVPASS + 1 06480041 + WRITE (I02,80001) IVTNUM 06490041 + GO TO 6421 06500041 +26410 IVFAIL = IVFAIL + 1 06510041 + IVCORR = 19683 06520041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06530041 + 6421 CONTINUE 06540041 + IVTNUM = 642 06550041 +C 06560041 +C **** TEST 642 **** 06570041 +C 06580041 + IF (ICZERO) 36420, 6420, 36420 06590041 + 6420 CONTINUE 06600041 + IVON01 = 9 06610041 + IVCOMP = IVON01 ** 3 06620041 + GO TO 46420 06630041 +36420 IVDELE = IVDELE + 1 06640041 + WRITE (I02,80003) IVTNUM 06650041 + IF (ICZERO) 46420, 6431, 46420 06660041 +46420 IF (IVCOMP - 729) 26420,16420,26420 06670041 +16420 IVPASS = IVPASS + 1 06680041 + WRITE (I02,80001) IVTNUM 06690041 + GO TO 6431 06700041 +26420 IVFAIL = IVFAIL + 1 06710041 + IVCORR = 729 06720041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06730041 + 6431 CONTINUE 06740041 +C 06750041 +C TESTS 643 THROUGH 648 TEST POSITIVE AND NEGATIVE BASES TO POSITIVE06760041 +C ODD AND EVEN NUMBER POWERS CHECKING THE SIGN06770041 +C OF THE RESULTS 06780041 +C 06790041 + IVTNUM = 643 06800041 +C 06810041 +C **** TEST 643 **** 06820041 +C 06830041 + IF (ICZERO) 36430, 6430, 36430 06840041 + 6430 CONTINUE 06850041 + IVON01 = 1 06860041 + IVCOMP = IVON01 ** 2 06870041 + GO TO 46430 06880041 +36430 IVDELE = IVDELE + 1 06890041 + WRITE (I02,80003) IVTNUM 06900041 + IF (ICZERO) 46430, 6441, 46430 06910041 +46430 IF (IVCOMP - 1) 26430,16430,26430 06920041 +16430 IVPASS = IVPASS + 1 06930041 + WRITE (I02,80001) IVTNUM 06940041 + GO TO 6441 06950041 +26430 IVFAIL = IVFAIL + 1 06960041 + IVCORR = 1 06970041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 06980041 + 6441 CONTINUE 06990041 + IVTNUM = 644 07000041 +C 07010041 +C **** TEST 644 **** 07020041 +C 07030041 + IF (ICZERO) 36440, 6440, 36440 07040041 + 6440 CONTINUE 07050041 + IVON01 = -1 07060041 + IVCOMP = IVON01 ** 2 07070041 + GO TO 46440 07080041 +36440 IVDELE = IVDELE + 1 07090041 + WRITE (I02,80003) IVTNUM 07100041 + IF (ICZERO) 46440, 6451, 46440 07110041 +46440 IF (IVCOMP - 1) 26440,16440,26440 07120041 +16440 IVPASS = IVPASS + 1 07130041 + WRITE (I02,80001) IVTNUM 07140041 + GO TO 6451 07150041 +26440 IVFAIL = IVFAIL + 1 07160041 + IVCORR = 1 07170041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07180041 + 6451 CONTINUE 07190041 + IVTNUM = 645 07200041 +C 07210041 +C **** TEST 645 **** 07220041 +C 07230041 + IF (ICZERO) 36450, 6450, 36450 07240041 + 6450 CONTINUE 07250041 + IVON01 = 7 07260041 + IVCOMP = IVON01 ** 3 07270041 + GO TO 46450 07280041 +36450 IVDELE = IVDELE + 1 07290041 + WRITE (I02,80003) IVTNUM 07300041 + IF (ICZERO) 46450, 6461, 46450 07310041 +46450 IF (IVCOMP - 343) 26450,16450,26450 07320041 +16450 IVPASS = IVPASS + 1 07330041 + WRITE (I02,80001) IVTNUM 07340041 + GO TO 6461 07350041 +26450 IVFAIL = IVFAIL + 1 07360041 + IVCORR = 343 07370041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07380041 + 6461 CONTINUE 07390041 + IVTNUM = 646 07400041 +C 07410041 +C **** TEST 646 **** 07420041 +C 07430041 + IF (ICZERO) 36460, 6460, 36460 07440041 + 6460 CONTINUE 07450041 + IVON01 = -7 07460041 + IVCOMP = IVON01 ** 3 07470041 + GO TO 46460 07480041 +36460 IVDELE = IVDELE + 1 07490041 + WRITE (I02,80003) IVTNUM 07500041 + IF (ICZERO) 46460, 6471, 46460 07510041 +46460 IF (IVCOMP + 343) 26460,16460,26460 07520041 +16460 IVPASS = IVPASS + 1 07530041 + WRITE (I02,80001) IVTNUM 07540041 + GO TO 6471 07550041 +26460 IVFAIL = IVFAIL + 1 07560041 + IVCORR = -343 07570041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07580041 + 6471 CONTINUE 07590041 + IVTNUM = 647 07600041 +C 07610041 +C **** TEST 647 **** 07620041 +C 07630041 + IF (ICZERO) 36470, 6470, 36470 07640041 + 6470 CONTINUE 07650041 + IVON01 = 7 07660041 + IVCOMP = IVON01 ** 4 07670041 + GO TO 46470 07680041 +36470 IVDELE = IVDELE + 1 07690041 + WRITE (I02,80003) IVTNUM 07700041 + IF (ICZERO) 46470, 6481, 46470 07710041 +46470 IF (IVCOMP - 2401) 26470,16470,26470 07720041 +16470 IVPASS = IVPASS + 1 07730041 + WRITE (I02,80001) IVTNUM 07740041 + GO TO 6481 07750041 +26470 IVFAIL = IVFAIL + 1 07760041 + IVCORR = 2401 07770041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07780041 + 6481 CONTINUE 07790041 + IVTNUM = 648 07800041 +C 07810041 +C **** TEST 648 **** 07820041 +C 07830041 + IF (ICZERO) 36480, 6480, 36480 07840041 + 6480 CONTINUE 07850041 + IVON01 = -7 07860041 + IVCOMP = IVON01 ** 4 07870041 + GO TO 46480 07880041 +36480 IVDELE = IVDELE + 1 07890041 + WRITE (I02,80003) IVTNUM 07900041 + IF (ICZERO) 46480, 6491, 46480 07910041 +46480 IF (IVCOMP - 2401) 26480,16480,26480 07920041 +16480 IVPASS = IVPASS + 1 07930041 + WRITE (I02,80001) IVTNUM 07940041 + GO TO 6491 07950041 +26480 IVFAIL = IVFAIL + 1 07960041 + IVCORR = 2401 07970041 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 07980041 + 6491 CONTINUE 07990041 +C *** END OF TESTS *** 08000041 +C 08010041 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08020041 +99999 CONTINUE 08030041 + WRITE (I02,90002) 08040041 + WRITE (I02,90006) 08050041 + WRITE (I02,90002) 08060041 + WRITE (I02,90002) 08070041 + WRITE (I02,90007) 08080041 + WRITE (I02,90002) 08090041 + WRITE (I02,90008) IVFAIL 08100041 + WRITE (I02,90009) IVPASS 08110041 + WRITE (I02,90010) IVDELE 08120041 +C 08130041 +C 08140041 +C TERMINATE ROUTINE EXECUTION 08150041 + STOP 08160041 +C 08170041 +C FORMAT STATEMENTS FOR PAGE HEADERS 08180041 +90000 FORMAT ("1") 08190041 +90002 FORMAT (" ") 08200041 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08210041 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08220041 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08230041 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08240041 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08250041 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08260041 +C 08270041 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08280041 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08290041 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08300041 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08310041 +C 08320041 +C FORMAT STATEMENTS FOR TEST RESULTS 08330041 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08340041 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08350041 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08360041 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08370041 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08380041 +C 08390041 +90007 FORMAT (" ",20X,"END OF PROGRAM FM041" ) 08400041 + END 08410041 diff --git a/Fortran/UnitTests/fcvs21_f95/FM041.reference_output b/Fortran/UnitTests/fcvs21_f95/FM041.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM041.reference_output @@ -0,0 +1,58 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 615 PASS + 616 PASS + 617 PASS + 618 PASS + 619 PASS + 620 PASS + 621 PASS + 622 PASS + 623 PASS + 624 PASS + 625 PASS + 626 PASS + 627 PASS + 628 PASS + 629 PASS + 630 PASS + 631 PASS + 632 PASS + 633 PASS + 634 PASS + 635 PASS + 636 PASS + 637 PASS + 638 PASS + 639 PASS + 640 PASS + 641 PASS + 642 PASS + 643 PASS + 644 PASS + 645 PASS + 646 PASS + 647 PASS + 648 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM041 + + 0 ERRORS ENCOUNTERED + 34 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM042.f b/Fortran/UnitTests/fcvs21_f95/FM042.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM042.f @@ -0,0 +1,876 @@ + PROGRAM FM042 + +C COMMENT SECTION 00010042 +C 00020042 +C FM042 00030042 +C 00040042 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS OF THE 00050042 +C FORM INTEGER VARIABLE = PRIMARY ** PRIMARY 00060042 +C WHERE THE FIRST OF TWO PRIMARIES IS AN INTEGER VARIABLE OR AN 00070042 +C INTEGER CONSTANT AND THE SECOND PRIMARY IS AN INTEGER VARIABLE. 00080042 +C 00090042 +C REFERENCES 00100042 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110042 +C X3.9-1978 00120042 +C 00130042 +C SECTION 4.3, INTEGER TYPE 00140042 +C SECTION 4.3.1, INTEGER CONSTANT 00150042 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00160042 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00170042 +C 00180042 +C 00190042 +C ********************************************************** 00200042 +C 00210042 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00220042 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00230042 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00240042 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00250042 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00260042 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00270042 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00280042 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00290042 +C OF EXECUTING THESE TESTS. 00300042 +C 00310042 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00320042 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00330042 +C 00340042 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00350042 +C 00360042 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00370042 +C SOFTWARE STANDARDS VALIDATION GROUP 00380042 +C BUILDING 225 RM A266 00390042 +C GAITHERSBURG, MD 20899 00400042 +C ********************************************************** 00410042 +C 00420042 +C 00430042 +C 00440042 +C INITIALIZATION SECTION 00450042 +C 00460042 +C INITIALIZE CONSTANTS 00470042 +C ************** 00480042 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00490042 + I01 = 5 00500042 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00510042 + I02 = 6 00520042 +C SYSTEM ENVIRONMENT SECTION 00530042 +C 00540042 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00550042 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00560042 +C (UNIT NUMBER FOR CARD READER). 00570042 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00580042 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00590042 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00600042 +C 00610042 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00620042 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00630042 +C (UNIT NUMBER FOR PRINTER). 00640042 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00650042 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00660042 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00670042 +C 00680042 + IVPASS=0 00690042 + IVFAIL=0 00700042 + IVDELE=0 00710042 + ICZERO=0 00720042 +C 00730042 +C WRITE PAGE HEADERS 00740042 + WRITE (I02,90000) 00750042 + WRITE (I02,90001) 00760042 + WRITE (I02,90002) 00770042 + WRITE (I02, 90002) 00780042 + WRITE (I02,90003) 00790042 + WRITE (I02,90002) 00800042 + WRITE (I02,90004) 00810042 + WRITE (I02,90002) 00820042 + WRITE (I02,90011) 00830042 + WRITE (I02,90002) 00840042 + WRITE (I02,90002) 00850042 + WRITE (I02,90005) 00860042 + WRITE (I02,90006) 00870042 + WRITE (I02,90002) 00880042 +C 00890042 +C TEST SECTION 00900042 +C 00910042 +C ARITHMETIC ASSIGNMENT STATEMENT 00920042 +C 00930042 +C TEST 649 THROUGH TEST 665 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS00940042 +C OF THE FORM INTEGER VARIABLE = INTEGER CONST. ** INTEGER VAR. 00950042 +C 00960042 +C TEST 666 THROUGH TEST 682 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS00970042 +C OF THE FORM INTEGER VARIABLE = INTEGER VAR. ** INTEGER VAR. 00980042 +C 00990042 +C 01000042 + IVTNUM = 649 01010042 +C 01020042 +C **** TEST 649 **** 01030042 +C TEST 649 - SMALL NUMBER BASE; ZERO EXPONENT 01040042 +C 01050042 + IF (ICZERO) 36490, 6490, 36490 01060042 + 6490 CONTINUE 01070042 + IVON01 = 0 01080042 + IVCOMP = 1 ** IVON01 01090042 + GO TO 46490 01100042 +36490 IVDELE = IVDELE + 1 01110042 + WRITE (I02,80003) IVTNUM 01120042 + IF (ICZERO) 46490, 6501, 46490 01130042 +46490 IF (IVCOMP - 1) 26490,16490,26490 01140042 +16490 IVPASS = IVPASS + 1 01150042 + WRITE (I02,80001) IVTNUM 01160042 + GO TO 6501 01170042 +26490 IVFAIL = IVFAIL + 1 01180042 + IVCORR = 1 01190042 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01200042 + 6501 CONTINUE 01210042 + IVTNUM = 650 01220042 +C 01230042 +C **** TEST 650 **** 01240042 +C TEST 650 - ZERO BASE TO FIRST POWER 01250042 +C 01260042 + IF (ICZERO) 36500, 6500, 36500 01270042 + 6500 CONTINUE 01280042 + IVON01 = 1 01290042 + IVCOMP = 0 ** IVON01 01300042 + GO TO 46500 01310042 +36500 IVDELE = IVDELE + 1 01320042 + WRITE (I02,80003) IVTNUM 01330042 + IF (ICZERO) 46500, 6511, 46500 01340042 +46500 IF (IVCOMP) 26500,16500,26500 01350042 +16500 IVPASS = IVPASS + 1 01360042 + WRITE (I02,80001) IVTNUM 01370042 + GO TO 6511 01380042 +26500 IVFAIL = IVFAIL + 1 01390042 + IVCORR = 0 01400042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01410042 + 6511 CONTINUE 01420042 + IVTNUM = 651 01430042 +C 01440042 +C **** TEST 651 **** 01450042 +C TEST 651 - BASE =1; EXPONENT = 1 01460042 +C 01470042 + IF (ICZERO) 36510, 6510, 36510 01480042 + 6510 CONTINUE 01490042 + IVON01 = 1 01500042 + IVCOMP = 1 ** IVON01 01510042 + GO TO 46510 01520042 +36510 IVDELE = IVDELE + 1 01530042 + WRITE (I02,80003) IVTNUM 01540042 + IF (ICZERO) 46510, 6521, 46510 01550042 +46510 IF (IVCOMP - 1) 26510,16510,26510 01560042 +16510 IVPASS = IVPASS + 1 01570042 + WRITE (I02,80001) IVTNUM 01580042 + GO TO 6521 01590042 +26510 IVFAIL = IVFAIL + 1 01600042 + IVCORR = 1 01610042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01620042 + 6521 CONTINUE 01630042 + IVTNUM = 652 01640042 +C 01650042 +C **** TEST 652 **** 01660042 +C TEST 652 - LARGE EXPONENT 01670042 +C 01680042 + IF (ICZERO) 36520, 6520, 36520 01690042 + 6520 CONTINUE 01700042 + IVON01 = 32767 01710042 + IVCOMP = 1 ** IVON01 01720042 + GO TO 46520 01730042 +36520 IVDELE = IVDELE + 1 01740042 + WRITE (I02,80003) IVTNUM 01750042 + IF (ICZERO) 46520, 6531, 46520 01760042 +46520 IF (IVCOMP - 1) 26520,16520,26520 01770042 +16520 IVPASS = IVPASS + 1 01780042 + WRITE (I02,80001) IVTNUM 01790042 + GO TO 6531 01800042 +26520 IVFAIL = IVFAIL + 1 01810042 + IVCORR = 1 01820042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01830042 + 6531 CONTINUE 01840042 + IVTNUM = 653 01850042 +C 01860042 +C **** TEST 653 **** 01870042 +C TEST 653 - LARGE NUMBER BASE; EXPONENT = 1 01880042 +C 01890042 + IF (ICZERO) 36530, 6530, 36530 01900042 + 6530 CONTINUE 01910042 + IVON01 = 1 01920042 + IVCOMP = 32767 ** IVON01 01930042 + GO TO 46530 01940042 +36530 IVDELE = IVDELE + 1 01950042 + WRITE (I02,80003) IVTNUM 01960042 + IF (ICZERO) 46530, 6541, 46530 01970042 +46530 IF (IVCOMP - 32767) 26530,16530,26530 01980042 +16530 IVPASS = IVPASS + 1 01990042 + WRITE (I02,80001) IVTNUM 02000042 + GO TO 6541 02010042 +26530 IVFAIL = IVFAIL + 1 02020042 + IVCORR = 32767 02030042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02040042 + 6541 CONTINUE 02050042 + IVTNUM = 654 02060042 +C 02070042 +C **** TEST 654 **** 02080042 +C TEST 654 - ZERO BASE; LARGE NUMBER EXPONENT 02090042 +C 02100042 + IF (ICZERO) 36540, 6540, 36540 02110042 + 6540 CONTINUE 02120042 + IVON01 = 32767 02130042 + IVCOMP = 0 ** IVON01 02140042 + GO TO 46540 02150042 +36540 IVDELE = IVDELE + 1 02160042 + WRITE (I02,80003) IVTNUM 02170042 + IF (ICZERO) 46540, 6551, 46540 02180042 +46540 IF (IVCOMP) 26540,16540,26540 02190042 +16540 IVPASS = IVPASS + 1 02200042 + WRITE (I02,80001) IVTNUM 02210042 + GO TO 6551 02220042 +26540 IVFAIL = IVFAIL + 1 02230042 + IVCORR = 0 02240042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02250042 + 6551 CONTINUE 02260042 + IVTNUM = 655 02270042 +C 02280042 +C **** TEST 655 **** 02290042 +C TEST 655 -LARGE NUMBER BASE; ZERO EXPONENT 02300042 +C 02310042 + IF (ICZERO) 36550, 6550, 36550 02320042 + 6550 CONTINUE 02330042 + IVON01 = 0 02340042 + IVCOMP = 32767 ** IVON01 02350042 + GO TO 46550 02360042 +36550 IVDELE = IVDELE + 1 02370042 + WRITE (I02,80003) IVTNUM 02380042 + IF (ICZERO) 46550, 6561, 46550 02390042 +46550 IF (IVCOMP -1) 26550,16550,26550 02400042 +16550 IVPASS = IVPASS + 1 02410042 + WRITE (I02,80001) IVTNUM 02420042 + GO TO 6561 02430042 +26550 IVFAIL = IVFAIL + 1 02440042 + IVCORR = 1 02450042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02460042 + 6561 CONTINUE 02470042 + IVTNUM = 656 02480042 +C 02490042 +C **** TEST 656 **** 02500042 +C TEST 656 -EXPONENT IS POWER OF TWO 02510042 +C 02520042 + IF (ICZERO) 36560, 6560, 36560 02530042 + 6560 CONTINUE 02540042 + IVON01 = 2 02550042 + IVCOMP = 181 ** IVON01 02560042 + GO TO 46560 02570042 +36560 IVDELE = IVDELE + 1 02580042 + WRITE (I02,80003) IVTNUM 02590042 + IF (ICZERO) 46560, 6571, 46560 02600042 +46560 IF (IVCOMP - 32761) 26560,16560,26560 02610042 +16560 IVPASS = IVPASS + 1 02620042 + WRITE (I02,80001) IVTNUM 02630042 + GO TO 6571 02640042 +26560 IVFAIL = IVFAIL + 1 02650042 + IVCORR = 32761 02660042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02670042 + 6571 CONTINUE 02680042 + IVTNUM = 657 02690042 +C 02700042 +C **** TEST 657 **** 02710042 +C TEST 657 - BASE AND EXPONENT ARE BOTH POWERS OF TWO 02720042 +C 02730042 + IF (ICZERO) 36570, 6570, 36570 02740042 + 6570 CONTINUE 02750042 + IVON01 = 8 02760042 + IVCOMP = 2 ** IVON01 02770042 + GO TO 46570 02780042 +36570 IVDELE = IVDELE + 1 02790042 + WRITE (I02,80003) IVTNUM 02800042 + IF (ICZERO) 46570, 6581, 46570 02810042 +46570 IF (IVCOMP - 256) 26570,16570,26560 02820042 +16570 IVPASS = IVPASS + 1 02830042 + WRITE (I02,80001) IVTNUM 02840042 + GO TO 6581 02850042 +26570 IVFAIL = IVFAIL + 1 02860042 + IVCORR = 256 02870042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02880042 + 6581 CONTINUE 02890042 +C 02900042 +C TESTS 658 AND 659 TEST TO ENSURE EXPONENTIATION OPERATOR IS 02910042 +C NOT COMMUTATIVE 02920042 +C 02930042 + IVTNUM = 658 02940042 +C 02950042 +C **** TEST 658 **** 02960042 +C 02970042 + IF (ICZERO) 36580, 6580, 36580 02980042 + 6580 CONTINUE 02990042 + IVON01 = 9 03000042 + IVCOMP = 3 ** IVON01 03010042 + GO TO 46580 03020042 +36580 IVDELE = IVDELE + 1 03030042 + WRITE (I02,80003) IVTNUM 03040042 + IF (ICZERO) 46580, 6591, 46580 03050042 +46580 IF (IVCOMP - 19683) 26580,16580,26580 03060042 +16580 IVPASS = IVPASS + 1 03070042 + WRITE (I02,80001) IVTNUM 03080042 + GO TO 6591 03090042 +26580 IVFAIL = IVFAIL + 1 03100042 + IVCORR = 19683 03110042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03120042 + 6591 CONTINUE 03130042 + IVTNUM = 659 03140042 +C 03150042 +C **** TEST 659 **** 03160042 +C 03170042 + IF (ICZERO) 36590, 6590, 36590 03180042 + 6590 CONTINUE 03190042 + IVON01 = 3 03200042 + IVCOMP = 9 ** IVON01 03210042 + GO TO 46590 03220042 +36590 IVDELE = IVDELE + 1 03230042 + WRITE (I02,80003) IVTNUM 03240042 + IF (ICZERO) 46590, 6601, 46590 03250042 +46590 IF (IVCOMP - 729) 26590,16590,26590 03260042 +16590 IVPASS = IVPASS + 1 03270042 + WRITE (I02,80001) IVTNUM 03280042 + GO TO 6601 03290042 +26590 IVFAIL = IVFAIL + 1 03300042 + IVCORR = 729 03310042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03320042 + 6601 CONTINUE 03330042 +C 03340042 +C TESTS 660 THROUGH 665 TEST POSITIVE AND NEGATIVE BASES TO POSITIVE03350042 +C ODD AND EVEN NUMBER POWERS CHECKING THE SIGN03360042 +C OF THE RESULTS 03370042 +C 03380042 + IVTNUM = 660 03390042 +C 03400042 +C **** TEST 660 **** 03410042 +C 03420042 + IF (ICZERO) 36600, 6600, 36600 03430042 + 6600 CONTINUE 03440042 + IVON01 = 2 03450042 + IVCOMP = 1 ** IVON01 03460042 + GO TO 46600 03470042 +36600 IVDELE = IVDELE + 1 03480042 + WRITE (I02,80003) IVTNUM 03490042 + IF (ICZERO) 46600, 6611, 46600 03500042 +46600 IF (IVCOMP - 1) 26600,16600,26600 03510042 +16600 IVPASS = IVPASS + 1 03520042 + WRITE (I02,80001) IVTNUM 03530042 + GO TO 6611 03540042 +26600 IVFAIL = IVFAIL + 1 03550042 + IVCORR = 1 03560042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03570042 + 6611 CONTINUE 03580042 + IVTNUM = 661 03590042 +C 03600042 +C **** TEST 661 **** 03610042 +C 03620042 + IF (ICZERO) 36610, 6610, 36610 03630042 + 6610 CONTINUE 03640042 + IVON01 = 2 03650042 + IVCOMP = ( -1) ** IVON01 03660042 + GO TO 46610 03670042 +36610 IVDELE = IVDELE + 1 03680042 + WRITE (I02,80003) IVTNUM 03690042 + IF (ICZERO) 46610, 6621, 46610 03700042 +46610 IF (IVCOMP - 1) 26610,16610,26610 03710042 +16610 IVPASS = IVPASS + 1 03720042 + WRITE (I02,80001) IVTNUM 03730042 + GO TO 6621 03740042 +26610 IVFAIL = IVFAIL + 1 03750042 + IVCORR = 1 03760042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03770042 + 6621 CONTINUE 03780042 + IVTNUM = 662 03790042 +C 03800042 +C **** TEST 662 **** 03810042 +C 03820042 + IF (ICZERO) 36620, 6620, 36620 03830042 + 6620 CONTINUE 03840042 + IVON01 = 3 03850042 + IVCOMP = 7 ** IVON01 03860042 + GO TO 46620 03870042 +36620 IVDELE = IVDELE + 1 03880042 + WRITE (I02,80003) IVTNUM 03890042 + IF (ICZERO) 46620, 6631, 46620 03900042 +46620 IF (IVCOMP - 343) 26620,16620,26620 03910042 +16620 IVPASS = IVPASS + 1 03920042 + WRITE (I02,80001) IVTNUM 03930042 + GO TO 6631 03940042 +26620 IVFAIL = IVFAIL + 1 03950042 + IVCORR = 343 03960042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03970042 + 6631 CONTINUE 03980042 + IVTNUM = 663 03990042 +C 04000042 +C **** TEST 663 **** 04010042 +C 04020042 + IF (ICZERO) 36630, 6630, 36630 04030042 + 6630 CONTINUE 04040042 + IVON01 = 3 04050042 + IVCOMP = (-7) **IVON01 04060042 + GO TO 46630 04070042 +36630 IVDELE = IVDELE + 1 04080042 + WRITE (I02,80003) IVTNUM 04090042 + IF (ICZERO) 46630, 6641, 46630 04100042 +46630 IF (IVCOMP + 343) 26630,16630,26630 04110042 +16630 IVPASS = IVPASS + 1 04120042 + WRITE (I02,80001) IVTNUM 04130042 + GO TO 6641 04140042 +26630 IVFAIL = IVFAIL + 1 04150042 + IVCORR = -343 04160042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04170042 + 6641 CONTINUE 04180042 + IVTNUM = 664 04190042 +C 04200042 +C **** TEST 664 **** 04210042 +C 04220042 + IF (ICZERO) 36640, 6640, 36640 04230042 + 6640 CONTINUE 04240042 + IVON01 = 4 04250042 + IVCOMP = 7 ** IVON01 04260042 + GO TO 46640 04270042 +36640 IVDELE = IVDELE + 1 04280042 + WRITE (I02,80003) IVTNUM 04290042 + IF (ICZERO) 46640, 6651, 46640 04300042 +46640 IF (IVCOMP - 2401) 26640,16640,26640 04310042 +16640 IVPASS = IVPASS + 1 04320042 + WRITE (I02,80001) IVTNUM 04330042 + GO TO 6651 04340042 +26640 IVFAIL = IVFAIL + 1 04350042 + IVCORR = 2401 04360042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04370042 + 6651 CONTINUE 04380042 + IVTNUM = 665 04390042 +C 04400042 +C **** TEST 665 **** 04410042 +C 04420042 + IF (ICZERO) 36650, 6650, 36650 04430042 + 6650 CONTINUE 04440042 + IVON01 = 4 04450042 + IVCOMP = (-7) ** IVON01 04460042 + GO TO 46650 04470042 +36650 IVDELE = IVDELE + 1 04480042 + WRITE (I02,80003) IVTNUM 04490042 + IF (ICZERO) 46650, 6661, 46650 04500042 +46650 IF (IVCOMP - 2401) 26650,16650,26650 04510042 +16650 IVPASS = IVPASS + 1 04520042 + WRITE (I02,80001) IVTNUM 04530042 + GO TO 6661 04540042 +26650 IVFAIL = IVFAIL + 1 04550042 + IVCORR = 2401 04560042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04570042 + 6661 CONTINUE 04580042 + IVTNUM = 666 04590042 +C 04600042 +C **** TEST 666 **** 04610042 +C TEST 666 - SMALL NUMBER BASE; ZERO EXPONENT 04620042 +C 04630042 + IF (ICZERO) 36660, 6660, 36660 04640042 + 6660 CONTINUE 04650042 + IVON01 = 1 04660042 + IVON02 = 0 04670042 + IVCOMP = IVON01 ** IVON02 04680042 + GO TO 46660 04690042 +36660 IVDELE = IVDELE + 1 04700042 + WRITE (I02,80003) IVTNUM 04710042 + IF (ICZERO) 46660, 6671, 46660 04720042 +46660 IF (IVCOMP - 1) 26660,16660,26660 04730042 +16660 IVPASS = IVPASS + 1 04740042 + WRITE (I02,80001) IVTNUM 04750042 + GO TO 6671 04760042 +26660 IVFAIL = IVFAIL + 1 04770042 + IVCORR = 1 04780042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04790042 + 6671 CONTINUE 04800042 + IVTNUM = 667 04810042 +C 04820042 +C **** TEST 667 **** 04830042 +C TEST 667 - ZERO BASE TO FIRST POWER 04840042 +C 04850042 + IF (ICZERO) 36670, 6670, 36670 04860042 + 6670 CONTINUE 04870042 + IVON01 = 0 04880042 + IVON02 = 1 04890042 + IVCOMP = IVON01 ** IVON02 04900042 + GO TO 46670 04910042 +36670 IVDELE = IVDELE + 1 04920042 + WRITE (I02,80003) IVTNUM 04930042 + IF (ICZERO) 46670, 6681, 46670 04940042 +46670 IF (IVCOMP) 26670,16670,26670 04950042 +16670 IVPASS = IVPASS + 1 04960042 + WRITE (I02,80001) IVTNUM 04970042 + GO TO 6681 04980042 +26670 IVFAIL = IVFAIL + 1 04990042 + IVCORR = 0 05000042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05010042 + 6681 CONTINUE 05020042 + IVTNUM = 668 05030042 +C 05040042 +C **** TEST 668 **** 05050042 +C TEST 668 - BASE =1; EXPONENT = 1 05060042 +C 05070042 + IF (ICZERO) 36680, 6680, 36680 05080042 + 6680 CONTINUE 05090042 + IVON01 = 1 05100042 + IVON02 = 1 05110042 + IVCOMP = IVON01 ** IVON02 05120042 + GO TO 46680 05130042 +36680 IVDELE = IVDELE + 1 05140042 + WRITE (I02,80003) IVTNUM 05150042 + IF (ICZERO) 46680, 6691, 46680 05160042 +46680 IF (IVCOMP - 1) 26680,16680,26680 05170042 +16680 IVPASS = IVPASS + 1 05180042 + WRITE (I02,80001) IVTNUM 05190042 + GO TO 6691 05200042 +26680 IVFAIL = IVFAIL + 1 05210042 + IVCORR = 1 05220042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05230042 + 6691 CONTINUE 05240042 + IVTNUM = 669 05250042 +C 05260042 +C **** TEST 669 **** 05270042 +C TEST 669 - LARGE EXPONENT 05280042 +C 05290042 + IF (ICZERO) 36690, 6690, 36690 05300042 + 6690 CONTINUE 05310042 + IVON01 = 1 05320042 + IVON02 = 32767 05330042 + IVCOMP = IVON01 ** IVON02 05340042 + GO TO 46690 05350042 +36690 IVDELE = IVDELE + 1 05360042 + WRITE (I02,80003) IVTNUM 05370042 + IF (ICZERO) 46690, 6701, 46690 05380042 +46690 IF (IVCOMP - 1) 26690,16690,26690 05390042 +16690 IVPASS = IVPASS + 1 05400042 + WRITE (I02,80001) IVTNUM 05410042 + GO TO 6701 05420042 +26690 IVFAIL = IVFAIL + 1 05430042 + IVCORR = 1 05440042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05450042 + 6701 CONTINUE 05460042 + IVTNUM = 670 05470042 +C 05480042 +C **** TEST 670 **** 05490042 +C TEST 670 - LARGE NUMBER BASE; EXPONENT = 1 05500042 +C 05510042 + IF (ICZERO) 36700, 6700, 36700 05520042 + 6700 CONTINUE 05530042 + IVON01 = 32767 05540042 + IVON02 = 1 05550042 + IVCOMP = IVON01 ** IVON02 05560042 + GO TO 46700 05570042 +36700 IVDELE = IVDELE + 1 05580042 + WRITE (I02,80003) IVTNUM 05590042 + IF (ICZERO) 46700, 6711, 46700 05600042 +46700 IF (IVCOMP - 32767) 26700,16700,26700 05610042 +16700 IVPASS = IVPASS + 1 05620042 + WRITE (I02,80001) IVTNUM 05630042 + GO TO 6711 05640042 +26700 IVFAIL = IVFAIL + 1 05650042 + IVCORR = 32767 05660042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05670042 + 6711 CONTINUE 05680042 + IVTNUM = 671 05690042 +C 05700042 +C **** TEST 671 **** 05710042 +C TEST 671 - ZERO BASE; LARGE NUMBER EXPONENT 05720042 +C 05730042 + IF (ICZERO) 36710, 6710, 36710 05740042 + 6710 CONTINUE 05750042 + IVON01 = 0 05760042 + IVON02 = 32767 05770042 + IVCOMP = IVON01 ** IVON02 05780042 + GO TO 46710 05790042 +36710 IVDELE = IVDELE + 1 05800042 + WRITE (I02,80003) IVTNUM 05810042 + IF (ICZERO) 46710, 6721, 46710 05820042 +46710 IF (IVCOMP) 26710,16710,26710 05830042 +16710 IVPASS = IVPASS + 1 05840042 + WRITE (I02,80001) IVTNUM 05850042 + GO TO 6721 05860042 +26710 IVFAIL = IVFAIL + 1 05870042 + IVCORR = 0 05880042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05890042 + 6721 CONTINUE 05900042 + IVTNUM = 672 05910042 +C 05920042 +C **** TEST 672 **** 05930042 +C TEST 672 -LARGE NUMBER BASE; ZERO EXPONENT 05940042 +C 05950042 + IF (ICZERO) 36720, 6720, 36720 05960042 + 6720 CONTINUE 05970042 + IVON01 = 32767 05980042 + IVON02 = 0 05990042 + IVCOMP = IVON01 ** IVON02 06000042 + GO TO 46720 06010042 +36720 IVDELE = IVDELE + 1 06020042 + WRITE (I02,80003) IVTNUM 06030042 + IF (ICZERO) 46720, 6731, 46720 06040042 +46720 IF (IVCOMP -1) 26720,16720,26720 06050042 +16720 IVPASS = IVPASS + 1 06060042 + WRITE (I02,80001) IVTNUM 06070042 + GO TO 6731 06080042 +26720 IVFAIL = IVFAIL + 1 06090042 + IVCORR = 1 06100042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06110042 + 6731 CONTINUE 06120042 + IVTNUM = 673 06130042 +C 06140042 +C **** TEST 673 **** 06150042 +C TEST 673 -EXPONENT IS POWER OF TWO 06160042 +C 06170042 + IF (ICZERO) 36730, 6730, 36730 06180042 + 6730 CONTINUE 06190042 + IVON01 = 181 06200042 + IVON02 = 2 06210042 + IVCOMP = IVON01 ** IVON02 06220042 + GO TO 46730 06230042 +36730 IVDELE = IVDELE + 1 06240042 + WRITE (I02,80003) IVTNUM 06250042 + IF (ICZERO) 46730, 6741, 46730 06260042 +46730 IF (IVCOMP - 32761) 26730,16730,26730 06270042 +16730 IVPASS = IVPASS + 1 06280042 + WRITE (I02,80001) IVTNUM 06290042 + GO TO 6741 06300042 +26730 IVFAIL = IVFAIL + 1 06310042 + IVCORR = 32761 06320042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06330042 + 6741 CONTINUE 06340042 + IVTNUM = 674 06350042 +C 06360042 +C **** TEST 674 **** 06370042 +C TEST 674 - BASE AND EXPONENT ARE BOTH POWERS OF TWO 06380042 +C 06390042 + IF (ICZERO) 36740, 6740, 36740 06400042 + 6740 CONTINUE 06410042 + IVON01 = 2 06420042 + IVON02 = 8 06430042 + IVCOMP = IVON01 ** IVON02 06440042 + GO TO 46740 06450042 +36740 IVDELE = IVDELE + 1 06460042 + WRITE (I02,80003) IVTNUM 06470042 + IF (ICZERO) 46740, 6751, 46740 06480042 +46740 IF (IVCOMP - 256) 26740,16740,26740 06490042 +16740 IVPASS = IVPASS + 1 06500042 + WRITE (I02,80001) IVTNUM 06510042 + GO TO 6751 06520042 +26740 IVFAIL = IVFAIL + 1 06530042 + IVCORR = 256 06540042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06550042 + 6751 CONTINUE 06560042 +C 06570042 +C TESTS 675 AND 676 TEST TO ENSURE EXPONENTIATION OPERATOR IS 06580042 +C NOT COMMUTATIVE 06590042 +C 06600042 + IVTNUM = 675 06610042 +C 06620042 +C **** TEST 675 **** 06630042 +C 06640042 + IF (ICZERO) 36750, 6750, 36750 06650042 + 6750 CONTINUE 06660042 + IVON01 = 3 06670042 + IVON02 = 9 06680042 + IVCOMP = IVON01 ** IVON02 06690042 + GO TO 46750 06700042 +36750 IVDELE = IVDELE + 1 06710042 + WRITE (I02,80003) IVTNUM 06720042 + IF (ICZERO) 46750, 6761, 46750 06730042 +46750 IF (IVCOMP - 19683) 26750,16750,26750 06740042 +16750 IVPASS = IVPASS + 1 06750042 + WRITE (I02,80001) IVTNUM 06760042 + GO TO 6761 06770042 +26750 IVFAIL = IVFAIL + 1 06780042 + IVCORR = 19683 06790042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06800042 + 6761 CONTINUE 06810042 + IVTNUM = 676 06820042 +C 06830042 +C **** TEST 676 **** 06840042 +C 06850042 + IF (ICZERO) 36760, 6760, 36760 06860042 + 6760 CONTINUE 06870042 + IVON01 = 9 06880042 + IVON02 = 3 06890042 + IVCOMP = IVON01 ** IVON02 06900042 + GO TO 46760 06910042 +36760 IVDELE = IVDELE + 1 06920042 + WRITE (I02,80003) IVTNUM 06930042 + IF (ICZERO) 46760, 6771, 46760 06940042 +46760 IF (IVCOMP - 729) 26760,16760,26760 06950042 +16760 IVPASS = IVPASS + 1 06960042 + WRITE (I02,80001) IVTNUM 06970042 + GO TO 6771 06980042 +26760 IVFAIL = IVFAIL + 1 06990042 + IVCORR = 729 07000042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07010042 + 6771 CONTINUE 07020042 +C 07030042 +C TESTS 677 THROUGH 682 TEST POSITIVE AND NEGATIVE BASES TO POSITIVE07040042 +C ODD AND EVEN NUMBER POWERS CHECKING THE SIGN07050042 +C OF THE RESULTS 07060042 +C 07070042 + IVTNUM = 677 07080042 +C 07090042 +C **** TEST 677 **** 07100042 +C 07110042 + IF (ICZERO) 36770, 6770, 36770 07120042 + 6770 CONTINUE 07130042 + IVON01 = 1 07140042 + IVON02 = 2 07150042 + IVCOMP = IVON01 ** IVON02 07160042 + GO TO 46770 07170042 +36770 IVDELE = IVDELE + 1 07180042 + WRITE (I02,80003) IVTNUM 07190042 + IF (ICZERO) 46770, 6781, 46770 07200042 +46770 IF (IVCOMP - 1) 26770,16770,26770 07210042 +16770 IVPASS = IVPASS + 1 07220042 + WRITE (I02,80001) IVTNUM 07230042 + GO TO 6781 07240042 +26770 IVFAIL = IVFAIL + 1 07250042 + IVCORR = 1 07260042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07270042 + 6781 CONTINUE 07280042 + IVTNUM = 678 07290042 +C 07300042 +C **** TEST 678 **** 07310042 +C 07320042 + IF (ICZERO) 36780, 6780, 36780 07330042 + 6780 CONTINUE 07340042 + IVON01 = -1 07350042 + IVON02 = 2 07360042 + IVCOMP = IVON01 ** IVON02 07370042 + GO TO 46780 07380042 +36780 IVDELE = IVDELE + 1 07390042 + WRITE (I02,80003) IVTNUM 07400042 + IF (ICZERO) 46780, 6791, 46780 07410042 +46780 IF (IVCOMP - 1) 26780,16780,26780 07420042 +16780 IVPASS = IVPASS + 1 07430042 + WRITE (I02,80001) IVTNUM 07440042 + GO TO 6791 07450042 +26780 IVFAIL = IVFAIL + 1 07460042 + IVCORR = 1 07470042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07480042 + 6791 CONTINUE 07490042 + IVTNUM = 679 07500042 +C 07510042 +C **** TEST 679 **** 07520042 +C 07530042 + IF (ICZERO) 36790, 6790, 36790 07540042 + 6790 CONTINUE 07550042 + IVON01 = 7 07560042 + IVON02 = 3 07570042 + IVCOMP = IVON01 ** IVON02 07580042 + GO TO 46790 07590042 +36790 IVDELE = IVDELE + 1 07600042 + WRITE (I02,80003) IVTNUM 07610042 + IF (ICZERO) 46790, 6801, 46790 07620042 +46790 IF (IVCOMP - 343) 26790,16790,26790 07630042 +16790 IVPASS = IVPASS + 1 07640042 + WRITE (I02,80001) IVTNUM 07650042 + GO TO 6801 07660042 +26790 IVFAIL = IVFAIL + 1 07670042 + IVCORR = 343 07680042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07690042 + 6801 CONTINUE 07700042 + IVTNUM = 680 07710042 +C 07720042 +C **** TEST 680 **** 07730042 +C 07740042 + IF (ICZERO) 36800, 6800, 36800 07750042 + 6800 CONTINUE 07760042 + IVON01 = -7 07770042 + IVON02 = 3 07780042 + IVCOMP = IVON01 ** IVON02 07790042 + GO TO 46800 07800042 +36800 IVDELE = IVDELE + 1 07810042 + WRITE (I02,80003) IVTNUM 07820042 + IF (ICZERO) 46800, 6811, 46800 07830042 +46800 IF (IVCOMP + 343) 26800,16800,26800 07840042 +16800 IVPASS = IVPASS + 1 07850042 + WRITE (I02,80001) IVTNUM 07860042 + GO TO 6811 07870042 +26800 IVFAIL = IVFAIL + 1 07880042 + IVCORR = -343 07890042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07900042 + 6811 CONTINUE 07910042 + IVTNUM = 681 07920042 +C 07930042 +C **** TEST 681 **** 07940042 +C 07950042 + IF (ICZERO) 36810, 6810, 36810 07960042 + 6810 CONTINUE 07970042 + IVON01 = 7 07980042 + IVON02 = 4 07990042 + IVCOMP = IVON01 ** IVON02 08000042 + GO TO 46810 08010042 +36810 IVDELE = IVDELE + 1 08020042 + WRITE (I02,80003) IVTNUM 08030042 + IF (ICZERO) 46810, 6821, 46810 08040042 +46810 IF (IVCOMP - 2401) 26810,16810,26810 08050042 +16810 IVPASS = IVPASS + 1 08060042 + WRITE (I02,80001) IVTNUM 08070042 + GO TO 6821 08080042 +26810 IVFAIL = IVFAIL + 1 08090042 + IVCORR = 2401 08100042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 08110042 + 6821 CONTINUE 08120042 + IVTNUM = 682 08130042 +C 08140042 +C **** TEST 682 **** 08150042 +C 08160042 + IF (ICZERO) 36820, 6820, 36820 08170042 + 6820 CONTINUE 08180042 + IVON01 = -7 08190042 + IVON02 = 4 08200042 + IVCOMP = IVON01 ** IVON02 08210042 + GO TO 46820 08220042 +36820 IVDELE = IVDELE + 1 08230042 + WRITE (I02,80003) IVTNUM 08240042 + IF (ICZERO) 46820, 6831, 46820 08250042 +46820 IF (IVCOMP - 2401) 26820,16820,26820 08260042 +16820 IVPASS = IVPASS + 1 08270042 + WRITE (I02,80001) IVTNUM 08280042 + GO TO 6831 08290042 +26820 IVFAIL = IVFAIL + 1 08300042 + IVCORR = 2401 08310042 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 08320042 + 6831 CONTINUE 08330042 +C 08340042 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08350042 +99999 CONTINUE 08360042 + WRITE (I02,90002) 08370042 + WRITE (I02,90006) 08380042 + WRITE (I02,90002) 08390042 + WRITE (I02,90002) 08400042 + WRITE (I02,90007) 08410042 + WRITE (I02,90002) 08420042 + WRITE (I02,90008) IVFAIL 08430042 + WRITE (I02,90009) IVPASS 08440042 + WRITE (I02,90010) IVDELE 08450042 +C 08460042 +C 08470042 +C TERMINATE ROUTINE EXECUTION 08480042 + STOP 08490042 +C 08500042 +C FORMAT STATEMENTS FOR PAGE HEADERS 08510042 +90000 FORMAT ("1") 08520042 +90002 FORMAT (" ") 08530042 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08540042 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08550042 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08560042 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08570042 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08580042 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08590042 +C 08600042 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08610042 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08620042 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08630042 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08640042 +C 08650042 +C FORMAT STATEMENTS FOR TEST RESULTS 08660042 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08670042 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08680042 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08690042 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08700042 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08710042 +C 08720042 +90007 FORMAT (" ",20X,"END OF PROGRAM FM042" ) 08730042 + END 08740042 diff --git a/Fortran/UnitTests/fcvs21_f95/FM042.reference_output b/Fortran/UnitTests/fcvs21_f95/FM042.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM042.reference_output @@ -0,0 +1,58 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 649 PASS + 650 PASS + 651 PASS + 652 PASS + 653 PASS + 654 PASS + 655 PASS + 656 PASS + 657 PASS + 658 PASS + 659 PASS + 660 PASS + 661 PASS + 662 PASS + 663 PASS + 664 PASS + 665 PASS + 666 PASS + 667 PASS + 668 PASS + 669 PASS + 670 PASS + 671 PASS + 672 PASS + 673 PASS + 674 PASS + 675 PASS + 676 PASS + 677 PASS + 678 PASS + 679 PASS + 680 PASS + 681 PASS + 682 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM042 + + 0 ERRORS ENCOUNTERED + 34 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM043.f b/Fortran/UnitTests/fcvs21_f95/FM043.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM043.f @@ -0,0 +1,977 @@ + PROGRAM FM043 + +C COMMENT SECTION 00010043 +C 00020043 +C FM043 00030043 +C 00040043 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS OF THE FORM 00050043 +C 00060043 +C INTEGER VAR. = INTEGER VAR. INTEGER VAR. INTEGER VAR. 00070043 +C 00080043 +C WHERE AND ARE ARITHMETIC OPERATORS, BUT IS 00090043 +C NOT THE SAME AS . 00100043 +C 00110043 +C REFERENCES 00120043 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130043 +C X3.9-1978 00140043 +C 00150043 +C SECTION 4.3, INTEGER TYPE 00160043 +C SECTION 4.3.1, INTEGER CONSTANT 00170043 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00180043 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00190043 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00200043 +C 00210043 +C 00220043 +C ********************************************************** 00230043 +C 00240043 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00250043 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00260043 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00270043 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00280043 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00290043 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00300043 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00310043 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00320043 +C OF EXECUTING THESE TESTS. 00330043 +C 00340043 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00350043 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00360043 +C 00370043 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00380043 +C 00390043 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00400043 +C SOFTWARE STANDARDS VALIDATION GROUP 00410043 +C BUILDING 225 RM A266 00420043 +C GAITHERSBURG, MD 20899 00430043 +C ********************************************************** 00440043 +C 00450043 +C 00460043 +C 00470043 +C INITIALIZATION SECTION 00480043 +C 00490043 +C INITIALIZE CONSTANTS 00500043 +C ************** 00510043 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00520043 + I01 = 5 00530043 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00540043 + I02 = 6 00550043 +C SYSTEM ENVIRONMENT SECTION 00560043 +C 00570043 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00580043 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00590043 +C (UNIT NUMBER FOR CARD READER). 00600043 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00610043 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00620043 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00630043 +C 00640043 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00650043 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00660043 +C (UNIT NUMBER FOR PRINTER). 00670043 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00680043 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00690043 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00700043 +C 00710043 + IVPASS=0 00720043 + IVFAIL=0 00730043 + IVDELE=0 00740043 + ICZERO=0 00750043 +C 00760043 +C WRITE PAGE HEADERS 00770043 + WRITE (I02,90000) 00780043 + WRITE (I02,90001) 00790043 + WRITE (I02,90002) 00800043 + WRITE (I02, 90002) 00810043 + WRITE (I02,90003) 00820043 + WRITE (I02,90002) 00830043 + WRITE (I02,90004) 00840043 + WRITE (I02,90002) 00850043 + WRITE (I02,90011) 00860043 + WRITE (I02,90002) 00870043 + WRITE (I02,90002) 00880043 + WRITE (I02,90005) 00890043 + WRITE (I02,90006) 00900043 + WRITE (I02,90002) 00910043 +C 00920043 +C TEST SECTION 00930043 +C 00940043 +C ARITHMETIC ASSIGNMENT STATEMENT 00950043 +C 00960043 +C TESTS 683 THROUGH 694 TEST STATEMENTS WHERE IS '+' AND 00970043 +C VARIES. 00980043 +C 00990043 +C TEST 695 THROUGH 706 TEST STATEMENTS WHERE IS '-' AND 01000043 +C VARIES. 01010043 +C 01020043 +C TESTS 707 THROUGH 718 TEST STATEMENTS WHERE IS '*' AND 01030043 +C VARIES. 01040043 +C 01050043 +C 01060043 +C 01070043 +C TESTS 683 THROUGH 685 TEST '+' FOLLOWED BY '-'. 01080043 +C 01090043 + IVTNUM = 683 01100043 +C 01110043 +C **** TEST 683 **** 01120043 +C 01130043 + IF (ICZERO) 36830, 6830, 36830 01140043 + 6830 CONTINUE 01150043 + IVON01 = 45 01160043 + IVON02 = 9 01170043 + IVON03 = 3 01180043 + IVCOMP = IVON01 + IVON02 - IVON03 01190043 + GO TO 46830 01200043 +36830 IVDELE = IVDELE + 1 01210043 + WRITE (I02,80003) IVTNUM 01220043 + IF (ICZERO) 46830, 6841, 46830 01230043 +46830 IF (IVCOMP - 51) 26830,16830,26830 01240043 +16830 IVPASS = IVPASS + 1 01250043 + WRITE (I02,80001) IVTNUM 01260043 + GO TO 6841 01270043 +26830 IVFAIL = IVFAIL + 1 01280043 + IVCORR = 51 01290043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01300043 + 6841 CONTINUE 01310043 + IVTNUM = 684 01320043 +C 01330043 +C **** TEST 684 **** 01340043 +C 01350043 + IF (ICZERO) 36840, 6840, 36840 01360043 + 6840 CONTINUE 01370043 + IVON01 = 45 01380043 + IVON02 = 9 01390043 + IVON03 = 3 01400043 + IVCOMP = (IVON01 + IVON02) - IVON03 01410043 + GO TO 46840 01420043 +36840 IVDELE = IVDELE + 1 01430043 + WRITE (I02,80003) IVTNUM 01440043 + IF (ICZERO) 46840, 6851, 46840 01450043 +46840 IF (IVCOMP - 51) 26840,16840,26840 01460043 +16840 IVPASS = IVPASS + 1 01470043 + WRITE (I02,80001) IVTNUM 01480043 + GO TO 6851 01490043 +26840 IVFAIL = IVFAIL + 1 01500043 + IVCORR = 51 01510043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01520043 + 6851 CONTINUE 01530043 + IVTNUM = 685 01540043 +C 01550043 +C **** TEST 685 **** 01560043 +C 01570043 + IF (ICZERO) 36850, 6850, 36850 01580043 + 6850 CONTINUE 01590043 + IVON01 = 45 01600043 + IVON02 = 9 01610043 + IVON03 = 3 01620043 + IVCOMP = IVON01 + (IVON02 - IVON03) 01630043 + GO TO 46850 01640043 +36850 IVDELE = IVDELE + 1 01650043 + WRITE (I02,80003) IVTNUM 01660043 + IF (ICZERO) 46850, 6861, 46850 01670043 +46850 IF (IVCOMP - 51) 26850,16850,26850 01680043 +16850 IVPASS = IVPASS + 1 01690043 + WRITE (I02,80001) IVTNUM 01700043 + GO TO 6861 01710043 +26850 IVFAIL = IVFAIL + 1 01720043 + IVCORR = 51 01730043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01740043 + 6861 CONTINUE 01750043 +C 01760043 +C TESTS 686 THROUGH 688 TEST '+' FOLLOWED BY '*'. 01770043 +C 01780043 + IVTNUM = 686 01790043 +C 01800043 +C **** TEST 686 **** 01810043 +C 01820043 + IF (ICZERO) 36860, 6860, 36860 01830043 + 6860 CONTINUE 01840043 + IVON01 = 45 01850043 + IVON02 = 9 01860043 + IVON03 = 3 01870043 + IVCOMP = IVON01 + IVON02 * IVON03 01880043 + GO TO 46860 01890043 +36860 IVDELE = IVDELE + 1 01900043 + WRITE (I02,80003) IVTNUM 01910043 + IF (ICZERO) 46860, 6871, 46860 01920043 +46860 IF (IVCOMP - 72) 26860,16860,26860 01930043 +16860 IVPASS = IVPASS + 1 01940043 + WRITE (I02,80001) IVTNUM 01950043 + GO TO 6871 01960043 +26860 IVFAIL = IVFAIL + 1 01970043 + IVCORR = 72 01980043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01990043 + 6871 CONTINUE 02000043 + IVTNUM = 687 02010043 +C 02020043 +C **** TEST 687 **** 02030043 +C 02040043 + IF (ICZERO) 36870, 6870, 36870 02050043 + 6870 CONTINUE 02060043 + IVON01 = 45 02070043 + IVON02 = 9 02080043 + IVON03 = 3 02090043 + IVCOMP = (IVON01 + IVON02) * IVON03 02100043 + GO TO 46870 02110043 +36870 IVDELE = IVDELE + 1 02120043 + WRITE (I02,80003) IVTNUM 02130043 + IF (ICZERO) 46870, 6881, 46870 02140043 +46870 IF (IVCOMP - 162) 26870,16870,26870 02150043 +16870 IVPASS = IVPASS + 1 02160043 + WRITE (I02,80001) IVTNUM 02170043 + GO TO 6881 02180043 +26870 IVFAIL = IVFAIL + 1 02190043 + IVCORR = 162 02200043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02210043 + 6881 CONTINUE 02220043 + IVTNUM = 688 02230043 +C 02240043 +C **** TEST 688 **** 02250043 +C 02260043 + IF (ICZERO) 36880, 6880, 36880 02270043 + 6880 CONTINUE 02280043 + IVON01 = 45 02290043 + IVON02 = 9 02300043 + IVON03 = 3 02310043 + IVCOMP = IVON01 + (IVON02 * IVON03) 02320043 + GO TO 46880 02330043 +36880 IVDELE = IVDELE + 1 02340043 + WRITE (I02,80003) IVTNUM 02350043 + IF (ICZERO) 46880, 6891, 46880 02360043 +46880 IF (IVCOMP - 72) 26880,16880,26880 02370043 +16880 IVPASS = IVPASS + 1 02380043 + WRITE (I02,80001) IVTNUM 02390043 + GO TO 6891 02400043 +26880 IVFAIL = IVFAIL + 1 02410043 + IVCORR = 72 02420043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02430043 + 6891 CONTINUE 02440043 +C 02450043 +C TESTS 689 THROUGH 691 TEST '+' FOLLOWED BY '/'. 02460043 +C 02470043 + IVTNUM = 689 02480043 +C 02490043 +C **** TEST 689 **** 02500043 +C 02510043 + IF (ICZERO) 36890, 6890, 36890 02520043 + 6890 CONTINUE 02530043 + IVON01 = 45 02540043 + IVON02 = 9 02550043 + IVON03 = 3 02560043 + IVCOMP = IVON01 + IVON02 / IVON03 02570043 + GO TO 46890 02580043 +36890 IVDELE = IVDELE + 1 02590043 + WRITE (I02,80003) IVTNUM 02600043 + IF (ICZERO) 46890, 6901, 46890 02610043 +46890 IF (IVCOMP - 48) 26890,16890,26890 02620043 +16890 IVPASS = IVPASS + 1 02630043 + WRITE (I02,80001) IVTNUM 02640043 + GO TO 6901 02650043 +26890 IVFAIL = IVFAIL + 1 02660043 + IVCORR = 48 02670043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02680043 + 6901 CONTINUE 02690043 + IVTNUM = 690 02700043 +C 02710043 +C **** TEST 690 **** 02720043 +C 02730043 + IF (ICZERO) 36900, 6900, 36900 02740043 + 6900 CONTINUE 02750043 + IVON01 = 45 02760043 + IVON02 = 9 02770043 + IVON03 = 3 02780043 + IVCOMP = (IVON01 + IVON02) / IVON03 02790043 + GO TO 46900 02800043 +36900 IVDELE = IVDELE + 1 02810043 + WRITE (I02,80003) IVTNUM 02820043 + IF (ICZERO) 46900, 6911, 46900 02830043 +46900 IF (IVCOMP - 18) 26900,16900,26900 02840043 +16900 IVPASS = IVPASS + 1 02850043 + WRITE (I02,80001) IVTNUM 02860043 + GO TO 6911 02870043 +26900 IVFAIL = IVFAIL + 1 02880043 + IVCORR = 18 02890043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02900043 + 6911 CONTINUE 02910043 + IVTNUM = 691 02920043 +C 02930043 +C **** TEST 691 **** 02940043 +C 02950043 + IF (ICZERO) 36910, 6910, 36910 02960043 + 6910 CONTINUE 02970043 + IVON01 = 45 02980043 + IVON02 = 9 02990043 + IVON03 = 3 03000043 + IVCOMP = IVON01 + (IVON02 / IVON03) 03010043 + GO TO 46910 03020043 +36910 IVDELE = IVDELE + 1 03030043 + WRITE (I02,80003) IVTNUM 03040043 + IF (ICZERO) 46910, 6921, 46910 03050043 +46910 IF (IVCOMP - 48) 26910,16910,26910 03060043 +16910 IVPASS = IVPASS + 1 03070043 + WRITE (I02,80001) IVTNUM 03080043 + GO TO 6921 03090043 +26910 IVFAIL = IVFAIL + 1 03100043 + IVCORR = 48 03110043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03120043 + 6921 CONTINUE 03130043 +C 03140043 +C TESTS 692 THROUGH 694 TEST '+' FOLLOWED BY '**'. 03150043 +C 03160043 + IVTNUM = 692 03170043 +C 03180043 +C **** TEST 692 **** 03190043 +C 03200043 + IF (ICZERO) 36920, 6920, 36920 03210043 + 6920 CONTINUE 03220043 + IVON01 = 15 03230043 + IVON02 = 9 03240043 + IVON03 = 3 03250043 + IVCOMP = IVON01 + IVON02 ** IVON03 03260043 + GO TO 46920 03270043 +36920 IVDELE = IVDELE + 1 03280043 + WRITE (I02,80003) IVTNUM 03290043 + IF (ICZERO) 46920, 6931, 46920 03300043 +46920 IF (IVCOMP - 744) 26920,16920,26920 03310043 +16920 IVPASS = IVPASS + 1 03320043 + WRITE (I02,80001) IVTNUM 03330043 + GO TO 6931 03340043 +26920 IVFAIL = IVFAIL + 1 03350043 + IVCORR = 744 03360043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03370043 + 6931 CONTINUE 03380043 + IVTNUM = 693 03390043 +C 03400043 +C **** TEST 693 **** 03410043 +C 03420043 + IF (ICZERO) 36930, 6930, 36930 03430043 + 6930 CONTINUE 03440043 + IVON01 = 15 03450043 + IVON02 = 9 03460043 + IVON03 = 3 03470043 + IVCOMP = (IVON01 + IVON02) ** IVON03 03480043 + GO TO 46930 03490043 +36930 IVDELE = IVDELE + 1 03500043 + WRITE (I02,80003) IVTNUM 03510043 + IF (ICZERO) 46930, 6941, 46930 03520043 +46930 IF (IVCOMP - 13824) 26930,16930,26930 03530043 +16930 IVPASS = IVPASS + 1 03540043 + WRITE (I02,80001) IVTNUM 03550043 + GO TO 6941 03560043 +26930 IVFAIL = IVFAIL + 1 03570043 + IVCORR = 13824 03580043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03590043 + 6941 CONTINUE 03600043 + IVTNUM = 694 03610043 +C 03620043 +C **** TEST 694 **** 03630043 +C 03640043 + IF (ICZERO) 36940, 6940, 36940 03650043 + 6940 CONTINUE 03660043 + IVON01 = 15 03670043 + IVON02 = 9 03680043 + IVON03 = 3 03690043 + IVCOMP = IVON01 + (IVON02 ** IVON03) 03700043 + GO TO 46940 03710043 +36940 IVDELE = IVDELE + 1 03720043 + WRITE (I02,80003) IVTNUM 03730043 + IF (ICZERO) 46940, 6951, 46940 03740043 +46940 IF (IVCOMP - 744) 26940,16940,26940 03750043 +16940 IVPASS = IVPASS + 1 03760043 + WRITE (I02,80001) IVTNUM 03770043 + GO TO 6951 03780043 +26940 IVFAIL = IVFAIL + 1 03790043 + IVCORR = 744 03800043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03810043 + 6951 CONTINUE 03820043 +C 03830043 +C TESTS 695 THROUGH 697 TEST '-' FOLLOWED BY '+'. 03840043 +C 03850043 + IVTNUM = 695 03860043 +C 03870043 +C **** TEST 695 **** 03880043 +C 03890043 + IF (ICZERO) 36950, 6950, 36950 03900043 + 6950 CONTINUE 03910043 + IVON01 = 45 03920043 + IVON02 = 9 03930043 + IVON03 = 3 03940043 + IVCOMP = IVON01 - IVON02 + IVON03 03950043 + GO TO 46950 03960043 +36950 IVDELE = IVDELE + 1 03970043 + WRITE (I02,80003) IVTNUM 03980043 + IF (ICZERO) 46950, 6961, 46950 03990043 +46950 IF (IVCOMP - 39) 26950,16950,26950 04000043 +16950 IVPASS = IVPASS + 1 04010043 + WRITE (I02,80001) IVTNUM 04020043 + GO TO 6961 04030043 +26950 IVFAIL = IVFAIL + 1 04040043 + IVCORR = 39 04050043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04060043 + 6961 CONTINUE 04070043 + IVTNUM = 696 04080043 +C 04090043 +C **** TEST 696 **** 04100043 +C 04110043 + IF (ICZERO) 36960, 6960, 36960 04120043 + 6960 CONTINUE 04130043 + IVON01 = 45 04140043 + IVON02 = 9 04150043 + IVON03 = 3 04160043 + IVCOMP = (IVON01 - IVON02) + IVON03 04170043 + GO TO 46960 04180043 +36960 IVDELE = IVDELE + 1 04190043 + WRITE (I02,80003) IVTNUM 04200043 + IF (ICZERO) 46960, 6971, 46960 04210043 +46960 IF (IVCOMP - 39) 26960,16960,26960 04220043 +16960 IVPASS = IVPASS + 1 04230043 + WRITE (I02,80001) IVTNUM 04240043 + GO TO 6971 04250043 +26960 IVFAIL = IVFAIL + 1 04260043 + IVCORR = 39 04270043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04280043 + 6971 CONTINUE 04290043 + IVTNUM = 697 04300043 +C 04310043 +C **** TEST 697 **** 04320043 +C 04330043 + IF (ICZERO) 36970, 6970, 36970 04340043 + 6970 CONTINUE 04350043 + IVON01 = 45 04360043 + IVON02 = 9 04370043 + IVON03 = 3 04380043 + IVCOMP = IVON01 - (IVON02 + IVON03) 04390043 + GO TO 46970 04400043 +36970 IVDELE = IVDELE + 1 04410043 + WRITE (I02,80003) IVTNUM 04420043 + IF (ICZERO) 46970, 6981, 46970 04430043 +46970 IF (IVCOMP - 33) 26970,16970,26970 04440043 +16970 IVPASS = IVPASS + 1 04450043 + WRITE (I02,80001) IVTNUM 04460043 + GO TO 6981 04470043 +26970 IVFAIL = IVFAIL + 1 04480043 + IVCORR = 33 04490043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04500043 + 6981 CONTINUE 04510043 +C 04520043 +C TESTS 698 THROUGH 700 TEST '-' FOLLOWED BY '*'. 04530043 +C 04540043 + IVTNUM = 698 04550043 +C 04560043 +C **** TEST 698 **** 04570043 +C 04580043 + IF (ICZERO) 36980, 6980, 36980 04590043 + 6980 CONTINUE 04600043 + IVON01 = 45 04610043 + IVON02 = 9 04620043 + IVON03 = 3 04630043 + IVCOMP = IVON01 - IVON02 * IVON03 04640043 + GO TO 46980 04650043 +36980 IVDELE = IVDELE + 1 04660043 + WRITE (I02,80003) IVTNUM 04670043 + IF (ICZERO) 46980, 6991, 46980 04680043 +46980 IF (IVCOMP - 18) 26980,16980,26980 04690043 +16980 IVPASS = IVPASS + 1 04700043 + WRITE (I02,80001) IVTNUM 04710043 + GO TO 6991 04720043 +26980 IVFAIL = IVFAIL + 1 04730043 + IVCORR = 18 04740043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04750043 + 6991 CONTINUE 04760043 + IVTNUM = 699 04770043 +C 04780043 +C **** TEST 699 **** 04790043 +C 04800043 + IF (ICZERO) 36990, 6990, 36990 04810043 + 6990 CONTINUE 04820043 + IVON01 = 45 04830043 + IVON02 = 9 04840043 + IVON03 = 3 04850043 + IVCOMP = (IVON01 - IVON02) * IVON03 04860043 + GO TO 46990 04870043 +36990 IVDELE = IVDELE + 1 04880043 + WRITE (I02,80003) IVTNUM 04890043 + IF (ICZERO) 46990, 7001, 46990 04900043 +46990 IF (IVCOMP - 108) 26990,16990,26990 04910043 +16990 IVPASS = IVPASS + 1 04920043 + WRITE (I02,80001) IVTNUM 04930043 + GO TO 7001 04940043 +26990 IVFAIL = IVFAIL + 1 04950043 + IVCORR = 108 04960043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04970043 + 7001 CONTINUE 04980043 + IVTNUM = 700 04990043 +C 05000043 +C **** TEST 700 **** 05010043 +C 05020043 + IF (ICZERO) 37000, 7000, 37000 05030043 + 7000 CONTINUE 05040043 + IVON01 = 45 05050043 + IVON02 = 9 05060043 + IVON03 = 3 05070043 + IVCOMP = IVON01 - (IVON02 * IVON03) 05080043 + GO TO 47000 05090043 +37000 IVDELE = IVDELE + 1 05100043 + WRITE (I02,80003) IVTNUM 05110043 + IF (ICZERO) 47000, 7011, 47000 05120043 +47000 IF (IVCOMP - 18) 27000,17000,27000 05130043 +17000 IVPASS = IVPASS + 1 05140043 + WRITE (I02,80001) IVTNUM 05150043 + GO TO 7011 05160043 +27000 IVFAIL = IVFAIL + 1 05170043 + IVCORR = 18 05180043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05190043 + 7011 CONTINUE 05200043 +C 05210043 +C TESTS 701 THROUGH 703 TEST '-' FOLLOWED BY '/'. 05220043 +C 05230043 + IVTNUM = 701 05240043 +C 05250043 +C **** TEST 701 **** 05260043 +C 05270043 + IF (ICZERO) 37010, 7010, 37010 05280043 + 7010 CONTINUE 05290043 + IVON01 = 45 05300043 + IVON02 = 9 05310043 + IVON03 = 3 05320043 + IVCOMP = IVON01 - IVON02 / IVON03 05330043 + GO TO 47010 05340043 +37010 IVDELE = IVDELE + 1 05350043 + WRITE (I02,80003) IVTNUM 05360043 + IF (ICZERO) 47010, 7021, 47010 05370043 +47010 IF (IVCOMP - 42) 27010,17010,27010 05380043 +17010 IVPASS = IVPASS + 1 05390043 + WRITE (I02,80001) IVTNUM 05400043 + GO TO 7021 05410043 +27010 IVFAIL = IVFAIL + 1 05420043 + IVCORR = 42 05430043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05440043 + 7021 CONTINUE 05450043 + IVTNUM = 702 05460043 +C 05470043 +C **** TEST 702 **** 05480043 +C 05490043 + IF (ICZERO) 37020, 7020, 37020 05500043 + 7020 CONTINUE 05510043 + IVON01 = 45 05520043 + IVON02 = 9 05530043 + IVON03 = 3 05540043 + IVCOMP = (IVON01 - IVON02) / IVON03 05550043 + GO TO 47020 05560043 +37020 IVDELE = IVDELE + 1 05570043 + WRITE (I02,80003) IVTNUM 05580043 + IF (ICZERO) 47020, 7031, 47020 05590043 +47020 IF (IVCOMP - 12) 27020,17020,27020 05600043 +17020 IVPASS = IVPASS + 1 05610043 + WRITE (I02,80001) IVTNUM 05620043 + GO TO 7031 05630043 +27020 IVFAIL = IVFAIL + 1 05640043 + IVCORR = 12 05650043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05660043 + 7031 CONTINUE 05670043 + IVTNUM = 703 05680043 +C 05690043 +C **** TEST 703 **** 05700043 +C 05710043 + IF (ICZERO) 37030, 7030, 37030 05720043 + 7030 CONTINUE 05730043 + IVON01 = 45 05740043 + IVON02 = 9 05750043 + IVON03 = 3 05760043 + IVCOMP = IVON01 - (IVON02 / IVON03) 05770043 + GO TO 47030 05780043 +37030 IVDELE = IVDELE + 1 05790043 + WRITE (I02,80003) IVTNUM 05800043 + IF (ICZERO) 47030, 7041, 47030 05810043 +47030 IF (IVCOMP - 42) 27030,17030,27030 05820043 +17030 IVPASS = IVPASS + 1 05830043 + WRITE (I02,80001) IVTNUM 05840043 + GO TO 7041 05850043 +27030 IVFAIL = IVFAIL + 1 05860043 + IVCORR = 42 05870043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05880043 + 7041 CONTINUE 05890043 +C 05900043 +C TESTS 704 THROUGH 706 TEST '-' FOLLOWED BY '**'. 05910043 +C 05920043 + IVTNUM = 704 05930043 +C 05940043 +C **** TEST 704 **** 05950043 +C 05960043 + IF (ICZERO) 37040, 7040, 37040 05970043 + 7040 CONTINUE 05980043 + IVON01 = 35 05990043 + IVON02 = 9 06000043 + IVON03 = 3 06010043 + IVCOMP = IVON01 - IVON02 ** IVON03 06020043 + GO TO 47040 06030043 +37040 IVDELE = IVDELE + 1 06040043 + WRITE (I02,80003) IVTNUM 06050043 + IF (ICZERO) 47040, 7051, 47040 06060043 +47040 IF (IVCOMP + 694) 27040,17040,27040 06070043 +17040 IVPASS = IVPASS + 1 06080043 + WRITE (I02,80001) IVTNUM 06090043 + GO TO 7051 06100043 +27040 IVFAIL = IVFAIL + 1 06110043 + IVCORR = -694 06120043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06130043 + 7051 CONTINUE 06140043 + IVTNUM = 705 06150043 +C 06160043 +C **** TEST 705 **** 06170043 +C 06180043 + IF (ICZERO) 37050, 7050, 37050 06190043 + 7050 CONTINUE 06200043 + IVON01 = 35 06210043 + IVON02 = 9 06220043 + IVON03 = 3 06230043 + IVCOMP = (IVON01 - IVON02) ** IVON03 06240043 + GO TO 47050 06250043 +37050 IVDELE = IVDELE + 1 06260043 + WRITE (I02,80003) IVTNUM 06270043 + IF (ICZERO) 47050, 7061, 47050 06280043 +47050 IF (IVCOMP - 17576) 27050,17050,27050 06290043 +17050 IVPASS = IVPASS + 1 06300043 + WRITE (I02,80001) IVTNUM 06310043 + GO TO 7061 06320043 +27050 IVFAIL = IVFAIL + 1 06330043 + IVCORR = 17576 06340043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06350043 + 7061 CONTINUE 06360043 + IVTNUM = 706 06370043 +C 06380043 +C **** TEST 706 **** 06390043 +C 06400043 + IF (ICZERO) 37060, 7060, 37060 06410043 + 7060 CONTINUE 06420043 + IVON01 = 35 06430043 + IVON02 = 9 06440043 + IVON03 = 3 06450043 + IVCOMP = IVON01 - (IVON02 ** IVON03) 06460043 + GO TO 47060 06470043 +37060 IVDELE = IVDELE + 1 06480043 + WRITE (I02,80003) IVTNUM 06490043 + IF (ICZERO) 47060, 7071, 47060 06500043 +47060 IF (IVCOMP + 694) 27060,17060,27060 06510043 +17060 IVPASS = IVPASS + 1 06520043 + WRITE (I02,80001) IVTNUM 06530043 + GO TO 7071 06540043 +27060 IVFAIL = IVFAIL + 1 06550043 + IVCORR = -694 06560043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06570043 + 7071 CONTINUE 06580043 +C 06590043 +C TESTS 707 THROUGH 709 TEST '*' FOLLOWED BY '+'. 06600043 +C 06610043 + IVTNUM = 707 06620043 +C 06630043 +C **** TEST 707 **** 06640043 +C 06650043 + IF (ICZERO) 37070, 7070, 37070 06660043 + 7070 CONTINUE 06670043 + IVON01 = 45 06680043 + IVON02 = 9 06690043 + IVON03 = 3 06700043 + IVCOMP = IVON01 * IVON02 + IVON03 06710043 + GO TO 47070 06720043 +37070 IVDELE = IVDELE + 1 06730043 + WRITE (I02,80003) IVTNUM 06740043 + IF (ICZERO) 47070, 7081, 47070 06750043 +47070 IF (IVCOMP - 408) 27070,17070,27070 06760043 +17070 IVPASS = IVPASS + 1 06770043 + WRITE (I02,80001) IVTNUM 06780043 + GO TO 7081 06790043 +27070 IVFAIL = IVFAIL + 1 06800043 + IVCORR = 408 06810043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06820043 + 7081 CONTINUE 06830043 + IVTNUM = 708 06840043 +C 06850043 +C **** TEST 708 **** 06860043 +C 06870043 + IF (ICZERO) 37080, 7080, 37080 06880043 + 7080 CONTINUE 06890043 + IVON01 = 45 06900043 + IVON02 = 9 06910043 + IVON03 = 3 06920043 + IVCOMP = (IVON01 * IVON02) + IVON03 06930043 + GO TO 47080 06940043 +37080 IVDELE = IVDELE + 1 06950043 + WRITE (I02,80003) IVTNUM 06960043 + IF (ICZERO) 47080, 7091, 47080 06970043 +47080 IF (IVCOMP - 408) 27080,17080,27080 06980043 +17080 IVPASS = IVPASS + 1 06990043 + WRITE (I02,80001) IVTNUM 07000043 + GO TO 7091 07010043 +27080 IVFAIL = IVFAIL + 1 07020043 + IVCORR = 408 07030043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07040043 + 7091 CONTINUE 07050043 + IVTNUM = 709 07060043 +C 07070043 +C **** TEST 709 **** 07080043 +C 07090043 + IF (ICZERO) 37090, 7090, 37090 07100043 + 7090 CONTINUE 07110043 + IVON01 = 45 07120043 + IVON02 = 9 07130043 + IVON03 = 3 07140043 + IVCOMP = IVON01 * (IVON02 + IVON03) 07150043 + GO TO 47090 07160043 +37090 IVDELE = IVDELE + 1 07170043 + WRITE (I02,80003) IVTNUM 07180043 + IF (ICZERO) 47090, 7101, 47090 07190043 +47090 IF (IVCOMP - 540) 27090,17090,27090 07200043 +17090 IVPASS = IVPASS + 1 07210043 + WRITE (I02,80001) IVTNUM 07220043 + GO TO 7101 07230043 +27090 IVFAIL = IVFAIL + 1 07240043 + IVCORR = 540 07250043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07260043 + 7101 CONTINUE 07270043 +C 07280043 +C TESTS 710 THROUGH 712 TEST '*' FOLLOWED BY '-'. 07290043 +C 07300043 + IVTNUM = 710 07310043 +C 07320043 +C **** TEST 710 **** 07330043 +C 07340043 + IF (ICZERO) 37100, 7100, 37100 07350043 + 7100 CONTINUE 07360043 + IVON01 = 45 07370043 + IVON02 = 9 07380043 + IVON03 = 3 07390043 + IVCOMP = IVON01 * IVON02 - IVON03 07400043 + GO TO 47100 07410043 +37100 IVDELE = IVDELE + 1 07420043 + WRITE (I02,80003) IVTNUM 07430043 + IF (ICZERO) 47100, 7111, 47100 07440043 +47100 IF (IVCOMP - 402) 27100,17100,27100 07450043 +17100 IVPASS = IVPASS + 1 07460043 + WRITE (I02,80001) IVTNUM 07470043 + GO TO 7111 07480043 +27100 IVFAIL = IVFAIL + 1 07490043 + IVCORR = 402 07500043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07510043 + 7111 CONTINUE 07520043 + IVTNUM = 711 07530043 +C 07540043 +C **** TEST 711 **** 07550043 +C 07560043 + IF (ICZERO) 37110, 7110, 37110 07570043 + 7110 CONTINUE 07580043 + IVON01 = 45 07590043 + IVON02 = 9 07600043 + IVON03 = 3 07610043 + IVCOMP = (IVON01 * IVON02) - IVON03 07620043 + GO TO 47110 07630043 +37110 IVDELE = IVDELE + 1 07640043 + WRITE (I02,80003) IVTNUM 07650043 + IF (ICZERO) 47110, 7121, 47110 07660043 +47110 IF (IVCOMP - 402) 27110,17110,27110 07670043 +17110 IVPASS = IVPASS + 1 07680043 + WRITE (I02,80001) IVTNUM 07690043 + GO TO 7121 07700043 +27110 IVFAIL = IVFAIL + 1 07710043 + IVCORR = 402 07720043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07730043 + 7121 CONTINUE 07740043 + IVTNUM = 712 07750043 +C 07760043 +C **** TEST 712 **** 07770043 +C 07780043 + IF (ICZERO) 37120, 7120, 37120 07790043 + 7120 CONTINUE 07800043 + IVON01 = 45 07810043 + IVON02 = 9 07820043 + IVON03 = 3 07830043 + IVCOMP = IVON01 * (IVON02 - IVON03) 07840043 + GO TO 47120 07850043 +37120 IVDELE = IVDELE + 1 07860043 + WRITE (I02,80003) IVTNUM 07870043 + IF (ICZERO) 47120, 7131, 47120 07880043 +47120 IF (IVCOMP - 270) 27120,17120,27120 07890043 +17120 IVPASS = IVPASS + 1 07900043 + WRITE (I02,80001) IVTNUM 07910043 + GO TO 7131 07920043 +27120 IVFAIL = IVFAIL + 1 07930043 + IVCORR = 270 07940043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07950043 + 7131 CONTINUE 07960043 +C 07970043 +C TESTS 713 THROUGH 715 TEST '*' FOLLOWED BY '/'. 07980043 +C 07990043 + IVTNUM = 713 08000043 +C 08010043 +C **** TEST 713 **** 08020043 +C 08030043 + IF (ICZERO) 37130, 7130, 37130 08040043 + 7130 CONTINUE 08050043 + IVON01 = 45 08060043 + IVON02 = 9 08070043 + IVON03 = 3 08080043 + IVCOMP = IVON01 * IVON02 / IVON03 08090043 + GO TO 47130 08100043 +37130 IVDELE = IVDELE + 1 08110043 + WRITE (I02,80003) IVTNUM 08120043 + IF (ICZERO) 47130, 7141, 47130 08130043 +47130 IF (IVCOMP - 135) 27130,17130,27130 08140043 +17130 IVPASS = IVPASS + 1 08150043 + WRITE (I02,80001) IVTNUM 08160043 + GO TO 7141 08170043 +27130 IVFAIL = IVFAIL + 1 08180043 + IVCORR = 135 08190043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 08200043 + 7141 CONTINUE 08210043 + IVTNUM = 714 08220043 +C 08230043 +C **** TEST 714 **** 08240043 +C 08250043 + IF (ICZERO) 37140, 7140, 37140 08260043 + 7140 CONTINUE 08270043 + IVON01 = 45 08280043 + IVON02 = 9 08290043 + IVON03 = 3 08300043 + IVCOMP = (IVON01 * IVON02) / IVON03 08310043 + GO TO 47140 08320043 +37140 IVDELE = IVDELE + 1 08330043 + WRITE (I02,80003) IVTNUM 08340043 + IF (ICZERO) 47140, 7151, 47140 08350043 +47140 IF (IVCOMP - 135) 27140,17140,27140 08360043 +17140 IVPASS = IVPASS + 1 08370043 + WRITE (I02,80001) IVTNUM 08380043 + GO TO 7151 08390043 +27140 IVFAIL = IVFAIL + 1 08400043 + IVCORR = 135 08410043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 08420043 + 7151 CONTINUE 08430043 + IVTNUM = 715 08440043 +C 08450043 +C **** TEST 715 **** 08460043 +C 08470043 + IF (ICZERO) 37150, 7150, 37150 08480043 + 7150 CONTINUE 08490043 + IVON01 = 45 08500043 + IVON02 = 9 08510043 + IVON03 = 3 08520043 + IVCOMP = IVON01 * (IVON02 / IVON03) 08530043 + GO TO 47150 08540043 +37150 IVDELE = IVDELE + 1 08550043 + WRITE (I02,80003) IVTNUM 08560043 + IF (ICZERO) 47150, 7161, 47150 08570043 +47150 IF (IVCOMP - 135) 27150,17150,27150 08580043 +17150 IVPASS = IVPASS + 1 08590043 + WRITE (I02,80001) IVTNUM 08600043 + GO TO 7161 08610043 +27150 IVFAIL = IVFAIL + 1 08620043 + IVCORR = 135 08630043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 08640043 + 7161 CONTINUE 08650043 +C 08660043 +C TESTS 716 THROUGH 718 TEST '*' FOLLOWED BY '**'. 08670043 +C 08680043 + IVTNUM = 716 08690043 +C 08700043 +C **** TEST 716 **** 08710043 +C 08720043 + IF (ICZERO) 37160, 7160, 37160 08730043 + 7160 CONTINUE 08740043 + IVON01 = 7 08750043 + IVON02 = 3 08760043 + IVON03 = 3 08770043 + IVCOMP = IVON01 * IVON02 ** IVON03 08780043 + GO TO 47160 08790043 +37160 IVDELE = IVDELE + 1 08800043 + WRITE (I02,80003) IVTNUM 08810043 + IF (ICZERO) 47160, 7171, 47160 08820043 +47160 IF (IVCOMP - 189) 27160,17160,27160 08830043 +17160 IVPASS = IVPASS + 1 08840043 + WRITE (I02,80001) IVTNUM 08850043 + GO TO 7171 08860043 +27160 IVFAIL = IVFAIL + 1 08870043 + IVCORR = 189 08880043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 08890043 + 7171 CONTINUE 08900043 + IVTNUM = 717 08910043 +C 08920043 +C **** TEST 717 **** 08930043 +C 08940043 + IF (ICZERO) 37170, 7170, 37170 08950043 + 7170 CONTINUE 08960043 + IVON01 = 7 08970043 + IVON02 = 3 08980043 + IVON03 = 3 08990043 + IVCOMP = (IVON01 * IVON02) ** IVON03 09000043 + GO TO 47170 09010043 +37170 IVDELE = IVDELE + 1 09020043 + WRITE (I02,80003) IVTNUM 09030043 + IF (ICZERO) 47170, 7181, 47170 09040043 +47170 IF (IVCOMP - 9261) 27170,17170,27170 09050043 +17170 IVPASS = IVPASS + 1 09060043 + WRITE (I02,80001) IVTNUM 09070043 + GO TO 7181 09080043 +27170 IVFAIL = IVFAIL + 1 09090043 + IVCORR = 9261 09100043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 09110043 + 7181 CONTINUE 09120043 + IVTNUM = 718 09130043 +C 09140043 +C **** TEST 718 **** 09150043 +C 09160043 + IF (ICZERO) 37180, 7180, 37180 09170043 + 7180 CONTINUE 09180043 + IVON01 = 7 09190043 + IVON02 = 3 09200043 + IVON03 = 3 09210043 + IVCOMP = IVON01 * (IVON02 ** IVON03) 09220043 + GO TO 47180 09230043 +37180 IVDELE = IVDELE + 1 09240043 + WRITE (I02,80003) IVTNUM 09250043 + IF (ICZERO) 47180, 7191, 47180 09260043 +47180 IF (IVCOMP - 189) 27180,17180,27180 09270043 +17180 IVPASS = IVPASS + 1 09280043 + WRITE (I02,80001) IVTNUM 09290043 + GO TO 7191 09300043 +27180 IVFAIL = IVFAIL + 1 09310043 + IVCORR = 189 09320043 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 09330043 + 7191 CONTINUE 09340043 +C 09350043 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 09360043 +99999 CONTINUE 09370043 + WRITE (I02,90002) 09380043 + WRITE (I02,90006) 09390043 + WRITE (I02,90002) 09400043 + WRITE (I02,90002) 09410043 + WRITE (I02,90007) 09420043 + WRITE (I02,90002) 09430043 + WRITE (I02,90008) IVFAIL 09440043 + WRITE (I02,90009) IVPASS 09450043 + WRITE (I02,90010) IVDELE 09460043 +C 09470043 +C 09480043 +C TERMINATE ROUTINE EXECUTION 09490043 + STOP 09500043 +C 09510043 +C FORMAT STATEMENTS FOR PAGE HEADERS 09520043 +90000 FORMAT ("1") 09530043 +90002 FORMAT (" ") 09540043 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 09550043 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 09560043 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 09570043 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 09580043 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 09590043 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 09600043 +C 09610043 +C FORMAT STATEMENTS FOR RUN SUMMARIES 09620043 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 09630043 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 09640043 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 09650043 +C 09660043 +C FORMAT STATEMENTS FOR TEST RESULTS 09670043 +80001 FORMAT (" ",4X,I5,7X,"PASS") 09680043 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 09690043 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 09700043 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 09710043 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 09720043 +C 09730043 +90007 FORMAT (" ",20X,"END OF PROGRAM FM043" ) 09740043 + END 09750043 diff --git a/Fortran/UnitTests/fcvs21_f95/FM043.reference_output b/Fortran/UnitTests/fcvs21_f95/FM043.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM043.reference_output @@ -0,0 +1,60 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 683 PASS + 684 PASS + 685 PASS + 686 PASS + 687 PASS + 688 PASS + 689 PASS + 690 PASS + 691 PASS + 692 PASS + 693 PASS + 694 PASS + 695 PASS + 696 PASS + 697 PASS + 698 PASS + 699 PASS + 700 PASS + 701 PASS + 702 PASS + 703 PASS + 704 PASS + 705 PASS + 706 PASS + 707 PASS + 708 PASS + 709 PASS + 710 PASS + 711 PASS + 712 PASS + 713 PASS + 714 PASS + 715 PASS + 716 PASS + 717 PASS + 718 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM043 + + 0 ERRORS ENCOUNTERED + 36 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM044.f b/Fortran/UnitTests/fcvs21_f95/FM044.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM044.f @@ -0,0 +1,786 @@ + PROGRAM FM044 + +C COMMENT SECTION 00010044 +C 00020044 +C FM044 00030044 +C 00040044 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS OF THE FORM 00050044 +C INTEGER VAR. = INTEGER VAR. INTEGER VAR. INTEGER VAR. 00060044 +C 00070044 +C WHERE AND ARE ARITHMETIC OPERATORS. 00080044 +C 00090044 +C REFERENCES 00100044 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110044 +C X3.9-1978 00120044 +C 00130044 +C SECTION 4.3, INTEGER TYPE 00140044 +C SECTION 4.3.1, INTEGER CONSTANT 00150044 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00160044 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00170044 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00180044 +C 00190044 +C 00200044 +C ********************************************************** 00210044 +C 00220044 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00230044 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00240044 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00250044 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00260044 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00270044 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00280044 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00290044 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00300044 +C OF EXECUTING THESE TESTS. 00310044 +C 00320044 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00330044 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00340044 +C 00350044 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00360044 +C 00370044 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00380044 +C SOFTWARE STANDARDS VALIDATION GROUP 00390044 +C BUILDING 225 RM A266 00400044 +C GAITHERSBURG, MD 20899 00410044 +C ********************************************************** 00420044 +C 00430044 +C 00440044 +C 00450044 +C INITIALIZATION SECTION 00460044 +C 00470044 +C INITIALIZE CONSTANTS 00480044 +C ************** 00490044 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00500044 + I01 = 5 00510044 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00520044 + I02 = 6 00530044 +C SYSTEM ENVIRONMENT SECTION 00540044 +C 00550044 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00560044 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00570044 +C (UNIT NUMBER FOR CARD READER). 00580044 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00590044 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00600044 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00610044 +C 00620044 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00630044 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00640044 +C (UNIT NUMBER FOR PRINTER). 00650044 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00660044 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670044 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00680044 +C 00690044 + IVPASS=0 00700044 + IVFAIL=0 00710044 + IVDELE=0 00720044 + ICZERO=0 00730044 +C 00740044 +C WRITE PAGE HEADERS 00750044 + WRITE (I02,90000) 00760044 + WRITE (I02,90001) 00770044 + WRITE (I02,90002) 00780044 + WRITE (I02, 90002) 00790044 + WRITE (I02,90003) 00800044 + WRITE (I02,90002) 00810044 + WRITE (I02,90004) 00820044 + WRITE (I02,90002) 00830044 + WRITE (I02,90011) 00840044 + WRITE (I02,90002) 00850044 + WRITE (I02,90002) 00860044 + WRITE (I02,90005) 00870044 + WRITE (I02,90006) 00880044 + WRITE (I02,90002) 00890044 +C 00900044 +C TEST SECTION 00910044 +C 00920044 +C ARITHMETIC ASSIGNMENT STATEMENT 00930044 +C 00940044 +C TESTS 719 THROUGH 730 TEST STATEMENTS WHERE IS '/' AND 00950044 +C VARIES. 00960044 +C 00970044 +C TESTS 731 THROUGH 746 TEST STATEMENTS WHERE IS '**' AND 00980044 +C VARIES. 00990044 +C 01000044 +C 01010044 +C TEST 719 THROUGH 721 TEST '/' FOLLOWED BY '+'. 01020044 +C 01030044 + IVTNUM = 719 01040044 +C 01050044 +C **** TEST 719 **** 01060044 +C 01070044 + IF (ICZERO) 37190, 7190, 37190 01080044 + 7190 CONTINUE 01090044 + IVON01 = 108 01100044 + IVON02 = 9 01110044 + IVON03 = 3 01120044 + IVCOMP = IVON01 / IVON02 + IVON03 01130044 + GO TO 47190 01140044 +37190 IVDELE = IVDELE + 1 01150044 + WRITE (I02,80003) IVTNUM 01160044 + IF (ICZERO) 47190, 7201, 47190 01170044 +47190 IF (IVCOMP - 15) 27190,17190,27190 01180044 +17190 IVPASS = IVPASS + 1 01190044 + WRITE (I02,80001) IVTNUM 01200044 + GO TO 7201 01210044 +27190 IVFAIL = IVFAIL + 1 01220044 + IVCORR = 15 01230044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01240044 + 7201 CONTINUE 01250044 + IVTNUM = 720 01260044 +C 01270044 +C **** TEST 720 **** 01280044 +C 01290044 + IF (ICZERO) 37200, 7200, 37200 01300044 + 7200 CONTINUE 01310044 + IVON01 = 108 01320044 + IVON02 = 9 01330044 + IVON03 = 3 01340044 + IVCOMP = (IVON01 / IVON02) + IVON03 01350044 + GO TO 47200 01360044 +37200 IVDELE = IVDELE + 1 01370044 + WRITE (I02,80003) IVTNUM 01380044 + IF (ICZERO) 47200, 7211, 47200 01390044 +47200 IF (IVCOMP - 15) 27200,17200,27200 01400044 +17200 IVPASS = IVPASS + 1 01410044 + WRITE (I02,80001) IVTNUM 01420044 + GO TO 7211 01430044 +27200 IVFAIL = IVFAIL + 1 01440044 + IVCORR = 15 01450044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01460044 + 7211 CONTINUE 01470044 + IVTNUM = 721 01480044 +C 01490044 +C **** TEST 721 **** 01500044 +C 01510044 + IF (ICZERO) 37210, 7210, 37210 01520044 + 7210 CONTINUE 01530044 + IVON01 = 108 01540044 + IVON02 = 9 01550044 + IVON03 = 3 01560044 + IVCOMP = IVON01 / (IVON02 + IVON03) 01570044 + GO TO 47210 01580044 +37210 IVDELE = IVDELE + 1 01590044 + WRITE (I02,80003) IVTNUM 01600044 + IF (ICZERO) 47210, 7221, 47210 01610044 +47210 IF (IVCOMP - 9) 27210,17210,27210 01620044 +17210 IVPASS = IVPASS + 1 01630044 + WRITE (I02,80001) IVTNUM 01640044 + GO TO 7221 01650044 +27210 IVFAIL = IVFAIL + 1 01660044 + IVCORR = 9 01670044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01680044 + 7221 CONTINUE 01690044 +C 01700044 +C TEST 722 THROUGH 724 TEST '/' FOLLOWED BY '-'. 01710044 +C 01720044 + IVTNUM = 722 01730044 +C 01740044 +C **** TEST 722 **** 01750044 +C 01760044 + IF (ICZERO) 37220, 7220, 37220 01770044 + 7220 CONTINUE 01780044 + IVON01 = 108 01790044 + IVON02 = 9 01800044 + IVON03 = 3 01810044 + IVCOMP = IVON01 / IVON02 - IVON03 01820044 + GO TO 47220 01830044 +37220 IVDELE = IVDELE + 1 01840044 + WRITE (I02,80003) IVTNUM 01850044 + IF (ICZERO) 47220, 7231, 47220 01860044 +47220 IF (IVCOMP - 9) 27220,17220,27220 01870044 +17220 IVPASS = IVPASS + 1 01880044 + WRITE (I02,80001) IVTNUM 01890044 + GO TO 7231 01900044 +27220 IVFAIL = IVFAIL + 1 01910044 + IVCORR = 9 01920044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01930044 + 7231 CONTINUE 01940044 + IVTNUM = 723 01950044 +C 01960044 +C **** TEST 723 **** 01970044 +C 01980044 + IF (ICZERO) 37230, 7230, 37230 01990044 + 7230 CONTINUE 02000044 + IVON01 = 108 02010044 + IVON02 = 9 02020044 + IVON03 = 3 02030044 + IVCOMP = (IVON01 / IVON02) - IVON03 02040044 + GO TO 47230 02050044 +37230 IVDELE = IVDELE + 1 02060044 + WRITE (I02,80003) IVTNUM 02070044 + IF (ICZERO) 47230, 7241, 47230 02080044 +47230 IF (IVCOMP - 9) 27230,17230,27230 02090044 +17230 IVPASS = IVPASS + 1 02100044 + WRITE (I02,80001) IVTNUM 02110044 + GO TO 7241 02120044 +27230 IVFAIL = IVFAIL + 1 02130044 + IVCORR = 9 02140044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02150044 + 7241 CONTINUE 02160044 + IVTNUM = 724 02170044 +C 02180044 +C **** TEST 724 **** 02190044 +C 02200044 + IF (ICZERO) 37240, 7240, 37240 02210044 + 7240 CONTINUE 02220044 + IVON01 = 108 02230044 + IVON02 = 9 02240044 + IVON03 = 3 02250044 + IVCOMP = IVON01 / (IVON02 - IVON03) 02260044 + GO TO 47240 02270044 +37240 IVDELE = IVDELE + 1 02280044 + WRITE (I02,80003) IVTNUM 02290044 + IF (ICZERO) 47240, 7251, 47240 02300044 +47240 IF (IVCOMP - 18) 27240,17240,27240 02310044 +17240 IVPASS = IVPASS + 1 02320044 + WRITE (I02,80001) IVTNUM 02330044 + GO TO 7251 02340044 +27240 IVFAIL = IVFAIL + 1 02350044 + IVCORR = 18 02360044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02370044 + 7251 CONTINUE 02380044 +C 02390044 +C TEST 725 THROUGH 727 TEST '/' FOLLOWED BY '*'. 02400044 +C 02410044 + IVTNUM = 725 02420044 +C 02430044 +C **** TEST 725 **** 02440044 +C 02450044 + IF (ICZERO) 37250, 7250, 37250 02460044 + 7250 CONTINUE 02470044 + IVON01 = 108 02480044 + IVON02 = 9 02490044 + IVON03 = 3 02500044 + IVCOMP = IVON01 / IVON02 * IVON03 02510044 + GO TO 47250 02520044 +37250 IVDELE = IVDELE + 1 02530044 + WRITE (I02,80003) IVTNUM 02540044 + IF (ICZERO) 47250, 7261, 47250 02550044 +47250 IF (IVCOMP - 36) 27250,17250,27250 02560044 +17250 IVPASS = IVPASS + 1 02570044 + WRITE (I02,80001) IVTNUM 02580044 + GO TO 7261 02590044 +27250 IVFAIL = IVFAIL + 1 02600044 + IVCORR = 36 02610044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02620044 + 7261 CONTINUE 02630044 + IVTNUM = 726 02640044 +C 02650044 +C **** TEST 726 **** 02660044 +C 02670044 + IF (ICZERO) 37260, 7260, 37260 02680044 + 7260 CONTINUE 02690044 + IVON01 = 108 02700044 + IVON02 = 9 02710044 + IVON03 = 3 02720044 + IVCOMP = (IVON01 / IVON02) * IVON03 02730044 + GO TO 47260 02740044 +37260 IVDELE = IVDELE + 1 02750044 + WRITE (I02,80003) IVTNUM 02760044 + IF (ICZERO) 47260, 7271, 47260 02770044 +47260 IF (IVCOMP - 36) 27260,17260,27260 02780044 +17260 IVPASS = IVPASS + 1 02790044 + WRITE (I02,80001) IVTNUM 02800044 + GO TO 7271 02810044 +27260 IVFAIL = IVFAIL + 1 02820044 + IVCORR = 36 02830044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02840044 + 7271 CONTINUE 02850044 + IVTNUM = 727 02860044 +C 02870044 +C **** TEST 727 **** 02880044 +C 02890044 + IF (ICZERO) 37270, 7270, 37270 02900044 + 7270 CONTINUE 02910044 + IVON01 = 108 02920044 + IVON02 = 9 02930044 + IVON03 = 3 02940044 + IVCOMP = IVON01 / (IVON02 * IVON03) 02950044 + GO TO 47270 02960044 +37270 IVDELE = IVDELE + 1 02970044 + WRITE (I02,80003) IVTNUM 02980044 + IF (ICZERO) 47270, 7281, 47270 02990044 +47270 IF (IVCOMP - 4) 27270,17270,27270 03000044 +17270 IVPASS = IVPASS + 1 03010044 + WRITE (I02,80001) IVTNUM 03020044 + GO TO 7281 03030044 +27270 IVFAIL = IVFAIL + 1 03040044 + IVCORR = 4 03050044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03060044 + 7281 CONTINUE 03070044 +C 03080044 +C TEST 728 THROUGH 730 TEST '/' FOLLOWED BY '**'. 03090044 +C 03100044 + IVTNUM = 728 03110044 +C 03120044 +C **** TEST 728 **** 03130044 +C 03140044 + IF (ICZERO) 37280, 7280, 37280 03150044 + 7280 CONTINUE 03160044 + IVON01 = 108 03170044 + IVON02 = 3 03180044 + IVON03 = 2 03190044 + IVCOMP = IVON01 / IVON02 ** IVON03 03200044 + GO TO 47280 03210044 +37280 IVDELE = IVDELE + 1 03220044 + WRITE (I02,80003) IVTNUM 03230044 + IF (ICZERO) 47280, 7291, 47280 03240044 +47280 IF (IVCOMP - 12) 27280,17280,27280 03250044 +17280 IVPASS = IVPASS + 1 03260044 + WRITE (I02,80001) IVTNUM 03270044 + GO TO 7291 03280044 +27280 IVFAIL = IVFAIL + 1 03290044 + IVCORR = 12 03300044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03310044 + 7291 CONTINUE 03320044 + IVTNUM = 729 03330044 +C 03340044 +C **** TEST 729 **** 03350044 +C 03360044 + IF (ICZERO) 37290, 7290, 37290 03370044 + 7290 CONTINUE 03380044 + IVON01 = 108 03390044 + IVON02 = 3 03400044 + IVON03 = 2 03410044 + IVCOMP = (IVON01 / IVON02) ** IVON03 03420044 + GO TO 47290 03430044 +37290 IVDELE = IVDELE + 1 03440044 + WRITE (I02,80003) IVTNUM 03450044 + IF (ICZERO) 47290, 7301, 47290 03460044 +47290 IF (IVCOMP - 1296) 27290,17290,27290 03470044 +17290 IVPASS = IVPASS + 1 03480044 + WRITE (I02,80001) IVTNUM 03490044 + GO TO 7301 03500044 +27290 IVFAIL = IVFAIL + 1 03510044 + IVCORR = 1296 03520044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03530044 + 7301 CONTINUE 03540044 + IVTNUM = 730 03550044 +C 03560044 +C **** TEST 730 **** 03570044 +C 03580044 + IF (ICZERO) 37300, 7300, 37300 03590044 + 7300 CONTINUE 03600044 + IVON01 = 108 03610044 + IVON02 = 3 03620044 + IVON03 = 2 03630044 + IVCOMP = IVON01 / (IVON02 ** IVON03) 03640044 + GO TO 47300 03650044 +37300 IVDELE = IVDELE + 1 03660044 + WRITE (I02,80003) IVTNUM 03670044 + IF (ICZERO) 47300, 7311, 47300 03680044 +47300 IF (IVCOMP - 12) 27300,17300,27300 03690044 +17300 IVPASS = IVPASS + 1 03700044 + WRITE (I02,80001) IVTNUM 03710044 + GO TO 7311 03720044 +27300 IVFAIL = IVFAIL + 1 03730044 + IVCORR = 12 03740044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03750044 + 7311 CONTINUE 03760044 +C 03770044 +C TEST 731 THROUGH 733 TEST '**' FOLLOWED BY '+'. 03780044 +C 03790044 + IVTNUM = 731 03800044 +C 03810044 +C **** TEST 731 **** 03820044 +C 03830044 + IF (ICZERO) 37310, 7310, 37310 03840044 + 7310 CONTINUE 03850044 + IVON01 = 3 03860044 + IVON02 = 5 03870044 + IVON03 = 4 03880044 + IVCOMP = IVON01 ** IVON02 + IVON03 03890044 + GO TO 47310 03900044 +37310 IVDELE = IVDELE + 1 03910044 + WRITE (I02,80003) IVTNUM 03920044 + IF (ICZERO) 47310, 7321, 47310 03930044 +47310 IF (IVCOMP - 247) 27310,17310,27310 03940044 +17310 IVPASS = IVPASS + 1 03950044 + WRITE (I02,80001) IVTNUM 03960044 + GO TO 7321 03970044 +27310 IVFAIL = IVFAIL + 1 03980044 + IVCORR = 247 03990044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04000044 + 7321 CONTINUE 04010044 + IVTNUM = 732 04020044 +C 04030044 +C **** TEST 732 **** 04040044 +C 04050044 + IF (ICZERO) 37320, 7320, 37320 04060044 + 7320 CONTINUE 04070044 + IVON01 = 3 04080044 + IVON02 = 5 04090044 + IVON03 = 4 04100044 + IVCOMP = (IVON01 ** IVON02) + IVON03 04110044 + GO TO 47320 04120044 +37320 IVDELE = IVDELE + 1 04130044 + WRITE (I02,80003) IVTNUM 04140044 + IF (ICZERO) 47320, 7331, 47320 04150044 +47320 IF (IVCOMP - 247) 27320,17320,27320 04160044 +17320 IVPASS = IVPASS + 1 04170044 + WRITE (I02,80001) IVTNUM 04180044 + GO TO 7331 04190044 +27320 IVFAIL = IVFAIL + 1 04200044 + IVCORR = 247 04210044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04220044 + 7331 CONTINUE 04230044 + IVTNUM = 733 04240044 +C 04250044 +C **** TEST 733 **** 04260044 +C 04270044 + IF (ICZERO) 37330, 7330, 37330 04280044 + 7330 CONTINUE 04290044 + IVON01 = 3 04300044 + IVON02 = 5 04310044 + IVON03 = 4 04320044 + IVCOMP = IVON01 ** (IVON02 + IVON03) 04330044 + GO TO 47330 04340044 +37330 IVDELE = IVDELE + 1 04350044 + WRITE (I02,80003) IVTNUM 04360044 + IF (ICZERO) 47330, 7341, 47330 04370044 +47330 IF (IVCOMP - 19683) 27330,17330,27330 04380044 +17330 IVPASS = IVPASS + 1 04390044 + WRITE (I02,80001) IVTNUM 04400044 + GO TO 7341 04410044 +27330 IVFAIL = IVFAIL + 1 04420044 + IVCORR = 19683 04430044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04440044 + 7341 CONTINUE 04450044 +C 04460044 +C TEST 734 THROUGH 736 TEST '**' FOLLOWED BY '-'. 04470044 +C 04480044 + IVTNUM = 734 04490044 +C 04500044 +C **** TEST 734 **** 04510044 +C 04520044 + IF (ICZERO) 37340, 7340, 37340 04530044 + 7340 CONTINUE 04540044 + IVON01 = 3 04550044 + IVON02 = 7 04560044 + IVON03 = 4 04570044 + IVCOMP = IVON01 ** IVON02 - IVON03 04580044 + GO TO 47340 04590044 +37340 IVDELE = IVDELE + 1 04600044 + WRITE (I02,80003) IVTNUM 04610044 + IF (ICZERO) 47340, 7351, 47340 04620044 +47340 IF (IVCOMP - 2183) 27340,17340,27340 04630044 +17340 IVPASS = IVPASS + 1 04640044 + WRITE (I02,80001) IVTNUM 04650044 + GO TO 7351 04660044 +27340 IVFAIL = IVFAIL + 1 04670044 + IVCORR = 2183 04680044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04690044 + 7351 CONTINUE 04700044 + IVTNUM = 735 04710044 +C 04720044 +C **** TEST 735 **** 04730044 +C 04740044 + IF (ICZERO) 37350, 7350, 37350 04750044 + 7350 CONTINUE 04760044 + IVON01 = 3 04770044 + IVON02 = 7 04780044 + IVON03 = 4 04790044 + IVCOMP = (IVON01 ** IVON02) - IVON03 04800044 + GO TO 47350 04810044 +37350 IVDELE = IVDELE + 1 04820044 + WRITE (I02,80003) IVTNUM 04830044 + IF (ICZERO) 47350, 7361, 47350 04840044 +47350 IF (IVCOMP - 2183) 27350,17350,27350 04850044 +17350 IVPASS = IVPASS + 1 04860044 + WRITE (I02,80001) IVTNUM 04870044 + GO TO 7361 04880044 +27350 IVFAIL = IVFAIL + 1 04890044 + IVCORR = 2183 04900044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04910044 + 7361 CONTINUE 04920044 + IVTNUM = 736 04930044 +C 04940044 +C **** TEST 736 **** 04950044 +C 04960044 + IF (ICZERO) 37360, 7360, 37360 04970044 + 7360 CONTINUE 04980044 + IVON01 = 3 04990044 + IVON02 = 7 05000044 + IVON03 = 4 05010044 + IVCOMP = IVON01 ** (IVON02 - IVON03) 05020044 + GO TO 47360 05030044 +37360 IVDELE = IVDELE + 1 05040044 + WRITE (I02,80003) IVTNUM 05050044 + IF (ICZERO) 47360, 7371, 47360 05060044 +47360 IF (IVCOMP - 27) 27360,17360,27360 05070044 +17360 IVPASS = IVPASS + 1 05080044 + WRITE (I02,80001) IVTNUM 05090044 + GO TO 7371 05100044 +27360 IVFAIL = IVFAIL + 1 05110044 + IVCORR = 27 05120044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05130044 + 7371 CONTINUE 05140044 +C 05150044 +C TEST 737 THROUGH 739 TEST '**' FOLLOWED BY '*'. 05160044 +C 05170044 + IVTNUM = 737 05180044 +C 05190044 +C **** TEST 737 **** 05200044 +C 05210044 + IF (ICZERO) 37370, 7370, 37370 05220044 + 7370 CONTINUE 05230044 + IVON01 = 3 05240044 + IVON02 = 3 05250044 + IVON03 = 3 05260044 + IVCOMP = IVON01 ** IVON02 * IVON03 05270044 + GO TO 47370 05280044 +37370 IVDELE = IVDELE + 1 05290044 + WRITE (I02,80003) IVTNUM 05300044 + IF (ICZERO) 47370, 7381, 47370 05310044 +47370 IF (IVCOMP - 81) 27370,17370,27370 05320044 +17370 IVPASS = IVPASS + 1 05330044 + WRITE (I02,80001) IVTNUM 05340044 + GO TO 7381 05350044 +27370 IVFAIL = IVFAIL + 1 05360044 + IVCORR = 81 05370044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05380044 + 7381 CONTINUE 05390044 + IVTNUM = 738 05400044 +C 05410044 +C **** TEST 738 **** 05420044 +C 05430044 + IF (ICZERO) 37380, 7380, 37380 05440044 + 7380 CONTINUE 05450044 + IVON01 = 3 05460044 + IVON02 = 3 05470044 + IVON03 = 3 05480044 + IVCOMP = (IVON01 ** IVON02) * IVON03 05490044 + GO TO 47380 05500044 +37380 IVDELE = IVDELE + 1 05510044 + WRITE (I02,80003) IVTNUM 05520044 + IF (ICZERO) 47380, 7391, 47380 05530044 +47380 IF (IVCOMP - 81) 27380,17380,27380 05540044 +17380 IVPASS = IVPASS + 1 05550044 + WRITE (I02,80001) IVTNUM 05560044 + GO TO 7391 05570044 +27380 IVFAIL = IVFAIL + 1 05580044 + IVCORR = 81 05590044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05600044 + 7391 CONTINUE 05610044 + IVTNUM = 739 05620044 +C 05630044 +C **** TEST 739 **** 05640044 +C 05650044 + IF (ICZERO) 37390, 7390, 37390 05660044 + 7390 CONTINUE 05670044 + IVON01 = 3 05680044 + IVON02 = 3 05690044 + IVON03 = 3 05700044 + IVCOMP = IVON01 ** (IVON02 * IVON03) 05710044 + GO TO 47390 05720044 +37390 IVDELE = IVDELE + 1 05730044 + WRITE (I02,80003) IVTNUM 05740044 + IF (ICZERO) 47390, 7401, 47390 05750044 +47390 IF (IVCOMP - 19683) 27390,17390,27390 05760044 +17390 IVPASS = IVPASS + 1 05770044 + WRITE (I02,80001) IVTNUM 05780044 + GO TO 7401 05790044 +27390 IVFAIL = IVFAIL + 1 05800044 + IVCORR = 19683 05810044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05820044 + 7401 CONTINUE 05830044 +C 05840044 +C TEST 740 THROUGH 742 TEST '**' FOLLOWED BY '/'. 05850044 +C 05860044 + IVTNUM = 740 05870044 +C 05880044 +C **** TEST 740 **** 05890044 +C 05900044 + IF (ICZERO) 37400, 7400, 37400 05910044 + 7400 CONTINUE 05920044 + IVON01 = 3 05930044 + IVON02 = 9 05940044 + IVON03 = 3 05950044 + IVCOMP = IVON01 ** IVON02 / IVON03 05960044 + GO TO 47400 05970044 +37400 IVDELE = IVDELE + 1 05980044 + WRITE (I02,80003) IVTNUM 05990044 + IF (ICZERO) 47400, 7411, 47400 06000044 +47400 IF (IVCOMP - 6561) 27400,17400,27400 06010044 +17400 IVPASS = IVPASS + 1 06020044 + WRITE (I02,80001) IVTNUM 06030044 + GO TO 7411 06040044 +27400 IVFAIL = IVFAIL + 1 06050044 + IVCORR = 6561 06060044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06070044 + 7411 CONTINUE 06080044 + IVTNUM = 741 06090044 +C 06100044 +C **** TEST 741 **** 06110044 +C 06120044 + IF (ICZERO) 37410, 7410, 37410 06130044 + 7410 CONTINUE 06140044 + IVON01 = 3 06150044 + IVON02 = 9 06160044 + IVON03 = 3 06170044 + IVCOMP = (IVON01 ** IVON02) / IVON03 06180044 + GO TO 47410 06190044 +37410 IVDELE = IVDELE + 1 06200044 + WRITE (I02,80003) IVTNUM 06210044 + IF (ICZERO) 47410, 7421, 47410 06220044 +47410 IF (IVCOMP - 6561) 27410,17410,27410 06230044 +17410 IVPASS = IVPASS + 1 06240044 + WRITE (I02,80001) IVTNUM 06250044 + GO TO 7421 06260044 +27410 IVFAIL = IVFAIL + 1 06270044 + IVCORR = 6561 06280044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06290044 + 7421 CONTINUE 06300044 + IVTNUM = 742 06310044 +C **** TEST 742 **** 06320044 +C 06330044 + IF (ICZERO) 37420, 7420, 37420 06340044 + 7420 CONTINUE 06350044 + IVON01 = 3 06360044 + IVON02 = 9 06370044 + IVON03 = 3 06380044 + IVCOMP = IVON01 ** (IVON02 / IVON03) 06390044 + GO TO 47420 06400044 +37420 IVDELE = IVDELE + 1 06410044 + WRITE (I02,80003) IVTNUM 06420044 + IF (ICZERO) 47420, 7431, 47420 06430044 +47420 IF (IVCOMP - 27) 27420,17420,27420 06440044 +17420 IVPASS = IVPASS + 1 06450044 + WRITE (I02,80001) IVTNUM 06460044 + GO TO 7431 06470044 +27420 IVFAIL = IVFAIL + 1 06480044 + IVCORR = 27 06490044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06500044 + 7431 CONTINUE 06510044 +C 06520044 +C TEST 743 THROUGH 746 TEST '**' FOLLOWED BY '**'. 06530044 +C 06540044 + IVTNUM = 743 06550044 +C 06560044 +C **** TEST 743 **** 06570044 +C 06580044 + IF (ICZERO) 37430, 7430, 37430 06590044 + 7430 CONTINUE 06600044 + IVON01 = 3 06610044 + IVON02 = 3 06620044 + IVON03 = 2 06630044 + IVCOMP = (IVON01 ** IVON02) ** IVON03 06640044 + GO TO 47430 06650044 +37430 IVDELE = IVDELE + 1 06660044 + WRITE (I02,80003) IVTNUM 06670044 + IF (ICZERO) 47430, 7441, 47430 06680044 +47430 IF (IVCOMP - 729) 27430,17430,27430 06690044 +17430 IVPASS = IVPASS + 1 06700044 + WRITE (I02,80001) IVTNUM 06710044 + GO TO 7441 06720044 +27430 IVFAIL = IVFAIL + 1 06730044 + IVCORR = 729 06740044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06750044 + 7441 CONTINUE 06760044 + IVTNUM = 744 06770044 +C 06780044 +C **** TEST 744 **** 06790044 +C 06800044 + IF (ICZERO) 37440, 7440, 37440 06810044 + 7440 CONTINUE 06820044 + IVON01 = 3 06830044 + IVON02 = 3 06840044 + IVON03 = 2 06850044 + IVCOMP = IVON01 ** (IVON02 ** IVON03) 06860044 + GO TO 47440 06870044 +37440 IVDELE = IVDELE + 1 06880044 + WRITE (I02,80003) IVTNUM 06890044 + IF (ICZERO) 47440, 7451, 47440 06900044 +47440 IF (IVCOMP - 19683) 27440,17440,27440 06910044 +17440 IVPASS = IVPASS + 1 06920044 + WRITE (I02,80001) IVTNUM 06930044 + GO TO 7451 06940044 +27440 IVFAIL = IVFAIL + 1 06950044 + IVCORR = 19683 06960044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06970044 + 7451 CONTINUE 06980044 + IVTNUM = 745 06990044 +C 07000044 +C **** TEST 745 **** 07010044 +C 07020044 + IF (ICZERO) 37450, 7450, 37450 07030044 + 7450 CONTINUE 07040044 + IVON01 = -3 07050044 + IVON02 = 3 07060044 + IVON03 = 2 07070044 + IVCOMP = (IVON01 ** IVON02) ** IVON03 07080044 + GO TO 47450 07090044 +37450 IVDELE = IVDELE + 1 07100044 + WRITE (I02,80003) IVTNUM 07110044 + IF (ICZERO) 47450, 7461, 47450 07120044 +47450 IF (IVCOMP - 729) 27450,17450,27450 07130044 +17450 IVPASS = IVPASS + 1 07140044 + WRITE (I02,80001) IVTNUM 07150044 + GO TO 7461 07160044 +27450 IVFAIL = IVFAIL + 1 07170044 + IVCORR = 729 07180044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07190044 + 7461 CONTINUE 07200044 + IVTNUM = 746 07210044 +C 07220044 +C **** TEST 746 **** 07230044 +C 07240044 + IF (ICZERO) 37460, 7460, 37460 07250044 + 7460 CONTINUE 07260044 + IVON01 = -3 07270044 + IVON02 = 3 07280044 + IVON03 = 2 07290044 + IVCOMP = IVON01 ** (IVON02 ** IVON03) 07300044 + GO TO 47460 07310044 +37460 IVDELE = IVDELE + 1 07320044 + WRITE (I02,80003) IVTNUM 07330044 + IF (ICZERO) 47460, 7471, 47460 07340044 +47460 IF (IVCOMP + 19683) 27460,17460,27460 07350044 +17460 IVPASS = IVPASS + 1 07360044 + WRITE (I02,80001) IVTNUM 07370044 + GO TO 7471 07380044 +27460 IVFAIL = IVFAIL + 1 07390044 + IVCORR = -19683 07400044 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07410044 + 7471 CONTINUE 07420044 +C 07430044 +C 07440044 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07450044 +99999 CONTINUE 07460044 + WRITE (I02,90002) 07470044 + WRITE (I02,90006) 07480044 + WRITE (I02,90002) 07490044 + WRITE (I02,90002) 07500044 + WRITE (I02,90007) 07510044 + WRITE (I02,90002) 07520044 + WRITE (I02,90008) IVFAIL 07530044 + WRITE (I02,90009) IVPASS 07540044 + WRITE (I02,90010) IVDELE 07550044 +C 07560044 +C 07570044 +C TERMINATE ROUTINE EXECUTION 07580044 + STOP 07590044 +C 07600044 +C FORMAT STATEMENTS FOR PAGE HEADERS 07610044 +90000 FORMAT ("1") 07620044 +90002 FORMAT (" ") 07630044 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07640044 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07650044 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07660044 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07670044 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07680044 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07690044 +C 07700044 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07710044 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07720044 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07730044 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07740044 +C 07750044 +C FORMAT STATEMENTS FOR TEST RESULTS 07760044 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07770044 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07780044 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07790044 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07800044 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07810044 +C 07820044 +90007 FORMAT (" ",20X,"END OF PROGRAM FM044" ) 07830044 + END 07840044 diff --git a/Fortran/UnitTests/fcvs21_f95/FM044.reference_output b/Fortran/UnitTests/fcvs21_f95/FM044.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM044.reference_output @@ -0,0 +1,52 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 719 PASS + 720 PASS + 721 PASS + 722 PASS + 723 PASS + 724 PASS + 725 PASS + 726 PASS + 727 PASS + 728 PASS + 729 PASS + 730 PASS + 731 PASS + 732 PASS + 733 PASS + 734 PASS + 735 PASS + 736 PASS + 737 PASS + 738 PASS + 739 PASS + 740 PASS + 741 PASS + 742 PASS + 743 PASS + 744 PASS + 745 PASS + 746 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM044 + + 0 ERRORS ENCOUNTERED + 28 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM045.f b/Fortran/UnitTests/fcvs21_f95/FM045.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM045.f @@ -0,0 +1,478 @@ + PROGRAM FM045 + +C COMMENT SECTION 00010045 +C 00020045 +C FM045 00030045 +C 00040045 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENTS USING INTEGER 00050045 +C VARIABLES CONNECTED BY A SERIES OF ARITHMETIC OPERATORS. 00060045 +C DIFFERENT COMBINATIONS OF PARENTHETICAL NOTATION ARE EXERCIZED. 00070045 +C 00080045 +C 00090045 +C REFERENCES 00100045 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110045 +C X3.9-1978 00120045 +C 00130045 +C SECTION 4.3, INTEGER TYPE 00140045 +C SECTION 4.3.1, INTEGER CONSTANT 00150045 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00160045 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00170045 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00180045 +C 00190045 +C 00200045 +C 00210045 +C ********************************************************** 00220045 +C 00230045 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00240045 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00250045 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00260045 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00270045 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00280045 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00290045 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00300045 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00310045 +C OF EXECUTING THESE TESTS. 00320045 +C 00330045 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00340045 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00350045 +C 00360045 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00370045 +C 00380045 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00390045 +C SOFTWARE STANDARDS VALIDATION GROUP 00400045 +C BUILDING 225 RM A266 00410045 +C GAITHERSBURG, MD 20899 00420045 +C ********************************************************** 00430045 +C 00440045 +C 00450045 +C 00460045 +C INITIALIZATION SECTION 00470045 +C 00480045 +C INITIALIZE CONSTANTS 00490045 +C ************** 00500045 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00510045 + I01 = 5 00520045 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00530045 + I02 = 6 00540045 +C SYSTEM ENVIRONMENT SECTION 00550045 +C 00560045 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00570045 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00580045 +C (UNIT NUMBER FOR CARD READER). 00590045 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00600045 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00610045 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00620045 +C 00630045 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00640045 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00650045 +C (UNIT NUMBER FOR PRINTER). 00660045 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00670045 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00680045 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00690045 +C 00700045 + IVPASS=0 00710045 + IVFAIL=0 00720045 + IVDELE=0 00730045 + ICZERO=0 00740045 +C 00750045 +C WRITE PAGE HEADERS 00760045 + WRITE (I02,90000) 00770045 + WRITE (I02,90001) 00780045 + WRITE (I02,90002) 00790045 + WRITE (I02, 90002) 00800045 + WRITE (I02,90003) 00810045 + WRITE (I02,90002) 00820045 + WRITE (I02,90004) 00830045 + WRITE (I02,90002) 00840045 + WRITE (I02,90011) 00850045 + WRITE (I02,90002) 00860045 + WRITE (I02,90002) 00870045 + WRITE (I02,90005) 00880045 + WRITE (I02,90006) 00890045 + WRITE (I02,90002) 00900045 +C 00910045 +C 00920045 +C TEST SECTION 00930045 +C 00940045 +C ARITHMETIC ASSIGNMENT STATEMENT 00950045 +C 00960045 +C 00970045 +C TESTS 747 THROUGH 755 USE THE SAME STRING OF VARIABLES AND 00980045 +C OPERATORS, BUT USE DIFFERENT COMBINATIONS OF PARENTHETICAL 00990045 +C NOTATION TO ALTER PRIORITIES IN ORDER OF EVALUATION. 01000045 +C 01010045 +C TESTS 756 THROUGH 759 CHECK THE CAPABILITY TO ENCLOSE THE ENTIRE 01020045 +C RIGHT HAND SIDE OF AN ASSIGNMENT STATEMENT IN PARENTHESES OR SETS 01030045 +C OF NESTED PARENTHESES. 01040045 +C 01050045 +C 01060045 +C 01070045 +C 01080045 +C 01090045 +C 01100045 +C 01110045 + IVTNUM = 747 01120045 +C 01130045 +C **** TEST 747 **** 01140045 +C 01150045 + IF (ICZERO) 37470, 7470, 37470 01160045 + 7470 CONTINUE 01170045 + IVON01 = 15 01180045 + IVON02 = 9 01190045 + IVON03 = 4 01200045 + IVON04 = 18 01210045 + IVON05 = 6 01220045 + IVON06 = 2 01230045 + IVCOMP = IVON01 + IVON02 - IVON03 * IVON04 / IVON05 ** IVON06 01240045 + GO TO 47470 01250045 +37470 IVDELE = IVDELE + 1 01260045 + WRITE (I02,80003) IVTNUM 01270045 + IF (ICZERO) 47470, 7481, 47470 01280045 +47470 IF (IVCOMP - 22) 27470,17470,27470 01290045 +17470 IVPASS = IVPASS + 1 01300045 + WRITE (I02,80001) IVTNUM 01310045 + GO TO 7481 01320045 +27470 IVFAIL = IVFAIL + 1 01330045 + IVCORR = 22 01340045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01350045 + 7481 CONTINUE 01360045 + IVTNUM = 748 01370045 +C 01380045 +C **** TEST 748 **** 01390045 +C 01400045 + IF (ICZERO) 37480, 7480, 37480 01410045 + 7480 CONTINUE 01420045 + IVON01 = 15 01430045 + IVON02 = 9 01440045 + IVON03 = 4 01450045 + IVON04 = 18 01460045 + IVON05 = 6 01470045 + IVON06 = 2 01480045 + IVCOMP = ((((IVON01 + IVON02) - IVON03) * IVON04) / IVON05) 01490045 + * ** IVON06 01500045 + GO TO 47480 01510045 +37480 IVDELE = IVDELE + 1 01520045 + WRITE (I02,80003) IVTNUM 01530045 + IF (ICZERO) 47480, 7491, 47480 01540045 +47480 IF (IVCOMP - 3600) 27480,17480,27480 01550045 +17480 IVPASS = IVPASS + 1 01560045 + WRITE (I02,80001) IVTNUM 01570045 + GO TO 7491 01580045 +27480 IVFAIL = IVFAIL + 1 01590045 + IVCORR = 3600 01600045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01610045 + 7491 CONTINUE 01620045 + IVTNUM = 749 01630045 +C 01640045 +C **** TEST 749 **** 01650045 +C 01660045 + IF (ICZERO) 37490, 7490, 37490 01670045 + 7490 CONTINUE 01680045 + IVON01 = 15 01690045 + IVON02 = 9 01700045 + IVON03 = 4 01710045 + IVON04 = 36 01720045 + IVON05 = 6 01730045 + IVON06 = 2 01740045 + IVCOMP = (IVON01 + IVON02 - IVON03) * (IVON04 / IVON05 ** IVON06) 01750045 + GO TO 47490 01760045 +37490 IVDELE = IVDELE + 1 01770045 + WRITE (I02,80003) IVTNUM 01780045 + IF (ICZERO) 47490, 7501, 47490 01790045 +47490 IF (IVCOMP - 20) 27490,17490,27490 01800045 +17490 IVPASS = IVPASS + 1 01810045 + WRITE (I02,80001) IVTNUM 01820045 + GO TO 7501 01830045 +27490 IVFAIL = IVFAIL + 1 01840045 + IVCORR = 20 01850045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01860045 + 7501 CONTINUE 01870045 + IVTNUM = 750 01880045 +C 01890045 +C **** TEST 750 **** 01900045 +C 01910045 + IF (ICZERO) 37500, 7500, 37500 01920045 + 7500 CONTINUE 01930045 + IVON01 = 15 01940045 + IVON02 = 9 01950045 + IVON03 = 4 01960045 + IVON04 = 36 01970045 + IVON05 = 6 01980045 + IVON06 = 2 01990045 + IVCOMP = (IVON01 + IVON02) - (IVON03 * IVON04) / (IVON05 ** 02000045 + * IVON06) 02010045 + GO TO 47500 02020045 +37500 IVDELE = IVDELE + 1 02030045 + WRITE (I02,80003) IVTNUM 02040045 + IF (ICZERO) 47500, 7511, 47500 02050045 +47500 IF (IVCOMP - 20) 27500,17500,27500 02060045 +17500 IVPASS = IVPASS + 1 02070045 + WRITE (I02,80001) IVTNUM 02080045 + GO TO 7511 02090045 +27500 IVFAIL = IVFAIL + 1 02100045 + IVCORR = 20 02110045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02120045 + 7511 CONTINUE 02130045 + IVTNUM = 751 02140045 +C 02150045 +C **** TEST 751 **** 02160045 +C 02170045 + IF (ICZERO) 37510, 7510, 37510 02180045 + 7510 CONTINUE 02190045 + IVON01 = 15 02200045 + IVON02 = 9 02210045 + IVON03 = 4 02220045 + IVON04 = 36 02230045 + IVON05 = 6 02240045 + IVON06 = 2 02250045 + IVCOMP = ((IVON01 + IVON02) - (IVON03 * IVON04)) / (IVON05 ** 02260045 + * IVON06) 02270045 + GO TO 47510 02280045 +37510 IVDELE = IVDELE + 1 02290045 + WRITE (I02,80003) IVTNUM 02300045 + IF (ICZERO) 47510, 7521, 47510 02310045 +47510 IF (IVCOMP + 3) 27510,17510,27510 02320045 +17510 IVPASS = IVPASS + 1 02330045 + WRITE (I02,80001) IVTNUM 02340045 + GO TO 7521 02350045 +27510 IVFAIL = IVFAIL + 1 02360045 + IVCORR = -3 02370045 +C ACTUAL ANSWER IS -3.333333... TRUNCATION IS NECESSARY 02380045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02390045 + 7521 CONTINUE 02400045 + IVTNUM = 752 02410045 +C 02420045 +C **** TEST 752 **** 02430045 +C 02440045 + IF (ICZERO) 37520, 7520, 37520 02450045 + 7520 CONTINUE 02460045 + IVON01 = 15 02470045 + IVON02 = 9 02480045 + IVON03 = 4 02490045 + IVON04 = 36 02500045 + IVON05 = 6 02510045 + IVON06 = 2 02520045 + IVCOMP = (IVON01 + IVON02) - (IVON03 * IVON04 / IVON05) ** IVON06 02530045 + GO TO 47520 02540045 +37520 IVDELE = IVDELE + 1 02550045 + WRITE (I02,80003) IVTNUM 02560045 + IF (ICZERO) 47520, 7531, 47520 02570045 +47520 IF (IVCOMP + 552) 27520,17520,27520 02580045 +17520 IVPASS = IVPASS + 1 02590045 + WRITE (I02,80001) IVTNUM 02600045 + GO TO 7531 02610045 +27520 IVFAIL = IVFAIL + 1 02620045 + IVCORR = -552 02630045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02640045 + 7531 CONTINUE 02650045 + IVTNUM = 753 02660045 +C 02670045 +C **** TEST 753 **** 02680045 +C 02690045 + IF (ICZERO) 37530, 7530, 37530 02700045 + 7530 CONTINUE 02710045 + IVON01 = 15 02720045 + IVON02 = 9 02730045 + IVON03 = 4 02740045 + IVON04 = 36 02750045 + IVON05 = 6 02760045 + IVON06 = 2 02770045 + IVCOMP = IVON01 + (IVON02 - IVON03 * IVON04) / IVON05 ** IVON06 02780045 + GO TO 47530 02790045 +37530 IVDELE = IVDELE + 1 02800045 + WRITE (I02,80003) IVTNUM 02810045 + IF (ICZERO) 47530, 7541, 47530 02820045 +47530 IF (IVCOMP - 12) 27530,17530,27530 02830045 +17530 IVPASS = IVPASS + 1 02840045 + WRITE (I02,80001) IVTNUM 02850045 + GO TO 7541 02860045 +27530 IVFAIL = IVFAIL + 1 02870045 + IVCORR = 12 02880045 +C ACTUAL ANSWER IS 11.25 TRUNCATION IS NECESSARY 02890045 +C DURING AN INTERMEDIATE STEP 02900045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02910045 + 7541 CONTINUE 02920045 + IVTNUM = 754 02930045 +C 02940045 +C **** TEST 754 **** 02950045 +C 02960045 + IF (ICZERO) 37540, 7540, 37540 02970045 + 7540 CONTINUE 02980045 + IVON01 = 15 02990045 + IVON02 = 9 03000045 + IVON03 = 4 03010045 + IVON04 = 36 03020045 + IVON05 = 6 03030045 + IVON06 = 2 03040045 + IVCOMP = IVON01 + (IVON02 - IVON03) * (IVON04 / IVON05) ** IVON06 03050045 + GO TO 47540 03060045 +37540 IVDELE = IVDELE + 1 03070045 + WRITE (I02,80003) IVTNUM 03080045 + IF (ICZERO) 47540, 7551, 47540 03090045 +47540 IF (IVCOMP - 195) 27540,17540,27540 03100045 +17540 IVPASS = IVPASS + 1 03110045 + WRITE (I02,80001) IVTNUM 03120045 + GO TO 7551 03130045 +27540 IVFAIL = IVFAIL + 1 03140045 + IVCORR = 195 03150045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03160045 + 7551 CONTINUE 03170045 + IVTNUM = 755 03180045 +C 03190045 +C **** TEST 755 **** 03200045 +C 03210045 + IF (ICZERO) 37550, 7550, 37550 03220045 + 7550 CONTINUE 03230045 + IVON01 = 15 03240045 + IVON02 = 9 03250045 + IVON03 = 4 03260045 + IVON04 = 36 03270045 + IVON05 = 6 03280045 + IVON06 = 2 03290045 + IVCOMP = ((IVON01 + (IVON02 - IVON03) * IVON04) / IVON05) ** 03300045 + * IVON06 03310045 + GO TO 47550 03320045 +37550 IVDELE = IVDELE + 1 03330045 + WRITE (I02,80003) IVTNUM 03340045 + IF (ICZERO) 47550, 7561, 47550 03350045 +47550 IF (IVCOMP - 1024) 27550,17550,27550 03360045 +17550 IVPASS = IVPASS + 1 03370045 + WRITE (I02,80001) IVTNUM 03380045 + GO TO 7561 03390045 +27550 IVFAIL = IVFAIL + 1 03400045 + IVCORR = 1024 03410045 +C ACTUAL ANSWER IS 1056.25 TRUNCATION IS NECESSARY 03420045 +C DURING AN INTERMEDIATE STEP 03430045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03440045 + 7561 CONTINUE 03450045 + IVTNUM = 756 03460045 +C 03470045 +C **** TEST 756 **** 03480045 +C SINGLE PARENTHESES 03490045 +C 03500045 + IF (ICZERO) 37560, 7560, 37560 03510045 + 7560 CONTINUE 03520045 + IVON01 = 13 03530045 + IVON02 = 37 03540045 + IVCOMP = (IVON01 + IVON02) 03550045 + GO TO 47560 03560045 +37560 IVDELE = IVDELE + 1 03570045 + WRITE (I02,80003) IVTNUM 03580045 + IF (ICZERO) 47560, 7571, 47560 03590045 +47560 IF (IVCOMP - 50) 27560,17560,27560 03600045 +17560 IVPASS = IVPASS + 1 03610045 + WRITE (I02,80001) IVTNUM 03620045 + GO TO 7571 03630045 +27560 IVFAIL = IVFAIL + 1 03640045 + IVCORR = 50 03650045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03660045 + 7571 CONTINUE 03670045 + IVTNUM = 757 03680045 +C 03690045 +C **** TEST 757 **** 03700045 +C NESTED PARENTHESES (TWO SETS) 03710045 +C 03720045 + IF (ICZERO) 37570, 7570, 37570 03730045 + 7570 CONTINUE 03740045 + IVON01 = 13 03750045 + IVON02 = 37 03760045 + IVCOMP = ((IVON01 - IVON02)) 03770045 + GO TO 47570 03780045 +37570 IVDELE = IVDELE + 1 03790045 + WRITE (I02,80003) IVTNUM 03800045 + IF (ICZERO) 47570, 7581, 47570 03810045 +47570 IF (IVCOMP + 24) 27570,17570,27570 03820045 +17570 IVPASS = IVPASS + 1 03830045 + WRITE (I02,80001) IVTNUM 03840045 + GO TO 7581 03850045 +27570 IVFAIL = IVFAIL + 1 03860045 + IVCORR = -24 03870045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03880045 + 7581 CONTINUE 03890045 + IVTNUM = 758 03900045 +C 03910045 +C **** TEST 758 **** 03920045 +C NESTED PARENTHESES (21 SETS - SAME LINE) 03930045 +C 03940045 + IF (ICZERO) 37580, 7580, 37580 03950045 + 7580 CONTINUE 03960045 + IVON01 = 13 03970045 + IVON02 = 37 03980045 + IVCOMP = (((((((((((((((((((((IVON01 * IVON02)))))))))))))))))))))03990045 + GO TO 47580 04000045 +37580 IVDELE = IVDELE + 1 04010045 + WRITE (I02,80003) IVTNUM 04020045 + IF (ICZERO) 47580, 7591, 47580 04030045 +47580 IF (IVCOMP - 481) 27580,17580,27580 04040045 +17580 IVPASS = IVPASS + 1 04050045 + WRITE (I02,80001) IVTNUM 04060045 + GO TO 7591 04070045 +27580 IVFAIL = IVFAIL + 1 04080045 + IVCORR = 481 04090045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04100045 + 7591 CONTINUE 04110045 + IVTNUM = 759 04120045 +C 04130045 +C **** TEST 759 **** 04140045 +C NESTED PARENTHESES (57 SETS - MULTIPLE LINES) 04150045 +C 04160045 + IF (ICZERO) 37590, 7590, 37590 04170045 + 7590 CONTINUE 04180045 + IVON01 = 13 04190045 + IVON02 = 37 04200045 + IVCOMP = (((((((((((((((((((((((((((((((((((((((((((((((((((((((((04210045 + * IVON01 / IVON02 04220045 + * )))))))))))))))))))))))))))))))))))))))))))))))))))))))))04230045 + GO TO 47590 04240045 +37590 IVDELE = IVDELE + 1 04250045 + WRITE (I02,80003) IVTNUM 04260045 + IF (ICZERO) 47590, 7601, 47590 04270045 +47590 IF (IVCOMP) 27590,17590,27590 04280045 +17590 IVPASS = IVPASS + 1 04290045 + WRITE (I02,80001) IVTNUM 04300045 + GO TO 7601 04310045 +27590 IVFAIL = IVFAIL + 1 04320045 + IVCORR = 0 04330045 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04340045 + 7601 CONTINUE 04350045 +C 04360045 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 04370045 +99999 CONTINUE 04380045 + WRITE (I02,90002) 04390045 + WRITE (I02,90006) 04400045 + WRITE (I02,90002) 04410045 + WRITE (I02,90002) 04420045 + WRITE (I02,90007) 04430045 + WRITE (I02,90002) 04440045 + WRITE (I02,90008) IVFAIL 04450045 + WRITE (I02,90009) IVPASS 04460045 + WRITE (I02,90010) IVDELE 04470045 +C 04480045 +C 04490045 +C TERMINATE ROUTINE EXECUTION 04500045 + STOP 04510045 +C 04520045 +C FORMAT STATEMENTS FOR PAGE HEADERS 04530045 +90000 FORMAT ("1") 04540045 +90002 FORMAT (" ") 04550045 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04560045 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 04570045 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 04580045 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 04590045 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 04600045 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 04610045 +C 04620045 +C FORMAT STATEMENTS FOR RUN SUMMARIES 04630045 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 04640045 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 04650045 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 04660045 +C 04670045 +C FORMAT STATEMENTS FOR TEST RESULTS 04680045 +80001 FORMAT (" ",4X,I5,7X,"PASS") 04690045 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 04700045 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 04710045 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 04720045 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 04730045 +C 04740045 +90007 FORMAT (" ",20X,"END OF PROGRAM FM045" ) 04750045 + END 04760045 diff --git a/Fortran/UnitTests/fcvs21_f95/FM045.reference_output b/Fortran/UnitTests/fcvs21_f95/FM045.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM045.reference_output @@ -0,0 +1,37 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 747 PASS + 748 PASS + 749 PASS + 750 PASS + 751 PASS + 752 PASS + 753 PASS + 754 PASS + 755 PASS + 756 PASS + 757 PASS + 758 PASS + 759 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM045 + + 0 ERRORS ENCOUNTERED + 13 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM050.f b/Fortran/UnitTests/fcvs21_f95/FM050.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM050.f @@ -0,0 +1,566 @@ + PROGRAM FM050 + +C 00010050 +C COMMENT SECTION 00020050 +C 00030050 +C FM050 00040050 +C 00050050 +C THIS ROUTINE CONTAINS BASIC SUBROUTINE AND FUNCTION REFERENCE00060050 +C TESTS. FOUR SUBROUTINES AND ONE FUNCTION ARE CALLED OR 00070050 +C REFERENCED. FS051 IS CALLED TO TEST THE CALLING AND PASSING OF 00080050 +C ARGUMENTS THROUGH UNLABELED COMMON. NO ARGUMENTS ARE SPECIFIED 00090050 +C IN THE CALL LINE. FS052 IS IDENTICAL TO FS051 EXCEPT THAT SEVERAL00100050 +C RETURNS ARE USED. FS053 UTILIZES MANY ARGUMENTS ON THE CALL 00110050 +C STATEMENT AND MANY RETURN STATEMENTS IN THE SUBROUTINE BODY. 00120050 +C FF054 IS A FUNCTION SUBROUTINE IN WHICH MANY ARGUMENTS AND RETURN 00130050 +C STATEMENTS ARE USED. AND FINALLY FS055 PASSES A ONE DIMENIONAL 00140050 +C ARRAY BACK TO FM050. 00150050 +C 00160050 +C REFERENCES 00170050 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00180050 +C X3.9-1978 00190050 +C 00200050 +C SECTION 15.5.2, REFERENCING AN EXTERNAL FUNCTION 00210050 +C SECTION 15.6.2, SUBROUTINE REFERENCE 00220050 +C 00230050 + COMMON RVCN01,IVCN01,IVCN02,IACN11(20) 00240050 + INTEGER FF054 00250050 +C 00260050 +C ********************************************************** 00270050 +C 00280050 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00290050 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00300050 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00310050 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00320050 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00330050 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00340050 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00350050 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00360050 +C OF EXECUTING THESE TESTS. 00370050 +C 00380050 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00390050 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00400050 +C 00410050 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00420050 +C 00430050 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00440050 +C SOFTWARE STANDARDS VALIDATION GROUP 00450050 +C BUILDING 225 RM A266 00460050 +C GAITHERSBURG, MD 20899 00470050 +C ********************************************************** 00480050 +C 00490050 +C 00500050 +C 00510050 +C INITIALIZATION SECTION 00520050 +C 00530050 +C INITIALIZE CONSTANTS 00540050 +C ************** 00550050 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00560050 + I01 = 5 00570050 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00580050 + I02 = 6 00590050 +C SYSTEM ENVIRONMENT SECTION 00600050 +C 00610050 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00620050 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00630050 +C (UNIT NUMBER FOR CARD READER). 00640050 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00650050 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00660050 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00670050 +C 00680050 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00690050 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00700050 +C (UNIT NUMBER FOR PRINTER). 00710050 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00720050 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00730050 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00740050 +C 00750050 + IVPASS=0 00760050 + IVFAIL=0 00770050 + IVDELE=0 00780050 + ICZERO=0 00790050 +C 00800050 +C WRITE PAGE HEADERS 00810050 + WRITE (I02,90000) 00820050 + WRITE (I02,90001) 00830050 + WRITE (I02,90002) 00840050 + WRITE (I02, 90002) 00850050 + WRITE (I02,90003) 00860050 + WRITE (I02,90002) 00870050 + WRITE (I02,90004) 00880050 + WRITE (I02,90002) 00890050 + WRITE (I02,90011) 00900050 + WRITE (I02,90002) 00910050 + WRITE (I02,90002) 00920050 + WRITE (I02,90005) 00930050 + WRITE (I02,90006) 00940050 + WRITE (I02,90002) 00950050 +C TEST SECTION 00960050 +C 00970050 +C SUBROUTINE AND FUNCTION SUBPROGRAMS 00980050 +C 00990050 + 4001 CONTINUE 01000050 + IVTNUM = 400 01010050 +C 01020050 +C **** TEST 400 **** 01030050 +C TEST 400 TESTS THE CALL TO A SUBROUTINE CONTAINING NO ARGUMENTS. 01040050 +C ALL PARAMETERS ARE PASSED THROUGH UNLABELED COMMON. 01050050 +C 01060050 + IF (ICZERO) 34000, 4000, 34000 01070050 + 4000 CONTINUE 01080050 + RVCN01 = 2.1654 01090050 + CALL FS051 01100050 + RVCOMP = RVCN01 01110050 + GO TO 44000 01120050 +34000 IVDELE = IVDELE + 1 01130050 + WRITE (I02,80003) IVTNUM 01140050 + IF (ICZERO) 44000, 4011, 44000 01150050 +44000 IF (RVCOMP - 3.1649) 24000,14000,44001 01160050 +44001 IF (RVCOMP - 3.1659) 14000,14000,24000 01170050 +14000 IVPASS = IVPASS + 1 01180050 + WRITE (I02,80001) IVTNUM 01190050 + GO TO 4011 01200050 +24000 IVFAIL = IVFAIL + 1 01210050 + RVCORR = 3.1654 01220050 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01230050 + 4011 CONTINUE 01240050 +C 01250050 +C TEST 401 THROUGH TEST 403 TEST THE CALL TO SUBROUTINE FS052 WHICH 01260050 +C CONTAINS NO ARGUMENTS. ALL PARAMETERS ARE PASSED THROUGH 01270050 +C UNLABELED COMMON. SUBROUTINE FS052 CONTAIN SEVERAL RETURN 01280050 +C STATEMENTS. 01290050 +C 01300050 + IVTNUM = 401 01310050 +C 01320050 +C **** TEST 401 **** 01330050 +C 01340050 + IF (ICZERO) 34010, 4010, 34010 01350050 + 4010 CONTINUE 01360050 + IVCN01 = 5 01370050 + IVCN02 = 1 01380050 + CALL FS052 01390050 + IVCOMP = IVCN01 01400050 + GO TO 44010 01410050 +34010 IVDELE = IVDELE + 1 01420050 + WRITE (I02,80003) IVTNUM 01430050 + IF (ICZERO) 44010, 4021, 44010 01440050 +44010 IF (IVCOMP - 6) 24010,14010,24010 01450050 +14010 IVPASS = IVPASS + 1 01460050 + WRITE (I02,80001) IVTNUM 01470050 + GO TO 4021 01480050 +24010 IVFAIL = IVFAIL + 1 01490050 + IVCORR = 6 01500050 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01510050 + 4021 CONTINUE 01520050 + IVTNUM = 402 01530050 +C 01540050 +C **** TEST 402 **** 01550050 +C 01560050 + IF (ICZERO) 34020, 4020, 34020 01570050 + 4020 CONTINUE 01580050 + IVCN01 = 10 01590050 + IVCN02 = 5 01600050 + CALL FS052 01610050 + IVCOMP = IVCN01 01620050 + GO TO 44020 01630050 +34020 IVDELE = IVDELE + 1 01640050 + WRITE (I02,80003) IVTNUM 01650050 + IF (ICZERO) 44020, 4031, 44020 01660050 +44020 IF (IVCOMP - 15) 24020,14020,24020 01670050 +14020 IVPASS = IVPASS + 1 01680050 + WRITE (I02,80001) IVTNUM 01690050 + GO TO 4031 01700050 +24020 IVFAIL = IVFAIL + 1 01710050 + IVCORR = 15 01720050 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01730050 + 4031 CONTINUE 01740050 + IVTNUM = 403 01750050 +C 01760050 +C **** TEST 403 **** 01770050 +C 01780050 + IF (ICZERO) 34030, 4030, 34030 01790050 + 4030 CONTINUE 01800050 + IVCN01 = 30 01810050 + IVCN02 = 3 01820050 + CALL FS052 01830050 + IVCOMP = IVCN01 01840050 + GO TO 44030 01850050 +34030 IVDELE = IVDELE + 1 01860050 + WRITE (I02,80003) IVTNUM 01870050 + IF (ICZERO) 44030, 4041, 44030 01880050 +44030 IF (IVCOMP - 33) 24030,14030,24030 01890050 +14030 IVPASS = IVPASS + 1 01900050 + WRITE (I02,80001) IVTNUM 01910050 + GO TO 4041 01920050 +24030 IVFAIL = IVFAIL + 1 01930050 + IVCORR = 33 01940050 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01950050 + 4041 CONTINUE 01960050 +C 01970050 +C TEST 404 THROUGH TEST 406 TEST THE CALL TO SUBROUTINE FS053 WHICH 01980050 +C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS. 01990050 +C 02000050 + IVTNUM = 404 02010050 +C 02020050 +C **** TEST 404 **** 02030050 +C 02040050 + IF (ICZERO) 34040, 4040, 34040 02050050 + 4040 CONTINUE 02060050 + CALL FS053 (6,10,11,IVON04,1) 02070050 + IVCOMP = IVON04 02080050 + GO TO 44040 02090050 +34040 IVDELE = IVDELE + 1 02100050 + WRITE (I02,80003) IVTNUM 02110050 + IF (ICZERO) 44040, 4051, 44040 02120050 +44040 IF (IVCOMP - 6) 24040,14040,24040 02130050 +14040 IVPASS = IVPASS + 1 02140050 + WRITE (I02,80001) IVTNUM 02150050 + GO TO 4051 02160050 +24040 IVFAIL = IVFAIL + 1 02170050 + IVCORR = 6 02180050 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02190050 + 4051 CONTINUE 02200050 + IVTNUM = 405 02210050 +C 02220050 +C **** TEST 405 **** 02230050 +C 02240050 + IF (ICZERO) 34050, 4050, 34050 02250050 + 4050 CONTINUE 02260050 + IVCN01 = 10 02270050 + CALL FS053 (6,IVCN01,11,IVON04,2) 02280050 + IVCOMP = IVON04 02290050 + GO TO 44050 02300050 +34050 IVDELE = IVDELE + 1 02310050 + WRITE (I02,80003) IVTNUM 02320050 + IF (ICZERO) 44050, 4061, 44050 02330050 +44050 IF (IVCOMP - 16) 24050,14050,24050 02340050 +14050 IVPASS = IVPASS + 1 02350050 + WRITE (I02,80001) IVTNUM 02360050 + GO TO 4061 02370050 +24050 IVFAIL = IVFAIL + 1 02380050 + IVCORR = 16 02390050 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02400050 + 4061 CONTINUE 02410050 + IVTNUM = 406 02420050 +C 02430050 +C **** TEST 406 **** 02440050 +C 02450050 + IF (ICZERO) 34060, 4060, 34060 02460050 + 4060 CONTINUE 02470050 + IVON01 = 6 02480050 + IVON02 = 10 02490050 + IVON03 = 11 02500050 + IVON05 = 3 02510050 + CALL FS053 (IVON01,IVON02,IVON03,IVON04,IVON05) 02520050 + IVCOMP = IVON04 02530050 + GO TO 44060 02540050 +34060 IVDELE = IVDELE + 1 02550050 + WRITE (I02,80003) IVTNUM 02560050 + IF (ICZERO) 44060, 4071, 44060 02570050 +44060 IF (IVCOMP - 27) 24060,14060,24060 02580050 +14060 IVPASS = IVPASS + 1 02590050 + WRITE (I02,80001) IVTNUM 02600050 + GO TO 4071 02610050 +24060 IVFAIL = IVFAIL + 1 02620050 + IVCORR = 27 02630050 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02640050 + 4071 CONTINUE 02650050 +C 02660050 +C TEST 407 THROUGH 409 TEST THE REFERENCE TO FUNCTION FF054 WHICH 02670050 +C CONTAINS SEVERAL ARGUMENTS AND SEVERAL RETURN STATEMENTS 02680050 +C 02690050 + IVTNUM = 407 02700050 +C 02710050 +C **** TEST 407 **** 02720050 +C 02730050 + IF (ICZERO) 34070, 4070, 34070 02740050 + 4070 CONTINUE 02750050 + IVCOMP = FF054 (300,1,21,1) 02760050 + GO TO 44070 02770050 +34070 IVDELE = IVDELE + 1 02780050 + WRITE (I02,80003) IVTNUM 02790050 + IF (ICZERO) 44070, 4081, 44070 02800050 +44070 IF (IVCOMP - 300) 24070,14070,24070 02810050 +14070 IVPASS = IVPASS + 1 02820050 + WRITE (I02,80001) IVTNUM 02830050 + GO TO 4081 02840050 +24070 IVFAIL = IVFAIL + 1 02850050 + IVCORR = 300 02860050 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02870050 + 4081 CONTINUE 02880050 + IVTNUM = 408 02890050 +C 02900050 +C **** TEST 408 **** 02910050 +C 02920050 + IF (ICZERO) 34080, 4080, 34080 02930050 + 4080 CONTINUE 02940050 + IVON01 = 300 02950050 + IVON04 = 2 02960050 + IVCOMP = FF054 (IVON01,77,5,IVON04) 02970050 + GO TO 44080 02980050 +34080 IVDELE = IVDELE + 1 02990050 + WRITE (I02,80003) IVTNUM 03000050 + IF (ICZERO) 44080, 4091, 44080 03010050 +44080 IF (IVCOMP - 377) 24080,14080,24080 03020050 +14080 IVPASS = IVPASS + 1 03030050 + WRITE (I02,80001) IVTNUM 03040050 + GO TO 4091 03050050 +24080 IVFAIL = IVFAIL + 1 03060050 + IVCORR = 377 03070050 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03080050 + 4091 CONTINUE 03090050 + IVTNUM = 409 03100050 +C 03110050 +C **** TEST 409 **** 03120050 +C 03130050 + IF (ICZERO) 34090, 4090, 34090 03140050 + 4090 CONTINUE 03150050 + IVON01 = 71 03160050 + IVON02 = 21 03170050 + IVON03 = 17 03180050 + IVON04 = 3 03190050 + IVCOMP = FF054 (IVON01,IVON02,IVON03,IVON04) 03200050 + GO TO 44090 03210050 +34090 IVDELE = IVDELE + 1 03220050 + WRITE (I02,80003) IVTNUM 03230050 + IF (ICZERO) 44090, 4101, 44090 03240050 +44090 IF (IVCOMP - 109) 24090,14090,24090 03250050 +14090 IVPASS = IVPASS + 1 03260050 + WRITE (I02,80001) IVTNUM 03270050 + GO TO 4101 03280050 +24090 IVFAIL = IVFAIL + 1 03290050 + IVCORR = 109 03300050 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03310050 + 4101 CONTINUE 03320050 +C 03330050 +C TEST 410 THROUGH 429 TEST THE CALL TO SUBROUTINE FS055 WHICH 03340050 +C CONTAINS NO ARGUMENTS. THE PARAMETERS ARE PASSED THROUGH AN 03350050 +C INTEGER ARRAY VARIABLE IN UNLABELED COMMON. 03360050 +C 03370050 + CALL FS055 03380050 + DO 20 I = 1,20 03390050 + IF (ICZERO) 34100, 4100, 34100 03400050 + 4100 CONTINUE 03410050 + IVTNUM = 409 + I 03420050 + IVCOMP = IACN11(I) 03430050 + GO TO 44100 03440050 +34100 IVDELE = IVDELE + 1 03450050 + WRITE (I02,80003) IVTNUM 03460050 + IF (ICZERO) 44100, 4111, 44100 03470050 +44100 IF (IVCOMP - I) 24100,14100,24100 03480050 +14100 IVPASS = IVPASS + 1 03490050 + WRITE (I02,80001) IVTNUM 03500050 + GO TO 4111 03510050 +24100 IVFAIL = IVFAIL + 1 03520050 + IVCORR = I 03530050 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03540050 + 4111 CONTINUE 03550050 +20 CONTINUE 03560050 +C 03570050 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03580050 +99999 CONTINUE 03590050 + WRITE (I02,90002) 03600050 + WRITE (I02,90006) 03610050 + WRITE (I02,90002) 03620050 + WRITE (I02,90002) 03630050 + WRITE (I02,90007) 03640050 + WRITE (I02,90002) 03650050 + WRITE (I02,90008) IVFAIL 03660050 + WRITE (I02,90009) IVPASS 03670050 + WRITE (I02,90010) IVDELE 03680050 +C 03690050 +C 03700050 +C TERMINATE ROUTINE EXECUTION 03710050 + STOP 03720050 +C 03730050 +C FORMAT STATEMENTS FOR PAGE HEADERS 03740050 +90000 FORMAT ("1") 03750050 +90002 FORMAT (" ") 03760050 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03770050 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03780050 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03790050 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03800050 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03810050 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03820050 +C 03830050 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03840050 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03850050 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03860050 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03870050 +C 03880050 +C FORMAT STATEMENTS FOR TEST RESULTS 03890050 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03900050 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03910050 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03920050 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03930050 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03940050 +C 03950050 +90007 FORMAT (" ",20X,"END OF PROGRAM FM050" ) 03960050 + END 03970050 + +C 00010051 +C COMMENT SECTION 00020051 +C 00030051 +C FS051 00040051 +C 00050051 +C FS051 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060051 +C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070051 +C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS051 00080051 +C INCREMENTS THE VALUE OF A REAL VARIABLE BY 1 AND RETURNS CONTROL 00090051 +C TO THE CALLING PROGRAM FM050. 00100051 +C 00110051 +C REFERENCES 00120051 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130051 +C X3.9-1978 00140051 +C 00150051 +C SECTION 15.6, SUBROUTINES 00160051 +C SECTION 15.8, RETURN STATEMENT 00170051 +C 00180051 +C TEST SECTION 00190051 +C 00200051 +C SUBROUTINE SUBPROGRAM - NO ARGUMENTS 00210051 +C 00220051 + SUBROUTINE FS051 00230051 + COMMON //RVCN01 00240051 + RVCN01 = RVCN01 + 1.0 00250051 + RETURN 00260051 + END 00270051 + +C 00010052 +C COMMENT SECTION 00020052 +C 00030052 +C FS052 00040052 +C 00050052 +C FS052 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060052 +C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070052 +C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS052 00080052 +C INCREMENTS THE VALUE OF ONE INTEGER VARIABLE BY 1,2,3,4 OR 5 00090052 +C DEPENDING ON THE VALUE OF A SECOND INTEGER VARIABLE AND THEN 00100052 +C RETURNS CONTROL TO THE CALLING PROGRAM FM050. SEVERAL RETURN 00110052 +C STATEMENTS ARE INCLUDED. 00120052 +C 00130052 +C REFERENCES 00140052 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150052 +C X3.9-1978 00160052 +C 00170052 +C SECTION 15.6, SUBROUTINES 00180052 +C SECTION 15.8, RETURN STATEMENT 00190052 +C 00200052 +C TEST SECTION 00210052 +C 00220052 +C SUBROUTINE SUBPROGRAM - NO ARGUMENTS, MANY RETURNS 00230052 +C 00240052 + SUBROUTINE FS052 00250052 + COMMON RVDN01,IVCN01,IVCN02 00260052 + GO TO (10,20,30,40,50),IVCN02 00270052 +10 IVCN01 = IVCN01 + 1 00280052 + RETURN 00290052 +20 IVCN01 = IVCN01 + 2 00300052 + RETURN 00310052 +30 IVCN01 = IVCN01 + 3 00320052 + RETURN 00330052 +40 IVCN01 = IVCN01 + 4 00340052 + RETURN 00350052 +50 IVCN01 = IVCN01 + 5 00360052 + RETURN 00370052 + END 00380052 + +C 00010053 +C COMMENT SECTION 00020053 +C 00030053 +C FS053 00040053 +C 00050053 +C FS053 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060053 +C PROGRAM FM050. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND 00070053 +C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE SUBROUTINE FS053 00080053 +C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS 00090053 +C DEPENDING ON THE VALUE OF THE FIFTH ARGUMENT. THE RESULTING SUM 00100053 +C IS THEN RETURNED TO THE CALLING PROGRAM FM050 THROUGH THE FOURTH 00110053 +C ARGUMENT. 00120053 +C 00130053 +C REFERENCES 00140053 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150053 +C X3.9-1978 00160053 +C 00170053 +C SECTION 15.6, SUBROUTINES 00180053 +C SECTION 15.8, RETURN STATEMENT 00190053 +C 00200053 +C TEST SECTION 00210053 +C 00220053 +C SUBROUTINE SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS 00230053 +C 00240053 + SUBROUTINE FS053 (IVON01,IVON02,IVON03,IVON04,IVON05) 00250053 + GO TO (10,20,30),IVON05 00260053 +10 IVON04 = IVON01 00270053 + RETURN 00280053 +20 IVON04 = IVON01 + IVON02 00290053 + RETURN 00300053 +30 IVON04 = IVON01 + IVON02 + IVON03 00310053 + RETURN 00320053 + END 00330053 + +C 00010054 +C COMMENT SECTION 00020054 +C 00030054 +C FF054 00040054 +C 00050054 +C FF054 IS A FUNCTION SUBPROGRAM WHICH IS REFERENCED BY THE 00060054 +C MAIN PROGRAM. FIVE INTEGER VARIABLE ARGUMENTS ARE PASSED AND 00070054 +C SEVERAL RETURN STATEMENTS ARE SPECIFIED. THE FUNCTION FF054 00080054 +C ADDS TOGETHER THE VALUES OF THE FIRST ONE, TWO OR THREE ARGUMENTS 00090054 +C DEPENDING ON THE VALUE OF THE FOURTH ARGUMENT. THE RESULTING SUM 00100054 +C IS THEN RETURNED TO THE REFERENCING PROGRAM FM050 THROUGH THE 00110054 +C FUNCTION REFERENCE. 00120054 +C 00130054 +C REFERENCES 00140054 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00150054 +C X3.9-1978 00160054 +C 00170054 +C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00180054 +C SECTION 15.8, RETURN STATEMENT 00190054 +C 00200054 +C TEST SECTION 00210054 +C 00220054 +C FUNCTION SUBPROGRAM - SEVERAL ARGUMENTS, SEVERAL RETURNS 00230054 +C 00240054 + INTEGER FUNCTION FF054 (IVON01,IVON02,IVON03,IVON04) 00250054 + GO TO (10,20,30),IVON04 00260054 +10 FF054 = IVON01 00270054 + RETURN 00280054 +20 FF054 = IVON01 + IVON02 00290054 + RETURN 00300054 +30 FF054 = IVON01 + IVON02 + IVON03 00310054 + RETURN 00320054 + END 00330054 + +C 00010055 +C COMMENT SECTION 00020055 +C 00030055 +C FS055 00040055 +C 00050055 +C FS055 IS A SUBROUTINE SUBPROGRAM WHICH IS CALLED BY THE MAIN 00060055 +C PROGRAM FM050. NO ARGUMENTS ARE SPECIFIED THEREFORE ALL 00070055 +C PARAMETERS ARE PASSED VIA UNLABELED COMMON. THE SUBROUTINE FS055 00080055 +C INITIALIZES A ONE DIMENSIONAL INTEGER ARRAY OF 20 ELEMENTS WITH 00090055 +C THE VALUES 1 THROUGH 20 RESPECTIVELY. CONTROL IS THEN RETURNED 00100055 +C TO THE CALLING PROGRAM FM050. 00110055 +C 00120055 +C REFERENCES 00130055 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140055 +C X3.9-1978 00150055 +C 00160055 +C SECTION 15.6, SUBROUTINES 00170055 +C SECTION 15.8, RETURN STATEMENT 00180055 +C 00190055 +C TEST SECTION 00200055 +C 00210055 +C SUBROUTINE SUBPROGRAM - ARRAY ARGUMENTS 00220055 +C 00230055 + SUBROUTINE FS055 00240055 + COMMON RVCN01,IVCN01,IVCN02,IACN11 00250055 + DIMENSION IACN11(20) 00260055 + DO 20 I = 1,20 00270055 + IACN11(I) = I 00280055 +20 CONTINUE 00290055 + RETURN 00300055 + END 00310055 diff --git a/Fortran/UnitTests/fcvs21_f95/FM050.reference_output b/Fortran/UnitTests/fcvs21_f95/FM050.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM050.reference_output @@ -0,0 +1,54 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 400 PASS + 401 PASS + 402 PASS + 403 PASS + 404 PASS + 405 PASS + 406 PASS + 407 PASS + 408 PASS + 409 PASS + 410 PASS + 411 PASS + 412 PASS + 413 PASS + 414 PASS + 415 PASS + 416 PASS + 417 PASS + 418 PASS + 419 PASS + 420 PASS + 421 PASS + 422 PASS + 423 PASS + 424 PASS + 425 PASS + 426 PASS + 427 PASS + 428 PASS + 429 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM050 + + 0 ERRORS ENCOUNTERED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM056.f b/Fortran/UnitTests/fcvs21_f95/FM056.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM056.f @@ -0,0 +1,532 @@ + PROGRAM FM056 + +C 00010056 +C COMMENT SECTION 00020056 +C 00030056 +C FM056 00040056 +C 00050056 +C FM056 IS A MAIN WHICH TESTS THE ARGUMENT PASSING LINKAGE OF 00060056 +C A 2 LEVEL NESTED SUBROUTINE AND AN EXTERNAL FUNCTION REFERENCE. 00070056 +C THE MAIN PROGRAM FM056 CALLS SUBROUTINE FS057 PASSING ONE 00080056 +C ARGUMENT. SUBROUTINE FS057 CALLS SUBROUTINE FS058 PASSING TWO 00090056 +C ARGUMENTS. SUBROUTINE FS058 REFERENCES EXTERNAL FUNCTION FF059 00100056 +C PASSING 3 ARGUMENTS. FUNCTION FF059 ADDS THE VALUES OF THE 3 00110056 +C ARGUMENTS TOGETHER. SUBROUTINE FS057 AND FS058 THEN MERELY 00120056 +C RETURN THE RESULT TO FM056 IN THE FIRST ARGUMENT. 00130056 +C 00140056 +C THE VALUES OF THE ARGUMENTS THAT ARE PASSED TO EACH 00150056 +C SUBPROGRAM AND FUNCTION, AND RETURNED TO THE CALLING OR 00160056 +C REFERENCING PROGRAM ARE SAVED IN AN INTEGER ARRAY. FM056 THEN 00170056 +C USES THESE VALUES TO TEST THE COMPILER'S ARGUMENT PASSING 00180056 +C CAPABILITIES. 00190056 +C 00200056 +C REFERENCES 00210056 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00220056 +C X3.9-1978 00230056 +C 00240056 +C SECTION 15.6.2, SUBROUTINE REFERENCE 00250056 + COMMON IACN11 (12) 00260056 +C 00270056 +C ********************************************************** 00280056 +C 00290056 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00300056 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00310056 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00320056 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00330056 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00340056 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00350056 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00360056 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00370056 +C OF EXECUTING THESE TESTS. 00380056 +C 00390056 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00400056 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00410056 +C 00420056 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00430056 +C 00440056 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00450056 +C SOFTWARE STANDARDS VALIDATION GROUP 00460056 +C BUILDING 225 RM A266 00470056 +C GAITHERSBURG, MD 20899 00480056 +C ********************************************************** 00490056 +C 00500056 +C 00510056 +C 00520056 +C INITIALIZATION SECTION 00530056 +C 00540056 +C INITIALIZE CONSTANTS 00550056 +C ************** 00560056 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00570056 + I01 = 5 00580056 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00590056 + I02 = 6 00600056 +C SYSTEM ENVIRONMENT SECTION 00610056 +C 00620056 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00630056 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00640056 +C (UNIT NUMBER FOR CARD READER). 00650056 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00660056 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670056 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00680056 +C 00690056 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00700056 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00710056 +C (UNIT NUMBER FOR PRINTER). 00720056 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00730056 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00740056 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00750056 +C 00760056 + IVPASS=0 00770056 + IVFAIL=0 00780056 + IVDELE=0 00790056 + ICZERO=0 00800056 +C 00810056 +C WRITE PAGE HEADERS 00820056 + WRITE (I02,90000) 00830056 + WRITE (I02,90001) 00840056 + WRITE (I02,90002) 00850056 + WRITE (I02, 90002) 00860056 + WRITE (I02,90003) 00870056 + WRITE (I02,90002) 00880056 + WRITE (I02,90004) 00890056 + WRITE (I02,90002) 00900056 + WRITE (I02,90011) 00910056 + WRITE (I02,90002) 00920056 + WRITE (I02,90002) 00930056 + WRITE (I02,90005) 00940056 + WRITE (I02,90006) 00950056 + WRITE (I02,90002) 00960056 +C 00970056 +C TEST SECTION 00980056 +C 00990056 +C SUBROUTINE SUBPROGRAM 01000056 +C 01010056 + IVON01 = 5 01020056 + CALL FS057 (IVON01) 01030056 + IACN11 (12) = IVON01 01040056 + IVTNUM = 430 01050056 +C 01060056 +C **** TEST 430 **** 01070056 +C 01080056 +C TEST 430 TESTS THE VALUE OF THE ARGUMENT RECEIVED BY FS057 FROM 01090056 +C A FM056 CALL TO FS057 01100056 +C 01110056 + IF (ICZERO) 34300, 4300, 34300 01120056 + 4300 CONTINUE 01130056 + IVCOMP = IACN11 (1) 01140056 + GO TO 44300 01150056 +34300 IVDELE = IVDELE + 1 01160056 + WRITE (I02,80003) IVTNUM 01170056 + IF (ICZERO) 44300, 4311, 44300 01180056 +44300 IF (IVCOMP - 5) 24300,14300,24300 01190056 +14300 IVPASS = IVPASS + 1 01200056 + WRITE (I02,80001) IVTNUM 01210056 + GO TO 4311 01220056 +24300 IVFAIL = IVFAIL + 1 01230056 + IVCORR = 5 01240056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01250056 + 4311 CONTINUE 01260056 + IVTNUM = 431 01270056 +C 01280056 +C **** TEST 431 **** 01290056 +C 01300056 +C TEST 431 TESTS THE VALUE OF THE SECOND ARGUMENT THAT WAS PASSED 01310056 +C FROM A FS057 CALL TO FS058 01320056 +C 01330056 +C 01340056 + IF (ICZERO) 34310, 4310, 34310 01350056 + 4310 CONTINUE 01360056 + IVCOMP = IACN11 (2) 01370056 + GO TO 44310 01380056 +34310 IVDELE = IVDELE + 1 01390056 + WRITE (I02,80003) IVTNUM 01400056 + IF (ICZERO) 44310, 4321, 44310 01410056 +44310 IF (IVCOMP - 4) 24310,14310,24310 01420056 +14310 IVPASS = IVPASS + 1 01430056 + WRITE (I02,80001) IVTNUM 01440056 + GO TO 4321 01450056 +24310 IVFAIL = IVFAIL + 1 01460056 + IVCORR = 4 01470056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01480056 + 4321 CONTINUE 01490056 + IVTNUM = 432 01500056 +C 01510056 +C **** TEST 432 **** 01520056 +C 01530056 +C TEST 432 TESTS THE VALUE OF THE FIRST ARGUMENT RECEIVED BY FS058 01540056 +C FROM A FS057 CALL TO FS058 01550056 +C 01560056 +C 01570056 + IF (ICZERO) 34320, 4320, 34320 01580056 + 4320 CONTINUE 01590056 + IVCOMP = IACN11 (3) 01600056 + GO TO 44320 01610056 +34320 IVDELE = IVDELE + 1 01620056 + WRITE (I02,80003) IVTNUM 01630056 + IF (ICZERO) 44320, 4331, 44320 01640056 +44320 IF (IVCOMP - 5) 24320,14320,24320 01650056 +14320 IVPASS = IVPASS + 1 01660056 + WRITE (I02,80001) IVTNUM 01670056 + GO TO 4331 01680056 +24320 IVFAIL = IVFAIL + 1 01690056 + IVCORR = 5 01700056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01710056 + 4331 CONTINUE 01720056 + IVTNUM = 433 01730056 +C 01740056 +C **** TEST 433 **** 01750056 +C 01760056 +C TEST 433 TESTS THE VALUE OF THE SECOND ARGUMENT RECEIVED BY FS058 01770056 +C FROM A FS057 CALL TO FS058 01780056 +C 01790056 +C 01800056 + IF (ICZERO) 34330, 4330, 34330 01810056 + 4330 CONTINUE 01820056 + IVCOMP = IACN11 (4) 01830056 + GO TO 44330 01840056 +34330 IVDELE = IVDELE + 1 01850056 + WRITE (I02,80003) IVTNUM 01860056 + IF (ICZERO) 44330, 4341, 44330 01870056 +44330 IF (IVCOMP - 4) 24330,14330,24330 01880056 +14330 IVPASS = IVPASS + 1 01890056 + WRITE (I02,80001) IVTNUM 01900056 + GO TO 4341 01910056 +24330 IVFAIL = IVFAIL + 1 01920056 + IVCORR = 4 01930056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 01940056 + 4341 CONTINUE 01950056 + IVTNUM = 434 01960056 +C 01970056 +C **** TEST 434 **** 01980056 +C 01990056 +C TEST 434 TESTS THE VALUE OF THE THIRD ARGUMENT THAT WAS PASSED 02000056 +C FROM A FS058 REFERENCE OF FUNCTION FF059 02010056 +C 02020056 +C 02030056 + IF (ICZERO) 34340, 4340, 34340 02040056 + 4340 CONTINUE 02050056 + IVCOMP = IACN11 (5) 02060056 + GO TO 44340 02070056 +34340 IVDELE = IVDELE + 1 02080056 + WRITE (I02,80003) IVTNUM 02090056 + IF (ICZERO) 44340, 4351, 44340 02100056 +44340 IF (IVCOMP - 3) 24340,14340,24340 02110056 +14340 IVPASS = IVPASS + 1 02120056 + WRITE (I02,80001) IVTNUM 02130056 + GO TO 4351 02140056 +24340 IVFAIL = IVFAIL + 1 02150056 + IVCORR = 3 02160056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02170056 + 4351 CONTINUE 02180056 + IVTNUM = 435 02190056 +C 02200056 +C **** TEST 435 **** 02210056 +C 02220056 +C TEST 435 TESTS THE VALUE OF THE FIRST ARGUMENT RECEIVED BY FF059 02230056 +C FROM A FS058 REFERENCE OF FUNCTION FF059 02240056 +C 02250056 +C 02260056 + IF (ICZERO) 34350, 4350, 34350 02270056 + 4350 CONTINUE 02280056 + IVCOMP = IACN11 (6) 02290056 + GO TO 44350 02300056 +34350 IVDELE = IVDELE + 1 02310056 + WRITE (I02,80003) IVTNUM 02320056 + IF (ICZERO) 44350, 4361, 44350 02330056 +44350 IF (IVCOMP - 5) 24350,14350,24350 02340056 +14350 IVPASS = IVPASS + 1 02350056 + WRITE (I02,80001) IVTNUM 02360056 + GO TO 4361 02370056 +24350 IVFAIL = IVFAIL + 1 02380056 + IVCORR = 5 02390056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02400056 + 4361 CONTINUE 02410056 + IVTNUM = 436 02420056 +C 02430056 +C **** TEST 436 **** 02440056 +C 02450056 +C TEST 436 TESTS THE VALUE OF THE SECOND ARGUMENT RECEIVED BY FF059 02460056 +C FROM A FS058 REFERENCE OF FUNCTION FF059 02470056 +C 02480056 +C 02490056 + IF (ICZERO) 34360, 4360, 34360 02500056 + 4360 CONTINUE 02510056 + IVCOMP = IACN11 (7) 02520056 + GO TO 44360 02530056 +34360 IVDELE = IVDELE + 1 02540056 + WRITE (I02,80003) IVTNUM 02550056 + IF (ICZERO) 44360, 4371, 44360 02560056 +44360 IF (IVCOMP - 4) 24360,14360,24360 02570056 +14360 IVPASS = IVPASS + 1 02580056 + WRITE (I02,80001) IVTNUM 02590056 + GO TO 4371 02600056 +24360 IVFAIL = IVFAIL + 1 02610056 + IVCORR = 4 02620056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02630056 + 4371 CONTINUE 02640056 + IVTNUM = 437 02650056 +C 02660056 +C **** TEST 437 **** 02670056 +C 02680056 +C TEST 437 TESTS THE VALUE OF THE THIRD ARGUMENT RECEIVED BY FF059 02690056 +C FROM A FS058 REFERENCE OF FUNCTION FF059 02700056 +C 02710056 +C 02720056 + IF (ICZERO) 34370, 4370, 34370 02730056 + 4370 CONTINUE 02740056 + IVCOMP = IACN11 (8) 02750056 + GO TO 44370 02760056 +34370 IVDELE = IVDELE + 1 02770056 + WRITE (I02,80003) IVTNUM 02780056 + IF (ICZERO) 44370, 4381, 44370 02790056 +44370 IF (IVCOMP - 3) 24370,14370,24370 02800056 +14370 IVPASS = IVPASS + 1 02810056 + WRITE (I02,80001) IVTNUM 02820056 + GO TO 4381 02830056 +24370 IVFAIL = IVFAIL + 1 02840056 + IVCORR = 3 02850056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02860056 + 4381 CONTINUE 02870056 + IVTNUM = 438 02880056 +C 02890056 +C **** TEST 438 **** 02900056 +C 02910056 +C TEST 438 TESTS THE VALUE OF THE FUNCTION DETERMINED BY FF059 02920056 +C 02930056 +C 02940056 + IF (ICZERO) 34380, 4380, 34380 02950056 + 4380 CONTINUE 02960056 + IVCOMP = IACN11 (9) 02970056 + GO TO 44380 02980056 +34380 IVDELE = IVDELE + 1 02990056 + WRITE (I02,80003) IVTNUM 03000056 + IF (ICZERO) 44380, 4391, 44380 03010056 +44380 IF (IVCOMP - 12) 24380,14380,24380 03020056 +14380 IVPASS = IVPASS + 1 03030056 + WRITE (I02,80001) IVTNUM 03040056 + GO TO 4391 03050056 +24380 IVFAIL = IVFAIL + 1 03060056 + IVCORR = 12 03070056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03080056 + 4391 CONTINUE 03090056 + IVTNUM = 439 03100056 +C 03110056 +C **** TEST 439 **** 03120056 +C 03130056 +C TEST 439 TESTS THE VALUE OF THE FUNCTION RETURNED TO FS058 BY 03140056 +C FF059 03150056 +C 03160056 +C 03170056 + IF (ICZERO) 34390, 4390, 34390 03180056 + 4390 CONTINUE 03190056 + IVCOMP = IACN11 (10) 03200056 + GO TO 44390 03210056 +34390 IVDELE = IVDELE + 1 03220056 + WRITE (I02,80003) IVTNUM 03230056 + IF (ICZERO) 44390, 4401, 44390 03240056 +44390 IF (IVCOMP - 12) 24390,14390,24390 03250056 +14390 IVPASS = IVPASS + 1 03260056 + WRITE (I02,80001) IVTNUM 03270056 + GO TO 4401 03280056 +24390 IVFAIL = IVFAIL + 1 03290056 + IVCORR = 12 03300056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03310056 + 4401 CONTINUE 03320056 + IVTNUM = 440 03330056 +C 03340056 +C **** TEST 440 **** 03350056 +C 03360056 +C TEST 440 TESTS THE VALUE OF THE FIRST ARGUMENT RETURNED TO FS057 03370056 +C BY FS058 03380056 +C 03390056 + IF (ICZERO) 34400, 4400, 34400 03400056 + 4400 CONTINUE 03410056 + IVCOMP = IACN11 (11) 03420056 + GO TO 44400 03430056 +34400 IVDELE = IVDELE + 1 03440056 + WRITE (I02,80003) IVTNUM 03450056 + IF (ICZERO) 44400, 4411, 44400 03460056 +44400 IF (IVCOMP - 12) 24400,14400,24400 03470056 +14400 IVPASS = IVPASS + 1 03480056 + WRITE (I02,80001) IVTNUM 03490056 + GO TO 4411 03500056 +24400 IVFAIL = IVFAIL + 1 03510056 + IVCORR = 12 03520056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03530056 + 4411 CONTINUE 03540056 + IVTNUM = 441 03550056 +C 03560056 +C **** TEST 441 **** 03570056 +C 03580056 +C TEST 441 TESTS THE VALUE OF THE FIRST ARGUMENT RETURNED TO FM056 03590056 +C BY FS057 03600056 +C 03610056 +C 03620056 + IF (ICZERO) 34410, 4410, 34410 03630056 + 4410 CONTINUE 03640056 + IVCOMP = IACN11 (12) 03650056 + GO TO 44410 03660056 +34410 IVDELE = IVDELE + 1 03670056 + WRITE (I02,80003) IVTNUM 03680056 + IF (ICZERO) 44410, 4421, 44410 03690056 +44410 IF (IVCOMP - 12) 24410,14410,24410 03700056 +14410 IVPASS = IVPASS + 1 03710056 + WRITE (I02,80001) IVTNUM 03720056 + GO TO 4421 03730056 +24410 IVFAIL = IVFAIL + 1 03740056 + IVCORR = 12 03750056 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03760056 + 4421 CONTINUE 03770056 +C 03780056 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03790056 +99999 CONTINUE 03800056 + WRITE (I02,90002) 03810056 + WRITE (I02,90006) 03820056 + WRITE (I02,90002) 03830056 + WRITE (I02,90002) 03840056 + WRITE (I02,90007) 03850056 + WRITE (I02,90002) 03860056 + WRITE (I02,90008) IVFAIL 03870056 + WRITE (I02,90009) IVPASS 03880056 + WRITE (I02,90010) IVDELE 03890056 +C 03900056 +C 03910056 +C TERMINATE ROUTINE EXECUTION 03920056 + STOP 03930056 +C 03940056 +C FORMAT STATEMENTS FOR PAGE HEADERS 03950056 +90000 FORMAT ("1") 03960056 +90002 FORMAT (" ") 03970056 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03980056 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03990056 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 04000056 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 04010056 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 04020056 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 04030056 +C 04040056 +C FORMAT STATEMENTS FOR RUN SUMMARIES 04050056 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 04060056 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 04070056 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 04080056 +C 04090056 +C FORMAT STATEMENTS FOR TEST RESULTS 04100056 +80001 FORMAT (" ",4X,I5,7X,"PASS") 04110056 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 04120056 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 04130056 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 04140056 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 04150056 +C 04160056 +90007 FORMAT (" ",20X,"END OF PROGRAM FM056" ) 04170056 + END 04180056 + +C 00010057 +C COMMENT SECTION 00020057 +C 00030057 +C FS057 00040057 +C 00050057 +C THIS SUBROUTINE IS CALLED BY THE MAIN PROGRAM FM056. THE 00060057 +C SINGLE ARGUMENT PASSED FROM FM056 ALONG WITH A SECOND PARAMETER 00070057 +C CREATED IN FS057 ARE THEN PASSED VIA A CALL TO SUBROUTINE FS058. 00080057 +C A RESULT FROM AN ARITHMETIC OPERATION IS RETURNED FROM FS058 IN 00090057 +C THE FIRST ARGUMENT. FS057 ACCEPTS THIS RESULT AND RETURNS CONTROL00100057 +C TO FM056 WITHOUT ANY ADDITIONAL PROCESSING. 00110057 +C 00120057 +C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FM056 TO 00130057 +C FS057 AND RETURNED ARE SAVED IN AN INTEGER ARRAY FOR LATER 00140057 +C VERIFICATION BY THE MAIN PROGRAM. 00150057 +C 00160057 +C REFERENCES 00170057 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00180057 +C X3.9-1978 00190057 +C 00200057 +C SECTION 15.6, SUBROUTINES 00210057 +C SECTION 15.6.2, SUBROUTINE REFERENCE 00220057 +C SECTION 15.8, RETURN STATEMENT 00230057 +C 00240057 +C TEST SECTION 00250057 +C 00260057 +C SUBROUTINE SUBPROGRAM 00270057 +C 00280057 + SUBROUTINE FS057 (IVON01) 00290057 + COMMON IACN11 (12) 00300057 + IACN11 (1) = IVON01 00310057 + IVON02 = 4 00320057 + IACN11 (2) = IVON02 00330057 + CALL FS058 (IVON01,IVON02) 00340057 + IACN11 (11) = IVON01 00350057 + RETURN 00360057 + END 00370057 + +C 00010058 +C COMMENT SECTION 00020058 +C 00030058 +C FS058 00040058 +C 00050058 +C THIS SUBROUTINE IS CALLED BY SUBROUTINE FS057. THE TWO 00060058 +C ARGUMENTS PASSED FROM FS057 ALONG WITH A THIRD PARAMETER CREATED 00070058 +C IN FS058 ARE THEN PASSED TO FUNCTION FF059 WHERE THEY ARE USED IN 00080058 +C AN ARITHMETIC OPERATION. FS058 THEN SAVES THE RESULT OF THIS 00090058 +C OPERATION IN THE FIRST ARGUMENT AND RETURNS CONTROL TO FS057 00100058 +C WITHOUT ANY ADDITIONAL PROCESSING. 00110058 +C 00120058 +C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FS057 TO 00130058 +C FS058 AND RETURNED ARE SAVED IN AN INTEGER ARRAY FOR LATER 00140058 +C VERIFICATION BY THE MAIN PROGRAM. 00150058 +C 00160058 +C REFERENCES 00170058 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00180058 +C X3.9-1978 00190058 +C 00200058 +C SECTION 15.5.2, REFERENCING EXTERNAL FUNCTIONS 00210058 +C SECTION 15.6, SUBROUTINES 00220058 +C SECTION 15.8, RETURN STATEMENT 00230058 +C 00240058 +C TEST SECTION 00250058 +C 00260058 +C SUBROUTINE SUBPROGRAM 00270058 +C 00280058 + SUBROUTINE FS058 (IVON01,IVON02) 00290058 + COMMON IACN11 (12) 00300058 + INTEGER FF059 00310058 + IVON03 = 3 00320058 + IACN11 (3) = IVON01 00330058 + IACN11 (4) = IVON02 00340058 + IACN11 (5) = IVON03 00350058 + IVON01 = FF059 (IVON01,IVON02,IVON03) 00360058 + IACN11 (10) = IVON01 00370058 + RETURN 00380058 + END 00390058 + +C 00010059 +C COMMENT SECTION 00020059 +C 00030059 +C FF059 00040059 +C 00050059 +C THIS EXTERNAL FUNCTION IS REFERENCED WITHIN SUBROUTINE FS058.00060059 +C THE THREE ARGUMENTS THAT ARE PASSED ARE SIMPLY ADDED TOGETHER AND 00070059 +C THE RESULT SUBSTITUTED FOR THE ORIGINAL REFERENCE. CONTROL IS 00080059 +C THEN RETURNED TO FS058. 00090059 +C 00100059 +C THE VALUES OF THE ARGUMENTS THAT ARE PASSED FROM FS058 TO 00110059 +C FF059 AND THE RESULT THAT IS RETURNED ARE SAVED IN AN INTEGER 00120059 +C ARRAY FOR LATER VERIFICATION BY THE MAIN PROGRAM. 00130059 +C 00140059 +C REFERENCES 00150059 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160059 +C X3.9-1978 00170059 +C 00180059 +C SECTION 15.5.1, FUNCTION SUBPROGRAM AND FUNCTION STATEMENT 00190059 +C SECTION 15.8, RETURN STATEMENT 00200059 +C TEST SECTION 00210059 +C 00220059 +C FUNCTION SUBPROGRAM 00230059 +C 00240059 + INTEGER FUNCTION FF059 (IVON01,IVON02,IVON03) 00250059 + COMMON IACN11 (12) 00260059 + IACN11 (6) = IVON01 00270059 + IACN11 (7) = IVON02 00280059 + IACN11 (8) = IVON03 00290059 + FF059 = IVON01 + IVON02 + IVON03 00300059 + IACN11 (9) = IVON01 + IVON02 + IVON03 00310059 + RETURN 00320059 + END 00330059 diff --git a/Fortran/UnitTests/fcvs21_f95/FM056.reference_output b/Fortran/UnitTests/fcvs21_f95/FM056.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM056.reference_output @@ -0,0 +1,36 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 430 PASS + 431 PASS + 432 PASS + 433 PASS + 434 PASS + 435 PASS + 436 PASS + 437 PASS + 438 PASS + 439 PASS + 440 PASS + 441 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM056 + + 0 ERRORS ENCOUNTERED + 12 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM060.f b/Fortran/UnitTests/fcvs21_f95/FM060.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM060.f @@ -0,0 +1,854 @@ + PROGRAM FM060 + +C COMMENT SECTION 00010060 +C 00020060 +C FM060 00030060 +C 00040060 +C THIS ROUTINE CONTAINS BASIC ARITHMETIC IF STATEMENT TESTS FOR 00050060 +C THE FORMAT 00060060 +C 00070060 +C IF (E) K1,K2,K3 00080060 +C 00090060 +C WHERE E IS A SIMPLE REAL EXPRESSION OF THE FORM 00100060 +C 00110060 +C REAL VARIABLE 00120060 +C REAL VARIABLE - REAL CONSTANT 00130060 +C REAL VARIABLE + REAL CONSTANT 00140060 +C 00150060 +C AND K1, K2 AND K3 ARE STATEMENT LABELS. 00160060 +C 00170060 +C THIS ROUTINE ALSO TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF 00180060 +C THE FORM 00190060 +C REAL VARIABLE = REAL CONSTANT 00200060 +C REAL VARIABLE = REAL VARIABLE 00210060 +C REAL VARIABLE = -REAL VARIABLE 00220060 +C 00230060 +C THE REAL CONSTANTS AND REAL VARIABLES CONTAIN BOTH POSITIVE AND 00240060 +C NEGATIVE VALUES. 00250060 +C 00260060 +C A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A 00270060 +C REAL NUMBER. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES. 00280060 +C 00290060 +C A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A DECIMAL00300060 +C POINT, AND A DECIMAL FRACTION PART IN THAT ORDER. BOTH THE 00310060 +C INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS; EITHER 00320060 +C ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH. THE CONSTANT IS 00330060 +C AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A DECIMAL 00340060 +C NUMERAL. 00350060 +C 00360060 +C A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN 00370060 +C OPTIONALLY SIGNED INTEGER CONSTANT. 00380060 +C 00390060 +C A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT,00400060 +C A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN 00410060 +C INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT. 00420060 +C 00430060 +C REFERENCES 00440060 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00450060 +C X3.9-1978 00460060 +C 00470060 +C SECTION 4.4, REAL TYPE 00480060 +C SECTION 4.4.1, REAL CONSTANT 00490060 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00500060 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00510060 +C SECTION 11.4, ARITHMETIC IF STATEMENT 00520060 +C 00530060 +C ********************************************************** 00540060 +C 00550060 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00560060 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00570060 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00580060 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00590060 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00600060 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00610060 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00620060 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00630060 +C OF EXECUTING THESE TESTS. 00640060 +C 00650060 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00660060 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00670060 +C 00680060 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00690060 +C 00700060 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00710060 +C SOFTWARE STANDARDS VALIDATION GROUP 00720060 +C BUILDING 225 RM A266 00730060 +C GAITHERSBURG, MD 20899 00740060 +C ********************************************************** 00750060 +C 00760060 +C 00770060 +C 00780060 +C INITIALIZATION SECTION 00790060 +C 00800060 +C INITIALIZE CONSTANTS 00810060 +C ************** 00820060 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00830060 + I01 = 5 00840060 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00850060 + I02 = 6 00860060 +C SYSTEM ENVIRONMENT SECTION 00870060 +C 00880060 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00890060 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00900060 +C (UNIT NUMBER FOR CARD READER). 00910060 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00920060 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00930060 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00940060 +C 00950060 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00960060 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00970060 +C (UNIT NUMBER FOR PRINTER). 00980060 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00990060 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01000060 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01010060 +C 01020060 + IVPASS=0 01030060 + IVFAIL=0 01040060 + IVDELE=0 01050060 + ICZERO=0 01060060 +C 01070060 +C WRITE PAGE HEADERS 01080060 + WRITE (I02,90000) 01090060 + WRITE (I02,90001) 01100060 + WRITE (I02,90002) 01110060 + WRITE (I02, 90002) 01120060 + WRITE (I02,90003) 01130060 + WRITE (I02,90002) 01140060 + WRITE (I02,90004) 01150060 + WRITE (I02,90002) 01160060 + WRITE (I02,90011) 01170060 + WRITE (I02,90002) 01180060 + WRITE (I02,90002) 01190060 + WRITE (I02,90005) 01200060 + WRITE (I02,90006) 01210060 + WRITE (I02,90002) 01220060 +C 01230060 +C TEST SECTION 01240060 +C 01250060 +C ARITHMETIC IF STATEMENT 01260060 +C 01270060 +C TEST 1 THROUGH TEST 3 CONTAIN BASIC ARITHMETIC IF STATEMENT TESTS 01280060 +C WITH A REAL VARIABLE AS ARITHMETIC EXPRESSION. 01290060 +C 01300060 + 11 CONTINUE 01310060 + IVTNUM = 1 01320060 +C 01330060 +C **** TEST 1 **** 01340060 +C TEST 001 - LESS THAN ZERO BRANCH EXPECTED 01350060 +C 01360060 + IF (ICZERO) 30010, 10, 30010 01370060 + 10 CONTINUE 01380060 + RVCOMP = 0.0 01390060 + RVON01 = -1.0 01400060 + IF (RVON01) 12,40010, 40010 01410060 + 12 RVCOMP = RVON01 01420060 + GO TO 40010 01430060 +30010 IVDELE = IVDELE + 1 01440060 + WRITE (I02,80003) IVTNUM 01450060 + IF (ICZERO) 40010, 21, 40010 01460060 +40010 IF (RVCOMP) 10010,20010,20010 01470060 +10010 IVPASS = IVPASS + 1 01480060 + WRITE (I02,80001) IVTNUM 01490060 + GO TO 21 01500060 +20010 IVFAIL = IVFAIL + 1 01510060 + RVCORR = -1.0 01520060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01530060 + 21 CONTINUE 01540060 + IVTNUM = 2 01550060 +C 01560060 +C **** TEST 2 **** 01570060 +C TEST 002 - EQUAL TO ZERO BRANCH EXPECTED 01580060 +C 01590060 + IF (ICZERO) 30020, 20, 30020 01600060 + 20 CONTINUE 01610060 + RVCOMP = 1.0 01620060 + RVON01 = 0.0 01630060 + IF (RVON01) 40020,22,40020 01640060 + 22 RVCOMP = RVON01 01650060 + GO TO 40020 01660060 +30020 IVDELE = IVDELE + 1 01670060 + WRITE (I02,80003) IVTNUM 01680060 + IF (ICZERO) 40020, 31, 40020 01690060 +40020 IF (RVCOMP) 20020,10020,20020 01700060 +10020 IVPASS = IVPASS + 1 01710060 + WRITE (I02,80001) IVTNUM 01720060 + GO TO 31 01730060 +20020 IVFAIL = IVFAIL + 1 01740060 + RVCORR = 0.0 01750060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01760060 + 31 CONTINUE 01770060 + IVTNUM = 3 01780060 +C 01790060 +C **** TEST 3 **** 01800060 +C TEST 003 - GREATER THAN ZERO BRANCH EXPECTED 01810060 +C 01820060 + IF (ICZERO) 30030, 30, 30030 01830060 + 30 CONTINUE 01840060 + RVCOMP = 0.0 01850060 + RVON01 = 1.0 01860060 + IF (RVON01) 40030,40030,32 01870060 + 32 RVCOMP = RVON01 01880060 + GO TO 40030 01890060 +30030 IVDELE = IVDELE + 1 01900060 + WRITE (I02,80003) IVTNUM 01910060 + IF (ICZERO) 40030, 41, 40030 01920060 +40030 IF (RVCOMP) 20030,20030,10030 01930060 +10030 IVPASS = IVPASS + 1 01940060 + WRITE (I02,80001) IVTNUM 01950060 + GO TO 41 01960060 +20030 IVFAIL = IVFAIL + 1 01970060 + RVCORR = 1.0 01980060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01990060 + 41 CONTINUE 02000060 + IVTNUM = 4 02010060 +C 02020060 +C **** TEST 4 **** 02030060 +C TEST 004 - BASIC IF STATEMENTS TEST 02040060 +C THESE IF STATEMENTS ARE USED IN REAL VARIABLE TEST 02050060 +C VERIFICATION. THE ARITHMETIC EXPRESSIONS ARE OF THE FORM 02060060 +C REAL VARIABLE - REAL CONSTANT 02070060 +C 02080060 + IF (ICZERO) 30040, 40, 30040 02090060 + 40 CONTINUE 02100060 + RVCOMP = 4.0 02110060 + RVON01 = 1.0 02120060 + IF (RVON01 - .99995) 40040,42,42 02130060 + 42 IF (RVON01 - 1.0005) 43,43,40040 02140060 + 43 RVCOMP = 0.0 02150060 + GO TO 40040 02160060 +30040 IVDELE = IVDELE + 1 02170060 + WRITE (I02,80003) IVTNUM 02180060 + IF (ICZERO) 40040, 51, 40040 02190060 +40040 IF (RVCOMP) 20040,10040,20040 02200060 +10040 IVPASS = IVPASS + 1 02210060 + WRITE (I02,80001) IVTNUM 02220060 + GO TO 51 02230060 +20040 IVFAIL = IVFAIL + 1 02240060 + RVCORR = 0.0 02250060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02260060 + 51 CONTINUE 02270060 + IVTNUM = 5 02280060 +C 02290060 +C **** TEST 5 **** 02300060 +C TEST 005 - BASIC IF STATEMENTS TEST 02310060 +C THESE IF STATEMENTS ARE USED IN REAL VARIABLE TEST 02320060 +C VERIFICATION. THE ARITHMETIC EXPRESSIONS ARE OF THE FORM 02330060 +C REAL VARIABLE + REAL CONSTANT 02340060 +C 02350060 + IF (ICZERO) 30050, 50, 30050 02360060 + 50 CONTINUE 02370060 + RVCOMP = -1.0 02380060 + RVON01 = -1.0 02390060 + IF (RVON01 + 1.0005) 40050,52,52 02400060 + 52 IF (RVON01 + .99995) 53,53,40050 02410060 + 53 RVCOMP = 0.0 02420060 + GO TO 40050 02430060 +30050 IVDELE = IVDELE + 1 02440060 + WRITE (I02,80003) IVTNUM 02450060 + IF (ICZERO) 40050, 61, 40050 02460060 +40050 IF (RVCOMP) 20050,10050,20050 02470060 +10050 IVPASS = IVPASS + 1 02480060 + WRITE (I02,80001) IVTNUM 02490060 + GO TO 61 02500060 +20050 IVFAIL = IVFAIL + 1 02510060 + RVCORR = 0.0 02520060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02530060 +C 02540060 +C ARITHMETIC ASSIGNMENT STATEMENT 02550060 +C 02560060 +C 02570060 +C TEST 006 THROUGH TEST 025 CONTAIN ARITHMETIC ASSIGNMENT 02580060 +C STATEMENTS OF THE FORM 02590060 +C REAL VARIABLE = REAL CONSTANT 02600060 +C 02610060 +C THE THREE TYPES OF REAL CONSTANTS ARE TESTED WITH POSITIVE 02620060 +C AND NEGATIVE VALUES FOR THE CONSTANTS, AND POSITIVE AND NEGATIVE 02630060 +C EXPONENTS. 02640060 +C 02650060 +C TEST 006 THROUGH TEST 011 - CONSTANT IS BASIC REAL CONSTANT 02660060 +C 02670060 + 61 CONTINUE 02680060 + IVTNUM = 6 02690060 +C 02700060 +C **** TEST 6 **** 02710060 +C 02720060 + IF (ICZERO) 30060, 60, 30060 02730060 + 60 CONTINUE 02740060 + RVCOMP = 2.0 02750060 + GO TO 40060 02760060 +30060 IVDELE = IVDELE + 1 02770060 + WRITE (I02,80003) IVTNUM 02780060 + IF (ICZERO) 40060, 71, 40060 02790060 +40060 IF (RVCOMP - 1.9995) 20060,10060,40061 02800060 +40061 IF (RVCOMP - 2.0005) 10060,10060,20060 02810060 +10060 IVPASS = IVPASS + 1 02820060 + WRITE (I02,80001) IVTNUM 02830060 + GO TO 71 02840060 +20060 IVFAIL = IVFAIL + 1 02850060 + RVCORR = 2.0 02860060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02870060 + 71 CONTINUE 02880060 + IVTNUM = 7 02890060 +C 02900060 +C **** TEST 7 **** 02910060 +C 02920060 + IF (ICZERO) 30070, 70, 30070 02930060 + 70 CONTINUE 02940060 + RVCOMP = 44.5 02950060 + GO TO 40070 02960060 +30070 IVDELE = IVDELE + 1 02970060 + WRITE (I02,80003) IVTNUM 02980060 + IF (ICZERO) 40070, 81, 40070 02990060 +40070 IF (RVCOMP - 44.495) 20070,10070,40071 03000060 +40071 IF (RVCOMP - 45.505) 10070,10070,20070 03010060 +10070 IVPASS = IVPASS + 1 03020060 + WRITE (I02,80001) IVTNUM 03030060 + GO TO 81 03040060 +20070 IVFAIL = IVFAIL + 1 03050060 + RVCORR = 44.5 03060060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03070060 + 81 CONTINUE 03080060 + IVTNUM = 8 03090060 +C 03100060 +C **** TEST 8 **** 03110060 +C 03120060 + IF (ICZERO) 30080, 80, 30080 03130060 + 80 CONTINUE 03140060 + RVCOMP = -2.0 03150060 + GO TO 40080 03160060 +30080 IVDELE = IVDELE + 1 03170060 + WRITE (I02,80003) IVTNUM 03180060 + IF (ICZERO) 40080, 91, 40080 03190060 +40080 IF (RVCOMP + 2.0005) 20080,10080,40081 03200060 +40081 IF (RVCOMP + 1.9995) 10080,10080,20080 03210060 +10080 IVPASS = IVPASS + 1 03220060 + WRITE (I02,80001) IVTNUM 03230060 + GO TO 91 03240060 +20080 IVFAIL = IVFAIL + 1 03250060 + RVCORR = -2.0 03260060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03270060 + 91 CONTINUE 03280060 + IVTNUM = 9 03290060 +C 03300060 +C **** TEST 9 **** 03310060 +C 03320060 + IF (ICZERO) 30090, 90, 30090 03330060 + 90 CONTINUE 03340060 + RVCOMP = 65001. 03350060 + GO TO 40090 03360060 +30090 IVDELE = IVDELE + 1 03370060 + WRITE (I02,80003) IVTNUM 03380060 + IF (ICZERO) 40090, 101, 40090 03390060 +40090 IF (RVCOMP - 64996.) 20090,10090,40091 03400060 +40091 IF (RVCOMP - 65006.) 10090,10090,20090 03410060 +10090 IVPASS = IVPASS + 1 03420060 + WRITE (I02,80001) IVTNUM 03430060 + GO TO 101 03440060 +20090 IVFAIL = IVFAIL + 1 03450060 + RVCORR = 65001. 03460060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03470060 + 101 CONTINUE 03480060 + IVTNUM = 10 03490060 +C 03500060 +C **** TEST 10 **** 03510060 +C 03520060 + IF (ICZERO) 30100, 100, 30100 03530060 + 100 CONTINUE 03540060 + RVCOMP = .65001 03550060 + GO TO 40100 03560060 +30100 IVDELE = IVDELE + 1 03570060 + WRITE (I02,80003) IVTNUM 03580060 + IF (ICZERO) 40100, 111, 40100 03590060 +40100 IF (RVCOMP - .64996) 20100,10100,40101 03600060 +40101 IF (RVCOMP - .65006) 10100,10100,20100 03610060 +10100 IVPASS = IVPASS + 1 03620060 + WRITE (I02,80001) IVTNUM 03630060 + GO TO 111 03640060 +20100 IVFAIL = IVFAIL + 1 03650060 + RVCORR = .65001 03660060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03670060 + 111 CONTINUE 03680060 + IVTNUM = 11 03690060 +C 03700060 +C **** TEST 11 **** 03710060 +C 03720060 + IF (ICZERO) 30110, 110, 30110 03730060 + 110 CONTINUE 03740060 + RVCOMP = -.33333 03750060 + GO TO 40110 03760060 +30110 IVDELE = IVDELE + 1 03770060 + WRITE (I02,80003) IVTNUM 03780060 + IF (ICZERO) 40110, 121, 40110 03790060 +40110 IF (RVCOMP + .33338) 20110,10110,40111 03800060 +40111 IF (RVCOMP + .33328) 10110,10110,20110 03810060 +10110 IVPASS = IVPASS + 1 03820060 + WRITE (I02,80001) IVTNUM 03830060 + GO TO 121 03840060 +20110 IVFAIL = IVFAIL + 1 03850060 + RVCORR = -.33333 03860060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03870060 +C 03880060 +C TEST 012 THROUGH TEST 19 - REAL CONSTANT IS BASIC REAL CONSTANT 03890060 +C - FOLLOWED BY DECIMAL EXPONENT 03900060 +C 03910060 + 121 CONTINUE 03920060 + IVTNUM = 12 03930060 +C 03940060 +C **** TEST 12 **** 03950060 +C 03960060 + IF (ICZERO) 30120, 120, 30120 03970060 + 120 CONTINUE 03980060 + RVCOMP = .2E+1 03990060 + GO TO 40120 04000060 +30120 IVDELE = IVDELE + 1 04010060 + WRITE (I02,80003) IVTNUM 04020060 + IF (ICZERO) 40120, 131, 40120 04030060 +40120 IF (RVCOMP - 1.9995) 20120,10120,40121 04040060 +40121 IF (RVCOMP - 2.0005) 10120,10120,20120 04050060 +10120 IVPASS = IVPASS + 1 04060060 + WRITE (I02,80001) IVTNUM 04070060 + GO TO 131 04080060 +20120 IVFAIL = IVFAIL + 1 04090060 + RVCORR = 2.0 04100060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04110060 + 131 CONTINUE 04120060 + IVTNUM = 13 04130060 +C 04140060 +C **** TEST 13 **** 04150060 +C 04160060 + IF (ICZERO) 30130, 130, 30130 04170060 + 130 CONTINUE 04180060 + RVCOMP = 2.0E+0 04190060 + GO TO 40130 04200060 +30130 IVDELE = IVDELE + 1 04210060 + WRITE (I02,80003) IVTNUM 04220060 + IF (ICZERO) 40130, 141, 40130 04230060 +40130 IF (RVCOMP - 1.9995) 20130,10130,40131 04240060 +40131 IF (RVCOMP - 2.0005) 10130,10130,20130 04250060 +10130 IVPASS = IVPASS + 1 04260060 + WRITE (I02,80001) IVTNUM 04270060 + GO TO 141 04280060 +20130 IVFAIL = IVFAIL + 1 04290060 + RVCORR = 2.0 04300060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04310060 + 141 CONTINUE 04320060 + IVTNUM = 14 04330060 +C 04340060 +C **** TEST 14 **** 04350060 +C 04360060 + IF (ICZERO) 30140, 140, 30140 04370060 + 140 CONTINUE 04380060 + RVCOMP = 445.0E-01 04390060 + GO TO 40140 04400060 +30140 IVDELE = IVDELE + 1 04410060 + WRITE (I02,80003) IVTNUM 04420060 + IF (ICZERO) 40140, 151, 40140 04430060 +40140 IF (RVCOMP - 44.495) 20140,10140,40141 04440060 +40141 IF (RVCOMP - 44.505) 10140,10140,20140 04450060 +10140 IVPASS = IVPASS + 1 04460060 + WRITE (I02,80001) IVTNUM 04470060 + GO TO 151 04480060 +20140 IVFAIL = IVFAIL + 1 04490060 + RVCORR = 44.5 04500060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04510060 + 151 CONTINUE 04520060 + IVTNUM = 15 04530060 +C 04540060 +C **** TEST 15 **** 04550060 +C 04560060 + IF (ICZERO) 30150, 150, 30150 04570060 + 150 CONTINUE 04580060 + RVCOMP = 4.450E1 04590060 + GO TO 40150 04600060 +30150 IVDELE = IVDELE + 1 04610060 + WRITE (I02,80003) IVTNUM 04620060 + IF (ICZERO) 40150, 161, 40150 04630060 +40150 IF (RVCOMP - 44.495) 20150,10150,40151 04640060 +40151 IF (RVCOMP - 44.505) 10150,10150,20150 04650060 +10150 IVPASS = IVPASS + 1 04660060 + WRITE (I02,80001) IVTNUM 04670060 + GO TO 161 04680060 +20150 IVFAIL = IVFAIL + 1 04690060 + RVCORR = 44.5 04700060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04710060 + 161 CONTINUE 04720060 + IVTNUM = 16 04730060 +C 04740060 +C **** TEST 16 **** 04750060 +C 04760060 + IF (ICZERO) 30160, 160, 30160 04770060 + 160 CONTINUE 04780060 + RVCOMP = 2.E+15 04790060 + GO TO 40160 04800060 +30160 IVDELE = IVDELE + 1 04810060 + WRITE (I02,80003) IVTNUM 04820060 + IF (ICZERO) 40160, 171, 40160 04830060 +40160 IF (RVCOMP - 1.9995E+15) 20160,10160,40161 04840060 +40161 IF (RVCOMP - 2.0005E+15) 10160,10160,20160 04850060 +10160 IVPASS = IVPASS + 1 04860060 + WRITE (I02,80001) IVTNUM 04870060 + GO TO 171 04880060 +20160 IVFAIL = IVFAIL + 1 04890060 + RVCORR = 2.0E+15 04900060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04910060 + 171 CONTINUE 04920060 + IVTNUM = 17 04930060 +C 04940060 +C **** TEST 17 **** 04950060 +C 04960060 + IF (ICZERO) 30170, 170, 30170 04970060 + 170 CONTINUE 04980060 + RVCOMP = 44.5E-15 04990060 + GO TO 40170 05000060 +30170 IVDELE = IVDELE + 1 05010060 + WRITE (I02,80003) IVTNUM 05020060 + IF (ICZERO) 40170, 181, 40170 05030060 +40170 IF (RVCOMP - 44.495E-15) 20170,10170,40171 05040060 +40171 IF (RVCOMP - 44.505E-15) 10170,10170,20170 05050060 +10170 IVPASS = IVPASS + 1 05060060 + WRITE (I02,80001) IVTNUM 05070060 + GO TO 181 05080060 +20170 IVFAIL = IVFAIL + 1 05090060 + RVCORR = 44.5E-15 05100060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05110060 + 181 CONTINUE 05120060 + IVTNUM = 18 05130060 +C 05140060 +C **** TEST 18 **** 05150060 +C 05160060 + IF (ICZERO) 30180, 180, 30180 05170060 + 180 CONTINUE 05180060 + RVCOMP = -4.45E0 05190060 + GO TO 40180 05200060 +30180 IVDELE = IVDELE + 1 05210060 + WRITE (I02,80003) IVTNUM 05220060 + IF (ICZERO) 40180, 191, 40180 05230060 +40180 IF (RVCOMP + 4.4505) 20180,10180,40181 05240060 +40181 IF (RVCOMP + 4.4495) 10180,10180,20180 05250060 +10180 IVPASS = IVPASS + 1 05260060 + WRITE (I02,80001) IVTNUM 05270060 + GO TO 191 05280060 +20180 IVFAIL = IVFAIL + 1 05290060 + RVCORR = -4.45 05300060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05310060 + 191 CONTINUE 05320060 + IVTNUM = 19 05330060 +C 05340060 +C **** TEST 19 **** 05350060 +C 05360060 + IF (ICZERO) 30190, 190, 30190 05370060 + 190 CONTINUE 05380060 + RVCOMP = -6511.8E-0 05390060 + GO TO 40190 05400060 +30190 IVDELE = IVDELE + 1 05410060 + WRITE (I02,80003) IVTNUM 05420060 + IF (ICZERO) 40190, 201, 40190 05430060 +40190 IF (RVCOMP + 6512.3) 20190,10190,40191 05440060 +40191 IF (RVCOMP + 6511.3) 10190,10190,20190 05450060 +10190 IVPASS = IVPASS + 1 05460060 + WRITE (I02,80001) IVTNUM 05470060 + GO TO 201 05480060 +20190 IVFAIL = IVFAIL + 1 05490060 + RVCORR = -6511.8 05500060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05510060 +C 05520060 +C TEST 020 THROUGH TEST 025 - INTEGER CONSTANT FOLLOWED 05530060 +C - BY A DECIMAL EXPONENT 05540060 +C 05550060 + 201 CONTINUE 05560060 + IVTNUM = 20 05570060 +C 05580060 +C **** TEST 20 **** 05590060 +C 05600060 + IF (ICZERO) 30200, 200, 30200 05610060 + 200 CONTINUE 05620060 + RVCOMP = 2E+1 05630060 + GO TO 40200 05640060 +30200 IVDELE = IVDELE + 1 05650060 + WRITE (I02,80003) IVTNUM 05660060 + IF (ICZERO) 40200, 211, 40200 05670060 +40200 IF (RVCOMP - 19.995) 20200,10200,40201 05680060 +40201 IF (RVCOMP - 20.005) 10200,10200,20200 05690060 +10200 IVPASS = IVPASS + 1 05700060 + WRITE (I02,80001) IVTNUM 05710060 + GO TO 211 05720060 +20200 IVFAIL = IVFAIL + 1 05730060 + RVCORR = 20.0 05740060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05750060 + 211 CONTINUE 05760060 + IVTNUM = 21 05770060 +C 05780060 +C **** TEST 21 **** 05790060 +C 05800060 + IF (ICZERO) 30210, 210, 30210 05810060 + 210 CONTINUE 05820060 + RVCOMP = 445E-02 05830060 + GO TO 40210 05840060 +30210 IVDELE = IVDELE + 1 05850060 + WRITE (I02,80003) IVTNUM 05860060 + IF (ICZERO) 40210, 221, 40210 05870060 +40210 IF (RVCOMP - 4.4495) 20210,10210,40211 05880060 +40211 IF (RVCOMP - 4.4505) 10210,10210,20210 05890060 +10210 IVPASS = IVPASS + 1 05900060 + WRITE (I02,80001) IVTNUM 05910060 + GO TO 221 05920060 +20210 IVFAIL = IVFAIL + 1 05930060 + RVCORR = 4.45 05940060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05950060 + 221 CONTINUE 05960060 + IVTNUM = 22 05970060 +C 05980060 +C **** TEST 22 **** 05990060 +C 06000060 + IF (ICZERO) 30220, 220, 30220 06010060 + 220 CONTINUE 06020060 + RVCOMP = 7E3 06030060 + GO TO 40220 06040060 +30220 IVDELE = IVDELE + 1 06050060 + WRITE (I02,80003) IVTNUM 06060060 + IF (ICZERO) 40220, 231, 40220 06070060 +40220 IF (RVCOMP - 6999.0) 20220,10220,40221 06080060 +40221 IF (RVCOMP - 7001.0) 10220,10220,20220 06090060 +10220 IVPASS = IVPASS + 1 06100060 + WRITE (I02,80001) IVTNUM 06110060 + GO TO 231 06120060 +20220 IVFAIL = IVFAIL + 1 06130060 + RVCORR = 7000.0 06140060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06150060 + 231 CONTINUE 06160060 + IVTNUM = 23 06170060 +C 06180060 +C **** TEST 23 **** 06190060 +C 06200060 + IF (ICZERO) 30230, 230, 30230 06210060 + 230 CONTINUE 06220060 + RVCOMP = 214 E 0 06230060 + GO TO 40230 06240060 +30230 IVDELE = IVDELE + 1 06250060 + WRITE (I02,80003) IVTNUM 06260060 + IF (ICZERO) 40230, 241, 40230 06270060 +40230 IF (RVCOMP - 213.95) 20230,10230,40231 06280060 +40231 IF (RVCOMP - 214.05) 10230,10230,20230 06290060 +10230 IVPASS = IVPASS + 1 06300060 + WRITE (I02,80001) IVTNUM 06310060 + GO TO 241 06320060 +20230 IVFAIL = IVFAIL + 1 06330060 + RVCORR = 214.0 06340060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06350060 + 241 CONTINUE 06360060 + IVTNUM = 24 06370060 +C 06380060 +C **** TEST 24 **** 06390060 +C 06400060 + IF (ICZERO) 30240, 240, 30240 06410060 + 240 CONTINUE 06420060 + RVCOMP = -3276E+6 06430060 + GO TO 40240 06440060 +30240 IVDELE = IVDELE + 1 06450060 + WRITE (I02,80003) IVTNUM 06460060 + IF (ICZERO) 40240, 251, 40240 06470060 +40240 IF (RVCOMP + .32765E+10) 20240,10240,40241 06480060 +40241 IF (RVCOMP + .32755E+10) 10240,10240,20240 06490060 +10240 IVPASS = IVPASS + 1 06500060 + WRITE (I02,80001) IVTNUM 06510060 + GO TO 251 06520060 +20240 IVFAIL = IVFAIL + 1 06530060 + RVCORR = -3276E+6 06540060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06550060 + 251 CONTINUE 06560060 + IVTNUM = 25 06570060 +C 06580060 +C **** TEST 25 **** 06590060 +C 06600060 + IF (ICZERO) 30250, 250, 30250 06610060 + 250 CONTINUE 06620060 + RVCOMP = -7E3 06630060 + GO TO 40250 06640060 +30250 IVDELE = IVDELE + 1 06650060 + WRITE (I02,80003) IVTNUM 06660060 + IF (ICZERO) 40250, 261, 40250 06670060 +40250 IF (RVCOMP + 7001.) 20250,10250,40251 06680060 +40251 IF (RVCOMP + 6999.) 10250,10250,20250 06690060 +10250 IVPASS = IVPASS + 1 06700060 + WRITE (I02,80001) IVTNUM 06710060 + GO TO 261 06720060 +20250 IVFAIL = IVFAIL + 1 06730060 + RVCORR = -7000.0 06740060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06750060 +C 06760060 +C TEST 026 THROUGH TEST 028 CONTAIN ARITHMETIC ASSIGNMENT STATEMENT 06770060 +C OF THE FORM REAL VARIABLE = REAL VARIABLE 06780060 +C 06790060 + 261 CONTINUE 06800060 + IVTNUM = 26 06810060 +C 06820060 +C **** TEST 26 **** 06830060 +C 06840060 + IF (ICZERO) 30260, 260, 30260 06850060 + 260 CONTINUE 06860060 + RVON01 = .2E+1 06870060 + RVCOMP = RVON01 06880060 + GO TO 40260 06890060 +30260 IVDELE = IVDELE + 1 06900060 + WRITE (I02,80003) IVTNUM 06910060 + IF (ICZERO) 40260, 271, 40260 06920060 +40260 IF (RVCOMP - 1.9995) 20260,10260,40261 06930060 +40261 IF (RVCOMP - 2.0005) 10260,10260,20260 06940060 +10260 IVPASS = IVPASS + 1 06950060 + WRITE (I02,80001) IVTNUM 06960060 + GO TO 271 06970060 +20260 IVFAIL = IVFAIL + 1 06980060 + RVCORR = 20.0 06990060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07000060 + 271 CONTINUE 07010060 + IVTNUM = 27 07020060 +C 07030060 +C **** TEST 27 **** 07040060 +C 07050060 + IF (ICZERO) 30270, 270, 30270 07060060 + 270 CONTINUE 07070060 + RVON01 = -445.E-01 07080060 + RVCOMP = RVON01 07090060 + GO TO 40270 07100060 +30270 IVDELE = IVDELE + 1 07110060 + WRITE (I02,80003) IVTNUM 07120060 + IF (ICZERO) 40270, 281, 40270 07130060 +40270 IF (RVCOMP + 44.505) 20270,10270,40271 07140060 +40271 IF (RVCOMP + 44.495) 10270,10270,20270 07150060 +10270 IVPASS = IVPASS + 1 07160060 + WRITE (I02,80001) IVTNUM 07170060 + GO TO 281 07180060 +20270 IVFAIL = IVFAIL + 1 07190060 + RVCORR = -44.5 07200060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07210060 + 281 CONTINUE 07220060 + IVTNUM = 28 07230060 +C 07240060 +C **** TEST 28 **** 07250060 +C 07260060 + IF (ICZERO) 30280, 280, 30280 07270060 + 280 CONTINUE 07280060 + RVON01 = 7E3 07290060 + RVCOMP = RVON01 07300060 + GO TO 40280 07310060 +30280 IVDELE = IVDELE + 1 07320060 + WRITE (I02,80003) IVTNUM 07330060 + IF (ICZERO) 40280, 291, 40280 07340060 +40280 IF (RVCOMP - 6999.0) 20280,10280,40281 07350060 +40281 IF (RVCOMP-7001.0) 10280,10280,20280 07360060 +10280 IVPASS = IVPASS + 1 07370060 + WRITE (I02,80001) IVTNUM 07380060 + GO TO 291 07390060 +20280 IVFAIL = IVFAIL + 1 07400060 + RVCORR = 7000.0 07410060 +C 07420060 +C TEST 029 THROUGH TEST 031 CONTAIN ARITHMETIC ASSIGNMENT STATEMENT 07430060 +C OF THE FORM REAL VARIABLE = - REAL VARIABLE 07440060 +C 07450060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07460060 + 291 CONTINUE 07470060 + IVTNUM = 29 07480060 +C 07490060 +C **** TEST 29 **** 07500060 +C 07510060 + IF (ICZERO) 30290, 290, 30290 07520060 + 290 CONTINUE 07530060 + RVON01 = .2E+1 07540060 + RVCOMP = -RVON01 07550060 + GO TO 40290 07560060 +30290 IVDELE = IVDELE + 1 07570060 + WRITE (I02,80003) IVTNUM 07580060 + IF (ICZERO) 40290, 301, 40290 07590060 +40290 IF (RVCOMP + 2.0005) 20290,10290,40291 07600060 +40291 IF (RVCOMP + 1.9995) 10290,10290,20290 07610060 +10290 IVPASS = IVPASS + 1 07620060 + WRITE (I02,80001) IVTNUM 07630060 + GO TO 301 07640060 +20290 IVFAIL = IVFAIL + 1 07650060 + RVCORR = -2.0 07660060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07670060 + 301 CONTINUE 07680060 + IVTNUM = 30 07690060 +C 07700060 +C **** TEST 30 **** 07710060 +C 07720060 + IF (ICZERO) 30300, 300, 30300 07730060 + 300 CONTINUE 07740060 + RVON01 = -445.E-01 07750060 + RVCOMP = -RVON01 07760060 + GO TO 40300 07770060 +30300 IVDELE = IVDELE + 1 07780060 + WRITE (I02,80003) IVTNUM 07790060 + IF (ICZERO) 40300, 311, 40300 07800060 +40300 IF (RVCOMP - 44.495) 20300,10300,40301 07810060 +40301 IF (RVCOMP - 44.505) 10300,10300,20300 07820060 +10300 IVPASS = IVPASS + 1 07830060 + WRITE (I02,80001) IVTNUM 07840060 + GO TO 311 07850060 +20300 IVFAIL = IVFAIL + 1 07860060 + RVCORR = 44.5 07870060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07880060 + 311 CONTINUE 07890060 + IVTNUM = 31 07900060 +C 07910060 +C **** TEST 31 **** 07920060 +C 07930060 + IF (ICZERO) 30310, 310, 30310 07940060 + 310 CONTINUE 07950060 + RVON01 = -.44559E1 07960060 + RVCOMP = -RVON01 07970060 + GO TO 40310 07980060 +30310 IVDELE = IVDELE + 1 07990060 + WRITE (I02,80003) IVTNUM 08000060 + IF (ICZERO) 40310, 321, 40310 08010060 +40310 IF (RVCOMP - 4.4554) 20310,10310,40311 08020060 +40311 IF (RVCOMP - 4.4564) 10310,10310,20310 08030060 +10310 IVPASS = IVPASS + 1 08040060 + WRITE (I02,80001) IVTNUM 08050060 + GO TO 321 08060060 +20310 IVFAIL = IVFAIL + 1 08070060 + RVCORR = 4.4559 08080060 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08090060 +C **** END OF TESTS **** 08100060 + 321 CONTINUE 08110060 +C 08120060 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08130060 +99999 CONTINUE 08140060 + WRITE (I02,90002) 08150060 + WRITE (I02,90006) 08160060 + WRITE (I02,90002) 08170060 + WRITE (I02,90002) 08180060 + WRITE (I02,90007) 08190060 + WRITE (I02,90002) 08200060 + WRITE (I02,90008) IVFAIL 08210060 + WRITE (I02,90009) IVPASS 08220060 + WRITE (I02,90010) IVDELE 08230060 +C 08240060 +C 08250060 +C TERMINATE ROUTINE EXECUTION 08260060 + STOP 08270060 +C 08280060 +C FORMAT STATEMENTS FOR PAGE HEADERS 08290060 +90000 FORMAT ("1") 08300060 +90002 FORMAT (" ") 08310060 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08320060 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08330060 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08340060 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08350060 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08360060 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08370060 +C 08380060 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08390060 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08400060 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08410060 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08420060 +C 08430060 +C FORMAT STATEMENTS FOR TEST RESULTS 08440060 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08450060 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08460060 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08470060 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08480060 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08490060 +C 08500060 +90007 FORMAT (" ",20X,"END OF PROGRAM FM060" ) 08510060 + END 08520060 diff --git a/Fortran/UnitTests/fcvs21_f95/FM060.reference_output b/Fortran/UnitTests/fcvs21_f95/FM060.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM060.reference_output @@ -0,0 +1,55 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM060 + + 0 ERRORS ENCOUNTERED + 31 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM061.f b/Fortran/UnitTests/fcvs21_f95/FM061.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM061.f @@ -0,0 +1,788 @@ + PROGRAM FM061 + +C COMMENT SECTION 00010061 +C 00020061 +C FM061 00030061 +C 00040061 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS OF THE 00050061 +C FORM 00060061 +C INTEGER VARIABLE = REAL CONSTANT 00070061 +C INTEGER VARIABLE = REAL VARIABLE 00080061 +C REAL VARIABLE = INTEGER VARIABLE 00090061 +C REAL VARIABLE = INTEGER CONSTANT 00100061 +C 00110061 +C THE CONSTANTS AND VARIABLES CONTAIN BOTH POSITIVE AND NEGATIVE 00120061 +C VALUES. 00130061 +C 00140061 +C A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A 00150061 +C REAL NUMBER. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES. 00160061 +C 00170061 +C A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A 00180061 +C DECIMAL POINT, AND A DECIMAL FRACTION PART IN THAT ORDER. BOTH 00190061 +C THE INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS; 00200061 +C EITHER ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH. THE 00210061 +C CONSTANT IS AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A 00220061 +C DECIMAL NUMERAL. 00230061 +C 00240061 +C A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN 00250061 +C OPTIONALLY SIGNED INTEGER CONSTANT. 00260061 +C 00270061 +C A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT,00280061 +C A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN 00290061 +C INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT. 00300061 +C 00310061 +C REFERENCES 00320061 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00330061 +C X3.9-1978 00340061 +C 00350061 +C SECTION 4.4, REAL TYPE 00360061 +C SECTION 4.4.1, REAL CONSTANT 00370061 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00380061 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00390061 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00400061 +C SECTION 11.4, ARITHMETIC IF STATEMENT 00410061 +C 00420061 +C ********************************************************** 00430061 +C 00440061 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00450061 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00460061 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00470061 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00480061 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00490061 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00500061 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00510061 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00520061 +C OF EXECUTING THESE TESTS. 00530061 +C 00540061 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00550061 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00560061 +C 00570061 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00580061 +C 00590061 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00600061 +C SOFTWARE STANDARDS VALIDATION GROUP 00610061 +C BUILDING 225 RM A266 00620061 +C GAITHERSBURG, MD 20899 00630061 +C ********************************************************** 00640061 +C 00650061 +C 00660061 +C 00670061 +C INITIALIZATION SECTION 00680061 +C 00690061 +C INITIALIZE CONSTANTS 00700061 +C ************** 00710061 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00720061 + I01 = 5 00730061 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00740061 + I02 = 6 00750061 +C SYSTEM ENVIRONMENT SECTION 00760061 +C 00770061 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00780061 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00790061 +C (UNIT NUMBER FOR CARD READER). 00800061 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00810061 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00820061 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00830061 +C 00840061 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00850061 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00860061 +C (UNIT NUMBER FOR PRINTER). 00870061 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00880061 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00890061 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00900061 +C 00910061 + IVPASS=0 00920061 + IVFAIL=0 00930061 + IVDELE=0 00940061 + ICZERO=0 00950061 +C 00960061 +C WRITE PAGE HEADERS 00970061 + WRITE (I02,90000) 00980061 + WRITE (I02,90001) 00990061 + WRITE (I02,90002) 01000061 + WRITE (I02, 90002) 01010061 + WRITE (I02,90003) 01020061 + WRITE (I02,90002) 01030061 + WRITE (I02,90004) 01040061 + WRITE (I02,90002) 01050061 + WRITE (I02,90011) 01060061 + WRITE (I02,90002) 01070061 + WRITE (I02,90002) 01080061 + WRITE (I02,90005) 01090061 + WRITE (I02,90006) 01100061 + WRITE (I02,90002) 01110061 +C 01120061 +C TEST SECTION 01130061 +C 01140061 +C TEST 32 THROUGH TEST 42 CONTAIN ARITHMETIC ASSIGNMENT 01150061 +C STATEMENTS OF THE FORM 01160061 +C 01170061 +C INTEGER VARIABLE = REAL VARIABLE 01180061 +C 01190061 + IVTNUM = 32 01200061 +C 01210061 +C **** TEST 32 **** 01220061 +C 01230061 + IF (ICZERO) 30320, 320, 30320 01240061 + 320 CONTINUE 01250061 + RVON01 = 44.5 01260061 + IVCOMP = RVON01 01270061 + GO TO 40320 01280061 +30320 IVDELE = IVDELE + 1 01290061 + WRITE (I02,80003) IVTNUM 01300061 + IF (ICZERO) 40320, 331, 40320 01310061 +40320 IF (IVCOMP - 44) 20320,10320,20320 01320061 +10320 IVPASS = IVPASS + 1 01330061 + WRITE (I02,80001) IVTNUM 01340061 + GO TO 331 01350061 +20320 IVFAIL = IVFAIL + 1 01360061 + IVCORR = 44 01370061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01380061 + 331 CONTINUE 01390061 + IVTNUM = 33 01400061 +C 01410061 +C **** TEST 33 **** 01420061 +C 01430061 + IF (ICZERO) 30330, 330, 30330 01440061 + 330 CONTINUE 01450061 + RVON01 = -2.0005 01460061 + IVCOMP = RVON01 01470061 + GO TO 40330 01480061 +30330 IVDELE = IVDELE + 1 01490061 + WRITE (I02,80003) IVTNUM 01500061 + IF (ICZERO) 40330, 341, 40330 01510061 +40330 IF (IVCOMP + 2) 20330,10330,20330 01520061 +10330 IVPASS = IVPASS + 1 01530061 + WRITE (I02,80001) IVTNUM 01540061 + GO TO 341 01550061 +20330 IVFAIL = IVFAIL + 1 01560061 + IVCORR = -2 01570061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01580061 + 341 CONTINUE 01590061 + IVTNUM = 34 01600061 +C 01610061 +C **** TEST 34 **** 01620061 +C 01630061 + IF (ICZERO) 30340, 340, 30340 01640061 + 340 CONTINUE 01650061 + RVON01 = .32767 01660061 + IVCOMP = RVON01 01670061 + GO TO 40340 01680061 +30340 IVDELE = IVDELE + 1 01690061 + WRITE (I02,80003) IVTNUM 01700061 + IF (ICZERO) 40340, 351, 40340 01710061 +40340 IF (IVCOMP) 20340,10340,20340 01720061 +10340 IVPASS = IVPASS + 1 01730061 + WRITE (I02,80001) IVTNUM 01740061 + GO TO 351 01750061 +20340 IVFAIL = IVFAIL + 1 01760061 + IVCORR = 0 01770061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01780061 + 351 CONTINUE 01790061 + IVTNUM = 35 01800061 +C 01810061 +C **** TEST 35 **** 01820061 +C 01830061 + IF (ICZERO) 30350, 350, 30350 01840061 + 350 CONTINUE 01850061 + RVON01 = 1.999 01860061 + IVCOMP = RVON01 01870061 + GO TO 40350 01880061 +30350 IVDELE = IVDELE + 1 01890061 + WRITE (I02,80003) IVTNUM 01900061 + IF (ICZERO) 40350, 361, 40350 01910061 +40350 IF (IVCOMP - 1) 20350,10350,20350 01920061 +10350 IVPASS = IVPASS + 1 01930061 + WRITE (I02,80001) IVTNUM 01940061 + GO TO 361 01950061 +20350 IVFAIL = IVFAIL + 1 01960061 + IVCORR = 1 01970061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01980061 + 361 CONTINUE 01990061 + IVTNUM = 36 02000061 +C 02010061 +C **** TEST 36 **** 02020061 +C 02030061 + IF (ICZERO) 30360, 360, 30360 02040061 + 360 CONTINUE 02050061 + RVON01 = .25E+1 02060061 + IVCOMP = RVON01 02070061 + GO TO 40360 02080061 +30360 IVDELE = IVDELE + 1 02090061 + WRITE (I02,80003) IVTNUM 02100061 + IF (ICZERO) 40360, 371, 40360 02110061 +40360 IF (IVCOMP - 2) 20360,10360,20360 02120061 +10360 IVPASS = IVPASS + 1 02130061 + WRITE (I02,80001) IVTNUM 02140061 + GO TO 371 02150061 +20360 IVFAIL = IVFAIL + 1 02160061 + IVCORR = 2 02170061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02180061 + 371 CONTINUE 02190061 + IVTNUM = 37 02200061 +C 02210061 +C **** TEST 37 **** 02220061 +C 02230061 + IF (ICZERO) 30370, 370, 30370 02240061 + 370 CONTINUE 02250061 + RVON01 = 445.0E-01 02260061 + IVCOMP = RVON01 02270061 + GO TO 40370 02280061 +30370 IVDELE = IVDELE + 1 02290061 + WRITE (I02,80003) IVTNUM 02300061 + IF (ICZERO) 40370, 381, 40370 02310061 +40370 IF (IVCOMP - 44) 20370,10370,20370 02320061 +10370 IVPASS = IVPASS + 1 02330061 + WRITE (I02,80001) IVTNUM 02340061 + GO TO 381 02350061 +20370 IVFAIL = IVFAIL + 1 02360061 + IVCORR = 44 02370061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02380061 + 381 CONTINUE 02390061 + IVTNUM = 38 02400061 +C 02410061 +C **** TEST 38 **** 02420061 +C 02430061 + IF (ICZERO) 30380, 380, 30380 02440061 + 380 CONTINUE 02450061 + RVON01 = -651.1E-0 02460061 + IVCOMP = RVON01 02470061 + GO TO 40380 02480061 +30380 IVDELE = IVDELE + 1 02490061 + WRITE (I02,80003) IVTNUM 02500061 + IF (ICZERO) 40380, 391, 40380 02510061 +40380 IF (IVCOMP + 651) 20380,10380,20380 02520061 +10380 IVPASS = IVPASS + 1 02530061 + WRITE (I02,80001) IVTNUM 02540061 + GO TO 391 02550061 +20380 IVFAIL = IVFAIL + 1 02560061 + IVCORR = -651 02570061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02580061 + 391 CONTINUE 02590061 + IVTNUM = 39 02600061 +C 02610061 +C **** TEST 39 **** 02620061 +C 02630061 + IF (ICZERO) 30390, 390, 30390 02640061 + 390 CONTINUE 02650061 + RVON01 = .3266E4 02660061 + IVCOMP = RVON01 02670061 + GO TO 40390 02680061 +30390 IVDELE = IVDELE + 1 02690061 + WRITE (I02,80003) IVTNUM 02700061 + IF (ICZERO) 40390, 401, 40390 02710061 +40390 IF (IVCOMP - 3266) 20390,10390,20390 02720061 +10390 IVPASS = IVPASS + 1 02730061 + WRITE (I02,80001) IVTNUM 02740061 + GO TO 401 02750061 +20390 IVFAIL = IVFAIL + 1 02760061 + IVCORR = 3266 02770061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02780061 + 401 CONTINUE 02790061 + IVTNUM = 40 02800061 +C 02810061 +C **** TEST 40 **** 02820061 +C 02830061 + IF (ICZERO) 30400, 400, 30400 02840061 + 400 CONTINUE 02850061 + RVON01 = 35.43E-01 02860061 + IVCOMP = RVON01 02870061 + GO TO 40400 02880061 +30400 IVDELE = IVDELE + 1 02890061 + WRITE (I02,80003) IVTNUM 02900061 + IF (ICZERO) 40400, 411, 40400 02910061 +40400 IF (IVCOMP - 3) 20400,10400,20400 02920061 +10400 IVPASS = IVPASS + 1 02930061 + WRITE (I02,80001) IVTNUM 02940061 + GO TO 411 02950061 +20400 IVFAIL = IVFAIL + 1 02960061 + IVCORR = 3 02970061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02980061 + 411 CONTINUE 02990061 + IVTNUM = 41 03000061 +C 03010061 +C **** TEST 41 **** 03020061 +C 03030061 + IF (ICZERO) 30410, 410, 30410 03040061 + 410 CONTINUE 03050061 + RVON01 = -7.001E2 03060061 + IVCOMP = RVON01 03070061 + GO TO 40410 03080061 +30410 IVDELE = IVDELE + 1 03090061 + WRITE (I02,80003) IVTNUM 03100061 + IF (ICZERO) 40410, 421, 40410 03110061 +40410 IF (IVCOMP + 700) 20410,10410,20410 03120061 +10410 IVPASS = IVPASS + 1 03130061 + WRITE (I02,80001) IVTNUM 03140061 + GO TO 421 03150061 +20410 IVFAIL = IVFAIL + 1 03160061 + IVCORR = -700 03170061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03180061 + 421 CONTINUE 03190061 + IVTNUM = 42 03200061 +C 03210061 +C **** TEST 42 **** 03220061 +C 03230061 + IF (ICZERO) 30420, 420, 30420 03240061 + 420 CONTINUE 03250061 + RVON01 = 4.45E-02 03260061 + IVCOMP = RVON01 03270061 + GO TO 40420 03280061 +30420 IVDELE = IVDELE + 1 03290061 + WRITE (I02,80003) IVTNUM 03300061 + IF (ICZERO) 40420, 431, 40420 03310061 +40420 IF (IVCOMP) 20420,10420,20420 03320061 +10420 IVPASS = IVPASS + 1 03330061 + WRITE (I02,80001) IVTNUM 03340061 + GO TO 431 03350061 +20420 IVFAIL = IVFAIL + 1 03360061 + IVCORR = 0 03370061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03380061 +C TEST 43 THROUGH TEST 48 CONTAIN ARITHMETIC ASSIGNMENT 03390061 +C STATEMENTS OF THE FORM 03400061 +C 03410061 +C REAL VARIABLE = INTEGER VARIABLE 03420061 +C 03430061 + 431 CONTINUE 03440061 + IVTNUM = 43 03450061 +C 03460061 +C **** TEST 43 **** 03470061 +C 03480061 + IF (ICZERO) 30430, 430, 30430 03490061 + 430 CONTINUE 03500061 + IVON01 = 2 03510061 + RVCOMP = IVON01 03520061 + GO TO 40430 03530061 +30430 IVDELE = IVDELE + 1 03540061 + WRITE (I02,80003) IVTNUM 03550061 + IF (ICZERO) 40430, 441, 40430 03560061 +40430 IF (RVCOMP - 1.9995) 20430,10430,40431 03570061 +40431 IF (RVCOMP - 2.0005) 10430,10430,20430 03580061 +10430 IVPASS = IVPASS + 1 03590061 + WRITE (I02,80001) IVTNUM 03600061 + GO TO 441 03610061 +20430 IVFAIL = IVFAIL + 1 03620061 + RVCORR = 2.0000 03630061 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03640061 + 441 CONTINUE 03650061 + IVTNUM = 44 03660061 +C 03670061 +C **** TEST 44 **** 03680061 +C 03690061 + IF (ICZERO) 30440, 440, 30440 03700061 + 440 CONTINUE 03710061 + IVON01 = 25 03720061 + RVCOMP = IVON01 03730061 + GO TO 40440 03740061 +30440 IVDELE = IVDELE + 1 03750061 + WRITE (I02,80003) IVTNUM 03760061 + IF (ICZERO) 40440, 451, 40440 03770061 +40440 IF (RVCOMP - 24.995) 20440,10440,40441 03780061 +40441 IF (RVCOMP - 25.005) 10440,10440,20440 03790061 +10440 IVPASS = IVPASS + 1 03800061 + WRITE (I02,80001) IVTNUM 03810061 + GO TO 451 03820061 +20440 IVFAIL = IVFAIL + 1 03830061 + RVCORR = 25.000 03840061 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03850061 + 451 CONTINUE 03860061 + IVTNUM = 45 03870061 +C 03880061 +C **** TEST 45 **** 03890061 +C 03900061 + IF (ICZERO) 30450, 450, 30450 03910061 + 450 CONTINUE 03920061 + IVON01 = 357 03930061 + RVCOMP = IVON01 03940061 + GO TO 40450 03950061 +30450 IVDELE = IVDELE + 1 03960061 + WRITE (I02,80003) IVTNUM 03970061 + IF (ICZERO) 40450, 461, 40450 03980061 +40450 IF (RVCOMP - 356.95) 20450,10450,40451 03990061 +40451 IF (RVCOMP - 357.05) 10450,10450,20450 04000061 +10450 IVPASS = IVPASS + 1 04010061 + WRITE (I02,80001) IVTNUM 04020061 + GO TO 461 04030061 +20450 IVFAIL = IVFAIL + 1 04040061 + RVCORR = 357.00 04050061 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04060061 + 461 CONTINUE 04070061 + IVTNUM = 46 04080061 +C 04090061 +C **** TEST 46 **** 04100061 +C 04110061 + IF (ICZERO) 30460, 460, 30460 04120061 + 460 CONTINUE 04130061 + IVON01 = 4968 04140061 + RVCOMP = IVON01 04150061 + GO TO 40460 04160061 +30460 IVDELE = IVDELE + 1 04170061 + WRITE (I02,80003) IVTNUM 04180061 + IF (ICZERO) 40460, 471, 40460 04190061 +40460 IF (RVCOMP - 4967.5) 20460,10460,40461 04200061 +40461 IF (RVCOMP - 4968.5) 10460,10460,20460 04210061 +10460 IVPASS = IVPASS + 1 04220061 + WRITE (I02,80001) IVTNUM 04230061 + GO TO 471 04240061 +20460 IVFAIL = IVFAIL + 1 04250061 + RVCORR = 4968.0 04260061 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04270061 + 471 CONTINUE 04280061 + IVTNUM = 47 04290061 +C 04300061 +C **** TEST 47 **** 04310061 +C 04320061 + IF (ICZERO) 30470, 470, 30470 04330061 + 470 CONTINUE 04340061 + IVON01 = 32767 04350061 + RVCOMP = IVON01 04360061 + GO TO 40470 04370061 +30470 IVDELE = IVDELE + 1 04380061 + WRITE (I02,80003) IVTNUM 04390061 + IF (ICZERO) 40470, 481, 40470 04400061 +40470 IF (RVCOMP - 32762.) 20470,10470,40471 04410061 +40471 IF (RVCOMP - 32772.) 10470,10470,20470 04420061 +10470 IVPASS = IVPASS + 1 04430061 + WRITE (I02,80001) IVTNUM 04440061 + GO TO 481 04450061 +20470 IVFAIL = IVFAIL + 1 04460061 + RVCORR = 32767. 04470061 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04480061 + 481 CONTINUE 04490061 + IVTNUM = 48 04500061 +C 04510061 +C **** TEST 48 **** 04520061 +C 04530061 + IF (ICZERO) 30480, 480, 30480 04540061 + 480 CONTINUE 04550061 + IVON01 = -2 04560061 + RVCOMP = IVON01 04570061 + GO TO 40480 04580061 +30480 IVDELE = IVDELE + 1 04590061 + WRITE (I02,80003) IVTNUM 04600061 + IF (ICZERO) 40480, 491, 40480 04610061 +40480 IF (RVCOMP + 2.0005) 20480,10480,40481 04620061 +40481 IF (RVCOMP + 1.9995) 10480,10480,20450 04630061 +10480 IVPASS = IVPASS + 1 04640061 + WRITE (I02,80001) IVTNUM 04650061 + GO TO 491 04660061 +20480 IVFAIL = IVFAIL + 1 04670061 + RVCORR = -2.0000 04680061 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04690061 +C 04700061 +C TEST 49 THROUGH TEST 51 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS 04710061 +C OF THE FORM 04720061 +C INTEGER VARIABLE = REAL CONSTANT 04730061 +C WHERE CONSTANT IS BASIC REAL CONSTANT 04740061 +C 04750061 + 491 CONTINUE 04760061 + IVTNUM = 49 04770061 +C 04780061 +C **** TEST 49 **** 04790061 +C 04800061 + IF (ICZERO) 30490, 490, 30490 04810061 + 490 CONTINUE 04820061 + IVCOMP = 44.5 04830061 + GO TO 40490 04840061 +30490 IVDELE = IVDELE + 1 04850061 + WRITE (I02,80003) IVTNUM 04860061 + IF (ICZERO) 40490, 501, 40490 04870061 +40490 IF (IVCOMP - 44) 20490,10490,20490 04880061 +10490 IVPASS = IVPASS + 1 04890061 + WRITE (I02,80001) IVTNUM 04900061 + GO TO 501 04910061 +20490 IVFAIL = IVFAIL + 1 04920061 + IVCORR = 44 04930061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04940061 + 501 CONTINUE 04950061 + IVTNUM = 50 04960061 +C 04970061 +C **** TEST 50 **** 04980061 +C 04990061 + IF (ICZERO) 30500, 500, 30500 05000061 + 500 CONTINUE 05010061 + IVCOMP = 6500.1 05020061 + GO TO 40500 05030061 +30500 IVDELE = IVDELE + 1 05040061 + WRITE (I02,80003) IVTNUM 05050061 + IF (ICZERO) 40500, 511, 40500 05060061 +40500 IF (IVCOMP - 6500) 20500,10500,20500 05070061 +10500 IVPASS = IVPASS + 1 05080061 + WRITE (I02,80001) IVTNUM 05090061 + GO TO 511 05100061 +20500 IVFAIL = IVFAIL + 1 05110061 + IVCORR = 6500 05120061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05130061 + 511 CONTINUE 05140061 + IVTNUM = 51 05150061 +C 05160061 +C **** TEST 51 **** 05170061 +C 05180061 + IF (ICZERO) 30510, 510, 30510 05190061 + 510 CONTINUE 05200061 + IVCOMP = -.33333 05210061 + GO TO 40510 05220061 +30510 IVDELE = IVDELE + 1 05230061 + WRITE (I02,80003) IVTNUM 05240061 + IF (ICZERO) 40510, 521, 40510 05250061 +40510 IF (IVCOMP) 20510,10510,20510 05260061 +10510 IVPASS = IVPASS + 1 05270061 + WRITE (I02,80001) IVTNUM 05280061 + GO TO 521 05290061 +20510 IVFAIL = IVFAIL + 1 05300061 + IVCORR = 0 05310061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05320061 +C 05330061 +C TEST 52 THROUGH TEST 55 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS 05340061 +C OF THE FORM 05350061 +C INTEGER VARIABLE = REAL CONSTANT 05360061 +C 05370061 +C WHERE CONSTANT IS BASIC REAL CONSTANT FOLLOWED BY DECIMAL EXPONENT05380061 +C 05390061 + 521 CONTINUE 05400061 + IVTNUM = 52 05410061 +C 05420061 +C **** TEST 52 **** 05430061 +C 05440061 + IF (ICZERO) 30520, 520, 30520 05450061 + 520 CONTINUE 05460061 + IVCOMP = .21E+1 05470061 + GO TO 40520 05480061 +30520 IVDELE = IVDELE + 1 05490061 + WRITE (I02,80003) IVTNUM 05500061 + IF (ICZERO) 40520, 531, 40520 05510061 +40520 IF (IVCOMP - 2) 20520,10520,20520 05520061 +10520 IVPASS = IVPASS + 1 05530061 + WRITE (I02,80001) IVTNUM 05540061 + GO TO 531 05550061 +20520 IVFAIL = IVFAIL + 1 05560061 + IVCORR = 2 05570061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05580061 + 531 CONTINUE 05590061 + IVTNUM = 53 05600061 +C 05610061 +C **** TEST 53 **** 05620061 +C 05630061 + IF (ICZERO) 30530, 530, 30530 05640061 + 530 CONTINUE 05650061 + IVCOMP = 445.0E-01 05660061 + GO TO 40530 05670061 +30530 IVDELE = IVDELE + 1 05680061 + WRITE (I02,80003) IVTNUM 05690061 + IF (ICZERO) 40530, 541, 40530 05700061 +40530 IF (IVCOMP - 44) 20530,10530,20530 05710061 +10530 IVPASS = IVPASS + 1 05720061 + WRITE (I02,80001) IVTNUM 05730061 + GO TO 541 05740061 +20530 IVFAIL = IVFAIL + 1 05750061 + IVCORR = 44 05760061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05770061 + 541 CONTINUE 05780061 + IVTNUM = 54 05790061 +C 05800061 +C **** TEST 54 **** 05810061 +C 05820061 + IF (ICZERO) 30540, 540, 30540 05830061 + 540 CONTINUE 05840061 + IVCOMP = 4.450E1 05850061 + GO TO 40540 05860061 +30540 IVDELE = IVDELE + 1 05870061 + WRITE (I02,80003) IVTNUM 05880061 + IF (ICZERO) 40540, 551, 40540 05890061 +40540 IF (IVCOMP - 44) 20540,10540,20540 05900061 +10540 IVPASS = IVPASS + 1 05910061 + WRITE (I02,80001) IVTNUM 05920061 + GO TO 551 05930061 +20540 IVFAIL = IVFAIL + 1 05940061 + IVCORR = 44 05950061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05960061 + 551 CONTINUE 05970061 + IVTNUM = 55 05980061 +C 05990061 +C **** TEST 55 **** 06000061 +C 06010061 + IF (ICZERO) 30550, 550, 30550 06020061 + 550 CONTINUE 06030061 + IVCOMP = -4.45E0 06040061 + GO TO 40550 06050061 +30550 IVDELE = IVDELE + 1 06060061 + WRITE (I02,80003) IVTNUM 06070061 + IF (ICZERO) 40550, 561, 40550 06080061 +40550 IF (IVCOMP + 4) 20550,10550,20550 06090061 +10550 IVPASS = IVPASS + 1 06100061 + WRITE (I02,80001) IVTNUM 06110061 + GO TO 561 06120061 +20550 IVFAIL = IVFAIL + 1 06130061 + IVCORR = -4 06140061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06150061 +C 06160061 +C TEST 56 AND 57 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS OF THE 06170061 +C FORM INTEGER VARIABLE = REAL CONSTANT 06180061 +C WHERE CONSTANT IS INTEGER CONSTANT FOLLOWED BY DECIMAL EXPONENT 06190061 +C 06200061 + 561 CONTINUE 06210061 + IVTNUM = 56 06220061 +C 06230061 +C **** TEST 56 **** 06240061 +C 06250061 + IF (ICZERO) 30560, 560, 30560 06260061 + 560 CONTINUE 06270061 + IVCOMP = 445E-02 06280061 + GO TO 40560 06290061 +30560 IVDELE = IVDELE + 1 06300061 + WRITE (I02,80003) IVTNUM 06310061 + IF (ICZERO) 40560, 571, 40560 06320061 +40560 IF (IVCOMP - 4) 20560,10560,20560 06330061 +10560 IVPASS = IVPASS + 1 06340061 + WRITE (I02,80001) IVTNUM 06350061 + GO TO 571 06360061 +20560 IVFAIL = IVFAIL + 1 06370061 + IVCORR = 4 06380061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06390061 + 571 CONTINUE 06400061 + IVTNUM = 57 06410061 +C 06420061 +C **** TEST 57 **** 06430061 +C 06440061 + IF (ICZERO) 30570, 570, 30570 06450061 + 570 CONTINUE 06460061 + IVCOMP = -701E-1 06470061 + GO TO 40570 06480061 +30570 IVDELE = IVDELE + 1 06490061 + WRITE (I02,80003) IVTNUM 06500061 + IF (ICZERO) 40570, 581, 40570 06510061 +40570 IF (IVCOMP + 70) 20570,10570,20570 06520061 +10570 IVPASS = IVPASS + 1 06530061 + WRITE (I02,80001) IVTNUM 06540061 + GO TO 581 06550061 +20570 IVFAIL = IVFAIL + 1 06560061 + IVCORR = -70 06570061 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06580061 +C 06590061 +C TEST 58 THROUGH TEST 62 CONTAIN ARITHMETIC ASSIGNMENT STATEMENTS 06600061 +C OF THE FORM REAL VARIABLE = INTEGER CONSTANT 06610061 +C 06620061 + 581 CONTINUE 06630061 + IVTNUM = 58 06640061 +C 06650061 +C **** TEST 58 **** 06660061 +C 06670061 + IF (ICZERO) 30580, 580, 30580 06680061 + 580 CONTINUE 06690061 + RVCOMP = 23 06700061 + GO TO 40580 06710061 +30580 IVDELE = IVDELE + 1 06720061 + WRITE (I02,80003) IVTNUM 06730061 + IF (ICZERO) 40580, 591, 40580 06740061 +40580 IF (RVCOMP - 22.995) 20580,10580,40581 06750061 +40581 IF (RVCOMP - 23.005) 10580,10580,20580 06760061 +10580 IVPASS = IVPASS + 1 06770061 + WRITE (I02,80001) IVTNUM 06780061 + GO TO 591 06790061 +20580 IVFAIL = IVFAIL + 1 06800061 + RVCORR = 23.000 06810061 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06820061 + 591 CONTINUE 06830061 + IVTNUM = 59 06840061 +C 06850061 +C **** TEST 59 **** 06860061 +C 06870061 + IF (ICZERO) 30590, 590, 30590 06880061 + 590 CONTINUE 06890061 + RVCOMP = 32645 06900061 + GO TO 40590 06910061 +30590 IVDELE = IVDELE + 1 06920061 + WRITE (I02,80003) IVTNUM 06930061 + IF (ICZERO) 40590, 601, 40590 06940061 +40590 IF (RVCOMP - 32640.) 20590,10590,40591 06950061 +40591 IF (RVCOMP - 32650.) 10590,10590,20590 06960061 +10590 IVPASS = IVPASS + 1 06970061 + WRITE (I02,80001) IVTNUM 06980061 + GO TO 601 06990061 +20590 IVFAIL = IVFAIL + 1 07000061 + RVCORR = 32645. 07010061 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07020061 + 601 CONTINUE 07030061 + IVTNUM = 60 07040061 +C 07050061 +C **** TEST 60 **** 07060061 +C 07070061 + IF (ICZERO) 30600, 600, 30600 07080061 + 600 CONTINUE 07090061 + RVCOMP = 0 07100061 + GO TO 40600 07110061 +30600 IVDELE = IVDELE + 1 07120061 + WRITE (I02,80003) IVTNUM 07130061 + IF (ICZERO) 40600, 611, 40600 07140061 +40600 IF (RVCOMP) 20600,10600,20600 07150061 +10600 IVPASS = IVPASS + 1 07160061 + WRITE (I02,80001) IVTNUM 07170061 + GO TO 611 07180061 +20600 IVFAIL = IVFAIL + 1 07190061 + RVCORR = 00000. 07200061 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07210061 + 611 CONTINUE 07220061 + IVTNUM = 61 07230061 +C 07240061 +C **** TEST 61 **** 07250061 +C 07260061 + IF (ICZERO) 30610, 610, 30610 07270061 + 610 CONTINUE 07280061 + RVCOMP = -15 07290061 + GO TO 40610 07300061 +30610 IVDELE = IVDELE + 1 07310061 + WRITE (I02,80003) IVTNUM 07320061 + IF (ICZERO) 40610, 621, 40610 07330061 +40610 IF (RVCOMP -14.995) 40611,10610,20610 07340061 +40611 IF (RVCOMP + 15.005) 20610,10610,10610 07350061 +10610 IVPASS = IVPASS + 1 07360061 + WRITE (I02,80001) IVTNUM 07370061 + GO TO 621 07380061 +20610 IVFAIL = IVFAIL + 1 07390061 + RVCORR = -15.000 07400061 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07410061 + 621 CONTINUE 07420061 +C 07430061 +C **** END OF TESTS **** 07440061 +C 07450061 +C 07460061 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 07470061 +99999 CONTINUE 07480061 + WRITE (I02,90002) 07490061 + WRITE (I02,90006) 07500061 + WRITE (I02,90002) 07510061 + WRITE (I02,90002) 07520061 + WRITE (I02,90007) 07530061 + WRITE (I02,90002) 07540061 + WRITE (I02,90008) IVFAIL 07550061 + WRITE (I02,90009) IVPASS 07560061 + WRITE (I02,90010) IVDELE 07570061 +C 07580061 +C 07590061 +C TERMINATE ROUTINE EXECUTION 07600061 + STOP 07610061 +C 07620061 +C FORMAT STATEMENTS FOR PAGE HEADERS 07630061 +90000 FORMAT ("1") 07640061 +90002 FORMAT (" ") 07650061 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07660061 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07670061 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07680061 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07690061 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07700061 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07710061 +C 07720061 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07730061 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07740061 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07750061 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07760061 +C 07770061 +C FORMAT STATEMENTS FOR TEST RESULTS 07780061 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07790061 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07800061 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07810061 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07820061 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07830061 +C 07840061 +90007 FORMAT (" ",20X,"END OF PROGRAM FM061" ) 07850061 + END 07860061 diff --git a/Fortran/UnitTests/fcvs21_f95/FM061.reference_output b/Fortran/UnitTests/fcvs21_f95/FM061.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM061.reference_output @@ -0,0 +1,54 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 32 PASS + 33 PASS + 34 PASS + 35 PASS + 36 PASS + 37 PASS + 38 PASS + 39 PASS + 40 PASS + 41 PASS + 42 PASS + 43 PASS + 44 PASS + 45 PASS + 46 PASS + 47 PASS + 48 PASS + 49 PASS + 50 PASS + 51 PASS + 52 PASS + 53 PASS + 54 PASS + 55 PASS + 56 PASS + 57 PASS + 58 PASS + 59 PASS + 60 PASS + 61 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM061 + + 0 ERRORS ENCOUNTERED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM062.f b/Fortran/UnitTests/fcvs21_f95/FM062.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM062.f @@ -0,0 +1,899 @@ + PROGRAM FM062 + +C COMMENT SECTION 00010062 +C 00020062 +C FM062 00030062 +C 00040062 +C THIS ROUTINE TESTS ARITHMETIC ASSIGNMENT STATEMENTS WHERE 00050062 +C AN ARITHMETIC EXPRESSION FORMED FROM REAL VARIABLES AND 00060062 +C CONSTANTS CONNECTED BY ARITHMETIC OPERATORS IS ASSIGNED TO 00070062 +C A REAL VARIABLE. IN CASES INVOLVING THE EXPONENTIATION 00080062 +C OPERATOR, REAL VALUES ARE RAISED TO INTEGER POWERS ONLY. 00090062 +C 00100062 +C A REAL DATUM IS A PROCESSOR APPROXIMATION TO THE VALUE OF A 00110062 +C REAL NUMBER. IT MAY ASSUME POSITIVE, NEGATIVE AND ZERO VALUES. 00120062 +C 00130062 +C A BASIC REAL CONSTANT IS WRITTEN AS AN INTEGER PART, A 00140062 +C DECIMAL POINT, AND A DECIMAL FRACTION PART IN THAT ORDER. BOTH 00150062 +C THE INTEGER PART AND THE DECIMAL PART ARE STRINGS OF DIGITS; 00160062 +C EITHER ONE OF THESE STRINGS MAY BE EMPTY BUT NOT BOTH. THE 00170062 +C CONSTANT IS AN APPROXIMATION TO THE DIGIT STRING INTERPRETED AS A 00180062 +C DECIMAL NUMERAL. 00190062 +C 00200062 +C A DECIMAL EXPONENT IS WRITTEN AS THE LETTER E, FOLLOWED BY AN 00210062 +C OPTIONALLY SIGNED INTEGER CONSTANT. 00220062 +C 00230062 +C A REAL CONSTANT IS INDICATED BY WRITING A BASIC REAL CONSTANT,00240062 +C A BASIC REAL CONSTANT FOLLOWED BY A DECIMAL EXPONENT, OR AN 00250062 +C INTEGER CONSTANT FOLLOWED BY A DECIMAL EXPONENT. 00260062 +C 00270062 +C REFERENCES 00280062 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00290062 +C X3.9-1978 00300062 +C 00310062 +C SECTION 4.4, REAL TYPE 00320062 +C SECTION 4.4.1, REAL CONSTANT 00330062 +C SECTION 6.1, ARITHMETIC EXPRESSIONS 00340062 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00350062 +C SECTION 10.1, ARITHMETIC ASSIGNMENT STATEMENT 00360062 +C 00370062 +C ********************************************************** 00380062 +C 00390062 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00400062 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00410062 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00420062 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00430062 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00440062 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00450062 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00460062 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00470062 +C OF EXECUTING THESE TESTS. 00480062 +C 00490062 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00500062 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00510062 +C 00520062 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00530062 +C 00540062 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00550062 +C SOFTWARE STANDARDS VALIDATION GROUP 00560062 +C BUILDING 225 RM A266 00570062 +C GAITHERSBURG, MD 20899 00580062 +C ********************************************************** 00590062 +C 00600062 +C 00610062 +C 00620062 +C INITIALIZATION SECTION 00630062 +C 00640062 +C INITIALIZE CONSTANTS 00650062 +C ************** 00660062 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00670062 + I01 = 5 00680062 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00690062 + I02 = 6 00700062 +C SYSTEM ENVIRONMENT SECTION 00710062 +C 00720062 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00730062 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740062 +C (UNIT NUMBER FOR CARD READER). 00750062 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00760062 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00770062 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00780062 +C 00790062 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00800062 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00810062 +C (UNIT NUMBER FOR PRINTER). 00820062 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00830062 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00840062 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00850062 +C 00860062 + IVPASS=0 00870062 + IVFAIL=0 00880062 + IVDELE=0 00890062 + ICZERO=0 00900062 +C 00910062 +C WRITE PAGE HEADERS 00920062 + WRITE (I02,90000) 00930062 + WRITE (I02,90001) 00940062 + WRITE (I02,90002) 00950062 + WRITE (I02, 90002) 00960062 + WRITE (I02,90003) 00970062 + WRITE (I02,90002) 00980062 + WRITE (I02,90004) 00990062 + WRITE (I02,90002) 01000062 + WRITE (I02,90011) 01010062 + WRITE (I02,90002) 01020062 + WRITE (I02,90002) 01030062 + WRITE (I02,90005) 01040062 + WRITE (I02,90006) 01050062 + WRITE (I02,90002) 01060062 +C 01070062 +C TEST SECTION 01080062 +C 01090062 +C ARITHMETIC ASSIGNMENT STATEMENT 01100062 +C 01110062 +C 01120062 +C TESTS 62 THROUGH 70 USE A MIXTURE OF REAL VARIABLES AND REAL 01130062 +C CONSTANTS CONNECTED BY TWO IDENTICAL ARITHMETIC OPERATORS. 01140062 +C TESTS OCCUR IN PAIRS, ONE WITHOUT PARENTHESES AND ONE WITH 01150062 +C PARENTHESES TO ALTER THE NORMAL ORDER OF EVALUATION. 01160062 +C 01170062 +C TESTS 71 THROUGH 90 USE THREE REAL VARIABLES CONNECTED BY A 01180062 +C PAIR OF DISSIMILAR OPERATORS. ALL COMBINATIONS AND ORDERINGS 01190062 +C OF OPERATORS ARE EXERCIZED. WHERE EXPONENTIATION IS TESTED, 01200062 +C INTEGER VARIABLES ARE USED FOR THE POWER PRIMARIES. 01210062 +C 01220062 +C TESTS 91 AND 92 USE A SERIES OF REAL VARIABLES CONNECTED BY ONE 01230062 +C EACH OF THE ARITHMETIC OPERTORS. PARENTHETICAL NOTATIONS ARE 01240062 +C ALSO TESTED. 01250062 +C 01260062 +C 01270062 +C 01280062 +C 01290062 +C 01300062 + IVTNUM = 62 01310062 +C 01320062 +C **** TEST 62 **** 01330062 +C 01340062 + IF (ICZERO) 30620, 620, 30620 01350062 + 620 CONTINUE 01360062 + RVON01 = 7.5 01370062 + RVON02 = 5E2 01380062 + RVCOMP = RVON01 + RVON02 + 33E-1 01390062 + GO TO 40620 01400062 +30620 IVDELE = IVDELE + 1 01410062 + WRITE (I02,80003) IVTNUM 01420062 + IF (ICZERO) 40620, 631, 40620 01430062 +40620 IF (RVCOMP - 510.75) 20620,10620,40621 01440062 +40621 IF (RVCOMP - 510.85) 10620,10620,20620 01450062 +10620 IVPASS = IVPASS + 1 01460062 + WRITE (I02,80001) IVTNUM 01470062 + GO TO 631 01480062 +20620 IVFAIL = IVFAIL + 1 01490062 + RVCORR = 510.8 01500062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01510062 + 631 CONTINUE 01520062 + IVTNUM = 63 01530062 +C 01540062 +C **** TEST 63 **** 01550062 +C 01560062 + IF (ICZERO) 30630, 630, 30630 01570062 + 630 CONTINUE 01580062 + RVON01 = 75E-1 01590062 + RVON02 = 500.0 01600062 + RVCOMP = RVON01 + (RVON02 + 3.3) 01610062 + GO TO 40630 01620062 +30630 IVDELE = IVDELE + 1 01630062 + WRITE (I02,80003) IVTNUM 01640062 + IF (ICZERO) 40630, 641, 40630 01650062 +40630 IF (RVCOMP - 510.75) 20630,10630,40631 01660062 +40631 IF (RVCOMP - 510.85) 10630,10630,20630 01670062 +10630 IVPASS = IVPASS + 1 01680062 + WRITE (I02,80001) IVTNUM 01690062 + GO TO 641 01700062 +20630 IVFAIL = IVFAIL + 1 01710062 + RVCORR = 510.8 01720062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01730062 + 641 CONTINUE 01740062 + IVTNUM = 64 01750062 +C 01760062 +C **** TEST 64 **** 01770062 +C 01780062 + IF (ICZERO) 30640, 640, 30640 01790062 + 640 CONTINUE 01800062 + RVCOMP = 7.5 - 500. - 3.3 01810062 + GO TO 40640 01820062 +30640 IVDELE = IVDELE + 1 01830062 + WRITE (I02,80003) IVTNUM 01840062 + IF (ICZERO) 40640, 651, 40640 01850062 +40640 IF (RVCOMP + 495.85) 20640,10640,40641 01860062 +40641 IF (RVCOMP + 495.75) 10640,10640,20640 01870062 +10640 IVPASS = IVPASS + 1 01880062 + WRITE (I02,80001) IVTNUM 01890062 + GO TO 651 01900062 +20640 IVFAIL = IVFAIL + 1 01910062 + RVCORR = -495.8 01920062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01930062 + 651 CONTINUE 01940062 + IVTNUM = 65 01950062 +C 01960062 +C **** TEST 65 **** 01970062 +C 01980062 + IF (ICZERO) 30650, 650, 30650 01990062 + 650 CONTINUE 02000062 + RVON01 = 7.5 02010062 + RVON02 = 5E2 02020062 + RVCOMP = RVON01 - (33E-1 - RVON02) 02030062 + GO TO 40650 02040062 +30650 IVDELE = IVDELE + 1 02050062 + WRITE (I02,80003) IVTNUM 02060062 + IF (ICZERO) 40650, 661, 40650 02070062 +40650 IF (RVCOMP - 504.15) 20650,10650,40651 02080062 +40651 IF (RVCOMP - 504.25) 10650,10650,20650 02090062 +10650 IVPASS = IVPASS + 1 02100062 + WRITE (I02,80001) IVTNUM 02110062 + GO TO 661 02120062 +20650 IVFAIL = IVFAIL + 1 02130062 + RVCORR = 504.2 02140062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02150062 + 661 CONTINUE 02160062 + IVTNUM = 66 02170062 +C 02180062 +C **** TEST 66 **** 02190062 +C 02200062 + IF (ICZERO) 30660, 660, 30660 02210062 + 660 CONTINUE 02220062 + RVON01 = 7.5 02230062 + RVCOMP = 5E2 * 33E-1 * RVON01 02240062 + GO TO 40660 02250062 +30660 IVDELE = IVDELE + 1 02260062 + WRITE (I02,80003) IVTNUM 02270062 + IF (ICZERO) 40660, 671, 40660 02280062 +40660 IF (RVCOMP - 12370) 20660,10660,40661 02290062 +40661 IF (RVCOMP - 12380) 10660,10660,20660 02300062 +10660 IVPASS = IVPASS + 1 02310062 + WRITE (I02,80001) IVTNUM 02320062 + GO TO 671 02330062 +20660 IVFAIL = IVFAIL + 1 02340062 + RVCORR = 12375. 02350062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02360062 + 671 CONTINUE 02370062 + IVTNUM = 67 02380062 +C 02390062 +C **** TEST 67 **** 02400062 +C 02410062 + IF (ICZERO) 30670, 670, 30670 02420062 + 670 CONTINUE 02430062 + RVON01 = 7.5 02440062 + RVCOMP = 5E2 * (RVON01 * 33E-1) 02450062 + GO TO 40670 02460062 +30670 IVDELE = IVDELE + 1 02470062 + WRITE (I02,80003) IVTNUM 02480062 + IF (ICZERO) 40670, 681, 40670 02490062 +40670 IF (RVCOMP - 12370) 20670,10670,40671 02500062 +40671 IF (RVCOMP - 12380) 10670,10670,20670 02510062 +10670 IVPASS = IVPASS + 1 02520062 + WRITE (I02,80001) IVTNUM 02530062 + GO TO 681 02540062 +20670 IVFAIL = IVFAIL + 1 02550062 + RVCORR = 12375. 02560062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02570062 + 681 CONTINUE 02580062 + IVTNUM = 68 02590062 +C 02600062 +C **** TEST 68 **** 02610062 +C 02620062 + IF (ICZERO) 30680, 680, 30680 02630062 + 680 CONTINUE 02640062 + RVON01 = 7.5 02650062 + RVON02 = 33E-1 02660062 + RVON03 = -5E+2 02670062 + RVCOMP = RVON01 / RVON02 / RVON03 02680062 + GO TO 40680 02690062 +30680 IVDELE = IVDELE + 1 02700062 + WRITE (I02,80003) IVTNUM 02710062 + IF (ICZERO) 40680, 691, 40680 02720062 +40680 IF (RVCOMP + .00459) 20680,10680,40681 02730062 +40681 IF (RVCOMP + .00449) 10680,10680,20680 02740062 +10680 IVPASS = IVPASS + 1 02750062 + WRITE (I02,80001) IVTNUM 02760062 + GO TO 691 02770062 +20680 IVFAIL = IVFAIL + 1 02780062 + RVCORR = -.0045454 02790062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02800062 + 691 CONTINUE 02810062 + IVTNUM = 69 02820062 +C 02830062 +C **** TEST 69 **** 02840062 +C 02850062 + IF (ICZERO) 30690, 690, 30690 02860062 + 690 CONTINUE 02870062 + RVON01 = 7.5 02880062 + RVON02 = 33E-1 02890062 + RVON03 = -5E+2 02900062 + RVCOMP = RVON01 / (RVON02 / RVON03) 02910062 + GO TO 40690 02920062 +30690 IVDELE = IVDELE + 1 02930062 + WRITE (I02,80003) IVTNUM 02940062 + IF (ICZERO) 40690, 701, 40690 02950062 +40690 IF (RVCOMP + 1180.) 20690,10690,40691 02960062 +40691 IF (RVCOMP + 1080.) 10690,10690,20690 02970062 +10690 IVPASS = IVPASS + 1 02980062 + WRITE (I02,80001) IVTNUM 02990062 + GO TO 701 03000062 +20690 IVFAIL = IVFAIL + 1 03010062 + RVCORR = -1136.4 03020062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03030062 + 701 CONTINUE 03040062 + IVTNUM = 70 03050062 +C 03060062 +C **** TEST 70 **** 03070062 +C 03080062 + IF (ICZERO) 30700, 700, 30700 03090062 + 700 CONTINUE 03100062 + RVON01 = 3.835E3 03110062 + IVON01 = 5 03120062 + RVCOMP = RVON01 ** IVON01 03130062 + GO TO 40700 03140062 +30700 IVDELE = IVDELE + 1 03150062 + WRITE (I02,80003) IVTNUM 03160062 + IF (ICZERO) 40700, 711, 40700 03170062 +40700 IF (RVCOMP - 8.29E17) 20700,10700,40701 03180062 +40701 IF (RVCOMP - 8.30E17) 10700,10700,20700 03190062 +10700 IVPASS = IVPASS + 1 03200062 + WRITE (I02,80001) IVTNUM 03210062 + GO TO 711 03220062 +20700 IVFAIL = IVFAIL + 1 03230062 + RVCORR = 8.295E17 03240062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03250062 + 711 CONTINUE 03260062 +C 03270062 +C TESTS 71 THROUGH 74 TEST RV1 + RV2 RV3 03280062 +C 03290062 + IVTNUM = 71 03300062 +C 03310062 +C **** TEST 71 **** 03320062 +C 03330062 + IF (ICZERO) 30710, 710, 30710 03340062 + 710 CONTINUE 03350062 + RVON01 = 524.87 03360062 + RVON02 = 3.35 03370062 + RVON03 = .005679 03380062 + RVCOMP = RVON01 + RVON02 - RVON03 03390062 + GO TO 40710 03400062 +30710 IVDELE = IVDELE + 1 03410062 + WRITE (I02,80003) IVTNUM 03420062 + IF (ICZERO) 40710, 721, 40710 03430062 +40710 IF (RVCOMP - 528.16) 20710,10710,40711 03440062 +40711 IF (RVCOMP - 528.26) 10710,10710,20710 03450062 +10710 IVPASS = IVPASS + 1 03460062 + WRITE (I02,80001) IVTNUM 03470062 + GO TO 721 03480062 +20710 IVFAIL = IVFAIL + 1 03490062 + RVCORR = 528.21 03500062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03510062 + 721 CONTINUE 03520062 + IVTNUM = 72 03530062 +C 03540062 +C **** TEST 72 **** 03550062 +C 03560062 + IF (ICZERO) 30720, 720, 30720 03570062 + 720 CONTINUE 03580062 + RVON01 = 524.87 03590062 + RVON02 = 3.35 03600062 + RVON03 = .005679 03610062 + RVCOMP = RVON01 + RVON02 * RVON03 03620062 + GO TO 40720 03630062 +30720 IVDELE = IVDELE + 1 03640062 + WRITE (I02,80003) IVTNUM 03650062 + IF (ICZERO) 40720, 731, 40720 03660062 +40720 IF (RVCOMP - 524.84) 20720,10720,40721 03670062 +40721 IF (RVCOMP - 524.94) 10720,10720,20720 03680062 +10720 IVPASS = IVPASS + 1 03690062 + WRITE (I02,80001) IVTNUM 03700062 + GO TO 731 03710062 +20720 IVFAIL = IVFAIL + 1 03720062 + RVCORR = 524.89 03730062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03740062 + 731 CONTINUE 03750062 + IVTNUM = 73 03760062 +C 03770062 +C **** TEST 73 **** 03780062 +C 03790062 + IF (ICZERO) 30730, 730, 30730 03800062 + 730 CONTINUE 03810062 + RVON01 = 524.87 03820062 + RVON02 = 3.35 03830062 + RVON03 = .005679 03840062 + RVCOMP = RVON01 + RVON02 / RVON03 03850062 + GO TO 40730 03860062 +30730 IVDELE = IVDELE + 1 03870062 + WRITE (I02,80003) IVTNUM 03880062 + IF (ICZERO) 40730, 741, 40730 03890062 +40730 IF (RVCOMP - 1114.2) 20730,10730,40731 03900062 +40731 IF (RVCOMP - 1115.2) 10730,10730,20730 03910062 +10730 IVPASS = IVPASS + 1 03920062 + WRITE (I02,80001) IVTNUM 03930062 + GO TO 741 03940062 +20730 IVFAIL = IVFAIL + 1 03950062 + RVCORR = 1114.8 03960062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03970062 + 741 CONTINUE 03980062 + IVTNUM = 74 03990062 +C 04000062 +C **** TEST 74 **** 04010062 +C 04020062 + IF (ICZERO) 30740, 740, 30740 04030062 + 740 CONTINUE 04040062 + RVON01 = 524.87 04050062 + RVON02 = 3.35 04060062 + IVON01 = 7 04070062 + RVCOMP = RVON01 + RVON02 ** IVON01 04080062 + GO TO 40740 04090062 +30740 IVDELE = IVDELE + 1 04100062 + WRITE (I02,80003) IVTNUM 04110062 + IF (ICZERO) 40740, 751, 40740 04120062 +40740 IF (RVCOMP - 5259.3) 20740,10740,40741 04130062 +40741 IF (RVCOMP - 5260.3) 10740,10740,20740 04140062 +10740 IVPASS = IVPASS + 1 04150062 + WRITE (I02,80001) IVTNUM 04160062 + GO TO 751 04170062 +20740 IVFAIL = IVFAIL + 1 04180062 + RVCORR = 5259.8 04190062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04200062 + 751 CONTINUE 04210062 +C 04220062 +C TESTS 75 THROUGH 78 CHECK RV1 - RV2 RV3 04230062 +C 04240062 + IVTNUM = 75 04250062 +C 04260062 +C **** TEST 75 **** 04270062 +C 04280062 + IF (ICZERO) 30750, 750, 30750 04290062 + 750 CONTINUE 04300062 + RVON01 = 524.87 04310062 + RVON02 = 3.35 04320062 + RVON03 = .5679 04330062 + RVCOMP = RVON01 - RVON02 + RVON03 04340062 + GO TO 40750 04350062 +30750 IVDELE = IVDELE + 1 04360062 + WRITE (I02,80003) IVTNUM 04370062 + IF (ICZERO) 40750, 761, 40750 04380062 +40750 IF (RVCOMP - 522.03) 20750,10750,40751 04390062 +40751 IF (RVCOMP - 522.13) 10750,10750,20750 04400062 +10750 IVPASS = IVPASS + 1 04410062 + WRITE (I02,80001) IVTNUM 04420062 + GO TO 761 04430062 +20750 IVFAIL = IVFAIL + 1 04440062 + RVCORR = 522.09 04450062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04460062 + 761 CONTINUE 04470062 + IVTNUM = 76 04480062 +C 04490062 +C **** TEST 76 **** 04500062 +C 04510062 + IF (ICZERO) 30760, 760, 30760 04520062 + 760 CONTINUE 04530062 + RVON01 = 524.87 04540062 + RVON02 = 3.35 04550062 + RVON03 = .5679 04560062 + RVCOMP = RVON01 - RVON02 * RVON03 04570062 + GO TO 40760 04580062 +30760 IVDELE = IVDELE + 1 04590062 + WRITE (I02,80003) IVTNUM 04600062 + IF (ICZERO) 40760, 771, 40760 04610062 +40760 IF (RVCOMP - 522.92) 20760,10760,40761 04620062 +40761 IF (RVCOMP - 523.02) 10760,10760,20760 04630062 +10760 IVPASS = IVPASS + 1 04640062 + WRITE (I02,80001) IVTNUM 04650062 + GO TO 771 04660062 +20760 IVFAIL = IVFAIL + 1 04670062 + RVCORR = 522.97 04680062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04690062 + 771 CONTINUE 04700062 + IVTNUM = 77 04710062 +C 04720062 +C **** TEST 77 **** 04730062 +C 04740062 + IF (ICZERO) 30770, 770, 30770 04750062 + 770 CONTINUE 04760062 + RVON01 = 524.87 04770062 + RVON02 = 3.35 04780062 + RVON03 = .5679 04790062 + RVCOMP = RVON01 - RVON02 / RVON03 04800062 + GO TO 40770 04810062 +30770 IVDELE = IVDELE + 1 04820062 + WRITE (I02,80003) IVTNUM 04830062 + IF (ICZERO) 40770, 781, 40770 04840062 +40770 IF (RVCOMP - 518.92) 20770,10770,40771 04850062 +40771 IF (RVCOMP - 519.02) 10770,10770,20770 04860062 +10770 IVPASS = IVPASS + 1 04870062 + WRITE (I02,80001) IVTNUM 04880062 + GO TO 781 04890062 +20770 IVFAIL = IVFAIL + 1 04900062 + RVCORR = 518.97 04910062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04920062 + 781 CONTINUE 04930062 + IVTNUM = 78 04940062 +C 04950062 +C **** TEST 78 **** 04960062 +C 04970062 + IF (ICZERO) 30780, 780, 30780 04980062 + 780 CONTINUE 04990062 + RVON01 = 524.87 05000062 + RVON02 = 3.35 05010062 + IVON01 = 7 05020062 + RVCOMP = RVON01 - RVON02 ** IVON01 05030062 + GO TO 40780 05040062 +30780 IVDELE = IVDELE + 1 05050062 + WRITE (I02,80003) IVTNUM 05060062 + IF (ICZERO) 40780, 791, 40780 05070062 +40780 IF (RVCOMP + 4210.6) 20780,10780,40781 05080062 +40781 IF (RVCOMP + 4209.6) 10780,10780,20780 05090062 +10780 IVPASS = IVPASS + 1 05100062 + WRITE (I02,80001) IVTNUM 05110062 + GO TO 791 05120062 +20780 IVFAIL = IVFAIL + 1 05130062 + RVCORR = -4210.1 05140062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05150062 + 791 CONTINUE 05160062 +C 05170062 +C TESTS 79 THROUGH 82 CHECK RV1 * RV2 RV3 05180062 +C 05190062 + IVTNUM = 79 05200062 +C 05210062 +C **** TEST 79 **** 05220062 +C 05230062 + IF (ICZERO) 30790, 790, 30790 05240062 + 790 CONTINUE 05250062 + RVON01 = 524.87 05260062 + RVON02 = .5679 05270062 + RVON03 = 3.35 05280062 + RVCOMP = RVON01 * RVON02 + RVON03 05290062 + GO TO 40790 05300062 +30790 IVDELE = IVDELE + 1 05310062 + WRITE (I02,80003) IVTNUM 05320062 + IF (ICZERO) 40790, 801, 40790 05330062 +40790 IF (RVCOMP - 301.37) 20790,10790,40791 05340062 +40791 IF (RVCOMP - 301.47) 10790,10790,20790 05350062 +10790 IVPASS = IVPASS + 1 05360062 + WRITE (I02,80001) IVTNUM 05370062 + GO TO 801 05380062 +20790 IVFAIL = IVFAIL + 1 05390062 + RVCORR = 301.42 05400062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05410062 + 801 CONTINUE 05420062 + IVTNUM = 80 05430062 +C 05440062 +C **** TEST 80 **** 05450062 +C 05460062 + IF (ICZERO) 30800, 800, 30800 05470062 + 800 CONTINUE 05480062 + RVON01 = 524.87 05490062 + RVON02 = .5679 05500062 + RVON03 = 3.35 05510062 + RVCOMP = RVON01 * RVON02 - RVON03 05520062 + GO TO 40800 05530062 +30800 IVDELE = IVDELE + 1 05540062 + WRITE (I02,80003) IVTNUM 05550062 + IF (ICZERO) 40800, 811, 40800 05560062 +40800 IF (RVCOMP - 294.67) 20800,10800,40801 05570062 +40801 IF (RVCOMP - 294.77) 10800,10800,20800 05580062 +10800 IVPASS = IVPASS + 1 05590062 + WRITE (I02,80001) IVTNUM 05600062 + GO TO 811 05610062 +20800 IVFAIL = IVFAIL + 1 05620062 + RVCORR = 294.72 05630062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05640062 + 811 CONTINUE 05650062 + IVTNUM = 81 05660062 +C 05670062 +C **** TEST 81 **** 05680062 +C 05690062 + IF (ICZERO) 30810, 810, 30810 05700062 + 810 CONTINUE 05710062 + RVON01 = 524.87 05720062 + RVON02 = .5679 05730062 + RVON03 = 3.35 05740062 + RVCOMP = RVON01 * RVON02 / RVON03 05750062 + GO TO 40810 05760062 +30810 IVDELE = IVDELE + 1 05770062 + WRITE (I02,80003) IVTNUM 05780062 + IF (ICZERO) 40810, 821, 40810 05790062 +40810 IF (RVCOMP - 88.92) 20810,10810,40811 05800062 +40811 IF (RVCOMP - 89.02) 10810,10810,20810 05810062 +10810 IVPASS = IVPASS + 1 05820062 + WRITE (I02,80001) IVTNUM 05830062 + GO TO 821 05840062 +20810 IVFAIL = IVFAIL + 1 05850062 + RVCORR = 88.977 05860062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05870062 + 821 CONTINUE 05880062 + IVTNUM = 82 05890062 +C 05900062 +C **** TEST 82 **** 05910062 +C 05920062 + IF (ICZERO) 30820, 820, 30820 05930062 + 820 CONTINUE 05940062 + RVON01 = 524.87 05950062 + RVON02 = .5679 05960062 + IVON01 = 7 05970062 + RVCOMP = RVON01 * RVON02 ** IVON01 05980062 + GO TO 40820 05990062 +30820 IVDELE = IVDELE + 1 06000062 + WRITE (I02,80003) IVTNUM 06010062 + IF (ICZERO) 40820, 831, 40820 06020062 +40820 IF (RVCOMP - 9.94) 20820,10820,40821 06030062 +40821 IF (RVCOMP - 10.04) 10820,10820,20820 06040062 +10820 IVPASS = IVPASS + 1 06050062 + WRITE (I02,80001) IVTNUM 06060062 + GO TO 831 06070062 +20820 IVFAIL = IVFAIL + 1 06080062 + RVCORR = 9.999 06090062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06100062 + 831 CONTINUE 06110062 +C 06120062 +C TESTS 83 THROUGH 86 CHECK RV1 / RV2 RV3 06130062 +C 06140062 + IVTNUM = 83 06150062 +C 06160062 +C **** TEST 83 **** 06170062 +C 06180062 + IF (ICZERO) 30830, 830, 30830 06190062 + 830 CONTINUE 06200062 + RVON01 = 524.87 06210062 + RVON02 = 3.35 06220062 + RVON03 = .5679 06230062 + RVCOMP = RVON01 / RVON02 + RVON03 06240062 + GO TO 40830 06250062 +30830 IVDELE = IVDELE + 1 06260062 + WRITE (I02,80003) IVTNUM 06270062 + IF (ICZERO) 40830, 841, 40830 06280062 +40830 IF (RVCOMP - 157.19) 20830,10830,40831 06290062 +40831 IF (RVCOMP - 157.29) 10830,10830,20830 06300062 +10830 IVPASS = IVPASS + 1 06310062 + WRITE (I02,80001) IVTNUM 06320062 + GO TO 841 06330062 +20830 IVFAIL = IVFAIL + 1 06340062 + RVCORR = 157.25 06350062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06360062 + 841 CONTINUE 06370062 + IVTNUM = 84 06380062 +C 06390062 +C **** TEST 84 **** 06400062 +C 06410062 + IF (ICZERO) 30840, 840, 30840 06420062 + 840 CONTINUE 06430062 + RVON01 = 524.87 06440062 + RVON02 = 3.35 06450062 + RVON03 = .8507 06460062 + RVCOMP = RVON01 / RVON02 - RVON03 06470062 + GO TO 40840 06480062 +30840 IVDELE = IVDELE + 1 06490062 + WRITE (I02,80003) IVTNUM 06500062 + IF (ICZERO) 40840, 851, 40840 06510062 +40840 IF (RVCOMP - 155.77) 20840,10840,40841 06520062 +40841 IF (RVCOMP - 155.87) 10840,10840,20840 06530062 +10840 IVPASS = IVPASS + 1 06540062 + WRITE (I02,80001) IVTNUM 06550062 + GO TO 851 06560062 +20840 IVFAIL = IVFAIL + 1 06570062 + RVCORR = 155.83 06580062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06590062 + 851 CONTINUE 06600062 + IVTNUM = 85 06610062 +C 06620062 +C **** TEST 85 **** 06630062 +C 06640062 + IF (ICZERO) 30850, 850, 30850 06650062 + 850 CONTINUE 06660062 + RVON01 = 524.87 06670062 + RVON02 = 3.35 06680062 + RVON03 = .8507 06690062 + RVCOMP = RVON01 / RVON02 * RVON03 06700062 + GO TO 40850 06710062 +30850 IVDELE = IVDELE + 1 06720062 + WRITE (I02,80003) IVTNUM 06730062 + IF (ICZERO) 40850, 861, 40850 06740062 +40850 IF (RVCOMP - 132.7) 20850,10850,40851 06750062 +40851 IF (RVCOMP - 133.7) 10850,10850,20850 06760062 +10850 IVPASS = IVPASS + 1 06770062 + WRITE (I02,80001) IVTNUM 06780062 + GO TO 861 06790062 +20850 IVFAIL = IVFAIL + 1 06800062 + RVCORR = 133.29 06810062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06820062 + 861 CONTINUE 06830062 + IVTNUM = 86 06840062 +C 06850062 +C **** TEST 86 **** 06860062 +C 06870062 + IF (ICZERO) 30860, 860, 30860 06880062 + 860 CONTINUE 06890062 + RVON01 = 524.87 06900062 + RVON02 = 3.35 06910062 + IVON01 = 7 06920062 + RVCOMP = RVON01 / RVON02 ** IVON01 06930062 + GO TO 40860 06940062 +30860 IVDELE = IVDELE + 1 06950062 + WRITE (I02,80003) IVTNUM 06960062 + IF (ICZERO) 40860, 871, 40860 06970062 +40860 IF (RVCOMP - .106) 20860,10860,40861 06980062 +40861 IF (RVCOMP - .116) 10860,10860,20860 06990062 +10860 IVPASS = IVPASS + 1 07000062 + WRITE (I02,80001) IVTNUM 07010062 + GO TO 871 07020062 +20860 IVFAIL = IVFAIL + 1 07030062 + RVCORR = .11085 07040062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07050062 + 871 CONTINUE 07060062 +C 07070062 +C TESTS 87 THROUGH 90 CHECK RV1 ** IV1 RV2 07080062 +C 07090062 + IVTNUM = 87 07100062 +C 07110062 +C **** TEST 87 **** 07120062 +C 07130062 + IF (ICZERO) 30870, 870, 30870 07140062 + 870 CONTINUE 07150062 + RVON01 = 3.35 07160062 + IVON01 = 7 07170062 + RVON02 = 524.87 07180062 + RVCOMP = RVON01 ** IVON01 + RVON02 07190062 + GO TO 40870 07200062 +30870 IVDELE = IVDELE + 1 07210062 + WRITE (I02,80003) IVTNUM 07220062 + IF (ICZERO) 40870, 881, 40870 07230062 +40870 IF (RVCOMP - 5210.) 20870,10870,40871 07240062 +40871 IF (RVCOMP - 5310.) 10870,10870,20870 07250062 +10870 IVPASS = IVPASS + 1 07260062 + WRITE (I02,80001) IVTNUM 07270062 + GO TO 881 07280062 +20870 IVFAIL = IVFAIL + 1 07290062 + RVCORR = 5259.8 07300062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07310062 + 881 CONTINUE 07320062 + IVTNUM = 88 07330062 +C 07340062 +C **** TEST 88 **** 07350062 +C 07360062 + IF (ICZERO) 30880, 880, 30880 07370062 + 880 CONTINUE 07380062 + RVON01 = 3.35 07390062 + IVON01 = 7 07400062 + RVON02 = 524.87 07410062 + RVCOMP = RVON01 ** IVON01 - RVON02 07420062 + GO TO 40880 07430062 +30880 IVDELE = IVDELE + 1 07440062 + WRITE (I02,80003) IVTNUM 07450062 + IF (ICZERO) 40880, 891, 40880 07460062 +40880 IF (RVCOMP - 4160.) 20880,10880,40881 07470062 +40881 IF (RVCOMP - 4260.) 10880,10880,20880 07480062 +10880 IVPASS = IVPASS + 1 07490062 + WRITE (I02,80001) IVTNUM 07500062 + GO TO 891 07510062 +20880 IVFAIL = IVFAIL + 1 07520062 + RVCORR = 4210.1 07530062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07540062 + 891 CONTINUE 07550062 + IVTNUM = 89 07560062 +C 07570062 +C **** TEST 89 **** 07580062 +C 07590062 + IF (ICZERO) 30890, 890, 30890 07600062 + 890 CONTINUE 07610062 + RVON01 = 3.35 07620062 + IVON01 = 7 07630062 + RVON02 = 524.87 07640062 + RVCOMP = RVON01 ** IVON01 * RVON02 07650062 + GO TO 40890 07660062 +30890 IVDELE = IVDELE + 1 07670062 + WRITE (I02,80003) IVTNUM 07680062 + IF (ICZERO) 40890, 901, 40890 07690062 +40890 IF (RVCOMP - 2.43E6) 20890,10890,40891 07700062 +40891 IF (RVCOMP - 2.53E6) 10890,10890,20890 07710062 +10890 IVPASS = IVPASS + 1 07720062 + WRITE (I02,80001) IVTNUM 07730062 + GO TO 901 07740062 +20890 IVFAIL = IVFAIL + 1 07750062 + RVCORR = 2.4852E6 07760062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07770062 + 901 CONTINUE 07780062 + IVTNUM = 90 07790062 +C 07800062 +C **** TEST 90 **** 07810062 +C 07820062 + IF (ICZERO) 30900, 900, 30900 07830062 + 900 CONTINUE 07840062 + RVON01 = 3.35 07850062 + IVON01 = 7 07860062 + RVON02 = 524.87 07870062 + RVCOMP = RVON01 ** IVON01 / RVON02 07880062 + GO TO 40900 07890062 +30900 IVDELE = IVDELE + 1 07900062 + WRITE (I02,80003) IVTNUM 07910062 + IF (ICZERO) 40900, 911, 40900 07920062 +40900 IF (RVCOMP - 8.97) 20900,10900,40901 07930062 +40901 IF (RVCOMP - 9.07) 10900,10900,20900 07940062 +10900 IVPASS = IVPASS + 1 07950062 + WRITE (I02,80001) IVTNUM 07960062 + GO TO 911 07970062 +20900 IVFAIL = IVFAIL + 1 07980062 + RVCORR = 9.0211 07990062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08000062 + 911 CONTINUE 08010062 +C 08020062 +C TESTS 91 AND 92 CHECK ALL ARITHMETIC OPERATORS USED TOGETHER 08030062 +C 08040062 + IVTNUM = 91 08050062 +C 08060062 +C **** TEST 91 **** 08070062 +C 08080062 + IF (ICZERO) 30910, 910, 30910 08090062 + 910 CONTINUE 08100062 + RVON01 = 780.56 08110062 + RVON02 = .803 08120062 + RVON03 = 3.35 08130062 + IVON01 = 7 08140062 + RVON04 = 20.07 08150062 + RVON05 = 511.9 08160062 + RVCOMP = - RVON01 + RVON02 * RVON03 ** IVON01 / RVON04 - RVON05 08170062 + GO TO 40910 08180062 +30910 IVDELE = IVDELE + 1 08190062 + WRITE (I02,80003) IVTNUM 08200062 + IF (ICZERO) 40910, 921, 40910 08210062 +40910 IF (RVCOMP + 1113.0) 20910,10910,40911 08220062 +40911 IF (RVCOMP + 1093.0) 10910,10910,20910 08230062 +10910 IVPASS = IVPASS + 1 08240062 + WRITE (I02,80001) IVTNUM 08250062 + GO TO 921 08260062 +20910 IVFAIL = IVFAIL + 1 08270062 + RVCORR = -1103.0 08280062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08290062 + 921 CONTINUE 08300062 + IVTNUM = 92 08310062 +C 08320062 +C **** TEST 92 **** 08330062 +C 08340062 + IF (ICZERO) 30920, 920, 30920 08350062 + 920 CONTINUE 08360062 + RVON01 = 780.56 08370062 + RVON02 = .803 08380062 + RVON03 = 3.35 08390062 + IVON01 = 7 08400062 + RVON04 = 20.07 08410062 + RVON05 = 511.9 08420062 + RVCOMP = (-RVON01) + (RVON02 * RVON03) ** IVON01 / (RVON04-RVON05)08430062 + GO TO 40920 08440062 +30920 IVDELE = IVDELE + 1 08450062 + WRITE (I02,80003) IVTNUM 08460062 + IF (ICZERO) 40920, 931, 40920 08470062 +40920 IF (RVCOMP + 788.) 20920,10920,40921 08480062 +40921 IF (RVCOMP + 777.) 10920,10920,20920 08490062 +10920 IVPASS = IVPASS + 1 08500062 + WRITE (I02,80001) IVTNUM 08510062 + GO TO 931 08520062 +20920 IVFAIL = IVFAIL + 1 08530062 + RVCORR = -782.63 08540062 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08550062 + 931 CONTINUE 08560062 +C 08570062 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08580062 +99999 CONTINUE 08590062 + WRITE (I02,90002) 08600062 + WRITE (I02,90006) 08610062 + WRITE (I02,90002) 08620062 + WRITE (I02,90002) 08630062 + WRITE (I02,90007) 08640062 + WRITE (I02,90002) 08650062 + WRITE (I02,90008) IVFAIL 08660062 + WRITE (I02,90009) IVPASS 08670062 + WRITE (I02,90010) IVDELE 08680062 +C 08690062 +C 08700062 +C TERMINATE ROUTINE EXECUTION 08710062 + STOP 08720062 +C 08730062 +C FORMAT STATEMENTS FOR PAGE HEADERS 08740062 +90000 FORMAT ("1") 08750062 +90002 FORMAT (" ") 08760062 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08770062 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08780062 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08790062 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08800062 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08810062 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08820062 +C 08830062 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08840062 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08850062 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08860062 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08870062 +C 08880062 +C FORMAT STATEMENTS FOR TEST RESULTS 08890062 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08900062 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08910062 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08920062 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08930062 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08940062 +C 08950062 +90007 FORMAT (" ",20X,"END OF PROGRAM FM062" ) 08960062 + END 08970062 diff --git a/Fortran/UnitTests/fcvs21_f95/FM062.reference_output b/Fortran/UnitTests/fcvs21_f95/FM062.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM062.reference_output @@ -0,0 +1,55 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 62 PASS + 63 PASS + 64 PASS + 65 PASS + 66 PASS + 67 PASS + 68 PASS + 69 PASS + 70 PASS + 71 PASS + 72 PASS + 73 PASS + 74 PASS + 75 PASS + 76 PASS + 77 PASS + 78 PASS + 79 PASS + 80 PASS + 81 PASS + 82 PASS + 83 PASS + 84 PASS + 85 PASS + 86 PASS + 87 PASS + 88 PASS + 89 PASS + 90 PASS + 91 PASS + 92 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM062 + + 0 ERRORS ENCOUNTERED + 31 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM080.f b/Fortran/UnitTests/fcvs21_f95/FM080.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM080.f @@ -0,0 +1,721 @@ + 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 diff --git a/Fortran/UnitTests/fcvs21_f95/FM080.reference_output b/Fortran/UnitTests/fcvs21_f95/FM080.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM080.reference_output @@ -0,0 +1,41 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 674 PASS + 675 PASS + 676 PASS + 677 PASS + 678 PASS + 679 PASS + 680 PASS + 681 PASS + 682 PASS + 683 PASS + 684 PASS + 685 PASS + 686 PASS + 687 PASS + 688 PASS + 689 PASS + 690 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM080 + + 0 ERRORS ENCOUNTERED + 17 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM097.f b/Fortran/UnitTests/fcvs21_f95/FM097.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM097.f @@ -0,0 +1,881 @@ + PROGRAM FM097 + +C COMMENT SECTION 00010097 +C 00020097 +C FM097 00030097 +C 00040097 +C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION TYPE IS 00050097 +C REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE REAL AND 00060097 +C INTEGER VARIABLES AND THE REAL AND INTEGER CONSTANTS CONTAIN BOTH 00070097 +C POSITIVE AND NEGATIVE VALUES. THE INTRINSIC FUNCTIONS TESTED BY 00080097 +C FM097 INCLUDE 00090097 +C TYPE OF 00100097 +C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION 00110097 +C ------------------ ---- -------- -------- 00120097 +C ABSOLUTE VALUE ABS REAL REAL 00130097 +C TRUNCATION AINT REAL REAL 00140097 +C REMAINDERING AMOD REAL REAL 00150097 +C CHOOSING LARGEST VALUE AMAX0 INTEGER REAL 00160097 +C AMAX1 REAL REAL 00170097 +C CHOOSING SMALLEST VALUE AMIN0 INTEGER REAL 00180097 +C AMIN1 REAL REAL 00190097 +C FLOAT FLOAT INTEGER REAL 00200097 +C TRANSFER OF SIGN SIGN REAL REAL 00210097 +C POSITIVE DIFFERENCE DIM REAL REAL 00220097 +C 00230097 +C REFERENCES 00240097 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00250097 +C X3.9-1978 00260097 +C 00270097 +C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS 00280097 +C SECTION 15.3, INTRINSIC FUNCTION 00290097 +C SECTION 15.3.2, INTRINSIC FUNCTIONS AND THEIR REFERENCE 00300097 +C 00310097 +C 00320097 +C ********************************************************** 00330097 +C 00340097 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350097 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360097 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370097 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380097 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390097 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400097 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410097 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420097 +C OF EXECUTING THESE TESTS. 00430097 +C 00440097 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450097 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460097 +C 00470097 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480097 +C 00490097 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00500097 +C SOFTWARE STANDARDS VALIDATION GROUP 00510097 +C BUILDING 225 RM A266 00520097 +C GAITHERSBURG, MD 20899 00530097 +C ********************************************************** 00540097 +C 00550097 +C 00560097 +C 00570097 +C INITIALIZATION SECTION 00580097 +C 00590097 +C INITIALIZE CONSTANTS 00600097 +C ************** 00610097 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620097 + I01 = 5 00630097 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640097 + I02 = 6 00650097 +C SYSTEM ENVIRONMENT SECTION 00660097 +C 00670097 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00680097 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690097 +C (UNIT NUMBER FOR CARD READER). 00700097 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710097 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720097 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730097 +C 00740097 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00750097 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760097 +C (UNIT NUMBER FOR PRINTER). 00770097 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780097 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790097 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800097 +C 00810097 + IVPASS=0 00820097 + IVFAIL=0 00830097 + IVDELE=0 00840097 + ICZERO=0 00850097 +C 00860097 +C WRITE PAGE HEADERS 00870097 + WRITE (I02,90000) 00880097 + WRITE (I02,90001) 00890097 + WRITE (I02,90002) 00900097 + WRITE (I02, 90002) 00910097 + WRITE (I02,90003) 00920097 + WRITE (I02,90002) 00930097 + WRITE (I02,90004) 00940097 + WRITE (I02,90002) 00950097 + WRITE (I02,90011) 00960097 + WRITE (I02,90002) 00970097 + WRITE (I02,90002) 00980097 + WRITE (I02,90005) 00990097 + WRITE (I02,90006) 01000097 + WRITE (I02,90002) 01010097 +C 01020097 +C TEST SECTION 01030097 +C 01040097 +C TEST 875 THROUGH TEST 878 CONTAIN INTRINSIC FUNCTION TESTS FOR 01050097 +C ABSOLUTE VALUE WHERE ARGUMENT AND FUNCTION ARE REAL 01060097 +C 01070097 + IVTNUM = 875 01080097 +C 01090097 +C **** TEST 875 **** 01100097 +C 01110097 + IF (ICZERO) 38750, 8750, 38750 01120097 + 8750 CONTINUE 01130097 + RVCOMP = ABS (-38.2) 01140097 + GO TO 48750 01150097 +38750 IVDELE = IVDELE + 1 01160097 + WRITE (I02,80003) IVTNUM 01170097 + IF (ICZERO) 48750, 8761, 48750 01180097 +48750 IF (RVCOMP - 38.195) 28750,18750,48751 01190097 +48751 IF (RVCOMP - 38.205) 18750,18750,28750 01200097 +18750 IVPASS = IVPASS + 1 01210097 + WRITE (I02,80001) IVTNUM 01220097 + GO TO 8761 01230097 +28750 IVFAIL = IVFAIL + 1 01240097 + RVCORR = 38.200 01250097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01260097 + 8761 CONTINUE 01270097 + IVTNUM = 876 01280097 +C 01290097 +C **** TEST 876 **** 01300097 +C 01310097 + IF (ICZERO) 38760, 8760, 38760 01320097 + 8760 CONTINUE 01330097 + RVON01 = 445.06 01340097 + RVCOMP = ABS (RVON01) 01350097 + GO TO 48760 01360097 +38760 IVDELE = IVDELE + 1 01370097 + WRITE (I02,80003) IVTNUM 01380097 + IF (ICZERO) 48760, 8771, 48760 01390097 +48760 IF (RVCOMP - 445.01) 28760,18760,48761 01400097 +48761 IF (RVCOMP - 445.11) 18760,18760,28760 01410097 +18760 IVPASS = IVPASS + 1 01420097 + WRITE (I02,80001) IVTNUM 01430097 + GO TO 8771 01440097 +28760 IVFAIL = IVFAIL + 1 01450097 + RVCORR = 445.06 01460097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01470097 + 8771 CONTINUE 01480097 + IVTNUM = 877 01490097 +C 01500097 +C **** TEST 877 **** 01510097 +C 01520097 + IF (ICZERO) 38770, 8770, 38770 01530097 + 8770 CONTINUE 01540097 + RVON01 = -32.176 01550097 + RVCOMP = ABS (RVON01) 01560097 + GO TO 48770 01570097 +38770 IVDELE = IVDELE + 1 01580097 + WRITE (I02,80003) IVTNUM 01590097 + IF (ICZERO) 48770, 8781, 48770 01600097 +48770 IF (RVCOMP - 32.171) 28770,18770,48771 01610097 +48771 IF (RVCOMP - 32.181) 18770,18770,28770 01620097 +18770 IVPASS = IVPASS + 1 01630097 + WRITE (I02,80001) IVTNUM 01640097 + GO TO 8781 01650097 +28770 IVFAIL = IVFAIL + 1 01660097 + RVCORR = 32.176 01670097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01680097 + 8781 CONTINUE 01690097 + IVTNUM = 878 01700097 +C 01710097 +C **** TEST 878 **** 01720097 +C 01730097 + IF (ICZERO) 38780, 8780, 38780 01740097 + 8780 CONTINUE 01750097 + RVON01 = -2.2E+2 01760097 + RVCOMP = ABS (RVON01) 01770097 + GO TO 48780 01780097 +38780 IVDELE = IVDELE + 1 01790097 + WRITE (I02,80003) IVTNUM 01800097 + IF (ICZERO) 48780, 8791, 48780 01810097 +48780 IF (RVCOMP - 219.95) 28780,18780,48781 01820097 +48781 IF (RVCOMP - 220.05) 18780,18780,28780 01830097 +18780 IVPASS = IVPASS + 1 01840097 + WRITE (I02,80001) IVTNUM 01850097 + GO TO 8791 01860097 +28780 IVFAIL = IVFAIL + 1 01870097 + RVCORR = 220.00 01880097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01890097 + 8791 CONTINUE 01900097 + IVTNUM = 879 01910097 +C 01920097 +C **** TEST 879 **** 01930097 +C 01940097 +C TEST 879 THROUGH TEST 882 CONTAIN INTRINSIC FUNCTION TESTS FOR 01950097 +C TRUNCATION WHERE ARGUMENT AND FUNCTION ARE REAL 01960097 +C 01970097 +C 01980097 + IF (ICZERO) 38790, 8790, 38790 01990097 + 8790 CONTINUE 02000097 + RVCOMP = AINT (38.2) 02010097 + GO TO 48790 02020097 +38790 IVDELE = IVDELE + 1 02030097 + WRITE (I02,80003) IVTNUM 02040097 + IF (ICZERO) 48790, 8801, 48790 02050097 +48790 IF (RVCOMP - 37.995) 28790,18790,48791 02060097 +48791 IF (RVCOMP - 38.005) 18790,18790,28790 02070097 +18790 IVPASS = IVPASS + 1 02080097 + WRITE (I02,80001) IVTNUM 02090097 + GO TO 8801 02100097 +28790 IVFAIL = IVFAIL + 1 02110097 + RVCORR = 38.000 02120097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02130097 + 8801 CONTINUE 02140097 + IVTNUM = 880 02150097 +C 02160097 +C **** TEST 880 **** 02170097 +C 02180097 + IF (ICZERO) 38800, 8800, 38800 02190097 + 8800 CONTINUE 02200097 + RVON01 = -445.95 02210097 + RVCOMP = AINT (RVON01) 02220097 + GO TO 48800 02230097 +38800 IVDELE = IVDELE + 1 02240097 + WRITE (I02,80003) IVTNUM 02250097 + IF (ICZERO) 48800, 8811, 48800 02260097 +48800 IF (RVCOMP + 445.05) 28800,18800,48801 02270097 +48801 IF (RVCOMP + 444.95) 18800,18800,28800 02280097 +18800 IVPASS = IVPASS + 1 02290097 + WRITE (I02,80001) IVTNUM 02300097 + GO TO 8811 02310097 +28800 IVFAIL = IVFAIL + 1 02320097 + RVCORR = -445.00 02330097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02340097 + 8811 CONTINUE 02350097 + IVTNUM = 881 02360097 +C 02370097 +C **** TEST 881 **** 02380097 +C 02390097 + IF (ICZERO) 38810, 8810, 38810 02400097 + 8810 CONTINUE 02410097 + RVON01 = 466.01 02420097 + RVCOMP = AINT (RVON01) 02430097 + GO TO 48810 02440097 +38810 IVDELE = IVDELE + 1 02450097 + WRITE (I02,80003) IVTNUM 02460097 + IF (ICZERO) 48810, 8821, 48810 02470097 +48810 IF (RVCOMP - 465.95) 28810,18810,48811 02480097 +48811 IF (RVCOMP - 466.05) 18810,18810,28810 02490097 +18810 IVPASS = IVPASS + 1 02500097 + WRITE (I02,80001) IVTNUM 02510097 + GO TO 8821 02520097 +28810 IVFAIL = IVFAIL + 1 02530097 + RVCOMP = 466.00 02540097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02550097 + 8821 CONTINUE 02560097 + IVTNUM = 882 02570097 +C 02580097 +C **** TEST 882 **** 02590097 +C 02600097 + IF (ICZERO) 38820, 8820, 38820 02610097 + 8820 CONTINUE 02620097 + RVON01 = 382E-1 02630097 + RVCOMP = AINT (RVON01) 02640097 + GO TO 48820 02650097 +38820 IVDELE = IVDELE + 1 02660097 + WRITE (I02,80003) IVTNUM 02670097 + IF (ICZERO) 48820, 8831, 48820 02680097 +48820 IF (RVCOMP - 37.995) 28820,18820,48821 02690097 +48821 IF (RVCOMP - 38.005) 18820,18820,28820 02700097 +18820 IVPASS = IVPASS + 1 02710097 + WRITE (I02,80001) IVTNUM 02720097 + GO TO 8831 02730097 +28820 IVFAIL = IVFAIL + 1 02740097 + RVCORR = 38.000 02750097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02760097 + 8831 CONTINUE 02770097 +C 02780097 +C TEST 883 THROUGH 886 CONTAIN INTRINSIC FUNCTION TESTS FOR 02790097 +C REMAINDERING WHERE ARGUMENT AND FUNCTION ARE REAL 02800097 +C 02810097 + IVTNUM = 883 02820097 +C 02830097 +C **** TEST 883 **** 02840097 +C 02850097 + IF (ICZERO) 38830, 8830, 38830 02860097 + 8830 CONTINUE 02870097 + RVCOMP = AMOD (42.0,19.0) 02880097 + GO TO 48830 02890097 +38830 IVDELE = IVDELE + 1 02900097 + WRITE (I02,80003) IVTNUM 02910097 + IF (ICZERO) 48830, 8841, 48830 02920097 +48830 IF (RVCOMP - 3.9995) 28830,18830,48831 02930097 +48831 IF (RVCOMP - 4.0005) 18830,18830,28830 02940097 +18830 IVPASS = IVPASS + 1 02950097 + WRITE (I02,80001) IVTNUM 02960097 + GO TO 8841 02970097 +28830 IVFAIL = IVFAIL + 1 02980097 + RVCORR = 4.0000 02990097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03000097 + 8841 CONTINUE 03010097 + IVTNUM = 884 03020097 +C 03030097 +C **** TEST 884 **** 03040097 +C 03050097 + IF (ICZERO) 38840, 8840, 38840 03060097 + 8840 CONTINUE 03070097 + RVON01 = 16.27 03080097 + RVON02 = 2.0 03090097 + RVCOMP = AMOD (RVON01,RVON02) 03100097 + GO TO 48840 03110097 +38840 IVDELE = IVDELE + 1 03120097 + WRITE (I02,80003) IVTNUM 03130097 + IF (ICZERO) 48840, 8851, 48840 03140097 +48840 IF (RVCOMP - .26995) 28840,18840,48841 03150097 +48841 IF (RVCOMP - .27005) 18840,18840,28840 03160097 +18840 IVPASS = IVPASS + 1 03170097 + WRITE (I02,80001) IVTNUM 03180097 + GO TO 8851 03190097 +28840 IVFAIL = IVFAIL + 1 03200097 + RVCORR = .27000 03210097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03220097 + 8851 CONTINUE 03230097 + IVTNUM = 885 03240097 +C 03250097 +C **** TEST 885 **** 03260097 +C 03270097 + IF (ICZERO) 38850, 8850, 38850 03280097 + 8850 CONTINUE 03290097 + RVON01 = 225.0 03300097 + RVON02 = 5.0E1 03310097 + RVCOMP = AMOD (RVON01,RVON02) 03320097 + GO TO 48850 03330097 +38850 IVDELE = IVDELE + 1 03340097 + WRITE (I02,80003) IVTNUM 03350097 + IF (ICZERO) 48850, 8861, 48850 03360097 +48850 IF (RVCOMP - 24.995) 28850,18850,48851 03370097 +48851 IF (RVCOMP - 25.005) 18850,18850,28850 03380097 +18850 IVPASS = IVPASS + 1 03390097 + WRITE (I02,80001) IVTNUM 03400097 + GO TO 8861 03410097 +28850 IVFAIL = IVFAIL + 1 03420097 + RVCORR = 25.000 03430097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03440097 + 8861 CONTINUE 03450097 + IVTNUM = 886 03460097 +C 03470097 +C **** TEST 886 **** 03480097 +C 03490097 + IF (ICZERO) 38860, 8860, 38860 03500097 + 8860 CONTINUE 03510097 + RVON01 = -0.390E+2 03520097 + RVON02 = 5E2 03530097 + RVCOMP = AMOD (RVON01,RVON02) 03540097 + GO TO 48860 03550097 +38860 IVDELE = IVDELE + 1 03560097 + WRITE (I02,80003) IVTNUM 03570097 + IF (ICZERO) 48860, 8871, 48860 03580097 +48860 IF (RVCOMP + 39.005) 28860,18860,48861 03590097 +48861 IF (RVCOMP + 38.995) 18860,18860,28860 03600097 +18860 IVPASS = IVPASS + 1 03610097 + WRITE (I02,80001) IVTNUM 03620097 + GO TO 8871 03630097 +28860 IVFAIL = IVFAIL + 1 03640097 + RVCORR = -39.000 03650097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03660097 + 8871 CONTINUE 03670097 +C 03680097 +C TEST 887 AND 888 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 03690097 +C LARGEST VALUE WHERE ARGUMENTS ARE INTEGER AND FUNCTION IS REAL 03700097 +C 03710097 + IVTNUM = 887 03720097 +C 03730097 +C **** TEST 887 **** 03740097 +C 03750097 + IF (ICZERO) 38870, 8870, 38870 03760097 + 8870 CONTINUE 03770097 + IVON01 = 317 03780097 + IVON02 = -99 03790097 + IVON03 = 1 03800097 + RVCOMP = AMAX0 (263,IVON01,IVON02,IVON03) 03810097 + GO TO 48870 03820097 +38870 IVDELE = IVDELE + 1 03830097 + WRITE (I02,80003) IVTNUM 03840097 + IF (ICZERO) 48870, 8881, 48870 03850097 +48870 IF (RVCOMP - 316.95) 28870,18870,48871 03860097 +48871 IF (RVCOMP - 317.05) 18870,18870,28870 03870097 +18870 IVPASS = IVPASS + 1 03880097 + WRITE (I02,80001) IVTNUM 03890097 + GO TO 8881 03900097 +28870 IVFAIL = IVFAIL + 1 03910097 + RVCORR = 317.00 03920097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03930097 + 8881 CONTINUE 03940097 + IVTNUM = 888 03950097 +C 03960097 +C **** TEST 888 **** 03970097 +C 03980097 + IF (ICZERO) 38880, 8880, 38880 03990097 + 8880 CONTINUE 04000097 + IVON01 = 2572 04010097 + IVON02 = 2570 04020097 + RVCOMP = AMAX0 (IVON01,IVON02) 04030097 + GO TO 48880 04040097 +38880 IVDELE = IVDELE + 1 04050097 + WRITE (I02,80003) IVTNUM 04060097 + IF (ICZERO) 48880, 8891, 48880 04070097 +48880 IF (RVCOMP - 2571.5) 28880,18880,48881 04080097 +48881 IF (RVCOMP - 2572.5) 18880,18880,28880 04090097 +18880 IVPASS = IVPASS + 1 04100097 + WRITE (I02,80001) IVTNUM 04110097 + GO TO 8891 04120097 +28880 IVFAIL = IVFAIL + 1 04130097 + RVCORR = 2572.0 04140097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04150097 + 8891 CONTINUE 04160097 +C 04170097 +C TEST 889 AND 890 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04180097 +C LARGEST VALUE WHERE THE ARGUMENTS AND FUNCTION ARE REAL 04190097 +C 04200097 + IVTNUM = 889 04210097 +C 04220097 +C **** TEST 889 **** 04230097 +C 04240097 + IF (ICZERO) 38890, 8890, 38890 04250097 + 8890 CONTINUE 04260097 + RVON01 = .326E+2 04270097 + RVON02 = 22.075 04280097 + RVON03 = 76E-1 04290097 + RVCOMP = AMAX1 (RVON01,RVON02,RVON03) 04300097 + GO TO 48890 04310097 +38890 IVDELE = IVDELE + 1 04320097 + WRITE (I02,80003) IVTNUM 04330097 + IF (ICZERO) 48890, 8901, 48890 04340097 +48890 IF (RVCOMP - 32.595) 28890,18890,48891 04350097 +48891 IF (RVCOMP - 32.605) 18890,18890,28890 04360097 +18890 IVPASS = IVPASS + 1 04370097 + WRITE (I02,80001) IVTNUM 04380097 + GO TO 8901 04390097 +28890 IVFAIL = IVFAIL + 1 04400097 + RVCORR = 32.600 04410097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04420097 + 8901 CONTINUE 04430097 + IVTNUM = 890 04440097 +C 04450097 +C **** TEST 890 **** 04460097 +C 04470097 + IF (ICZERO) 38900, 8900, 38900 04480097 + 8900 CONTINUE 04490097 + RVON01 = -6.3E2 04500097 + RVON02 = -21.0 04510097 + RVCOMP = AMAX1 (-463.3,RVON01,RVON02) 04520097 + GO TO 48900 04530097 +38900 IVDELE = IVDELE + 1 04540097 + WRITE (I02,80003) IVTNUM 04550097 + IF (ICZERO) 48900, 8911, 48900 04560097 +48900 IF (RVCOMP + 21.005) 28900,18900,48901 04570097 +48901 IF (RVCOMP + 20.995) 18900,18900,28900 04580097 +18900 IVPASS = IVPASS + 1 04590097 + WRITE (I02,80001) IVTNUM 04600097 + GO TO 8911 04610097 +28900 IVFAIL = IVFAIL + 1 04620097 + RVCORR = -21.000 04630097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04640097 + 8911 CONTINUE 04650097 +C 04660097 +C TESTS 891 AND 892 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04670097 +C SMALLEST VALUE WHERE ARGUMENTS ARE INTEGER AND FUNCTION IS REAL 04680097 +C 04690097 + IVTNUM = 891 04700097 +C 04710097 +C **** TEST 891 **** 04720097 +C 04730097 + IF (ICZERO) 38910, 8910, 38910 04740097 + 8910 CONTINUE 04750097 + IVON01 = -75 04760097 + IVON02 = -243 04770097 + RVCOMP = AMIN0 (IVON01,IVON02) 04780097 + GO TO 48910 04790097 +38910 IVDELE = IVDELE + 1 04800097 + WRITE (I02,80003) IVTNUM 04810097 + IF (ICZERO) 48910, 8921, 48910 04820097 +48910 IF (RVCOMP + 243.05) 28910,18910,48911 04830097 +48911 IF (RVCOMP + 242.95) 18910,18910,28910 04840097 +18910 IVPASS = IVPASS + 1 04850097 + WRITE (I02,80001) IVTNUM 04860097 + GO TO 8921 04870097 +28910 IVFAIL = IVFAIL + 1 04880097 + RVCORR = -243.00 04890097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04900097 + 8921 CONTINUE 04910097 + IVTNUM = 892 04920097 +C 04930097 +C **** TEST 892 **** 04940097 +C 04950097 + IF (ICZERO) 38920, 8920, 38920 04960097 + 8920 CONTINUE 04970097 + IVON01 = -11 04980097 + IVON02 = 11 04990097 + RVCOMP = AMIN0 (0,IVON01,IVON02) 05000097 + GO TO 48920 05010097 +38920 IVDELE = IVDELE + 1 05020097 + WRITE (I02,80003) IVTNUM 05030097 + IF (ICZERO) 48920, 8931, 48920 05040097 +48920 IF (RVCOMP + 11.005) 28920,18920,48921 05050097 +48921 IF (RVCOMP + 10.995) 18920,18920,28920 05060097 +18920 IVPASS = IVPASS + 1 05070097 + WRITE (I02,80001) IVTNUM 05080097 + GO TO 8931 05090097 +28920 IVFAIL = IVFAIL + 1 05100097 + RVCORR = -11.000 05110097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05120097 + 8931 CONTINUE 05130097 +C 05140097 +C TESTS 893 AND 894 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 05150097 +C SMALLEST VALUE WHERE ARGUMENTS AND FUNCTION ARE REAL 05160097 +C 05170097 + IVTNUM = 893 05180097 +C 05190097 +C **** TEST 893 **** 05200097 +C 05210097 + IF (ICZERO) 38930, 8930, 38930 05220097 + 8930 CONTINUE 05230097 + RVON01 = 1.1111 05240097 + RVON02 = 22.222 05250097 + RVON03 = 333.33 05260097 + RVCOMP = AMIN1 (RVON01,RVON02,RVON03) 05270097 + GO TO 48930 05280097 +38930 IVDELE = IVDELE + 1 05290097 + WRITE (I02,80003) IVTNUM 05300097 + IF (ICZERO) 48930, 8941, 48930 05310097 +48930 IF (RVCOMP - 1.1106) 28930,18930,48931 05320097 +48931 IF (RVCOMP - 1.1116) 18930,18930,28930 05330097 +18930 IVPASS = IVPASS + 1 05340097 + WRITE (I02,80001) IVTNUM 05350097 + GO TO 8941 05360097 +28930 IVFAIL = IVFAIL + 1 05370097 + RVCORR = 1.1111 05380097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05390097 + 8941 CONTINUE 05400097 + IVTNUM = 894 05410097 +C 05420097 +C **** TEST 894 **** 05430097 +C 05440097 + IF (ICZERO) 38940, 8940, 38940 05450097 + 8940 CONTINUE 05460097 + RVON01 = 28.8 05470097 + RVON02 = 2.88E1 05480097 + RVON03 = 288E-1 05490097 + RVON04 = 35.0 05500097 + RVCOMP = AMIN1 (RVON01,RVON02,RVON03,RVON04) 05510097 + GO TO 48940 05520097 +38940 IVDELE = IVDELE + 1 05530097 + WRITE (I02,80003) IVTNUM 05540097 + IF (ICZERO) 48940, 8951, 48940 05550097 +48940 IF (RVCOMP - 28.795) 28940,18940,48941 05560097 +48941 IF (RVCOMP - 28.805) 18940,18940,28940 05570097 +18940 IVPASS = IVPASS + 1 05580097 + WRITE (I02,80001) IVTNUM 05590097 + GO TO 8951 05600097 +28940 IVFAIL = IVFAIL + 1 05610097 + RVCORR = 28.800 05620097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05630097 + 8951 CONTINUE 05640097 +C 05650097 +C TEST 895 THROUGH TEST 897 CONTAIN INTRINSIC FUNCTION TESTS FOR 05660097 +C FLOAT - CONVERSION OF AN INTEGER ARGUMENT TO REAL FUNCTION 05670097 +C 05680097 + IVTNUM = 895 05690097 +C 05700097 +C **** TEST 895 **** 05710097 +C 05720097 + IF (ICZERO) 38950, 8950, 38950 05730097 + 8950 CONTINUE 05740097 + RVCOMP = FLOAT (-606) 05750097 + GO TO 48950 05760097 +38950 IVDELE = IVDELE + 1 05770097 + WRITE (I02,80003) IVTNUM 05780097 + IF (ICZERO) 48950, 8961, 48950 05790097 +48950 IF (RVCOMP + 606.05) 28950,18950,48951 05800097 +48951 IF (RVCOMP + 605.95) 18950,18950,28950 05810097 +18950 IVPASS = IVPASS + 1 05820097 + WRITE (I02,80001) IVTNUM 05830097 + GO TO 8961 05840097 +28950 IVFAIL = IVFAIL + 1 05850097 + RVCORR = -606.00 05860097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05870097 + 8961 CONTINUE 05880097 + IVTNUM = 896 05890097 +C 05900097 +C **** TEST 896 **** 05910097 +C 05920097 + IF (ICZERO) 38960, 8960, 38960 05930097 + 8960 CONTINUE 05940097 + IVON01 = 71 05950097 + RVCOMP = FLOAT (IVON01) 05960097 + GO TO 48960 05970097 +38960 IVDELE = IVDELE + 1 05980097 + WRITE (I02,80003) IVTNUM 05990097 + IF (ICZERO) 48960, 8971, 48960 06000097 +48960 IF (RVCOMP - 70.995) 28960,18960,48961 06010097 +48961 IF (RVCOMP - 71.005) 18960,18960,28960 06020097 +18960 IVPASS = IVPASS + 1 06030097 + WRITE (I02,80001) IVTNUM 06040097 + GO TO 8971 06050097 +28960 IVFAIL = IVFAIL + 1 06060097 + RVCORR = 71.000 06070097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06080097 + 8971 CONTINUE 06090097 + IVTNUM = 897 06100097 +C 06110097 +C **** TEST 897 **** 06120097 +C 06130097 + IF (ICZERO) 38970, 8970, 38970 06140097 + 8970 CONTINUE 06150097 + IVON01 = 321 06160097 + RVCOMP = FLOAT (-IVON01) 06170097 + GO TO 48970 06180097 +38970 IVDELE = IVDELE + 1 06190097 + WRITE (I02,80003) IVTNUM 06200097 + IF (ICZERO) 48970, 8981, 48970 06210097 +48970 IF (RVCOMP + 321.05) 28970,18970,48971 06220097 +48971 IF (RVCOMP + 320.95) 18970,18970,28970 06230097 +18970 IVPASS = IVPASS + 1 06240097 + WRITE (I02,80001) IVTNUM 06250097 + GO TO 8981 06260097 +28970 IVFAIL = IVFAIL + 1 06270097 + RVCORR = -321.00 06280097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06290097 + 8981 CONTINUE 06300097 +C 06310097 +C TEST 898 THROUGH TEST 900 CONTAIN INTRINSIC FUNCTION TESTS FOR 06320097 +C TRANSFER OF SIGN - BOTH ARGUMENTS AND FUNCTION ARE REAL 06330097 +C 06340097 + IVTNUM = 898 06350097 +C 06360097 +C **** TEST 898 **** 06370097 +C 06380097 + IF (ICZERO) 38980, 8980, 38980 06390097 + 8980 CONTINUE 06400097 + RVON01 = 64.3 06410097 + RVCOMP = SIGN (RVON01,-1.0) 06420097 + GO TO 48980 06430097 +38980 IVDELE = IVDELE + 1 06440097 + WRITE (I02,80003) IVTNUM 06450097 + IF (ICZERO) 48980, 8991, 48980 06460097 +48980 IF (RVCOMP + 64.305) 28980,18980,48981 06470097 +48981 IF (RVCOMP + 64.295) 18980,18980,28980 06480097 +18980 IVPASS = IVPASS + 1 06490097 + WRITE (I02,80001) IVTNUM 06500097 + GO TO 8991 06510097 +28980 IVFAIL = IVFAIL + 1 06520097 + RVCORR = -64.300 06530097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06540097 + 8991 CONTINUE 06550097 + IVTNUM = 899 06560097 +C 06570097 +C **** TEST 899 **** 06580097 +C 06590097 + IF (ICZERO) 38990, 8990, 38990 06600097 + 8990 CONTINUE 06610097 + RVON01 = -2.2 06620097 + RVON02 = 7.23E1 06630097 + RVCOMP = SIGN (RVON01,RVON02) 06640097 + GO TO 48990 06650097 +38990 IVDELE = IVDELE + 1 06660097 + WRITE (I02,80003) IVTNUM 06670097 + IF (ICZERO) 48990, 9001, 48990 06680097 +48990 IF (RVCOMP - 2.1995) 28990,18990,48991 06690097 +48991 IF (RVCOMP - 2.2005) 18990,18990,28990 06700097 +18990 IVPASS = IVPASS + 1 06710097 + WRITE (I02,80001) IVTNUM 06720097 + GO TO 9001 06730097 +28990 IVFAIL = IVFAIL + 1 06740097 + RVCORR = 2.2000 06750097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06760097 + 9001 CONTINUE 06770097 + IVTNUM = 900 06780097 +C 06790097 +C **** TEST 900 **** 06800097 +C 06810097 + IF (ICZERO) 39000, 9000, 39000 06820097 + 9000 CONTINUE 06830097 + RVON01 = 35.32E+1 06840097 + RVON02 = 1.0 06850097 + RVCOMP = SIGN (RVON01,RVON02) 06860097 + GO TO 49000 06870097 +39000 IVDELE = IVDELE + 1 06880097 + WRITE (I02,80003) IVTNUM 06890097 + IF (ICZERO) 49000, 9011, 49000 06900097 +49000 IF (RVCOMP - 353.15) 29000,19000,49001 06910097 +49001 IF (RVCOMP - 353.25) 19000,19000,29000 06920097 +19000 IVPASS = IVPASS + 1 06930097 + WRITE (I02,80001) IVTNUM 06940097 + GO TO 9011 06950097 +29000 IVFAIL = IVFAIL + 1 06960097 + RVCORR = 353.20 06970097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06980097 + 9011 CONTINUE 06990097 +C 07000097 +C TEST 901 THROUGH TEST 904 CONTAIN INTRINSIC FUNCTION TESTS FOR 07010097 +C POSITIVE DIFFERENCE WHERE ARGUMENTS AND FUNCTION ARE REAL 07020097 +C 07030097 + IVTNUM = 901 07040097 +C 07050097 +C **** TEST 901 **** 07060097 +C 07070097 + IF (ICZERO) 39010, 9010, 39010 07080097 + 9010 CONTINUE 07090097 + RVON01 = 22.2 07100097 + RVCOMP = DIM (RVON01,1.0) 07110097 + GO TO 49010 07120097 +39010 IVDELE = IVDELE + 1 07130097 + WRITE (I02,80003) IVTNUM 07140097 + IF (ICZERO) 49010, 9021, 49010 07150097 +49010 IF (RVCOMP - 21.195) 29010,19010,49011 07160097 +49011 IF (RVCOMP - 21.205) 19010,19010,29010 07170097 +19010 IVPASS = IVPASS + 1 07180097 + WRITE (I02,80001) IVTNUM 07190097 + GO TO 9021 07200097 +29010 IVFAIL = IVFAIL + 1 07210097 + RVCORR = 21.200 07220097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07230097 + 9021 CONTINUE 07240097 + IVTNUM = 902 07250097 +C 07260097 +C **** TEST 902 **** 07270097 +C 07280097 + IF (ICZERO) 39020, 9020, 39020 07290097 + 9020 CONTINUE 07300097 + RVON01 = 4.5E1 07310097 + RVON02 = 41.0 07320097 + RVCOMP = DIM (RVON01,RVON02) 07330097 + GO TO 49020 07340097 +39020 IVDELE = IVDELE + 1 07350097 + WRITE (I02,80003) IVTNUM 07360097 + IF (ICZERO) 49020, 9031, 49020 07370097 +49020 IF (RVCOMP - 3.9995) 29020,19020,49021 07380097 +49021 IF (RVCOMP - 4.0005) 19020,19020,29020 07390097 +19020 IVPASS = IVPASS + 1 07400097 + WRITE (I02,80001) IVTNUM 07410097 + GO TO 9031 07420097 +29020 IVFAIL = IVFAIL + 1 07430097 + RVCORR = 4.0000 07440097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07450097 + 9031 CONTINUE 07460097 + IVTNUM = 903 07470097 +C 07480097 +C **** TEST 903 **** 07490097 +C 07500097 + IF (ICZERO) 39030, 9030, 39030 07510097 + 9030 CONTINUE 07520097 + RVON01 = 2.0 07530097 + RVON02 = 10.0 07540097 + RVCOMP = DIM (RVON01,RVON02) 07550097 + GO TO 49030 07560097 +39030 IVDELE = IVDELE + 1 07570097 + WRITE (I02,80003) IVTNUM 07580097 + IF (ICZERO) 49030, 9041, 49030 07590097 +49030 IF (RVCOMP) 29030,19030,29030 07600097 +19030 IVPASS = IVPASS + 1 07610097 + WRITE (I02,80001) IVTNUM 07620097 + GO TO 9041 07630097 +29030 IVFAIL = IVFAIL + 1 07640097 + RVCORR = 0.0000 07650097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07660097 + 9041 CONTINUE 07670097 + IVTNUM = 904 07680097 +C 07690097 +C **** TEST 904 **** 07700097 +C 07710097 + IF (ICZERO) 39040, 9040, 39040 07720097 + 9040 CONTINUE 07730097 + RVON01 = 1.65E+1 07740097 + RVON02 = -2.0 07750097 + RVCOMP = DIM (RVON01,RVON02) 07760097 + GO TO 49040 07770097 +39040 IVDELE = IVDELE + 1 07780097 + WRITE (I02,80003) IVTNUM 07790097 + IF (ICZERO) 49040, 9051, 49040 07800097 +49040 IF (RVCOMP - 18.495) 29040,19040,49041 07810097 +49041 IF (RVCOMP - 18.505) 19040,19040,29040 07820097 +19040 IVPASS = IVPASS + 1 07830097 + WRITE (I02,80001) IVTNUM 07840097 + GO TO 9051 07850097 +29040 IVFAIL = IVFAIL + 1 07860097 + RVCORR = 18.500 07870097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 07880097 + 9051 CONTINUE 07890097 +C 07900097 +C TESTS 905 AND 906 CONTAIN EXPRESSIONS CONTAINING MORE THAN ONE 07910097 +C INTRINSIC FUNCTION - ALL ARGUMENTS AND FUNCTIONS ARE REAL 07920097 +C 07930097 + IVTNUM = 905 07940097 +C 07950097 +C **** TEST 905 **** 07960097 +C 07970097 + IF (ICZERO) 39050, 9050, 39050 07980097 + 9050 CONTINUE 07990097 + RVON01 = 33.3 08000097 + RVON02 = -12.1 08010097 + RVCOMP = AINT (RVON01) + ABS (RVON02) 08020097 + GO TO 49050 08030097 +39050 IVDELE = IVDELE + 1 08040097 + WRITE (I02,80003) IVTNUM 08050097 + IF (ICZERO) 49050, 9061, 49050 08060097 +49050 IF (RVCOMP - 45.095) 29050,19050,49051 08070097 +49051 IF (RVCOMP - 45.105) 19050,19050,29050 08080097 +19050 IVPASS = IVPASS + 1 08090097 + WRITE (I02,80001) IVTNUM 08100097 + GO TO 9061 08110097 +29050 IVFAIL = IVFAIL + 1 08120097 + RVCORR = 45.100 08130097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08140097 + 9061 CONTINUE 08150097 + IVTNUM = 906 08160097 +C 08170097 +C **** TEST 906 **** 08180097 +C 08190097 + IF (ICZERO) 39060, 9060, 39060 08200097 + 9060 CONTINUE 08210097 + RVON01 = 76.3 08220097 + RVON02 = 2.1E1 08230097 + RVON03 = 3E1 08240097 + RVCOMP = AMAX1(RVON01,RVON02,RVON03)-AMIN1(RVON01,RVON02,RVON03) 08250097 + GO TO 49060 08260097 +39060 IVDELE = IVDELE + 1 08270097 + WRITE (I02,80003) IVTNUM 08280097 + IF (ICZERO) 49060, 9071, 49060 08290097 +49060 IF (RVCOMP - 55.295) 29060,19060,49061 08300097 +49061 IF (RVCOMP - 55.305) 19060,19060,29060 08310097 +19060 IVPASS = IVPASS + 1 08320097 + WRITE (I02,80001) IVTNUM 08330097 + GO TO 9071 08340097 +29060 IVFAIL = IVFAIL + 1 08350097 + RVCORR = 55.300 08360097 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 08370097 + 9071 CONTINUE 08380097 +C 08390097 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08400097 +99999 CONTINUE 08410097 + WRITE (I02,90002) 08420097 + WRITE (I02,90006) 08430097 + WRITE (I02,90002) 08440097 + WRITE (I02,90002) 08450097 + WRITE (I02,90007) 08460097 + WRITE (I02,90002) 08470097 + WRITE (I02,90008) IVFAIL 08480097 + WRITE (I02,90009) IVPASS 08490097 + WRITE (I02,90010) IVDELE 08500097 +C 08510097 +C 08520097 +C TERMINATE ROUTINE EXECUTION 08530097 + STOP 08540097 +C 08550097 +C FORMAT STATEMENTS FOR PAGE HEADERS 08560097 +90000 FORMAT ("1") 08570097 +90002 FORMAT (" ") 08580097 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08590097 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08600097 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08610097 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08620097 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08630097 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08640097 +C 08650097 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08660097 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08670097 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08680097 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08690097 +C 08700097 +C FORMAT STATEMENTS FOR TEST RESULTS 08710097 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08720097 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08730097 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08740097 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08750097 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08760097 +C 08770097 +90007 FORMAT (" ",20X,"END OF PROGRAM FM097" ) 08780097 + END 08790097 diff --git a/Fortran/UnitTests/fcvs21_f95/FM097.reference_output b/Fortran/UnitTests/fcvs21_f95/FM097.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM097.reference_output @@ -0,0 +1,56 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 875 PASS + 876 PASS + 877 PASS + 878 PASS + 879 PASS + 880 PASS + 881 PASS + 882 PASS + 883 PASS + 884 PASS + 885 PASS + 886 PASS + 887 PASS + 888 PASS + 889 PASS + 890 PASS + 891 PASS + 892 PASS + 893 PASS + 894 PASS + 895 PASS + 896 PASS + 897 PASS + 898 PASS + 899 PASS + 900 PASS + 901 PASS + 902 PASS + 903 PASS + 904 PASS + 905 PASS + 906 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM097 + + 0 ERRORS ENCOUNTERED + 32 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM098.f b/Fortran/UnitTests/fcvs21_f95/FM098.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM098.f @@ -0,0 +1,852 @@ + PROGRAM FM098 + +C COMMENT SECTION 00010098 +C 00020098 +C FM098 00030098 +C 00040098 +C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION TYPE IS 00050098 +C INTEGER AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE REAL 00060098 +C AND INTEGER VARIABLES AND THE REAL AND INTEGER CONSTANTS CONTAIN 00070098 +C BOTH POSITIVE AND NEGATIVE VALUES. THE INTRINSIC FUNCTIONS TESTED00080098 +C BY FM098 INCLUDE 00090098 +C TYPE OF 00100098 +C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION 00110098 +C ------------------ ---- -------- -------- 00120098 +C ABSOLUTE VALUE IABS INTEGER INTEGER 00130098 +C TRUNCATION INT REAL INTEGER 00140098 +C REMAINDERING MOD INTEGER INTEGER 00150098 +C CHOOSING LARGEST VALUE MAX0 INTEGER INTEGER 00160098 +C MAX1 REAL INTEGER 00170098 +C CHOOSING SMALLEST VALUE MIN0 INTEGER INTEGER 00180098 +C MIN1 REAL INTEGER 00190098 +C FIX IFIX REAL INTEGER 00200098 +C TRANSFER OF SIGN ISIGN INTEGER INTEGER 00210098 +C POSITIVE DIFFERENCE IDIM INTEGER INTEGER 00220098 +C 00230098 +C REFERENCES 00240098 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00250098 +C X3.9-1978 00260098 +C 00270098 +C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS 00280098 +C SECTION 15.3, INTRINSIC FUNCTION 00290098 +C SECTION 15.3.2, INTRINSIC FUNCTIONS AND THEIR REFERENCE 00300098 +C 00310098 +C 00320098 +C ********************************************************** 00330098 +C 00340098 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00350098 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00360098 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00370098 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00380098 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00390098 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00400098 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00410098 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00420098 +C OF EXECUTING THESE TESTS. 00430098 +C 00440098 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00450098 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00460098 +C 00470098 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00480098 +C 00490098 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00500098 +C SOFTWARE STANDARDS VALIDATION GROUP 00510098 +C BUILDING 225 RM A266 00520098 +C GAITHERSBURG, MD 20899 00530098 +C ********************************************************** 00540098 +C 00550098 +C 00560098 +C 00570098 +C INITIALIZATION SECTION 00580098 +C 00590098 +C INITIALIZE CONSTANTS 00600098 +C ************** 00610098 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620098 + I01 = 5 00630098 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640098 + I02 = 6 00650098 +C SYSTEM ENVIRONMENT SECTION 00660098 +C 00670098 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00680098 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690098 +C (UNIT NUMBER FOR CARD READER). 00700098 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00710098 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00720098 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00730098 +C 00740098 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00750098 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00760098 +C (UNIT NUMBER FOR PRINTER). 00770098 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00780098 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00790098 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00800098 +C 00810098 + IVPASS=0 00820098 + IVFAIL=0 00830098 + IVDELE=0 00840098 + ICZERO=0 00850098 +C 00860098 +C WRITE PAGE HEADERS 00870098 + WRITE (I02,90000) 00880098 + WRITE (I02,90001) 00890098 + WRITE (I02,90002) 00900098 + WRITE (I02, 90002) 00910098 + WRITE (I02,90003) 00920098 + WRITE (I02,90002) 00930098 + WRITE (I02,90004) 00940098 + WRITE (I02,90002) 00950098 + WRITE (I02,90011) 00960098 + WRITE (I02,90002) 00970098 + WRITE (I02,90002) 00980098 + WRITE (I02,90005) 00990098 + WRITE (I02,90006) 01000098 + WRITE (I02,90002) 01010098 +C 01020098 +C TEST SECTION 01030098 +C 01040098 +C TEST 907 THROUGH TEST 909 CONTAIN INTRINSIC FUNCTION TESTS FOR 01050098 +C ABSOLUTE VALUE WHERE ARGUMENT AND FUNCTION ARE INTEGER 01060098 +C 01070098 + 9071 CONTINUE 01080098 + IVTNUM = 907 01090098 +C 01100098 +C **** TEST 907 **** 01110098 +C 01120098 + IF (ICZERO) 39070, 9070, 39070 01130098 + 9070 CONTINUE 01140098 + IVCOMP = IABS (-382) 01150098 + GO TO 49070 01160098 +39070 IVDELE = IVDELE + 1 01170098 + WRITE (I02,80003) IVTNUM 01180098 + IF (ICZERO) 49070, 9081, 49070 01190098 +49070 IF (IVCOMP - 382) 29070,19070,29070 01200098 +19070 IVPASS = IVPASS + 1 01210098 + WRITE (I02,80001) IVTNUM 01220098 + GO TO 9081 01230098 +29070 IVFAIL = IVFAIL + 1 01240098 + IVCORR = 382 01250098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01260098 + 9081 CONTINUE 01270098 + IVTNUM = 908 01280098 +C 01290098 +C **** TEST 908 **** 01300098 +C 01310098 + IF (ICZERO) 39080, 9080, 39080 01320098 + 9080 CONTINUE 01330098 + IVON01 = 445 01340098 + IVCOMP = IABS (IVON01) 01350098 + GO TO 49080 01360098 +39080 IVDELE = IVDELE + 1 01370098 + WRITE (I02,80003) IVTNUM 01380098 + IF (ICZERO) 49080, 9091, 49080 01390098 +49080 IF (IVCOMP - 445) 29080,19080,29080 01400098 +19080 IVPASS = IVPASS + 1 01410098 + WRITE (I02,80001) IVTNUM 01420098 + GO TO 9091 01430098 +29080 IVFAIL = IVFAIL + 1 01440098 + IVCORR = 445 01450098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01460098 + 9091 CONTINUE 01470098 + IVTNUM = 909 01480098 +C 01490098 +C **** TEST 909 **** 01500098 +C 01510098 + IF (ICZERO) 39090, 9090, 39090 01520098 + 9090 CONTINUE 01530098 + IVON01 = -32176 01540098 + IVCOMP = IABS (IVON01) 01550098 + GO TO 49090 01560098 +39090 IVDELE = IVDELE + 1 01570098 + WRITE (I02,80003) IVTNUM 01580098 + IF (ICZERO) 49090, 9101, 49090 01590098 +49090 IF (IVCOMP - 32176) 29090,19090,29090 01600098 +19090 IVPASS = IVPASS + 1 01610098 + WRITE (I02,80001) IVTNUM 01620098 + GO TO 9101 01630098 +29090 IVFAIL = IVFAIL + 1 01640098 + IVCORR = 32176 01650098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01660098 +C 01670098 +C TEST 910 THROUGH TEST 913 CONTAIN INTRINSIC FUNCTION TESTS FOR 01680098 +C TRUNCATION WHERE ARGUMENT IS REAL AND FUNCTION IS INTEGER 01690098 +C 01700098 + 9101 CONTINUE 01710098 + IVTNUM = 910 01720098 +C 01730098 +C **** TEST 910 **** 01740098 +C 01750098 + IF (ICZERO) 39100, 9100, 39100 01760098 + 9100 CONTINUE 01770098 + IVCOMP = INT (38.2) 01780098 + GO TO 49100 01790098 +39100 IVDELE = IVDELE + 1 01800098 + WRITE (I02,80003) IVTNUM 01810098 + IF (ICZERO) 49100, 9111, 49100 01820098 +49100 IF (IVCOMP - 38) 29100,19100,29100 01830098 +19100 IVPASS = IVPASS + 1 01840098 + WRITE (I02,80001) IVTNUM 01850098 + GO TO 9111 01860098 +29100 IVFAIL = IVFAIL + 1 01870098 + IVCORR = 38 01880098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 01890098 + 9111 CONTINUE 01900098 + IVTNUM = 911 01910098 +C 01920098 +C **** TEST 911 **** 01930098 +C 01940098 + IF (ICZERO) 39110, 9110, 39110 01950098 + 9110 CONTINUE 01960098 + RVON01 = -445.95 01970098 + IVCOMP = INT (RVON01) 01980098 + GO TO 49110 01990098 +39110 IVDELE = IVDELE + 1 02000098 + WRITE (I02,80003) IVTNUM 02010098 + IF (ICZERO) 49110, 9121, 49110 02020098 +49110 IF (IVCOMP + 445) 29110,19110,29110 02030098 +19110 IVPASS = IVPASS + 1 02040098 + WRITE (I02,80001) IVTNUM 02050098 + GO TO 9121 02060098 +29110 IVFAIL = IVFAIL + 1 02070098 + IVCORR = -445 02080098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02090098 + 9121 CONTINUE 02100098 + IVTNUM = 912 02110098 +C 02120098 +C **** TEST 912 **** 02130098 +C 02140098 + IF (ICZERO) 39120, 9120, 39120 02150098 + 9120 CONTINUE 02160098 + RVON01 = 466.01 02170098 + IVCOMP = INT (RVON01) 02180098 + GO TO 49120 02190098 +39120 IVDELE = IVDELE + 1 02200098 + WRITE (I02,80003) IVTNUM 02210098 + IF (ICZERO) 49120, 9131, 49120 02220098 +49120 IF (IVCOMP - 466) 29120,19120,29120 02230098 +19120 IVPASS = IVPASS + 1 02240098 + WRITE (I02,80001) IVTNUM 02250098 + GO TO 9131 02260098 +29120 IVFAIL = IVFAIL + 1 02270098 + IVCORR = 466 02280098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02290098 + 9131 CONTINUE 02300098 + IVTNUM = 913 02310098 +C 02320098 +C **** TEST 913 **** 02330098 +C 02340098 + IF (ICZERO) 39130, 9130, 39130 02350098 + 9130 CONTINUE 02360098 + RVON01 = 382E-1 02370098 + IVCOMP = INT (RVON01) 02380098 + GO TO 49130 02390098 +39130 IVDELE = IVDELE + 1 02400098 + WRITE (I02,80003) IVTNUM 02410098 + IF (ICZERO) 49130, 9141, 49130 02420098 +49130 IF (IVCOMP - 38) 29130,19130,29130 02430098 +19130 IVPASS = IVPASS + 1 02440098 + WRITE (I02,80001) IVTNUM 02450098 + GO TO 9141 02460098 +29130 IVFAIL = IVFAIL + 1 02470098 + IVCORR = 38 02480098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02490098 +C 02500098 +C TEST 914 THROUGH TEST 917 CONTAIN INTRINSIC FUNCTION TESTS FOR 02510098 +C REMAINDERING WHERE ARGUMENTS AND FUNCTION ARE INTEGERS 02520098 +C 02530098 + 9141 CONTINUE 02540098 + IVTNUM = 914 02550098 +C 02560098 +C **** TEST 914 **** 02570098 +C 02580098 + IF (ICZERO) 39140, 9140, 39140 02590098 + 9140 CONTINUE 02600098 + IVCOMP = MOD (42,19) 02610098 + GO TO 49140 02620098 +39140 IVDELE = IVDELE + 1 02630098 + WRITE (I02,80003) IVTNUM 02640098 + IF (ICZERO) 49140, 9151, 49140 02650098 +49140 IF (IVCOMP - 4) 29140,19140,29140 02660098 +19140 IVPASS = IVPASS + 1 02670098 + WRITE (I02,80001) IVTNUM 02680098 + GO TO 9151 02690098 +29140 IVFAIL = IVFAIL + 1 02700098 + IVCORR = 4 02710098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02720098 + 9151 CONTINUE 02730098 + IVTNUM = 915 02740098 +C 02750098 +C **** TEST 915 **** 02760098 +C 02770098 + IF (ICZERO) 39150, 9150, 39150 02780098 + 9150 CONTINUE 02790098 + IVON01 = 6667 02800098 + IVON02 = 2 02810098 + IVCOMP = MOD (IVON01,IVON02) 02820098 + GO TO 49150 02830098 +39150 IVDELE = IVDELE + 1 02840098 + WRITE (I02,80003) IVTNUM 02850098 + IF (ICZERO) 49150, 9161, 49150 02860098 +49150 IF (IVCOMP - 1) 29150,19150,29150 02870098 +19150 IVPASS = IVPASS + 1 02880098 + WRITE (I02,80001) IVTNUM 02890098 + GO TO 9161 02900098 +29150 IVFAIL = IVFAIL + 1 02910098 + IVCORR = 1 02920098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 02930098 + 9161 CONTINUE 02940098 + IVTNUM = 916 02950098 +C 02960098 +C **** TEST 916 **** 02970098 +C 02980098 + IF (ICZERO) 39160, 9160, 39160 02990098 + 9160 CONTINUE 03000098 + IVON01 = 225 03010098 + IVON02 = 50 03020098 + IVCOMP = MOD (IVON01,IVON02) 03030098 + GO TO 49160 03040098 +39160 IVDELE = IVDELE + 1 03050098 + WRITE (I02,80003) IVTNUM 03060098 + IF (ICZERO) 49160, 9171, 49160 03070098 +49160 IF (IVCOMP - 25) 29160,19160,29160 03080098 +19160 IVPASS = IVPASS + 1 03090098 + WRITE (I02,80001) IVTNUM 03100098 + GO TO 9171 03110098 +29160 IVFAIL = IVFAIL + 1 03120098 + IVCORR = 25 03130098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03140098 + 9171 CONTINUE 03150098 + IVTNUM = 917 03160098 +C 03170098 +C **** TEST 917 **** 03180098 +C 03190098 + IF (ICZERO) 39170, 9170, 39170 03200098 + 9170 CONTINUE 03210098 + IVON01 = -39 03220098 + IVON02 = 500 03230098 + IVCOMP = MOD (IVON01,IVON02) 03240098 + GO TO 49170 03250098 +39170 IVDELE = IVDELE + 1 03260098 + WRITE (I02,80003) IVTNUM 03270098 + IF (ICZERO) 49170, 9181, 49170 03280098 +49170 IF (IVCOMP + 39) 29170,19170,29170 03290098 +19170 IVPASS = IVPASS + 1 03300098 + WRITE (I02,80001) IVTNUM 03310098 + GO TO 9181 03320098 +29170 IVFAIL = IVFAIL + 1 03330098 + IVCORR = -39 03340098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03350098 +C 03360098 +C TEST 918 AND 919 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 03370098 +C LARGEST VALUE WHERE ARGUMENTS AND FUNCTION ARE INTEGER 03380098 +C 03390098 + 9181 CONTINUE 03400098 + IVTNUM = 918 03410098 +C 03420098 +C **** TEST 918 **** 03430098 +C 03440098 + IF (ICZERO) 39180, 9180, 39180 03450098 + 9180 CONTINUE 03460098 + IVON01 = 317 03470098 + IVON02 = -99 03480098 + IVON03 = 1 03490098 + IVCOMP = MAX0 (263,IVON01,IVON02,IVON03) 03500098 + GO TO 49180 03510098 +39180 IVDELE = IVDELE + 1 03520098 + WRITE (I02,80003) IVTNUM 03530098 + IF (ICZERO) 49180, 9191, 49180 03540098 +49180 IF (IVCOMP - 317) 29180,19180,29180 03550098 +19180 IVPASS = IVPASS + 1 03560098 + WRITE (I02,80001) IVTNUM 03570098 + GO TO 9191 03580098 +29180 IVFAIL = IVFAIL + 1 03590098 + IVCORR = 317 03600098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03610098 + 9191 CONTINUE 03620098 + IVTNUM = 919 03630098 +C 03640098 +C **** TEST 919 **** 03650098 +C 03660098 + IF (ICZERO) 39190, 9190, 39190 03670098 + 9190 CONTINUE 03680098 + IVON01 = 2572 03690098 + IVON02 = 2570 03700098 + IVCOMP = MAX0 (IVON01,IVON02) 03710098 + GO TO 49190 03720098 +39190 IVDELE = IVDELE + 1 03730098 + WRITE (I02,80003) IVTNUM 03740098 + IF (ICZERO) 49190, 9201, 49190 03750098 +49190 IF (IVCOMP - 2572) 29190,19190,29190 03760098 +19190 IVPASS = IVPASS + 1 03770098 + WRITE (I02,80001) IVTNUM 03780098 + GO TO 9201 03790098 +29190 IVFAIL = IVFAIL + 1 03800098 + IVCORR = 2572 03810098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 03820098 +C 03830098 +C TEST 920 AND 921 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 03840098 +C LARGEST VALUE WHERE ARGUMENTS ARE REAL AND FUNCTION IS INTEGER 03850098 +C 03860098 + 9201 CONTINUE 03870098 + IVTNUM = 920 03880098 +C 03890098 +C **** TEST 920 **** 03900098 +C 03910098 + IF (ICZERO) 39200, 9200, 39200 03920098 + 9200 CONTINUE 03930098 + RVON01 = .326E+2 03940098 + RVON02 = 22.075 03950098 + RVON03 = 76E-1 03960098 + IVCOMP = MAX1 (RVON01,RVON02,RVON03) 03970098 + GO TO 49200 03980098 +39200 IVDELE = IVDELE + 1 03990098 + WRITE (I02,80003) IVTNUM 04000098 + IF (ICZERO) 49200, 9211, 49200 04010098 +49200 IF (IVCOMP - 32) 29200,19200,29200 04020098 +19200 IVPASS = IVPASS + 1 04030098 + WRITE (I02,80001) IVTNUM 04040098 + GO TO 9211 04050098 +29200 IVFAIL = IVFAIL + 1 04060098 + IVCORR = 32 04070098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04080098 + 9211 CONTINUE 04090098 + IVTNUM = 921 04100098 +C 04110098 +C **** TEST 921 **** 04120098 +C 04130098 + IF (ICZERO) 39210, 9210, 39210 04140098 + 9210 CONTINUE 04150098 + RVON01 = -6.3E2 04160098 + RVON02 = -21.0 04170098 + IVCOMP = MAX1 (-463.3,RVON01,RVON02) 04180098 + GO TO 49210 04190098 +39210 IVDELE = IVDELE + 1 04200098 + WRITE (I02,80003) IVTNUM 04210098 + IF (ICZERO) 49210, 9221, 49210 04220098 +49210 IF (IVCOMP + 21) 29210,19210,29210 04230098 +19210 IVPASS = IVPASS + 1 04240098 + WRITE (I02,80001) IVTNUM 04250098 + GO TO 9221 04260098 +29210 IVFAIL = IVFAIL + 1 04270098 + IVCORR = -21 04280098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04290098 +C 04300098 +C TEST 922 AND 923 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04310098 +C SMALLEST VALUE WHERE ARGUMENTS AND FUNCTION ARE INTEGER 04320098 +C 04330098 + 9221 CONTINUE 04340098 + IVTNUM = 922 04350098 +C 04360098 +C **** TEST 922 **** 04370098 +C 04380098 + IF (ICZERO) 39220, 9220, 39220 04390098 + 9220 CONTINUE 04400098 + IVON01 = -75 04410098 + IVON02 = -243 04420098 + IVCOMP = MIN0 (IVON01,IVON02) 04430098 + GO TO 49220 04440098 +39220 IVDELE = IVDELE + 1 04450098 + WRITE (I02,80003) IVTNUM 04460098 + IF (ICZERO) 49220, 9231, 49220 04470098 +49220 IF (IVCOMP + 243) 29220,19220,29220 04480098 +19220 IVPASS = IVPASS + 1 04490098 + WRITE (I02,80001) IVTNUM 04500098 + GO TO 9231 04510098 +29220 IVFAIL = IVFAIL + 1 04520098 + IVCORR = -243 04530098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04540098 + 9231 CONTINUE 04550098 + IVTNUM = 923 04560098 +C 04570098 +C **** TEST 923 **** 04580098 +C 04590098 + IF (ICZERO) 39230, 9230, 39230 04600098 + 9230 CONTINUE 04610098 + IVON01 = -11 04620098 + IVON02 = 11 04630098 + IVCOMP = MIN0 (0,IVON01,IVON02) 04640098 + GO TO 49230 04650098 +39230 IVDELE = IVDELE + 1 04660098 + WRITE (I02,80003) IVTNUM 04670098 + IF (ICZERO) 49230, 9241, 49230 04680098 +49230 IF (IVCOMP + 11) 29230,19230,29230 04690098 +19230 IVPASS = IVPASS + 1 04700098 + WRITE (I02,80001) IVTNUM 04710098 + GO TO 9241 04720098 +29230 IVFAIL = IVFAIL + 1 04730098 + IVCORR = -11 04740098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 04750098 +C 04760098 +C TEST 924 AND 925 CONTAIN INTRINSIC FUNCTION TESTS FOR CHOOSING 04770098 +C SMALLEST VALUE WHERE ARGUMENTS ARE REAL AND FUNCTION IS INTEGER 04780098 +C 04790098 + 9241 CONTINUE 04800098 + IVTNUM = 924 04810098 +C 04820098 +C **** TEST 924 **** 04830098 +C 04840098 + IF (ICZERO) 39240, 9240, 39240 04850098 + 9240 CONTINUE 04860098 + RVON01 = 1.1111 04870098 + RVON02 = 22.222 04880098 + RVON03 = 333.33 04890098 + IVCOMP = MIN1 (RVON01,RVON02,RVON03) 04900098 + GO TO 49240 04910098 +39240 IVDELE = IVDELE + 1 04920098 + WRITE (I02,80003) IVTNUM 04930098 + IF (ICZERO) 49240, 9251, 49240 04940098 +49240 IF (IVCOMP - 1) 29240,19240,29240 04950098 +19240 IVPASS = IVPASS + 1 04960098 + WRITE (I02,80001) IVTNUM 04970098 + GO TO 9251 04980098 +29240 IVFAIL = IVFAIL + 1 04990098 + IVCORR = 1 05000098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05010098 + 9251 CONTINUE 05020098 + IVTNUM = 925 05030098 +C 05040098 +C **** TEST 925 **** 05050098 +C 05060098 + IF (ICZERO) 39250, 9250, 39250 05070098 + 9250 CONTINUE 05080098 + RVON01 = 28.8 05090098 + RVON02 = 2.88E1 05100098 + RVON03 = 288E-1 05110098 + RVON04 = 35.0 05120098 + IVCOMP = MIN1 (RVON01,RVON02,RVON03,RVON04) 05130098 + GO TO 49250 05140098 +39250 IVDELE = IVDELE + 1 05150098 + WRITE (I02,80003) IVTNUM 05160098 + IF (ICZERO) 49250, 9261, 49250 05170098 +49250 IF (IVCOMP - 28) 29250,19250,29250 05180098 +19250 IVPASS = IVPASS + 1 05190098 + WRITE (I02,80001) IVTNUM 05200098 + GO TO 9261 05210098 +29250 IVFAIL = IVFAIL + 1 05220098 + IVCORR = 28 05230098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05240098 +C 05250098 +C TEST 926 THROUGH TEST 929 CONTAIN THE INTRINSIC FUNCTION FIX 05260098 +C WHICH CONVERTS REAL ARGUMENTS TO INTEGER FUNCTION RESULTS 05270098 +C 05280098 + 9261 CONTINUE 05290098 + IVTNUM = 926 05300098 +C 05310098 +C **** TEST 926 **** 05320098 +C 05330098 + IF (ICZERO) 39260, 9260, 39260 05340098 + 9260 CONTINUE 05350098 + IVCOMP = IFIX (-6.06) 05360098 + GO TO 49260 05370098 +39260 IVDELE = IVDELE + 1 05380098 + WRITE (I02,80003) IVTNUM 05390098 + IF (ICZERO) 49260, 9271, 49260 05400098 +49260 IF (IVCOMP + 6) 29260,19260,29260 05410098 +19260 IVPASS = IVPASS + 1 05420098 + WRITE (I02,80001) IVTNUM 05430098 + GO TO 9271 05440098 +29260 IVFAIL = IVFAIL + 1 05450098 + IVCORR = -6 05460098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05470098 + 9271 CONTINUE 05480098 + IVTNUM = 927 05490098 +C 05500098 +C **** TEST 927 **** 05510098 +C 05520098 + IF (ICZERO) 39270, 9270, 39270 05530098 + 9270 CONTINUE 05540098 + RVON01 = 71.01 05550098 + IVCOMP = IFIX (RVON01) 05560098 + GO TO 49270 05570098 +39270 IVDELE = IVDELE + 1 05580098 + WRITE (I02,80003) IVTNUM 05590098 + IF (ICZERO) 49270, 9281, 49270 05600098 +49270 IF (IVCOMP - 71) 29270,19270,29270 05610098 +19270 IVPASS = IVPASS + 1 05620098 + WRITE (I02,80001) IVTNUM 05630098 + GO TO 9281 05640098 +29270 IVFAIL = IVFAIL + 1 05650098 + IVCORR = 71 05660098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05670098 + 9281 CONTINUE 05680098 + IVTNUM = 928 05690098 +C 05700098 +C **** TEST 928 **** 05710098 +C 05720098 + IF (ICZERO) 39280, 9280, 39280 05730098 + 9280 CONTINUE 05740098 + RVON01 = 3.211E2 05750098 + IVCOMP = IFIX (RVON01) 05760098 + GO TO 49280 05770098 +39280 IVDELE = IVDELE + 1 05780098 + WRITE (I02,80003) IVTNUM 05790098 + IF (ICZERO) 49280, 9291, 49280 05800098 +49280 IF (IVCOMP - 321) 29280,19280,29280 05810098 +19280 IVPASS = IVPASS + 1 05820098 + WRITE (I02,80001) IVTNUM 05830098 + GO TO 9291 05840098 +29280 IVFAIL = IVFAIL + 1 05850098 + IVCORR = 321 05860098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 05870098 + 9291 CONTINUE 05880098 + IVTNUM = 929 05890098 +C 05900098 +C **** TEST 929 **** 05910098 +C 05920098 + IF (ICZERO) 39290, 9290, 39290 05930098 + 9290 CONTINUE 05940098 + RVON01 = 777E-1 05950098 + IVCOMP = IFIX (RVON01) 05960098 + GO TO 49290 05970098 +39290 IVDELE = IVDELE + 1 05980098 + WRITE (I02,80003) IVTNUM 05990098 + IF (ICZERO) 49290, 9301, 49290 06000098 +49290 IF (IVCOMP - 77) 29290,19290,29290 06010098 +19290 IVPASS = IVPASS + 1 06020098 + WRITE (I02,80001) IVTNUM 06030098 + GO TO 9301 06040098 +29290 IVFAIL = IVFAIL + 1 06050098 + IVCORR = 77 06060098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06070098 +C 06080098 +C TEST 930 THROUGH TEST 932 CONTAIN INTRINSIC FUNCTION TESTS FOR 06090098 +C TRANSFER OF SIGN WHERE ARGUMENTS AND FUNCTION ARE INTEGER 06100098 +C 06110098 + 9301 CONTINUE 06120098 + IVTNUM = 930 06130098 +C 06140098 +C **** TEST 930 **** 06150098 +C 06160098 + IF (ICZERO) 39300, 9300, 39300 06170098 + 9300 CONTINUE 06180098 + IVON01 = 643 06190098 + IVCOMP = ISIGN (IVON01,-1) 06200098 + GO TO 49300 06210098 +39300 IVDELE = IVDELE + 1 06220098 + WRITE (I02,80003) IVTNUM 06230098 + IF (ICZERO) 49300, 9311, 49300 06240098 +49300 IF (IVCOMP + 643) 29300,19300,29300 06250098 +19300 IVPASS = IVPASS + 1 06260098 + WRITE (I02,80001) IVTNUM 06270098 + GO TO 9311 06280098 +29300 IVFAIL = IVFAIL + 1 06290098 + IVCORR = -643 06300098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06310098 + 9311 CONTINUE 06320098 + IVTNUM = 931 06330098 +C 06340098 +C **** TEST 931 **** 06350098 +C 06360098 + IF (ICZERO) 39310, 9310, 39310 06370098 + 9310 CONTINUE 06380098 + IVON01 = -22 06390098 + IVON02 = 723 06400098 + IVCOMP = ISIGN (IVON01,IVON02) 06410098 + GO TO 49310 06420098 +39310 IVDELE = IVDELE + 1 06430098 + WRITE (I02,80003) IVTNUM 06440098 + IF (ICZERO) 49310, 9321, 49310 06450098 +49310 IF (IVCOMP - 22) 29310,19310,29310 06460098 +19310 IVPASS = IVPASS + 1 06470098 + WRITE (I02,80001) IVTNUM 06480098 + GO TO 9321 06490098 +29310 IVFAIL = IVFAIL + 1 06500098 + IVCORR = 22 06510098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06520098 + 9321 CONTINUE 06530098 + IVTNUM = 932 06540098 +C 06550098 +C **** TEST 932 **** 06560098 +C 06570098 + IF (ICZERO) 39320, 9320, 39320 06580098 + 9320 CONTINUE 06590098 + IVON01 = 3532 06600098 + IVON02 = 1 06610098 + IVCOMP = ISIGN (IVON01,IVON02) 06620098 + GO TO 49320 06630098 +39320 IVDELE = IVDELE + 1 06640098 + WRITE (I02,80003) IVTNUM 06650098 + IF (ICZERO) 49320, 9331, 49320 06660098 +49320 IF (IVCOMP - 3532) 29320,19320,29320 06670098 +19320 IVPASS = IVPASS + 1 06680098 + WRITE (I02,80001) IVTNUM 06690098 + GO TO 9331 06700098 +29320 IVFAIL = IVFAIL + 1 06710098 + IVCORR = 3532 06720098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06730098 +C 06740098 +C TEST 933 THROUGH TEST 936 CONTAIN INTRINSIC FUNCTION TESTS FOR 06750098 +C POSITIVE DIFFERENCE WHERE ARGUMENTS AND FUNCTION ARE INTEGERS 06760098 +C 06770098 + 9331 CONTINUE 06780098 + IVTNUM = 933 06790098 +C 06800098 +C **** TEST 933 **** 06810098 +C 06820098 + IF (ICZERO) 39330, 9330, 39330 06830098 + 9330 CONTINUE 06840098 + IVON01 = 222 06850098 + IVCOMP = IDIM (IVON01,1) 06860098 + GO TO 49330 06870098 +39330 IVDELE = IVDELE + 1 06880098 + WRITE (I02,80003) IVTNUM 06890098 + IF (ICZERO) 49330, 9341, 49330 06900098 +49330 IF (IVCOMP - 221) 29330,19330,29330 06910098 +19330 IVPASS = IVPASS + 1 06920098 + WRITE (I02,80001) IVTNUM 06930098 + GO TO 9341 06940098 +29330 IVFAIL = IVFAIL + 1 06950098 + IVCORR = 221 06960098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 06970098 + 9341 CONTINUE 06980098 + IVTNUM = 934 06990098 +C 07000098 +C **** TEST 934 **** 07010098 +C 07020098 + IF (ICZERO) 39340, 9340, 39340 07030098 + 9340 CONTINUE 07040098 + IVON01 = 45 07050098 + IVON02 = 41 07060098 + IVCOMP = IDIM (IVON01,IVON02) 07070098 + GO TO 49340 07080098 +39340 IVDELE = IVDELE + 1 07090098 + WRITE (I02,80003) IVTNUM 07100098 + IF (ICZERO) 49340, 9351, 49340 07110098 +49340 IF (IVCOMP - 4) 29340,19340,29340 07120098 +19340 IVPASS = IVPASS + 1 07130098 + WRITE (I02,80001) IVTNUM 07140098 + GO TO 9351 07150098 +29340 IVFAIL = IVFAIL + 1 07160098 + IVCORR = 4 07170098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07180098 + 9351 CONTINUE 07190098 + IVTNUM = 935 07200098 +C 07210098 +C **** TEST 935 **** 07220098 +C 07230098 + IF (ICZERO) 39350, 9350, 39350 07240098 + 9350 CONTINUE 07250098 + IVON01 = 2 07260098 + IVON02 = 10 07270098 + IVCOMP = IDIM (IVON01,IVON02) 07280098 + GO TO 49350 07290098 +39350 IVDELE = IVDELE + 1 07300098 + WRITE (I02,80003) IVTNUM 07310098 + IF (ICZERO) 49350, 9361, 49350 07320098 +49350 IF (IVCOMP) 29350,19350,29350 07330098 +19350 IVPASS = IVPASS + 1 07340098 + WRITE (I02,80001) IVTNUM 07350098 + GO TO 9361 07360098 +29350 IVFAIL = IVFAIL + 1 07370098 + IVCORR = 0 07380098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07390098 + 9361 CONTINUE 07400098 + IVTNUM = 936 07410098 +C 07420098 +C **** TEST 936 **** 07430098 +C 07440098 + IF (ICZERO) 39360, 9360, 39360 07450098 + 9360 CONTINUE 07460098 + IVON01 = 165 07470098 + IVON02 = -2 07480098 + IVCOMP = IDIM (IVON01,IVON02) 07490098 + GO TO 49360 07500098 +39360 IVDELE = IVDELE + 1 07510098 + WRITE (I02,80003) IVTNUM 07520098 + IF (ICZERO) 49360, 9371, 49360 07530098 +49360 IF (IVCOMP - 167) 29360,19360,29360 07540098 +19360 IVPASS = IVPASS + 1 07550098 + WRITE (I02,80001) IVTNUM 07560098 + GO TO 9371 07570098 +29360 IVFAIL = IVFAIL + 1 07580098 + IVCORR = 167 07590098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07600098 +C 07610098 +C TESTS 937 AND 938 CONTAIN EXPRESSIONS CONTAINING MORE THAN ONE 07620098 +C INTRINSIC FUNCTION - THE FUNCTIONS ARE INTEGER AND THE ARGUMENTS 07630098 +C ARE REAL AND INTEGER 07640098 +C 07650098 + 9371 CONTINUE 07660098 + IVTNUM = 937 07670098 +C 07680098 +C **** TEST 937 **** 07690098 +C 07700098 + IF (ICZERO) 39370, 9370, 39370 07710098 + 9370 CONTINUE 07720098 + RVON01 = 33.3 07730098 + IVON01 = -12 07740098 + IVCOMP = INT (RVON01) + IABS (IVON01) 07750098 + GO TO 49370 07760098 +39370 IVDELE = IVDELE + 1 07770098 + WRITE (I02,80003) IVTNUM 07780098 + IF (ICZERO) 49370, 9381, 49370 07790098 +49370 IF (IVCOMP - 45) 29370,19370,29370 07800098 +19370 IVPASS = IVPASS + 1 07810098 + WRITE (I02,80001) IVTNUM 07820098 + GO TO 9381 07830098 +29370 IVFAIL = IVFAIL + 1 07840098 + IVCORR = 45 07850098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 07860098 + 9381 CONTINUE 07870098 + IVTNUM = 938 07880098 +C 07890098 +C **** TEST 938 **** 07900098 +C 07910098 + IF (ICZERO) 39380, 9380, 39380 07920098 + 9380 CONTINUE 07930098 + IVON01 = 76 07940098 + IVON02 = 21 07950098 + IVON03 = 30 07960098 + IVCOMP = MAX0 (IVON01,IVON02,IVON03) - MIN0 (IVON01,IVON02,IVON03)07970098 + GO TO 49380 07980098 +39380 IVDELE = IVDELE + 1 07990098 + WRITE (I02,80003) IVTNUM 08000098 + IF (ICZERO) 49380, 9391, 49380 08010098 +49380 IF (IVCOMP - 55) 29380,19380,29380 08020098 +19380 IVPASS = IVPASS + 1 08030098 + WRITE (I02,80001) IVTNUM 08040098 + GO TO 9391 08050098 +29380 IVFAIL = IVFAIL + 1 08060098 + IVCORR = 55 08070098 + WRITE (I02,80004) IVTNUM, IVCOMP, IVCORR 08080098 + 9391 CONTINUE 08090098 +C 08100098 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 08110098 +99999 CONTINUE 08120098 + WRITE (I02,90002) 08130098 + WRITE (I02,90006) 08140098 + WRITE (I02,90002) 08150098 + WRITE (I02,90002) 08160098 + WRITE (I02,90007) 08170098 + WRITE (I02,90002) 08180098 + WRITE (I02,90008) IVFAIL 08190098 + WRITE (I02,90009) IVPASS 08200098 + WRITE (I02,90010) IVDELE 08210098 +C 08220098 +C 08230098 +C TERMINATE ROUTINE EXECUTION 08240098 + STOP 08250098 +C 08260098 +C FORMAT STATEMENTS FOR PAGE HEADERS 08270098 +90000 FORMAT ("1") 08280098 +90002 FORMAT (" ") 08290098 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08300098 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 08310098 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08320098 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 08330098 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 08340098 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08350098 +C 08360098 +C FORMAT STATEMENTS FOR RUN SUMMARIES 08370098 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 08380098 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 08390098 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 08400098 +C 08410098 +C FORMAT STATEMENTS FOR TEST RESULTS 08420098 +80001 FORMAT (" ",4X,I5,7X,"PASS") 08430098 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 08440098 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 08450098 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08460098 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08470098 +C 08480098 +90007 FORMAT (" ",20X,"END OF PROGRAM FM098" ) 08490098 + END 08500098 diff --git a/Fortran/UnitTests/fcvs21_f95/FM098.reference_output b/Fortran/UnitTests/fcvs21_f95/FM098.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM098.reference_output @@ -0,0 +1,56 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 907 PASS + 908 PASS + 909 PASS + 910 PASS + 911 PASS + 912 PASS + 913 PASS + 914 PASS + 915 PASS + 916 PASS + 917 PASS + 918 PASS + 919 PASS + 920 PASS + 921 PASS + 922 PASS + 923 PASS + 924 PASS + 925 PASS + 926 PASS + 927 PASS + 928 PASS + 929 PASS + 930 PASS + 931 PASS + 932 PASS + 933 PASS + 934 PASS + 935 PASS + 936 PASS + 937 PASS + 938 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM098 + + 0 ERRORS ENCOUNTERED + 32 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM099.f b/Fortran/UnitTests/fcvs21_f95/FM099.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM099.f @@ -0,0 +1,721 @@ + PROGRAM FM099 + +C COMMENT SECTION 00010099 +C 00020099 +C FM099 00030099 +C 00040099 +C THIS ROUTINE TESTS VARIOUS MATHEMATICAL FUNCTIONS WHERE BOTH THE 00050099 +C FUNCTION TYPE AND ARGUMENTS ARE REAL. THE REAL VARIABLES AND 00060099 +C CONSTANTS CONTAIN BOTH POSITIVE AND NEGATIVE VALUES. THE 00070099 +C FUNCTIONS TESTED IN FM099 INCLUDE 00080099 +C 00090099 +C TYPE OF 00100099 +C FUNCTION NAME ARGUMENT FUNCTION 00110099 +C ---------------- ---- -------- -------- 00120099 +C EXPONENTIAL EXP REAL REAL 00130099 +C NATURAL LOGARITHM ALOG REAL REAL 00140099 +C COMMON LOGARITHM ALOG10 REAL REAL 00150099 +C SQUARE ROOT SQRT REAL REAL 00160099 +C TRIGONOMETRIC SINE SIN REAL REAL 00170099 +C TRIGONOMETRIC COSINE COS REAL REAL 00180099 +C HYPERBOLIC TANGENT TANH REAL REAL 00190099 +C ARCTANGENT ATAN REAL REAL 00200099 +C ATAN2 REAL REAL 00210099 +C 00220099 +C REFERENCES 00230099 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00240099 +C X3.9-1978 00250099 +C 00260099 +C SECTION 8.7, EXTERNAL STATEMENT 00270099 +C SECTION 15.5.2, FUNCTION REFERENCE 00280099 +C 00290099 +C 00300099 +C ********************************************************** 00310099 +C 00320099 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00330099 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00340099 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00350099 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00360099 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00370099 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00380099 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00390099 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00400099 +C OF EXECUTING THESE TESTS. 00410099 +C 00420099 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00430099 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00440099 +C 00450099 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00460099 +C 00470099 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00480099 +C SOFTWARE STANDARDS VALIDATION GROUP 00490099 +C BUILDING 225 RM A266 00500099 +C GAITHERSBURG, MD 20899 00510099 +C ********************************************************** 00520099 +C 00530099 +C 00540099 +C 00550099 +C INITIALIZATION SECTION 00560099 +C 00570099 +C INITIALIZE CONSTANTS 00580099 +C ************** 00590099 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00600099 + I01 = 5 00610099 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00620099 + I02 = 6 00630099 +C SYSTEM ENVIRONMENT SECTION 00640099 +C 00650099 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00660099 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670099 +C (UNIT NUMBER FOR CARD READER). 00680099 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00690099 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00700099 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00710099 +C 00720099 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00730099 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00740099 +C (UNIT NUMBER FOR PRINTER). 00750099 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00760099 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00770099 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00780099 +C 00790099 + IVPASS=0 00800099 + IVFAIL=0 00810099 + IVDELE=0 00820099 + ICZERO=0 00830099 +C 00840099 +C WRITE PAGE HEADERS 00850099 + WRITE (I02,90000) 00860099 + WRITE (I02,90001) 00870099 + WRITE (I02,90002) 00880099 + WRITE (I02, 90002) 00890099 + WRITE (I02,90003) 00900099 + WRITE (I02,90002) 00910099 + WRITE (I02,90004) 00920099 + WRITE (I02,90002) 00930099 + WRITE (I02,90011) 00940099 + WRITE (I02,90002) 00950099 + WRITE (I02,90002) 00960099 + WRITE (I02,90005) 00970099 + WRITE (I02,90006) 00980099 + WRITE (I02,90002) 00990099 +C 01000099 +C TEST SECTION 01010099 +C 01020099 +C TEST 939 THROUGH TEST 942 CONTAIN FUNCTION TESTS FOR EXPONENTIAL 01030099 +C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 01040099 +C 01050099 + IVTNUM = 939 01060099 +C 01070099 +C **** TEST 939 **** 01080099 +C 01090099 + IF (ICZERO) 39390, 9390, 39390 01100099 + 9390 CONTINUE 01110099 + RVON01 = 0.0 01120099 + RVCOMP = EXP (RVON01) 01130099 + GO TO 49390 01140099 +39390 IVDELE = IVDELE + 1 01150099 + WRITE (I02,80003) IVTNUM 01160099 + IF (ICZERO) 49390, 9401, 49390 01170099 +49390 IF (RVCOMP - 0.95) 29390,19390,49391 01180099 +49391 IF (RVCOMP - 1.05) 19390,19390,29390 01190099 +19390 IVPASS = IVPASS + 1 01200099 + WRITE (I02,80001) IVTNUM 01210099 + GO TO 9401 01220099 +29390 IVFAIL = IVFAIL + 1 01230099 + RVCORR = 1.00 01240099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01250099 + 9401 CONTINUE 01260099 + IVTNUM = 940 01270099 +C 01280099 +C **** TEST 940 **** 01290099 +C 01300099 + IF (ICZERO) 39400, 9400, 39400 01310099 + 9400 CONTINUE 01320099 + RVCOMP = EXP (0.5) 01330099 + GO TO 49400 01340099 +39400 IVDELE = IVDELE + 1 01350099 + WRITE (I02,80003) IVTNUM 01360099 + IF (ICZERO) 49400, 9411, 49400 01370099 +49400 IF (RVCOMP - 1.60) 29400,19400,49401 01380099 +49401 IF (RVCOMP - 1.70) 19400,19400,29400 01390099 +19400 IVPASS = IVPASS + 1 01400099 + WRITE (I02,80001) IVTNUM 01410099 + GO TO 9411 01420099 +29400 IVFAIL = IVFAIL + 1 01430099 + RVCORR = 1.65 01440099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01450099 + 9411 CONTINUE 01460099 + IVTNUM = 941 01470099 +C 01480099 +C **** TEST 941 **** 01490099 +C 01500099 + IF (ICZERO) 39410, 9410, 39410 01510099 + 9410 CONTINUE 01520099 + RVON01 = .1E1 01530099 + RVCOMP = EXP (RVON01) 01540099 + GO TO 49410 01550099 +39410 IVDELE = IVDELE + 1 01560099 + WRITE (I02,80003) IVTNUM 01570099 + IF (ICZERO) 49410, 9421, 49410 01580099 +49410 IF (RVCOMP - 2.67) 29410,19410,49411 01590099 +49411 IF (RVCOMP - 2.77) 19410,19410,29410 01600099 +19410 IVPASS = IVPASS + 1 01610099 + WRITE (I02,80001) IVTNUM 01620099 + GO TO 9421 01630099 +29410 IVFAIL = IVFAIL + 1 01640099 + RVCORR = 2.72 01650099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01660099 + 9421 CONTINUE 01670099 + IVTNUM = 942 01680099 +C 01690099 +C **** TEST 942 **** 01700099 +C 01710099 + IF (ICZERO) 39420, 9420, 39420 01720099 + 9420 CONTINUE 01730099 + RVON01 = -1.0 01740099 + RVCOMP = EXP (RVON01) 01750099 + GO TO 49420 01760099 +39420 IVDELE = IVDELE + 1 01770099 + WRITE (I02,80003) IVTNUM 01780099 + IF (ICZERO) 49420, 9431, 49420 01790099 +49420 IF (RVCOMP - 0.363) 29420,19420,49421 01800099 +49421 IF (RVCOMP - 0.373) 19420,19420,29420 01810099 +19420 IVPASS = IVPASS + 1 01820099 + WRITE (I02,80001) IVTNUM 01830099 + GO TO 9431 01840099 +29420 IVFAIL = IVFAIL + 1 01850099 + RVCORR = 0.368 01860099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 01870099 + 9431 CONTINUE 01880099 +C 01890099 +C TEST 943 THROUGH TEST 945 CONTAIN FUNCTION TESTS FOR NATURAL 01900099 +C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 01910099 +C 01920099 + IVTNUM = 943 01930099 +C 01940099 +C **** TEST 943 **** 01950099 +C 01960099 + IF (ICZERO) 39430, 9430, 39430 01970099 + 9430 CONTINUE 01980099 + RVON01 = 5E1 01990099 + RVCOMP = ALOG (RVON01) 02000099 + GO TO 49430 02010099 +39430 IVDELE = IVDELE + 1 02020099 + WRITE (I02,80003) IVTNUM 02030099 + IF (ICZERO) 49430, 9441, 49430 02040099 +49430 IF (RVCOMP - 3.9115) 29430,19430,49431 02050099 +49431 IF (RVCOMP - 3.9125) 19430,19430,29430 02060099 +19430 IVPASS = IVPASS + 1 02070099 + WRITE (I02,80001) IVTNUM 02080099 + GO TO 9441 02090099 +29430 IVFAIL = IVFAIL + 1 02100099 + RVCORR = 3.9120 02110099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02120099 + 9441 CONTINUE 02130099 + IVTNUM = 944 02140099 +C 02150099 +C **** TEST 944 **** 02160099 +C 02170099 + IF (ICZERO) 39440, 9440, 39440 02180099 + 9440 CONTINUE 02190099 + RVON01 = 1.0 02200099 + RVCOMP = ALOG (RVON01) 02210099 + GO TO 49440 02220099 +39440 IVDELE = IVDELE + 1 02230099 + WRITE (I02,80003) IVTNUM 02240099 + IF (ICZERO) 49440, 9451, 49440 02250099 +49440 IF (RVCOMP + .00005) 29440,19440,49441 02260099 +49441 IF (RVCOMP - .00005) 19440,19440,29440 02270099 +19440 IVPASS = IVPASS + 1 02280099 + WRITE (I02,80001) IVTNUM 02290099 + GO TO 9451 02300099 +29440 IVFAIL = IVFAIL + 1 02310099 + RVCORR = 0.00000 02320099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02330099 + 9451 CONTINUE 02340099 + IVTNUM = 945 02350099 +C 02360099 +C **** TEST 945 **** 02370099 +C 02380099 + IF (ICZERO) 39450, 9450, 39450 02390099 + 9450 CONTINUE 02400099 + RVCOMP = ALOG (2.0) 02410099 + GO TO 49450 02420099 +39450 IVDELE = IVDELE + 1 02430099 + WRITE (I02,80003) IVTNUM 02440099 + IF (ICZERO) 49450, 9461, 49450 02450099 +49450 IF (RVCOMP - 0.688) 29450,19450,49451 02460099 +49451 IF (RVCOMP - 0.698) 19450,19450,29450 02470099 +19450 IVPASS = IVPASS + 1 02480099 + WRITE (I02,80001) IVTNUM 02490099 + GO TO 9461 02500099 +29450 IVFAIL = IVFAIL + 1 02510099 + RVCORR = 0.693 02520099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02530099 + 9461 CONTINUE 02540099 +C 02550099 +C TEST 946 THROUGH TEST 948 CONTAIN FUNCTION TESTS FOR COMMON 02560099 +C LOGARITHM FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 02570099 +C 02580099 + IVTNUM = 946 02590099 +C 02600099 +C **** TEST 946 **** 02610099 +C 02620099 + IF (ICZERO) 39460, 9460, 39460 02630099 + 9460 CONTINUE 02640099 + RVON01 = 2E2 02650099 + RVCOMP = ALOG10 (RVON01) 02660099 + GO TO 49460 02670099 +39460 IVDELE = IVDELE + 1 02680099 + WRITE (I02,80003) IVTNUM 02690099 + IF (ICZERO) 49460, 9471, 49460 02700099 +49460 IF (RVCOMP - 2.296) 29460,19460,49461 02710099 +49461 IF (RVCOMP - 2.306) 19460,19460,29460 02720099 +19460 IVPASS = IVPASS + 1 02730099 + WRITE (I02,80001) IVTNUM 02740099 + GO TO 9471 02750099 +29460 IVFAIL = IVFAIL + 1 02760099 + RVCORR = 2.301 02770099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02780099 + 9471 CONTINUE 02790099 + IVTNUM = 947 02800099 +C 02810099 +C **** TEST 947 **** 02820099 +C 02830099 + IF (ICZERO) 39470, 9470, 39470 02840099 + 9470 CONTINUE 02850099 + RVON01 = .3E+3 02860099 + RVCOMP = ALOG10 (RVON01) 02870099 + GO TO 49470 02880099 +39470 IVDELE = IVDELE + 1 02890099 + WRITE (I02,80003) IVTNUM 02900099 + IF (ICZERO) 49470, 9481, 49470 02910099 +49470 IF (RVCOMP - 2.472) 29470,19470,49471 02920099 +49471 IF (RVCOMP - 2.482) 19470,19470,29470 02930099 +19470 IVPASS = IVPASS + 1 02940099 + WRITE (I02,80001) IVTNUM 02950099 + GO TO 9481 02960099 +29470 IVFAIL = IVFAIL + 1 02970099 + RVCORR = 2.477 02980099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 02990099 + 9481 CONTINUE 03000099 + IVTNUM = 948 03010099 +C 03020099 +C **** TEST 948 **** 03030099 +C 03040099 + IF (ICZERO) 39480, 9480, 39480 03050099 + 9480 CONTINUE 03060099 + RVON01 = 1350.0 03070099 + RVCOMP = ALOG10 (RVON01) 03080099 + GO TO 49480 03090099 +39480 IVDELE = IVDELE + 1 03100099 + WRITE (I02,80003) IVTNUM 03110099 + IF (ICZERO) 49480, 9491, 49480 03120099 +49480 IF (RVCOMP - 3.125) 29480,19480,49481 03130099 +49481 IF (RVCOMP - 3.135) 19480,19480,29480 03140099 +19480 IVPASS = IVPASS + 1 03150099 + WRITE (I02,80001) IVTNUM 03160099 + GO TO 9491 03170099 +29480 IVFAIL = IVFAIL + 1 03180099 + RVCORR = 3.130 03190099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03200099 + 9491 CONTINUE 03210099 +C 03220099 +C TEST 949 THROUGH TEST 951 CONTAIN FUNCTION TESTS FOR SQUARE ROOT 03230099 +C FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 03240099 +C 03250099 + IVTNUM = 949 03260099 +C 03270099 +C **** TEST 949 **** 03280099 +C 03290099 + IF (ICZERO) 39490, 9490, 39490 03300099 + 9490 CONTINUE 03310099 + RVON01 = 1.0 03320099 + RVCOMP = SQRT (RVON01) 03330099 + GO TO 49490 03340099 +39490 IVDELE = IVDELE + 1 03350099 + WRITE (I02,80003) IVTNUM 03360099 + IF (ICZERO) 49490, 9501, 49490 03370099 +49490 IF (RVCOMP - 0.95) 29490,19490,49491 03380099 +49491 IF (RVCOMP - 1.05) 19490,19490,29490 03390099 +19490 IVPASS = IVPASS + 1 03400099 + WRITE (I02,80001) IVTNUM 03410099 + GO TO 9501 03420099 +29490 IVFAIL = IVFAIL + 1 03430099 + RVCORR = 1.00 03440099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03450099 + 9501 CONTINUE 03460099 + IVTNUM = 950 03470099 +C 03480099 +C **** TEST 950 **** 03490099 +C 03500099 + IF (ICZERO) 39500, 9500, 39500 03510099 + 9500 CONTINUE 03520099 + RVCOMP = SQRT (2.0) 03530099 + GO TO 49500 03540099 +39500 IVDELE = IVDELE + 1 03550099 + WRITE (I02,80003) IVTNUM 03560099 + IF (ICZERO) 49500, 9511, 49500 03570099 +49500 IF (RVCOMP - 1.36) 29500,19500,49501 03580099 +49501 IF (RVCOMP - 1.46) 19500,19500,29500 03590099 +19500 IVPASS = IVPASS + 1 03600099 + WRITE (I02,80001) IVTNUM 03610099 + GO TO 9511 03620099 +29500 IVFAIL = IVFAIL + 1 03630099 + RVCORR = 1.41 03640099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03650099 + 9511 CONTINUE 03660099 + IVTNUM = 951 03670099 +C 03680099 +C **** TEST 951 **** 03690099 +C 03700099 + IF (ICZERO) 39510, 9510, 39510 03710099 + 9510 CONTINUE 03720099 + RVON01 = .229E1 03730099 + RVCOMP = SQRT (RVON01) 03740099 + GO TO 49510 03750099 +39510 IVDELE = IVDELE + 1 03760099 + WRITE (I02,80003) IVTNUM 03770099 + IF (ICZERO) 49510, 9521, 49510 03780099 +49510 IF (RVCOMP - 1.46) 29510,19510,49511 03790099 +49511 IF (RVCOMP - 1.56) 19510,19510,29510 03800099 +19510 IVPASS = IVPASS + 1 03810099 + WRITE (I02,80001) IVTNUM 03820099 + GO TO 9521 03830099 +29510 IVFAIL = IVFAIL + 1 03840099 + RVCORR = 1.51 03850099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 03860099 + 9521 CONTINUE 03870099 +C 03880099 +C TEST 952 THROUGH TEST 953 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC03890099 +C SINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 03900099 +C 03910099 + IVTNUM = 952 03920099 +C 03930099 +C **** TEST 952 **** 03940099 +C 03950099 + IF (ICZERO) 39520, 9520, 39520 03960099 + 9520 CONTINUE 03970099 + RVON01 = 0.00000 03980099 + RVCOMP = SIN (RVON01) 03990099 + GO TO 49520 04000099 +39520 IVDELE = IVDELE + 1 04010099 + WRITE (I02,80003) IVTNUM 04020099 + IF (ICZERO) 49520, 9531, 49520 04030099 +49520 IF (RVCOMP + .00005) 29520,19520,49521 04040099 +49521 IF (RVCOMP - .00005) 19520,19520,29520 04050099 +19520 IVPASS = IVPASS + 1 04060099 + WRITE (I02,80001) IVTNUM 04070099 + GO TO 9531 04080099 +29520 IVFAIL = IVFAIL + 1 04090099 + RVCORR = 0.00000 04100099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04110099 + 9531 CONTINUE 04120099 + IVTNUM = 953 04130099 +C 04140099 +C **** TEST 953 **** 04150099 +C 04160099 + IF (ICZERO) 39530, 9530, 39530 04170099 + 9530 CONTINUE 04180099 + RVON01 = 0.5 04190099 + RVCOMP = SIN (RVON01) 04200099 + GO TO 49530 04210099 +39530 IVDELE = IVDELE + 1 04220099 + WRITE (I02,80003) IVTNUM 04230099 + IF (ICZERO) 49530, 9541, 49530 04240099 +49530 IF (RVCOMP - .474) 29530,19530,49531 04250099 +49531 IF (RVCOMP - .484) 19530,19530,29530 04260099 +19530 IVPASS = IVPASS + 1 04270099 + WRITE (I02,80001) IVTNUM 04280099 + GO TO 9541 04290099 +29530 IVFAIL = IVFAIL + 1 04300099 + RVCORR = .479 04310099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04320099 + 9541 CONTINUE 04330099 + IVTNUM = 954 04340099 +C 04350099 +C **** TEST 954 **** 04360099 +C 04370099 + IF (ICZERO) 39540, 9540, 39540 04380099 + 9540 CONTINUE 04390099 + RVON01 = 4E0 04400099 + RVCOMP = SIN (RVON01) 04410099 + GO TO 49540 04420099 +39540 IVDELE = IVDELE + 1 04430099 + WRITE (I02,80003) IVTNUM 04440099 + IF (ICZERO) 49540, 9551, 49540 04450099 +49540 IF (RVCOMP + .762) 29540,19540,49541 04460099 +49541 IF (RVCOMP + .752) 19540,19540,29540 04470099 +19540 IVPASS = IVPASS + 1 04480099 + WRITE (I02,80001) IVTNUM 04490099 + GO TO 9551 04500099 +29540 IVFAIL = IVFAIL + 1 04510099 + RVCORR = -.757 04520099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04530099 + 9551 CONTINUE 04540099 +C 04550099 +C TEST 955 THROUGH TEST 957 CONTAIN FUNCTION TESTS FOR TRIGONOMETRIC04560099 +C COSINE FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 04570099 +C 04580099 + IVTNUM = 955 04590099 +C 04600099 +C **** TEST 955 **** 04610099 +C 04620099 + IF (ICZERO) 39550, 9550, 39550 04630099 + 9550 CONTINUE 04640099 + RVON01 = 0.00000 04650099 + RVCOMP = COS (RVON01) 04660099 + GO TO 49550 04670099 +39550 IVDELE = IVDELE + 1 04680099 + WRITE (I02,80003) IVTNUM 04690099 + IF (ICZERO) 49550, 9561, 49550 04700099 +49550 IF (RVCOMP - .995) 29550,19550,49551 04710099 +49551 IF (RVCOMP - 1.005) 19550,19550,29550 04720099 +19550 IVPASS = IVPASS + 1 04730099 + WRITE (I02,80001) IVTNUM 04740099 + GO TO 9561 04750099 +29550 IVFAIL = IVFAIL + 1 04760099 + RVCORR = 1.000 04770099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04780099 + 9561 CONTINUE 04790099 + IVTNUM = 956 04800099 +C 04810099 +C **** TEST 956 **** 04820099 +C 04830099 + IF (ICZERO) 39560, 9560, 39560 04840099 + 9560 CONTINUE 04850099 + RVON01 = 1.0E0 04860099 + RVCOMP = COS (RVON01) 04870099 + GO TO 49560 04880099 +39560 IVDELE = IVDELE + 1 04890099 + WRITE (I02,80003) IVTNUM 04900099 + IF (ICZERO) 49560, 9571, 49560 04910099 +49560 IF (RVCOMP - .535) 29560,19560,49561 04920099 +49561 IF (RVCOMP - .545) 19560,19560,29560 04930099 +19560 IVPASS = IVPASS + 1 04940099 + WRITE (I02,80001) IVTNUM 04950099 + GO TO 9571 04960099 +29560 IVFAIL = IVFAIL + 1 04970099 + RVCORR = 0.540 04980099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 04990099 + 9571 CONTINUE 05000099 + IVTNUM = 957 05010099 +C 05020099 +C **** TEST 957 **** 05030099 +C 05040099 + IF (ICZERO) 39570, 9570, 39570 05050099 + 9570 CONTINUE 05060099 + RVCOMP = COS (4.0) 05070099 + GO TO 49570 05080099 +39570 IVDELE = IVDELE + 1 05090099 + WRITE (I02,80003) IVTNUM 05100099 + IF (ICZERO) 49570, 9581, 49570 05110099 +49570 IF (RVCOMP + .659) 29570,19570,49571 05120099 +49571 IF (RVCOMP + .649) 19570,19570,29570 05130099 +19570 IVPASS = IVPASS + 1 05140099 + WRITE (I02,80001) IVTNUM 05150099 + GO TO 9581 05160099 +29570 IVFAIL = IVFAIL + 1 05170099 + RVCORR = -0.654 05180099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05190099 + 9581 CONTINUE 05200099 +C 05210099 +C TEST 958 THROUGH TEST 960 CONTAIN FUNCTION TESTS FOR HYPERBOLIC 05220099 +C TANGENT FUNCTIONS WHERE THE ARGUMENT AND FUNCTION ARE REAL 05230099 +C 05240099 + IVTNUM = 958 05250099 +C 05260099 +C **** TEST 958 **** 05270099 +C 05280099 + IF (ICZERO) 39580, 9580, 39580 05290099 + 9580 CONTINUE 05300099 + RVCOMP = TANH (0.0) 05310099 + GO TO 49580 05320099 +39580 IVDELE = IVDELE + 1 05330099 + WRITE (I02,80003) IVTNUM 05340099 + IF (ICZERO) 49580, 9591, 49580 05350099 +49580 IF (RVCOMP + .00005) 29580,19580,49581 05360099 +49581 IF (RVCOMP - .00005) 19580,19580,29580 05370099 +19580 IVPASS = IVPASS + 1 05380099 + WRITE (I02,80001) IVTNUM 05390099 + GO TO 9591 05400099 +29580 IVFAIL = IVFAIL + 1 05410099 + RVCORR = 0.00000 05420099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05430099 + 9591 CONTINUE 05440099 + IVTNUM = 959 05450099 +C 05460099 +C **** TEST 959 **** 05470099 +C 05480099 + IF (ICZERO) 39590, 9590, 39590 05490099 + 9590 CONTINUE 05500099 + RVON01 = .5E0 05510099 + RVCOMP = TANH (RVON01) 05520099 + GO TO 49590 05530099 +39590 IVDELE = IVDELE + 1 05540099 + WRITE (I02,80003) IVTNUM 05550099 + IF (ICZERO) 49590, 9601, 49590 05560099 +49590 IF (RVCOMP - .457) 29590,19590,49591 05570099 +49591 IF (RVCOMP - .467) 19590,19590,29590 05580099 +19590 IVPASS = IVPASS + 1 05590099 + WRITE (I02,80001) IVTNUM 05600099 + GO TO 9601 05610099 +29590 IVFAIL = IVFAIL + 1 05620099 + RVCORR = 0.462 05630099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05640099 + 9601 CONTINUE 05650099 + IVTNUM = 960 05660099 +C 05670099 +C **** TEST 960 **** 05680099 +C 05690099 + IF (ICZERO) 39600, 9600, 39600 05700099 + 9600 CONTINUE 05710099 + RVON01 = .25 05720099 + RVCOMP = TANH (RVON01) 05730099 + GO TO 49600 05740099 +39600 IVDELE = IVDELE + 1 05750099 + WRITE (I02,80003) IVTNUM 05760099 + IF (ICZERO) 49600, 9611, 49600 05770099 +49600 IF (RVCOMP - .240) 29600,19600,49601 05780099 +49601 IF (RVCOMP - .250) 19600,19600,29600 05790099 +19600 IVPASS = IVPASS + 1 05800099 + WRITE (I02,80001) IVTNUM 05810099 + GO TO 9611 05820099 +29600 IVFAIL = IVFAIL + 1 05830099 + RVCORR = 0.245 05840099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 05850099 + 9611 CONTINUE 05860099 +C 05870099 +C TESTS 961 AND 962 CONTAIN TESTS FOR ARCTANGENT OF THE FORM 05880099 +C ATAN (A) WHERE THE ARGUMENT AND FUNCTION ARE REAL 05890099 +C 05900099 + IVTNUM = 961 05910099 +C 05920099 +C **** TEST 961 **** 05930099 +C 05940099 + IF (ICZERO) 39610, 9610, 39610 05950099 + 9610 CONTINUE 05960099 + RVCOMP = ATAN (0.0) 05970099 + GO TO 49610 05980099 +39610 IVDELE = IVDELE + 1 05990099 + WRITE (I02,80003) IVTNUM 06000099 + IF (ICZERO) 49610, 9621, 49610 06010099 +49610 IF (RVCOMP + .00005) 29610,19610,49611 06020099 +49611 IF (RVCOMP - .00005) 19610,19610,29610 06030099 +19610 IVPASS = IVPASS + 1 06040099 + WRITE (I02,80001) IVTNUM 06050099 + GO TO 9621 06060099 +29610 IVFAIL = IVFAIL + 1 06070099 + RVCORR = 0.00000 06080099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06090099 + 9621 CONTINUE 06100099 + IVTNUM = 962 06110099 +C 06120099 +C **** TEST 962 **** 06130099 +C 06140099 + IF (ICZERO) 39620, 9620, 39620 06150099 + 9620 CONTINUE 06160099 + RVON01 = 5E-1 06170099 + RVCOMP = ATAN (RVON01) 06180099 + GO TO 49620 06190099 +39620 IVDELE = IVDELE + 1 06200099 + WRITE (I02,80003) IVTNUM 06210099 + IF (ICZERO) 49620, 9631, 49620 06220099 +49620 IF (RVCOMP - .459) 29620,19620,49621 06230099 +49621 IF (RVCOMP - .469) 19620,19620,29620 06240099 +19620 IVPASS = IVPASS + 1 06250099 + WRITE (I02,80001) IVTNUM 06260099 + GO TO 9631 06270099 +29620 IVFAIL = IVFAIL + 1 06280099 + RVCORR = 0.464 06290099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06300099 + 9631 CONTINUE 06310099 +C 06320099 +C TESTS 963 AND 964 CONTAIN TESTS FOR ARCTANGENT OF THE FORM 06330099 +C ATAN2 (A1,A2) WHERE THE ARGUMENTS AND FUNCTION ARE REAL 06340099 +C 06350099 + IVTNUM = 963 06360099 +C 06370099 +C **** TEST 963 **** 06380099 +C 06390099 + IF (ICZERO) 39630, 9630, 39630 06400099 + 9630 CONTINUE 06410099 + RVON01 = 0.0 06420099 + RVON02 = 1E0 06430099 + RVCOMP = ATAN2 (RVON01,RVON02) 06440099 + GO TO 49630 06450099 +39630 IVDELE = IVDELE + 1 06460099 + WRITE (I02,80003) IVTNUM 06470099 + IF (ICZERO) 49630, 9641, 49630 06480099 +49630 IF (RVCOMP + .00005) 29630,19630,49631 06490099 +49631 IF (RVCOMP - .00005) 19630,19630,29630 06500099 +19630 IVPASS = IVPASS + 1 06510099 + WRITE (I02,80001) IVTNUM 06520099 + GO TO 9641 06530099 +29630 IVFAIL = IVFAIL + 1 06540099 + RVCORR = 0.00000 06550099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06560099 + 9641 CONTINUE 06570099 + IVTNUM = 964 06580099 +C 06590099 +C **** TEST 964 **** 06600099 +C 06610099 + IF (ICZERO) 39640, 9640, 39640 06620099 + 9640 CONTINUE 06630099 + RVON01 = 2E1 06640099 + RVCOMP = ATAN2 (-1.0,RVON01) 06650099 + GO TO 49640 06660099 +39640 IVDELE = IVDELE + 1 06670099 + WRITE (I02,80003) IVTNUM 06680099 + IF (ICZERO) 49640, 9651, 49640 06690099 +49640 IF (RVCOMP + .05001) 29640,19640,49641 06700099 +49641 IF (RVCOMP + .04991) 19640,19640,29640 06710099 +19640 IVPASS = IVPASS + 1 06720099 + WRITE (I02,80001) IVTNUM 06730099 + GO TO 9651 06740099 +29640 IVFAIL = IVFAIL + 1 06750099 + RVCORR = -.04996 06760099 + WRITE (I02,80005) IVTNUM, RVCOMP, RVCORR 06770099 + 9651 CONTINUE 06780099 +C 06790099 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 06800099 +99999 CONTINUE 06810099 + WRITE (I02,90002) 06820099 + WRITE (I02,90006) 06830099 + WRITE (I02,90002) 06840099 + WRITE (I02,90002) 06850099 + WRITE (I02,90007) 06860099 + WRITE (I02,90002) 06870099 + WRITE (I02,90008) IVFAIL 06880099 + WRITE (I02,90009) IVPASS 06890099 + WRITE (I02,90010) IVDELE 06900099 +C 06910099 +C 06920099 +C TERMINATE ROUTINE EXECUTION 06930099 + STOP 06940099 +C 06950099 +C FORMAT STATEMENTS FOR PAGE HEADERS 06960099 +90000 FORMAT ("1") 06970099 +90002 FORMAT (" ") 06980099 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06990099 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 07000099 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07010099 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 07020099 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 07030099 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07040099 +C 07050099 +C FORMAT STATEMENTS FOR RUN SUMMARIES 07060099 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 07070099 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 07080099 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 07090099 +C 07100099 +C FORMAT STATEMENTS FOR TEST RESULTS 07110099 +80001 FORMAT (" ",4X,I5,7X,"PASS") 07120099 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 07130099 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 07140099 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07150099 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07160099 +C 07170099 +90007 FORMAT (" ",20X,"END OF PROGRAM FM099" ) 07180099 + END 07190099 diff --git a/Fortran/UnitTests/fcvs21_f95/FM099.reference_output b/Fortran/UnitTests/fcvs21_f95/FM099.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM099.reference_output @@ -0,0 +1,50 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 939 PASS + 940 PASS + 941 PASS + 942 PASS + 943 PASS + 944 PASS + 945 PASS + 946 PASS + 947 PASS + 948 PASS + 949 PASS + 950 PASS + 951 PASS + 952 PASS + 953 PASS + 954 PASS + 955 PASS + 956 PASS + 957 PASS + 958 PASS + 959 PASS + 960 PASS + 961 PASS + 962 PASS + 963 PASS + 964 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM099 + + 0 ERRORS ENCOUNTERED + 26 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM100.f b/Fortran/UnitTests/fcvs21_f95/FM100.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM100.f @@ -0,0 +1,370 @@ + PROGRAM FM100 + +C COMMENT SECTION. 00010100 +C 00020100 +C FM100 00030100 +C 00040100 +C THIS ROUTINE IS A TEST OF THE I FORMAT AND IS TAPE AND PRINTER00050100 +C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060100 +C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070100 +C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR 00080100 +C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090100 +C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100100 +C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110100 +C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120100 +C INTEGER ARRAY FOR THE DUMP SECTION. 00130100 +C 00140100 +C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150100 +C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS 00160100 +C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS 00170100 +C AND THE END OF FILE ON THE LAST RECORD. 00180100 +C 00190100 +C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00200100 +C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00210100 +C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00220100 +C OF THE CONTINUATION LINE. 00230100 +C 00240100 +C REFERENCES 00250100 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260100 +C X3.9-1978 00270100 +C 00280100 +C SECTION 8, SPECIFICATION STATEMENTS 00290100 +C SECTION 9, DATA STATEMENT 00300100 +C SECTION 11.10, DO STATEMENT 00310100 +C SECTION 12, INPUT/OUTPUT STATEMENTS 00320100 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00330100 +C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00340100 +C SECTION 13, FORMAT STATEMENT 00350100 +C SECTION 13.2.1, EDIT DESCRIPTORS 00360100 +C SECTION 13.5.9.1, INTEGER EDITING 00370100 +C 00380100 + DIMENSION ITEST(30) 00390100 + DIMENSION IDUMP(136) 00400100 + CHARACTER*1 NINE,IDUMP 00410100 + DATA NINE/'9'/ 00420100 +C 00430100 +77701 FORMAT ( 80A1 ) 00440100 +77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00450100 + 1F ",I3," RECORDS") 00460100 +77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00470100 +77704 FORMAT (10X,"FILE ON LUN " ,I2," TOO LONG MORE THAN " ,I3, " RECOR00480100 + 1DS") 00490100 +77705 FORMAT ( 1X,80A1) 00500100 +77706 FORMAT (10X,"FILE I06 CREATED WITH 31 SEQUENTIAL RECORDS" ) 00510100 +77751 FORMAT (I3,I2,I2,I3,I3,I3,I4,I1,I1,I1,I1,I1,I1,I1,I1,I1,I1,I2,I2,I00520100 + 13,I3,I4,I4,I4,I4,I4,I5,I5,I5,I5) 00530100 +C 00540100 +C 00550100 +C ********************************************************** 00560100 +C 00570100 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00580100 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00590100 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00600100 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00610100 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00620100 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00630100 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00640100 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00650100 +C OF EXECUTING THESE TESTS. 00660100 +C 00670100 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00680100 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00690100 +C 00700100 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00710100 +C 00720100 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00730100 +C SOFTWARE STANDARDS VALIDATION GROUP 00740100 +C BUILDING 225 RM A266 00750100 +C GAITHERSBURG, MD 20899 00760100 +C ********************************************************** 00770100 +C 00780100 +C 00790100 +C 00800100 +C INITIALIZATION SECTION 00810100 +C 00820100 +C INITIALIZE CONSTANTS 00830100 +C ************** 00840100 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00850100 + I01 = 5 00860100 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00870100 + I02 = 6 00880100 +C SYSTEM ENVIRONMENT SECTION 00890100 +C 00900100 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00910100 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00920100 +C (UNIT NUMBER FOR CARD READER). 00930100 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00940100 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00950100 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00960100 +C 00970100 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00980100 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00990100 +C (UNIT NUMBER FOR PRINTER). 01000100 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01010100 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01020100 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01030100 +C 01040100 + IVPASS=0 01050100 + IVFAIL=0 01060100 + IVDELE=0 01070100 + ICZERO=0 01080100 +C 01090100 +C WRITE PAGE HEADERS 01100100 + WRITE (I02,90000) 01110100 + WRITE (I02,90001) 01120100 + WRITE (I02,90002) 01130100 + WRITE (I02, 90002) 01140100 + WRITE (I02,90003) 01150100 + WRITE (I02,90002) 01160100 + WRITE (I02,90004) 01170100 + WRITE (I02,90002) 01180100 + WRITE (I02,90011) 01190100 + WRITE (I02,90002) 01200100 + WRITE (I02,90002) 01210100 + WRITE (I02,90005) 01220100 + WRITE (I02,90006) 01230100 + WRITE (I02,90002) 01240100 +C 01250100 +C DEFAULT ASSIGNMENT FOR FILE 01 IS I06 = 7 01260100 + I06 = 93 01270100 +CX060 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-060 01280100 +CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061 01290100 +C 01300100 +C WRITE SECTION.... 01310100 +C 01320100 +C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS 01330100 +C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF ONLY 01340100 +C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01350100 +C ROUTINE FM100 AND FOR PURPOSES OF IDENTIFICATION IS FILE 01. 01360100 +C ALL OF THE DATA WITH THE EXCEPTION OF THE RECORD NUMBER - IRNUM , 01370100 +C INTEGER VARIABLE ICON31 WHICH IS SET TO THE VALUE OF THE RECORD 01380100 +C NUMBER, AND THE END OF FILE CHECK - IEOF IS SET BY INTEGER 01390100 +C ASSIGNMENT STATEMENTS TO VARIOUS INTEGER CONSTANTS. 01400100 + IPROG = 100 01410100 + IFILE = 01 01420100 + ILUN = I06 01430100 + ITOTR = 31 01440100 + IRLGN = 80 01450100 + IEOF = 0000 01460100 + ICON11 = 1 01470100 + ICON12 = 2 01480100 + ICON13 = 3 01490100 + ICON14 = 4 01500100 + ICON15 = 5 01510100 + ICON16 = 6 01520100 + ICON17 = 7 01530100 + ICON18 = 8 01540100 + ICON19 = 9 01550100 + ICON10 = 0 01560100 + ICON21 = 21 01570100 + ICON22 = 22 01580100 + ICON32 = 512 01590100 + ICON41 = 9995 01600100 + ICON42 = 9996 01610100 + ICON43 = 9997 01620100 + ICON44 = 9998 01630100 + ICON45 = 9999 01640100 + ICON51 = 32764 01650100 + ICON52 = 32765 01660100 + ICON53 = 32766 01670100 + ICON54 = 32767 01680100 + DO 12 IRNUM = 1, 31 01690100 + ICON31 = IRNUM 01700100 + IF ( IRNUM .EQ. 31 ) IEOF = 9999 01710100 + WRITE(I06,77751)IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,ICON11,ICO01720100 + 1N12,ICON13,ICON14,ICON15,ICON16,ICON17,ICON18,ICON19,ICON10,ICON2101730100 + 2,ICON22,ICON31,ICON32,ICON41,ICON42,ICON43,ICON44,ICON45,ICON51,IC01740100 + 3ON52,ICON53,ICON54 01750100 + 12 CONTINUE 01760100 + WRITE (I02,77706) 01770100 +C 01780100 +C REWIND SECTION 01790100 +C 01800100 + REWIND I06 01810100 +C 01820100 +C READ SECTION.... 01830100 +C 01840100 + IVTNUM = 1 01850100 +C 01860100 +C **** TEST 1 THRU TEST 8 **** 01870100 +C TEST 1 THRU TEST 8 - THESE TESTS READ THE SEQUENTIAL FILE 01880100 +C PREVIOUSLY WRITTEN ON LUN I06 AND CHECK THE FIRST AND EVERY FOURTH01890100 +C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND 01900100 +C SEVERAL VALUES WHICH SHOULD REMAIN CONSTANT FOR ALL OF THE 31 01910100 +C RECORDS. 01920100 +C 01930100 + IRTST = 1 01940100 + READ(I06,77751) ITEST 01950100 +C READ THE FIRST RECORD.... 01960100 + DO 23 I = 1, 8 01970100 + IVON01 = 0 01980100 +C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 1 THRU 801990100 + IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1 02000100 +C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER.... 02010100 + IF ( ITEST(8) .EQ. ICON11 ) IVON01 = IVON01 + 1 02020100 +C THE ELEMENT (8) SHOULD EQUAL ICON11 = 1.... 02030100 + IF ( ITEST(18) .EQ. ICON21 ) IVON01 = IVON01 + 1 02040100 +C THE ELEMENT (18) SHOULD EQUAL ICON21 = 21.... 02050100 + IF ( ITEST(20) .EQ. IRTST ) IVON01 = IVON01 + 1 02060100 +C THE ELEMENT (20) SHOULD ALSO EQUAL THE RECORD NUMBER.... 02070100 + IF ( ITEST(26) .EQ. ICON45 ) IVON01 = IVON01 + 1 02080100 +C THE ELEMENT (26. SHOULD EQUAL ICON45 = 9999.... 02090100 + IF ( ITEST(30) .EQ. ICON54 ) IVON01 = IVON01 + 1 02100100 +C THE ELEMENT (30) SHOULD EQUAL ICON54 = 32767.... 02110100 + IF ( IVON01 - 6 ) 20010, 10010, 20010 02120100 +C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE 02130100 +C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 02140100 +C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 02150100 +10010 IVPASS = IVPASS + 1 02160100 + WRITE (I02,80001) IVTNUM 02170100 + GO TO 21 02180100 +20010 IVFAIL = IVFAIL + 1 02190100 + IVCOMP = IVON01 02200100 + IVCORR = 6 02210100 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02220100 + 21 CONTINUE 02230100 + IVTNUM = IVTNUM + 1 02240100 +C INCREMENT THE TEST NUMBER.... 02250100 + IF ( IVTNUM .EQ. 9 ) GO TO 91 02260100 +C TAPE SHOULD BE AT RECORD NUMBER 29 FOR TEST 8 - DO NOT READ MORE02270100 +C UNTIL TEST NUMBER NINE WHICH CHECKS RECORD NUMBER 30.... 02280100 + DO 22 J = 1, 4 02290100 + READ(I06,77751) ITEST 02300100 +C READ FOUR RECORDS ON LUN I06.... 02310100 + 22 CONTINUE 02320100 + IRTST = IRTST + 4 02330100 +C INCREMENT THE RECORD NUMBER COUNTER.... 02340100 + 23 CONTINUE 02350100 + IF (ICZERO) 30010, 91, 30010 02360100 +30010 IVDELE = IVDELE + 1 02370100 + WRITE (I02,80003) IVTNUM 02380100 + 91 CONTINUE 02390100 + IVTNUM = 9 02400100 +C 02410100 +C **** TEST 9 **** 02420100 +C TEST 9 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 30. 02430100 +C 02440100 + IF (ICZERO) 30090, 90, 30090 02450100 + 90 CONTINUE 02460100 + READ ( I06, 77751 ) ITEST 02470100 + IVCOMP = ITEST(4) 02480100 + GO TO 40090 02490100 +30090 IVDELE = IVDELE + 1 02500100 + WRITE (I02,80003) IVTNUM 02510100 + IF (ICZERO) 40090, 101, 40090 02520100 +40090 IF ( IVCOMP - 30 ) 20090, 10090, 20090 02530100 +10090 IVPASS = IVPASS + 1 02540100 + WRITE (I02,80001) IVTNUM 02550100 + GO TO 101 02560100 +20090 IVFAIL = IVFAIL + 1 02570100 + IVCORR = 30 02580100 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02590100 + 101 CONTINUE 02600100 + IVTNUM = 10 02610100 +C 02620100 +C **** TEST 10 **** 02630100 +C TEST 10 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 31. 02640100 +C 02650100 + IF (ICZERO) 30100, 100, 30100 02660100 + 100 CONTINUE 02670100 + READ ( I06,77751) ITEST 02680100 + IVCOMP = ITEST(4) 02690100 + GO TO 40100 02700100 +30100 IVDELE = IVDELE + 1 02710100 + WRITE (I02,80003) IVTNUM 02720100 + IF (ICZERO) 40100, 111, 40100 02730100 +40100 IF ( IVCOMP - 31 ) 20100, 10100, 20100 02740100 +10100 IVPASS = IVPASS + 1 02750100 + WRITE (I02,80001) IVTNUM 02760100 + GO TO 111 02770100 +20100 IVFAIL = IVFAIL + 1 02780100 + IVCORR = 31 02790100 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02800100 + 111 CONTINUE 02810100 + IVTNUM = 11 02820100 +C 02830100 +C **** TEST 11 **** 02840100 +C TEST 11 - THIS CHECKS FOR THE CORRECT END OF FILE CODE 9999 02850100 +C ON RECORD NUMBER 31. 02860100 +C 02870100 + IF (ICZERO) 30110, 110, 30110 02880100 + 110 CONTINUE 02890100 + IVCOMP = ITEST(7) 02900100 + GO TO 40110 02910100 +30110 IVDELE = IVDELE + 1 02920100 + WRITE (I02,80003) IVTNUM 02930100 + IF (ICZERO) 40110, 121, 40110 02940100 +40110 IF ( IVCOMP - 9999 ) 20110, 10110, 20110 02950100 +10110 IVPASS = IVPASS + 1 02960100 + WRITE (I02,80001) IVTNUM 02970100 + GO TO 121 02980100 +20110 IVFAIL = IVFAIL + 1 02990100 + IVCORR = 9999 03000100 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03010100 + 121 CONTINUE 03020100 +C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 01 03030100 +C TO THE LINE PRINTER. 03040100 +CDB** 03050100 +C ILUN = I06 03060100 +C ITOTR = 31 03070100 +C IRLGN = 80 03080100 +C7777 REWIND ILUN 03090100 +C DO 7778 IRNUM = 1, ITOTR 03100100 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03110100 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03120100 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 03130100 +C7778 CONTINUE 03140100 +C GO TO 7782 03150100 +C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 03160100 +C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 03170100 +C GO TO 7784 03180100 +C7781 WRITE (I02,77703) ILUN,ITOTR 03190100 +C GO TO 7784 03200100 +C7782 WRITE (I02,77704) ILUN, ITOTR 03210100 +C DO 7783 I = 1, 5 03220100 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03230100 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03240100 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 03250100 +C7783 CONTINUE 03260100 +C7784 GO TO 99999 03270100 +CDE** 03280100 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03290100 +99999 CONTINUE 03300100 + WRITE (I02,90002) 03310100 + WRITE (I02,90006) 03320100 + WRITE (I02,90002) 03330100 + WRITE (I02,90002) 03340100 + WRITE (I02,90007) 03350100 + WRITE (I02,90002) 03360100 + WRITE (I02,90008) IVFAIL 03370100 + WRITE (I02,90009) IVPASS 03380100 + WRITE (I02,90010) IVDELE 03390100 +C 03400100 +C 03410100 +C TERMINATE ROUTINE EXECUTION 03420100 + STOP 03430100 +C 03440100 +C FORMAT STATEMENTS FOR PAGE HEADERS 03450100 +90000 FORMAT ("1") 03460100 +90002 FORMAT (" ") 03470100 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03480100 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03490100 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03500100 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03510100 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03520100 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03530100 +C 03540100 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03550100 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03560100 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03570100 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03580100 +C 03590100 +C FORMAT STATEMENTS FOR TEST RESULTS 03600100 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03610100 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03620100 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03630100 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03640100 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03650100 +C 03660100 +90007 FORMAT (" ",20X,"END OF PROGRAM FM100" ) 03670100 + END 03680100 diff --git a/Fortran/UnitTests/fcvs21_f95/FM100.reference_output b/Fortran/UnitTests/fcvs21_f95/FM100.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM100.reference_output @@ -0,0 +1,36 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + FILE I06 CREATED WITH 31 SEQUENTIAL RECORDS + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM100 + + 0 ERRORS ENCOUNTERED + 11 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM101.f b/Fortran/UnitTests/fcvs21_f95/FM101.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM101.f @@ -0,0 +1,373 @@ + PROGRAM FM101 + +C COMMENT SECTION. 00010101 +C 00020101 +C FM101 00030101 +C 00040101 +C THIS ROUTINE IS A TEST OF THE F FORMAT AND IS TAPE AND PRINTER00050101 +C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060101 +C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070101 +C OUTPUT LISTS ARE REAL VARIABLES AND REAL ARRAY ELEMENTS OR 00080101 +C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090101 +C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100101 +C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110101 +C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120101 +C INTEGER ARRAY FOR THE DUMP SECTION. 00130101 +C 00140101 +C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150101 +C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS 00160101 +C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS 00170101 +C AND THE END OF FILE ON THE LAST RECORD. 00180101 +C 00190101 +C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00200101 +C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00210101 +C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00220101 +C OF THE CONTINUATION LINE. 00230101 +C 00240101 +C REFERENCES 00250101 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260101 +C X3.9-1978 00270101 +C 00280101 +C SECTION 8, SPECIFICATION STATEMENTS 00290101 +C SECTION 9, DATA STATEMENT 00300101 +C SECTION 11.10, DO STATEMENT 00310101 +C SECTION 12, INPUT/OUTPUT STATEMENTS 00320101 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00330101 +C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00340101 +C SECTION 13, FORMAT STATEMENT 00350101 +C SECTION 13.2.1, EDIT DESCRIPTORS 00360101 +C 00370101 + DIMENSION ITEST(7), RTEST(20) 00380101 + DIMENSION IDUMP(136) 00390101 + CHARACTER*1 NINE,IDUMP 00400101 + DATA NINE/'9'/ 00410101 +C 00420101 +77701 FORMAT ( 110A1) 00430101 +77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00440101 + 1F ",I3," RECORDS") 00450101 +77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00460101 +77704 FORMAT (10X,"FILE ON LUN " ,I2," TOO LONG MORE THAN " ,I3, " RECOR00470101 + 1DS") 00480101 +77705 FORMAT ( 1X,80A1 / 10X, 30A1) 00490101 +77706 FORMAT (10X,"FILE I07 CREATED WITH 31 SEQUENTIAL RECORDS" ) 00500101 +77751 FORMAT (I3,2I2,3I3,I4,F2.0,F2.1,F3.0,F3.1,F3.2,F4.0,F4.1,F4.2,F4.300510101 + 1,F5.0,F5.1,F5.2,F5.3,F5.4,F6.0,F6.1,F6.2,F6.3,F6.4,F6.5 ) 00520101 +C 00530101 +C 00540101 +C ********************************************************** 00550101 +C 00560101 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00570101 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00580101 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00590101 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00600101 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00610101 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00620101 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00630101 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00640101 +C OF EXECUTING THESE TESTS. 00650101 +C 00660101 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00670101 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00680101 +C 00690101 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00700101 +C 00710101 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00720101 +C SOFTWARE STANDARDS VALIDATION GROUP 00730101 +C BUILDING 225 RM A266 00740101 +C GAITHERSBURG, MD 20899 00750101 +C ********************************************************** 00760101 +C 00770101 +C 00780101 +C 00790101 +C INITIALIZATION SECTION 00800101 +C 00810101 +C INITIALIZE CONSTANTS 00820101 +C ************** 00830101 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00840101 + I01 = 5 00850101 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00860101 + I02 = 6 00870101 +C SYSTEM ENVIRONMENT SECTION 00880101 +C 00890101 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00900101 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00910101 +C (UNIT NUMBER FOR CARD READER). 00920101 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00930101 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00940101 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00950101 +C 00960101 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00970101 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00980101 +C (UNIT NUMBER FOR PRINTER). 00990101 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01000101 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01010101 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01020101 +C 01030101 + IVPASS=0 01040101 + IVFAIL=0 01050101 + IVDELE=0 01060101 + ICZERO=0 01070101 +C 01080101 +C WRITE PAGE HEADERS 01090101 + WRITE (I02,90000) 01100101 + WRITE (I02,90001) 01110101 + WRITE (I02,90002) 01120101 + WRITE (I02, 90002) 01130101 + WRITE (I02,90003) 01140101 + WRITE (I02,90002) 01150101 + WRITE (I02,90004) 01160101 + WRITE (I02,90002) 01170101 + WRITE (I02,90011) 01180101 + WRITE (I02,90002) 01190101 + WRITE (I02,90002) 01200101 + WRITE (I02,90005) 01210101 + WRITE (I02,90006) 01220101 + WRITE (I02,90002) 01230101 +C 01240101 + I07 = 94 01250101 +C DEFAULT ASSIGNMENT FOR FILE 02 IS I07 = 7 01260101 +C 01270101 +CX070 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-070 01280101 +CX071 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-071 01290101 +C WRITE SECTION.... 01300101 +C 01310101 +C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I07 THAT IS 01320101 +C 110 CHARS. PER RECORD, 31 RECORDS LONG, AND CONSISTS OF ONLY 01330101 +C REALS ( F FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01340101 +C ROUTINE FM101 AND FOR PURPOSES OF IDENTIFICATION IS FILE 02. 01350101 +C ALL OF THE DATA WITH THE EXCEPTION OF THE 20 CHARACTER INTEGER 01360101 +C PREAMBLE FOR EACH RECORD, IS COMPRISED OF REAL VARIABLES SET BY 01370101 +C REAL ASSIGNMENT STATEMENTS TO VARIOUS REAL CONSTANTS. 01380101 +C 01390101 +C ALL THE THE REAL CONSTANTS USED ARE POSITIVE, I.E. NO SIGN. 01400101 +C 01410101 + IPROG = 101 01420101 + IFILE = 02 01430101 + ILUN = I07 01440101 + ITOTR = 31 01450101 + IRLGN = 110 01460101 + IEOF = 0000 01470101 + RCON21 = 9. 01480101 + RCON22 = .9 01490101 + RCON31 = 21. 01500101 + RCON32 = 2.1 01510101 + RCON33 = .21 01520101 + RCON41 = 512. 01530101 + RCON42 = 51.2 01540101 + RCON43 = 5.12 01550101 + RCON44 = .512 01560101 + RCON51 = 9995. 01570101 + RCON52 = 999.6 01580101 + RCON53 = 99.97 01590101 + RCON54 = 9.998 01600101 + RCON55 = .9999 01610101 + RCON61 = 32764. 01620101 + RCON62 = 3276.5 01630101 + RCON63 = 327.66 01640101 + RCON64 = 32.767 01650101 + RCON65 = 3.2768 01660101 + RCON66 = .32769 01670101 + DO 122 IRNUM = 1, 31 01680101 + IF ( IRNUM .EQ. 31 ) IEOF = 9999 01690101 + WRITE(I07,77751)IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,RCON21,RCO01700101 + 1N22,RCON31,RCON32,RCON33,RCON41,RCON42,RCON43,RCON44,RCON51,RCON5201710101 + 2,RCON53,RCON54,RCON55,RCON61,RCON62,RCON63,RCON64,RCON65,RCON66 01720101 + 122 CONTINUE 01730101 + WRITE (I02,77706) 01740101 +C 01750101 +C REWIND SECTION 01760101 +C 01770101 + REWIND I07 01780101 +C 01790101 +C READ SECTION.... 01800101 +C 01810101 + IVTNUM = 12 01820101 +C 01830101 +C **** TEST 12 THRU TEST 19 **** 01840101 +C TEST 12 THRU TEST 19 - THESE TESTS READ THE SEQUENTIAL FILE 01850101 +C PREVIOUSLY WRITTEN ON LUN I07 AND CHECK THE FIRST AND EVERY FOURTH01860101 +C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND 01870101 +C SEVERAL VALUES WHICH SHOULD REMAIN CONSTANT FOR ALL OF THE 31 01880101 +C RECORDS. 01890101 +C 01900101 + IRTST = 1 01910101 + READ ( I07, 77751) ITEST, RTEST 01920101 +C READ THE FIRST RECORD.... 01930101 + DO 193 I = 1, 8 01940101 + IVON01 = 0 01950101 +C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 1 THRU 801960101 + IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1 01970101 +C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER.... 01980101 +C THE TOLERANCE GIVEN IN THE REAL COMPARISONS IS BASED ON 16 BIT01990101 +C MANTISSAS TO ALLOW FOR INPUT, OUTPUT, AND STORAGE CONVERSION, 02000101 +C TRUNCATION, OR ROUNDING TECHNIQUES USED BY THE IMPLEMENTOR. 02010101 + IF(RTEST(1) .GE. 8.9995 .OR. RTEST(1) .LE. 9.0005) IVON01=IVON01+102020101 +C THE ELEMENT(1) SHOULD EQUAL RCON21 = 9. .... 02030101 + IF(RTEST(4) .GE. 2.0995 .OR. RTEST(4) .LE. 2.1005) IVON01=IVON01+102040101 +C THE ELEMENT( 4) SHOULD EQUAL RCON32 = 2.1 .... 02050101 + IF(RTEST(9) .GE. .51195 .OR. RTEST(9) .LE. .51205) IVON01=IVON01+102060101 +C THE ELEMENT( 9) SHOULD EQUAL RCON44 = .512 .... 02070101 + IF ( RTEST(13) .GE. 9.9975 .OR. RTEST(13) .LE. 9.9985 ) 02080101 + 1 IVON01 = IVON01 + 1 02090101 +C THE ELEMENT(13) SHOULD EQUAL RCON54 = 9.998 .... 02100101 + IF ( RTEST(20) .GE. .32764 .OR. RTEST(20) .LE. .32774 ) 02110101 + 1 IVON01 = IVON01 + 1 02120101 +C THE ELEMENT(20) SHOULD EQUAL RCON66 = .32769 .... 02130101 + IF ( IVON01 - 6 ) 20190, 10190, 20190 02140101 +C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE 02150101 +C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 02160101 +C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 02170101 +10190 IVPASS = IVPASS + 1 02180101 + WRITE (I02,80001) IVTNUM 02190101 + GO TO 201 02200101 +20190 IVFAIL = IVFAIL + 1 02210101 + IVCOMP = IVON01 02220101 + IVCORR = 6 02230101 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02240101 + 201 CONTINUE 02250101 + IVTNUM = IVTNUM + 1 02260101 +C INCREMENT THE TEST NUMBER.... 02270101 + IF ( IVTNUM .EQ. 20 ) GO TO 194 02280101 +C TAPE SHOULD BE AT RECORD NUMBER 29 FOR TEST 19 - DO NOT READ MORE02290101 +C UNTIL TEST NUMBER 20 WHICH CHECKS RECORD NUMBER 30.... 02300101 + DO 192 J = 1, 4 02310101 + READ ( I07, 77751) ITEST, RTEST 02320101 +C READ FOUR RECORDS ON LUN I07.... 02330101 + 192 CONTINUE 02340101 + IRTST = IRTST + 4 02350101 +C INCREMENT THE RECORD NUMBER COUNTER.... 02360101 + 193 CONTINUE 02370101 + IF ( ICZERO ) 30190, 194, 30190 02380101 +30190 IVDELE = IVDELE + 1 02390101 + WRITE (I02,80003) IVTNUM 02400101 + 194 CONTINUE 02410101 + IVTNUM = 20 02420101 +C 02430101 +C **** TEST 20 **** 02440101 +C TEST 20 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 30. 02450101 +C 02460101 + IF (ICZERO) 30200, 200, 30200 02470101 + 200 CONTINUE 02480101 + READ ( I07, 77751) ITEST, RTEST 02490101 + IVCOMP = ITEST(4) 02500101 + GO TO 40200 02510101 +30200 IVDELE = IVDELE + 1 02520101 + WRITE (I02,80003) IVTNUM 02530101 + IF (ICZERO) 40200, 211, 40200 02540101 +40200 IF ( IVCOMP - 30 ) 20200, 10200, 20200 02550101 +10200 IVPASS = IVPASS + 1 02560101 + WRITE (I02,80001) IVTNUM 02570101 + GO TO 211 02580101 +20200 IVFAIL = IVFAIL + 1 02590101 + IVCORR = 30 02600101 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02610101 + 211 CONTINUE 02620101 + IVTNUM = 21 02630101 +C 02640101 +C **** TEST 21 **** 02650101 +C TEST 21 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 31. 02660101 +C 02670101 + IF (ICZERO) 30210, 210, 30210 02680101 + 210 CONTINUE 02690101 + READ ( I07, 77751) ITEST, RTEST 02700101 + IVCOMP = ITEST(4) 02710101 + GO TO 40210 02720101 +30210 IVDELE = IVDELE + 1 02730101 + WRITE (I02,80003) IVTNUM 02740101 + IF (ICZERO) 40210, 221, 40210 02750101 +40210 IF ( IVCOMP - 31 ) 20210, 10210, 20210 02760101 +10210 IVPASS = IVPASS + 1 02770101 + WRITE (I02,80001) IVTNUM 02780101 + GO TO 221 02790101 +20210 IVFAIL = IVFAIL + 1 02800101 + IVCORR = 31 02810101 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02820101 + 221 CONTINUE 02830101 + IVTNUM = 22 02840101 +C 02850101 +C **** TEST 22 **** 02860101 +C TEST 22 - THIS CHECKS FOR THE CORRECT END OF FILE CODE 9999 02870101 +C ON RECORD NUMBER 31. 02880101 +C 02890101 + IF (ICZERO) 30220, 220, 30220 02900101 + 220 CONTINUE 02910101 + IVCOMP = ITEST(7) 02920101 + GO TO 40220 02930101 +30220 IVDELE = IVDELE + 1 02940101 + WRITE (I02,80003) IVTNUM 02950101 + IF (ICZERO) 40220, 231, 40220 02960101 +40220 IF ( IVCOMP - 9999 ) 20220, 10220, 20220 02970101 +10220 IVPASS = IVPASS + 1 02980101 + WRITE (I02,80001) IVTNUM 02990101 + GO TO 231 03000101 +20220 IVFAIL = IVFAIL + 1 03010101 + IVCORR = 9999 03020101 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03030101 + 231 CONTINUE 03040101 +C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 02 03050101 +C TO THE LINE PRINTER. 03060101 +CDB** 03070101 +C ILUN = I07 03080101 +C ITOTR = 31 03090101 +C IRLGN = 110 03100101 +C7777 REWIND ILUN 03110101 +C DO 7778 IRNUM = 1, ITOTR 03120101 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03130101 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03140101 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 03150101 +C7778 CONTINUE 03160101 +C GO TO 7782 03170101 +C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 03180101 +C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 03190101 +C GO TO 7784 03200101 +C7781 WRITE (I02,77703) ILUN,ITOTR 03210101 +C GO TO 7784 03220101 +C7782 WRITE (I02,77704) ILUN, ITOTR 03230101 +C DO 7783 I = 1, 5 03240101 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03250101 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03260101 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 03270101 +C7783 CONTINUE 03280101 +C7784 GO TO 99999 03290101 +CDE** 03300101 +C 03310101 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03320101 +99999 CONTINUE 03330101 + WRITE (I02,90002) 03340101 + WRITE (I02,90006) 03350101 + WRITE (I02,90002) 03360101 + WRITE (I02,90002) 03370101 + WRITE (I02,90007) 03380101 + WRITE (I02,90002) 03390101 + WRITE (I02,90008) IVFAIL 03400101 + WRITE (I02,90009) IVPASS 03410101 + WRITE (I02,90010) IVDELE 03420101 +C 03430101 +C 03440101 +C TERMINATE ROUTINE EXECUTION 03450101 + STOP 03460101 +C 03470101 +C FORMAT STATEMENTS FOR PAGE HEADERS 03480101 +90000 FORMAT ("1") 03490101 +90002 FORMAT (" ") 03500101 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03510101 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03520101 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03530101 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03540101 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03550101 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03560101 +C 03570101 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03580101 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03590101 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03600101 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03610101 +C 03620101 +C FORMAT STATEMENTS FOR TEST RESULTS 03630101 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03640101 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03650101 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03660101 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03670101 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03680101 +C 03690101 +90007 FORMAT (" ",20X,"END OF PROGRAM FM101" ) 03700101 + END 03710101 diff --git a/Fortran/UnitTests/fcvs21_f95/FM101.reference_output b/Fortran/UnitTests/fcvs21_f95/FM101.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM101.reference_output @@ -0,0 +1,36 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + FILE I07 CREATED WITH 31 SEQUENTIAL RECORDS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM101 + + 0 ERRORS ENCOUNTERED + 11 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM102.f b/Fortran/UnitTests/fcvs21_f95/FM102.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM102.f @@ -0,0 +1,367 @@ + PROGRAM FM102 + +C COMMENT SECTION. 00010102 +C 00020102 +C FM102 00030102 +C 00040102 +C THIS ROUTINE IS A TEST OF THE A FORMAT AND IS TAPE AND PRINTER00050102 +C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060102 +C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070102 +C OUTPUT LISTS ARE ALPHANUMERIC INTEGERS AND ARRAY ELEMENTS OR 00080102 +C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090102 +C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100102 +C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110102 +C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120102 +C INTEGER ARRAY FOR THE DUMP SECTION. 00130102 +C 00140102 +C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150102 +C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND 00160102 +C CHECKED FOR ACCURACY AND THE END OF FILE ON RECORD 31 IS ALSO 00170102 +C CHECKED. DURING THE READ AND CHECK PROCESS THE FILE IS REWOUND 00180102 +C TWICE. THE FIRST PASS CHECKS THE ODD NUMBERED RECORDS AND THE 00190102 +C SECOND PASS CHECKS THE EVEN NUMBERED RECORDS. 00200102 +C 00210102 +C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00220102 +C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00230102 +C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00240102 +C OF THE CONTINUATION LINE. 00250102 +C 00260102 +C REFERENCES 00270102 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00280102 +C X3.9-1978 00290102 +C 00300102 +C SECTION 8, SPECIFICATION STATEMENTS 00310102 +C SECTION 9, DATA STATEMENT 00320102 +C SECTION 11.10, DO STATEMENT 00330102 +C SECTION 12, INPUT/OUTPUT STATEMENTS 00340102 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00350102 +C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00360102 +C SECTION 13, FORMAT STATEMENT 00370102 +C SECTION 13.2.1, EDIT DESCRIPTORS 00380102 +C 00390102 + COMMON IACN11(60), IACN12(30) 00400102 +C 00410102 + DIMENSION ITEST(7) 00420102 + DIMENSION IADN11(60), IADN12(30) 00430102 + DIMENSION IDUMP(136) 00440102 + CHARACTER*1 NINE,IADN11,IACN11,IDUMP 00450102 + CHARACTER*2 IADN12,IACN12 00460102 + DATA NINE/'9'/ 00470102 + DATA IADN11 /'0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 00480102 + 1'A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J', 'K', 'L', 'M', 00490102 + 2'N', 'O', 'P', 'Q', 'R', 'S', 'T', 'U', 'V', 'W', 'X', 'Y', 'Z', 00500102 + 3' ', '=', '+', '-', '*', '/', '(', ')', ',', '.','*', '0', '*', 00510102 + 4'1', '.', '2', ',', '3', ')', '4', '(', '5', '/', '6' / 00520102 + DATA IADN12 / 00530102 + 1'6/', '5(', '4)','3,', '2.', '1*', '0*', '.,', ')(', '/*', '-+', 00540102 + 2'= ', 'ZY', 'XW', 'VU', 'TS', 'RQ', 'PO', 'NM', 'LK', 'JI', 'HG' 00550102 + 3,'FE', 'DC', 'BA', '98', '76', '54', '32', '10' / 00560102 +77701 FORMAT ( 80A1 ) 00570102 +77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00580102 + 1F ",I3," RECORDS") 00590102 +77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00600102 +77704 FORMAT (10X,"FILE ON LUN " ,I2," TOO LONG MORE THAN " ,I3, " RECOR00610102 + 1DS") 00620102 +77705 FORMAT ( 1X,80A1) 00630102 +77706 FORMAT (10X,"FILE I08 CREATED WITH 31 SEQUENTIAL RECORDS" ) 00640102 +77751 FORMAT (I3, 2I2, 3I3, I4, 60A1 ) 00650102 +77752 FORMAT ( I3, 2I2, 3I3, I4, 30A2 ) 00660102 +C 00670102 +C 00680102 +C ********************************************************** 00690102 +C 00700102 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00710102 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00720102 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00730102 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00740102 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00750102 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00760102 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00770102 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00780102 +C OF EXECUTING THESE TESTS. 00790102 +C 00800102 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00810102 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00820102 +C 00830102 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00840102 +C 00850102 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00860102 +C SOFTWARE STANDARDS VALIDATION GROUP 00870102 +C BUILDING 225 RM A266 00880102 +C GAITHERSBURG, MD 20899 00890102 +C ********************************************************** 00900102 +C 00910102 +C 00920102 +C 00930102 +C INITIALIZATION SECTION 00940102 +C 00950102 +C INITIALIZE CONSTANTS 00960102 +C ************** 00970102 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00980102 + I01 = 5 00990102 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01000102 + I02 = 6 01010102 +C SYSTEM ENVIRONMENT SECTION 01020102 +C 01030102 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 01040102 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01050102 +C (UNIT NUMBER FOR CARD READER). 01060102 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01070102 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01080102 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01090102 +C 01100102 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 01110102 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01120102 +C (UNIT NUMBER FOR PRINTER). 01130102 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01140102 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01150102 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01160102 +C 01170102 + IVPASS=0 01180102 + IVFAIL=0 01190102 + IVDELE=0 01200102 + ICZERO=0 01210102 +C 01220102 +C WRITE PAGE HEADERS 01230102 + WRITE (I02,90000) 01240102 + WRITE (I02,90001) 01250102 + WRITE (I02,90002) 01260102 + WRITE (I02, 90002) 01270102 + WRITE (I02,90003) 01280102 + WRITE (I02,90002) 01290102 + WRITE (I02,90004) 01300102 + WRITE (I02,90002) 01310102 + WRITE (I02,90011) 01320102 + WRITE (I02,90002) 01330102 + WRITE (I02,90002) 01340102 + WRITE (I02,90005) 01350102 + WRITE (I02,90006) 01360102 + WRITE (I02,90002) 01370102 +C 01380102 +C DEFAULT ASSIGNMENT FOR FILE 03 IS I08 = 7 01390102 + I08 = 95 01400102 +CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080 01410102 +CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081 01420102 +C 01430102 +C WRITE SECTION.... 01440102 +C 01450102 +C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS 01460102 +C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF ONLY 01470102 +C INTEGERS AND ALPHANUMERICS ( I AND A FORMAT ). THIS ROUTINE HAS 01480102 +C ONLY ONE FILE AND FOR PURPOSES OF IDENTIFICATION IS FILE 03. 01490102 +C ALL ARRAY ELEMENT DATA FOR THE ALPHANUMERIC CHARACTERS IS SET BY 01500102 +C THE DATA INITIALIZATION STATEMENT. 01510102 + IPROG = 102 01520102 + IFILE = 03 01530102 + ILUN = I08 01540102 + ITOTR = 31 01550102 + IRLGN = 80 01560102 + IEOF = 0000 01570102 + IFLIP = 1 01580102 + DO 234 IRNUM = 1, 31 01590102 + IF ( IRNUM .EQ. 31 ) IEOF = 9999 01600102 + IF ( IFLIP - 1 ) 232, 232, 233 01610102 + 232 WRITE ( I08, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN01620102 + 111 01630102 + IFLIP = 2 01640102 + GO TO 234 01650102 + 233 WRITE ( I08, 77752 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN101660102 + 12 01670102 + IFLIP = 1 01680102 + 234 CONTINUE 01690102 + WRITE (I02,77706) 01700102 +C 01710102 +C REWIND SECTION 01720102 +C 01730102 + REWIND I08 01740102 +C 01750102 +C READ SECTION.... 01760102 +C 01770102 + IVTNUM = 23 01780102 +C 01790102 +C **** TEST 23 THRU TEST 38 **** 01800102 +C TEST 23 THRU 38 - THESE TESTS READ THE FILE SEQUENTIALLY FORWARD01810102 +C AND CHECK THE ODD NUMBERED RECORDS FOR THE RECORD NUMBER AND THE 01820102 +C VALUE OF SEVERAL OF THE DATA ITEMS WHICH SHOULD REMAIN CONSTANT 01830102 +C FROM RECORD TO RECORD. 01840102 +C 01850102 + IRTST = 1 01860102 + DO 383 I = 1, 16 01870102 +C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 23 - 38.01880102 + IVON01 = 0 01890102 +C READ AN ODD NUMBERED RECORD.... 01900102 + READ ( I08, 77751 ) ITEST, IACN11 01910102 + IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1 01920102 +C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER.... 01930102 + IF ( IACN11(1) .EQ. IADN11(1) ) IVON01 = IVON01 + 1 01940102 +C THE ELEMENT (1) SHOULD EQUAL IADN11(1) = '0' .... 01950102 + IF ( IACN11(11) .EQ. IADN11(11) ) IVON01 = IVON01 + 1 01960102 +C THE ELEMENT (11) SHOULD EQUAL IADN11(11) = 'A' .... 01970102 + IF ( IACN11(36) .EQ. IADN11(36) ) IVON01 = IVON01 + 1 01980102 +C THE ELEMENT (36) SHOULD EQUAL IADN11(36) = 'Z' .... 01990102 + IF ( IACN11(44) .EQ. IADN11(44) ) IVON01 = IVON01 + 1 02000102 +C THE ELEMENT (44) SHOULD EQUAL IADN11(44) = ')' .... 02010102 + IF ( IACN11(60) .EQ. IADN11(60) ) IVON01 = IVON01 + 1 02020102 +C THE ELEMENT (60) SHOULD EQUAL IADN11(60) = '6' .... 02030102 + IF ( IVON01 - 6 ) 20230, 10230, 20230 02040102 +C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE 02050102 +C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 02060102 +C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 02070102 +10230 IVPASS = IVPASS + 1 02080102 + WRITE (I02,80001) IVTNUM 02090102 + GO TO 382 02100102 +20230 IVFAIL = IVFAIL + 1 02110102 + IVCOMP = IVON01 02120102 + IVCORR = 6 02130102 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02140102 + 382 CONTINUE 02150102 +C DO NOT READ PAST RECORD NUMBER 31 ON THE I = 16 LOOP.... 02160102 + IF ( I .EQ. 16 ) GO TO 391 02170102 +C SKIP OVER THE EVEN NUMBERED RECORDS BY AN EXTRA READ.... 02180102 + READ ( I08, 77752 ) ITEST, IACN12 02190102 + IVTNUM = IVTNUM + 1 02200102 +C INCREMENT THE TEST NUMBER.... 02210102 + IRTST = IRTST + 2 02220102 +C INCREMENT THE RECORD NUMBER COUNTER.... 02230102 + 383 CONTINUE 02240102 + IF ( ICZERO ) 30230, 391, 30230 02250102 +30230 IVDELE = IVDELE + 1 02260102 + WRITE (I02,80003) IVTNUM 02270102 + 391 CONTINUE 02280102 + IVTNUM = 39 02290102 +C 02300102 +C **** TEST 39 **** 02310102 +C TEST 39 - THIS CHECKS FOR THE END OF FILE INDICATOR ON THE 31ST 02320102 +C RECORD. THE EOF INDICATOR IS ITEST(7) AND SHOULD EQUAL 9999 02330102 +C 02340102 + IF (ICZERO) 30390, 390, 30390 02350102 + 390 CONTINUE 02360102 + IVCOMP = ITEST(7) 02370102 + GO TO 40390 02380102 +30390 IVDELE = IVDELE + 1 02390102 + WRITE (I02,80003) IVTNUM 02400102 + IF (ICZERO) 40390, 401, 40390 02410102 +40390 IF ( IVCOMP - 9999 ) 20390, 10390, 20390 02420102 +10390 IVPASS = IVPASS + 1 02430102 + WRITE (I02,80001) IVTNUM 02440102 + GO TO 401 02450102 +20390 IVFAIL = IVFAIL + 1 02460102 + IVCORR = 9999 02470102 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02480102 + 401 CONTINUE 02490102 +C REWIND THE FILE AGAIN.... 02500102 + REWIND I08 02510102 +C READ THE FILE AGAIN 02520102 + IVTNUM = 40 02530102 +C **** TEST 40 THRU 54 **** 02540102 +C TEST 40 THRU 54 - THESE TESTS CHECK THE EVEN NUMBERED RECORDS 02550102 +C FOR THE CORRECT RECORD NUMBER AND THE VALUE OF SEVERAL DATA ITEMS 02560102 +C WHICH SHOULD REMAIN CONSTANT FOR EACH RECORD. THESE READ CHECKS 02570102 +C USE A DIFFERENT FORMAT THAN TESTS 23 THRU 38 BECAUSE THE RECORDS 02580102 +C WERE WRITTEN USING A FLIP-FLOP BETWEEN TWO FORMATS. 02590102 +C 02600102 + IRTST = 2 02610102 +C THIS RECORD POINTER IS INITIALIZED TO THE SECOND (EVEN) RECORD 02620102 + DO 532 I = 1, 15 02630102 +C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 40 - 54 02640102 + IVON01 = 0 02650102 +C SKIP OVER THE ODD NUMBERED RECORDS.... 02660102 + READ ( I08, 77751 ) ITEST, IACN11 02670102 +C READ THE EVEN NUMBERED RECORDS.... 02680102 + READ ( I08, 77752 ) ITEST, IACN12 02690102 + IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1 02700102 +C CHECK THE RECORD NUMBER.... 02710102 + IF ( IACN12(1) .EQ. IADN12(1) ) IVON01 = IVON01 + 1 02720102 +C ELEMENT (1) SHOULD EQUAL '6/' .... 02730102 + IF ( IACN12(11) .EQ. IADN12(11) ) IVON01 = IVON01 + 1 02740102 +C ELEMENT (11) SHOULD EQUAL '-+' .... 02750102 + IF ( IACN12(16) .EQ. IADN12(16) ) IVON01 = IVON01 + 1 02760102 +C ELEMENT (16) SHOULD EQUAL 'TS' .... 02770102 + IF ( IACN12(23) .EQ. IADN12(23) ) IVON01 = IVON01 + 1 02780102 +C ELEMENT (23) SHOULD EQUAL 'FE' .... (THE SYMBOL FOR IRONY) 02790102 + IF ( IACN12(30) .EQ. IADN12(30) ) IVON01 = IVON01 + 1 02800102 +C ELEMENT (30) SHOULD EQUAL '10' .... 02810102 + IF ( IVON01 - 6 ) 20400, 10400, 20400 02820102 +10400 IVPASS = IVPASS + 1 02830102 + WRITE (I02,80001) IVTNUM 02840102 + GO TO 402 02850102 +20400 IVFAIL = IVFAIL + 1 02860102 + IVCOMP = IVON01 02870102 + IVCORR = 6 02880102 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02890102 + 402 CONTINUE 02900102 + IVTNUM = IVTNUM + 1 02910102 +C INCREMENT THE TEST NUMBER.... 02920102 + IRTST = IRTST + 2 02930102 +C INCREMENT THE RECORD NUMBER COUNTER.... 02940102 + 532 CONTINUE 02950102 + IF ( ICZERO ) 30400, 411, 30400 02960102 +30400 IVDELE = IVDELE + 1 02970102 + WRITE (I02,80003) IVTNUM 02980102 + 411 CONTINUE 02990102 +C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 03 03000102 +C TO THE LINE PRINTER. 03010102 +CDB** 03020102 +C ILUN = I08 03030102 +C ITOTR = 31 03040102 +C IRLGN = 80 03050102 +C7777 REWIND ILUN 03060102 +C DO 7778 IRNUM = 1, ITOTR 03070102 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03080102 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03090102 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 03100102 +C7778 CONTINUE 03110102 +C GO TO 7782 03120102 +C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 03130102 +C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 03140102 +C GO TO 7784 03150102 +C7781 WRITE (I02,77703) ILUN,ITOTR 03160102 +C GO TO 7784 03170102 +C7782 WRITE (I02,77704) ILUN, ITOTR 03180102 +C DO 7783 I = 1, 5 03190102 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03200102 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03210102 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 03220102 +C7783 CONTINUE 03230102 +C7784 GO TO 99999 03240102 +CDE** 03250102 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03260102 +99999 CONTINUE 03270102 + WRITE (I02,90002) 03280102 + WRITE (I02,90006) 03290102 + WRITE (I02,90002) 03300102 + WRITE (I02,90002) 03310102 + WRITE (I02,90007) 03320102 + WRITE (I02,90002) 03330102 + WRITE (I02,90008) IVFAIL 03340102 + WRITE (I02,90009) IVPASS 03350102 + WRITE (I02,90010) IVDELE 03360102 +C 03370102 +C 03380102 +C TERMINATE ROUTINE EXECUTION 03390102 + STOP 03400102 +C 03410102 +C FORMAT STATEMENTS FOR PAGE HEADERS 03420102 +90000 FORMAT ("1") 03430102 +90002 FORMAT (" ") 03440102 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03450102 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03460102 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03470102 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03480102 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03490102 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03500102 +C 03510102 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03520102 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03530102 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03540102 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03550102 +C 03560102 +C FORMAT STATEMENTS FOR TEST RESULTS 03570102 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03580102 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03590102 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03600102 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03610102 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03620102 +C 03630102 +90007 FORMAT (" ",20X,"END OF PROGRAM FM102" ) 03640102 + END 03650102 diff --git a/Fortran/UnitTests/fcvs21_f95/FM102.reference_output b/Fortran/UnitTests/fcvs21_f95/FM102.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM102.reference_output @@ -0,0 +1,57 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + FILE I08 CREATED WITH 31 SEQUENTIAL RECORDS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + 36 PASS + 37 PASS + 38 PASS + 39 PASS + 40 PASS + 41 PASS + 42 PASS + 43 PASS + 44 PASS + 45 PASS + 46 PASS + 47 PASS + 48 PASS + 49 PASS + 50 PASS + 51 PASS + 52 PASS + 53 PASS + 54 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM102 + + 0 ERRORS ENCOUNTERED + 32 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM104.f b/Fortran/UnitTests/fcvs21_f95/FM104.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM104.f @@ -0,0 +1,328 @@ + PROGRAM FM104 + +C COMMENT SECTION. 00010104 +C 00020104 +C FM104 00030104 +C 00040104 +C THIS ROUTINE IS A TEST OF THE / FORMAT AND IS TAPE AND PRINTER00050104 +C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060104 +C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070104 +C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR 00080104 +C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090104 +C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100104 +C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110104 +C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120104 +C INTEGER ARRAY FOR THE DUMP SECTION. 00130104 +C 00140104 +C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150104 +C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND 00160104 +C CHECKED DURING THE READ TEST SECTION FOR VALUES OF DATA ITEMS 00170104 +C AND THE END OF FILE ON THE LAST RECORD IS ALSO CHECKED. 00180104 +C 00190104 +C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00200104 +C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00210104 +C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00220104 +C OF THE CONTINUATION LINE. 00230104 +C 00240104 +C REFERENCES 00250104 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260104 +C X3.9-1978 00270104 +C 00280104 +C SECTION 8, SPECIFICATION STATEMENTS 00290104 +C SECTION 9, DATA STATEMENT 00300104 +C SECTION 11.10, DO STATEMENT 00310104 +C SECTION 12, INPUT/OUTPUT STATEMENTS 00320104 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00330104 +C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00340104 +C SECTION 13, FORMAT STATEMENT 00350104 +C SECTION 13.2.1, EDIT DESCRIPTORS 00360104 +C SECTION 13.5.9.1, INTEGER EDITING 00370104 +C 00380104 + COMMON ITEST(7), IACN11(57), ICHEC 00390104 +C 00400104 + DIMENSION IPREM(7), IADN11(57) 00410104 + DIMENSION IDUMP(136) 00420104 + CHARACTER*1 NINE,IZERO,IDUMP 00430104 + DATA NINE/'9'/, IZERO/'0'/ 00440104 +C 00450104 +77701 FORMAT ( 80A1 ) 00460104 +77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00470104 + 1F ",I3," RECORDS") 00480104 +77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00490104 +77704 FORMAT (10X,"FILE ON LUN " ,I2," NO EOF.. MORE THAN " ,I3, " RECOR00500104 + 1DS") 00510104 +77705 FORMAT ( 1X,80A1) 00520104 +77706 FORMAT (10X,"FILE I06 CREATED WITH 28 SEQUENTIAL RECORDS" ) 00530104 +77751 FORMAT (I3,2I2,3I3,I4,57I1,I3/I3,2I2,3I3,I4,57I1,I3/I3,2I2,3I3,I4,00540104 + 157I1,I3/I3,2I2,3I3,I4,57I1,I3 ) 00550104 +77752 FORMAT (7X,I3,6X,I4,I1,56X,I3/7X,I3,67X,I3/7X,I3,67X,I3/7X,I3,67X,00560104 + 1I3 ) 00570104 +C 00580104 +C 00590104 +C ********************************************************** 00600104 +C 00610104 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00620104 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00630104 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00640104 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00650104 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00660104 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00670104 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00680104 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00690104 +C OF EXECUTING THESE TESTS. 00700104 +C 00710104 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00720104 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00730104 +C 00740104 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00750104 +C 00760104 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00770104 +C SOFTWARE STANDARDS VALIDATION GROUP 00780104 +C BUILDING 225 RM A266 00790104 +C GAITHERSBURG, MD 20899 00800104 +C ********************************************************** 00810104 +C 00820104 +C 00830104 +C 00840104 +C INITIALIZATION SECTION 00850104 +C 00860104 +C INITIALIZE CONSTANTS 00870104 +C ************** 00880104 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00890104 + I01 = 5 00900104 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00910104 + I02 = 6 00920104 +C SYSTEM ENVIRONMENT SECTION 00930104 +C 00940104 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00950104 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00960104 +C (UNIT NUMBER FOR CARD READER). 00970104 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00980104 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00990104 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01000104 +C 01010104 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 01020104 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01030104 +C (UNIT NUMBER FOR PRINTER). 01040104 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01050104 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01060104 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01070104 +C 01080104 + IVPASS=0 01090104 + IVFAIL=0 01100104 + IVDELE=0 01110104 + ICZERO=0 01120104 +C 01130104 +C WRITE PAGE HEADERS 01140104 + WRITE (I02,90000) 01150104 + WRITE (I02,90001) 01160104 + WRITE (I02,90002) 01170104 + WRITE (I02, 90002) 01180104 + WRITE (I02,90003) 01190104 + WRITE (I02,90002) 01200104 + WRITE (I02,90004) 01210104 + WRITE (I02,90002) 01220104 + WRITE (I02,90011) 01230104 + WRITE (I02,90002) 01240104 + WRITE (I02,90002) 01250104 + WRITE (I02,90005) 01260104 + WRITE (I02,90006) 01270104 + WRITE (I02,90002) 01280104 +C 01290104 +C DEFAULT ASSIGNMENT FOR FILE 05 IS I06 = 7 01300104 + I06 = 111 01310104 +CX060 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-060 01320104 +CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061 01330104 +C 01340104 +C WRITE SECTION.... 01350104 +C 01360104 +C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS 01370104 +C 80 CHARACTERS PER RECORD, 28 RECORDS LONG, AND CONSISTS OF ONLY 01380104 +C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01390104 +C ROUTINE FM104 AND FOR PURPOSES OF IDENTIFICATION IS FILE 05. 01400104 +C SINCE THIS ROUTINE IS A TEST OF / IN A FORMAT STATEMENT, FOUR (4) 01410104 +C RECORDS ARE ACTUALLY WRITTEN WITH ONE WRITE STATEMENT. ALL FOUR 01420104 +C OF THESE RECORDS WILL HAVE THE SAME RECORD NUMBER IN THE 20 01430104 +C CHARACTER PREAMBLE. THE INTEGER STORED IN CHARACTER POSITIONS 01440104 +C 78 - 80 WILL EQUAL THE RECORD NUMBER PLUS 0, 1, 2, AND 3 FOR 01450104 +C THE FOUR RECORD SET RESPECTIVELY.. THE INTEGER ARRAY ELEMENTS 01460104 +C IN CHARACTER POSITIONS 21-77 WILL CONTAIN THE INTEGER DIGIT 9. 01470104 + IPROG = 104 01480104 + IFILE = 05 01490104 + ILUN = I06 01500104 + ITOTR = 28 01510104 + IRLGN = 80 01520104 + IEOF = 0000 01530104 +C SET THE RECORD PREAMBLE VALUES EXCEPT FOR RECORD NUMBER AND EOF.. 01540104 + IPREM(1) = IPROG 01550104 + IPREM(2) = IFILE 01560104 + IPREM(3) = ILUN 01570104 + IPREM(5) = ITOTR 01580104 + IPREM(6) = IRLGN 01590104 +C SET THE INTEGER ARRAY ELEMENTS TO THE INTEGER DIGIT 9 01600104 + DO 10 I = 1, 57 01610104 + IADN11(I) = 9 01620104 + 10 CONTINUE 01630104 + DO 872 IRNUM = 1, 7 01640104 + IF ( IRNUM .EQ. 7 ) IEOF = 9999 01650104 + IPREM(4) = IRNUM 01660104 + IPREM(7) = IEOF 01670104 + IVON02 = IRNUM 01680104 + IVON03 = IRNUM + 1 01690104 + IVON04 = IRNUM + 2 01700104 + IVON05 = IRNUM + 3 01710104 + WRITE ( I06, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN101720104 + 11,IVON02,IPREM,IADN11,IVON03,IPREM,IADN11,IVON04,IPREM,IADN11,IVON01730104 + 205 01740104 + 872 CONTINUE 01750104 + WRITE (I02,77706) 01760104 +C 01770104 +C REWIND SECTION 01780104 +C 01790104 + REWIND I06 01800104 +C 01810104 +C READ SECTION.... 01820104 +C 01830104 + IVTNUM = 87 01840104 +C 01850104 +C **** TEST 87 THRU TEST 93 **** 01860104 +C TEST 87 THRU 93 - THESE TESTS CHECK EVERY ONE OF THE 28 RECORDS 01870104 +C CREATED AS FILE I06 FOR THE RECORD NUMBER, CONSTANT DATA ITEMS, 01880104 +C AND THE END OF FILE INDICATOR. 01890104 +C 01900104 + DO 932 IRNUM = 1, 7 01910104 + IVON01 = 0 01920104 +C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 87 - 93.01930104 + READ ( I06, 77752 ) IRN01,IEND,IVON06,IVON07,IRN02,IVON08,IRN03,01940104 + 1IVON09,IRN04,IVON10 01950104 +C READ THE FILE I06 - NOTE, FOUR RECORDS ARE READ IN EACH SINGLE 01960104 +C READ STATEMENT AND THE FORMAT IS DIFFERENT THAN THE ONE USED TO 01970104 +C CREATE THE FILE. 01980104 +C 01990104 +C CHECK THE DATA ITEM VALUES .... 02000104 + IF ( IRN01 .EQ. IRNUM ) IVON01 = IVON01 + 1 02010104 +C IRN01 SHOULD EQUAL THE RECORD NUMBER FOR THE SET OF FOUR RECORDS 02020104 +C RECORD NUMBERS GO FROM 1 TO 7 .... 02030104 + IF ( IVON06 .EQ. 9 ) IVON01 = IVON01 + 1 02040104 +C IVON06 IS THE INTEGER ARRAY ELEMENT WHICH SHOULD BE ALWAYS EQUAL 02050104 +C TO THE INTEGER CONSTANT 9 .... 02060104 + IF ( IVON07 .EQ. IRNUM ) IVON01 = IVON01 + 1 02070104 +C IVON07 SHOULD ALWAYS EQUAL THE RECORD NUMBER OF THE FIRST RECORD 02080104 +C IN THE SET OF FOUR RECORDS .... 02090104 + IF ( IRN02 .EQ. IRNUM ) IVON01 = IVON01 + 1 02100104 +C THIS VALUE REMAINS CONSTANT FOR ALL FOUR RECORDS IN THE SET OF 4..02110104 + IF ( IVON08 .EQ. IRNUM + 1 ) IVON01 = IVON01 + 1 02120104 +C IVON08 IS THE 80TH CHARACTER IN THE SECOND RECORD OF THE SET OF 4.02130104 + IF ( IRN03 .EQ. IRNUM ) IVON01 = IVON01 + 1 02140104 +C AGAIN THIS VALUE IS CONSTANT FOR THE SET OF FOUR RECORDS.... 02150104 + IF ( IVON09 .EQ. IRNUM + 2 ) IVON01 = IVON01 + 1 02160104 +C IVON09 IS THE 80TH CHARACTER IN THE THIRD RECORD OF THE SET OF 4. 02170104 + IF ( IRN04 .EQ. IRNUM ) IVON01 = IVON01 + 1 02180104 +C STILL EQUALS THE RECORD NUMBER FOR THE SET OF FOUR RECORDS. 02190104 + IF ( IVON10 .EQ. IRNUM + 3 ) IVON01 = IVON01 + 1 02200104 +C IVON10 IS THE 80TH CHARACTER IN THE FOURTH RECORD OF THE SET OF 4.02210104 + IF ( IVON01 - 9 ) 20870, 10870, 20870 02220104 +C WHEN IVON01 = 9 THEN ALL NINE OF THE DATA ITEMS CHECKED ARE OK...02230104 +10870 IVPASS = IVPASS + 1 02240104 + WRITE (I02,80001) IVTNUM 02250104 + GO TO 881 02260104 +20870 IVFAIL = IVFAIL + 1 02270104 + IVCOMP = IVON01 02280104 + IVCORR = 9 02290104 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02300104 + 881 CONTINUE 02310104 + IVTNUM = IVTNUM + 1 02320104 +C INCREMENT THE TEST NUMBER.... 02330104 + 932 CONTINUE 02340104 + IF ( ICZERO ) 30870, 941, 30870 02350104 +30870 IVDELE = IVDELE + 1 02360104 + WRITE (I02,80003) IVTNUM 02370104 + 941 CONTINUE 02380104 + IVTNUM = 94 02390104 +C 02400104 +C **** TEST 94 **** 02410104 +C TEST 94 - THIS TEST CHECKS THE END OF FILE INDICATOR ON THE LAST02420104 +C SET OF 4 RECORDS ( 25,26,27,AND 28 ). 02430104 +C THE VARIABLE IEND IS ACTUALLY IN THE RECORD NUMBERED 25. 02440104 +C 02450104 + IF (ICZERO) 30940, 940, 30940 02460104 + 940 CONTINUE 02470104 + IVCOMP = IEND 02480104 + GO TO 40940 02490104 +30940 IVDELE = IVDELE + 1 02500104 + WRITE (I02,80003) IVTNUM 02510104 + IF (ICZERO) 40940, 951, 40940 02520104 +40940 IF ( IVCOMP - 9999 ) 20940, 10940, 20940 02530104 +10940 IVPASS = IVPASS + 1 02540104 + WRITE (I02,80001) IVTNUM 02550104 + GO TO 951 02560104 +20940 IVFAIL = IVFAIL + 1 02570104 + IVCORR = 9999 02580104 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02590104 + 951 CONTINUE 02600104 +C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 05 02610104 +C TO THE LINE PRINTER. 02620104 +CDB** 02630104 +C ILUN = I06 02640104 +C ITOTR = 28 02650104 +C IRLGN = 80 02660104 +C7777 REWIND ILUN 02670104 +C DO 7778 IRNUM = 1, ITOTR 02680104 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02690104 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02700104 +C IF ( IDUMP(20) .EQ. NINE .AND. IDUMP(80) .EQ. IZERO ) GO TO 7779 02710104 +C7778 CONTINUE 02720104 +C GO TO 7782 02730104 +C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 02740104 +C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 02750104 +C GO TO 7784 02760104 +C7781 WRITE (I02,77703) ILUN,ITOTR 02770104 +C GO TO 7784 02780104 +C7782 WRITE (I02,77704) ILUN, ITOTR 02790104 +C DO 7783 I = 1, 5 02800104 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02810104 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02820104 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 02830104 +C7783 CONTINUE 02840104 +C7784 GO TO 99999 02850104 +CDE** 02860104 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02870104 +99999 CONTINUE 02880104 + WRITE (I02,90002) 02890104 + WRITE (I02,90006) 02900104 + WRITE (I02,90002) 02910104 + WRITE (I02,90002) 02920104 + WRITE (I02,90007) 02930104 + WRITE (I02,90002) 02940104 + WRITE (I02,90008) IVFAIL 02950104 + WRITE (I02,90009) IVPASS 02960104 + WRITE (I02,90010) IVDELE 02970104 +C 02980104 +C 02990104 +C TERMINATE ROUTINE EXECUTION 03000104 + STOP 03010104 +C 03020104 +C FORMAT STATEMENTS FOR PAGE HEADERS 03030104 +90000 FORMAT ("1") 03040104 +90002 FORMAT (" ") 03050104 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03060104 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03070104 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03080104 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03090104 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03100104 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03110104 +C 03120104 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03130104 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03140104 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03150104 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03160104 +C 03170104 +C FORMAT STATEMENTS FOR TEST RESULTS 03180104 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03190104 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03200104 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03210104 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03220104 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03230104 +C 03240104 +90007 FORMAT (" ",20X,"END OF PROGRAM FM104" ) 03250104 + END 03260104 diff --git a/Fortran/UnitTests/fcvs21_f95/FM104.reference_output b/Fortran/UnitTests/fcvs21_f95/FM104.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM104.reference_output @@ -0,0 +1,33 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + FILE I06 CREATED WITH 28 SEQUENTIAL RECORDS + 87 PASS + 88 PASS + 89 PASS + 90 PASS + 91 PASS + 92 PASS + 93 PASS + 94 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM104 + + 0 ERRORS ENCOUNTERED + 8 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM105.f b/Fortran/UnitTests/fcvs21_f95/FM105.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM105.f @@ -0,0 +1,335 @@ + PROGRAM FM105 + +C COMMENT SECTION. 00010105 +C 00020105 +C FM105 00030105 +C 00040105 +C FM105 TESTS REPEATED ( ) FORMAT FIELDS AND IS TAPE AND PRINTER00050105 +C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060105 +C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070105 +C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR 00080105 +C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090105 +C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100105 +C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110105 +C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120105 +C INTEGER ARRAY FOR THE DUMP SECTION. 00130105 +C 00140105 +C ROUTINE FM105 IS EXACTLY LIKE ROUTINE FM104 EXCEPT THAT 00150105 +C FORMAT NUMBERS 77751 AND 77752 HAVE BEEN CHANGED TO USE THREE (3) 00160105 +C REPEATED FIELDS, I.E. ... 3(/ ... ) THIS SHOULD STILL 00170105 +C MAKE THE ROUTINE WRITE AND THEN READ FOUR (4) 80 CHARACTER 00180105 +C RECORDS FOR EACH SINGLE WRITE OR READ STATEMENT. OTHER FORMAT 00190105 +C CONVERSIONS USED ARE THE X AND I FORMAT FIELDS. BECAUSE OF THE 00200105 +C NUMBER OF CHARACTERS TO BE WRITTEN OR READ IN EACH SET OF FOUR 00210105 +C RECORDS, THE ENTIRE REPEATED FIELD IS USED. 00220105 +C 00230105 +C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00240105 +C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY RECORD IS READ AND 00250105 +C CHECKED DURING THE READ TEST SECTION FOR VALUES OF DATA ITEMS 00260105 +C AND THE END OF FILE ON THE LAST RECORD IS ALSO CHECKED. 00270105 +C 00280105 +C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00290105 +C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00300105 +C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00310105 +C OF THE CONTINUATION LINE. 00320105 +C 00330105 +C REFERENCES 00340105 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00350105 +C X3.9-1978 00360105 +C 00370105 +C SECTION 8, SPECIFICATION STATEMENTS 00380105 +C SECTION 9, DATA STATEMENT 00390105 +C SECTION 11.10, DO STATEMENT 00400105 +C SECTION 12, INPUT/OUTPUT STATEMENTS 00410105 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00420105 +C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00430105 +C SECTION 13, FORMAT STATEMENT 00440105 +C SECTION 13.2.1, EDIT DESCRIPTORS 00450105 +C SECTION 13.5.9.1, INTEGER EDITING 00460105 +C 00470105 +C 00480105 + DIMENSION IPREM(7), IADN11(57) 00490105 + DIMENSION IDUMP(136) 00500105 + CHARACTER*1 NINE,IZERO,IDUMP 00510105 + DATA NINE/'9'/, IZERO/'0'/ 00520105 +C 00530105 +77701 FORMAT ( 80A1 ) 00540105 +77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00550105 + 1F ",I3," RECORDS") 00560105 +77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00570105 +77704 FORMAT (10X,"FILE ON LUN " ,I2," TOO LONG MORE THAN " ,I3, " RECOR00580105 + 1DS") 00590105 +77705 FORMAT ( 1X,80A1) 00600105 +77706 FORMAT (10X,"FILE I08 CREATED WITH 28 SEQUENTIAL RECORDS" ) 00610105 +77751 FORMAT ( I3,2(I2),3(I3),I4,57(I1),I3,3(/I3,2(I2),3(I3),I4,57(I1),I00620105 + 13) ) 00630105 +77752 FORMAT ( 7(1X),I3,6(1X),I4,I1,56(1X),I3,3(/7(1X),I3,67(1X),I3) ) 00640105 +C 00650105 +C 00660105 +C ********************************************************** 00670105 +C 00680105 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00690105 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00700105 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00710105 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00720105 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00730105 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00740105 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00750105 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00760105 +C OF EXECUTING THESE TESTS. 00770105 +C 00780105 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00790105 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00800105 +C 00810105 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00820105 +C 00830105 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00840105 +C SOFTWARE STANDARDS VALIDATION GROUP 00850105 +C BUILDING 225 RM A266 00860105 +C GAITHERSBURG, MD 20899 00870105 +C ********************************************************** 00880105 +C 00890105 +C 00900105 +C 00910105 +C INITIALIZATION SECTION 00920105 +C 00930105 +C INITIALIZE CONSTANTS 00940105 +C ************** 00950105 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00960105 + I01 = 5 00970105 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00980105 + I02 = 6 00990105 +C SYSTEM ENVIRONMENT SECTION 01000105 +C 01010105 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 01020105 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01030105 +C (UNIT NUMBER FOR CARD READER). 01040105 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01050105 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01060105 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01070105 +C 01080105 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 01090105 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01100105 +C (UNIT NUMBER FOR PRINTER). 01110105 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01120105 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01130105 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01140105 +C 01150105 + IVPASS=0 01160105 + IVFAIL=0 01170105 + IVDELE=0 01180105 + ICZERO=0 01190105 +C 01200105 +C WRITE PAGE HEADERS 01210105 + WRITE (I02,90000) 01220105 + WRITE (I02,90001) 01230105 + WRITE (I02,90002) 01240105 + WRITE (I02, 90002) 01250105 + WRITE (I02,90003) 01260105 + WRITE (I02,90002) 01270105 + WRITE (I02,90004) 01280105 + WRITE (I02,90002) 01290105 + WRITE (I02,90011) 01300105 + WRITE (I02,90002) 01310105 + WRITE (I02,90002) 01320105 + WRITE (I02,90005) 01330105 + WRITE (I02,90006) 01340105 + WRITE (I02,90002) 01350105 +C 01360105 +C DEFAULT ASSIGNMENT FOR FILE 06 IS I08 = 7 01370105 + I08 = 112 01380105 +CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080 01390105 +CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081 01400105 +C 01410105 +C WRITE SECTION.... 01420105 +C 01430105 +C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS 01440105 +C 80 CHARACTERS PER RECORD, 28 RECORDS LONG, AND CONSISTS OF ONLY 01450105 +C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01460105 +C ROUTINE FM105 AND FOR PURPOSES OF IDENTIFICATION IS FILE 06. 01470105 +C SINCE THIS ROUTINE IS A TEST OF / IN A FORMAT STATEMENT, FOUR (4) 01480105 +C RECORDS ARE ACTUALLY WRITTEN WITH ONE WRITE STATEMENT. ALL FOUR 01490105 +C OF THESE RECORDS WILL HAVE THE SAME RECORD NUMBER IN THE 20 01500105 +C CHARACTER PREAMBLE. THE INTEGER STORED IN CHARACTER POSITIONS 01510105 +C 78 - 80 WILL EQUAL THE RECORD NUMBER PLUS 0, 1, 2, AND 3 FOR 01520105 +C THE FOUR RECORD SET RESPECTIVELY.. THE INTEGER ARRAY ELEMENTS 01530105 +C IN CHARACTER POSITIONS 21-77 WILL CONTAIN THE INTEGER DIGIT 9. 01540105 + IPROG = 105 01550105 + IFILE = 06 01560105 + ILUN = I08 01570105 + ITOTR = 28 01580105 + IRLGN = 80 01590105 + IEOF = 0000 01600105 +C SET THE RECORD PREAMBLE VALUES EXCEPT FOR RECORD NUMBER AND EOF.. 01610105 + IPREM(1) = IPROG 01620105 + IPREM(2) = IFILE 01630105 + IPREM(3) = ILUN 01640105 + IPREM(5) = ITOTR 01650105 + IPREM(6) = IRLGN 01660105 +C SET THE INTEGER ARRAY ELEMENTS TO THE INTEGER DIGIT 9 01670105 + DO 10 I = 1, 57 01680105 + IADN11(I) = 9 01690105 + 10 CONTINUE 01700105 + DO 952 IRNUM = 1, 7 01710105 + IF ( IRNUM .EQ. 7 ) IEOF = 9999 01720105 + IPREM(4) = IRNUM 01730105 + IPREM(7) = IEOF 01740105 + IVON02 = IRNUM 01750105 + IVON03 = IRNUM + 1 01760105 + IVON04 = IRNUM + 2 01770105 + IVON05 = IRNUM + 3 01780105 + WRITE ( I08, 77751 ) IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,IADN101790105 + 11,IVON02,IPREM,IADN11,IVON03,IPREM,IADN11,IVON04,IPREM,IADN11,IVON01800105 + 205 01810105 + 952 CONTINUE 01820105 + WRITE (I02,77706) 01830105 +C 01840105 +C REWIND SECTION 01850105 +C 01860105 + REWIND I08 01870105 +C 01880105 +C READ SECTION.... 01890105 +C 01900105 + IVTNUM = 95 01910105 +C 01920105 +C **** TEST 95 THRU TEST 101 **** 01930105 +C TEST 95 THRU 101 - THESE TESTS CHECK EVERY ONE OF THE 28 RECORDS 01940105 +C CREATED AS FILE I08 FOR THE RECORD NUMBER, CONSTANT DATA ITEMS, 01950105 +C AND THE END OF FILE INDICATOR. 01960105 +C 01970105 + DO 962 IRNUM = 1, 7 01980105 + IVON01 = 0 01990105 +C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 95 - 10102000105 + READ ( I08, 77752 ) IRN01,IEND,IVON06,IVON07,IRN02,IVON08,IRN03,02010105 + 1IVON09,IRN04,IVON10 02020105 +C READ THE FILE I08 - NOTE, FOUR RECORDS ARE READ IN EACH SINGLE 02030105 +C READ STATEMENT AND THE FORMAT IS DIFFERENT THAN THE ONE USED TO 02040105 +C CREATE THE FILE. 02050105 +C 02060105 +C CHECK THE DATA ITEM VALUES .... 02070105 + IF ( IRN01 .EQ. IRNUM ) IVON01 = IVON01 + 1 02080105 +C IRN01 SHOULD EQUAL THE RECORD NUMBER FOR THE SET OF FOUR RECORDS 02090105 +C RECORD NUMBERS GO FROM 1 TO 7 .... 02100105 + IF ( IVON06 .EQ. 9 ) IVON01 = IVON01 + 1 02110105 +C IVON06 IS THE INTEGER ARRAY ELEMENT WHICH SHOULD BE ALWAYS EQUAL 02120105 +C TO THE INTEGER CONSTANT 9 .... 02130105 + IF ( IVON07 .EQ. IRNUM ) IVON01 = IVON01 + 1 02140105 +C IVON07 SHOULD ALWAYS EQUAL THE RECORD NUMBER OF THE FIRST RECORD 02150105 +C IN THE SET OF FOUR RECORDS .... 02160105 + IF ( IRN02 .EQ. IRNUM ) IVON01 = IVON01 + 1 02170105 +C THIS VALUE REMAINS CONSTANT FOR ALL FOUR RECORDS IN THE SET OF 4..02180105 + IF ( IVON08 .EQ. IRNUM + 1 ) IVON01 = IVON01 + 1 02190105 +C IVON08 IS THE 80TH CHARACTER IN THE SECOND RECORD OF THE SET OF 4.02200105 + IF ( IRN03 .EQ. IRNUM ) IVON01 = IVON01 + 1 02210105 +C AGAIN THIS VALUE IS CONSTANT FOR THE SET OF FOUR RECORDS.... 02220105 + IF ( IVON09 .EQ. IRNUM + 2 ) IVON01 = IVON01 + 1 02230105 +C IVON09 IS THE 80TH CHARACTER IN THE THIRD RECORD OF THE SET OF 4. 02240105 + IF ( IRN04 .EQ. IRNUM ) IVON01 = IVON01 + 1 02250105 +C STILL EQUALS THE RECORD NUMBER FOR THE SET OF FOUR RECORDS. 02260105 + IF ( IVON10 .EQ. IRNUM + 3 ) IVON01 = IVON01 + 1 02270105 +C IVON10 IS THE 80TH CHARACTER IN THE FOURTH RECORD OF THE SET OF 4.02280105 + IF ( IVON01 - 9 ) 20960, 10960, 20960 02290105 +C WHEN IVON01 = 9 THEN ALL NINE OF THE DATA ITEMS CHECKED ARE OK...02300105 +10960 IVPASS = IVPASS + 1 02310105 + WRITE (I02,80001) IVTNUM 02320105 + GO TO 971 02330105 +20960 IVFAIL = IVFAIL + 1 02340105 + IVCOMP = IVON01 02350105 + IVCORR = 9 02360105 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02370105 + 971 CONTINUE 02380105 + IVTNUM = IVTNUM + 1 02390105 +C INCREMENT THE TEST NUMBER.... 02400105 + 962 CONTINUE 02410105 + IF ( ICZERO ) 30960, 1021, 30960 02420105 +30960 IVDELE = IVDELE + 1 02430105 + WRITE (I02,80003) IVTNUM 02440105 + 1021 CONTINUE 02450105 + IVTNUM = 102 02460105 +C 02470105 +C **** TEST 102 **** 02480105 +C TEST 102 - THIS TEST CHECKS THE END OF FILE INDICATOR ON THE LAST02490105 +C SET OF 4 RECORDS ( 25,26,27,AND 28 ). 02500105 +C THE VARIABLE IEND IS ACTUALLY IN THE RECORD NUMBERED 25. 02510105 +C 02520105 + IF (ICZERO) 31020, 1020, 31020 02530105 + 1020 CONTINUE 02540105 + IVCOMP = IEND 02550105 + GO TO 41020 02560105 +31020 IVDELE = IVDELE + 1 02570105 + WRITE (I02,80003) IVTNUM 02580105 + IF (ICZERO) 41020, 1031, 41020 02590105 +41020 IF ( IVCOMP - 9999 ) 21020, 11020, 21020 02600105 +11020 IVPASS = IVPASS + 1 02610105 + WRITE (I02,80001) IVTNUM 02620105 + GO TO 1031 02630105 +21020 IVFAIL = IVFAIL + 1 02640105 + IVCORR = 9999 02650105 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02660105 + 1031 CONTINUE 02670105 +C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 06 02680105 +C TO THE LINE PRINTER. 02690105 +CDB** 02700105 +C ILUN = I08 02710105 +C ITOTR = 28 02720105 +C IRLGN = 80 02730105 +C7777 REWIND ILUN 02740105 +C DO 7778 IRNUM = 1, ITOTR 02750105 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02760105 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02770105 +C IF ( IDUMP(20) .EQ. NINE .AND. IDUMP(80) .EQ. IZERO ) GO TO 7779 02780105 +C7778 CONTINUE 02790105 +C GO TO 7782 02800105 +C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 02810105 +C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 02820105 +C GO TO 7784 02830105 +C7781 WRITE (I02,77703) ILUN,ITOTR 02840105 +C GO TO 7784 02850105 +C7782 WRITE (I02,77704) ILUN, ITOTR 02860105 +C DO 7783 I = 1, 5 02870105 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02880105 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02890105 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 02900105 +C7783 CONTINUE 02910105 +C7784 GO TO 99999 02920105 +CDE** 02930105 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 02940105 +99999 CONTINUE 02950105 + WRITE (I02,90002) 02960105 + WRITE (I02,90006) 02970105 + WRITE (I02,90002) 02980105 + WRITE (I02,90002) 02990105 + WRITE (I02,90007) 03000105 + WRITE (I02,90002) 03010105 + WRITE (I02,90008) IVFAIL 03020105 + WRITE (I02,90009) IVPASS 03030105 + WRITE (I02,90010) IVDELE 03040105 +C 03050105 +C 03060105 +C TERMINATE ROUTINE EXECUTION 03070105 + STOP 03080105 +C 03090105 +C FORMAT STATEMENTS FOR PAGE HEADERS 03100105 +90000 FORMAT ("1") 03110105 +90002 FORMAT (" ") 03120105 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03130105 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03140105 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03150105 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03160105 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03170105 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03180105 +C 03190105 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03200105 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03210105 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03220105 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03230105 +C 03240105 +C FORMAT STATEMENTS FOR TEST RESULTS 03250105 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03260105 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03270105 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03280105 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03290105 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03300105 +C 03310105 +90007 FORMAT (" ",20X,"END OF PROGRAM FM105" ) 03320105 + END 03330105 diff --git a/Fortran/UnitTests/fcvs21_f95/FM105.reference_output b/Fortran/UnitTests/fcvs21_f95/FM105.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM105.reference_output @@ -0,0 +1,33 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + FILE I08 CREATED WITH 28 SEQUENTIAL RECORDS + 95 PASS + 96 PASS + 97 PASS + 98 PASS + 99 PASS + 100 PASS + 101 PASS + 102 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM105 + + 0 ERRORS ENCOUNTERED + 8 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM106.f b/Fortran/UnitTests/fcvs21_f95/FM106.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM106.f @@ -0,0 +1,382 @@ + PROGRAM FM106 + +C COMMENT SECTION. 00010106 +C 00020106 +C FM106 00030106 +C 00040106 +C THIS ROUTINE IS A TEST OF THE E FORMAT AND IS TAPE AND PRINTER00050106 +C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060106 +C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070106 +C OUTPUT LISTS ARE REAL VARIABLES AND REAL ARRAY ELEMENTS OR 00080106 +C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090106 +C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100106 +C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110106 +C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120106 +C INTEGER ARRAY FOR THE DUMP SECTION. 00130106 +C 00140106 +C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00150106 +C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS 00160106 +C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS 00170106 +C AND THE END OF FILE ON THE LAST RECORD. 00180106 +C 00190106 +C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00200106 +C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00210106 +C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00220106 +C OF THE CONTINUATION LINE. 00230106 +C 00240106 +C REFERENCES 00250106 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00260106 +C X3.9-1978 00270106 +C 00280106 +C SECTION 8, SPECIFICATION STATEMENTS 00290106 +C SECTION 9, DATA STATEMENT 00300106 +C SECTION 11.10, DO STATEMENT 00310106 +C SECTION 12, INPUT/OUTPUT STATEMENTS 00320106 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00330106 +C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00340106 +C SECTION 13, FORMAT STATEMENT 00350106 +C SECTION 13.2.1, EDIT DESCRIPTORS 00360106 +C 00370106 + DIMENSION ITEST(7), RTEST(20) 00380106 + DIMENSION IDUMP(136) 00390106 + CHARACTER*1 NINE,IDUMP 00400106 + DATA NINE/'9'/ 00410106 +C 00420106 +77701 FORMAT ( 110A1) 00430106 +77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00440106 + 1F ",I3," RECORDS") 00450106 +77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00460106 +77704 FORMAT (10X,"FILE ON LUN " ,I2," TOO LONG MORE THAN " ,I3, " RECOR00470106 + 1DS") 00480106 +77705 FORMAT ( 1X,80A1,3(/ 10X,71A1) ) 00490106 +77706 FORMAT ( 10X, "FILE I09 CREATED WITH 124 SEQUENTIAL RECORDS" ) 00500106 +77751 FORMAT ( I3,2I2,3I3,I4,3X,2E8.1,2X,3E9.2,2X,E10.3/24X,3E10.3,4X,2E00510106 + 111.4,/1X,3E11.4,2X,2E12.5/26X,4E12.5,6X ) 00520106 +C 00530106 +C 00540106 +C ********************************************************** 00550106 +C 00560106 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00570106 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00580106 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00590106 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00600106 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00610106 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00620106 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00630106 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00640106 +C OF EXECUTING THESE TESTS. 00650106 +C 00660106 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00670106 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00680106 +C 00690106 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00700106 +C 00710106 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00720106 +C SOFTWARE STANDARDS VALIDATION GROUP 00730106 +C BUILDING 225 RM A266 00740106 +C GAITHERSBURG, MD 20899 00750106 +C ********************************************************** 00760106 +C 00770106 +C 00780106 +C 00790106 +C INITIALIZATION SECTION 00800106 +C 00810106 +C INITIALIZE CONSTANTS 00820106 +C ************** 00830106 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00840106 + I01 = 5 00850106 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00860106 + I02 = 6 00870106 +C SYSTEM ENVIRONMENT SECTION 00880106 +C 00890106 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00900106 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00910106 +C (UNIT NUMBER FOR CARD READER). 00920106 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00930106 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00940106 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00950106 +C 00960106 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00970106 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00980106 +C (UNIT NUMBER FOR PRINTER). 00990106 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01000106 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01010106 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01020106 +C 01030106 + IVPASS=0 01040106 + IVFAIL=0 01050106 + IVDELE=0 01060106 + ICZERO=0 01070106 +C 01080106 +C WRITE PAGE HEADERS 01090106 + WRITE (I02,90000) 01100106 + WRITE (I02,90001) 01110106 + WRITE (I02,90002) 01120106 + WRITE (I02, 90002) 01130106 + WRITE (I02,90003) 01140106 + WRITE (I02,90002) 01150106 + WRITE (I02,90004) 01160106 + WRITE (I02,90002) 01170106 + WRITE (I02,90011) 01180106 + WRITE (I02,90002) 01190106 + WRITE (I02,90002) 01200106 + WRITE (I02,90005) 01210106 + WRITE (I02,90006) 01220106 + WRITE (I02,90002) 01230106 +C 01240106 +C DEFAULT ASSIGNMENT FOR FILE 07 IS I09 = 7 01250106 + I09 = 99 01260106 +CX090 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-090 01270106 +CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091 01280106 +C 01290106 +C WRITE SECTION.... 01300106 +C 01310106 +C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I09 THAT IS 01320106 +C 80 CHARACTERS PER RECORD, 124 RECORDS AND CONSISTS OF ONLY 01330106 +C REALS ( E FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01340106 +C ROUTINE FM106 AND FOR PURPOSES OF IDENTIFICATION IS FILE 07. 01350106 +C ALL OF THE DATA WITH THE EXCEPTION OF THE 20 CHARACTER INTEGER 01360106 +C PREAMBLE FOR EACH RECORD, IS COMPRISED OF REAL VARIABLES SET BY 01370106 +C REAL ASSIGNMENT STATEMENTS TO VARIOUS REAL CONSTANTS. 01380106 +C 01390106 +C ALL THE THE REAL CONSTANTS USED ARE POSITIVE, I.E. NO SIGN. 01400106 +C 01410106 + IPROG = 106 01420106 + IFILE = 07 01430106 + ILUN = I09 01440106 +C THERE ARE 31 SETS OF FOUR 80 CHARACTER RECORDS EACH.. 01450106 +C EACH WRITE OR READ OF THE FILE HANDLES 4 RECORDS. FOR THE 01460106 +C PURPOSES OF THE OPTIONAL DUMP OF FILE 07, THE TOTAL NUMBER OF 01470106 +C 80 CHARACTER RECORDS IS 4 * 31 = 124 RECORDS. 01480106 + ITOTR = 124 01490106 + IRLGN = 80 01500106 + IEOF = 0000 01510106 +C SET THE REAL VARIABLES USING E - NOTATION.... 01520106 + RCON21 = 0.9E01 01530106 + RCON22 = 0.9E00 01540106 + RCON31 = 0.21E02 01550106 + RCON32 = 0.21E01 01560106 + RCON33 = 0.21E00 01570106 + RCON41 = 0.512E03 01580106 + RCON42 = 0.512E02 01590106 + RCON43 = 0.512E01 01600106 + RCON44 = 0.512E00 01610106 + RCON51 = 0.9995E04 01620106 + RCON52 = 0.9996E03 01630106 + RCON53 = 0.9997E02 01640106 + RCON54 = 0.9998E01 01650106 + RCON55 = 0.9999E00 01660106 + RCON61 = 0.32764E05 01670106 + RCON62 = 0.32765E04 01680106 + RCON63 = 0.32766E03 01690106 + RCON64 = 0.32767E02 01700106 + RCON65 = 0.32768E01 01710106 + RCON66 = 0.32769E00 01720106 + DO 1032 IRNUM = 1, 31 01730106 + IF ( IRNUM .EQ. 31 ) IEOF = 9999 01740106 + WRITE(I09,77751)IPROG,IFILE,ILUN,IRNUM,ITOTR,IRLGN,IEOF,RCON21,RCO01750106 + 1N22,RCON31,RCON32,RCON33,RCON41,RCON42,RCON43,RCON44,RCON51,RCON5201760106 + 2,RCON53,RCON54,RCON55,RCON61,RCON62,RCON63,RCON64,RCON65,RCON66 01770106 + 1032 CONTINUE 01780106 + WRITE (I02,77706) 01790106 +C 01800106 +C REWIND SECTION 01810106 +C 01820106 + REWIND I09 01830106 +C 01840106 +C READ SECTION.... 01850106 +C 01860106 + IVTNUM = 103 01870106 +C 01880106 +C **** TEST 103 THRU TEST 110 **** 01890106 +C TEST 103 THRU 110 - THESE TESTS READ THE SEQUENTIAL FILE 01900106 +C PREVIOUSLY WRITTEN ON LUN I09 AND CHECK THE FIRST AND EVERY FOURTH01910106 +C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND 01920106 +C SEVERAL VALUES WHICH SHOULD REMAIN CONSTANT FOR ALL OF THE 31 01930106 +C SETS OF 4 RECORDS. 01940106 +C 01950106 + IRTST = 1 01960106 + READ ( I09, 77751) ITEST, RTEST 01970106 +C READ THE FIRST RECORD.... 01980106 + DO 1034 I = 1, 8 01990106 + IVON01 = 0 02000106 +C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 1 THRU 802010106 + IF ( ITEST(4) .EQ. IRTST ) IVON01 = IVON01 + 1 02020106 +C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER.... 02030106 +C THE ERROR TOLERANCE IS BASED ON A SIXTEEN BIT MANTISSA AND 02040106 +C PROVIDES SOME ALLOWANCE FOR THE IMPLEMENTORS INPUT, OUTPUT, AND 02050106 +C STORAGE OF REAL NUMBERS.... 02060106 + IF(RTEST(1) .GE. 8.9995 .OR. RTEST(1) .LE. 9.0005) IVON01=IVON01+102070106 +C THE ELEMENT(1) SHOULD EQUAL RCON21 = 9. .... 02080106 + IF(RTEST(4) .GE. 2.0995 .OR. RTEST(4) .LE. 2.1005) IVON01=IVON01+102090106 +C THE ELEMENT( 4) SHOULD EQUAL RCON32 = 2.1 .... 02100106 + IF(RTEST(9) .GE. .51195 .OR. RTEST(9) .LE. .51205) IVON01=IVON01+102110106 +C THE ELEMENT( 9) SHOULD EQUAL RCON44 = .512 .... 02120106 + IF ( RTEST(13) .GE. 9.9975 .OR. RTEST(13) .LE. 9.9985 ) 02130106 + 1 IVON01 = IVON01 + 1 02140106 +C THE ELEMENT(13) SHOULD EQUAL RCON54 = 9.998 .... 02150106 + IF ( RTEST(20) .GE. .32764 .OR. RTEST(20) .LE. .32774 ) 02160106 + 1 IVON01 = IVON01 + 1 02170106 +C THE ELEMENT(20) SHOULD EQUAL RCON66 = .32769 .... 02180106 + IF ( IVON01 - 6 ) 21030, 11030, 21030 02190106 +C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE 02200106 +C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 02210106 +C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 02220106 +11030 IVPASS = IVPASS + 1 02230106 + WRITE (I02,80001) IVTNUM 02240106 + GO TO 1041 02250106 +21030 IVFAIL = IVFAIL + 1 02260106 + IVCOMP = IVON01 02270106 + IVCORR = 6 02280106 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02290106 + 1041 CONTINUE 02300106 + IVTNUM = IVTNUM + 1 02310106 +C INCREMENT THE TEST NUMBER.... 02320106 + IF ( IVTNUM .EQ. 111 ) GO TO 1035 02330106 +C TAPE SHOULD BE AT RECORD NUMBER 29 FOR TEST 110 - DO NOT READ MORE02340106 +C UNTIL TEST NUMBER 111 WHICH CHECKS RECORD NUMBER 30.... 02350106 + DO 1033 J = 1, 4 02360106 + READ ( I09, 77751 ) ITEST, RTEST 02370106 +C READ FOUR SETS OF RECORDS ON LUN I09.... 02380106 + 1033 CONTINUE 02390106 + IRTST = IRTST + 4 02400106 +C INCREMENT THE RECORD NUMBER COUNTER.... 02410106 + 1034 CONTINUE 02420106 + IF ( ICZERO ) 31030, 1035, 31030 02430106 +31030 IVDELE = IVDELE + 1 02440106 + WRITE (I02,80003) IVTNUM 02450106 + 1035 CONTINUE 02460106 + IVTNUM = 111 02470106 +C 02480106 +C **** TEST 111 **** 02490106 +C TEST 111 - THIS CHECKS THE RECORD NUMBER ON EXPECTED RECORD 02500106 +C SET 30.... 02510106 +C 02520106 + IF (ICZERO) 31110, 1110, 31110 02530106 + 1110 CONTINUE 02540106 + READ ( I09, 77751 ) ITEST, RTEST 02550106 + IVCOMP = ITEST(4) 02560106 + GO TO 41110 02570106 +31110 IVDELE = IVDELE + 1 02580106 + WRITE (I02,80003) IVTNUM 02590106 + IF (ICZERO) 41110, 1121, 41110 02600106 +41110 IF ( IVCOMP - 30 ) 21110, 11110, 21110 02610106 +11110 IVPASS = IVPASS + 1 02620106 + WRITE (I02,80001) IVTNUM 02630106 + GO TO 1121 02640106 +21110 IVFAIL = IVFAIL + 1 02650106 + IVCORR = 30 02660106 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02670106 + 1121 CONTINUE 02680106 + IVTNUM = 112 02690106 +C 02700106 +C **** TEST 112 **** 02710106 +C TEST 112 - THIS CHECKS THE RECORD NUMBER ON RECORD SET 31. 02720106 +C 02730106 + IF (ICZERO) 31120, 1120, 31120 02740106 + 1120 CONTINUE 02750106 + READ ( I09, 77751 ) ITEST, RTEST 02760106 + IVCOMP = ITEST(4) 02770106 + GO TO 41120 02780106 +31120 IVDELE = IVDELE + 1 02790106 + WRITE (I02,80003) IVTNUM 02800106 + IF (ICZERO) 41120, 1131, 41120 02810106 +41120 IF ( IVCOMP - 31 ) 21120, 11120, 21120 02820106 +11120 IVPASS = IVPASS + 1 02830106 + WRITE (I02,80001) IVTNUM 02840106 + GO TO 1131 02850106 +21120 IVFAIL = IVFAIL + 1 02860106 + IVCORR = 31 02870106 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02880106 + 1131 CONTINUE 02890106 + IVTNUM = 113 02900106 +C 02910106 +C **** TEST 113 **** 02920106 +C TEST 113 - THIS CHECKS THE END OF FILE INDICATOR ON RECORD SET 02930106 +C NUMBER 31. 02940106 +C 02950106 +C 02960106 + IF (ICZERO) 31130, 1130, 31130 02970106 + 1130 CONTINUE 02980106 + IVCOMP = ITEST(7) 02990106 + GO TO 41130 03000106 +31130 IVDELE = IVDELE + 1 03010106 + WRITE (I02,80003) IVTNUM 03020106 + IF (ICZERO) 41130, 1141, 41130 03030106 +41130 IF ( IVCOMP - 9999 ) 21130, 11130, 21130 03040106 +11130 IVPASS = IVPASS + 1 03050106 + WRITE (I02,80001) IVTNUM 03060106 + GO TO 1141 03070106 +21130 IVFAIL = IVFAIL + 1 03080106 + IVCORR = 9999 03090106 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03100106 + 1141 CONTINUE 03110106 +C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 07 03120106 +C TO THE LINE PRINTER. 03130106 +CDB** 03140106 +C ILUN = I09 03150106 +C ITOTR = 124 03160106 +C IRLGN = 80 03170106 +C7777 REWIND ILUN 03180106 +C IENDC = 0 03190106 +C IRCNT = 0 03200106 +C DO 7778 IRNUM = 1, ITOTR 03210106 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03220106 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03230106 +C IRCNT = IRCNT + 1 03240106 +C IF ( IDUMP(20) .EQ. NINE ) IENDC = IRNUM 03250106 +C7778 CONTINUE 03260106 +C IF ( IENDC - 121 ) 7780,7779,7782 03270106 +C7779 IF ( IRCNT - ITOTR ) 7780, 7781, 7782 03280106 +C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 03290106 +C GO TO 7784 03300106 +C7781 WRITE (I02,77703) ILUN,ITOTR 03310106 +C GO TO 7784 03320106 +C7782 WRITE (I02,77704) ILUN, ITOTR 03330106 +C DO 7783 I = 1, 5 03340106 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03350106 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03360106 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 03370106 +C7783 CONTINUE 03380106 +C7784 GO TO 99999 03390106 +CDE** 03400106 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03410106 +99999 CONTINUE 03420106 + WRITE (I02,90002) 03430106 + WRITE (I02,90006) 03440106 + WRITE (I02,90002) 03450106 + WRITE (I02,90002) 03460106 + WRITE (I02,90007) 03470106 + WRITE (I02,90002) 03480106 + WRITE (I02,90008) IVFAIL 03490106 + WRITE (I02,90009) IVPASS 03500106 + WRITE (I02,90010) IVDELE 03510106 +C 03520106 +C 03530106 +C TERMINATE ROUTINE EXECUTION 03540106 + STOP 03550106 +C 03560106 +C FORMAT STATEMENTS FOR PAGE HEADERS 03570106 +90000 FORMAT ("1") 03580106 +90002 FORMAT (" ") 03590106 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03600106 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03610106 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03620106 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03630106 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03640106 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03650106 +C 03660106 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03670106 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03680106 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03690106 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03700106 +C 03710106 +C FORMAT STATEMENTS FOR TEST RESULTS 03720106 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03730106 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03740106 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03750106 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03760106 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03770106 +C 03780106 +90007 FORMAT (" ",20X,"END OF PROGRAM FM106" ) 03790106 + END 03800106 diff --git a/Fortran/UnitTests/fcvs21_f95/FM106.reference_output b/Fortran/UnitTests/fcvs21_f95/FM106.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM106.reference_output @@ -0,0 +1,36 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + FILE I09 CREATED WITH 124 SEQUENTIAL RECORDS + 103 PASS + 104 PASS + 105 PASS + 106 PASS + 107 PASS + 108 PASS + 109 PASS + 110 PASS + 111 PASS + 112 PASS + 113 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM106 + + 0 ERRORS ENCOUNTERED + 11 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM107.f b/Fortran/UnitTests/fcvs21_f95/FM107.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM107.f @@ -0,0 +1,380 @@ + PROGRAM FM107 + +C COMMENT SECTION. 00010107 +C 00020107 +C FM107 00030107 +C 00040107 +C THIS ROUTINE IS A TEST OF THE I FORMAT AND IS TAPE AND PRINTER00050107 +C ORIENTED. THE ROUTINE CAN ALSO BE USED FOR DISK. BOTH THE READ 00060107 +C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070107 +C OUTPUT LISTS ARE INTEGER VARIABLE AND INTEGER ARRAY ELEMENT OR 00080107 +C ARRAY NAME REFERENCES. ALL READ AND WRITE STATEMENTS ARE DONE 00090107 +C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100107 +C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110107 +C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120107 +C INTEGER ARRAY FOR THE DUMP SECTION. 00130107 +C 00140107 +C THE MAJOR PURPOSE OF THIS ROUTINE IS TO TEST WHETHER THE LAST 00150107 +C SET OF PARENTHESES WILL BE REPEATED IN A FORMAT STATEMENT IF THE 00160107 +C NUMBER OF DATA ITEMS IN THE INPUT/OUTPUT LIST IS GREATER THAN THE 00170107 +C NUMBER OF FIELD SPECIFICATIONS WITHIN THE FORMAT STATEMENT. 00180107 +C IN ADDITION THE USE OF TWO AND THREE DIMENSIONED ARRAYS IS TESTED 00190107 +C IN THE IMPLIED-DO LISTS IN BOTH THE WRITE AND READ SECTIONS. 00200107 +C 00210107 +C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00220107 +C REWOUND AND READ SEQUENTIALLY FORWARD. EVERY FOURTH RECORD IS 00230107 +C CHECKED DURING THE READ TEST SECTION PLUS THE LAST TWO RECORDS 00240107 +C AND THE END OF FILE ON THE LAST RECORD. 00250107 +C 00260107 +C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00270107 +C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00280107 +C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00290107 +C OF THE CONTINUATION LINE. 00300107 +C 00310107 +C REFERENCES 00320107 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00330107 +C X3.9-1978 00340107 +C 00350107 +C SECTION 8, SPECIFICATION STATEMENTS 00360107 +C SECTION 9, DATA STATEMENT 00370107 +C SECTION 11.10, DO STATEMENT 00380107 +C SECTION 12, INPUT/OUTPUT STATEMENTS 00390107 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00400107 +C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00410107 +C SECTION 13, FORMAT STATEMENT 00420107 +C SECTION 13.2.1, EDIT DESCRIPTORS 00430107 +C 00440107 + DIMENSION IADN21(31,20), IADN31(31,10,2) 00450107 + DIMENSION ITEST(27) 00460107 + DIMENSION IDUMP(136) 00470107 + CHARACTER*1 NINE,IDUMP 00480107 + DATA NINE/'9'/ 00490107 +C 00500107 +77701 FORMAT ( 80A1 ) 00510107 +77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00520107 + 1F ",I3," RECORDS") 00530107 +77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00540107 +77704 FORMAT (10X,"FILE ON LUN " ,I2," NO EOF.. MORE THAN " ,I3, " RECOR00550107 + 1DS") 00560107 +77705 FORMAT ( 1X,80A1) 00570107 +77706 FORMAT (10X,"FILE I06 CREATED WITH 137 SEQUENTIAL RECORDS" ) 00580107 +77751 FORMAT ( I3, 2(1I2), 3(1I3), I4, 10(1I3) ) 00590107 +77752 FORMAT ( I3,2(1I2), 3(1I3), I4, 3(1I3) ) 00600107 +77753 FORMAT ( //////////////// I3,2I2,3I3,I4,10(I3) ) 00610107 +C 00620107 +C 00630107 +C ********************************************************** 00640107 +C 00650107 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00660107 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00670107 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00680107 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00690107 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00700107 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00710107 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00720107 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00730107 +C OF EXECUTING THESE TESTS. 00740107 +C 00750107 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00760107 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00770107 +C 00780107 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00790107 +C 00800107 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00810107 +C SOFTWARE STANDARDS VALIDATION GROUP 00820107 +C BUILDING 225 RM A266 00830107 +C GAITHERSBURG, MD 20899 00840107 +C ********************************************************** 00850107 +C 00860107 +C 00870107 +C 00880107 +C INITIALIZATION SECTION 00890107 +C 00900107 +C INITIALIZE CONSTANTS 00910107 +C ************** 00920107 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00930107 + I01 = 5 00940107 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00950107 + I02 = 6 00960107 +C SYSTEM ENVIRONMENT SECTION 00970107 +C 00980107 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00990107 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01000107 +C (UNIT NUMBER FOR CARD READER). 01010107 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01020107 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01030107 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01040107 +C 01050107 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 01060107 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01070107 +C (UNIT NUMBER FOR PRINTER). 01080107 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01090107 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01100107 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01110107 +C 01120107 + IVPASS=0 01130107 + IVFAIL=0 01140107 + IVDELE=0 01150107 + ICZERO=0 01160107 +C 01170107 +C WRITE PAGE HEADERS 01180107 + WRITE (I02,90000) 01190107 + WRITE (I02,90001) 01200107 + WRITE (I02,90002) 01210107 + WRITE (I02, 90002) 01220107 + WRITE (I02,90003) 01230107 + WRITE (I02,90002) 01240107 + WRITE (I02,90004) 01250107 + WRITE (I02,90002) 01260107 + WRITE (I02,90011) 01270107 + WRITE (I02,90002) 01280107 + WRITE (I02,90002) 01290107 + WRITE (I02,90005) 01300107 + WRITE (I02,90006) 01310107 + WRITE (I02,90002) 01320107 +C 01330107 +C DEFAULT ASSIGNMENT FOR FILE 08 IS I06 = 7 01340107 + I06 = 7 01350107 +CX060 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-060 01360107 +CX061 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-061 01370107 +C 01380107 +C WRITE SECTION.... 01390107 +C 01400107 +C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I06 THAT IS 01410107 +C 80 CHARACTERS PER RECORD, 31 RECORDS SETS, AND CONSISTS OF ONLY 01420107 +C INTEGERS ( I FORMAT ). THIS IS THE ONLY FILE TESTED IN THE 01430107 +C ROUTINE FM107 AND FOR PURPOSES OF IDENTIFICATION IS FILE 08. 01440107 + IPROG = 107 01450107 + IFILE = 08 01460107 + ILUN = I06 01470107 + ITOTR = 137 01480107 + IRLGN = 80 01490107 + IEOF = 0000 01500107 +C THESE DO-LOOPS ARE TO SET THE VALUES INTO THE TWO AND THREE 01510107 +C DIMENSIONED ARRAYS FOR THE I/O LISTS.... 01520107 + DO 1143 IRNUM = 1, 31 01530107 + DO 1142 J = 1, 20 01540107 + IADN21(IRNUM,J) = IRNUM + J + 99 01550107 + 1142 CONTINUE 01560107 + 1143 CONTINUE 01570107 +C 01580107 + DO 1146 IRNUM = 1, 31 01590107 + DO 1145 J = 1, 10 01600107 + DO 1144 K = 1, 2 01610107 + IADN31(IRNUM,J,K) = IRNUM + J + K + 298 01620107 + 1144 CONTINUE 01630107 + 1145 CONTINUE 01640107 + 1146 CONTINUE 01650107 + IFLIP = 1 01660107 + DO 1149 IRNUM = 1, 31 01670107 + IF ( IRNUM .EQ. 31 ) IEOF = 9999 01680107 + IF ( IFLIP - 1 ) 1147, 1147, 1148 01690107 + 1147 WRITE ( I06, 77751 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF01700107 + 1,(IADN21(IRNUM,J), J = 1, 20) 01710107 + IFLIP = 2 01720107 + GO TO 1149 01730107 + 1148 WRITE ( I06, 77752 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF01740107 + 1,((IADN31(IRNUM,J,K), K = 1, 2), J = 1, 10) 01750107 + IFLIP = 1 01760107 + 1149 CONTINUE 01770107 + WRITE (I02,77706) 01780107 +C 01790107 +C REWIND SECTION 01800107 +C 01810107 + REWIND I06 01820107 +C 01830107 +C READ SECTION.... 01840107 +C 01850107 + IVTNUM = 114 01860107 +C 01870107 +C **** TEST 114 THRU TEST 121 **** 01880107 +C TEST 114 THRU 121 - THESE TESTS READ THE SEQUENTIAL FILE 01890107 +C PREVIOUSLY WRITTEN ON LUN I06 AND CHECK THE FIRST AND EVERY FOURTH01900107 +C RECORD. THE VALUES CHECKED ARE THE RECORD NUMBER - IRNUM AND 01910107 +C SEVERAL VALUES IN THE INTEGER ARRAY WHICH SHOULD FOLLOW A 01920107 +C CALCULATED PATTERN WITH RESPECT TO THE SUBSCRIPTS AND THE RECORD 01930107 +C NUMBER.... 01940107 +C 01950107 + IRNUM = 1 01960107 + READ(I06,77751) ITEST 01970107 +C READ THE FIRST RECORD.... 01980107 + DO 1212 I = 1, 8 01990107 + IVON01 = 0 02000107 +C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 02010107 + IF ( ITEST(4) .EQ. IRNUM ) IVON01 = IVON01 + 1 02020107 +C THE ELEMENT (4) SHOULD EQUAL THE RECORD NUMBER.... 02030107 +C THE FOLLOWING TESTS ARE FOR ODD NUMBERED RECORDS 02040107 + IF ( ITEST(8) .EQ. IADN21(IRNUM,1) ) IVON01 = IVON01 + 1 02050107 +C ELEMENT (8) SHOULD EQUAL IRNUM + 100 .... 02060107 + IF ( ITEST(12) .EQ. IADN21(IRNUM,5) ) IVON01 = IVON01 + 1 02070107 +C ELEMENT (12) SHOULD EQUAL IRNUM + 104 .... 02080107 + IF ( ITEST(16) .EQ. IADN21(IRNUM,9) ) IVON01 = IVON01 + 1 02090107 +C ELEMENT (16) SHOULD EQUAL IRNUM + 108 .... 02100107 + IF ( ITEST(20) .EQ. IADN21(IRNUM,13) ) IVON01 = IVON01 + 1 02110107 +C ELEMENT (20) SHOULD EQUAL IRNUM + 112 .... 02120107 + IF ( ITEST(27) .EQ. IADN21(IRNUM,20) ) IVON01 = IVON01 + 1 02130107 +C ELEMENT (27) SHOULD EQUAL IRNUM + 119 .... 02140107 +C WHEN IVON01 = 6 THEN ALL SIX OF THE ITEST ELEMENTS THAT WERE 02150107 +C CHECKED HAD THE EXPECTED VALUES.... IF IVON01 DOES NOT EQUAL 6 02160107 +C THEN AT LEAST ONE OF THE VALUES WAS INCORRECT.... 02170107 +41200 IF ( IVON01 - 6 ) 21200, 11200, 21200 02180107 +11200 IVPASS = IVPASS + 1 02190107 + WRITE (I02,80001) IVTNUM 02200107 + GO TO 1210 02210107 +21200 IVFAIL = IVFAIL + 1 02220107 + IVCOMP = IVON01 02230107 + IVCORR = 6 02240107 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02250107 + 1210 CONTINUE 02260107 + IVTNUM = IVTNUM + 1 02270107 +C INCREMENT THE TEST NUMBER.... 02280107 +C 02290107 + IF ( I .EQ. 8 ) GO TO 1221 02300107 +C THIS CODE IS TO SKIP READING PAST THE END OF FILE BY NOT READING 02310107 +C FOUR RECORDS PAST RECORD NUMBER 29 ON THE 8TH LOOP.... 02320107 +C 02330107 + READ ( I06,77753 ) ITEST 02340107 +C READ FOUR RECORDS ON LUN I06.... 02350107 + IRNUM = IRNUM + 4 02360107 +C INCREMENT THE RECORD NUMBER COUNTER.... 02370107 + 1212 CONTINUE 02380107 + IF ( ICZERO ) 31200, 1221, 31200 02390107 +31200 IVDELE = IVDELE + 1 02400107 + WRITE (I02,80003) IVTNUM 02410107 + 1221 CONTINUE 02420107 + IVTNUM = 122 02430107 +C 02440107 +C **** TEST 122 **** 02450107 +C TEST 122 - THIS CHECKS THE VALUE OF THE VARIABLE ITEST(27) 02460107 +C ON RECORD NUMBER 30. ELEMENT (20) SHOULD EQUAL IADN31(30,2,10) 02470107 +C WHICH SHOULD BE EQUAL TO 340 .... 02480107 +C 02490107 + IF (ICZERO) 31220, 1220, 31220 02500107 + 1220 CONTINUE 02510107 + READ ( I06,77752 ) ITEST 02520107 + IVCOMP = ITEST(27) 02530107 + GO TO 41220 02540107 +31220 IVDELE = IVDELE + 1 02550107 + WRITE (I02,80003) IVTNUM 02560107 + IF (ICZERO) 41220, 1231, 41220 02570107 +41220 IF ( IVCOMP - 340 ) 21220, 11220, 21220 02580107 +11220 IVPASS = IVPASS + 1 02590107 + WRITE (I02,80001) IVTNUM 02600107 + GO TO 1231 02610107 +21220 IVFAIL = IVFAIL + 1 02620107 + IVCORR = 340 02630107 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02640107 + 1231 CONTINUE 02650107 + IVTNUM = 123 02660107 +C 02670107 +C **** TEST 123 **** 02680107 +C TEST 123 - THIS CHECKS THE VALUE OF VARIABLE ITEST(27) ON 02690107 +C RECORD NUMBER 31 WHICH SHOULD EQUAL IADN21(31,20) = 31 + 20 + 99 02700107 +C ITEST(27) SHOULD EQUAL 150 .... 02710107 +C 02720107 + IF (ICZERO) 31230, 1230, 31230 02730107 + 1230 CONTINUE 02740107 + READ ( I06,77751) ITEST 02750107 + IVCOMP = ITEST(27) 02760107 + GO TO 41230 02770107 +31230 IVDELE = IVDELE + 1 02780107 + WRITE (I02,80003) IVTNUM 02790107 + IF (ICZERO) 41230, 1241, 41230 02800107 +41230 IF ( IVCOMP - 150 ) 21230, 11230, 21230 02810107 +11230 IVPASS = IVPASS + 1 02820107 + WRITE (I02,80001) IVTNUM 02830107 + GO TO 1241 02840107 +21230 IVFAIL = IVFAIL + 1 02850107 + IVCORR = 150 02860107 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02870107 + 1241 CONTINUE 02880107 + IVTNUM = 124 02890107 +C 02900107 +C **** TEST 124 **** 02910107 +C TEST 124 - THIS CHECKS FOR THE PROPER 9999 EOF INDICATOR ON 02920107 +C RECORD NUMBER 31 .... 02930107 +C 02940107 + IF (ICZERO) 31240, 1240, 31240 02950107 + 1240 CONTINUE 02960107 + IVCOMP = ITEST(7) 02970107 + GO TO 41240 02980107 +31240 IVDELE = IVDELE + 1 02990107 + WRITE (I02,80003) IVTNUM 03000107 + IF (ICZERO) 41240, 1251, 41240 03010107 +41240 IF ( IVCOMP - 9999 ) 21240, 11240, 21240 03020107 +11240 IVPASS = IVPASS + 1 03030107 + WRITE (I02,80001) IVTNUM 03040107 + GO TO 1251 03050107 +21240 IVFAIL = IVFAIL + 1 03060107 + IVCORR = 9999 03070107 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 03080107 + 1251 CONTINUE 03090107 +C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 08 03100107 +C TO THE LINE PRINTER. 03110107 +CDB** 03120107 +C ILUN = I06 03130107 +C ITOTR = 137 03140107 +C IRLGN = 80 03150107 +C7777 REWIND ILUN 03160107 +C IENDC = 0 03170107 +C IRCNT = 0 03180107 +C DO 7778 IRNUM = 1, ITOTR 03190107 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03200107 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03210107 +C IRCNT = IRCNT + 1 03220107 +C IF ( IDUMP(20) .EQ. NINE ) IENDC = IRNUM 03230107 +C7778 CONTINUE 03240107 +C IF ( IENDC - 136 ) 7780, 7779, 7782 03250107 +C7779 IF ( IRCNT - ITOTR ) 7780, 7781, 7782 03260107 +C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 03270107 +C GO TO 7784 03280107 +C7781 WRITE (I02,77703) ILUN,ITOTR 03290107 +C GO TO 7784 03300107 +C7782 WRITE (I02,77704) ILUN, ITOTR 03310107 +C DO 7783 I = 1, 5 03320107 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03330107 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03340107 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 03350107 +C7783 CONTINUE 03360107 +C7784 GO TO 99999 03370107 +CDE** 03380107 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03390107 +99999 CONTINUE 03400107 + WRITE (I02,90002) 03410107 + WRITE (I02,90006) 03420107 + WRITE (I02,90002) 03430107 + WRITE (I02,90002) 03440107 + WRITE (I02,90007) 03450107 + WRITE (I02,90002) 03460107 + WRITE (I02,90008) IVFAIL 03470107 + WRITE (I02,90009) IVPASS 03480107 + WRITE (I02,90010) IVDELE 03490107 +C 03500107 +C 03510107 +C TERMINATE ROUTINE EXECUTION 03520107 + STOP 03530107 +C 03540107 +C FORMAT STATEMENTS FOR PAGE HEADERS 03550107 +90000 FORMAT ("1") 03560107 +90002 FORMAT (" ") 03570107 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03580107 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03590107 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03600107 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03610107 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03620107 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03630107 +C 03640107 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03650107 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03660107 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03670107 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03680107 +C 03690107 +C FORMAT STATEMENTS FOR TEST RESULTS 03700107 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03710107 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03720107 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03730107 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03740107 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03750107 +C 03760107 +90007 FORMAT (" ",20X,"END OF PROGRAM FM107" ) 03770107 + END 03780107 diff --git a/Fortran/UnitTests/fcvs21_f95/FM107.reference_output b/Fortran/UnitTests/fcvs21_f95/FM107.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM107.reference_output @@ -0,0 +1,36 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + FILE I06 CREATED WITH 137 SEQUENTIAL RECORDS + 114 PASS + 115 PASS + 116 PASS + 117 PASS + 118 PASS + 119 PASS + 120 PASS + 121 PASS + 122 PASS + 123 PASS + 124 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM107 + + 0 ERRORS ENCOUNTERED + 11 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM108.f b/Fortran/UnitTests/fcvs21_f95/FM108.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM108.f @@ -0,0 +1,356 @@ + PROGRAM FM108 + +C COMMENT SECTION. 00010108 +C 00020108 +C FM108 00030108 +C 00040108 +C THIS ROUTINE IS A TEST OF THE X FORMAT AND IS TAPE AND PRINTER00050108 +C ORIENTED. THE ROUTINE CAN NOT BE USED FOR DISK. BOTH THE READ 00060108 +C AND WRITE STATEMENTS ARE TESTED. VARIABLES IN THE INPUT AND 00070108 +C OUTPUT LISTS ARE INTEGER OR REAL VARIABLES, INTEGER ARRAY ELEMENTS00080108 +C OR ARRAY NAME REFERENCES. READ AND WRITE STATEMENTS ARE DONE 00090108 +C WITH FORMAT STATEMENTS. THE ROUTINE HAS AN OPTIONAL SECTION OF 00100108 +C CODE TO DUMP THE FILE AFTER IT HAS BEEN WRITTEN. DO LOOPS AND 00110108 +C DO-IMPLIED LISTS ARE USED IN CONJUNCTION WITH A ONE DIMENSIONAL 00120108 +C INTEGER ARRAY FOR THE DUMP SECTION. 00130108 +C 00140108 +C WITH THE EXCEPTION OF THE RECORD PREAMBLES ON EACH RECORD, 00150108 +C ALL OF THE I, F, AND A-FIELDS HAVE A MINUS SIGN IN THE LEFTMOST 00160108 +C CHARACTER POSITION OF EACH FIELD. 00170108 +C 00180108 +C THIS ROUTINE WRITES A SINGLE SEQUENTIAL FILE WHICH IS 00190108 +C REWOUND AND READ SEQUENTIALLY FORWARD AND THEN READ SEQUENTIALLY 00200108 +C BACKWARD BY USING THE BACKSPACE COMMAND. THE FORWARD READ IS 00210108 +C USED TO CHECK ALL OF THE ODD RECORDS AND THE READ REVERSE IN 00220108 +C EFFECT CHECKS THE EVEN NUMBERED RECORDS. THE ENDFILE COMMAND IS 00230108 +C ALSO USED AFTER THE WRITE SECTION BUT BECAUSE THE RESULT OF 00240108 +C ATTEMPTING TO READ OR READ BEYOND THE ENDFILE MARK IS NOT POSSIBLE00250108 +C TO PREDICT FOR ALL MACHINES, THE ENDFILE MARK IS NEVER ACTUALLY 00260108 +C READ. 00270108 +C 00280108 +C THE LINE CONTINUATION IN COLUMN 6 IS USED IN READ, WRITE, 00290108 +C AND FORMAT STATEMENTS. FOR BOTH SYNTAX AND SEMANTIC TESTS, ALL 00300108 +C STATEMENTS SHOULD BE CHECKED VISUALLY FOR THE PROPER FUNCTIONING 00310108 +C OF THE CONTINUATION LINE. 00320108 +C 00330108 +C 00340108 +C REFERENCES 00350108 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00360108 +C X3.9-1978 00370108 +C 00380108 +C SECTION 8, SPECIFICATION STATEMENTS 00390108 +C SECTION 9, DATA STATEMENT 00400108 +C SECTION 11.10, DO STATEMENT 00410108 +C SECTION 12, INPUT/OUTPUT STATEMENTS 00420108 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00430108 +C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00440108 +C SECTION 13, FORMAT STATEMENT 00450108 +C SECTION 13.2.1, EDIT DESCRIPTORS 00460108 +C 00470108 + DIMENSION IDUMP(136) 00480108 + DIMENSION IADN11(5), IADN12(3), IADN13(3) 00490108 + CHARACTER*1 NINE,IADN11,ICON04,IDUMP 00500108 + CHARACTER*2 IADN12,ICON06 00510108 + CHARACTER*3 IADN13 00520108 + DATA NINE/'9'/ 00530108 + DATA IADN11/'-', 'W', 'H', 'E', 'E'/, IADN12/'-H', 'EL', 'L'/, 00540108 + 1IADN13/'-', 'HE', 'LL'/ 00550108 +C 00560108 +77701 FORMAT ( 80A1 ) 00570108 +77702 FORMAT (10X,"PREMATURE EOF ONLY " ,I3," RECORDS LUN " ,I2, " OUT O00580108 + 1F ",I3," RECORDS") 00590108 +77703 FORMAT (10X,"FILE ON LUN " ,I2," OK... ",I3," RECORDS") 00600108 +77704 FORMAT (10X,"FILE ON LUN " ,I2," NO EOF.. MORE THAN " ,I3, " RECOR00610108 + 1DS") 00620108 +77705 FORMAT ( 1X,80A1) 00630108 +77706 FORMAT (10X,"FILE I08 CREATED WITH 31 SEQUENTIAL RECORDS" ) 00640108 +77751 FORMAT ( I3,2I2,3I3,I4,4X,I6,4X,F6.2,5X,5A1,4X,I6,4X,F6.4,5X,2A2,A00650108 + 11 ) 00660108 +77752 FORMAT ( I3,2I2,3I3,I4,I6,4X,F6.2,4X,5A1,5X,I6,4X,F6.4,4X,A1,2A2,500670108 + 1X ) 00680108 +77753 FORMAT (7X,I3,6X,I4,4X,I6,15X,A1,8X,I6,4X,F6.4,9X,A1 ) 00690108 +77754 FORMAT (7X,I3,6X,I4,I6,14X,A1,9X,I6,4X,F6.4,7X,A2,5X ) 00700108 +C 00710108 +C 00720108 +C ********************************************************** 00730108 +C 00740108 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00750108 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00760108 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00770108 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00780108 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00790108 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00800108 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00810108 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00820108 +C OF EXECUTING THESE TESTS. 00830108 +C 00840108 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00850108 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00860108 +C 00870108 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00880108 +C 00890108 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00900108 +C SOFTWARE STANDARDS VALIDATION GROUP 00910108 +C BUILDING 225 RM A266 00920108 +C GAITHERSBURG, MD 20899 00930108 +C ********************************************************** 00940108 +C 00950108 +C 00960108 +C 00970108 +C INITIALIZATION SECTION 00980108 +C 00990108 +C INITIALIZE CONSTANTS 01000108 +C ************** 01010108 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01020108 + I01 = 5 01030108 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01040108 + I02 = 6 01050108 +C SYSTEM ENVIRONMENT SECTION 01060108 +C 01070108 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 01080108 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01090108 +C (UNIT NUMBER FOR CARD READER). 01100108 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 01110108 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01120108 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01130108 +C 01140108 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 01150108 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01160108 +C (UNIT NUMBER FOR PRINTER). 01170108 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 01180108 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01190108 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01200108 +C 01210108 + IVPASS=0 01220108 + IVFAIL=0 01230108 + IVDELE=0 01240108 + ICZERO=0 01250108 +C 01260108 +C WRITE PAGE HEADERS 01270108 + WRITE (I02,90000) 01280108 + WRITE (I02,90001) 01290108 + WRITE (I02,90002) 01300108 + WRITE (I02, 90002) 01310108 + WRITE (I02,90003) 01320108 + WRITE (I02,90002) 01330108 + WRITE (I02,90004) 01340108 + WRITE (I02,90002) 01350108 + WRITE (I02,90011) 01360108 + WRITE (I02,90002) 01370108 + WRITE (I02,90002) 01380108 + WRITE (I02,90005) 01390108 + WRITE (I02,90006) 01400108 + WRITE (I02,90002) 01410108 +C 01420108 +C DEFAULT ASSIGNMENT FOR FILE 09 IS I08 = 7 01430108 + I08 = 115 01440108 +CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080 01450108 +CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081 01460108 +C 01470108 +C WRITE SECTION.... 01480108 +C 01490108 +C THIS SECTION OF CODE BUILDS A UNIT RECORD FILE ON LUN I08 THAT IS 01500108 +C 80 CHARACTERS PER RECORD, 31 RECORDS LONG, AND CONSISTS OF 01510108 +C I, F, A, AND X FORMAT. THIS IS THE ONLY FILE TESTED IN THE 01520108 +C ROUTINE FM108 AND FOR PURPOSES OF IDENTIFICATION IS FILE 09. 01530108 +C ALL ARRAY ELEMENT DATA FOR THE ALPHANUMERIC CHARACTERS IS SET BY 01540108 +C THE DATA INITIALIZATION STATEMENT. INTEGER AND REAL VARIABLES ARE 01550108 +C SET BY ASSIGNMENT STATEMENTS. 01560108 +C 01570108 + IPROG = 108 01580108 + IFILE = 09 01590108 + ILUN = I08 01600108 + ITOTR = 31 01610108 + IRLGN = 80 01620108 + IEOF = 0000 01630108 + ICON01 = -32766 01640108 + RCON01 = -12.34 01650108 + ICON02 = -12345 01660108 + RCON02 = -.9999 01670108 + IFLIP = 1 01680108 + DO 1254 IRNUM = 1, 31 01690108 + IF ( IRNUM .EQ. 31 ) IEOF = 9999 01700108 + IF ( IFLIP - 1 ) 1252, 1252, 1253 01710108 + 1252 WRITE ( I08, 77751 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF01720108 + 1, ICON01, RCON01, IADN11,ICON02, RCON02, IADN12 01730108 + IFLIP = 2 01740108 + GO TO 1254 01750108 + 1253 WRITE ( I08, 77752 ) IPROG, IFILE, ILUN, IRNUM, ITOTR, IRLGN, IEOF01760108 + 1, ICON01, RCON01, IADN11, ICON02, RCON02, IADN13 01770108 + IFLIP = 1 01780108 + 1254 CONTINUE 01790108 + WRITE (I02,77706) 01800108 +C 01810108 +C ENDFILE SECTION .... 01820108 + ENDFILE I08 01830108 +C 01840108 +C REWIND SECTION 01850108 + REWIND I08 01860108 +C 01870108 +C 01880108 +C READ FORWARD SECTION .... 01890108 +C 01900108 +C 01910108 + IVTNUM = 125 01920108 +C 01930108 +C **** TEST 125 THRU TEST 140 **** 01940108 +C TEST 125 THRU 140 - THESE TESTS CHECK THE ODD NUMBERED RECORDS. 01950108 +C THE FILE 09 IS READ SEQUENTIALLY FORWARD AND THE EVEN NUMBERED 01960108 +C RECORDS ARE SKIPPED BY READING PAST THEM. 01970108 +C 01980108 + DO 1255 IRNUM = 1, 31, 2 01990108 + IVON01 = 0 02000108 +C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 125-140.02010108 + READ ( I08,77753 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 02020108 +C READ AN ODD NUMBERED RECORD.... 02030108 + IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1 02040108 +C IRNO SHOULD BE THE RECORD NUMBER.... 02050108 + IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1 02060108 +C ICON03 SHOULD EQUAL -32766 .... 02070108 + IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1 02080108 +C ICON04 SHOULD EQUAL '-' .... 02090108 + IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1 02100108 +C ICON05 SHOULD EQUAL -12345 .... 02110108 + IF(RCON03.GE. -.99995 .OR. RCON03.LE. -.99985)IVON01=IVON01+1 02120108 +C RCON03 SHOULD EQUAL -.9999 .... 02130108 + IF ( ICON06 .EQ. IADN12(3) ) IVON01 = IVON01 + 1 02140108 +C ICON06 SHOULD EQUAL 'L' .... 02150108 + IF ( IVON01 - 6 ) 21250, 11250, 21250 02160108 +11250 IVPASS = IVPASS + 1 02170108 + WRITE (I02,80001) IVTNUM 02180108 + GO TO 1261 02190108 +21250 IVFAIL = IVFAIL + 1 02200108 + IVCOMP = IVON01 02210108 + IVCORR = 6 02220108 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02230108 + 1261 CONTINUE 02240108 + IF ( IRNUM .EQ. 31 ) GO TO 1255 02250108 +C THIS DOES NOT ALLOW READING THE ENDFILE MARK.... 02260108 + READ ( I08,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 02270108 +C READ PAST THE EVEN NUMBERED RECORD .... 02280108 + IVTNUM = IVTNUM + 1 02290108 +C INCREMENT THE TEST NUMBER.... 02300108 + 1255 CONTINUE 02310108 + IF ( ICZERO ) 31250, 1411, 31250 02320108 +31250 IVDELE = IVDELE + 1 02330108 + WRITE (I02,80003) IVTNUM 02340108 + 1411 CONTINUE 02350108 + IVTNUM = 141 02360108 +C 02370108 +C **** TEST 141 THRU TEST 155 **** 02380108 +C TEST 141 THRU 155 - THESE TESTS USE THE BACKSPACE COMMAND 02390108 +C TO READ REVERSE AND CHECK THE EVEN NUMBERED RECORDS. AT THE 02400108 +C BEGINNING OF THIS SERIES, THE FILE 09 SHOULD BE SETTING AT THE 02410108 +C ENDFILE MARK PAST RECORD NUMBER 31. 02420108 +C 02430108 + BACKSPACE I08 02440108 + BACKSPACE I08 02450108 + IRNUM = 30 02460108 +C THE FILE SHOULD NOW BE SETTING AT RECORD NUMBER 30.... 02470108 + DO 1552 I = 1, 15 02480108 + IVON01 = 0 02490108 +C THE INTEGER VARIABLE IS INITIALIZED TO ZERO FOR EACH TEST 141-155.02500108 + READ ( I08,77754 ) IRNO,IEND,ICON03,ICON04,ICON05,RCON03,ICON06 02510108 +C READ AN EVEN NUMBERED RECORD.... 02520108 + IF ( IRNO .EQ. IRNUM ) IVON01 = IVON01 + 1 02530108 +C IRNO SHOULD BE THE RECORD NUMBER.... 02540108 + IF ( ICON03 .EQ. ICON01 ) IVON01 = IVON01 + 1 02550108 +C ICON03 SHOULD EQUAL -32766 .... 02560108 + IF ( ICON04 .EQ. IADN11(1) ) IVON01 = IVON01 + 1 02570108 +C ICON04 SHOULD EQUAL '-' .... 02580108 + IF ( ICON05 .EQ. ICON02 ) IVON01 = IVON01 + 1 02590108 +C ICON05 SHOULD EQUAL -12345 .... 02600108 + IF(RCON03.GE. -.99995 .OR. RCON03.LE. -.99985)IVON01=IVON01+1 02610108 +C RCON03 SHOULD EQUAL -.9999 .... 02620108 + IF ( ICON06 .EQ. IADN13(3) ) IVON01 = IVON01 + 1 02630108 +C ICON06 SHOULD EQUAL 'LL' .... 02640108 + IF ( IVON01 - 6 ) 21410, 11410, 21410 02650108 +11410 IVPASS = IVPASS + 1 02660108 + WRITE (I02,80001) IVTNUM 02670108 + GO TO 1421 02680108 +21410 IVFAIL = IVFAIL + 1 02690108 + IVCOMP = IVON01 02700108 + IVCORR = 6 02710108 + WRITE (I02,80004) IVTNUM, IVCOMP ,IVCORR 02720108 + 1421 CONTINUE 02730108 +C THIS IS TO NOT ALLOW READING BACKWARDS PAST RECORD NUMBER 1.... 02740108 + IF ( I .EQ. 15 ) GO TO 1552 02750108 +C BACKSPACE TO THE NEXT EVEN RECORD.... 02760108 + BACKSPACE I08 02770108 + BACKSPACE I08 02780108 + BACKSPACE I08 02790108 + IVTNUM = IVTNUM + 1 02800108 +C INCREMENT THE TEST NUMBER.... 02810108 + IRNUM = IRNUM - 2 02820108 +C DECREMENT THE RECORD NUMBER POINTER BY 2 .... 02830108 + 1552 CONTINUE 02840108 + IF ( ICZERO ) 31410, 1561, 31410 02850108 +31410 IVDELE = IVDELE + 1 02860108 + WRITE (I02,80003) IVTNUM 02870108 + 1561 CONTINUE 02880108 +C THIS CODE IS OPTIONALLY COMPILED AND IS USED TO DUMP THE FILE 09 02890108 +C TO THE LINE PRINTER. 02900108 +CDB** 02910108 +C ILUN = I08 02920108 +C ITOTR = 31 02930108 +C IRLGN = 80 02940108 +C7777 REWIND ILUN 02950108 +C DO 7778 IRNUM = 1, ITOTR 02960108 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02970108 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 02980108 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7779 02990108 +C7778 CONTINUE 03000108 +C GO TO 7782 03010108 +C7779 IF ( IRNUM - ITOTR ) 7780, 7781, 7782 03020108 +C7780 WRITE (I02,77702) IRNUM,ILUN,ITOTR 03030108 +C GO TO 7784 03040108 +C7781 WRITE (I02,77703) ILUN,ITOTR 03050108 +C GO TO 7784 03060108 +C7782 WRITE (I02,77704) ILUN, ITOTR 03070108 +C DO 7783 I = 1, 5 03080108 +C READ (ILUN,77701) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03090108 +C WRITE ( I02,77705) (IDUMP(ICHAR), ICHAR = 1, IRLGN) 03100108 +C IF ( IDUMP(20) .EQ. NINE ) GO TO 7784 03110108 +C7783 CONTINUE 03120108 +C7784 GO TO 99999 03130108 +CDE** 03140108 +C WRITE PAGE FOOTINGS AND RUN SUMMARIES 03150108 +99999 CONTINUE 03160108 + WRITE (I02,90002) 03170108 + WRITE (I02,90006) 03180108 + WRITE (I02,90002) 03190108 + WRITE (I02,90002) 03200108 + WRITE (I02,90007) 03210108 + WRITE (I02,90002) 03220108 + WRITE (I02,90008) IVFAIL 03230108 + WRITE (I02,90009) IVPASS 03240108 + WRITE (I02,90010) IVDELE 03250108 +C 03260108 +C 03270108 +C TERMINATE ROUTINE EXECUTION 03280108 + STOP 03290108 +C 03300108 +C FORMAT STATEMENTS FOR PAGE HEADERS 03310108 +90000 FORMAT ("1") 03320108 +90002 FORMAT (" ") 03330108 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03340108 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 03350108 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 03360108 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 03370108 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 03380108 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 03390108 +C 03400108 +C FORMAT STATEMENTS FOR RUN SUMMARIES 03410108 +90008 FORMAT (" ",15X,I5," ERRORS ENCOUNTERED" ) 03420108 +90009 FORMAT (" ",15X,I5," TESTS PASSED" ) 03430108 +90010 FORMAT (" ",15X,I5," TESTS DELETED" ) 03440108 +C 03450108 +C FORMAT STATEMENTS FOR TEST RESULTS 03460108 +80001 FORMAT (" ",4X,I5,7X,"PASS") 03470108 +80002 FORMAT (" ",4X,I5,7X,"FAIL") 03480108 +80003 FORMAT (" ",4X,I5,7X,"DELETED") 03490108 +80004 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 03500108 +80005 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 03510108 +C 03520108 +90007 FORMAT (" ",20X,"END OF PROGRAM FM108" ) 03530108 + END 03540108 diff --git a/Fortran/UnitTests/fcvs21_f95/FM108.reference_output b/Fortran/UnitTests/fcvs21_f95/FM108.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM108.reference_output @@ -0,0 +1,56 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + FILE I08 CREATED WITH 31 SEQUENTIAL RECORDS + 125 PASS + 126 PASS + 127 PASS + 128 PASS + 129 PASS + 130 PASS + 131 PASS + 132 PASS + 133 PASS + 134 PASS + 135 PASS + 136 PASS + 137 PASS + 138 PASS + 139 PASS + 140 PASS + 141 PASS + 142 PASS + 143 PASS + 144 PASS + 145 PASS + 146 PASS + 147 PASS + 148 PASS + 149 PASS + 150 PASS + 151 PASS + 152 PASS + 153 PASS + 154 PASS + 155 PASS + + ---------------------------------------------- + + + END OF PROGRAM FM108 + + 0 ERRORS ENCOUNTERED + 31 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM109.f b/Fortran/UnitTests/fcvs21_f95/FM109.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM109.f @@ -0,0 +1,604 @@ + PROGRAM FM109 + +C COMMENT SECTION 00010109 +C 00020109 +C FM109 00030109 +C 00040109 +C THIS ROUTINE TESTS THE BASIC OPTIONS REGARDING THE SIMPLE 00050109 +C FORMATTED WRITE STATEMENT OF FORM 00060109 +C WRITE (U,F) OR 00070109 +C WRITE (U,F) L 00080109 +C WHERE U IS A LOGICAL UNIT NUMBER 00090109 +C F IS A FORMAT STATEMENT LABEL, AND 00100109 +C L IS A LIST OF INTEGER VARIABLES. 00110109 +C THE FORMAT STATEMENT F CONTAINS NH HOLLERITH FIELD DESCRIPTORS, 00120109 +C NX BLANK FIELD DESCRIPTORS AND IW NUMERIC FIELD DESCRIPTORS. 00130109 +C 00140109 +C THIS ROUTINE TESTS WHETHER THE FIRST CHARACTER OF A FORMAT 00150109 +C RECORD FOR PRINTER OUTPUT DETERMINES VERTICAL SPACING AS FOLLOWS 00160109 +C 1 - ADVANCE TO FIRST LINE OF NEXT PAGE 00170109 +C BLANK - ONE LINE 00180109 +C 0 - ADVANCE TWO LINES BEFORE PRINTING 00190109 +C + - DO NOT ADVANCE BEFORE PRINTING - ADVANCE 0 00200109 +C 00210109 +C REFERENCES 00220109 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00230109 +C X3.9-1978 00240109 +C 00250109 +C SECTION 8, SPECIFICATION STATEMENTS 00260109 +C SECTION 9, DATA STATEMENT 00270109 +C SECTION 11.10, DO STATEMENT 00280109 +C SECTION 12, INPUT/OUTPUT STATEMENTS 00290109 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00300109 +C SECTION 12.9.5.2, FORMATTED DATA TRANSFER 00310109 +C SECTION 13, FORMAT STATEMENT 00320109 +C SECTION 13.2.1, EDIT DESCRIPTORS 00330109 +C 00340109 +C ALL OF THE RESULTS OF THIS ROUTINE MUST BE VISUALLY CHECKED 00350109 +C ON THE OUTPUT REPORT. THE USUAL TEST CODE FOR PASS, FAIL, OR 00360109 +C DELETE DOES NOT APPLY TO THIS ROUTINE. IF ANY TEST IS TO BE 00370109 +C DELETED, CHANGE THE OFFENDING WRITE OR FORMAT STATEMENT TO A 00380109 +C COMMENT. THE PERSON RESPONSIBLE FOR CHECKING THE OUTPUT MUST ALSO00390109 +C CHECK THE COMPILER LISTING TO SEE IF ANY STATEMENTS HAVE BEEN 00400109 +C CHANGED TO COMMENTS. 00410109 +C 00420109 +C 00430109 +C ********************************************************** 00440109 +C 00450109 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00460109 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN NATIONAL STANDARD 00470109 +C PROGRAMMING LANGUAGE FORTRAN X3.9-1978, HAS BEEN DEVELOPED BY THE 00480109 +C FEDERAL COBOL COMPILER TESTING SERVICE. THE FORTRAN COMPILER 00490109 +C VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT ROUTINES, THEIR RELATED00500109 +C DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT ROUTINE IS A FORTRAN 00510109 +C PROGRAM, SUBPROGRAM OR FUNCTION WHICH INCLUDES TESTS OF SPECIFIC 00520109 +C LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING THE RESULT 00530109 +C OF EXECUTING THESE TESTS. 00540109 +C 00550109 +C THIS PARTICULAR PROGRAM/SUBPROGRAM/FUNCTION CONTAINS FEATURES 00560109 +C FOUND ONLY IN THE SUBSET AS DEFINED IN X3.9-1978. 00570109 +C 00580109 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO - 00590109 +C 00600109 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00610109 +C SOFTWARE STANDARDS VALIDATION GROUP 00620109 +C BUILDING 225 RM A266 00630109 +C GAITHERSBURG, MD 20899 00640109 +C ********************************************************** 00650109 +C 00660109 +C 00670109 +C 00680109 +C INITIALIZATION SECTION 00690109 +C 00700109 +C INITIALIZE CONSTANTS 00710109 +C ************** 00720109 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00730109 + I01 = 5 00740109 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00750109 + I02 = 6 00760109 +C SYSTEM ENVIRONMENT SECTION 00770109 +C 00780109 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD. 00790109 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00800109 +C (UNIT NUMBER FOR CARD READER). 00810109 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD. 00820109 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00830109 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00840109 +C 00850109 +CX020 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD. 00860109 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00870109 +C (UNIT NUMBER FOR PRINTER). 00880109 +CX021 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD. 00890109 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00900109 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00910109 +C 00920109 + IVPASS=0 00930109 + IVFAIL=0 00940109 + IVDELE=0 00950109 + ICZERO=0 00960109 +C 00970109 +C WRITE PAGE HEADERS 00980109 + WRITE (I02,90000) 00990109 + WRITE (I02,90001) 01000109 + WRITE (I02,90002) 01010109 + WRITE (I02, 90002) 01020109 + WRITE (I02,90003) 01030109 + WRITE (I02,90002) 01040109 + WRITE (I02,90004) 01050109 + WRITE (I02,90002) 01060109 + WRITE (I02,90011) 01070109 + WRITE (I02,90002) 01080109 + WRITE (I02,90002) 01090109 + WRITE (I02,90006) 01100109 + WRITE (I02,90002) 01110109 +C 01120109 + IVTNUM = 156 01130109 +C **** TEST 156 **** 01140109 +C TEST 156 - VERTICAL SPACING TEST 01150109 +C 1 IN FIRST CHARACTER OF FORMATTED PRINT RECORD MEANS 01160109 +C RECORD IS FIRST LINE AT TOP OF NEXT PAGE. 01170109 +C 01180109 + IF (ICZERO) 31560, 1560, 31560 01190109 + 1560 CONTINUE 01200109 + WRITE (I02,80001) IVTNUM 01210109 + WRITE (I02,80331) 01220109 +80331 FORMAT (5X,"LAST LINE ON THIS PAGE" ) 01230109 + WRITE (I02,80330) 01240109 +80330 FORMAT ("1"," THIS IS FIRST LINE ON PAGE" ) 01250109 + GO TO 1571 01260109 +31560 IVDELE = IVDELE + 1 01270109 + WRITE (I02,80003) IVTNUM 01280109 + 1571 CONTINUE 01290109 + IVTNUM = 157 01300109 +C 01310109 +C **** TEST 157 **** 01320109 +C TEST 157 - VERTICAL SPACING TEST 01330109 +C PRINT BLANK LINES 01340109 +C 01350109 +C 01360109 + IF (ICZERO) 31570, 1570, 31570 01370109 + 1570 CONTINUE 01380109 + WRITE (I02,90002) 01390109 + WRITE (I02,80001) IVTNUM 01400109 + WRITE (I02,80340) 01410109 +80340 FORMAT (" ", 10X) 01420109 + WRITE (I02,80341) 01430109 +80341 FORMAT (" THERE IS ONE BLANK LINE BEFORE THIS LINE" ) 01440109 + WRITE (I02,80342) 01450109 + WRITE (I02,80342) 01460109 +80342 FORMAT (" " ) 01470109 + WRITE (I02,80343) 01480109 +80343 FORMAT (" THERE ARE TWO BLANK LINES BEFORE THIS LINE" ) 01490109 + WRITE (I02,80344) 01500109 + WRITE (I02,80344) 01510109 + WRITE (I02,80344) 01520109 +80344 FORMAT (11X) 01530109 + WRITE (I02,80345) 01540109 +80345 FORMAT (" THERE ARE THREE BLANK LINES BEFORE THIS LINE" ) 01550109 + GO TO 1581 01560109 +31570 IVDELE = IVDELE + 1 01570109 + WRITE (I02,80003) IVTNUM 01580109 + 1581 CONTINUE 01590109 + IVTNUM = 158 01600109 +C 01610109 +C **** TEST 158 **** 01620109 +C TEST 158 - PRINT 54 CHARACTERS 01630109 +C 01640109 +C 01650109 + IF (ICZERO) 31580, 1580, 31580 01660109 + 1580 CONTINUE 01670109 + WRITE (I02,90002) 01680109 + WRITE (I02,80001)IVTNUM 01690109 + WRITE (I02,80351) 01700109 +80351 FORMAT (" NEXT LINE CONTAINS 54 CHARACTERS" ) 01710109 + WRITE (I02,80350) 01720109 +80350 FORMAT(" 123456789012345678901234567890123456789012345678901234" )01730109 + GO TO 1591 01740109 +31580 IVDELE = IVDELE + 1 01750109 + WRITE (I02,80003) IVTNUM 01760109 + 1591 CONTINUE 01770109 + IVTNUM = 159 01780109 +C 01790109 +C **** TEST 159 **** 01800109 +C TEST 159 - NUMERIC FIELD DESCRIPTOR I1 01810109 +C 01820109 + IF (ICZERO) 31590, 1590, 31590 01830109 + 1590 CONTINUE 01840109 + WRITE (I02,90002) 01850109 + WRITE (I02,80001) IVTNUM 01860109 + WRITE (I02,80361) 01870109 +80361 FORMAT (" ",10X,"THIS TEST PRINTS 3 UNDER I1 DESCRIPTOR" ) 01880109 + IVON01 = 3 01890109 + WRITE (I02,80360) IVON01 01900109 +80360 FORMAT (" ",10X,I1) 01910109 + GO TO 1601 01920109 +31590 IVDELE = IVDELE + 1 01930109 + WRITE (I02,80003) IVTNUM 01940109 + 1601 CONTINUE 01950109 + IVTNUM = 160 01960109 +C 01970109 +C **** TEST 160 **** 01980109 +C TEST 160 - NUMERIC FIELD DESCRIPTOR I2 01990109 +C 02000109 + IF (ICZERO) 31600, 1600, 31600 02010109 + 1600 CONTINUE 02020109 + WRITE (I02,90002) 02030109 + WRITE (I02,80001) IVTNUM 02040109 + WRITE (I02,80371) 02050109 +80371 FORMAT (11X,"THIS TEST PRINTS 15 UNDER I2 DESCRIPTOR" ) 02060109 + IVON01 = 15 02070109 + WRITE (I02,80370) IVON01 02080109 +80370 FORMAT (" ",10X,I2) 02090109 + GO TO 1611 02100109 +31600 IVDELE = IVDELE + 1 02110109 + WRITE (I02,80003) IVTNUM 02120109 + 1611 CONTINUE 02130109 + IVTNUM = 161 02140109 +C 02150109 +C **** TEST 161 **** 02160109 +C TEST 161 - NUMERIC FIELD DESCRIPTOR I3 02170109 +C 02180109 + IF (ICZERO) 31610, 1610, 31610 02190109 + 1610 CONTINUE 02200109 + WRITE (I02,90002) 02210109 + WRITE (I02,80001) IVTNUM 02220109 + WRITE (I02,80381) 02230109 +80381 FORMAT (11X,"THIS TEST PRINTS 291 UNDER I3 DESCRIPTOR" ) 02240109 + IVON01 = 291 02250109 + WRITE (I02,80380) IVON01 02260109 +80380 FORMAT (11X,I3) 02270109 + GO TO 1621 02280109 +31610 IVDELE = IVDELE + 1 02290109 + WRITE (I02,80003) IVTNUM 02300109 + 1621 CONTINUE 02310109 + IVTNUM = 162 02320109 +C 02330109 +C **** TEST 162 **** 02340109 +C TEST 162 - NUMERIC FIELD DESCRIPTOR I4 02350109 +C 02360109 + IF (ICZERO) 31620, 1620, 31620 02370109 + 1620 CONTINUE 02380109 + WRITE (I02,90002) 02390109 + WRITE (I02,80001) IVTNUM 02400109 + WRITE (I02,80391) 02410109 +80391 FORMAT (11X,"THIS TEST PRINTS 4321 UNDER I4 DESCRIPTOR" ) 02420109 + IVON01 = 4321 02430109 + WRITE (I02,80390) IVON01 02440109 +80390 FORMAT (11X,I4) 02450109 + GO TO 1631 02460109 +31620 IVDELE = IVDELE + 1 02470109 + WRITE (I02,80003) IVTNUM 02480109 + 1631 CONTINUE 02490109 + IVTNUM = 163 02500109 +C 02510109 +C **** TEST 163 **** 02520109 +C TEST 163 - NUMERIC FIELD DESCRIPTOR I5 02530109 +C 02540109 + IF (ICZERO) 31630, 1630, 31630 02550109 + 1630 CONTINUE 02560109 + WRITE (I02,90002) 02570109 + WRITE (I02,80001) IVTNUM 02580109 + WRITE (I02,80401) 02590109 +80401 FORMAT (" ",10X,"THIS TEST PRINTS 12345 UNDER I5 DESCRIPTOR" ) 02600109 + IVON01 = 12345 02610109 + WRITE (I02,80400) IVON01 02620109 +80400 FORMAT (" ",10X,I5) 02630109 + GO TO 1641 02640109 +31630 IVDELE = IVDELE + 1 02650109 + WRITE (I02,80003) IVTNUM 02660109 + 1641 CONTINUE 02670109 + IVTNUM = 164 02680109 +C 02690109 +C **** TEST 164 **** 02700109 +C TEST 164 - NUMERIC FIELD DESCRIPTORS, INTEGER CONVERSION 02710109 +C 02720109 + IF (ICZERO) 31640, 1640, 31640 02730109 + 1640 CONTINUE 02740109 + IVON01 = 1 02750109 + IVON02 = 22 02760109 + IVON03 = 333 02770109 + IVON04 = 4444 02780109 + IVON05 = 25555 02790109 + WRITE (I02,90002) 02800109 + WRITE (I02,80001) IVTNUM 02810109 + WRITE (I02,80411) 02820109 +80411 FORMAT (3X,"THIS TEST PRINTS 1, 22, 333, 4444, AND 25555 UNDER" ) 02830109 + WRITE (I02,80412) 02840109 +80412 FORMAT (10X,"(10X,I1,3X,I2,3X,I3,3X,I4,3X,I5)" ) 02850109 + WRITE (I02,80410) IVON01, IVON02, IVON03, IVON04, IVON05 02860109 +80410 FORMAT (10X,I1,3X,I2,3X,I3,3X,I4,3X,I5) 02870109 + GO TO 1651 02880109 +31640 IVDELE = IVDELE + 1 02890109 + WRITE (I02,80003) IVTNUM 02900109 + 1651 CONTINUE 02910109 + IVTNUM = 165 02920109 +C 02930109 +C **** TEST 165 **** 02940109 +C TEST 165 - HOLLERITH, NUMERIC AND X FIELD DESCRIPTORS 02950109 +C COMBINE HOLLERITH, NUMERIC AND X FIELD DESCRIPTORS IN 02960109 +C ONE FORMAT STATEMENT 02970109 +C 02980109 + IF (ICZERO) 31650, 1650, 31650 02990109 + 1650 CONTINUE 03000109 + IVON01=113 03010109 + IVON02=8 03020109 + WRITE (I02,90002) 03030109 + WRITE (I02,80001) IVTNUM 03040109 + WRITE (I02,80421) 03050109 +80421 FORMAT (10X,"NEXT TWO LINES ARE IDENTICAL" ) 03060109 + WRITE (I02,80422) 03070109 +80422 FORMAT (" IVON01 = 113 IVON02 = 8" ) 03080109 + WRITE (I02,80420) IVON01, IVON02 03090109 +80420 FORMAT (6X,"IVON01 =",I5,3X,"IVON02 =",I5) 03100109 + GO TO 1661 03110109 +31650 IVDELE = IVDELE + 1 03120109 + WRITE (I02,80003) IVTNUM 03130109 + 1661 CONTINUE 03140109 + IVTNUM = 166 03150109 +C 03160109 +C **** TEST 166 **** 03170109 +C TEST 166 - NUMERIC FIELD DESCRIPTOR I2 03180109 +C PRINT NEGATIVE INTEGER 03190109 +C 03200109 + IF (ICZERO) 31660, 1660, 31660 03210109 + 1660 CONTINUE 03220109 + IVON01 = -1 03230109 + WRITE (I02,90002) 03240109 + WRITE (I02,80001) IVTNUM 03250109 + WRITE (I02,80431) 03260109 +80431 FORMAT (11X,"THIS TEST PRINTS -1 UNDER I2 DESCRIPTOR" ) 03270109 + WRITE (I02,80430) IVON01 03280109 +80430 FORMAT (11X,I2) 03290109 + GO TO 1671 03300109 +31660 IVDELE = IVDELE + 1 03310109 + WRITE (I02,80003) IVTNUM 03320109 + 1671 CONTINUE 03330109 + IVTNUM = 167 03340109 +C 03350109 +C **** TEST 167 **** 03360109 +C TEST 167 - NUMERIC FIELD DESCRIPTOR I3 03370109 +C PRINT NEGATIVE INTEGER 03380109 +C 03390109 + IF (ICZERO) 31670, 1670, 31670 03400109 + 1670 CONTINUE 03410109 + IVON01 = -22 03420109 + WRITE (I02,90002) 03430109 + WRITE (I02,80001) IVTNUM 03440109 + WRITE (I02,80441) 03450109 +80441 FORMAT (11X,"THIS TEST PRINTS -22 UNDER I3 DESCRIPTOR" ) 03460109 + WRITE (I02,80440) IVON01 03470109 +80440 FORMAT (11X,I3) 03480109 + GO TO 1681 03490109 +31670 IVDELE = IVDELE + 1 03500109 + WRITE (I02,80003) IVTNUM 03510109 + 1681 CONTINUE 03520109 + IVTNUM = 168 03530109 +C 03540109 +C **** TEST 168 **** 03550109 +C TEST 168 - NUMERIC FIELD DESCRIPTOR I4 03560109 +C PRINT NEGATIVE INTEGER 03570109 +C 03580109 + IF (ICZERO) 31680, 1680, 31680 03590109 + 1680 CONTINUE 03600109 + IVON01 = -333 03610109 + WRITE (I02,90002) 03620109 + WRITE (I02,80001) IVTNUM 03630109 + WRITE (I02,80451) 03640109 +80451 FORMAT (11X,"THIS TEST PRINTS -333 UNDER I4 DESCRIPTOR" ) 03650109 + WRITE (I02,80450) IVON01 03660109 +80450 FORMAT (11X,I4) 03670109 + GO TO 1691 03680109 +31680 IVDELE = IVDELE + 1 03690109 + WRITE (I02,80003) IVTNUM 03700109 + 1691 CONTINUE 03710109 + IVTNUM = 169 03720109 +C 03730109 +C **** TEST 169 **** 03740109 +C TEST 169 - NUMERIC FIELD DESCRIPTOR I5 03750109 +C PRINT NEGATIVE INTEGER 03760109 +C 03770109 + IF (ICZERO) 31690, 1690, 31690 03780109 + 1690 CONTINUE 03790109 + IVON01 = -4444 03800109 + WRITE (I02,90002) 03810109 + WRITE (I02,80001) IVTNUM 03820109 + WRITE (I02,80461) 03830109 +80461 FORMAT (11X,"THIS TEST PRINTS -4444 UNDER I5 DESCRIPTOR" ) 03840109 + WRITE (I02,80460) IVON01 03850109 +80460 FORMAT (11X,I5) 03860109 + GO TO 1701 03870109 +31690 IVDELE = IVDELE + 1 03880109 + WRITE (I02,80003) IVTNUM 03890109 + 1701 CONTINUE 03900109 + IVTNUM = 170 03910109 +C 03920109 +C **** TEST 170 **** 03930109 +C TEST 170 - NUMERIC FIELD DESCRIPTOR I6 03940109 +C PRINT NEGATIVE INTEGER 03950109 +C 03960109 + IF (ICZERO) 31700, 1700, 31700 03970109 + 1700 CONTINUE 03980109 + IVON01 = -15555 03990109 + WRITE (I02,90002) 04000109 + WRITE (I02,80001) IVTNUM 04010109 + WRITE (I02,80471) 04020109 +80471 FORMAT (11X,"THIS TEST PRINTS -15555 UNDER DESCRIPTOR I6" ) 04030109 + WRITE (I02,80470) IVON01 04040109 +80470 FORMAT (11X,I6) 04050109 + GO TO 1711 04060109 +31700 IVDELE = IVDELE + 1 04070109 + WRITE (I02,80003) IVTNUM 04080109 + 1711 CONTINUE 04090109 + IVTNUM = 171 04100109 +C 04110109 +C **** TEST 171 **** 04120109 +C TEST 171 - NUMERIC FIELD DESCRIPTORS, INTEGER CONVERSION 04130109 +C PRINT NEGATIVE INTEGERS 04140109 +C 04150109 + IF (ICZERO) 31710, 1710, 31710 04160109 + 1710 CONTINUE 04170109 + IVON01 = -9 04180109 + IVON02 = -88 04190109 + IVON03 = -777 04200109 + IVON04 = -6666 04210109 + IVON05 = -25555 04220109 + WRITE (I02,90002) 04230109 + WRITE (I02,80001) IVTNUM 04240109 + WRITE (I02,80481) 04250109 +80481 FORMAT (8X,"THIS TEST PRINTS -9, -88, -777, -6666, AND -25555" ) 04260109 + WRITE (I02,80482) 04270109 +80482 FORMAT (11X,"UNDER FORMAT 10X,I2,3X,I3,3X,I4,3X,I5,3X,I6" ) 04280109 + WRITE (I02,80480) IVON01,IVON02,IVON03,IVON04,IVON05 04290109 +80480 FORMAT (10X,I2,3X,I3,3X,I4,3X,I5,3X,I6) 04300109 + GO TO 1721 04310109 +31710 IVDELE = IVDELE + 1 04320109 + WRITE (I02,80003) IVTNUM 04330109 + 1721 CONTINUE 04340109 + IVTNUM = 172 04350109 +C 04360109 +C **** TEST 172 **** 04370109 +C TEST 172 - NUMERIC FIELD DESCRIPTOR I5 04380109 +C MIX POSITIVE AND NEGATIVE INTEGER OUTPUT IN ONE FORMAT 04390109 +C STATEMENT ALL UNDER I5 DESCRIPTOR 04400109 +C 04410109 + IF (ICZERO) 31720, 1720, 31720 04420109 + 1720 CONTINUE 04430109 + IVON01 =5 04440109 + IVON02 = -54 04450109 + IVON03 = 543 04460109 + IVON04 = -5432 04470109 + IVON05=32000 04480109 + WRITE (I02,90002) 04490109 + WRITE (I02,80001) IVTNUM 04500109 + WRITE (I02,80491) 04510109 +80491 FORMAT (18X,"THIS TEST PRINTS 5, -54, 543, -5432, AND 32000" ) 04520109 + WRITE (I02,80492) 04530109 +80492 FORMAT (11X,"UNDER I5 NUMERIC FIELD DESCRIPTOR" ) 04540109 + WRITE (I02,80490) IVON01,IVON02,IVON03,IVON04,IVON05 04550109 +80490 FORMAT (11X,I5,3X,I5,3X,I5,3X,I5,3X,I5) 04560109 + GO TO 1731 04570109 +31720 IVDELE = IVDELE + 1 04580109 + WRITE (I02,80003) IVTNUM 04590109 + 1731 CONTINUE 04600109 + IVTNUM = 173 04610109 +C 04620109 +C **** TEST 173 **** 04630109 +C TEST 173 - VERTICAL SPACING TEST USING THE 1H0 AS A DOUBLE 04640109 +C SPACE BEFORE PRINT ( ADVANCE TWO LINES BEFORE WRITING ). THE 0 04650109 +C AS A CARRIAGE CONTROL CHARACTER IS USED WITH THE BLANK CHARACTER 04660109 +C TO GET AN ODD NUMBER OF LINES TO ADVANCE BEFORE WRITING. 04670109 +C 04680109 + IF (ICZERO) 31730, 1730, 31730 04690109 + 1730 CONTINUE 04700109 + WRITE (I02,90002) 04710109 + WRITE (I02,80001) IVTNUM 04720109 + WRITE (I02,81730) 04730109 +81730 FORMAT (" ", 10X) 04740109 + WRITE (I02,81731) 04750109 +81731 FORMAT (" THERE IS ONE BLANK LINE BEFORE THIS LINE" ) 04760109 + WRITE ( I02, 81732 ) 04770109 +81732 FORMAT ( "0",10X) 04780109 + WRITE ( I02, 81733 ) 04790109 +81733 FORMAT (" THERE ARE TWO BLANK LINES BEFORE THIS LINE" ) 04800109 + WRITE ( I02, 81730 ) 04810109 + WRITE ( I02, 81732 ) 04820109 + WRITE ( I02, 81735 ) 04830109 +81735 FORMAT (" THERE ARE THREE BLANK LINES BEFORE THIS LINE" ) 04840109 + WRITE ( I02, 81732 ) 04850109 + WRITE ( I02, 81732 ) 04860109 + WRITE ( I02, 81736 ) 04870109 +81736 FORMAT (" THERE ARE FOUR BLANK LINES BEFORE THIS LINE" ) 04880109 + GO TO 1741 04890109 +31730 IVDELE = IVDELE + 1 04900109 + WRITE (I02,80003) IVTNUM 04910109 + 1741 CONTINUE 04920109 + IVTNUM = 174 04930109 +C 04940109 +C **** TEST 174 **** 04950109 +C TEST 174 - VERTICAL SPACING TEST USING THE + CHARACTER TO 04960109 +C SUPPRESS ADVANCING BEFORE THE PRINT AND THIS SHOULD CAUSE TWO AND 04970109 +C THEN THREE SUCCESSIVE LINES TO OVERPRINT 04980109 +C 04990109 + IF (ICZERO) 31740, 1740, 31740 05000109 + 1740 CONTINUE 05010109 + WRITE ( I02, 90002 ) 05020109 + WRITE ( I02, 80001 ) IVTNUM 05030109 + WRITE ( I02, 81740 ) 05040109 +81740 FORMAT ( " " ) 05050109 + WRITE ( I02, 81741 ) 05060109 +81741 FORMAT ( " ",10X, "1ST LINE - AABBCCDD" ) 05070109 + WRITE ( I02, 81742 ) 05080109 +81742 FORMAT ( "+", 25X, "WWXXYYZZ OVERPRINTS - 2ND LINE" ) 05090109 + WRITE ( I02, 81743 ) 05100109 +81743 FORMAT ( /////" ") 05110109 +C SKIP DOWN A FEW LINES TO GET SET - OK AWAY WE GO.. 05120109 + WRITE ( I02, 81740 ) 05130109 + WRITE ( I02, 81744 ) 05140109 +81744 FORMAT ( " ", 10X, "11 44 1ST LINE" ) 05150109 + WRITE ( I02, 81745 ) 05160109 +81745 FORMAT ( "+", 10X, " 22 55 2ND" ) 05170109 + WRITE ( I02, 81746 ) 05180109 +81746 FORMAT ( "+", 10X, " 33 66 3RD" ) 05190109 + GO TO 1751 05200109 +31740 IVDELE = IVDELE + 1 05210109 + WRITE (I02,80003) IVTNUM 05220109 + 1751 CONTINUE 05230109 + IVTNUM = 175 05240109 +C 05250109 +C **** TEST 175 **** 05260109 +C TEST 175 - NUMERIC FIELD DESCRIPTOR F3.0 05270109 +C 05280109 + IF (ICZERO) 31750, 1750, 31750 05290109 + 1750 CONTINUE 05300109 + WRITE ( I02, 90002 ) 05310109 + WRITE ( I02, 80001 ) IVTNUM 05320109 + WRITE ( I02, 81751 ) 05330109 +81751 FORMAT (" ",10X,"THIS TESTS PRINTS 3. UNDER F3.0 DESCRIPTOR" ) 05340109 + RVON01 = 3. 05350109 + WRITE ( I02, 81752 ) RVON01 05360109 +81752 FORMAT ( " ",10X, F3.0 ) 05370109 + GO TO 1761 05380109 +31750 IVDELE = IVDELE + 1 05390109 + WRITE (I02,80003) IVTNUM 05400109 + 1761 CONTINUE 05410109 + IVTNUM = 176 05420109 +C 05430109 +C **** TEST 176 **** 05440109 +C TEST 176 - SIGNED NUMERIC FIELD DESCRIPTOR F4.0 05450109 +C 05460109 + IF (ICZERO) 31760, 1760, 31760 05470109 + 1760 CONTINUE 05480109 + WRITE ( I02, 90002 ) 05490109 + WRITE ( I02, 80001 ) IVTNUM 05500109 + WRITE ( I02, 81761 ) 05510109 +81761 FORMAT ( " ",10X,"THIS TEST PRINTS -15. WITH F4.0 DESCRIPTOR" ) 05520109 + RVON01 = -15. 05530109 + WRITE ( I02, 81762 ) RVON01 05540109 +81762 FORMAT ( " ",10X, F4.0) 05550109 + GO TO 1771 05560109 +31760 IVDELE = IVDELE + 1 05570109 + WRITE (I02,80003) IVTNUM 05580109 + 1771 CONTINUE 05590109 + IVTNUM = 177 05600109 +C 05610109 +C **** TEST 177 **** 05620109 +C TEST 177 - SIGNED NUMERIC FIELD DESCRIPTOR E12.5 05630109 +C 05640109 + IF (ICZERO) 31770, 1770, 31770 05650109 + 1770 CONTINUE 05660109 + WRITE ( I02, 90002 ) 05670109 + WRITE ( I02, 80001 ) IVTNUM 05680109 + WRITE ( I02, 81771 ) 05690109 +81771 FORMAT ( " ", 10X,"THIS TEST PRINTS -0.12345E+03 USING E12.5" ) 05700109 + RVON01 = -123.45 05710109 + WRITE ( I02, 81772 ) RVON01 05720109 +81772 FORMAT ( " ", 10X, E12.5 ) 05730109 + GO TO 1781 05740109 +31770 IVDELE = IVDELE + 1 05750109 + WRITE (I02,80003) IVTNUM 05760109 + 1781 CONTINUE 05770109 +C 05780109 +C WRITE PAGE FOOTINGS 05790109 +99999 CONTINUE 05800109 + WRITE (I02,90002) 05810109 + WRITE (I02,90006) 05820109 + WRITE (I02,90002) 05830109 + WRITE (I02,90007) 05840109 +C 05850109 +C TERMINATE ROUTINE EXECUTION 05860109 + STOP 05870109 +C 05880109 +C FORMAT STATEMENTS FOR PAGE HEADERS 05890109 +90000 FORMAT ("1") 05900109 +90002 FORMAT (" ") 05910109 +90001 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05920109 +90003 FORMAT (" ",21X,"VERSION 2.1" ) 05930109 +90004 FORMAT (" ",10X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 05940109 +90005 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL", 5X,"COMPUTED",8X,"CORRECT") 05950109 +90006 FORMAT (" ",5X,"----------------------------------------------" ) 05960109 +90011 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 05970109 +C FORMAT STATEMENTS FOR THIS ROUTINE 05980109 +80001 FORMAT (10X,"TEST ",I5) 05990109 +80003 FORMAT ( " ",4X,I5,7X,"DELETED") 06000109 +90007 FORMAT (" ",20X,"END OF PROGRAM FM109" ) 06010109 + END 06020109 diff --git a/Fortran/UnitTests/fcvs21_f95/FM109.reference_output b/Fortran/UnitTests/fcvs21_f95/FM109.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM109.reference_output @@ -0,0 +1,135 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + + + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + + + ---------------------------------------------- + + TEST 156 + LAST LINE ON THIS PAGE +1 THIS IS FIRST LINE ON PAGE + + TEST 157 + + THERE IS ONE BLANK LINE BEFORE THIS LINE + + + THERE ARE TWO BLANK LINES BEFORE THIS LINE + + + + THERE ARE THREE BLANK LINES BEFORE THIS LINE + + TEST 158 + NEXT LINE CONTAINS 54 CHARACTERS + 123456789012345678901234567890123456789012345678901234 + + TEST 159 + THIS TEST PRINTS 3 UNDER I1 DESCRIPTOR + 3 + + TEST 160 + THIS TEST PRINTS 15 UNDER I2 DESCRIPTOR + 15 + + TEST 161 + THIS TEST PRINTS 291 UNDER I3 DESCRIPTOR + 291 + + TEST 162 + THIS TEST PRINTS 4321 UNDER I4 DESCRIPTOR + 4321 + + TEST 163 + THIS TEST PRINTS 12345 UNDER I5 DESCRIPTOR + 12345 + + TEST 164 + THIS TEST PRINTS 1, 22, 333, 4444, AND 25555 UNDER + (10X,I1,3X,I2,3X,I3,3X,I4,3X,I5) + 1 22 333 4444 25555 + + TEST 165 + NEXT TWO LINES ARE IDENTICAL + IVON01 = 113 IVON02 = 8 + IVON01 = 113 IVON02 = 8 + + TEST 166 + THIS TEST PRINTS -1 UNDER I2 DESCRIPTOR + -1 + + TEST 167 + THIS TEST PRINTS -22 UNDER I3 DESCRIPTOR + -22 + + TEST 168 + THIS TEST PRINTS -333 UNDER I4 DESCRIPTOR + -333 + + TEST 169 + THIS TEST PRINTS -4444 UNDER I5 DESCRIPTOR + -4444 + + TEST 170 + THIS TEST PRINTS -15555 UNDER DESCRIPTOR I6 + -15555 + + TEST 171 + THIS TEST PRINTS -9, -88, -777, -6666, AND -25555 + UNDER FORMAT 10X,I2,3X,I3,3X,I4,3X,I5,3X,I6 + -9 -88 -777 -6666 -25555 + + TEST 172 + THIS TEST PRINTS 5, -54, 543, -5432, AND 32000 + UNDER I5 NUMERIC FIELD DESCRIPTOR + 5 -54 543 -5432 32000 + + TEST 173 + + THERE IS ONE BLANK LINE BEFORE THIS LINE +0 + THERE ARE TWO BLANK LINES BEFORE THIS LINE + +0 + THERE ARE THREE BLANK LINES BEFORE THIS LINE +0 +0 + THERE ARE FOUR BLANK LINES BEFORE THIS LINE + + TEST 174 + + 1ST LINE - AABBCCDD ++ WWXXYYZZ OVERPRINTS - 2ND LINE + + + + + + + + 11 44 1ST LINE ++ 22 55 2ND ++ 33 66 3RD + + TEST 175 + THIS TESTS PRINTS 3. UNDER F3.0 DESCRIPTOR + 3. + + TEST 176 + THIS TEST PRINTS -15. WITH F4.0 DESCRIPTOR + -15. + + TEST 177 + THIS TEST PRINTS -0.12345E+03 USING E12.5 + -0.12345E+03 + + ---------------------------------------------- + + END OF PROGRAM FM109 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM110.f b/Fortran/UnitTests/fcvs21_f95/FM110.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM110.f @@ -0,0 +1,646 @@ + PROGRAM FM110 + +C***********************************************************************00010110 +C***** FORTRAN 77 00020110 +C***** FM110 IOFMT - (350) 00030110 +C***** 00040110 +C***********************************************************************00050110 +C***** GENERAL PURPOSE SUBSET REFS00060110 +C***** TO TEST ADDITIONAL FEATURES OF READ AND WRITE 12.8 00070110 +C***** STATEMENTS, FORMATTED RECORDS AND FORMAT STATEMENTS 12.1.1 00080110 +C***** FOR INTEGER AND REAL DATA TYPES 00090110 +C***** RESTRICTIONS OBSERVED 00100110 +C***** * ALL FORMAT STATEMENTS ARE LABELED 13.1.1 00110110 +C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.2.1 00120110 +C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND 00130110 +C***** W IS EQUAL TO OR GREATER THAN D 00140110 +C***** * FIELD WIDTH IS NEVER ZERO 00150110 +C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE ITEM 13.3 00160110 +C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST 00170110 +C***** IN THE FORMAT SPECIFICATION 00180110 +C***** * ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS 00190110 +C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 13.5.9 00200110 +C***** * AN H EDIT DESCRIPTOR IS NEVER USED ON INPUT 13.5.2 00210110 +C***** * IN THE INPUT FIELD, FOR THE IW EDIT DESCRIPTOR 13.5.9.1 00220110 +C***** THE CHARACTER STRING MUST BE AN OPTIONALLY SIGNED 00230110 +C***** INTEGER CONSTANT 00240110 +CBB** ********************** BBCCOMNT **********************************00250110 +C**** 00260110 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00270110 +C**** VERSION 2.1 00280110 +C**** 00290110 +C**** 00300110 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00310110 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00320110 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00330110 +C**** BUILDING 225 RM A266 00340110 +C**** GAITHERSBURG, MD 20899 00350110 +C**** 00360110 +C**** 00370110 +C**** 00380110 +CBE** ********************** BBCCOMNT **********************************00390110 +C INPUT DATA TO THIS SEGMENT CONSISTS OF 40 CARD IMAGES IN COL. 1 - 80 00400110 +C COLS. 22 25 31 34-35 40-43 55 67 69 74-76 00410110 +CARD 1 . . . 0. E+00 + + . E00 00420110 +C COLS. 16 31 33 42-45 50 59-60 00430110 +CARD 2 + + . D+00 . D0 00440110 +C COLS. 1-----------14 18-----26 28-------38 00450110 +CARD 3 1.23456987654. +1.234E-0 -98.7654E+0 00460110 +C COLS 1---5 00470110 +CARDS 4,5,6,7,8 12345 00480110 +C COLS. 1-3 00490110 +CARDS 9,10,11,12 1.1 00500110 +C COLS. 1------------------------------------------------------58 00510110 +CARD 13 +0.339567E+02 00520110 +CARD 14 + .339567+2 00530110 +CARD 15 + 3.395670E1 00540110 +CARD 16 0.96295134244D+04 00550110 +CARD 17 .96295134244D04 00560110 +CARD 18 0.96295134244+4 00570110 +CARD 19 +.96295134244D4 00580110 +CARD 20 31.23+0.14E+04+0.2D+02 00590110 +CARD 21 31.23 .14D+4 +.2+2 00600110 +CARD 22 -0.13579E+054444 00610110 +CARD 23 4444 00620110 +CARD 24 4444 00630110 +CARD 25 4444 00640110 +CARD 26 4444 00650110 +CARD 27 -333 5.555+0.4545E-04 00660110 +CARD 28 -6.666 .9989E+12 00670110 +CARD 29 7.77-0.747E-02 +0.549E022 00680110 +CARD 30 +0.662E-00 0.468-1011 00690110 +CARD 31 0.59542D+04-44.6666-0.1234560000D-03 00700110 +CARD 32 54.9327-0.1395624534D+00 00710110 +CARD 33 65432.1 00720110 +CARD 34 +0.848E+03 .848E3 + .1290D7+0.129D+07 0.412D21 00730110 +CARD 35 22222222222222222222222222222222222222222222222222 00740110 +CARD 36 -.987E0-0.987E+00 -.987D0 00750110 +CARD 37 5 5 00760110 +CARD 38 987654 8647.86 987.654 00770110 +CARD 39 1.2345E0 1.2345 1234.5 00780110 +CARD 40 12345. 00790110 +CARD COLS. NOT MENTIONED ARE BLANK 00800110 +C***** 00810110 +C***** S P E C I F I C A T I O N S SEGMENT 350 00820110 +C***** 00830110 + REAL A1S(5),A2S(2,2),A3S(3,3,3),AC1S(25),AC2S(5,6) 00840110 + DIMENSION IAC1I(5),IAC2I(2,7),EP1S(33) 00850110 + INTEGER MCA3I(2,3,3) 00860110 + REAL MVS 00870110 +C CHARACTER*80 IDATA 00880110 +C***** IDATA USED BY TEST 3 TO BYPASS CARDS 4-21 TO DELETE TEST 00890110 +C***** 00900110 +CBB** ********************** BBCINITA **********************************00910110 +C**** SPECIFICATION STATEMENTS 00920110 +C**** 00930110 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00940110 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00950110 +CBE** ********************** BBCINITA **********************************00960110 +CBB** ********************** BBCINITB **********************************00970110 +C**** INITIALIZE SECTION 00980110 + DATA ZVERS, ZVERSD, ZDATE 00990110 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 01000110 + DATA ZCOMPL, ZNAME, ZTAPE 01010110 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 01020110 + DATA ZPROJ, ZTAPED, ZPROG 01030110 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 01040110 + DATA REMRKS /' '/ 01050110 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 01060110 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 01070110 +C**** 01080110 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 01090110 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 01100110 +CZ03 ZPROG = 'PROGRAM NAME' 01110110 +CZ04 ZDATE = 'DATE OF TEST' 01120110 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 01130110 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 01140110 +CZ07 ZNAME = 'NAME OF USER' 01150110 +CZ08 ZTAPE = 'TAPE OWNER/ID' 01160110 +CZ09 ZTAPED = 'DATE TAPE COPIED' 01170110 +C 01180110 + IVPASS = 0 01190110 + IVFAIL = 0 01200110 + IVDELE = 0 01210110 + IVINSP = 0 01220110 + IVTOTL = 0 01230110 + IVTOTN = 0 01240110 + ICZERO = 0 01250110 +C 01260110 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01270110 + I01 = 05 01280110 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01290110 + I02 = 06 01300110 +C 01310110 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01320110 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01330110 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01340110 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01350110 +C 01360110 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01370110 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01380110 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01390110 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01400110 +C 01410110 +CBE** ********************** BBCINITB **********************************01420110 + IRVI = I01 01430110 + NUVI = I02 01440110 + IVTOTL = 11 01450110 + ZPROG='FM110' 01460110 +CBB** ********************** BBCHED0A **********************************01470110 +C**** 01480110 +C**** WRITE REPORT TITLE 01490110 +C**** 01500110 + WRITE (I02, 90002) 01510110 + WRITE (I02, 90006) 01520110 + WRITE (I02, 90007) 01530110 + WRITE (I02, 90008) ZVERS, ZVERSD 01540110 + WRITE (I02, 90009) ZPROG, ZPROG 01550110 + WRITE (I02, 90010) ZDATE, ZCOMPL 01560110 +CBE** ********************** BBCHED0A **********************************01570110 +C***** ALL VARIABLES AND ARRAY ELEMENTS USED IN THIS SEGMENT 01580110 +C***** ARE FIRST SET TO A NON-ZERO VALUE 01590110 +C***** 01600110 +C***** HEADER FOR SEGMENT 350 WRITTEN 01610110 +35000 FORMAT (//2X,"IOFMT - (350) ADDITIONAL FORMATTED I/O" //16X, 01620110 + 1 "DATA TRANSFERS" ,//2X, "SUBSET REFS - 12.8 13." ) 01630110 + WRITE (NUVI,35000) 01640110 +C***** 01650110 +CBB** ********************** BBCHED0B **********************************01660110 +C**** WRITE DETAIL REPORT HEADERS 01670110 +C**** 01680110 + WRITE (I02,90004) 01690110 + WRITE (I02,90004) 01700110 + WRITE (I02,90013) 01710110 + WRITE (I02,90014) 01720110 + WRITE (I02,90015) IVTOTL 01730110 +CBE** ********************** BBCHED0B **********************************01740110 + JACVI = 11111 01750110 + IAC1I(1) = -2345 01760110 + IAC2I(1,1) = 9999 01770110 + MCA3I(1,1,1) = 2 01780110 + ACVS = 1.2 01790110 + BCVS = -.34E-3 01800110 + A1S(1) = 34.56 01810110 + A1S(2) = 456.789E+02 01820110 + A2S(1,1) = -7899.3 01830110 + A2S(2,1) = +9876.543E-01 01840110 + A3S(1,1,1) = .543 01850110 + A3S(2,1,1) = 4.33E+1 01860110 + MVS = +2.22E+01 01870110 + A1S(3) = -.33456E-01 01880110 + A2S(1,2) = 9987.76E+2 01890110 + A3S(3,1,1) = 44.E-2 01900110 +C**** 01910110 +C 01920110 +CT001* TEST 1 01930110 + IVTNUM = 1 01940110 +C****** 01950110 +C***** TEST THAT BLANK INPUT FIELDS ARE TREATED AS ZERO 13.5.9 01960110 +C***** I, E, and F EDIT DESCRIPTORS ARE TESTED 01970110 +C***** CARDS 1 AND 2 01980110 +C***** 01990110 +35001 FORMAT (4(I5), 4(F3.1), 4(F11.4)/ 4(E15.8)) 02000110 + READ (IRVI,35001) JACVI, IAC1I(1), IAC2I(1,1), MCA3I(1,1,1), ACVS,02010110 + 1 A1S(1), A2S(1,1), A3S(1,1,1), BCVS, A1S(2), A2S(2,1), 02020110 + 2 A3S(2,1,1), MVS, A1S(3), A2S(1,2), A3S(3,1,1) 02030110 +C**** TO DELETE TEST INSERT THE FOLLOWING CODE: 02040110 +C**** IVDELE=IVDELE+1 02050110 +C**** WRITE (NUVI,80000) IVTNUM 02060110 +C**** COMMENT OUT FOLLOWING CODE UNTIL NEXT TEST 02070110 + IVINSP=IVINSP+1 02080110 + WRITE (NUVI,80004) IVTNUM 02090110 +70010 FORMAT (/49X,"THIS TEST CONTAINS 4 GROUPS" , 02100110 + 1 /49X,"ALL ANSWERS SHOULD BE ZERO" ) 02110110 +C************************** 02120110 + WRITE (NUVI,70010) 02130110 +35002 FORMAT (" ",16X,"COMPUTED: " ,22X, 02140110 + 1 "4 COMPUTED LINES EXPECTED" ,4(/23X,I6), 02150110 + 2 /17X,"COMPUTED: " ,22X,"4 COMPUTED LINES EXPECTED" , 02160110 + 3 4(/23X,F8.1),/17X,"COMPUTED: " ,22X, 02170110 + 4 "4 COMPUTED LINES EXPECTED" ,4(/23X,F12.5), 02180110 + 5 /17X,"COMPUTED: " ,22X,"4 COMPUTED LINES EXPECTED" , 02190110 + 6 4(/23X,E12.1)) 02200110 + WRITE (NUVI,35002) JACVI, IAC1I(1), IAC2I(1,1), MCA3I(1,1,1),ACVS,02210110 + 1 A1S(1), A2S(1,1), A3S(1,1,1), BCVS, A1S(2), A2S(2,1), 02220110 + 2 A3S(2,1,1), MVS, A1S(3), A2S(1,2), A3S(3,1,1) 02230110 +C***** 02240110 +CT002* TEST 2 02250110 + IVTNUM = 2 02260110 +C***** TEST THAT DECIMAL POINTS APPEARING IN INPUT FIELDS 13.5.9.2.102270110 +C***** OVERRIDE THE SPECIFICATIONS SUPPLIED BY E AND F 02280110 +C***** EDIT DESCRIPTORS 02290110 +70020 FORMAT (" ",48X,"THIS TEST CONTAINS 4 GROUPS" ) 02300110 + CMAVS = 1.23456 02310110 + CMBVS = 987654. 02320110 + CMEVS = 0.1234E+01 02330110 + CMFVS = -0.987654E+02 02340110 +C***** CARD 3 02350110 +35004 FORMAT (2(F7.3), 2(E12.5)) 02360110 + READ (IRVI,35004) ACVS, BCVS, FFCVS, GGCVS 02370110 +35005 FORMAT (" ",16X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 02380110 + 1 2(/23X,F12.5),/17X,"CORRECT: " ," 1.23456", 02390110 + 2 //17X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 02400110 + 3 2(/23X,F13.1),/17X,"CORRECT: " ," 987654.0", 02410110 + 4 //17X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 02420110 + 5 2(/23X,E15.4),/17X,"CORRECT: " ," 0.1234E+01" ," OR ", 02430110 + 6 " .1234+001" ,//17X,"COMPUTED: " ,22X, 02440110 + 7 "2 COMPUTED LINES EXPECTED" ,2(/23X,E17.6), 02450110 + 8 /17X,"CORRECT: " ,"-0.987654E+02" ," OR ","-.987654+002" ) 02460110 +C**** SEE TEST 1 TO DELETE TEST (ENTER CODE HERE) 02470110 + IVINSP=IVINSP+1 02480110 + WRITE (NUVI,80004) IVTNUM 02490110 + WRITE (NUVI,70020) 02500110 + WRITE (NUVI,35005) CMAVS, ACVS, CMBVS, BCVS, CMEVS, FFCVS, 02510110 + 1 CMFVS, GGCVS 02520110 +C***** 02530110 +CT003* TEST 3 02540110 + IVTNUM=3 02550110 +C***** TEST COMPLETE FORMAT RESCAN 13.3 02560110 +C***** WHEN ADDITIONAL ITEMS REMAIN IN AN I/O LIST 02570110 +C***** AND THE LAST RIGHT PARENTHESIS HAS BEEN REACHED 02580110 +C***** IN THE CORRESPONDING FORMAT STATEMENT 02590110 + JACVI = +12345 02600110 + KBCVI = 3 02610110 + CMAVS = 1.1 02620110 + CMBVS = 1.23 02630110 + CMEVS = 33.9567 02640110 + CMGVS = 1.4E+03 02650110 + AVS = .962951E+4 02660110 + BVS = 2.0E1 02670110 +C***** CARDS 4, 5, 6, 7, 8 02680110 +70030 FORMAT (/49X,"THIS TEST CONTAINS 5 GROUPS" ) 02690110 +C*********************** 02700110 +C**** TO DELETE TEST 3 - CARDS 4 THRU 21 MUST BE BYPASS 02710110 +C**** USE THE FOLLOWING CODE: 02720110 +C**** IVDELE=IVDELE+1 02730110 +C**** WRITE (NUVI,80000) IVTNUM 02740110 +C**** DO 0031 IPASS=1,18 02750110 +C0032 FORMAT (A80) 02760110 +C**** READ (IRVI,0032) IDATA 02770110 +C0031 CONTINUE 02780110 +C**** COMMENT OUT REMAINING CODE UNTIL NEXT TEST 02790110 +C************************* 02800110 + IVINSP=IVINSP+1 02810110 + WRITE (NUVI,80004) IVTNUM 02820110 + WRITE (NUVI,70030) 02830110 +35007 FORMAT (I5) 02840110 + READ (IRVI,35007) IAC1I 02850110 + 3509 FORMAT (" ",16X,"COMPUTED: " ,22X,"6 COMPUTED LINES EXPECTED" ) 02860110 + WRITE (NUVI,3509) 02870110 +35009 FORMAT(23X,I10) 02880110 + WRITE(NUVI,35009)JACVI,IAC1I 02890110 +35008 FORMAT (" ",16X,"C0RRECT: " ," 12345") 02900110 + WRITE(NUVI,35008) 02910110 +C***** CARDS 9, 10, 11, 12 02920110 +35010 FORMAT(F3.1) 02930110 + READ (IRVI,35010) A2S 02940110 + 3501 FORMAT (/17X,"COMPUTED: " ,22X,"5 COMPUTED LINES EXPECTED" ) 02950110 + WRITE (NUVI,3501) 02960110 +35012 FORMAT(23X,F8.1) 02970110 + WRITE(NUVI,35012)CMAVS,A2S 02980110 +35011 FORMAT (" ",16X,"C0RRECT: " ," 1.1") 02990110 + WRITE (NUVI,35011) 03000110 +C***** CARDS 13, 14, 15 03010110 +35013 FORMAT (E13.6) 03020110 + READ (IRVI,35013) A1S(1), HHCVS, A1S(2) 03030110 + 3504 FORMAT (/17X,"COMPUTED: " ,22X,"4 COMPUTED LINES EXPECTED" ) 03040110 + WRITE (NUVI,3504) 03050110 +35015 FORMAT(23X,E17.6) 03060110 + WRITE(NUVI,35015) CMEVS, A1S(1), HHCVS, A1S(2) 03070110 +35014 FORMAT (" ",16X,"C0RRECT: " ," 0.339567E+02" ," OR ", 03080110 + 1 " .339567+002" ) 03090110 + WRITE (NUVI,35014) 03100110 +C***** CARDS 16, 17, 18, 19 WITH D EXPONENTS 03110110 +35016 FORMAT (F18.11/E18.11) 03120110 + READ (IRVI,35016) A2S 03130110 + 3507 FORMAT (/17X,"COMPUTED: " ,22X,"5 COMPUTED LINES EXPECTED" ) 03140110 + WRITE (NUVI,3507) 03150110 +35018 FORMAT (23X,E17.6) 03160110 + WRITE (NUVI,35018) AVS, A2S 03170110 +35017 FORMAT (" ",16X,"CORRECT: " ," 0.962951E+04" , 03180110 + 1 " OR "," .962951+004" ) 03190110 + WRITE (NUVI,35017) 03200110 +C***** CARDS 20, 21 03210110 +35019 FORMAT (I1,F4.2,E9.2,F8.1) 03220110 + READ (IRVI,35019) LCCVI, DCVS, AC2S(5,6), A3S(1,2,2), MDCVI, 03230110 + 1 FFCVS, GGCVS, AAVS 03240110 +70033 FORMAT (/17X,"COMPUTED: " ,22X,"3 COMPUTED LINES EXPECTED" ) 03250110 + WRITE (NUVI,70033) 03260110 +35021 FORMAT (23X,I6, F6.2, E10.2, E9.1) 03270110 + WRITE (NUVI,35021) KBCVI, CMBVS, CMGVS, BVS, LCCVI, DCVS, 03280110 + 1 AC2S(5,6), A3S(1,2,2), MDCVI, FFCVS, GGCVS, AAVS 03290110 +35020 FORMAT (" ",16X,"CORRECT: " ,22X, 03300110 + 1 "2 CORRECT ANSWERS POSSIBLE" , 03310110 + 2 /28X,"3 1.23 0.14E+04 0.2E+02" , 03320110 + 3 /28X,"3 1.23 0.14+004 0.2+002" ) 03330110 + WRITE (NUVI,35020) 03340110 +C********************************** 03350110 +CT004* TEST 4 03360110 + IVTNUM=4 03370110 +C***** 03380110 +C************************************ 03390110 +C***** TEST THAT FORMAT CONTROL PASSES TO THE GROUP 03400110 +C***** ENCLOSED BY THE LAST PRECEDING RIGHT PARENTHESIS 03410110 +C***** WHEN THE I/O LIST CONTAINS MORE ELEMENTS THAN 03420110 +C***** THE NUMBER OF DESCRIPTORS IN THE FORMAT STATEMENT 03430110 +C*************************************** 03440110 + JACVI = +4444 03450110 + KBCVI = -333 03460110 + LCCVI = 22 03470110 + MDCVI = 11 03480110 + ACVS = 5.555 03490110 + BCVS = -6.666 03500110 + CCVS = +7.77 03510110 + DCVS = 65432.1 03520110 + CMAVS = -0.13579E+5 03530110 + CMBVS = 0.4545E-04 03540110 + CMCVS = 0.9989E12 03550110 + CMDVS = -0.747E-2 03560110 + CMEVS = +0.549E+00 03570110 + CMFVS = 0.662E-0 03580110 + CMGVS = 0.468E-10 03590110 + RAVS = +59.542E02 03600110 + RBVS = -0.01234560E-2 03610110 + RCVS = -1395624534.E-10 03620110 + RDVS = +129.E4 03630110 + REVS = 4.12E+20 03640110 + FFCVS = -44.6666 03650110 + GGCVS = +.549327E+2 03660110 + HHCVS = 848. 03670110 + MVS = -.987 03680110 +C***** CARDS 22, 23, 24, 25, 26 03690110 +35022 FORMAT ( E12.5, (I4)) 03700110 +C***** SEE NOTES TEST1 & TEST 3 TO BYPASS TEST 03710110 +C***** CARDS 22 THRU 26 MUST BE BYPASSED 03720110 + IVINSP=IVINSP+1 03730110 + WRITE (NUVI,80004) IVTNUM 03740110 + WRITE (NUVI,70040) 03750110 + READ (IRVI,35022) A1S(2), IAC1I 03760110 +70040 FORMAT (" ",48X,"THIS TEST CONTAINS 2 GROUPS" ) 03770110 +35023 FORMAT (" ",16X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 03780110 + 1 2(/23X,E16.5), 03790110 + 2 /17X,"CORRECT: " ,"-0.13579E+05" ," OR "," -.13579+005" , 03800110 + 3 //17X,"COMPUTED: " ,22X,"6 COMPUTED LINES EXPECTED" , 03810110 + 4 /(23X,I9)) 03820110 +70041 FORMAT (" ",16X,"CORRECT: " ," 4444") 03830110 + WRITE (NUVI,35023) CMAVS, A1S(2), JACVI, IAC1I 03840110 + WRITE (NUVI,70041) 03850110 +CT005* TEST 5 03860110 +C***** 03870110 + IVTNUM = 5 03880110 +C***** CARDS 27, 28 03890110 +C***** SEE NOTES TEST 1 & TEST 3 TO DELETE TEST 03900110 +C***** CARDS 27,28 SHOULD BE BYPASSED 03910110 + IVINSP=IVINSP+1 03920110 + WRITE (NUVI,80004) IVTNUM 03930110 + WRITE (NUVI,70050) 03940110 +70050 FORMAT (" ",48X,"THIS TEST CONTAINS 5 GROUPS" ) 03950110 +35025 FORMAT (I4, (F6.3), E11.4) 03960110 + READ (IRVI,35025) MRRVI, AC1S(1), EP1S(1), A3S(1,1,1), AC2S(2,2) 03970110 +35026 FORMAT (" ",16X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 03980110 + 1 2(/23X,I8),/17X,"CORRECT: " ,"-333",//17X,"COMPUTED: " , 03990110 + 2 22X,"2 COMPUTED LINES EXPECTED" ,2(/23X,F10.3), 04000110 + 3 /17X,"CORRECT: " ," 5.555",//17X,"COMPUTED: " , 04010110 + 4 22X,"2 COMPUTED LINES EXPECTED" ,2(/23X,E15.4), 04020110 + 5 /17X,"CORRECT: " ," 0.4545E-04" ," OR ",".4545-004",//17X, 04030110 + 6 "COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" ,2(/23X,F10.3), 04040110 + 7 /17X,"CORRECT: " ,"-6.666",//17X, 04050110 + 8 "COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" ,2(/23X,E15.4), 04060110 + 9 /17X,"CORRECT: " ," 0.9989E+12" ," OR ",".9989+012") 04070110 + WRITE (NUVI,35026) KBCVI, MRRVI, ACVS, AC1S(1), CMBVS, EP1S(1), 04080110 + 1 BCVS, A3S(1,1,1),CMCVS,AC2S(2,2) 04090110 +CT006* TEST 6 04100110 +C***** CARDS 29, 30 04110110 + IVTNUM = 6 04120110 +C***** SEE NOTES TEST 1 & 3 TO DELETE TEST 04130110 +C***** CARDS 29 & 30 MUST BE BYPASSED 04140110 + IVINSP=IVINSP+1 04150110 + WRITE (NUVI,80004) IVTNUM 04160110 +70060 FORMAT (" ",48X,"THIS TEST CONTAINS 7 GROUPS" ) 04170110 + WRITE (NUVI,70060) 04180110 +35027 FORMAT (F4.2, (2(E10.3)), I2) 04190110 + READ (IRVI,35027) A2S(2,2), A3S(2,1,1), EP1S(2), MCA3I(1,1,1), 04200110 + 1 BVS, AC2S(2,1), NECVI 04210110 +35028 FORMAT (" ",16X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 04220110 + 1 2(/23X,F9.2),/17X,"CORRECT: " ," 7.77",//17X,"COMPUTED: " , 04230110 + 222X,"2 COMPUTED LINES EXPECTED" ,2(/23X,E14.3),/17X,"CORRECT: " ,04240110 + 3"-0.747E-02" ," OR ","-.747-002",//17X,"COMPUTED: " ,22X, 04250110 + 4"2 COMPUTED LINES EXPECTED" ,2(/23X,E14.3),/17X,"CORRECT: " , 04260110 + 5" 0.549E+00" ," OR ",".549+000",//17X,"COMPUTED: " ,22X, 04270110 + 6"2 COMPUTED LINES EXPECTED" ,2(/23X,I7),/17X,"CORRECT: " ," 22", 04280110 + 7//17X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 04290110 + 82(/23X,E14.3), /17X,"CORRECT: " ," 0.662E+00" ," OR ",".662+000")04300110 +75028 FORMAT (//17X,"COMPUTED: " ,22X, 04310110 + 1 "2 COMPUTED LINES EXPECTED" ,2(/23X,E14.3), 04320110 + 2 /17X,"CORRECT: " ," 0.468E-10" ," OR ",".468-010", 04330110 + 3 //17X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" ,2(/23X,I7), 04340110 + 4 /17X,"CORRECT: " ," 11") 04350110 + WRITE (NUVI,35028) CCVS, A2S(2,2), CMDVS, A3S(2,1,1), CMEVS, 04360110 + 1 EP1S(2), LCCVI, MCA3I(1,1,1), CMFVS, BVS 04370110 +C 04380110 + WRITE (NUVI,75028) CMGVS,AC2S(2,1),MDCVI,NECVI 04390110 +C 04400110 +CT007* TEST 7 04410110 + IVTNUM = 7 04420110 +C***** CARDS 31, 32 04430110 +C***** SEE NOTES TEST 1 & TEST 3 TO DELETE TEST 04440110 +C***** CARDS 31,& 32 SHOULD BE BYPASSED 04450110 + IVINSP=IVINSP+1 04460110 + WRITE (NUVI,80004) IVTNUM 04470110 + WRITE (NUVI,70070) 04480110 +70070 FORMAT (" ",48X,"THIS TEST CONTAINS 5 GROUPS" ) 04490110 +35029 FORMAT (E12.5, (F8.4, E17.10)) 04500110 + READ (IRVI,35029) CAVS, EP1S(3), A1S(1), A2S(1,2), A2S(2,1) 04510110 +35030 FORMAT (" ",16X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 04520110 + 1 /(23X, E16.5)) 04530110 +70071 FORMAT (/17X,"CORRECT: " ," 0.59542E+04" ," OR ", 04540110 + 1 ".59542+004" ) 04550110 + WRITE (NUVI,35030) RAVS, CAVS 04560110 + WRITE (NUVI,70071) 04570110 +35031 FORMAT (" ",16X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 04580110 + 1 2(/23X,F12.4),/17X,"CORRECT: " ,"-44.6666", 04590110 + 2 //17X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 04600110 + 3 2(/23X,E17.6), 04610110 + 4 /17X,"CORRECT: " ,"-0.123456E-03" ," OR ","-.123456-003" , 04620110 + 5 //17X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 04630110 + 6 2(/23X,F12.4),/17X,"CORRECT: " ," 54.9327",//17X, 04640110 + 7 "COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" ,/(23X,E17.6)) 04650110 +C 04660110 +70072 FORMAT (/17X,"CORRECT: " ,"-0.139562E+00" ," OR ", 04670110 + 1 "-.139562+000" ) 04680110 + WRITE (NUVI,35031) FFCVS, EP1S(3), RBVS, A1S(1), GGCVS, A2S(1,2),04690110 + 1 RCVS, A2S(2,1) 04700110 + WRITE (NUVI,70072) 04710110 +C**** 04720110 +CT008* TEST 8 04730110 + IVTNUM = 8 04740110 +C***** CARDS 33, 34, 35, 36 04750110 +C***** SEE NOTES TEST 1 & TEST 3 TO DELETE TEST 04760110 +C***** CARDS 33 THRU 36 SHOULD BE BYPASSED 04770110 + IVINSP=IVINSP+1 04780110 + WRITE (NUVI,80004) IVTNUM 04790110 + WRITE (NUVI,70080) 04800110 +70080 FORMAT (" ",48X,"THIS TEST CONTAINS 5 GROUPS" ) 04810110 +C***** THIS READ CAUSES AN INPUT DATA CARD TO BE SKIPPED 04820110 +35032 FORMAT( F7.1, (/2(E10.3), 2(E10.3)), E10.3) 04830110 + READ (IRVI,35032) CVS, A2S(2,1), A3S(1,2,2), A3S(1,1,1), 04840110 + 1 A3S(2,2,1), A2S(1,1), A3S(1,2,1), EP1S(4),A1S(2) 04850110 +35033 FORMAT (" ",16X,"COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" , 04860110 + 1 2(/23X,F12.1),/17X,"CORRECT: " ," 65432.1",//17X, 04870110 + 2 "COMPUTED: " ,22X,"3 COMPUTED LINES EXPECTED" ,3(/23X,E14.3), 04880110 + 3 /17X,"CORRECT: " ," 0.848E+03" ," OR ",".848+003",//17X, 04890110 + 4 "COMPUTED: " ,22X,"3 COMPUTED LINES EXPECTED" ,3(/23X,E14.3), 04900110 + 5 /17X,"CORRECT: " ," 0.129E+07" ," OR ",".129+007",//17X, 04910110 + 6 "COMPUTED: " ,22X,"2 COMPUTED LINES EXPECTED" ,2(/23X,E14.3), 04920110 + 7 /17X,"CORRECT: " ," 0.412E+21" ," OR ",".412+021",//17X, 04930110 + 8 "COMPUTED: " ,22X,"4 COMPUTED LINES EXPECTED" ,4(/23X,E14.3), 04940110 + 9 /17X,"CORRECT: " ,"-0.987E+00" ," OR ","-.987+000") 04950110 + WRITE (NUVI,35033) DCVS, CVS, HHCVS, A2S(2,1), A3S(1,2,2),RDVS, 04960110 + 1 A3S(1,1,1), A3S(2,2,1), REVS, A2S(1,1), 04970110 + 2 MVS, A3S(1,2,1), EP1S(4),A1S(2) 04980110 +CT009* TEST 9 04990110 + IVTNUM = 9 05000110 +C***** TEST FOR EMPTY FORMAT STATEMENT 05010110 +C***** SEE NOTES TEST 1 TO DELETE TEST 05020110 + IVINSP=IVINSP+1 05030110 + WRITE (NUVI,80004) IVTNUM 05040110 +35034 FORMAT (" ",48X,"EMPTY FORMAT ( ) WRITE" , 05050110 + 1 //2X,"THE FOLLOWING LINE SHOULD BE BLANK" ) 05060110 + WRITE (NUVI,35034) 05070110 +35035 FORMAT ( ) 05080110 + WRITE (NUVI,35035) 05090110 +35036 FORMAT (2X," END EMPTY FORMAT TEST" ) 05100110 + WRITE (NUVI,35036) 05110110 +C***** POSITION INPUT TO INSURE CORRECT RECORD FOR NEXT TESTS 05120110 +35037 IF (MRRVI - 5) 35038, 35039, 35038 05130110 +C***** CARD 37 05140110 +35038 READ (IRVI, 35025) MRRVI 05150110 + GO TO 35037 05160110 +35039 CONTINUE 05170110 +CT010* TEST 10 05180110 + IVTNUM = 10 05190110 +C***** 05200110 +C***** ADDITIONAL SCALE FACTOR ON INPUT-OUTPUT 13.5.7 05210110 +C***** CARD 38 05220110 + IVINSP=IVINSP+1 05230110 + WRITE (NUVI,80004) IVTNUM 05240110 +35040 FORMAT (1PE10.3, -1PE10.2, E10.3) 05250110 + READ (IRVI,35040) A1S(3), A1S(4), A1S(5) 05260110 +C**** SEE NOTES TEST 1 TO DELETE TEST (INSERT CODE HERE) 05270110 +35041 FORMAT (" ",16X,"COMPUTED: " , 05280110 + 1 E12.3, E12.4, E12.4, 05290110 + 2 /17X,"CORRECT: " ,22X,"2 CORRECT ANSWERS POSSIBLE" , 05300110 + 3 /30X,"0.988E+02 0.8648E+05 0.9877E+04" , 05310110 + 4 /30X," .988+002 .8648+005 .9877+004" ) 05320110 + WRITE(NUVI, 35041) A1S(3), A1S(4), A1S(5) 05330110 +CT011* TEST 11 05340110 + IVTNUM = 11 05350110 +C***** CARDS 39 & 40 05360110 +C***** SCALE FACTOR HAS NO EFFECT ON FORMAT RESCAN OR F EDIT 05370110 +C***** DESCRIPTOR WITH INPUT DATA CONTAINING AN EXPONENT 05380110 + AAVS = .087654 05390110 + BAVS = .87654 05400110 +35042 FORMAT (-1P,2F8.1, +1P, 2X,(F8.1)) 05410110 + READ (IRVI, 35042) AVS, BVS, CVS, DVS 05420110 +C**** SEE NOTES TEST 1 TO DELETE TEST 05430110 + IVINSP=IVINSP+1 05440110 + WRITE (NUVI,80004) IVTNUM 05450110 +35043 FORMAT (" ",16X,"COMPUTED: " ,22X, 05460110 + 1 "3 COMPUTED LINES EXPECTED" ,/25X,F8.4, F8.3, F8.2, F8.1, 1P, 05470110 + 2 /26X, F5.4, 3X, 2P, F5.3, +3P, " ", (23X,F6.2),3X) 05480110 + 5043 FORMAT (17X,"CORRECT: " ,22X," " , 05490110 + 1 /25X," 1.2345 12.345 123.45 1234.5" ,/24X, 05500110 + 2 " .8765 8.765 87.65" /21X, 05510110 + 3 " 876.54") 05520110 + WRITE (NUVI,35043) AVS,BVS,CVS,DVS,AAVS,AAVS,AAVS,BAVS 05530110 + WRITE (NUVI,5043) 05540110 +CBB** ********************** BBCSUM0 **********************************05550110 +C**** WRITE OUT TEST SUMMARY 05560110 +C**** 05570110 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 05580110 + WRITE (I02, 90004) 05590110 + WRITE (I02, 90014) 05600110 + WRITE (I02, 90004) 05610110 + WRITE (I02, 90020) IVPASS 05620110 + WRITE (I02, 90022) IVFAIL 05630110 + WRITE (I02, 90024) IVDELE 05640110 + WRITE (I02, 90026) IVINSP 05650110 + WRITE (I02, 90028) IVTOTN, IVTOTL 05660110 +CBE** ********************** BBCSUM0 **********************************05670110 +CBB** ********************** BBCFOOT0 **********************************05680110 +C**** WRITE OUT REPORT FOOTINGS 05690110 +C**** 05700110 + WRITE (I02,90016) ZPROG, ZPROG 05710110 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 05720110 + WRITE (I02,90019) 05730110 +CBE** ********************** BBCFOOT0 **********************************05740110 +CBB** ********************** BBCFMT0A **********************************05750110 +C**** FORMATS FOR TEST DETAIL LINES 05760110 +C**** 05770110 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 05780110 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 05790110 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 05800110 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 05810110 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 05820110 + 1I6,/," ",15X,"CORRECT= " ,I6) 05830110 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05840110 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 05850110 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05860110 + 1A21,/," ",16X,"CORRECT= " ,A21) 05870110 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 05880110 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 05890110 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 05900110 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 05910110 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 05920110 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 05930110 +80050 FORMAT (" ",48X,A31) 05940110 +CBE** ********************** BBCFMT0A **********************************05950110 +CBB** ********************** BBCFMAT1 **********************************05960110 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 05970110 +C**** 05980110 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05990110 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 06000110 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 06010110 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 06020110 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06030110 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06040110 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06050110 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06060110 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06070110 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 06080110 + 2"(",F12.5,", ",F12.5,")") 06090110 +CBE** ********************** BBCFMAT1 **********************************06100110 +CBB** ********************** BBCFMT0B **********************************06110110 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 06120110 +C**** 06130110 +90002 FORMAT ("1") 06140110 +90004 FORMAT (" ") 06150110 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )06160110 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06170110 +90008 FORMAT (" ",21X,A13,A17) 06180110 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 06190110 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 06200110 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 06210110 + 1 7X,"REMARKS",24X) 06220110 +90014 FORMAT (" ","----------------------------------------------" , 06230110 + 1 "---------------------------------" ) 06240110 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 06250110 +C**** 06260110 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 06270110 +C**** 06280110 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 06290110 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 06300110 + 1 A13) 06310110 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 06320110 +C**** 06330110 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 06340110 +C**** 06350110 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 06360110 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 06370110 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 06380110 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 06390110 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 06400110 +CBE** ********************** BBCFMT0B **********************************06410110 +C***** END OF TEST SEGMENT 350 06420110 + STOP 06430110 + END 06440110 diff --git a/Fortran/UnitTests/fcvs21_f95/FM110.reference_input b/Fortran/UnitTests/fcvs21_f95/FM110.reference_input new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM110.reference_input @@ -0,0 +1,41 @@ + . . . 0. E+00 + + . E00 + + + . D+00 . D0 +1.23456987654. +1.234E-0 -98.7654E+0 +12345 +12345 +12345 +12345 +12345 +1.1 +1.1 +1.1 +1.1 ++0.339567E+02 + + .339567+2 + + 3.395670E1 + 0.96295134244D+04 + .96295134244D04 + 0.96295134244+4 + +.96295134244D4 +31.23+0.14E+04+0.2D+02 +31.23 .14D+4 +.2+2 +-0.13579E+054444 +4444 +4444 +4444 +4444 +-333 5.555+0.4545E-04 +-6.666 .9989E+12 +7.77-0.747E-02 +0.549E022 ++0.662E-00 0.468-1011 + 0.59542D+04-44.6666-0.1234560000D-03 + 54.9327-0.1395624534D+00 +65432.1 ++0.848E+03 .848E3 + .1290D7+0.129D+07 0.412D21 +22222222222222222222222222222222222222222222222222 + -.987E0-0.987E+00 -.987D0 + 5 5 + 987654 8647.86 987.654 +1.2345E0 1.2345 1234.5 +12345. + diff --git a/Fortran/UnitTests/fcvs21_f95/FM110.reference_output b/Fortran/UnitTests/fcvs21_f95/FM110.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM110.reference_output @@ -0,0 +1,277 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM110BEGIN* TEST RESULTS - FM110 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + IOFMT - (350) ADDITIONAL FORMATTED I/O + + DATA TRANSFERS + + SUBSET REFS - 12.8 13. + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 11 TESTS + + 1 INSPECT + + THIS TEST CONTAINS 4 GROUPS + ALL ANSWERS SHOULD BE ZERO + COMPUTED: 4 COMPUTED LINES EXPECTED + 0 + 0 + 0 + 0 + COMPUTED: 4 COMPUTED LINES EXPECTED + 0.0 + 0.0 + 0.0 + 0.0 + COMPUTED: 4 COMPUTED LINES EXPECTED + 0.00000 + 0.00000 + 0.00000 + 0.00000 + COMPUTED: 4 COMPUTED LINES EXPECTED + 0.0E+00 + 0.0E+00 + 0.0E+00 + 0.0E+00 + 2 INSPECT + THIS TEST CONTAINS 4 GROUPS + COMPUTED: 2 COMPUTED LINES EXPECTED + 1.23456 + 1.23456 + CORRECT: 1.23456 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 987654.0 + 987654.0 + CORRECT: 987654.0 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 0.1234E+01 + 0.1234E+01 + CORRECT: 0.1234E+01 OR .1234+001 + + COMPUTED: 2 COMPUTED LINES EXPECTED + -0.987654E+02 + -0.987654E+02 + CORRECT: -0.987654E+02 OR -.987654+002 + 3 INSPECT + + THIS TEST CONTAINS 5 GROUPS + COMPUTED: 6 COMPUTED LINES EXPECTED + 12345 + 12345 + 12345 + 12345 + 12345 + 12345 + C0RRECT: 12345 + + COMPUTED: 5 COMPUTED LINES EXPECTED + 1.1 + 1.1 + 1.1 + 1.1 + 1.1 + C0RRECT: 1.1 + + COMPUTED: 4 COMPUTED LINES EXPECTED + 0.339567E+02 + 0.339567E+02 + 0.339567E+02 + 0.339567E+02 + C0RRECT: 0.339567E+02 OR .339567+002 + + COMPUTED: 5 COMPUTED LINES EXPECTED + 0.962951E+04 + 0.962951E+04 + 0.962951E+04 + 0.962951E+04 + 0.962951E+04 + CORRECT: 0.962951E+04 OR .962951+004 + + COMPUTED: 3 COMPUTED LINES EXPECTED + 3 1.23 0.14E+04 0.2E+02 + 3 1.23 0.14E+04 0.2E+02 + 3 1.23 0.14E+04 0.2E+02 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 3 1.23 0.14E+04 0.2E+02 + 3 1.23 0.14+004 0.2+002 + 4 INSPECT + THIS TEST CONTAINS 2 GROUPS + COMPUTED: 2 COMPUTED LINES EXPECTED + -0.13579E+05 + -0.13579E+05 + CORRECT: -0.13579E+05 OR -.13579+005 + + COMPUTED: 6 COMPUTED LINES EXPECTED + 4444 + 4444 + 4444 + 4444 + 4444 + 4444 + CORRECT: 4444 + 5 INSPECT + THIS TEST CONTAINS 5 GROUPS + COMPUTED: 2 COMPUTED LINES EXPECTED + -333 + -333 + CORRECT: -333 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 5.555 + 5.555 + CORRECT: 5.555 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 0.4545E-04 + 0.4545E-04 + CORRECT: 0.4545E-04 OR .4545-004 + + COMPUTED: 2 COMPUTED LINES EXPECTED + -6.666 + -6.666 + CORRECT: -6.666 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 0.9989E+12 + 0.9989E+12 + CORRECT: 0.9989E+12 OR .9989+012 + 6 INSPECT + THIS TEST CONTAINS 7 GROUPS + COMPUTED: 2 COMPUTED LINES EXPECTED + 7.77 + 7.77 + CORRECT: 7.77 + + COMPUTED: 2 COMPUTED LINES EXPECTED + -0.747E-02 + -0.747E-02 + CORRECT: -0.747E-02 OR -.747-002 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 0.549E+00 + 0.549E+00 + CORRECT: 0.549E+00 OR .549+000 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 22 + 22 + CORRECT: 22 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 0.662E+00 + 0.662E+00 + CORRECT: 0.662E+00 OR .662+000 + + + COMPUTED: 2 COMPUTED LINES EXPECTED + 0.468E-10 + 0.468E-10 + CORRECT: 0.468E-10 OR .468-010 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 11 + 11 + CORRECT: 11 + 7 INSPECT + THIS TEST CONTAINS 5 GROUPS + COMPUTED: 2 COMPUTED LINES EXPECTED + 0.59542E+04 + 0.59542E+04 + + CORRECT: 0.59542E+04 OR .59542+004 + COMPUTED: 2 COMPUTED LINES EXPECTED + -44.6666 + -44.6666 + CORRECT: -44.6666 + + COMPUTED: 2 COMPUTED LINES EXPECTED + -0.123456E-03 + -0.123456E-03 + CORRECT: -0.123456E-03 OR -.123456-003 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 54.9327 + 54.9327 + CORRECT: 54.9327 + + COMPUTED: 2 COMPUTED LINES EXPECTED + -0.139562E+00 + -0.139562E+00 + + CORRECT: -0.139562E+00 OR -.139562+000 + 8 INSPECT + THIS TEST CONTAINS 5 GROUPS + COMPUTED: 2 COMPUTED LINES EXPECTED + 65432.1 + 65432.1 + CORRECT: 65432.1 + + COMPUTED: 3 COMPUTED LINES EXPECTED + 0.848E+03 + 0.848E+03 + 0.848E+03 + CORRECT: 0.848E+03 OR .848+003 + + COMPUTED: 3 COMPUTED LINES EXPECTED + 0.129E+07 + 0.129E+07 + 0.129E+07 + CORRECT: 0.129E+07 OR .129+007 + + COMPUTED: 2 COMPUTED LINES EXPECTED + 0.412E+21 + 0.412E+21 + CORRECT: 0.412E+21 OR .412+021 + + COMPUTED: 4 COMPUTED LINES EXPECTED + -0.987E+00 + -0.987E+00 + -0.987E+00 + -0.987E+00 + CORRECT: -0.987E+00 OR -.987+000 + 9 INSPECT + EMPTY FORMAT ( ) WRITE + + THE FOLLOWING LINE SHOULD BE BLANK + + END EMPTY FORMAT TEST + 10 INSPECT + COMPUTED: 0.988E+02 0.8648E+05 0.9877E+04 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 0.988E+02 0.8648E+05 0.9877E+04 + .988+002 .8648+005 .9877+004 + 11 INSPECT + COMPUTED: 3 COMPUTED LINES EXPECTED + 1.2345 12.345 123.45 1234.5 + .8765 8.765 87.65 + 876.54 + CORRECT: + 1.2345 12.345 123.45 1234.5 + .8765 8.765 87.65 + 876.54 + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 11 TESTS REQUIRE INSPECTION + 11 OF 11 TESTS EXECUTED + + *FM110END* END OF TEST - FM110 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM200.f b/Fortran/UnitTests/fcvs21_f95/FM200.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM200.f @@ -0,0 +1,519 @@ + PROGRAM FM200 00010200 +C 00020200 +C 00030200 +C THIS ROUTINE IS THE FIRST AUDIT PROGRAM TO CONTAIN A PROGRAM 00040200 +C STATEMENT. THE FOLLOWING FEATURES FROM CHAPTER 3., CHARACTERS, 00050200 +C LINES AND EXECUTION SEQUENCE ARE TESTED. 00060200 +C 00070200 +C (1) ASTERISK (*) IN COLUMN 1 TO DESIGNATE A COMMENT LINE. 00080200 +C (2) USE OF NON-FORTRAN CHARACTERS WITHIN A COMMENT LINE. 00090200 +C (3) STATEMENT LABELS ON NONEXECUTABLE STATEMENTS. 00100200 +C (4) DIGIT 0 IN COLUMN 6 OF AN INITIAL LINE. 00110200 +C (5) CONTINUATION LINES - MAXIMUM OF NINE CONTINUATION LINES 00120200 +C (660 CHARACTERS). 00130200 +C (6) BLANK CHARACTERS WITHIN STATEMENTS. 00140200 +C (7) BLANK COMMENT LINE, BLANK CHARACTERS IN COLUMNS 1-72. 00150200 +C 00160200 +C THE BASIC FEATURES OF SUBSET FORTRAN WHICH ARE TESTED BY THIS 00170200 +C PROGRAM ARE USED THROUGHOUT THE REST OF THE SUBSET ROUTINES. 00180200 +C 00190200 +C REFERENCES 00200200 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00210200 +C X3.9-1978 00220200 +C 00230200 +C SECTION 3.1.6, BLANK CHARACTER 00240200 +C SECTION 3.2.1, COMMENT LINE 00250200 +C SECTION 3.2.2, INITIAL LINE 00260200 +C SECTION 3.2.3, CONTINUATION LINE 00270200 +C SECTION 3.3, STATEMENTS 00280200 +C SECTION 3.4, STATEMENT LABEL 00290200 +C SECTION 14.1, PROGRAM STATEMENT 00300200 +C 00310200 +C 00320200 +C ******************************************************************00330200 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00340200 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00350200 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00360200 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00370200 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00380200 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00390200 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00400200 +C THE RESULT OF EXECUTING THESE TESTS. 00410200 +C 00420200 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00430200 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00440200 +C 00450200 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00460200 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00470200 +C SOFTWARE STANDARDS VALIDATION GROUP 00480200 +C BUILDING 225 RM A266 00490200 +C GAITHERSBURG, MD 20899 00500200 +C ******************************************************************00510200 +C 00520200 +C 00530200 + IMPLICIT LOGICAL (L) 00540200 + IMPLICIT CHARACTER*14 (C) 00550200 +C 00560200 + 12 INTEGER XVTN01 00570200 + 22 DATA IVON02/5/ 00580200 +C THE PRECEDING STATEMENTS ARE NONEXECUTABLE STATEMENTS WHICH 00590200 +C CONTAIN STATEMENT LABELS. THEY ARE REFERENCED IN TESTS 1 AND 2. 00600200 +C 00610200 +C 00620200 +C 00630200 +C INITIALIZATION SECTION. 00640200 +C 00650200 +C INITIALIZE CONSTANTS 00660200 +C ******************** 00670200 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00680200 + I01 = 5 00690200 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00700200 + I02 = 6 00710200 +C SYSTEM ENVIRONMENT SECTION 00720200 +C 00730200 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00740200 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750200 +C (UNIT NUMBER FOR CARD READER). 00760200 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00770200 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00780200 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00790200 +C 00800200 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00810200 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00820200 +C (UNIT NUMBER FOR PRINTER). 00830200 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00840200 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850200 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00860200 +C 00870200 + IVPASS = 0 00880200 + IVFAIL = 0 00890200 + IVDELE = 0 00900200 + ICZERO = 0 00910200 +C 00920200 +C WRITE OUT PAGE HEADERS 00930200 +C 00940200 + WRITE (I02,90002) 00950200 + WRITE (I02,90006) 00960200 + WRITE (I02,90008) 00970200 + WRITE (I02,90004) 00980200 + WRITE (I02,90010) 00990200 + WRITE (I02,90004) 01000200 + WRITE (I02,90016) 01010200 + WRITE (I02,90001) 01020200 + WRITE (I02,90004) 01030200 + WRITE (I02,90012) 01040200 + WRITE (I02,90014) 01050200 + WRITE (I02,90004) 01060200 +C 01070200 +C 01080200 +C TEST 1 AND TEST 2 REFERENCE VARIABLES DEFINED IN NONEXECUTABLE 01090200 +C STATEMENTS WHICH CONTAIN STATEMENT LABELS. THE NONEXECUTABLE 01100200 +C STATEMENTS WHICH APPEAR AT THE BEGINNING OF THE PROGRAM ARE 01110200 +C 12 INTEGER XVTN01 01120200 +C 22 DATA IVON02/5/ 01130200 +C 01140200 +C REFERENCE X3.9-1977, SECTION 3.4, STATEMENT LABELS 01150200 +C 01160200 +C 01170200 +C **** FCVS PROGRAM 200 - TEST 001 **** 01180200 +C 01190200 +C TEST 001 ASSIGNS AN INTEGER VALUE TO XVTN01 WHICH WAS SPECIFIED01200200 +C AS TYPE INTEGER IN AN INTEGER STATEMENT CONTAINING A STATEMENT 01210200 +C LABEL. 01220200 +C 01230200 + IVTNUM = 1 01240200 + IF (ICZERO) 30010, 0010, 30010 01250200 + 0010 CONTINUE 01260200 + IVCOMP = 0 01270200 + XVTN01 = 1 01280200 + IVCOMP = XVTN01 01290200 + IVCORR = 1 01300200 +40010 IF (IVCOMP - 1) 20010, 10010, 20010 01310200 +30010 IVDELE = IVDELE + 1 01320200 + WRITE (I02,80000) IVTNUM 01330200 + IF (ICZERO) 10010, 0021, 20010 01340200 +10010 IVPASS = IVPASS + 1 01350200 + WRITE (I02,80002) IVTNUM 01360200 + GO TO 0021 01370200 +20010 IVFAIL = IVFAIL + 1 01380200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01390200 + 0021 CONTINUE 01400200 +C 01410200 +C **** FCVS PROGRAM 200 - TEST 002 **** 01420200 +C 01430200 +C TEST 002 CHECKS THE VALUE WHICH WAS ASSIGNED TO IVON02 BY A 01440200 +C DATA STATEMENT WITH A STATEMENT LABEL. 01450200 +C 01460200 + IVTNUM = 2 01470200 + IF (ICZERO) 30020, 0020, 30020 01480200 + 0020 CONTINUE 01490200 + IVCOMP = 0 01500200 + IVCOMP = IVON02 01510200 + IVCORR = 5 01520200 +40020 IF (IVCOMP - 5) 20020, 10020, 20020 01530200 +30020 IVDELE = IVDELE + 1 01540200 + WRITE (I02,80000) IVTNUM 01550200 + IF (ICZERO) 10020, 0031, 20020 01560200 +10020 IVPASS = IVPASS + 1 01570200 + WRITE (I02,80002) IVTNUM 01580200 + GO TO 0031 01590200 +20020 IVFAIL = IVFAIL + 1 01600200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01610200 + 0031 CONTINUE 01620200 +C 01630200 +C TEST 3 THROUGH TEST 5 USE AN ASTERISK (*) IN COLUMN 1 TO 01640200 +C DENOTE A COMMENT LINE. 01650200 +C 01660200 +C REFERENCE X3.9-1977, SECTION 3.2.1, COMMENT LINE 01670200 +C 01680200 +C 01690200 +C **** FCVS PROGRAM 200 - TEST 003 **** 01700200 +C 01710200 +C GO TO STATEMENT IN ASTERISK COMMENT LINE. 01720200 +C 01730200 + IVTNUM = 3 01740200 + IF (ICZERO) 30030, 0030, 30030 01750200 + 0030 CONTINUE 01760200 + IVCOMP = 1 01770200 +* GO TO 20030 01780200 + IVCOMP = 0 01790200 + IVCORR = 0 01800200 +40030 IF (IVCOMP) 20030, 10030, 20030 01810200 +30030 IVDELE = IVDELE + 1 01820200 + WRITE (I02,80000) IVTNUM 01830200 + IF (ICZERO) 10030, 0041, 20030 01840200 +10030 IVPASS = IVPASS + 1 01850200 + WRITE (I02,80002) IVTNUM 01860200 + GO TO 0041 01870200 +20030 IVFAIL = IVFAIL + 1 01880200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01890200 + 0041 CONTINUE 01900200 +C 01910200 +C **** FCVS PROGRAM 200 - TEST 004 **** 01920200 +C 01930200 +C SEVERAL * COMMENT LINES INTERMIXED WITH EXECUTABLE STATEMENTS. 01940200 +C 01950200 + IVTNUM = 4 01960200 + IF (ICZERO) 30040, 0040, 30040 01970200 + 0040 CONTINUE 01980200 + IVCOMP = 0 01990200 +* THE * COMMENT LINE IS THE SAME AS A C COMMENT LINE. 02000200 + IVCOMP = 1 02010200 +* THE * COMMENT LINES HAVE NO EFFECT ON THE PROGRAM EXECUTION. 02020200 +* THEIR USE IS STRICTLY FOR DOCUMENTATION PURPOSES. 02030200 + IVCOMP = 2 02040200 +* IVCOMP = 3 02050200 +* 40 ANY STATEMENT LABELS ON COMMENT LINES ARE IGNORED. 02060200 + IVCORR = 2 02070200 +40040 IF (IVCOMP - 2) 20040, 10040, 20040 02080200 +30040 IVDELE = IVDELE + 1 02090200 + WRITE (I02,80000) IVTNUM 02100200 + IF (ICZERO) 10040, 0051, 20040 02110200 +10040 IVPASS = IVPASS + 1 02120200 + WRITE (I02,80002) IVTNUM 02130200 + GO TO 0051 02140200 +20040 IVFAIL = IVFAIL + 1 02150200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02160200 + 0051 CONTINUE 02170200 +C 02180200 +C **** FCVS PROGRAM 200 - TEST 005 **** 02190200 +C 02200200 +C NONFORTRAN CHARACTERS WITHIN C AND * COMMENT LINES. 02210200 +C 02220200 + IVTNUM = 5 02230200 + IF (ICZERO) 30050, 0050, 30050 02240200 + 0050 CONTINUE 02250200 + IVCOMP = 1 02260200 +* <>%? NONFORTRAN CHARACTER 02270200 +C <>%? NONFORTRAN CHARACTER 02280200 + IVCOMP = 0 02290200 + IVCORR = 0 02300200 +40050 IF (IVCOMP) 20050, 10050, 20050 02310200 +30050 IVDELE = IVDELE + 1 02320200 + WRITE (I02,80000) IVTNUM 02330200 + IF (ICZERO) 10050, 0061, 20050 02340200 +10050 IVPASS = IVPASS + 1 02350200 + WRITE (I02,80002) IVTNUM 02360200 + GO TO 0061 02370200 +20050 IVFAIL = IVFAIL + 1 02380200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02390200 + 0061 CONTINUE 02400200 +C 02410200 +C **** FCVS PROGRAM 200 - TEST 006 **** 02420200 +C 02430200 +C LINES CONTAINING ONLY BLANK CHARACTERS IN COLUMNS 1 THROUGH 02440200 +C 72 ARE COMMENT LINES. 02450200 +C 02460200 +C REFERENCE X3.9-1977, SECTION 3.2.1, COMMENT LINE 02470200 +C 02480200 + IVTNUM = 6 02490200 + IF (ICZERO) 30060, 0060, 30060 02500200 + 0060 CONTINUE 02510200 + IVCOMP = 0 02520200 + 02530200 + IVCORR = 3 02540200 + IVCOMP = 9 02550200 +* ASTERISK COMMENT LINE FOLLOWED BY BLANK COMMENT LINE. 02560200 + 02570200 +* ASTERISK COMMENT LINE. 02580200 + IVCOMP = 3 02590200 +40060 IF (IVCOMP - 3) 20060, 10060, 20060 02600200 +30060 IVDELE = IVDELE + 1 02610200 + WRITE (I02,80000) IVTNUM 02620200 + IF (ICZERO) 10060, 0071, 20060 02630200 +10060 IVPASS = IVPASS + 1 02640200 + WRITE (I02,80002) IVTNUM 02650200 + GO TO 0071 02660200 +20060 IVFAIL = IVFAIL + 1 02670200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02680200 + 0071 CONTINUE 02690200 +C 02700200 +C TEST 7 AND TEST 8 CONTAIN THE DIGIT 0 IN COLUMN 6 OF INITIAL 02710200 +C LINES. 02720200 +C 02730200 +C REFERENCE X3.9-1977, SECTION 3.2.2, INITIAL LINE 02740200 +C 02750200 +C 02760200 +C **** FCVS PROGRAM 200 - TEST 007 **** 02770200 +C 02780200 +C TEST 007 USES THE DIGIT 0 IN COLUMN 6 OF TWO SUCCESSIVE 02790200 +C INITIAL LINES. 02800200 +C 02810200 + IVTNUM = 7 02820200 + IF (ICZERO) 30070, 0070, 30070 02830200 + 0070 CONTINUE 02840200 + IVCOMP = 0 02850200 + 0IVON01 = 5 02860200 + 0IVON02 = 6 02870200 + IVCOMP = IVON01 + IVON02 02880200 + IVCORR = 11 02890200 +40070 IF (IVCOMP - 11) 20070, 10070, 20070 02900200 +30070 IVDELE = IVDELE + 1 02910200 + WRITE (I02,80000) IVTNUM 02920200 + IF (ICZERO) 10070, 0081, 20070 02930200 +10070 IVPASS = IVPASS + 1 02940200 + WRITE (I02,80002) IVTNUM 02950200 + GO TO 0081 02960200 +20070 IVFAIL = IVFAIL + 1 02970200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02980200 + 0081 CONTINUE 02990200 +C 03000200 +C **** FCVS PROGRAM 200 - TEST 008 **** 03010200 +C 03020200 +C TEST 008 MIXES STATEMENTS WITH DIGIT 0 IN COLUMN 6 OF INITIAL 03030200 +C LINE AND COMMENT LINES WITH * IN COLUMN 1. 03040200 +C 03050200 + IVTNUM = 8 03060200 + IF (ICZERO) 30080, 0080, 30080 03070200 + 0080 CONTINUE 03080200 + IVCOMP = 0 03090200 +* FIRST INITIAL LINE FOLLOWS. 03100200 + 0IVON01 = 5 03110200 +* TWO SUCCESSIVE COMMENT LINES, 03120200 +* FOLLOWED BY TWO INITIAL LINES. 03130200 + 0IVON02=4 03140200 + 0IVCOMP=IVON01+IVON02 03150200 +* FALL THROUGH TO VERIFICATION CODE 03160200 + IVCORR = 9 03170200 +40080 IF (IVCOMP - 9) 20080, 10080, 20080 03180200 +30080 IVDELE = IVDELE + 1 03190200 + WRITE (I02,80000) IVTNUM 03200200 + IF (ICZERO) 10080, 0091, 20080 03210200 +10080 IVPASS = IVPASS + 1 03220200 + WRITE (I02,80002) IVTNUM 03230200 + GO TO 0091 03240200 +20080 IVFAIL = IVFAIL + 1 03250200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03260200 + 0091 CONTINUE 03270200 +C 03280200 +C TEST 9 THROUGH TEST 13 VERIFY THAT CONTINUATION LINES ARE 03290200 +C PERMITTED. 03300200 +C 03310200 +C REFERENCE X3.9-1977, SECTION 3.2.3, CONTINUATION LINE 03320200 +C 03330200 +C 03340200 +C **** FCVS PROGRAM 200 - TEST 009 **** 03350200 +C 03360200 +C STATEMENT WITH TWO CONTINUATION LINES. 03370200 +C 03380200 + IVTNUM = 9 03390200 + IF (ICZERO) 30090, 0090, 30090 03400200 + 0090 CONTINUE 03410200 + IVON01 = 0 03420200 + IVON 03430200 + 1 01 03440200 + 2 = 2 03450200 + IVCOMP = IVON01 03460200 + IVCORR = 2 03470200 +40090 IF (IVCOMP - 2) 20090, 10090, 20090 03480200 +30090 IVDELE = IVDELE + 1 03490200 + WRITE (I02,80000) IVTNUM 03500200 + IF (ICZERO) 10090, 0101, 20090 03510200 +10090 IVPASS = IVPASS + 1 03520200 + WRITE (I02,80002) IVTNUM 03530200 + GO TO 0101 03540200 +20090 IVFAIL = IVFAIL + 1 03550200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03560200 + 0101 CONTINUE 03570200 +C 03580200 +C **** FCVS PROGRAM 200 - TEST 010 **** 03590200 +C 03600200 +C STATEMENT WITH NINE CONTINUATION LINES. 03610200 +C 03620200 + IVTNUM = 10 03630200 + IF (ICZERO) 30100, 0100, 30100 03640200 + 0100 CONTINUE 03650200 + IVON01 = 0 03660200 + IVON01 = 03670200 + 1 1 03680200 + 2 +1 03690200 + 3 +1 03700200 + 4 +1 03710200 + 5 +1 03720200 + 6 +1 03730200 + 7 +1 03740200 + 8 +1 03750200 + 9+1 03760200 + IVCOMP = IVON01 03770200 + IVCORR = 9 03780200 +40100 IF (IVCOMP - 9) 20100, 10100, 20100 03790200 +30100 IVDELE = IVDELE + 1 03800200 + WRITE (I02,80000) IVTNUM 03810200 + IF (ICZERO) 10100, 0111, 20100 03820200 +10100 IVPASS = IVPASS + 1 03830200 + WRITE (I02,80002) IVTNUM 03840200 + GO TO 0111 03850200 +20100 IVFAIL = IVFAIL + 1 03860200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03870200 + 0111 CONTINUE 03880200 +C 03890200 +C **** FCVS PROGRAM 200 - TEST 011 **** 03900200 +C 03910200 +C TEST 011 CONTAINS THE MAXIMUM NUMBER OF CONTINUATION LINES 03920200 +C PERMITTED IN THE SUBSET LANGUAGE AND EACH OF THE 660 CHARACTERS 03930200 +C IN THE STATEMENT ARE NONBLANK. 03940200 +C 03950200 + IVTNUM = 11 03960200 + IF (ICZERO) 30110, 0110, 30110 03970200 + 0110 CONTINUE 03980200 + IVON01 = 1 03990200 + IVCOMP = 0 04000200 + IVCOMP=IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVO04010200 + 1N01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON0104020200 + 2+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IV04030200 + 3ON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON004040200 + 41+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+I04050200 + 5VON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON04060200 + 601+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+04070200 + 7IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVO04080200 + 8N01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON0104090200 + 9+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+IVON01+1204100200 + IVCORR = 105 04110200 +40110 IF (IVCOMP - 105) 20110, 10110, 20110 04120200 +30110 IVDELE = IVDELE + 1 04130200 + WRITE (I02,80000) IVTNUM 04140200 + IF (ICZERO) 10110, 0121, 20110 04150200 +10110 IVPASS = IVPASS + 1 04160200 + WRITE (I02,80002) IVTNUM 04170200 + GO TO 0121 04180200 +20110 IVFAIL = IVFAIL + 1 04190200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04200200 + 0121 CONTINUE 04210200 +C 04220200 +C **** FCVS PROGRAM 200 - TEST 012 **** 04230200 +C 04240200 +C TEST 012 SPLITS A STATEMENT ACROSS 8 CONTINUATION LINES. 04250200 +C THERE IS A STATEMENT LABEL IN COLUMNS 1-5 AND 0 IN COLUMN 6 04260200 +C OF THE INITIAL LINE. 04270200 +C 04280200 + IVTNUM = 12 04290200 + IF (ICZERO) 30120, 0120, 30120 04300200 + 0120 CONTINUE 04310200 + IVON01 = 0 04320200 + GO TO 0122 04330200 + 01220 I 04340200 + 1 V 04350200 + 2 O 04360200 + 3 N 04370200 + 4 0 04380200 + 5 1 04390200 + 6 = 04400200 + 7 8 04410200 + 8 9 04420200 + IVCOMP = IVON01 04430200 + IVCORR = 89 04440200 +40120 IF (IVCOMP - 89) 20120, 10120, 20120 04450200 +30120 IVDELE = IVDELE + 1 04460200 + WRITE (I02,80000) IVTNUM 04470200 + IF (ICZERO) 10120, 0131, 20120 04480200 +10120 IVPASS = IVPASS + 1 04490200 + WRITE (I02,80002) IVTNUM 04500200 + GO TO 0131 04510200 +20120 IVFAIL = IVFAIL + 1 04520200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04530200 + 0131 CONTINUE 04540200 +C 04550200 +C **** FCVS PROGRAM 200 - TEST 013 **** 04560200 +C 04570200 +C TEST 013 CONSISTS OF AN INITIAL LINE WHICH CONTAINS ONLY A 04580200 +C STATEMENT LABEL AND A CONTINUATION LINE WHICH CONTAINS THE 04590200 +C EXECUTABLE STATEMENT. 04600200 +C 04610200 + IVTNUM = 13 04620200 + IF (ICZERO) 30130, 0130, 30130 04630200 + 0130 CONTINUE 04640200 + IVCOMP = 0 04650200 + 0132 04660200 + 1IVCOMP = 4 04670200 + IVCORR = 4 04680200 +40130 IF (IVCOMP - 4) 20130, 10130, 20130 04690200 +30130 IVDELE = IVDELE + 1 04700200 + WRITE (I02,80000) IVTNUM 04710200 + IF (ICZERO) 10130, 0141, 20130 04720200 +10130 IVPASS = IVPASS + 1 04730200 + WRITE (I02,80002) IVTNUM 04740200 + GO TO 0141 04750200 +20130 IVFAIL = IVFAIL + 1 04760200 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04770200 + 0141 CONTINUE 04780200 +C 04790200 +C 04800200 +C WRITE OUT TEST SUMMARY 04810200 +C 04820200 + WRITE (I02,90004) 04830200 + WRITE (I02,90014) 04840200 + WRITE (I02,90004) 04850200 + WRITE (I02,90000) 04860200 + WRITE (I02,90004) 04870200 + WRITE (I02,90020) IVFAIL 04880200 + WRITE (I02,90022) IVPASS 04890200 + WRITE (I02,90024) IVDELE 04900200 + STOP 04910200 +90001 FORMAT (" ",24X,"FM200") 04920200 +90000 FORMAT (" ",20X,"END OF PROGRAM FM200" ) 04930200 +C 04940200 +C FORMATS FOR TEST DETAIL LINES 04950200 +C 04960200 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 04970200 +80002 FORMAT (" ",4X,I5,7X,"PASS") 04980200 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 04990200 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 05000200 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 05010200 +C 05020200 +C FORMAT STATEMENTS FOR PAGE HEADERS 05030200 +C 05040200 +90002 FORMAT ("1") 05050200 +90004 FORMAT (" ") 05060200 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05070200 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 05080200 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 05090200 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 05100200 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 05110200 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 05120200 +C 05130200 +C FORMAT STATEMENTS FOR RUN SUMMARY 05140200 +C 05150200 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 05160200 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 05170200 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 05180200 + END 05190200 diff --git a/Fortran/UnitTests/fcvs21_f95/FM200.reference_output b/Fortran/UnitTests/fcvs21_f95/FM200.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM200.reference_output @@ -0,0 +1,34 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM200 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + + ---------------------------------------------- + + END OF PROGRAM FM200 + + 0 TESTS FAILED + 13 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM201.f b/Fortran/UnitTests/fcvs21_f95/FM201.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM201.f @@ -0,0 +1,676 @@ + PROGRAM FM201 00010201 +C 00020201 +C 00030201 +C THIS ROUTINE VERIFIES THAT 00040201 +C 00050201 +C (1) THE VALUE OF A SIGNED ZERO IS THE SAME AS THE VALUE OF 00060201 +C AN UNSIGNED ZERO FOR INTEGER AND REAL VARIABLES. 00070201 +C 00080201 +C (2) A BASIC REAL CONSTANT MAY BE WRITTEN WITH MORE DIGITS 00090201 +C THAN A PROCESSOR WILL USE TO APPROXIMATE THE VALUE OF 00100201 +C THE CONSTANT. 00110201 +C 00120201 +C (3) AN IMPLICIT STATEMENT CAN BE USED TO CHANGE THE DEFAULT 00130201 +C IMPLICIT INTEGER AND REAL TYPING. 00140201 +C 00150201 +C (4) THE IMPLICIT INTEGER AND REAL TYPING OF AN IMPLICIT 00160201 +C STATEMENT MAY BE OVERRIDDEN BY THE APPEARANCE OF A 00170201 +C VARIABLE NAME IN A TYPE-STATEMENT. 00180201 +C 00190201 +C REFERENCES 00200201 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00210201 +C X3.9-1978 00220201 +C 00230201 +C SECTION 4.1.3, DATA TYPE PROPERTIES 00240201 +C SECTION 4.4.1, BASIC REAL CONSTANT 00250201 +C SECTION 6.1.5, INTEGER DIVISION 00260201 +C SECTION 8.4, TYPE-STATEMENTS 00270201 +C SECTION 8.5, IMPLICIT STATEMENT 00280201 +C 00290201 +C 00300201 +C ******************************************************************00310201 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00320201 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00330201 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00340201 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00350201 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00360201 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00370201 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00380201 +C THE RESULT OF EXECUTING THESE TESTS. 00390201 +C 00400201 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00410201 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00420201 +C 00430201 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00440201 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00450201 +C SOFTWARE STANDARDS VALIDATION GROUP 00460201 +C BUILDING 225 RM A266 00470201 +C GAITHERSBURG, MD 20899 00480201 +C ******************************************************************00490201 +C 00500201 +C 00510201 + IMPLICIT LOGICAL (L) 00520201 + IMPLICIT CHARACTER*14 (C) 00530201 +C 00540201 + IMPLICIT INTEGER (Y, V-X), REAL (M) 00550201 + REAL RVTN01, RVTN02, RVTN03, YVTN02 00560201 + INTEGER IVTN01, IVTN02, MVTN02 00570201 +C THE ABOVE THREE STATEMENTS ARE REFERENCED IN TESTS 29 THRU 35. 00580201 +C 00590201 +C 00600201 +C 00610201 +C INITIALIZATION SECTION. 00620201 +C 00630201 +C INITIALIZE CONSTANTS 00640201 +C ******************** 00650201 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00660201 + I01 = 5 00670201 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00680201 + I02 = 6 00690201 +C SYSTEM ENVIRONMENT SECTION 00700201 +C 00710201 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00720201 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00730201 +C (UNIT NUMBER FOR CARD READER). 00740201 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00750201 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00760201 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00770201 +C 00780201 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00790201 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00800201 +C (UNIT NUMBER FOR PRINTER). 00810201 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00820201 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00830201 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00840201 +C 00850201 + IVPASS = 0 00860201 + IVFAIL = 0 00870201 + IVDELE = 0 00880201 + ICZERO = 0 00890201 +C 00900201 +C WRITE OUT PAGE HEADERS 00910201 +C 00920201 + WRITE (I02,90002) 00930201 + WRITE (I02,90006) 00940201 + WRITE (I02,90008) 00950201 + WRITE (I02,90004) 00960201 + WRITE (I02,90010) 00970201 + WRITE (I02,90004) 00980201 + WRITE (I02,90016) 00990201 + WRITE (I02,90001) 01000201 + WRITE (I02,90004) 01010201 + WRITE (I02,90012) 01020201 + WRITE (I02,90014) 01030201 + WRITE (I02,90004) 01040201 +C 01050201 +C 01060201 +C TEST 14 THROUGH TEST 17 COMPARE INTEGER VARIABLES WHICH ARE 01070201 +C SET TO SIGNED ZERO AND UNSIGNED ZERO VALUES BY THE FOLLOWING 01080201 +C STATEMENTS 01090201 +C 01100201 + IVON01 = 0 01110201 + IVON02 = -0 01120201 + IVON03 = +0 01130201 +C 01140201 +C REFERENCE X3.9-1978, SECTION 4.1.3, DATA TYPE PROPERTIES 01150201 +C 01160201 +C **** FCVS PROGRAM 201 - TEST 014 **** 01170201 +C 01180201 +C COMPARE 0 TO -0 01190201 +C 01200201 + IVTNUM = 14 01210201 + IF (ICZERO) 30140, 0140, 30140 01220201 + 0140 CONTINUE 01230201 + IVCOMP = 1 01240201 + IVCORR = 0 01250201 + IF (IVON01 .EQ. IVON02) IVCOMP = 0 01260201 +40140 IF (IVCOMP) 20140, 10140, 20140 01270201 +30140 IVDELE = IVDELE + 1 01280201 + WRITE (I02,80000) IVTNUM 01290201 + IF (ICZERO) 10140, 0151, 20140 01300201 +10140 IVPASS = IVPASS + 1 01310201 + WRITE (I02,80002) IVTNUM 01320201 + GO TO 0151 01330201 +20140 IVFAIL = IVFAIL + 1 01340201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01350201 + 0151 CONTINUE 01360201 +C 01370201 +C **** FCVS PROGRAM 201 - TEST 015 **** 01380201 +C 01390201 +C COMPARE 0 TO +0 01400201 +C 01410201 + IVTNUM = 15 01420201 + IF (ICZERO) 30150, 0150, 30150 01430201 + 0150 CONTINUE 01440201 + IVCOMP = 1 01450201 + IVCORR = 0 01460201 + IF (IVON01 .EQ. IVON03) IVCOMP = 0 01470201 +40150 IF (IVCOMP) 20150, 10150, 20150 01480201 +30150 IVDELE = IVDELE + 1 01490201 + WRITE (I02,80000) IVTNUM 01500201 + IF (ICZERO) 10150, 0161, 20150 01510201 +10150 IVPASS = IVPASS + 1 01520201 + WRITE (I02,80002) IVTNUM 01530201 + GO TO 0161 01540201 +20150 IVFAIL = IVFAIL + 1 01550201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01560201 + 0161 CONTINUE 01570201 +C 01580201 +C **** FCVS PROGRAM 201 - TEST 016 **** 01590201 +C 01600201 +C COMPARE -0 TO +0 01610201 +C 01620201 + IVTNUM = 16 01630201 + IF (ICZERO) 30160, 0160, 30160 01640201 + 0160 CONTINUE 01650201 + IVCOMP = 1 01660201 + IVCORR = 0 01670201 + IF (IVON02 .EQ. IVON03) IVCOMP = 0 01680201 +40160 IF (IVCOMP) 20160, 10160, 20160 01690201 +30160 IVDELE = IVDELE + 1 01700201 + WRITE (I02,80000) IVTNUM 01710201 + IF (ICZERO) 10160, 0171, 20160 01720201 +10160 IVPASS = IVPASS + 1 01730201 + WRITE (I02,80002) IVTNUM 01740201 + GO TO 0171 01750201 +20160 IVFAIL = IVFAIL + 1 01760201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01770201 + 0171 CONTINUE 01780201 +C 01790201 +C **** FCVS PROGRAM 201 - TEST 017 **** 01800201 +C 01810201 +C MINUS ZERO (-0) SHOULD NOT BE LESS THAN PLUS ZERO (+0) 01820201 +C 01830201 + IVTNUM = 17 01840201 + IF (ICZERO) 30170, 0170, 30170 01850201 + 0170 CONTINUE 01860201 + IVCOMP = 1 01870201 + IVCORR = 0 01880201 + IF (IVON02 .LT. IVON03) GO TO 20170 01890201 + IVCOMP = 0 01900201 + GO TO 10170 01910201 +30170 IVDELE = IVDELE + 1 01920201 + WRITE (I02,80000) IVTNUM 01930201 + IF (ICZERO) 10170, 0181, 20170 01940201 +10170 IVPASS = IVPASS + 1 01950201 + WRITE (I02,80002) IVTNUM 01960201 + GO TO 0181 01970201 +20170 IVFAIL = IVFAIL + 1 01980201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01990201 + 0181 CONTINUE 02000201 +C 02010201 +C TEST 18 THROUGH TEST 24 COMPARE REAL VARIABLES WHICH ARE SET 02020201 +C TO SIGNED ZERO AND UNSIGNED ZERO VALUES BY THE FOLLOWING 02030201 +C STATEMENTS 02040201 +C 02050201 + RVON01 = 0.0 02060201 + RVON02 = -0.0 02070201 + RVON03 = +0.0 02080201 + RVON04 = -0.0E+01 02090201 + RVON05 = -0E+10 02100201 +C 02110201 +C REFERENCE X3.9-1978, SECTION 4.1.3, DATA TYPE PROPERTIES 02120201 +C 02130201 +C **** FCVS PROGRAM 201 - TEST 018 **** 02140201 +C 02150201 +C COMPARE 0.0 TO -0.0 02160201 +C 02170201 + IVTNUM = 18 02180201 + IF (ICZERO) 30180, 0180, 30180 02190201 + 0180 CONTINUE 02200201 + IVCOMP = 1 02210201 + IVCORR = 0 02220201 + IF (RVON01 .EQ. RVON02) IVCOMP = 0 02230201 +40180 IF (IVCOMP) 20180, 10180, 20180 02240201 +30180 IVDELE = IVDELE + 1 02250201 + WRITE (I02,80000) IVTNUM 02260201 + IF (ICZERO) 10180, 0191, 20180 02270201 +10180 IVPASS = IVPASS + 1 02280201 + WRITE (I02,80002) IVTNUM 02290201 + GO TO 0191 02300201 +20180 IVFAIL = IVFAIL + 1 02310201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02320201 + 0191 CONTINUE 02330201 +C 02340201 +C **** FCVS PROGRAM 201 - TEST 019 **** 02350201 +C 02360201 +C COMPARE 0.0 TO +0.0 02370201 +C 02380201 + IVTNUM = 19 02390201 + IF (ICZERO) 30190, 0190, 30190 02400201 + 0190 CONTINUE 02410201 + IVCOMP = 1 02420201 + IVCORR = 0 02430201 + IF (RVON01 .EQ. RVON03) IVCOMP = 0 02440201 +40190 IF (IVCOMP) 20190, 10190, 20190 02450201 +30190 IVDELE = IVDELE + 1 02460201 + WRITE (I02,80000) IVTNUM 02470201 + IF (ICZERO) 10190, 0201, 20190 02480201 +10190 IVPASS = IVPASS + 1 02490201 + WRITE (I02,80002) IVTNUM 02500201 + GO TO 0201 02510201 +20190 IVFAIL = IVFAIL + 1 02520201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02530201 + 0201 CONTINUE 02540201 +C 02550201 +C **** FCVS PROGRAM 201 - TEST 020 **** 02560201 +C 02570201 +C COMPARE -0.0 TO +0.0 02580201 +C 02590201 + IVTNUM = 20 02600201 + IF (ICZERO) 30200, 0200, 30200 02610201 + 0200 CONTINUE 02620201 + IVCOMP = 1 02630201 + IVCORR = 0 02640201 + IF (RVON02 .EQ. RVON03) IVCOMP = 0 02650201 +40200 IF (IVCOMP) 20200, 10200, 20200 02660201 +30200 IVDELE = IVDELE + 1 02670201 + WRITE (I02,80000) IVTNUM 02680201 + IF (ICZERO) 10200, 0211, 20200 02690201 +10200 IVPASS = IVPASS + 1 02700201 + WRITE (I02,80002) IVTNUM 02710201 + GO TO 0211 02720201 +20200 IVFAIL = IVFAIL + 1 02730201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02740201 + 0211 CONTINUE 02750201 +C 02760201 +C **** FCVS PROGRAM 201 - TEST 021 **** 02770201 +C 02780201 +C MINUS ZERO (-0.0) SHOULD NOT BE LESS THAN PLUS ZERO (+0.0) 02790201 +C 02800201 + IVTNUM = 21 02810201 + IF (ICZERO) 30210, 0210, 30210 02820201 + 0210 CONTINUE 02830201 + IVCOMP = 1 02840201 + IVCORR = 0 02850201 + IF (RVON02 .LT. RVON03) GO TO 20210 02860201 + IVCOMP = 0 02870201 + GO TO 10210 02880201 +30210 IVDELE = IVDELE + 1 02890201 + WRITE (I02,80000) IVTNUM 02900201 + IF (ICZERO) 10210, 0221, 20210 02910201 +10210 IVPASS = IVPASS + 1 02920201 + WRITE (I02,80002) IVTNUM 02930201 + GO TO 0221 02940201 +20210 IVFAIL = IVFAIL + 1 02950201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02960201 + 0221 CONTINUE 02970201 +C 02980201 +C **** FCVS PROGRAM 201 - TEST 022 **** 02990201 +C 03000201 +C COMPARE -0.0E+01 TO 0.0 03010201 +C 03020201 + IVTNUM = 22 03030201 + IF (ICZERO) 30220, 0220, 30220 03040201 + 0220 CONTINUE 03050201 + IVCOMP = 1 03060201 + IVCORR = 0 03070201 + IF (RVON04 .EQ. RVON01) IVCOMP = 0 03080201 +40220 IF (IVCOMP) 20220, 10220, 20220 03090201 +30220 IVDELE = IVDELE + 1 03100201 + WRITE (I02,80000) IVTNUM 03110201 + IF (ICZERO) 10220, 0231, 20220 03120201 +10220 IVPASS = IVPASS + 1 03130201 + WRITE (I02,80002) IVTNUM 03140201 + GO TO 0231 03150201 +20220 IVFAIL = IVFAIL + 1 03160201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03170201 + 0231 CONTINUE 03180201 +C 03190201 +C **** FCVS PROGRAM 201 - TEST 023 **** 03200201 +C 03210201 +C COMPARE -0E+10 TO 0.0 03220201 +C 03230201 + IVTNUM = 23 03240201 + IF (ICZERO) 30230, 0230, 30230 03250201 + 0230 CONTINUE 03260201 + IVCOMP = 1 03270201 + IVCORR = 0 03280201 + IF (RVON05 .EQ. RVON01) IVCOMP = 0 03290201 +40230 IF (IVCOMP) 20230, 10230, 20230 03300201 +30230 IVDELE = IVDELE + 1 03310201 + WRITE (I02,80000) IVTNUM 03320201 + IF (ICZERO) 10230, 0241, 20230 03330201 +10230 IVPASS = IVPASS + 1 03340201 + WRITE (I02,80002) IVTNUM 03350201 + GO TO 0241 03360201 +20230 IVFAIL = IVFAIL + 1 03370201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03380201 + 0241 CONTINUE 03390201 +C 03400201 +C **** FCVS PROGRAM 201 - TEST 024 **** 03410201 +C 03420201 +C COMPARE -0E+10 TO +0.0 03430201 +C 03440201 + IVTNUM = 24 03450201 + IF (ICZERO) 30240, 0240, 30240 03460201 + 0240 CONTINUE 03470201 + IVCOMP = 1 03480201 + IVCORR = 0 03490201 + IF (RVON05 .NE. RVON03) GO TO 20240 03500201 + IVCOMP = 0 03510201 + GO TO 10240 03520201 +30240 IVDELE = IVDELE + 1 03530201 + WRITE (I02,80000) IVTNUM 03540201 + IF (ICZERO) 10240, 0251, 20240 03550201 +10240 IVPASS = IVPASS + 1 03560201 + WRITE (I02,80002) IVTNUM 03570201 + GO TO 0251 03580201 +20240 IVFAIL = IVFAIL + 1 03590201 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03600201 + 0251 CONTINUE 03610201 +C 03620201 +C TEST 25 THROUGH TEST 28 VERIFY THAT A BASIC REAL CONSTANT MAY 03630201 +C BE WRITTEN WITH MORE DIGITS THAN A PROCESSOR WILL USE TO APPROXI- 03640201 +C MATE THE VALUE OF THE CONSTANT. 03650201 +C 03660201 +C REFERENCE X3.9-1978, SECTION 4.4.1, BASIC REAL CONSTANT 03670201 +C 03680201 +C 03690201 +C **** FCVS PROGRAM 201 - TEST 025 **** 03700201 +C 03710201 +C EIGHT DIGITS IN BASIC REAL CONSTANT 03720201 +C 03730201 + IVTNUM = 25 03740201 + IF (ICZERO) 30250, 0250, 30250 03750201 + 0250 CONTINUE 03760201 + RVON06 = 0.0 03770201 + RVCOMP = 0.0 03780201 + RVON06 = 3.1561234 03790201 + RVCOMP = RVON06 03800201 + RVCORR = 3.1561 03810201 +40250 IF (RVCOMP - 3.1556) 20250, 10250, 40251 03820201 +40251 IF (RVCOMP - 3.1566) 10250, 10250, 20250 03830201 +30250 IVDELE = IVDELE + 1 03840201 + WRITE (I02,80000) IVTNUM 03850201 + IF (ICZERO) 10250, 0261, 20250 03860201 +10250 IVPASS = IVPASS + 1 03870201 + WRITE (I02,80002) IVTNUM 03880201 + GO TO 0261 03890201 +20250 IVFAIL = IVFAIL + 1 03900201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03910201 + 0261 CONTINUE 03920201 +C 03930201 +C **** FCVS PROGRAM 201 - TEST 026 **** 03940201 +C 03950201 +C EIGHT DIGITS IN BASIC REAL CONSTANT PLUS A REAL EXPONENT. 03960201 +C 03970201 + IVTNUM = 26 03980201 + IF (ICZERO) 30260, 0260, 30260 03990201 + 0260 CONTINUE 04000201 + RVON06 = 0.0 04010201 + RVCOMP = 0.0 04020201 + RVON06 = .31561234E+01 04030201 + RVCOMP = RVON06 04040201 + RVCORR = 3.1561 04050201 +40260 IF (RVCOMP - 3.1556) 20260, 10260, 40261 04060201 +40261 IF (RVCOMP - 3.1566) 10260, 10260, 20260 04070201 +30260 IVDELE = IVDELE + 1 04080201 + WRITE (I02,80000) IVTNUM 04090201 + IF (ICZERO) 10260, 0271, 20260 04100201 +10260 IVPASS = IVPASS + 1 04110201 + WRITE (I02,80002) IVTNUM 04120201 + GO TO 0271 04130201 +20260 IVFAIL = IVFAIL + 1 04140201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04150201 + 0271 CONTINUE 04160201 +C 04170201 +C **** FCVS PROGRAM 201 - TEST 027 **** 04180201 +C 04190201 +C TWELVE DIGITS IN BASIC REAL CONSTANT. 04200201 +C 04210201 + IVTNUM = 27 04220201 + IF (ICZERO) 30270, 0270, 30270 04230201 + 0270 CONTINUE 04240201 + RVON06 = 0.0 04250201 + RVCOMP = 0.0 04260201 + RVON06 = 315612347833 E-11 04270201 + RVCOMP = RVON06 04280201 + RVCORR = 3.1561 04290201 +40270 IF (RVCOMP - 3.1556) 20270, 10270, 40271 04300201 +40271 IF (RVCOMP - 3.1566) 10270, 10270, 20270 04310201 +30270 IVDELE = IVDELE + 1 04320201 + WRITE (I02,80000) IVTNUM 04330201 + IF (ICZERO) 10270, 0281, 20270 04340201 +10270 IVPASS = IVPASS + 1 04350201 + WRITE (I02,80002) IVTNUM 04360201 + GO TO 0281 04370201 +20270 IVFAIL = IVFAIL + 1 04380201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04390201 + 0281 CONTINUE 04400201 +C 04410201 +C **** FCVS PROGRAM 201 - TEST 028 **** 04420201 +C 04430201 +C TWENTY-FIVE DIGITS IN BASIC REAL CONSTANT. 04440201 +C 04450201 + IVTNUM = 28 04460201 + IF (ICZERO) 30280, 0280, 30280 04470201 + 0280 CONTINUE 04480201 + RVON06 = 0.0 04490201 + RVCOMP = 0.0 04500201 + RVON06 = 31.56123478334867532834672E-1 04510201 + RVCOMP = RVON06 04520201 + RVCORR = 3.1561 04530201 +40280 IF (RVCOMP - 3.1556) 20280, 10280, 40281 04540201 +40281 IF (RVCOMP - 3.1566) 10280, 10280, 20280 04550201 +30280 IVDELE = IVDELE + 1 04560201 + WRITE (I02,80000) IVTNUM 04570201 + IF (ICZERO) 10280, 0291, 20280 04580201 +10280 IVPASS = IVPASS + 1 04590201 + WRITE (I02,80002) IVTNUM 04600201 + GO TO 0291 04610201 +20280 IVFAIL = IVFAIL + 1 04620201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04630201 + 0291 CONTINUE 04640201 +C 04650201 +C TEST 29 THROUGH TEST 33 REFERENCE VARIABLES WHOSE TYPE WAS 04660201 +C SPECIFIED BY AN IMPLICIT STATEMENT. DIVISION IS USED TO VERIFY 04670201 +C THAT THE TYPE IS INTEGER OR REAL. 04680201 +C 04690201 +C REFERENCE X3.9-1978, SECTION 8.5, IMPLICIT STATEMENT 04700201 +C 04710201 +C 04720201 +C **** FCVS PROGRAM 201 - TEST 029 **** 04730201 +C 04740201 +C VERIFY YVIN01 IS AN INTEGER VARIABLE. 04750201 +C 04760201 + IVTNUM = 29 04770201 + IF (ICZERO) 30290, 0290, 30290 04780201 + 0290 CONTINUE 04790201 + RVCOMP = 10.0 04800201 + YVIN01 = 4.0 04810201 + RVCOMP = YVIN01/5 04820201 + RVCORR = 0.0 04830201 +40290 IF (RVCOMP) 20290, 10290, 20290 04840201 +30290 IVDELE = IVDELE + 1 04850201 + WRITE (I02,80000) IVTNUM 04860201 + IF (ICZERO) 10290, 0301, 20290 04870201 +10290 IVPASS = IVPASS + 1 04880201 + WRITE (I02,80002) IVTNUM 04890201 + GO TO 0301 04900201 +20290 IVFAIL = IVFAIL + 1 04910201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04920201 + 0301 CONTINUE 04930201 +C 04940201 +C **** FCVS PROGRAM 201 - TEST 030 **** 04950201 +C 04960201 +C VERIFY VVIN01 IS AN INTEGER VARIABLE 04970201 +C 04980201 + IVTNUM = 30 04990201 + IF (ICZERO) 30300, 0300, 30300 05000201 + 0300 CONTINUE 05010201 + RVCOMP = 10.0 05020201 + VVIN01 = 4.0 05030201 + RVCOMP = VVIN01/5 05040201 + RVCORR = 0.0 05050201 +40300 IF (RVCOMP) 20300, 10300, 20300 05060201 +30300 IVDELE = IVDELE + 1 05070201 + WRITE (I02,80000) IVTNUM 05080201 + IF (ICZERO) 10300, 0311, 20300 05090201 +10300 IVPASS = IVPASS + 1 05100201 + WRITE (I02,80002) IVTNUM 05110201 + GO TO 0311 05120201 +20300 IVFAIL = IVFAIL + 1 05130201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05140201 + 0311 CONTINUE 05150201 +C 05160201 +C **** FCVS PROGRAM 201 - TEST 031 **** 05170201 +C 05180201 +C VERIFY WVIN01 IS AN INTEGER VARIABLE. 05190201 +C 05200201 + IVTNUM = 31 05210201 + IF (ICZERO) 30310, 0310, 30310 05220201 + 0310 CONTINUE 05230201 + RVCOMP = 10.0 05240201 + WVIN01 = 4.0 05250201 + RVCOMP = WVIN01/5 05260201 + RVCORR = 0.0 05270201 +40310 IF (RVCOMP) 20310, 10310, 20310 05280201 +30310 IVDELE = IVDELE + 1 05290201 + WRITE (I02,80000) IVTNUM 05300201 + IF (ICZERO) 10310, 0321, 20310 05310201 +10310 IVPASS = IVPASS + 1 05320201 + WRITE (I02,80002) IVTNUM 05330201 + GO TO 0321 05340201 +20310 IVFAIL = IVFAIL + 1 05350201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05360201 + 0321 CONTINUE 05370201 +C 05380201 +C **** FCVS PROGRAM 201 - TEST 032 **** 05390201 +C 05400201 +C VERIFY XVIN01 IS AN INTEGER VARIABLE. 05410201 +C 05420201 + IVTNUM = 32 05430201 + IF (ICZERO) 30320, 0320, 30320 05440201 + 0320 CONTINUE 05450201 + XVIN01 = 4 05460201 + RVCOMP = 10.0 05470201 + RVCOMP = XVIN01/5 05480201 + RVCORR = 0.0 05490201 +40320 IF (RVCOMP) 20320, 10320, 20320 05500201 +30320 IVDELE = IVDELE + 1 05510201 + WRITE (I02,80000) IVTNUM 05520201 + IF (ICZERO) 10320, 0331, 20320 05530201 +10320 IVPASS = IVPASS + 1 05540201 + WRITE (I02,80002) IVTNUM 05550201 + GO TO 0331 05560201 +20320 IVFAIL = IVFAIL + 1 05570201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05580201 + 0331 CONTINUE 05590201 +C 05600201 +C **** FCVS PROGRAM 201 - TEST 033 **** 05610201 +C 05620201 +C VERIFY MVIN01 IS A REAL VARIABLE. 05630201 +C 05640201 + IVTNUM = 33 05650201 + IF (ICZERO) 30330, 0330, 30330 05660201 + 0330 CONTINUE 05670201 + RVCOMP = 10.0 05680201 + MVIN01 = 4 05690201 + RVCOMP = MVIN01/5 05700201 + RVCORR = 0.8 05710201 +40330 IF (RVCOMP - 0.79995) 20330, 10330, 40331 05720201 +40331 IF (RVCOMP - 0.80005) 10330, 10330, 20330 05730201 +30330 IVDELE = IVDELE + 1 05740201 + WRITE (I02,80000) IVTNUM 05750201 + IF (ICZERO) 10330, 0341, 20330 05760201 +10330 IVPASS = IVPASS + 1 05770201 + WRITE (I02,80002) IVTNUM 05780201 + GO TO 0341 05790201 +20330 IVFAIL = IVFAIL + 1 05800201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05810201 + 0341 CONTINUE 05820201 +C 05830201 +C TEST 34 AND TEST 35 VERIFY THAT THE IMPLICIT TYPE SPECIFICA- 05840201 +C TION FOR A VARIABLE IS OVERRIDDEN BY THE APPEARANCE OF THAT 05850201 +C VARIABLE NAME IN A TYPE-STATEMENT. 05860201 +C 05870201 +C REFERENCE X3.9-1977, SECTION 8.4, TYPE-STATEMENTS 05880201 +C SECTION 8.5, IMPLICIT STATEMENT 05890201 +C 05900201 +C 05910201 +C **** FCVS PROGRAM 201 - TEST 034 **** 05920201 +C 05930201 +C VERIFY YVTN02 IS A REAL VARIABLE. 05940201 +C 05950201 + IVTNUM = 34 05960201 + IF (ICZERO) 30340, 0340, 30340 05970201 + 0340 CONTINUE 05980201 + RVCOMP = 10.0 05990201 + YVTN02 = 4 06000201 + RVCOMP = YVTN02/5 06010201 + RVCORR = 0.8 06020201 +40340 IF (RVCOMP - 0.79995) 20340, 10340, 40341 06030201 +40341 IF (RVCOMP - 0.80005) 10340, 10340, 20340 06040201 +30340 IVDELE = IVDELE + 1 06050201 + WRITE (I02,80000) IVTNUM 06060201 + IF (ICZERO) 10340, 0351, 20340 06070201 +10340 IVPASS = IVPASS + 1 06080201 + WRITE (I02,80002) IVTNUM 06090201 + GO TO 0351 06100201 +20340 IVFAIL = IVFAIL + 1 06110201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06120201 + 0351 CONTINUE 06130201 +C 06140201 +C **** FCVS PROGRAM 201 - TEST 035 **** 06150201 +C 06160201 +C VERIFY MVTN02 IS AN INTEGER VARIABLE. 06170201 +C 06180201 + IVTNUM = 35 06190201 + IF (ICZERO) 30350, 0350, 30350 06200201 + 0350 CONTINUE 06210201 + RVCOMP = 10.0 06220201 + MVTN02 = 4.0 06230201 + RVCOMP = MVTN02/5 06240201 + RVCORR = 0.0 06250201 +40350 IF (RVCOMP) 20350, 10350, 20350 06260201 +30350 IVDELE = IVDELE + 1 06270201 + WRITE (I02,80000) IVTNUM 06280201 + IF (ICZERO) 10350, 0361, 20350 06290201 +10350 IVPASS = IVPASS + 1 06300201 + WRITE (I02,80002) IVTNUM 06310201 + GO TO 0361 06320201 +20350 IVFAIL = IVFAIL + 1 06330201 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06340201 + 0361 CONTINUE 06350201 +C 06360201 +C 06370201 +C WRITE OUT TEST SUMMARY 06380201 +C 06390201 + WRITE (I02,90004) 06400201 + WRITE (I02,90014) 06410201 + WRITE (I02,90004) 06420201 + WRITE (I02,90000) 06430201 + WRITE (I02,90004) 06440201 + WRITE (I02,90020) IVFAIL 06450201 + WRITE (I02,90022) IVPASS 06460201 + WRITE (I02,90024) IVDELE 06470201 + STOP 06480201 +90001 FORMAT (" ",24X,"FM201") 06490201 +90000 FORMAT (" ",20X,"END OF PROGRAM FM201" ) 06500201 +C 06510201 +C FORMATS FOR TEST DETAIL LINES 06520201 +C 06530201 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 06540201 +80002 FORMAT (" ",4X,I5,7X,"PASS") 06550201 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 06560201 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 06570201 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 06580201 +C 06590201 +C FORMAT STATEMENTS FOR PAGE HEADERS 06600201 +C 06610201 +90002 FORMAT ("1") 06620201 +90004 FORMAT (" ") 06630201 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06640201 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 06650201 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 06660201 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 06670201 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 06680201 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 06690201 +C 06700201 +C FORMAT STATEMENTS FOR RUN SUMMARY 06710201 +C 06720201 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 06730201 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 06740201 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 06750201 + END 06760201 diff --git a/Fortran/UnitTests/fcvs21_f95/FM201.reference_output b/Fortran/UnitTests/fcvs21_f95/FM201.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM201.reference_output @@ -0,0 +1,43 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM201 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + + ---------------------------------------------- + + END OF PROGRAM FM201 + + 0 TESTS FAILED + 22 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM202.f b/Fortran/UnitTests/fcvs21_f95/FM202.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM202.f @@ -0,0 +1,875 @@ + PROGRAM FM202 00010202 +C 00020202 +C 00030202 +C THIS ROUTINE IS THE FIRST ROUTINE TO TEST CHARACTER DATA 00040202 +C TYPES. CHARACTER TYPE-STATEMENTS SPECIFY CHARACTER VARIABLES OF 00050202 +C LENGTH ONE AND LENGTH TWO. THE TESTS IN THIS ROUTINE DETERMINE 00060202 +C THAT THE FOLLOWING LANGUAGE FEATURES FUNCTION CORRECTLY. 00070202 +C 00080202 +C (1) CHARACTER ASSIGNMENT STATEMENTS OF THE FORM 00090202 +C 00100202 +C CHARACTER VARIABLE = CHARACTER CONSTANT 00110202 +C CHARACTER VARIABLE = CHARACTER VARIABLE 00120202 +C 00130202 +C WHERE THE VARIABLES AND CONSTANTS ARE THE SAME LENGTH. 00140202 +C 00150202 +C (2) THE REPRESENTATION OF AN APOSTROPHE IN A CHARACTER 00160202 +C CONSTANT IS TWO CONSECUTIVE APOSTROPHES WITH NO INTERVENING 00170202 +C BLANKS. 00180202 +C 00190202 +C (3) CHARACTER RELATIONAL EXPRESSION OF THE FORM 00200202 +C 00210202 +C CHARACTER VARIABLE RELOP CHARACTER CONSTANT 00220202 +C CHARACTER CONSTANT RELOP CHARACTER VARIABLE 00230202 +C CHARACTER VARIABLE RELOP CHARACTER VARIABLE 00240202 +C 00250202 +C WHERE THE CHARACTER ENTITIES ARE THE SAME LENGTH. 00260202 +C 00270202 +C (4) CHARACTER RELATIONAL EXPRESSIONS OF THE FORM 00280202 +C 00290202 +C CHARACTER VARIABLE .EQ. CHARACTER CONSTANT 00300202 +C 00310202 +C ARE USED IN THIS ROUTINE TO VERIFY THE CHARACTER ASSIGNMENT 00320202 +C STATEMENTS. 00330202 +C 00340202 +C REFERENCES 00350202 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00360202 +C X3.9-1978 00370202 +C 00380202 +C SECTION 4.8, CHARACTER TYPE 00390202 +C SECTION 4.8.1, CHARACTER CONSTANT 00400202 +C SECTION 6.2, CHARACTER EXPRESSIONS 00410202 +C SECTION 6.3.4, CHARACTER RELATIONAL EXPRESSION 00420202 +C SECTION 6.3.5, INTERPRETATION OF CHARACTER RELATIONAL 00430202 +C EXPRESSIONS 00440202 +C SECTION 8.4.2, CHARACTER TYPE-STATEMENT 00450202 +C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT 00460202 +C 00470202 +C 00480202 +C 00490202 +C ******************************************************************00500202 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00510202 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00520202 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00530202 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00540202 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00550202 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00560202 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00570202 +C THE RESULT OF EXECUTING THESE TESTS. 00580202 +C 00590202 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00600202 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00610202 +C 00620202 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00630202 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00640202 +C SOFTWARE STANDARDS VALIDATION GROUP 00650202 +C BUILDING 225 RM A266 00660202 +C GAITHERSBURG, MD 20899 00670202 +C ******************************************************************00680202 +C 00690202 +C 00700202 + IMPLICIT LOGICAL (L) 00710202 + IMPLICIT CHARACTER*14 (C) 00720202 +C 00730202 + CHARACTER *1 CVTN01, CVTN02 00740202 + CHARACTER *2 CVTN03, CVTN04 00750202 +C 00760202 +C 00770202 +C 00780202 +C INITIALIZATION SECTION. 00790202 +C 00800202 +C INITIALIZE CONSTANTS 00810202 +C ******************** 00820202 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00830202 + I01 = 5 00840202 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00850202 + I02 = 6 00860202 +C SYSTEM ENVIRONMENT SECTION 00870202 +C 00880202 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00890202 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00900202 +C (UNIT NUMBER FOR CARD READER). 00910202 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00920202 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00930202 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00940202 +C 00950202 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00960202 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00970202 +C (UNIT NUMBER FOR PRINTER). 00980202 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00990202 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01000202 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01010202 +C 01020202 + IVPASS = 0 01030202 + IVFAIL = 0 01040202 + IVDELE = 0 01050202 + ICZERO = 0 01060202 +C 01070202 +C WRITE OUT PAGE HEADERS 01080202 +C 01090202 + WRITE (I02,90002) 01100202 + WRITE (I02,90006) 01110202 + WRITE (I02,90008) 01120202 + WRITE (I02,90004) 01130202 + WRITE (I02,90010) 01140202 + WRITE (I02,90004) 01150202 + WRITE (I02,90016) 01160202 + WRITE (I02,90001) 01170202 + WRITE (I02,90004) 01180202 + WRITE (I02,90012) 01190202 + WRITE (I02,90014) 01200202 + WRITE (I02,90004) 01210202 +C 01220202 +C 01230202 +C TEST 1 THROUGH TEST 6 VERIFY THAT THE CHARACTER ASSIGNMENT 01240202 +C STATEMENT 01250202 +C 01260202 +C CHARACTER VARIABLE (LEN 1) = CHARACTER CONSTANT (LEN 1) 01270202 +C 01280202 +C IS CORRECT. THE CHARACTER RELATIONAL EXPRESSION 01290202 +C 01300202 +C CHARACTER VARIABLE (LEN 1) RELOP CHARACTER CONSTANT (LEN 1) 01310202 +C 01320202 +C IS USED TO VERIFY THE ASSIGNMENT STATEMENT. BOTH OF THE ABOVE 01330202 +C STATEMENTS MUST MEET THE LANGUAGE SPECIFICATIONS FOR THESE TESTS 01340202 +C TO PASS. 01350202 +C 01360202 +C 01370202 +C **** FCVS PROGRAM 202 - TEST 001 **** 01380202 +C 01390202 +C 01400202 + IVTNUM = 1 01410202 + IF (ICZERO) 30010, 0010, 30010 01420202 + 0010 CONTINUE 01430202 + IVCOMP = 0 01440202 + CVTN01 = ' ' 01450202 + IVCORR = 1 01460202 + IF (CVTN01 .EQ. ' ') IVCOMP = 1 01470202 +40010 IF (IVCOMP - 1) 20010,10010,20010 01480202 +30010 IVDELE = IVDELE + 1 01490202 + WRITE (I02,80000) IVTNUM 01500202 + IF (ICZERO) 10010, 0021, 20010 01510202 +10010 IVPASS = IVPASS + 1 01520202 + WRITE (I02,80002) IVTNUM 01530202 + GO TO 0021 01540202 +20010 IVFAIL = IVFAIL + 1 01550202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01560202 + 0021 CONTINUE 01570202 +C 01580202 +C **** FCVS PROGRAM 202 - TEST 002 **** 01590202 +C 01600202 +C 01610202 + IVTNUM = 2 01620202 + IF (ICZERO) 30020, 0020, 30020 01630202 + 0020 CONTINUE 01640202 + IVCOMP = 0 01650202 + CVTN01 = 'M' 01660202 + IVCORR = 1 01670202 + IF (CVTN01 .EQ. 'M') IVCOMP = 1 01680202 +40020 IF (IVCOMP - 1) 20020,10020,20020 01690202 +30020 IVDELE = IVDELE + 1 01700202 + WRITE (I02,80000) IVTNUM 01710202 + IF (ICZERO) 10020, 0031, 20020 01720202 +10020 IVPASS = IVPASS + 1 01730202 + WRITE (I02,80002) IVTNUM 01740202 + GO TO 0031 01750202 +20020 IVFAIL = IVFAIL + 1 01760202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01770202 + 0031 CONTINUE 01780202 +C 01790202 +C **** FCVS PROGRAM 202 - TEST 003 **** 01800202 +C 01810202 +C 01820202 + IVTNUM = 3 01830202 + IF (ICZERO) 30030, 0030, 30030 01840202 + 0030 CONTINUE 01850202 + IVCOMP = 0 01860202 + IVCORR = 1 01870202 + CVTN01 = '4' 01880202 + IF (CVTN01 .EQ. '4') IVCOMP = 1 01890202 +40030 IF (IVCOMP - 1) 20030,10030,20030 01900202 +30030 IVDELE = IVDELE + 1 01910202 + WRITE (I02,80000) IVTNUM 01920202 + IF (ICZERO) 10030, 0041, 20030 01930202 +10030 IVPASS = IVPASS + 1 01940202 + WRITE (I02,80002) IVTNUM 01950202 + GO TO 0041 01960202 +20030 IVFAIL = IVFAIL + 1 01970202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01980202 + 0041 CONTINUE 01990202 +C 02000202 +C **** FCVS PROGRAM 202 - TEST 004 **** 02010202 +C 02020202 +C 02030202 + IVTNUM = 4 02040202 + IF (ICZERO) 30040, 0040, 30040 02050202 + 0040 CONTINUE 02060202 + IVCOMP = 0 02070202 + IVCORR = 1 02080202 + CVTN01 = '=' 02090202 + IF (CVTN01 .EQ. '=') IVCOMP = 1 02100202 +40040 IF (IVCOMP - 1) 20040,10040,20040 02110202 +30040 IVDELE = IVDELE + 1 02120202 + WRITE (I02,80000) IVTNUM 02130202 + IF (ICZERO) 10040, 0051, 20040 02140202 +10040 IVPASS = IVPASS + 1 02150202 + WRITE (I02,80002) IVTNUM 02160202 + GO TO 0051 02170202 +20040 IVFAIL = IVFAIL + 1 02180202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02190202 + 0051 CONTINUE 02200202 +C 02210202 +C **** FCVS PROGRAM 202 - TEST 005 **** 02220202 +C 02230202 +C 02240202 + IVTNUM = 5 02250202 + IF (ICZERO) 30050, 0050, 30050 02260202 + 0050 CONTINUE 02270202 + IVCOMP = 0 02280202 + IVCORR = 1 02290202 + CVTN01 = '/' 02300202 + IF (CVTN01 .EQ. '/') IVCOMP = 1 02310202 +40050 IF (IVCOMP - 1) 20050,10050,20050 02320202 +30050 IVDELE = IVDELE + 1 02330202 + WRITE (I02,80000) IVTNUM 02340202 + IF (ICZERO) 10050, 0061, 20050 02350202 +10050 IVPASS = IVPASS + 1 02360202 + WRITE (I02,80002) IVTNUM 02370202 + GO TO 0061 02380202 +20050 IVFAIL = IVFAIL + 1 02390202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02400202 + 0061 CONTINUE 02410202 +C 02420202 +C **** FCVS PROGRAM 202 - TEST 006 **** 02430202 +C 02440202 +C AN APOSTROPHE IN A CHARACTER CONSTANT IS REPRESENTED BY TWO 02450202 +C CONSECUTIVE APOSTROPHES WITH NO INTERVENING BLANKS. 02460202 +C 02470202 + IVTNUM = 6 02480202 + IF (ICZERO) 30060, 0060, 30060 02490202 + 0060 CONTINUE 02500202 + IVCOMP = 0 02510202 + IVCORR = 1 02520202 + CVTN01 = '''' 02530202 + IF (CVTN01 .EQ. '''') IVCOMP = 1 02540202 +40060 IF (IVCOMP - 1) 20060,10060,20060 02550202 +30060 IVDELE = IVDELE + 1 02560202 + WRITE (I02,80000) IVTNUM 02570202 + IF (ICZERO) 10060, 0071, 20060 02580202 +10060 IVPASS = IVPASS + 1 02590202 + WRITE (I02,80002) IVTNUM 02600202 + GO TO 0071 02610202 +20060 IVFAIL = IVFAIL + 1 02620202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02630202 + 0071 CONTINUE 02640202 +C 02650202 +C TEST 7 THROUGH TEST 12 VERIFY THAT THE CHARACTER ASSIGNMENT 02660202 +C STATEMENTS 02670202 +C 02680202 +C CHARACTER VARIABLE (LEN 1) = CHARACTER CONSTANT (LEN 1) 02690202 +C CHARACTER VARIABLE (LEN 1) = CHARACTER VARIABLE (LEN 1) 02700202 +C 02710202 +C ARE CORRECT. THE CHARACTER RELATIONAL EXPRESSION 02720202 +C 02730202 +C CHARACTER VARIABLE (LEN 1) .EQ. CHARACTER CONSTANT (LEN 1) 02740202 +C 02750202 +C IS USED TO VERIFY THE RESULT OF THE ASSIGNMENT STATEMENTS. 02760202 +C 02770202 +C 02780202 +C **** FCVS PROGRAM 202 - TEST 007 **** 02790202 +C 02800202 +C 02810202 + IVTNUM = 7 02820202 + IF (ICZERO) 30070, 0070, 30070 02830202 + 0070 CONTINUE 02840202 + IVCOMP = 0 02850202 + IVCORR = 1 02860202 + CVTN01 = ' ' 02870202 + CVTN02 = CVTN01 02880202 + IF (CVTN02 .EQ. ' ') IVCOMP = 1 02890202 +40070 IF (IVCOMP - 1) 20070, 10070, 20070 02900202 +30070 IVDELE = IVDELE + 1 02910202 + WRITE (I02,80000) IVTNUM 02920202 + IF (ICZERO) 10070, 0081, 20070 02930202 +10070 IVPASS = IVPASS + 1 02940202 + WRITE (I02,80002) IVTNUM 02950202 + GO TO 0081 02960202 +20070 IVFAIL = IVFAIL + 1 02970202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02980202 + 0081 CONTINUE 02990202 +C 03000202 +C **** FCVS PROGRAM 202 - TEST 008 **** 03010202 +C 03020202 +C 03030202 + IVTNUM = 8 03040202 + IF (ICZERO) 30080, 0080, 30080 03050202 + 0080 CONTINUE 03060202 + IVCOMP = 0 03070202 + IVCORR = 1 03080202 + CVTN01 = 'M' 03090202 + CVTN02 = CVTN01 03100202 + IF (CVTN02 .EQ. 'M') IVCOMP = 1 03110202 +40080 IF (IVCOMP - 1) 20080,10080,20080 03120202 +30080 IVDELE = IVDELE + 1 03130202 + WRITE (I02,80000) IVTNUM 03140202 + IF (ICZERO) 10080, 0091, 20080 03150202 +10080 IVPASS = IVPASS + 1 03160202 + WRITE (I02,80002) IVTNUM 03170202 + GO TO 0091 03180202 +20080 IVFAIL = IVFAIL + 1 03190202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03200202 + 0091 CONTINUE 03210202 +C 03220202 +C **** FCVS PROGRAM 202 - TEST 009 **** 03230202 +C 03240202 +C 03250202 + IVTNUM = 9 03260202 + IF (ICZERO) 30090, 0090, 30090 03270202 + 0090 CONTINUE 03280202 + IVCOMP = 0 03290202 + IVCORR = 1 03300202 + CVTN01 = '4' 03310202 + CVTN02 = CVTN01 03320202 + IF (CVTN02 .EQ. '4') IVCOMP = 1 03330202 +40090 IF (IVCOMP - 1) 20090,10090,20090 03340202 +30090 IVDELE = IVDELE + 1 03350202 + WRITE (I02,80000) IVTNUM 03360202 + IF (ICZERO) 10090, 0101, 20090 03370202 +10090 IVPASS = IVPASS + 1 03380202 + WRITE (I02,80002) IVTNUM 03390202 + GO TO 0101 03400202 +20090 IVFAIL = IVFAIL + 1 03410202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03420202 + 0101 CONTINUE 03430202 +C 03440202 +C **** FCVS PROGRAM 202 - TEST 010 **** 03450202 +C 03460202 +C 03470202 + IVTNUM = 10 03480202 + IF (ICZERO) 30100, 0100, 30100 03490202 + 0100 CONTINUE 03500202 + IVCOMP = 0 03510202 + IVCORR = 1 03520202 + CVTN01 = '=' 03530202 + CVTN02 = CVTN01 03540202 + IF (CVTN02 .EQ. '=') IVCOMP = 1 03550202 +40100 IF (IVCOMP - 1) 20100,10100,20100 03560202 +30100 IVDELE = IVDELE + 1 03570202 + WRITE (I02,80000) IVTNUM 03580202 + IF (ICZERO) 10100, 0111, 20100 03590202 +10100 IVPASS = IVPASS + 1 03600202 + WRITE (I02,80002) IVTNUM 03610202 + GO TO 0111 03620202 +20100 IVFAIL = IVFAIL + 1 03630202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03640202 + 0111 CONTINUE 03650202 +C 03660202 +C **** FCVS PROGRAM 202 - TEST 011 **** 03670202 +C 03680202 +C 03690202 + IVTNUM = 11 03700202 + IF (ICZERO) 30110, 0110, 30110 03710202 + 0110 CONTINUE 03720202 + IVCOMP =0 03730202 + IVCORR = 1 03740202 + CVTN01 = '/' 03750202 + CVTN02 = CVTN01 03760202 + IF (CVTN02 .EQ. '/') IVCOMP = 1 03770202 +40110 IF (IVCOMP - 1) 20110,10110,20110 03780202 +30110 IVDELE = IVDELE + 1 03790202 + WRITE (I02,80000) IVTNUM 03800202 + IF (ICZERO) 10110, 0121, 20110 03810202 +10110 IVPASS = IVPASS + 1 03820202 + WRITE (I02,80002) IVTNUM 03830202 + GO TO 0121 03840202 +20110 IVFAIL = IVFAIL + 1 03850202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03860202 + 0121 CONTINUE 03870202 +C 03880202 +C **** FCVS PROGRAM 202 - TEST 012 **** 03890202 +C 03900202 +C AN APOSTROPHE IN A CHARACTER CONSTANT IS REPRESENTED BY TWO 03910202 +C CONSECUTIVE APOSTROPHES WITH NO INTERVENING BLANKS. 03920202 +C 03930202 + IVTNUM = 12 03940202 + IF (ICZERO) 30120, 0120, 30120 03950202 + 0120 CONTINUE 03960202 + IVCOMP = 0 03970202 + IVCORR = 1 03980202 + CVTN01 = '''' 03990202 + CVTN02 = CVTN01 04000202 + IF (CVTN02 .EQ. '''') IVCOMP = 1 04010202 +40120 IF (IVCOMP - 1) 20120,10120,20120 04020202 +30120 IVDELE = IVDELE + 1 04030202 + WRITE (I02,80000) IVTNUM 04040202 + IF (ICZERO) 10120, 0131, 20120 04050202 +10120 IVPASS = IVPASS + 1 04060202 + WRITE (I02,80002) IVTNUM 04070202 + GO TO 0131 04080202 +20120 IVFAIL = IVFAIL + 1 04090202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04100202 + 0131 CONTINUE 04110202 +C 04120202 +C TEST 13 THROUGH TEST 18 VERIFY THE RESULTS OF THE CHARACTER 04130202 +C RELATIONAL EXPRESSION USING EACH OF THE SIX RELATIONAL OPERATORS 04140202 +C IN THE STATEMENT FORM 04150202 +C 04160202 +C CHARACTER VARIABLE (LEN 1) RELOP CHARACTER CONSTANT (LEN 1). 04170202 +C 04180202 +C THE VARIABLE AND CONSTANT CONTAIN THE CHARACTER DATUM C. 04190202 +C 04200202 + CVTN01 = 'C' 04210202 +C 04220202 +C **** FCVS PROGRAM 202 - TEST 013 **** 04230202 +C 04240202 +C RELATIONAL OPERATOR .EQ. 04250202 +C 04260202 + IVTNUM = 13 04270202 + IF (ICZERO) 30130, 0130, 30130 04280202 + 0130 CONTINUE 04290202 + IVCOMP = 0 04300202 + IVCORR = 1 04310202 + IF (CVTN01 .EQ. 'C') IVCOMP = 1 04320202 +40130 IF (IVCOMP - 1) 20130,10130,20130 04330202 +30130 IVDELE = IVDELE + 1 04340202 + WRITE (I02,80000) IVTNUM 04350202 + IF (ICZERO) 10130, 0141, 20130 04360202 +10130 IVPASS = IVPASS + 1 04370202 + WRITE (I02,80002) IVTNUM 04380202 + GO TO 0141 04390202 +20130 IVFAIL = IVFAIL + 1 04400202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04410202 + 0141 CONTINUE 04420202 +C 04430202 +C **** FCVS PROGRAM 202 - TEST 014 **** 04440202 +C 04450202 +C RELATIONAL OPERATOR .NE. 04460202 +C 04470202 + IVTNUM = 14 04480202 + IF (ICZERO) 30140, 0140, 30140 04490202 + 0140 CONTINUE 04500202 + IVCOMP = 0 04510202 + IVCORR = 0 04520202 + IF (CVTN01 .NE. 'C') IVCOMP = 1 04530202 +40140 IF (IVCOMP) 20140,10140,20140 04540202 +30140 IVDELE = IVDELE + 1 04550202 + WRITE (I02,80000) IVTNUM 04560202 + IF (ICZERO) 10140, 0151, 20140 04570202 +10140 IVPASS = IVPASS + 1 04580202 + WRITE (I02,80002) IVTNUM 04590202 + GO TO 0151 04600202 +20140 IVFAIL = IVFAIL + 1 04610202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04620202 + 0151 CONTINUE 04630202 +C 04640202 +C **** FCVS PROGRAM 202 - TEST 015 **** 04650202 +C 04660202 +C RELATIONAL OPERATOR .LE. 04670202 +C 04680202 + IVTNUM = 15 04690202 + IF (ICZERO) 30150, 0150, 30150 04700202 + 0150 CONTINUE 04710202 + IVCOMP = 0 04720202 + IVCORR = 1 04730202 + IF (CVTN01 .LE. 'C') IVCOMP = 1 04740202 + IF (IVCOMP - 1) 20150,10150,20150 04750202 +30150 IVDELE = IVDELE + 1 04760202 + WRITE (I02,80000) IVTNUM 04770202 + IF (ICZERO) 10150, 0161, 20150 04780202 +10150 IVPASS = IVPASS + 1 04790202 + WRITE (I02,80002) IVTNUM 04800202 + GO TO 0161 04810202 +20150 IVFAIL = IVFAIL + 1 04820202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04830202 + 0161 CONTINUE 04840202 +C 04850202 +C **** FCVS PROGRAM 202 - TEST 016 **** 04860202 +C 04870202 +C RELATIONAL OPERATOR .LT. 04880202 +C 04890202 + IVTNUM = 16 04900202 + IF (ICZERO) 30160, 0160, 30160 04910202 + 0160 CONTINUE 04920202 + IVCOMP=0 04930202 + IVCORR=0 04940202 + IF (CVTN01 .LT. 'C') IVCOMP = 1 04950202 + IF (IVCOMP) 20160,10160,20160 04960202 +30160 IVDELE = IVDELE + 1 04970202 + WRITE (I02,80000) IVTNUM 04980202 + IF (ICZERO) 10160, 0171, 20160 04990202 +10160 IVPASS = IVPASS + 1 05000202 + WRITE (I02,80002) IVTNUM 05010202 + GO TO 0171 05020202 +20160 IVFAIL = IVFAIL + 1 05030202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05040202 + 0171 CONTINUE 05050202 +C 05060202 +C **** FCVS PROGRAM 202 - TEST 017 **** 05070202 +C 05080202 +C RELATIONAL OPERATOR .GE. 05090202 +C 05100202 + IVTNUM = 17 05110202 + IF (ICZERO) 30170, 0170, 30170 05120202 + 0170 CONTINUE 05130202 + IVCOMP = 0 05140202 + IVCORR = 1 05150202 + IF (CVTN01 .GE. 'C') IVCOMP = 1 05160202 +40170 IF (IVCOMP - 1) 20170,10170,20170 05170202 +30170 IVDELE = IVDELE + 1 05180202 + WRITE (I02,80000) IVTNUM 05190202 + IF (ICZERO) 10170, 0181, 20170 05200202 +10170 IVPASS = IVPASS + 1 05210202 + WRITE (I02,80002) IVTNUM 05220202 + GO TO 0181 05230202 +20170 IVFAIL = IVFAIL + 1 05240202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05250202 + 0181 CONTINUE 05260202 +C 05270202 +C **** FCVS PROGRAM 202 - TEST 018 **** 05280202 +C 05290202 +C RELATIONAL OPERATOR .GT. 05300202 +C 05310202 + IVTNUM = 18 05320202 + IF (ICZERO) 30180, 0180, 30180 05330202 + 0180 CONTINUE 05340202 + IVCOMP = 0 05350202 + IVCORR = 0 05360202 + IF (CVTN01 .GT. 'C') IVCOMP = 1 05370202 +40180 IF (IVCOMP) 20180,10180,20180 05380202 +30180 IVDELE = IVDELE + 1 05390202 + WRITE (I02,80000) IVTNUM 05400202 + IF (ICZERO) 10180, 0191, 20180 05410202 +10180 IVPASS = IVPASS + 1 05420202 + WRITE (I02,80002) IVTNUM 05430202 + GO TO 0191 05440202 +20180 IVFAIL = IVFAIL + 1 05450202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05460202 + 0191 CONTINUE 05470202 +C 05480202 +C TEST 19 THROUGH TEST 21 VERIFY THAT THE CHARACTER ASSIGNMENT 05490202 +C STATEMENT 05500202 +C 05510202 +C CHARACTER VARIABLE (LEN 2) = CHARACTER CONSTANT (LEN 2) 05520202 +C 05530202 +C OPERATES CORRECTLY. THE CHARACTER RELATIONAL EXPRESSION 05540202 +C 05550202 +C CHARACTER VARIABLE (LEN 2) .EQ. CHARACTER CONSTANT (LEN 2) 05560202 +C 05570202 +C IS USED TO VERIFY THE RESULT OF THE ASSIGNMENT STATEMENT. 05580202 +C 05590202 +C 05600202 +C **** FCVS PROGRAM 202 - TEST 019 **** 05610202 +C 05620202 +C 05630202 + IVTNUM = 19 05640202 + IF (ICZERO) 30190, 0190, 30190 05650202 + 0190 CONTINUE 05660202 + IVCOMP =0 05670202 + IVCORR =1 05680202 + CVTN03 = 'AZ' 05690202 + IF (CVTN03 .EQ. 'AZ') IVCOMP = 1 05700202 +40190 IF (IVCOMP - 1) 20190,10190,20190 05710202 +30190 IVDELE = IVDELE + 1 05720202 + WRITE (I02,80000) IVTNUM 05730202 + IF (ICZERO) 10190, 0201, 20190 05740202 +10190 IVPASS = IVPASS + 1 05750202 + WRITE (I02,80002) IVTNUM 05760202 + GO TO 0201 05770202 +20190 IVFAIL = IVFAIL + 1 05780202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05790202 + 0201 CONTINUE 05800202 +C 05810202 +C **** FCVS PROGRAM 202 - TEST 020 **** 05820202 +C 05830202 +C 05840202 + IVTNUM = 20 05850202 + IF (ICZERO) 30200, 0200, 30200 05860202 + 0200 CONTINUE 05870202 + IVCOMP = 0 05880202 + IVCORR = 1 05890202 + CVTN03 = 'B''' 05900202 + IF (CVTN03 .EQ. 'B''') IVCOMP = 1 05910202 +40200 IF (IVCOMP - 1) 20200,10200,20200 05920202 +30200 IVDELE = IVDELE + 1 05930202 + WRITE (I02,80000) IVTNUM 05940202 + IF (ICZERO) 10200, 0211, 20200 05950202 +10200 IVPASS = IVPASS + 1 05960202 + WRITE (I02,80002) IVTNUM 05970202 + GO TO 0211 05980202 +20200 IVFAIL = IVFAIL + 1 05990202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06000202 + 0211 CONTINUE 06010202 +C 06020202 +C **** FCVS PROGRAM 202 - TEST 021 **** 06030202 +C 06040202 +C 06050202 + IVTNUM = 21 06060202 + IF (ICZERO) 30210, 0210, 30210 06070202 + 0210 CONTINUE 06080202 + IVCOMP = 0 06090202 + IVCORR = 1 06100202 + CVTN03 = '//' 06110202 + IF (CVTN03 .EQ. '//') IVCOMP = 1 06120202 +40210 IF (IVCOMP - 1) 20210,10210,20210 06130202 +30210 IVDELE = IVDELE + 1 06140202 + WRITE (I02,80000) IVTNUM 06150202 + IF (ICZERO) 10210, 0221, 20210 06160202 +10210 IVPASS = IVPASS + 1 06170202 + WRITE (I02,80002) IVTNUM 06180202 + GO TO 0221 06190202 +20210 IVFAIL = IVFAIL + 1 06200202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06210202 + 0221 CONTINUE 06220202 +C 06230202 +C TEST 22 THROUGH TEST 24 VERIFY THAT THE CHARACTER ASSIGNMENT 06240202 +C STATEMENTS 06250202 +C 06260202 +C CHARACTER VARIABLE (LEN 2) = CHARACTER CONSTANT (LEN 2) 06270202 +C CHARACTER VARIABLE (LEN 2) = CHARACTER VARIABLE (LEN 2) 06280202 +C 06290202 +C OPERATE CORRECTLY. 06300202 +C 06310202 +C 06320202 +C **** FCVS PROGRAM 202 - TEST 022 **** 06330202 +C 06340202 +C 06350202 + IVTNUM = 22 06360202 + IF (ICZERO) 30220, 0220, 30220 06370202 + 0220 CONTINUE 06380202 + IVCOMP = 0 06390202 + IVCORR = 1 06400202 + CVTN03 = 'AZ' 06410202 + CVTN04 = CVTN03 06420202 + IF (CVTN04 .EQ. 'AZ') IVCOMP=1 06430202 +40220 IF (IVCOMP - 1) 20220,10220,20220 06440202 +30220 IVDELE = IVDELE + 1 06450202 + WRITE (I02,80000) IVTNUM 06460202 + IF (ICZERO) 10220, 0231, 20220 06470202 +10220 IVPASS = IVPASS + 1 06480202 + WRITE (I02,80002) IVTNUM 06490202 + GO TO 0231 06500202 +20220 IVFAIL = IVFAIL + 1 06510202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06520202 + 0231 CONTINUE 06530202 +C 06540202 +C **** FCVS PROGRAM 202 - TEST 023 **** 06550202 +C 06560202 +C 06570202 + IVTNUM = 23 06580202 + IF (ICZERO) 30230, 0230, 30230 06590202 + 0230 CONTINUE 06600202 + IVCOMP = 0 06610202 + IVCORR = 1 06620202 + CVTN03 = 'B''' 06630202 + CVTN04 = CVTN03 06640202 + IF (CVTN04 .EQ. 'B''') IVCOMP = 1 06650202 +40230 IF (IVCOMP - 1) 20230,10230,20230 06660202 +30230 IVDELE = IVDELE + 1 06670202 + WRITE (I02,80000) IVTNUM 06680202 + IF (ICZERO) 10230, 0241, 20230 06690202 +10230 IVPASS = IVPASS + 1 06700202 + WRITE (I02,80002) IVTNUM 06710202 + GO TO 0241 06720202 +20230 IVFAIL = IVFAIL + 1 06730202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06740202 + 0241 CONTINUE 06750202 +C 06760202 +C **** FCVS PROGRAM 202 - TEST 024 **** 06770202 +C 06780202 +C 06790202 + IVTNUM = 24 06800202 + IF (ICZERO) 30240, 0240, 30240 06810202 + 0240 CONTINUE 06820202 + IVCOMP = 0 06830202 + IVCORR = 1 06840202 + CVTN03 = '//' 06850202 + CVTN04 = CVTN03 06860202 + IF (CVTN04 .EQ. '//') IVCOMP = 1 06870202 +40240 IF (IVCOMP - 1) 20240,10240,20240 06880202 +30240 IVDELE = IVDELE + 1 06890202 + WRITE (I02,80000) IVTNUM 06900202 + IF (ICZERO) 10240, 0251, 20240 06910202 +10240 IVPASS = IVPASS + 1 06920202 + WRITE (I02,80002) IVTNUM 06930202 + GO TO 0251 06940202 +20240 IVFAIL = IVFAIL + 1 06950202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06960202 + 0251 CONTINUE 06970202 +C 06980202 +C TEST 25 THROUGH TEST 30 VERIFY THE RESULTS OF THE CHARACTER 06990202 +C RELATIONAL EXPRESSION USING EACH OF THE SIX RELATIONAL OPERATORS 07000202 +C IN THE EXPRESSION FORM 07010202 +C 07020202 +C CHARACTER VARIABLE (LEN 2) RELOP CHARACTER VARIABLE (LEN 2) 07030202 +C 07040202 +C THE VARIABLES CONTAIN THE CHARACTER DATUM CC. 07050202 +C 07060202 + CVTN03 = 'CC' 07070202 + CVTN04 = 'CC' 07080202 +C 07090202 +C **** FCVS PROGRAM 202 - TEST 025 **** 07100202 +C 07110202 +C RELATIONAL OPERATOR .EQ. 07120202 +C 07130202 + IVTNUM = 25 07140202 + IF (ICZERO) 30250, 0250, 30250 07150202 + 0250 CONTINUE 07160202 + IVCOMP = 0 07170202 + IVCORR = 1 07180202 + IF (CVTN03 .EQ. CVTN04) IVCOMP = 1 07190202 +40250 IF (IVCOMP - 1) 20250,10250,20250 07200202 +30250 IVDELE = IVDELE + 1 07210202 + WRITE (I02,80000) IVTNUM 07220202 + IF (ICZERO) 10250, 0261, 20250 07230202 +10250 IVPASS = IVPASS + 1 07240202 + WRITE (I02,80002) IVTNUM 07250202 + GO TO 0261 07260202 +20250 IVFAIL = IVFAIL + 1 07270202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07280202 + 0261 CONTINUE 07290202 +C 07300202 +C **** FCVS PROGRAM 202 - TEST 026 **** 07310202 +C 07320202 +C RELATIONAL OPERATOR .NE. 07330202 +C 07340202 + IVTNUM = 26 07350202 + IF (ICZERO) 30260, 0260, 30260 07360202 + 0260 CONTINUE 07370202 + IVCOMP = 0 07380202 + IVCORR = 0 07390202 + IF (CVTN03 .NE. CVTN04) IVCOMP = 1 07400202 +40260 IF (IVCOMP) 20260,10260,20260 07410202 +30260 IVDELE = IVDELE + 1 07420202 + WRITE (I02,80000) IVTNUM 07430202 + IF (ICZERO) 10260, 0271, 20260 07440202 +10260 IVPASS = IVPASS + 1 07450202 + WRITE (I02,80002) IVTNUM 07460202 + GO TO 0271 07470202 +20260 IVFAIL = IVFAIL + 1 07480202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07490202 + 0271 CONTINUE 07500202 +C 07510202 +C **** FCVS PROGRAM 202 - TEST 027 **** 07520202 +C 07530202 +C RELATIONAL OPERATOR .LE. 07540202 +C 07550202 + IVTNUM = 27 07560202 + IF (ICZERO) 30270, 0270, 30270 07570202 + 0270 CONTINUE 07580202 + IVCOMP = 0 07590202 + IVCORR = 1 07600202 + IF (CVTN03 .LE. CVTN04) IVCOMP = 1 07610202 +40270 IF (IVCOMP - 1) 20270,10270,20270 07620202 +30270 IVDELE = IVDELE + 1 07630202 + WRITE (I02,80000) IVTNUM 07640202 + IF (ICZERO) 10270, 0281, 20270 07650202 +10270 IVPASS = IVPASS + 1 07660202 + WRITE (I02,80002) IVTNUM 07670202 + GO TO 0281 07680202 +20270 IVFAIL = IVFAIL + 1 07690202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07700202 + 0281 CONTINUE 07710202 +C 07720202 +C **** FCVS PROGRAM 202 - TEST 028 **** 07730202 +C 07740202 +C RELATIONAL OPERATOR .LT. 07750202 +C 07760202 + IVTNUM = 28 07770202 + IF (ICZERO) 30280, 0280, 30280 07780202 + 0280 CONTINUE 07790202 + IVCOMP = 0 07800202 + IVCORR = 0 07810202 + IF (CVTN03 .LT. CVTN04) IVCOMP=1 07820202 +40280 IF (IVCOMP) 20280,10280,20280 07830202 +30280 IVDELE = IVDELE + 1 07840202 + WRITE (I02,80000) IVTNUM 07850202 + IF (ICZERO) 10280, 0291, 20280 07860202 +10280 IVPASS = IVPASS + 1 07870202 + WRITE (I02,80002) IVTNUM 07880202 + GO TO 0291 07890202 +20280 IVFAIL = IVFAIL + 1 07900202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07910202 + 0291 CONTINUE 07920202 +C 07930202 +C **** FCVS PROGRAM 202 - TEST 029 **** 07940202 +C 07950202 +C RELATIONAL OPERATOR .GE. 07960202 +C 07970202 + IVTNUM = 29 07980202 + IF (ICZERO) 30290, 0290, 30290 07990202 + 0290 CONTINUE 08000202 + IVCOMP = 0 08010202 + IVCORR = 1 08020202 + IF (CVTN03 .GE. CVTN04) IVCOMP = 1 08030202 +40290 IF (IVCOMP - 1) 20290,10290,20290 08040202 +30290 IVDELE = IVDELE + 1 08050202 + WRITE (I02,80000) IVTNUM 08060202 + IF (ICZERO) 10290, 0301, 20290 08070202 +10290 IVPASS = IVPASS + 1 08080202 + WRITE (I02,80002) IVTNUM 08090202 + GO TO 0301 08100202 +20290 IVFAIL = IVFAIL + 1 08110202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08120202 + 0301 CONTINUE 08130202 +C 08140202 +C **** FCVS PROGRAM 202 - TEST 030 **** 08150202 +C 08160202 +C RELATIONAL OPERATOR .GT. 08170202 +C 08180202 + IVTNUM = 30 08190202 + IF (ICZERO) 30300, 0300, 30300 08200202 + 0300 CONTINUE 08210202 + IVCOMP = 0 08220202 + IVCORR = 0 08230202 + IF (CVTN03 .GT. CVTN04) IVCOMP = 1 08240202 +40300 IF (IVCOMP) 20300,10300,20300 08250202 +30300 IVDELE = IVDELE + 1 08260202 + WRITE (I02,80000) IVTNUM 08270202 + IF (ICZERO) 10300, 0311, 20300 08280202 +10300 IVPASS = IVPASS + 1 08290202 + WRITE (I02,80002) IVTNUM 08300202 + GO TO 0311 08310202 +20300 IVFAIL = IVFAIL + 1 08320202 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08330202 + 0311 CONTINUE 08340202 +C 08350202 +C 08360202 +C WRITE OUT TEST SUMMARY 08370202 +C 08380202 + WRITE (I02,90004) 08390202 + WRITE (I02,90014) 08400202 + WRITE (I02,90004) 08410202 + WRITE (I02,90000) 08420202 + WRITE (I02,90004) 08430202 + WRITE (I02,90020) IVFAIL 08440202 + WRITE (I02,90022) IVPASS 08450202 + WRITE (I02,90024) IVDELE 08460202 + STOP 08470202 +90001 FORMAT (" ",24X,"FM202") 08480202 +90000 FORMAT (" ",20X,"END OF PROGRAM FM202" ) 08490202 +C 08500202 +C FORMATS FOR TEST DETAIL LINES 08510202 +C 08520202 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 08530202 +80002 FORMAT (" ",4X,I5,7X,"PASS") 08540202 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08550202 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08560202 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 08570202 +C 08580202 +C FORMAT STATEMENTS FOR PAGE HEADERS 08590202 +C 08600202 +90002 FORMAT ("1") 08610202 +90004 FORMAT (" ") 08620202 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08630202 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 08640202 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08650202 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 08660202 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 08670202 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08680202 +C 08690202 +C FORMAT STATEMENTS FOR RUN SUMMARY 08700202 +C 08710202 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 08720202 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 08730202 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 08740202 + END 08750202 diff --git a/Fortran/UnitTests/fcvs21_f95/FM202.reference_output b/Fortran/UnitTests/fcvs21_f95/FM202.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM202.reference_output @@ -0,0 +1,51 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM202 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + + ---------------------------------------------- + + END OF PROGRAM FM202 + + 0 TESTS FAILED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM203.f b/Fortran/UnitTests/fcvs21_f95/FM203.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM203.f @@ -0,0 +1,966 @@ + PROGRAM FM203 00010203 +C 00020203 +C 00030203 +C THIS ROUTINE CONTINUES THE TESTING OF CHARACTER DATA TYPES 00040203 +C WHICH WAS STARTED IN FM202. THE CHARACTER TYPE-STATEMENTS SPECIFY00050203 +C CHARACTER VARIABLES AND ONE-DIMENSIONAL CHARACTER ARRAYS OF 00060203 +C LENGTH ONE AND LENGTH TWO. THE TESTS IN THIS ROUTINE DETERMINE 00070203 +C THAT THE FOLLOWING LANGUAGE FEATURES FUNCTION CORRECTLY. 00080203 +C 00090203 +C (1) CHARACTER ASSIGNMENT STATEMENTS OF THE FORM 00100203 +C 00110203 +C CHARACTER ARRAY ELEMENT = CHARACTER CONSTANT 00120203 +C CHARACTER ARRAY ELEMENT = CHARACTER VARIABLE 00130203 +C CHARACTER ARRAY ELEMENT = CHARACTER ARRAY ELEMENT 00140203 +C CHARACTER VARIABLE = CHARACTER ARRAY ELEMENT 00150203 +C 00160203 +C WHERE THE ARRAY ELEMENTS, VARIABLES AND CONSTANTS ARE OF LENGTH 00170203 +C ONE OR TWO. 00180203 +C 00190203 +C (2) CHARACTER RELATIONAL EXPRESSIONS OF THE FORM 00200203 +C 00210203 +C CHARACTER ARRAY ELEMENT RELOP CHARACTER CONSTANT 00220203 +C CHARACTER ARRAY ELEMENT RELOP CHARACTER VARIABLE 00230203 +C CHARACTER ARRAY ELEMENT RELOP CHARACTER ARRAY ELEMENT 00240203 +C 00250203 +C WHERE THE ARRAY ELEMENTS, VARIABLES AND CONSTANTS ARE OF LENGTH 00260203 +C ONE OR TWO. 00270203 +C 00280203 +C (3) CHARACTER EXPRESSIONS ENCLOSED IN PARENTHESES. THE FORMS00290203 +C TESTED ARE 00300203 +C 00310203 +C (CHARACTER CONSTANT) 00320203 +C (CHARACTER VARIABLE) 00330203 +C (CHARACTER ARRAY ELEMENT) 00340203 +C ((CHARACTER ARRAY ELEMENT)) 00350203 +C 00360203 +C (4) CHARACTER RELATIONAL EXPRESSIONS OF THE FORM 00370203 +C 00380203 +C CHARACTER ARRAY ELEMENT .EQ. CHARACTER CONSTANT 00390203 +C 00400203 +C ARE USED IN THIS ROUTINE TO VERIFY THE CHARACTER ASSIGNMENT 00410203 +C STATEMENTS. 00420203 +C 00430203 +C REFERENCES 00440203 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00450203 +C X3.9-1978 00460203 +C 00470203 +C SECTION 4.8, CHARACTER TYPE 00480203 +C SECTION 4.8.1, CHARACTER CONSTANT 00490203 +C SECTION 6.2, CHARACTER EXPRESSIONS 00500203 +C SECTION 6.3.4, CHARACTER RELATIONAL EXPRESSION 00510203 +C SECTION 6.3.5, INTERPRETATION OF CHARACTER RELATIONAL 00520203 +C EXPRESSIONS 00530203 +C SECTION 8.4.2, CHARACTER TYPE-STATEMENT 00540203 +C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT 00550203 +C 00560203 +C 00570203 +C 00580203 +C ******************************************************************00590203 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00600203 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00610203 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00620203 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00630203 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00640203 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00650203 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00660203 +C THE RESULT OF EXECUTING THESE TESTS. 00670203 +C 00680203 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00690203 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00700203 +C 00710203 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00720203 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00730203 +C SOFTWARE STANDARDS VALIDATION GROUP 00740203 +C BUILDING 225 RM A266 00750203 +C GAITHERSBURG, MD 20899 00760203 +C ******************************************************************00770203 +C 00780203 +C 00790203 + IMPLICIT LOGICAL (L) 00800203 + IMPLICIT CHARACTER*14 (C) 00810203 +C 00820203 + CHARACTER CATN11(5), CVTN01, CATN12(5), CVTN02 00830203 + CHARACTER*2 CATN13, CVTN03, CATN14(5), CVTN04 00840203 + DIMENSION CATN13(5) 00850203 +C 00860203 +C 00870203 +C 00880203 +C INITIALIZATION SECTION. 00890203 +C 00900203 +C INITIALIZE CONSTANTS 00910203 +C ******************** 00920203 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00930203 + I01 = 5 00940203 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00950203 + I02 = 6 00960203 +C SYSTEM ENVIRONMENT SECTION 00970203 +C 00980203 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00990203 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01000203 +C (UNIT NUMBER FOR CARD READER). 01010203 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01020203 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01030203 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01040203 +C 01050203 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01060203 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01070203 +C (UNIT NUMBER FOR PRINTER). 01080203 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01090203 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01100203 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01110203 +C 01120203 + IVPASS = 0 01130203 + IVFAIL = 0 01140203 + IVDELE = 0 01150203 + ICZERO = 0 01160203 +C 01170203 +C WRITE OUT PAGE HEADERS 01180203 +C 01190203 + WRITE (I02,90002) 01200203 + WRITE (I02,90006) 01210203 + WRITE (I02,90008) 01220203 + WRITE (I02,90004) 01230203 + WRITE (I02,90010) 01240203 + WRITE (I02,90004) 01250203 + WRITE (I02,90016) 01260203 + WRITE (I02,90001) 01270203 + WRITE (I02,90004) 01280203 + WRITE (I02,90012) 01290203 + WRITE (I02,90014) 01300203 + WRITE (I02,90004) 01310203 +C 01320203 +C 01330203 +C TEST 31 THROUGH TEST 33 VERIFY THAT THE CHARACTER ASSIGNMENT 01340203 +C STATEMENT 01350203 +C 01360203 +C CHARACTER ARRAY ELEMENT (LEN 1) = CHARACTER CONSTANT (LEN 1) 01370203 +C 01380203 +C IS CORRECT. THE CHARACTER RELATIONAL EXPRESSION 01390203 +C 01400203 +C CHARACTER ARRAY ELEMENT (LEN 1) .EQ. CHARACTER CONSTANT (LEN 1) 01410203 +C 01420203 +C IS USED TO VERIFY THE ASSIGNMENT STATEMENT. BOTH OF THE ABOVE 01430203 +C STATEMENT FORMS MUST MEET THE LANGUAGE SPECIFICATIONS FOR THESE 01440203 +C TESTS TO PASS. 01450203 +C 01460203 +C THE TWO ARRAYS USED IN THESE TESTS ARE CATN11(5) AND CATN12(5)01470203 +C THE ARRAYS ARE INITIALIZED TO A BLANK CHARACTER BY THE DO-LOOP 01480203 +C 01490203 + DO 312 I= 1,5 01500203 + CATN11(I) = ' ' 01510203 + CATN12(I) = ' ' 01520203 + 312 CONTINUE 01530203 +C 01540203 +C **** FCVS PROGRAM 203 - TEST 031 **** 01550203 +C 01560203 +C 01570203 + IVTNUM = 31 01580203 + IF (ICZERO) 30310, 0310, 30310 01590203 + 0310 CONTINUE 01600203 + IVCOMP = 0 01610203 + IVCORR = 1 01620203 + CATN11(2) = 'V' 01630203 + IF (CATN11(2) .EQ. 'V') IVCOMP = 1 01640203 +40310 IF (IVCOMP - 1) 20310,10310,20310 01650203 +30310 IVDELE = IVDELE + 1 01660203 + WRITE (I02,80000) IVTNUM 01670203 + IF (ICZERO) 10310, 0321, 20310 01680203 +10310 IVPASS = IVPASS + 1 01690203 + WRITE (I02,80002) IVTNUM 01700203 + GO TO 0321 01710203 +20310 IVFAIL = IVFAIL + 1 01720203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01730203 + 0321 CONTINUE 01740203 +C 01750203 +C **** FCVS PROGRAM 203 - TEST 032 **** 01760203 +C 01770203 +C 01780203 + IVTNUM = 32 01790203 + IF (ICZERO) 30320, 0320, 30320 01800203 + 0320 CONTINUE 01810203 + IVCOMP=0 01820203 + IVCORR=1 01830203 + CATN11(3) = '+' 01840203 + IF (CATN11(3) .EQ. '+') IVCOMP = 1 01850203 +40320 IF (IVCOMP - 1) 20320,10320,20320 01860203 +30320 IVDELE = IVDELE + 1 01870203 + WRITE (I02,80000) IVTNUM 01880203 + IF (ICZERO) 10320, 0331, 20320 01890203 +10320 IVPASS = IVPASS + 1 01900203 + WRITE (I02,80002) IVTNUM 01910203 + GO TO 0331 01920203 +20320 IVFAIL = IVFAIL + 1 01930203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01940203 + 0331 CONTINUE 01950203 +C 01960203 +C **** FCVS PROGRAM 203 - TEST 033 **** 01970203 +C 01980203 +C 01990203 + IVTNUM = 33 02000203 + IF (ICZERO) 30330, 0330, 30330 02010203 + 0330 CONTINUE 02020203 + IVCOMP = 0 02030203 + IVCORR = 1 02040203 + CATN11 (4) = '7' 02050203 + IF (CATN11 (4) .EQ. '7') IVCOMP = 1 02060203 +40330 IF (IVCOMP -1) 20330,10330,20330 02070203 +30330 IVDELE = IVDELE + 1 02080203 + WRITE (I02,80000) IVTNUM 02090203 + IF (ICZERO) 10330, 0341, 20330 02100203 +10330 IVPASS = IVPASS + 1 02110203 + WRITE (I02,80002) IVTNUM 02120203 + GO TO 0341 02130203 +20330 IVFAIL = IVFAIL + 1 02140203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02150203 + 0341 CONTINUE 02160203 +C 02170203 +C TEST 34 THROUGH TEST 36 VERIFY THAT THE CHARACTER ASSIGNMENT 02180203 +C STATEMENTS 02190203 +C 02200203 +C CHARACTER VARIABLE (LEN 1) = CHARACTER CONSTANT (LEN 1) 02210203 +C CHARACTER ARRAY ELEMENT (LEN1) = CHARACTER VARIABLE (LEN1) 02220203 +C 02230203 +C ARE CORRECT. THE CHARACTER RELATIONAL EXPRESSION 02240203 +C 02250203 +C CHARACTER ARRAY ELEMENT (LEN1) .EQ. CHAR. CONSTANT (LEN1) 02260203 +C 02270203 +C IS USED TO VERIFY THE RESULT OF THE ASSIGNMENT STATEMENTS. 02280203 +C 02290203 +C 02300203 +C **** FCVS PROGRAM 203 - TEST 034 **** 02310203 +C 02320203 +C 02330203 + IVTNUM = 34 02340203 + IF (ICZERO) 30340, 0340, 30340 02350203 + 0340 CONTINUE 02360203 + IVCOMP = 0 02370203 + IVCORR = 1 02380203 + CVTN01 = 'V' 02390203 + CATN12(2) = CVTN01 02400203 + IF (CATN12(2) .EQ. 'V') IVCOMP = 1 02410203 +40340 IF (IVCOMP - 1) 20340,10340,20340 02420203 +30340 IVDELE = IVDELE + 1 02430203 + WRITE (I02,80000) IVTNUM 02440203 + IF (ICZERO) 10340, 0351, 20340 02450203 +10340 IVPASS = IVPASS + 1 02460203 + WRITE (I02,80002) IVTNUM 02470203 + GO TO 0351 02480203 +20340 IVFAIL = IVFAIL + 1 02490203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02500203 + 0351 CONTINUE 02510203 +C 02520203 +C **** FCVS PROGRAM 203 - TEST 035 **** 02530203 +C 02540203 +C 02550203 + IVTNUM = 35 02560203 + IF (ICZERO) 30350, 0350, 30350 02570203 + 0350 CONTINUE 02580203 + IVCOMP = 0 02590203 + IVCORR = 1 02600203 + CVTN01 = '+' 02610203 + CATN12(3) = CVTN01 02620203 + IF (CATN12(3) .EQ. '+') IVCOMP = 1 02630203 +40350 IF (IVCOMP - 1) 20350,10350,20350 02640203 +30350 IVDELE = IVDELE + 1 02650203 + WRITE (I02,80000) IVTNUM 02660203 + IF (ICZERO) 10350, 0361, 20350 02670203 +10350 IVPASS = IVPASS + 1 02680203 + WRITE (I02,80002) IVTNUM 02690203 + GO TO 0361 02700203 +20350 IVFAIL = IVFAIL + 1 02710203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02720203 + 0361 CONTINUE 02730203 +C 02740203 +C **** FCVS PROGRAM 203 - TEST 036 **** 02750203 +C 02760203 +C 02770203 + IVTNUM = 36 02780203 + IF (ICZERO) 30360, 0360, 30360 02790203 + 0360 CONTINUE 02800203 + IVCOMP = 0 02810203 + IVCORR = 1 02820203 + CVTN01 = '7' 02830203 + CATN12(4) = CVTN01 02840203 + IF (CATN12(4) .EQ. '7') IVCOMP = 1 02850203 +40360 IF (IVCOMP - 1) 20360,10360,20360 02860203 +30360 IVDELE = IVDELE + 1 02870203 + WRITE (I02,80000) IVTNUM 02880203 + IF (ICZERO) 10360, 0371, 20360 02890203 +10360 IVPASS = IVPASS + 1 02900203 + WRITE (I02,80002) IVTNUM 02910203 + GO TO 0371 02920203 +20360 IVFAIL = IVFAIL + 1 02930203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02940203 + 0371 CONTINUE 02950203 +C 02960203 +C TEST 37 THROUGH TEST 39 VERIFY THAT THE CHARACTER ASSIGNMENT 02970203 +C STATEMENTS 02980203 +C 02990203 +C CHAR. ARRAY ELEMENT (LEN 1) = CHAR. CONSTANT (LEN 1) 03000203 +C CHAR. ARRAY ELEMENT (LEN 1) = CHAR. ARRAY ELEMENT (LEN 1) 03010203 +C 03020203 +C ARE CORRECT. THE CHARACTER RELATIONAL EXPRESSION 03030203 +C 03040203 +C CHAR. ARRAY ELEMENT (LEN 1) .EQ. CHAR. CONSTANT (LEN 1) 03050203 +C 03060203 +C IS USED TO VERIFY THE RESULT OF THE ASSIGNMENT STATEMENTS. 03070203 +C 03080203 +C 03090203 +C **** FCVS PROGRAM 203 - TEST 037 **** 03100203 +C 03110203 +C 03120203 + IVTNUM = 37 03130203 + IF (ICZERO) 30370, 0370, 30370 03140203 + 0370 CONTINUE 03150203 + IVCOMP = 1 03160203 + IVCORR = 6 03170203 + CATN11 (1) = 'V' 03180203 + CATN12 (1) = CATN11 (1) 03190203 + IF (CATN12(1) .EQ. 'V') IVCOMP=IVCOMP*2 03200203 + IF (CATN11(1) .EQ. 'V') IVCOMP=IVCOMP*3 03210203 +40370 IF (IVCOMP-6) 20370,10370,20370 03220203 +30370 IVDELE = IVDELE + 1 03230203 + WRITE (I02,80000) IVTNUM 03240203 + IF (ICZERO) 10370, 0381, 20370 03250203 +10370 IVPASS = IVPASS + 1 03260203 + WRITE (I02,80002) IVTNUM 03270203 + GO TO 0381 03280203 +20370 IVFAIL = IVFAIL + 1 03290203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03300203 + 0381 CONTINUE 03310203 +C 03320203 +C **** FCVS PROGRAM 203 - TEST 038 **** 03330203 +C 03340203 +C 03350203 + IVTNUM = 38 03360203 + IF (ICZERO) 30380, 0380, 30380 03370203 + 0380 CONTINUE 03380203 + IVCOMP=1 03390203 + IVCORR=6 03400203 + CATN11(2) = '+' 03410203 + CATN12(2) = CATN11(2) 03420203 + IF (CATN12(2) .EQ. '+') IVCOMP=IVCOMP*2 03430203 + IF (CATN11(2) .EQ. '+') IVCOMP=IVCOMP*3 03440203 +40380 IF (IVCOMP - 6) 20380,10380,20380 03450203 +30380 IVDELE = IVDELE + 1 03460203 + WRITE (I02,80000) IVTNUM 03470203 + IF (ICZERO) 10380, 0391, 20380 03480203 +10380 IVPASS = IVPASS + 1 03490203 + WRITE (I02,80002) IVTNUM 03500203 + GO TO 0391 03510203 +20380 IVFAIL = IVFAIL + 1 03520203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03530203 + 0391 CONTINUE 03540203 +C 03550203 +C **** FCVS PROGRAM 203 - TEST 039 **** 03560203 +C 03570203 +C 03580203 + IVTNUM = 39 03590203 + IF (ICZERO) 30390, 0390, 30390 03600203 + 0390 CONTINUE 03610203 + IVCOMP = 1 03620203 + IVCORR = 6 03630203 + CATN11 (3) = '7' 03640203 + CATN12 (3) = CATN11 (3) 03650203 + IF (CATN12(3) .EQ. '7') IVCOMP = IVCOMP * 2 03660203 + IF (CATN11(3) .EQ. '7') IVCOMP = IVCOMP * 3 03670203 +40390 IF (IVCOMP - 6) 20390,10390,20390 03680203 +30390 IVDELE = IVDELE + 1 03690203 + WRITE (I02,80000) IVTNUM 03700203 + IF (ICZERO) 10390, 0401, 20390 03710203 +10390 IVPASS = IVPASS + 1 03720203 + WRITE (I02,80002) IVTNUM 03730203 + GO TO 0401 03740203 +20390 IVFAIL = IVFAIL + 1 03750203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03760203 + 0401 CONTINUE 03770203 +C 03780203 +C TEST 40 AND TEST 41 VERIFY THAT THE CHARACTER ASSIGNMENT 03790203 +C STATEMENTS 03800203 +C 03810203 +C CHAR. ARRAY ELEMENT (LEN 1) = CHAR. CONSTANT (LEN 1) 03820203 +C CHAR. VARIABLE (LEN 1) = CHAR. ARRAY ELEMENT (LEN 1) 03830203 +C 03840203 +C ARE CORRECT. 03850203 +C 03860203 +C 03870203 +C **** FCVS PROGRAM 203 - TEST 040 **** 03880203 +C 03890203 +C 03900203 + IVTNUM = 40 03910203 + IF (ICZERO) 30400, 0400, 30400 03920203 + 0400 CONTINUE 03930203 + IVCOMP = 0 03940203 + IVCORR = 1 03950203 + CATN11(4) = 'X' 03960203 + CVTN02 = CATN11 (4) 03970203 + IF (CVTN02 .EQ. 'X') IVCOMP = 1 03980203 +40400 IF (IVCOMP - 1) 20400,10400,20400 03990203 +30400 IVDELE = IVDELE + 1 04000203 + WRITE (I02,80000) IVTNUM 04010203 + IF (ICZERO) 10400, 0411, 20400 04020203 +10400 IVPASS = IVPASS + 1 04030203 + WRITE (I02,80002) IVTNUM 04040203 + GO TO 0411 04050203 +20400 IVFAIL = IVFAIL + 1 04060203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04070203 + 0411 CONTINUE 04080203 +C 04090203 +C **** FCVS PROGRAM 203 - TEST 041 **** 04100203 +C 04110203 +C 04120203 + IVTNUM = 41 04130203 + IF (ICZERO) 30410, 0410, 30410 04140203 + 0410 CONTINUE 04150203 + IVCOMP = 0 04160203 + IVCORR = 1 04170203 + CATN11(3) = '-' 04180203 + CVTN02 = CATN11(3) 04190203 + IF (CVTN02 .EQ. '-') IVCOMP=1 04200203 +40410 IF (IVCOMP - 1) 20410,10410,20410 04210203 +30410 IVDELE = IVDELE + 1 04220203 + WRITE (I02,80000) IVTNUM 04230203 + IF (ICZERO) 10410, 0421, 20410 04240203 +10410 IVPASS = IVPASS + 1 04250203 + WRITE (I02,80002) IVTNUM 04260203 + GO TO 0421 04270203 +20410 IVFAIL = IVFAIL + 1 04280203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04290203 + 0421 CONTINUE 04300203 +C 04310203 +C TEST 42 THROUGH TEST 44 VERIFY THE RESULTS OF CHARACTER 04320203 +C RELATIONAL EXPRESSIONS USING EACH OF THE SIX RELATIONAL OPERATORS.04330203 +C THE CHARACTER DATA 'A' AND '1' ARE COMPARED IN THE EXPRESSION 04340203 +C AND ARE INITIALIZED BY THE CHARACTER ASSIGNMENT STATEMENTS 04350203 +C 04360203 + CATN11 (4) = 'A' 04370203 + CATN12 (3) = '1' 04380203 + CVTN01 = 'A' 04390203 + CVTN02 = '1' 04400203 +C 04410203 +C **** FCVS PROGRAM 203 - TEST 042 **** 04420203 +C 04430203 +C RELATIONAL OPERATORS .NE. AND .EQ. 04440203 +C CHAR. ARRAY ELEMENT (LEN 1) RELOP CHAR. CONSTANT (LEN 1) 04450203 +C 04460203 + IVTNUM = 42 04470203 + IF (ICZERO) 30420, 0420, 30420 04480203 + 0420 CONTINUE 04490203 + IVCOMP = 1 04500203 + IVCORR = 3 04510203 + IF (CATN11(4) .EQ. '1') IVCOMP=IVCOMP*2 04520203 + IF ('A' .NE. CATN12(3)) IVCOMP=IVCOMP*3 04530203 +40420 IF (IVCOMP - 3) 20420,10420,20420 04540203 +30420 IVDELE = IVDELE + 1 04550203 + WRITE (I02,80000) IVTNUM 04560203 + IF (ICZERO) 10420, 0431, 20420 04570203 +10420 IVPASS = IVPASS + 1 04580203 + WRITE (I02,80002) IVTNUM 04590203 + GO TO 0431 04600203 +20420 IVFAIL = IVFAIL + 1 04610203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04620203 + 0431 CONTINUE 04630203 +C 04640203 +C **** FCVS PROGRAM 203 - TEST 043 **** 04650203 +C 04660203 +C RELATIONAL OPERATORS .LE. AND .GE. 04670203 +C CHAR. ARRAY ELEMENT (LEN 1) RELOP CHAR. VARIABLE (LEN 1) 04680203 +C 04690203 + IVTNUM = 43 04700203 + IF (ICZERO) 30430, 0430, 30430 04710203 + 0430 CONTINUE 04720203 + IVCOMP = 0 04730203 + IVCORR = 1 04740203 + IF (CATN11(4) .LE. CVTN02) IVCOMP=IVCOMP+1 04750203 + IF (CVTN01 .GE. CATN12(3)) IVCOMP=IVCOMP+1 04760203 +40430 IF (IVCOMP - 1) 20430,10430,20430 04770203 +30430 IVDELE = IVDELE + 1 04780203 + WRITE (I02,80000) IVTNUM 04790203 + IF (ICZERO) 10430, 0441, 20430 04800203 +10430 IVPASS = IVPASS + 1 04810203 + WRITE (I02,80002) IVTNUM 04820203 + GO TO 0441 04830203 +20430 IVFAIL = IVFAIL + 1 04840203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04850203 + 0441 CONTINUE 04860203 +C 04870203 +C **** FCVS PROGRAM 203 - TEST 044 **** 04880203 +C 04890203 +C RELATIONAL OPERATORS .LT. AND .GT. 04900203 +C CHAR. ARRAY ELEMENT (LEN 1) RELOP CHAR. ARRAY ELEMENT (LEN 1) 04910203 +C 04920203 + IVTNUM = 44 04930203 + IF (ICZERO) 30440, 0440, 30440 04940203 + 0440 CONTINUE 04950203 + IVCOMP = 0 04960203 + IVCORR = 1 04970203 + IF (CATN11(4) .LT. CATN12(3)) IVCOMP=IVCOMP+1 04980203 + IF (CATN11(4) .GT. CATN12(3)) IVCOMP=IVCOMP+1 04990203 +40440 IF (IVCOMP - 1) 20440,10440,20440 05000203 +30440 IVDELE = IVDELE + 1 05010203 + WRITE (I02,80000) IVTNUM 05020203 + IF (ICZERO) 10440, 0451, 20440 05030203 +10440 IVPASS = IVPASS + 1 05040203 + WRITE (I02,80002) IVTNUM 05050203 + GO TO 0451 05060203 +20440 IVFAIL = IVFAIL + 1 05070203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05080203 + 0451 CONTINUE 05090203 +C 05100203 +C **** FCVS PROGRAM 203 - TEST 045 **** 05110203 +C 05120203 +C TEST 45 VERIFIES THAT THE LAST ELEMENTS OF THE ARRAYS USED 05130203 +C IN TEST 31 THROUGH TEST 44 WERE NOT AFFECTED BY THE SETTING 05140203 +C OF OTHER CHARACTER ARRAY ELEMENTS. 05150203 +C 05160203 + IVTNUM = 45 05170203 + IF (ICZERO) 30450, 0450, 30450 05180203 + 0450 CONTINUE 05190203 + IVCOMP = 1 05200203 + IVCORR = 30 05210203 + IF (CATN11(5) .EQ. ' ') IVCOMP=IVCOMP*2 05220203 + IF (CATN12(5) .EQ. ' ') IVCOMP=IVCOMP*3 05230203 + IF (CATN11(5) .EQ. CATN12(5)) IVCOMP=IVCOMP*5 05240203 +40450 IF (IVCOMP - 30) 20450,10450,20450 05250203 +30450 IVDELE = IVDELE + 1 05260203 + WRITE (I02,80000) IVTNUM 05270203 + IF (ICZERO) 10450, 0461, 20450 05280203 +10450 IVPASS = IVPASS + 1 05290203 + WRITE (I02,80002) IVTNUM 05300203 + GO TO 0461 05310203 +20450 IVFAIL = IVFAIL + 1 05320203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05330203 + 0461 CONTINUE 05340203 +C 05350203 +C TEST 46 THROUGH TEST 49 CONTAIN CHARACTER ARRAY ELEMENTS OF 05360203 +C LENGTH TWO IN CHARACTER ASSIGNMENT STATEMENTS. THE CHARACTER 05370203 +C RELATIONAL EXPRESSION 05380203 +C 05390203 +C CHAR. ARRAY ELEMENT (LEN 2) .EQ. CHAR. CONSTANT (LEN 2) 05400203 +C 05410203 +C IS USED TO VERIFY THE TEST RESULTS. 05420203 +C 05430203 +C THE TWO ARRAYS USED IN THESE TESTS ARE CATN13(5) AND CATN14(5)05440203 +C THE ARRAYS ARE INITIALIZED TO TWO BLANK CHARACTERS BY THE DO-LOOP 05450203 +C 05460203 + DO 462 I=1,5 05470203 + CATN13(I) = ' ' 05480203 + CATN14(I) = ' ' 05490203 + 462 CONTINUE 05500203 +C 05510203 +C **** FCVS PROGRAM 203 - TEST 046 **** 05520203 +C 05530203 +C CHAR. ARRAY ELEMENT (LEN 2) = CHAR. CONSTANT (LEN 2) 05540203 +C 05550203 + IVTNUM = 46 05560203 + IF (ICZERO) 30460, 0460, 30460 05570203 + 0460 CONTINUE 05580203 + IVCOMP = 0 05590203 + IVCORR = 1 05600203 + CATN13(1) = 'AB' 05610203 + IF (CATN13(1) .EQ. 'AB') IVCOMP = 1 05620203 +40460 IF (IVCOMP - 1) 20460,10460,20460 05630203 +30460 IVDELE = IVDELE + 1 05640203 + WRITE (I02,80000) IVTNUM 05650203 + IF (ICZERO) 10460, 0471, 20460 05660203 +10460 IVPASS = IVPASS + 1 05670203 + WRITE (I02,80002) IVTNUM 05680203 + GO TO 0471 05690203 +20460 IVFAIL = IVFAIL + 1 05700203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05710203 + 0471 CONTINUE 05720203 +C 05730203 +C **** FCVS PROGRAM 203 - TEST 047 **** 05740203 +C 05750203 +C CHAR. VARIABLE (LEN 2) = CHAR. CONSTANT (LEN 2) 05760203 +C CHAR. ARRAY ELEMENT (LEN 2) = CHAR. VARIABLE (LEN 2) 05770203 +C 05780203 + IVTNUM = 47 05790203 + IF (ICZERO) 30470, 0470, 30470 05800203 + 0470 CONTINUE 05810203 + IVCOMP = 0 05820203 + IVCORR = 1 05830203 + CVTN03 = '+-' 05840203 + CATN13(2) = CVTN03 05850203 + IF (CATN13(2) .EQ. '+-') IVCOMP=1 05860203 +40470 IF (IVCOMP - 1) 20470,10470,20470 05870203 +30470 IVDELE = IVDELE + 1 05880203 + WRITE (I02,80000) IVTNUM 05890203 + IF (ICZERO) 10470, 0481, 20470 05900203 +10470 IVPASS = IVPASS + 1 05910203 + WRITE (I02,80002) IVTNUM 05920203 + GO TO 0481 05930203 +20470 IVFAIL = IVFAIL + 1 05940203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05950203 + 0481 CONTINUE 05960203 +C 05970203 +C **** FCVS PROGRAM 203 - TEST 048 **** 05980203 +C 05990203 +C CHAR. ARRAY ELEMENT (LEN 2) = CHAR. CONSTANT (LEN 2) 06000203 +C CHAR. ARRAY ELEMENT (LEN 2) = CHAR. ARRAY ELEMENT (LEN 2) 06010203 +C 06020203 + IVTNUM = 48 06030203 + IF (ICZERO) 30480, 0480, 30480 06040203 + 0480 CONTINUE 06050203 + IVCOMP = 0 06060203 + IVCORR = 1 06070203 + CATN13(4) = '24' 06080203 + CATN13(3) = CATN13(4) 06090203 + IF (CATN13(3) .EQ. '24') IVCOMP = 1 06100203 +40480 IF (IVCOMP - 1) 20480,10480,20480 06110203 +30480 IVDELE = IVDELE + 1 06120203 + WRITE (I02,80000) IVTNUM 06130203 + IF (ICZERO) 10480, 0491, 20480 06140203 +10480 IVPASS = IVPASS + 1 06150203 + WRITE (I02,80002) IVTNUM 06160203 + GO TO 0491 06170203 +20480 IVFAIL = IVFAIL + 1 06180203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06190203 + 0491 CONTINUE 06200203 +C 06210203 +C **** FCVS PROGRAM 203 - TEST 049 **** 06220203 +C 06230203 +C CHAR. ARRAY ELEMENT (LEN 2) = CHAR. CONSTANT (LEN 2) 06240203 +C CHAR. VARIABLE (LEN 2) = CHAR. ARRAY ELEMENT (LEN 2) 06250203 +C 06260203 + IVTNUM = 49 06270203 + IF (ICZERO) 30490, 0490, 30490 06280203 + 0490 CONTINUE 06290203 + IVCOMP = 0 06300203 + IVCORR = 1 06310203 + CATN14(1) = 'AB' 06320203 + CVTN04 = CATN14(1) 06330203 + IF (CVTN04 .EQ. 'AB') IVCOMP = 1 06340203 +40490 IF (IVCOMP - 1) 20490,10490,20490 06350203 +30490 IVDELE = IVDELE + 1 06360203 + WRITE (I02,80000) IVTNUM 06370203 + IF (ICZERO) 10490, 0501, 20490 06380203 +10490 IVPASS = IVPASS + 1 06390203 + WRITE (I02,80002) IVTNUM 06400203 + GO TO 0501 06410203 +20490 IVFAIL = IVFAIL + 1 06420203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06430203 + 0501 CONTINUE 06440203 +C 06450203 +C TEST 50 THROUGH TEST 52 VERIFY THE RESULTS OF CHARACTER 06460203 +C RELATIONAL EXPRESSIONS USING EACH OF THE SIX RELATIONAL OPERATORS.06470203 +C THE CHARACTER DATA 'ZA' AND 'Z1' ARE COMPARED IN THE EXPRESSION 06480203 +C AND ARE INITIALIZED BY THE CHARACTER ASSIGNMENT STATEMENTS 06490203 +C 06500203 + CATN14(2) = 'ZA' 06510203 + CATN14(3) = 'Z1' 06520203 + CVTN03 = 'ZA' 06530203 + CVTN04 = 'Z1' 06540203 +C 06550203 +C **** FCVS PROGRAM 203 - TEST 050 **** 06560203 +C 06570203 +C RELATIONAL OPERATORS .NE. AND .EQ. 06580203 +C CHAR. ARRAY ELEMENT (LEN 2) RELOP CHAR. VARIABLE (LEN 2) 06590203 +C 06600203 + IVTNUM = 50 06610203 + IF (ICZERO) 30500, 0500, 30500 06620203 + 0500 CONTINUE 06630203 + IVCOMP = 1 06640203 + IVCORR = 3 06650203 + IF (CATN14(2) .EQ. 'Z1') IVCOMP=IVCOMP*2 06660203 + IF ('ZA' .NE. CATN14(3)) IVCOMP=IVCOMP*3 06670203 +40500 IF (IVCOMP - 3) 20500,10500,20500 06680203 +30500 IVDELE = IVDELE + 1 06690203 + WRITE (I02,80000) IVTNUM 06700203 + IF (ICZERO) 10500, 0511, 20500 06710203 +10500 IVPASS = IVPASS + 1 06720203 + WRITE (I02,80002) IVTNUM 06730203 + GO TO 0511 06740203 +20500 IVFAIL = IVFAIL + 1 06750203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06760203 + 0511 CONTINUE 06770203 +C 06780203 +C **** FCVS PROGRAM 203 - TEST 051 **** 06790203 +C 06800203 +C RELATIONAL OPERATORS .LE. AND .GE. 06810203 +C CHAR. ARRAY ELEMENT (LEN 2) RELOP CHAR. VARIABLE (LEN 2) 06820203 +C 06830203 + IVTNUM = 51 06840203 + IF (ICZERO) 30510, 0510, 30510 06850203 + 0510 CONTINUE 06860203 + IVCOMP = 0 06870203 + IVCORR = 1 06880203 + IF (CATN14(2) .LE. CVTN04) IVCOMP=IVCOMP+1 06890203 + IF (CVTN03 .GE. CATN14(3)) IVCOMP=IVCOMP+1 06900203 +40510 IF (IVCOMP - 1) 20510,10510,20510 06910203 +30510 IVDELE = IVDELE + 1 06920203 + WRITE (I02,80000) IVTNUM 06930203 + IF (ICZERO) 10510, 0521, 20510 06940203 +10510 IVPASS = IVPASS + 1 06950203 + WRITE (I02,80002) IVTNUM 06960203 + GO TO 0521 06970203 +20510 IVFAIL = IVFAIL + 1 06980203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06990203 + 0521 CONTINUE 07000203 +C 07010203 +C **** FCVS PROGRAM 203 - TEST 052 **** 07020203 +C 07030203 +C RELATIONAL OPERATORS .LT. AND .GT. 07040203 +C CHAR. ARRAY ELEMENT (LEN 2) RELOP CHAR. ARRAY ELEMENT (LEN 2) 07050203 +C 07060203 + IVTNUM = 52 07070203 + IF (ICZERO) 30520, 0520, 30520 07080203 + 0520 CONTINUE 07090203 + IVCOMP =0 07100203 + IVCORR =1 07110203 + IF (CATN14(2) .LT. CATN14(3)) IVCOMP=IVCOMP+1 07120203 + IF (CATN14(2) .GT. CATN14(3)) IVCOMP=IVCOMP+1 07130203 +40520 IF (IVCOMP - 1) 20520,10520,20520 07140203 +30520 IVDELE = IVDELE + 1 07150203 + WRITE (I02,80000) IVTNUM 07160203 + IF (ICZERO) 10520, 0531, 20520 07170203 +10520 IVPASS = IVPASS + 1 07180203 + WRITE (I02,80002) IVTNUM 07190203 + GO TO 0531 07200203 +20520 IVFAIL = IVFAIL + 1 07210203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07220203 + 0531 CONTINUE 07230203 +C 07240203 +C **** FCVS PROGRAM 203 - TEST 053 **** 07250203 +C 07260203 +C TEST 53 VERIFIES THAT THE LAST ELEMENTS OF THE ARRAYS USED IN 07270203 +C TEST 46 THROUGH TEST 52 WERE NOT AFFECTED BY THE SETTING OF OTHER 07280203 +C CHARACTER ARRAY ELEMENTS. 07290203 +C 07300203 + IVTNUM = 53 07310203 + IF (ICZERO) 30530, 0530, 30530 07320203 + 0530 CONTINUE 07330203 + IVCOMP = 1 07340203 + IVCORR = 30 07350203 + IF (CATN13(5) .EQ. ' ')IVCOMP=IVCOMP*2 07360203 + IF (CATN14(5) .EQ. ' ') IVCOMP= IVCOMP * 3 07370203 + IF (CATN14(5) .EQ. CATN13(5)) IVCOMP=IVCOMP*5 07380203 +40530 IF (IVCOMP - 30) 20530,10530,20530 07390203 +30530 IVDELE = IVDELE + 1 07400203 + WRITE (I02,80000) IVTNUM 07410203 + IF (ICZERO) 10530, 0541, 20530 07420203 +10530 IVPASS = IVPASS + 1 07430203 + WRITE (I02,80002) IVTNUM 07440203 + GO TO 0541 07450203 +20530 IVFAIL = IVFAIL + 1 07460203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07470203 + 0541 CONTINUE 07480203 +C 07490203 +C TEST 54 THROUGH TEST 60 VERIFY THAT A CHARACTER PRIMARY CAN 07500203 +C BE ENCLOSED IN PARENTHESES. THE CHARACTER PRIMARIES FOR THE 07510203 +C SUBSET ARE CHARACTER CONSTANT, CHARACTER VARIABLE, CHARACTER ARRAY07520203 +C ELEMENT, AND CHARACTER EXPRESSION ENCLOSED IN PARENTHESES. THE 07530203 +C FORM OF A CHARACTER EXPRESSION IS CHARACTER PRIMARY. 07540203 +C 07550203 +C 07560203 +C **** FCVS PROGRAM 203 - TEST 054 **** 07570203 +C 07580203 +C CHARACTER ASSIGNMENT STATEMENT 07590203 +C CHAR. VARIABLE = (CHARACTER CONSTANT) LENGTH 1 07600203 +C 07610203 + IVTNUM = 54 07620203 + IF (ICZERO) 30540, 0540, 30540 07630203 + 0540 CONTINUE 07640203 + CVTN01 = ' ' 07650203 + IVCOMP = 0 07660203 + IVCORR = 1 07670203 + CVTN01 = ('N') 07680203 + IF (CVTN01 .EQ. 'N') IVCOMP = 1 07690203 +40540 IF (IVCOMP - 1) 20540,10540,20540 07700203 +30540 IVDELE = IVDELE + 1 07710203 + WRITE (I02,80000) IVTNUM 07720203 + IF (ICZERO) 10540, 0551, 20540 07730203 +10540 IVPASS = IVPASS + 1 07740203 + WRITE (I02,80002) IVTNUM 07750203 + GO TO 0551 07760203 +20540 IVFAIL = IVFAIL + 1 07770203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07780203 + 0551 CONTINUE 07790203 +C 07800203 +C **** FCVS PROGRAM 203 - TEST 055 **** 07810203 +C 07820203 +C CHARACTER ASSIGNMENT STATEMENT 07830203 +C CHAR. VARIABLE = (CHAR. VARIABLE) LENGTH 2 07840203 +C 07850203 + IVTNUM = 55 07860203 + IF (ICZERO) 30550, 0550, 30550 07870203 + 0550 CONTINUE 07880203 + CVTN04 = ' ' 07890203 + IVCOMP = 0 07900203 + IVCORR = 1 07910203 + CVTN03 = '/+' 07920203 + CVTN04 = (CVTN03) 07930203 + IF (CVTN04 .EQ. '/+') IVCOMP=1 07940203 +40550 IF (IVCOMP - 1) 20550,10550,20550 07950203 +30550 IVDELE = IVDELE + 1 07960203 + WRITE (I02,80000) IVTNUM 07970203 + IF (ICZERO) 10550, 0561, 20550 07980203 +10550 IVPASS = IVPASS + 1 07990203 + WRITE (I02,80002) IVTNUM 08000203 + GO TO 0561 08010203 +20550 IVFAIL = IVFAIL + 1 08020203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08030203 + 0561 CONTINUE 08040203 +C 08050203 +C **** FCVS PROGRAM 203 - TEST 056 **** 08060203 +C 08070203 +C CHARACTER ASSIGNMENT STATEMENT 08080203 +C CHAR. VARIABLE = (CHAR. ARRAY ELEMENT) LENGTH 2 08090203 +C 08100203 + IVTNUM = 56 08110203 + IF (ICZERO) 30560, 0560, 30560 08120203 + 0560 CONTINUE 08130203 + IVCOMP = 0 08140203 + IVCORR = 1 08150203 + CVTN04 = ' ' 08160203 + CATN13(1) = 'BC' 08170203 + CVTN04 = (CATN13(1)) 08180203 + IF (CVTN04 .EQ. 'BC') IVCOMP = 1 08190203 +40560 IF (IVCOMP - 1) 20560,10560,20560 08200203 +30560 IVDELE = IVDELE + 1 08210203 + WRITE (I02,80000) IVTNUM 08220203 + IF (ICZERO) 10560, 0571, 20560 08230203 +10560 IVPASS = IVPASS + 1 08240203 + WRITE (I02,80002) IVTNUM 08250203 + GO TO 0571 08260203 +20560 IVFAIL = IVFAIL + 1 08270203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08280203 + 0571 CONTINUE 08290203 +C 08300203 +C **** FCVS PROGRAM 203 - TEST 057 **** 08310203 +C 08320203 +C CHARACTER ASSIGNMENT STATEMENT 08330203 +C CHAR. VARIABLE = ((CHAR. ARRAY ELEMENT)) LENGTH 2 08340203 +C 08350203 + IVTNUM = 57 08360203 + IF (ICZERO) 30570, 0570, 30570 08370203 + 0570 CONTINUE 08380203 + IVCOMP = 0 08390203 + IVCORR = 1 08400203 + CVTN04 = ' ' 08410203 + CATN13(3) = 'BC' 08420203 + CVTN04 = ((CATN13(3))) 08430203 + IF (CVTN04 .EQ. 'BC') IVCOMP=1 08440203 +40570 IF (IVCOMP - 1) 20570,10570,20570 08450203 +30570 IVDELE = IVDELE + 1 08460203 + WRITE (I02,80000) IVTNUM 08470203 + IF (ICZERO) 10570, 0581, 20570 08480203 +10570 IVPASS = IVPASS + 1 08490203 + WRITE (I02,80002) IVTNUM 08500203 + GO TO 0581 08510203 +20570 IVFAIL = IVFAIL + 1 08520203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08530203 + 0581 CONTINUE 08540203 +C 08550203 +C **** FCVS PROGRAM 203 - TEST 058 **** 08560203 +C 08570203 +C RELATIONAL EXPRESSION, .NE. 08580203 +C (CHAR. CONSTANT) .NE. (CHAR. VARIABLE) LENGTH 1 08590203 +C 08600203 + IVTNUM = 58 08610203 + IF (ICZERO) 30580, 0580, 30580 08620203 + 0580 CONTINUE 08630203 + IVCOMP = 0 08640203 + IVCORR = 1 08650203 + CVTN01 = '6' 08660203 + IF (('9') .NE. (CVTN01)) IVCOMP=1 08670203 +40580 IF (IVCOMP - 1) 20580,10580,20580 08680203 +30580 IVDELE = IVDELE + 1 08690203 + WRITE (I02,80000) IVTNUM 08700203 + IF (ICZERO) 10580, 0591, 20580 08710203 +10580 IVPASS = IVPASS + 1 08720203 + WRITE (I02,80002) IVTNUM 08730203 + GO TO 0591 08740203 +20580 IVFAIL = IVFAIL + 1 08750203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08760203 + 0591 CONTINUE 08770203 +C 08780203 +C **** FCVS PROGRAM 203 - TEST 059 **** 08790203 +C 08800203 +C RELATIONAL EXPRESSION, .GE. 08810203 +C (CHAR. VARIABLE) .GE. (CHAR. ARRAY ELEMENT) LENGTH 2 08820203 +C 08830203 + IVTNUM = 59 08840203 + IF (ICZERO) 30590, 0590, 30590 08850203 + 0590 CONTINUE 08860203 + IVCOMP = 0 08870203 + IVCORR = 1 08880203 + CVTN03 = 'DE' 08890203 + CATN13(5) = 'DE' 08900203 + IF ((CVTN03) .GE. (CATN13(5))) IVCOMP=1 08910203 +40590 IF (IVCOMP - 1) 20590,10590,20590 08920203 +30590 IVDELE = IVDELE + 1 08930203 + WRITE (I02,80000) IVTNUM 08940203 + IF (ICZERO) 10590, 0601, 20590 08950203 +10590 IVPASS = IVPASS + 1 08960203 + WRITE (I02,80002) IVTNUM 08970203 + GO TO 0601 08980203 +20590 IVFAIL = IVFAIL + 1 08990203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09000203 + 0601 CONTINUE 09010203 +C 09020203 +C **** FCVS PROGRAM 203 - TEST 060 **** 09030203 +C 09040203 +C RELATIONAL EXPRESSION, .LE. 09050203 +C ((CHAR. ARRAY ELEMENT)) .LE. ((CHAR. ARRAY ELEMENT)) LEN 2 09060203 +C 09070203 + IVTNUM = 60 09080203 + IF (ICZERO) 30600, 0600, 30600 09090203 + 0600 CONTINUE 09100203 + IVCOMP = 0 09110203 + IVCORR = 1 09120203 + CATN13(4) = 'MC' 09130203 + CATN13(5) = 'MC' 09140203 + IF (((CATN13(4))) .LE. ((CATN13(5)))) IVCOMP = 1 09150203 +40600 IF (IVCOMP - 1) 20600,10600,20600 09160203 +30600 IVDELE = IVDELE + 1 09170203 + WRITE (I02,80000) IVTNUM 09180203 + IF (ICZERO) 10600, 0611, 20600 09190203 +10600 IVPASS = IVPASS + 1 09200203 + WRITE (I02,80002) IVTNUM 09210203 + GO TO 0611 09220203 +20600 IVFAIL = IVFAIL + 1 09230203 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09240203 + 0611 CONTINUE 09250203 +C 09260203 +C 09270203 +C WRITE OUT TEST SUMMARY 09280203 +C 09290203 + WRITE (I02,90004) 09300203 + WRITE (I02,90014) 09310203 + WRITE (I02,90004) 09320203 + WRITE (I02,90000) 09330203 + WRITE (I02,90004) 09340203 + WRITE (I02,90020) IVFAIL 09350203 + WRITE (I02,90022) IVPASS 09360203 + WRITE (I02,90024) IVDELE 09370203 + STOP 09380203 +90001 FORMAT (" ",24X,"FM203") 09390203 +90000 FORMAT (" ",20X,"END OF PROGRAM FM203" ) 09400203 +C 09410203 +C FORMATS FOR TEST DETAIL LINES 09420203 +C 09430203 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 09440203 +80002 FORMAT (" ",4X,I5,7X,"PASS") 09450203 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 09460203 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 09470203 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 09480203 +C 09490203 +C FORMAT STATEMENTS FOR PAGE HEADERS 09500203 +C 09510203 +90002 FORMAT ("1") 09520203 +90004 FORMAT (" ") 09530203 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 09540203 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 09550203 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 09560203 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 09570203 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 09580203 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 09590203 +C 09600203 +C FORMAT STATEMENTS FOR RUN SUMMARY 09610203 +C 09620203 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 09630203 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 09640203 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 09650203 + END 09660203 diff --git a/Fortran/UnitTests/fcvs21_f95/FM203.reference_output b/Fortran/UnitTests/fcvs21_f95/FM203.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM203.reference_output @@ -0,0 +1,51 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM203 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + 36 PASS + 37 PASS + 38 PASS + 39 PASS + 40 PASS + 41 PASS + 42 PASS + 43 PASS + 44 PASS + 45 PASS + 46 PASS + 47 PASS + 48 PASS + 49 PASS + 50 PASS + 51 PASS + 52 PASS + 53 PASS + 54 PASS + 55 PASS + 56 PASS + 57 PASS + 58 PASS + 59 PASS + 60 PASS + + ---------------------------------------------- + + END OF PROGRAM FM203 + + 0 TESTS FAILED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM204.f b/Fortran/UnitTests/fcvs21_f95/FM204.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM204.f @@ -0,0 +1,872 @@ + PROGRAM FM204 00010204 +C 00020204 +C 00030204 +C THIS ROUTINE CONTINUES THE TESTING OF CHARACTER VARIABLES AND 00040204 +C CHARACTER ARRAYS OF LENGTH ONE. THE CHARACTER FEATURES TESTED IN 00050204 +C FM202 AND FM203 ARE USED IN THE TESTS IN THIS ROUTINE. THE 00060204 +C FOLLOWING CHARACTER FEATURES ARE TESTED 00070204 +C 00080204 +C (1) INITIAL DEFINITION OF CHARACTER ENTITIES OF LENGTH ONE BY 00090204 +C SPECIFYING THEM IN A DATA STATEMENT. 00100204 +C 00110204 +C (2) THE SUBSET FORTRAN LANGUAGE SPECIFIES THE FOLLOWING 00120204 +C COLLATING SEQUENCE RULES. 00130204 +C 00140204 +C A LESS THAN B ... LESS THAN Z, 00150204 +C 0 LESS THAN 1 ... LESS THAN 9, 00160204 +C ALL OF THE DIGITS PRECEDE A OR ALL OF THE DIGITS FOLLOW 00170204 +C Z, 00180204 +C BLANK IS LESS THAN THE LETTER A AND BLANK IS LESS THAN 00190204 +C THE DIGIT ZERO. 00200204 +C 00210204 +C (3) THE VALUE OF THE INTRINSIC FUNCTION ICHAR IS AN INTEGER 00220204 +C IN THE RANGE (0, N-1), WHERE N IS THE NUMBER OF CHARACTERS IN 00230204 +C THE COLLATING SEQUENCE FOR THE PROCESSOR. FOR ANY CHARACTERS 00240204 +C C1 AND C2 CAPABLE OF REPRESENTATION IN THE PROCESSOR, C1 .LE. C2 00250204 +C IS TRUE IF AND ONLY IF ICHAR(C1) .LE. ICHAR(C2) IS TRUE; AND 00260204 +C C1 .EQ. C2 IF AND ONLY IF ICHAR(C1) .EQ. ICHAR(C2). 00270204 +C 00280204 +C REFERENCES 00290204 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00300204 +C X3.9-1978 00310204 +C 00320204 +C SECTION 3.1.5, COLLATING SEQUENCE AND GRAPHICS 00330204 +C SECTION 4.8, CHARACTER TYPE 00340204 +C SECTION 6.2, CHARACTER EXPRESSIONS 00350204 +C SECTION 6.3.4, CHARACTER RELATIONAL EXPRESSIONS 00360204 +C SECTION 6.3.5, INTERPRETATION OF CHARACTER RELATIONAL 00370204 +C EXPRESSIONS 00380204 +C SECTION 8.4.2, CHARACTER TYPE-STATEMENT 00390204 +C SECTION 9.4, CHARACTER CONSTANT IN A DATA STATEMENT 00400204 +C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT 00410204 +C SECTION 15.3, INTRINSIC FUNCTIONS 00420204 +C SECTION 15.10, TABLE 5 INTRINSIC FUNCTIONS 00430204 +C 00440204 +C 00450204 +C ******************************************************************00460204 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00470204 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00480204 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00490204 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00500204 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00510204 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00520204 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00530204 +C THE RESULT OF EXECUTING THESE TESTS. 00540204 +C 00550204 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00560204 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00570204 +C 00580204 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00590204 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00600204 +C SOFTWARE STANDARDS VALIDATION GROUP 00610204 +C BUILDING 225 RM A266 00620204 +C GAITHERSBURG, MD 20899 00630204 +C ******************************************************************00640204 +C 00650204 +C 00660204 + IMPLICIT LOGICAL (L) 00670204 + IMPLICIT CHARACTER*14 (C) 00680204 +C 00690204 + CHARACTER*1 CATN11(47), CATN12(26), CATN13(10) 00700204 + CHARACTER CVTN10*1, CATN14(6)*1, CVTN01 00710204 + DIMENSION IAON11(47) 00720204 + DATA CATN11/'A','B','C','D','E','F','G','H','I','J','K','L','M', 00730204 + 1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z','0','1', 00740204 + 2 '2','3','4','5','6','7','8','9',' ','=','+','-','*','/','(', 00750204 + 3 ')',',','.',''''/ 00760204 + DATA CATN12/'A','B','C','D','E','F','G','H','I','J','K','L','M', 00770204 + 1 'N','O','P','Q','R','S','T','U','V','W','X','Y','Z'/ 00780204 + DATA CATN14(1),CATN14(2),CATN14(3),CATN14(4),CATN14(5),CATN14(6) 00790204 + 1 /6*'V'/,IAON11/47*7/, CATN13/'0','1','2','3','4','5','6', 00800204 + 2 '7','8','9'/,CVTN10/' '/ 00810204 +C 00820204 +C 00830204 +C 00840204 +C INITIALIZATION SECTION. 00850204 +C 00860204 +C INITIALIZE CONSTANTS 00870204 +C ******************** 00880204 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00890204 + I01 = 5 00900204 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00910204 + I02 = 6 00920204 +C SYSTEM ENVIRONMENT SECTION 00930204 +C 00940204 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00950204 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00960204 +C (UNIT NUMBER FOR CARD READER). 00970204 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00980204 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00990204 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01000204 +C 01010204 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01020204 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01030204 +C (UNIT NUMBER FOR PRINTER). 01040204 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01050204 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01060204 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01070204 +C 01080204 + IVPASS = 0 01090204 + IVFAIL = 0 01100204 + IVDELE = 0 01110204 + ICZERO = 0 01120204 +C 01130204 +C WRITE OUT PAGE HEADERS 01140204 +C 01150204 + WRITE (I02,90002) 01160204 + WRITE (I02,90006) 01170204 + WRITE (I02,90008) 01180204 + WRITE (I02,90004) 01190204 + WRITE (I02,90010) 01200204 + WRITE (I02,90004) 01210204 + WRITE (I02,90016) 01220204 + WRITE (I02,90001) 01230204 + WRITE (I02,90004) 01240204 + WRITE (I02,90012) 01250204 + WRITE (I02,90014) 01260204 + WRITE (I02,90004) 01270204 +C 01280204 +C 01290204 +C TEST 61 THROUGH TEST 73 VERIFY THE CONTENTS OF CHARACTER ARRAY 01300204 +C ELEMENTS AND CHARACTER VARIABLES WHICH WERE INITIALLY DEFINED IN 01310204 +C A DATA STATEMENT. 01320204 +C 01330204 +C TEST 61 THROUGH TEST 65 VERIFY THE CONTENTS OF SELECTED 01340204 +C ELEMENTS OF THE ARRAY CATN11 WHICH WAS INITIALLY SET EQUAL TO THE 01350204 +C 47 CHARACTERS OF THE FORTRAN SUBSET LANGUAGE CHARACTER SET. 01360204 +C 01370204 +C 01380204 +C **** FCVS PROGRAM 204 - TEST 061 **** 01390204 +C 01400204 +C 01410204 + IVTNUM = 61 01420204 + IF (ICZERO) 30610, 0610, 30610 01430204 + 0610 CONTINUE 01440204 + IVCOMP = 0 01450204 + IVCORR = 1 01460204 + IF (CATN11(1) .EQ. 'A') IVCOMP = 1 01470204 +40610 IF (IVCOMP - 1) 20610, 10610, 20610 01480204 +30610 IVDELE = IVDELE + 1 01490204 + WRITE (I02,80000) IVTNUM 01500204 + IF (ICZERO) 10610, 0621, 20610 01510204 +10610 IVPASS = IVPASS + 1 01520204 + WRITE (I02,80002) IVTNUM 01530204 + GO TO 0621 01540204 +20610 IVFAIL = IVFAIL + 1 01550204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01560204 + 0621 CONTINUE 01570204 +C 01580204 +C **** FCVS PROGRAM 204 - TEST 062 **** 01590204 +C 01600204 +C 01610204 + IVTNUM = 62 01620204 + IF (ICZERO) 30620, 0620, 30620 01630204 + 0620 CONTINUE 01640204 + IVCOMP = 0 01650204 + IVCORR = 1 01660204 + IF (CATN11(47) .EQ. '''') IVCOMP = 1 01670204 +40620 IF (IVCOMP - 1) 20620, 10620, 20620 01680204 +30620 IVDELE = IVDELE + 1 01690204 + WRITE (I02,80000) IVTNUM 01700204 + IF (ICZERO) 10620, 0631, 20620 01710204 +10620 IVPASS = IVPASS + 1 01720204 + WRITE (I02,80002) IVTNUM 01730204 + GO TO 0631 01740204 +20620 IVFAIL = IVFAIL + 1 01750204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01760204 + 0631 CONTINUE 01770204 +C 01780204 +C **** FCVS PROGRAM 204 - TEST 063 **** 01790204 +C 01800204 +C 01810204 + IVTNUM = 63 01820204 + IF (ICZERO) 30630, 0630, 30630 01830204 + 0630 CONTINUE 01840204 + IVCOMP = 0 01850204 + IVCORR = 1 01860204 + IF (CATN11(46) .EQ. '.') IVCOMP = 1 01870204 +40630 IF (IVCOMP - 1) 20630, 10630, 20630 01880204 +30630 IVDELE = IVDELE + 1 01890204 + WRITE (I02,80000) IVTNUM 01900204 + IF (ICZERO) 10630, 0641, 20630 01910204 +10630 IVPASS = IVPASS + 1 01920204 + WRITE (I02,80002) IVTNUM 01930204 + GO TO 0641 01940204 +20630 IVFAIL = IVFAIL + 1 01950204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01960204 + 0641 CONTINUE 01970204 +C 01980204 +C **** FCVS PROGRAM 204 - TEST 064 **** 01990204 +C 02000204 +C 02010204 + IVTNUM = 64 02020204 + IF (ICZERO) 30640, 0640, 30640 02030204 + 0640 CONTINUE 02040204 + IVCOMP = 0 02050204 + IVCORR = 1 02060204 + IF (CATN11(27) .EQ. '0') IVCOMP = 1 02070204 +40640 IF (IVCOMP - 1) 20640, 10640, 20640 02080204 +30640 IVDELE = IVDELE + 1 02090204 + WRITE (I02,80000) IVTNUM 02100204 + IF (ICZERO) 10640, 0651, 20640 02110204 +10640 IVPASS = IVPASS + 1 02120204 + WRITE (I02,80002) IVTNUM 02130204 + GO TO 0651 02140204 +20640 IVFAIL = IVFAIL + 1 02150204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02160204 + 0651 CONTINUE 02170204 +C 02180204 +C **** FCVS PROGRAM 204 - TEST 065 **** 02190204 +C 02200204 +C 02210204 + IVTNUM = 65 02220204 + IF (ICZERO) 30650, 0650, 30650 02230204 + 0650 CONTINUE 02240204 + IVCOMP = 0 02250204 + IVCORR = 1 02260204 + IF (CATN11(36) .EQ. '9') IVCOMP = 1 02270204 +40650 IF (IVCOMP - 1) 20650, 10650, 20650 02280204 +30650 IVDELE = IVDELE + 1 02290204 + WRITE (I02,80000) IVTNUM 02300204 + IF (ICZERO) 10650, 0661, 20650 02310204 +10650 IVPASS = IVPASS + 1 02320204 + WRITE (I02,80002) IVTNUM 02330204 + GO TO 0661 02340204 +20650 IVFAIL = IVFAIL + 1 02350204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02360204 + 0661 CONTINUE 02370204 +C 02380204 +C TEST 66 THROUGH TEST 68 VERIFY THE CONTENTS OF SELECTED 02390204 +C ELEMENTS OF THE ARRAY CATN12 WHICH WAS INITIALLY SET EQUAL TO THE 02400204 +C 26 LETTERS OF THE ALPHABET. 02410204 +C 02420204 +C 02430204 +C **** FCVS PROGRAM 204 - TEST 066 **** 02440204 +C 02450204 +C 02460204 + IVTNUM = 66 02470204 + IF (ICZERO) 30660, 0660, 30660 02480204 + 0660 CONTINUE 02490204 + IVCOMP = 0 02500204 + IVCORR = 1 02510204 + IF (CATN12(1) .EQ. 'A') IVCOMP = 1 02520204 +40660 IF (IVCOMP - 1) 20660, 10660, 20660 02530204 +30660 IVDELE = IVDELE + 1 02540204 + WRITE (I02,80000) IVTNUM 02550204 + IF (ICZERO) 10660, 0671, 20660 02560204 +10660 IVPASS = IVPASS + 1 02570204 + WRITE (I02,80002) IVTNUM 02580204 + GO TO 0671 02590204 +20660 IVFAIL = IVFAIL + 1 02600204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02610204 + 0671 CONTINUE 02620204 +C 02630204 +C **** FCVS PROGRAM 204 - TEST 067 **** 02640204 +C 02650204 +C 02660204 + IVTNUM = 67 02670204 + IF (ICZERO) 30670, 0670, 30670 02680204 + 0670 CONTINUE 02690204 + IVCOMP = 0 02700204 + IVCORR = 1 02710204 + IF (CATN12(26) .EQ. 'Z') IVCOMP = 1 02720204 +40670 IF (IVCOMP - 1) 20670, 10670, 20670 02730204 +30670 IVDELE = IVDELE + 1 02740204 + WRITE (I02,80000) IVTNUM 02750204 + IF (ICZERO) 10670, 0681, 20670 02760204 +10670 IVPASS = IVPASS + 1 02770204 + WRITE (I02,80002) IVTNUM 02780204 + GO TO 0681 02790204 +20670 IVFAIL = IVFAIL + 1 02800204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02810204 + 0681 CONTINUE 02820204 +C 02830204 +C **** FCVS PROGRAM 204 - TEST 068 **** 02840204 +C 02850204 +C 02860204 + IVTNUM = 68 02870204 + IF (ICZERO) 30680, 0680, 30680 02880204 + 0680 CONTINUE 02890204 + IVCOMP = 0 02900204 + IVCORR = 1 02910204 + IF (CATN12(20) .EQ. 'T') IVCOMP = 1 02920204 +40680 IF (IVCOMP - 1) 20680, 10680, 20680 02930204 +30680 IVDELE = IVDELE + 1 02940204 + WRITE (I02,80000) IVTNUM 02950204 + IF (ICZERO) 10680, 0691, 20680 02960204 +10680 IVPASS = IVPASS + 1 02970204 + WRITE (I02,80002) IVTNUM 02980204 + GO TO 0691 02990204 +20680 IVFAIL = IVFAIL + 1 03000204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03010204 + 0691 CONTINUE 03020204 +C 03030204 +C TEST 69 AND TEST 70 VERIFY THE CONTENTS OF SELECTED ELEMENTS 03040204 +C OF THE ARRAY CATN13 WHICH WAS INITIALLY SET EQUAL TO THE TEN 03050204 +C NUMERIC DIGITS. 03060204 +C 03070204 +C 03080204 +C **** FCVS PROGRAM 204 - TEST 069 **** 03090204 +C 03100204 +C 03110204 + IVTNUM = 69 03120204 + IF (ICZERO) 30690, 0690, 30690 03130204 + 0690 CONTINUE 03140204 + IVCOMP = 0 03150204 + IVCORR = 1 03160204 + IF (CATN13(1) .EQ. '0') IVCOMP = 1 03170204 +40690 IF (IVCOMP - 1) 20690, 10690, 20690 03180204 +30690 IVDELE = IVDELE + 1 03190204 + WRITE (I02,80000) IVTNUM 03200204 + IF (ICZERO) 10690, 0701, 20690 03210204 +10690 IVPASS = IVPASS + 1 03220204 + WRITE (I02,80002) IVTNUM 03230204 + GO TO 0701 03240204 +20690 IVFAIL = IVFAIL + 1 03250204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03260204 + 0701 CONTINUE 03270204 +C 03280204 +C **** FCVS PROGRAM 204 - TEST 070 **** 03290204 +C 03300204 +C 03310204 + IVTNUM = 70 03320204 + IF (ICZERO) 30700, 0700, 30700 03330204 + 0700 CONTINUE 03340204 + IVCOMP = 0 03350204 + IVCORR = 1 03360204 + IF (CATN13(10) .EQ. '9') IVCOMP = 1 03370204 +40700 IF (IVCOMP - 1) 20700, 10700, 20700 03380204 +30700 IVDELE = IVDELE + 1 03390204 + WRITE (I02,80000) IVTNUM 03400204 + IF (ICZERO) 10700, 0711, 20700 03410204 +10700 IVPASS = IVPASS + 1 03420204 + WRITE (I02,80002) IVTNUM 03430204 + GO TO 0711 03440204 +20700 IVFAIL = IVFAIL + 1 03450204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03460204 + 0711 CONTINUE 03470204 +C 03480204 +C **** FCVS PROGRAM 204 - TEST 071 **** 03490204 +C 03500204 +C TEST 71 VERIFIES THE CONTENTS OF THE VARIABLE CVTN10 WHICH 03510204 +C WAS INITIALLY SET EQUAL TO BLANK. 03520204 +C 03530204 + IVTNUM = 71 03540204 + IF (ICZERO) 30710, 0710, 30710 03550204 + 0710 CONTINUE 03560204 + IVCOMP = 0 03570204 + IVCORR = 1 03580204 + IF (CVTN10 .EQ. ' ') IVCOMP = 1 03590204 +40710 IF (IVCOMP - 1) 20710, 10710, 20710 03600204 +30710 IVDELE = IVDELE + 1 03610204 + WRITE (I02,80000) IVTNUM 03620204 + IF (ICZERO) 10710, 0721, 20710 03630204 +10710 IVPASS = IVPASS + 1 03640204 + WRITE (I02,80002) IVTNUM 03650204 + GO TO 0721 03660204 +20710 IVFAIL = IVFAIL + 1 03670204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03680204 + 0721 CONTINUE 03690204 +C 03700204 +C **** FCVS PROGRAM 204 - TEST 072 **** 03710204 +C 03720204 +C TEST 72 VERIFIES THE CONTENTS OF THE ARRAY CATN14 WHICH WAS 03730204 +C INITIALLY SET EQUAL TO ALL V'S. 03740204 +C 03750204 + IVTNUM = 72 03760204 + IF (ICZERO) 30720, 0720, 30720 03770204 + 0720 CONTINUE 03780204 + IVCOMP = 0 03790204 + IVCORR = 6 03800204 + DO 722, I= 1,6 03810204 + IF (CATN14(I) .EQ. 'V') IVCOMP = IVCOMP + 1 03820204 + 722 CONTINUE 03830204 +40720 IF (IVCOMP - 6) 20720, 10720, 20720 03840204 +30720 IVDELE = IVDELE + 1 03850204 + WRITE (I02,80000) IVTNUM 03860204 + IF (ICZERO) 10720, 0731, 20720 03870204 +10720 IVPASS = IVPASS + 1 03880204 + WRITE (I02,80002) IVTNUM 03890204 + GO TO 0731 03900204 +20720 IVFAIL = IVFAIL + 1 03910204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03920204 + 0731 CONTINUE 03930204 +C 03940204 +C **** FCVS PROGRAM 204 - TEST 073 **** 03950204 +C 03960204 +C TEST 73 VERIFIES THE CONTENTS OF THE ARRAY IAON11 WHICH WAS 03970204 +C INITIALLY SET EQUAL TO ALL 7'S. 03980204 +C 03990204 + IVTNUM = 73 04000204 + IF (ICZERO) 30730, 0730, 30730 04010204 + 0730 CONTINUE 04020204 + IVCOMP = 0 04030204 + IVCORR = 47 04040204 + DO 732, I= 1,47 04050204 + IF (IAON11(I) - 7) 732, 733, 732 04060204 + 733 IVCOMP = IVCOMP + 1 04070204 + 732 CONTINUE 04080204 +40730 IF (IVCOMP - 47) 20730, 10730, 20730 04090204 +30730 IVDELE = IVDELE + 1 04100204 + WRITE (I02,80000) IVTNUM 04110204 + IF (ICZERO) 10730, 0741, 20730 04120204 +10730 IVPASS = IVPASS + 1 04130204 + WRITE (I02,80002) IVTNUM 04140204 + GO TO 0741 04150204 +20730 IVFAIL = IVFAIL + 1 04160204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04170204 + 0741 CONTINUE 04180204 +C 04190204 +C TEST 74 THROUGH TEST 79 VERIFY THE COLLATING SEQUENCE 04200204 +C SPECIFICATIONS FOR THE FORTRAN SUBSET LANGUAGE. 04210204 +C 04220204 +C TEST 74 AND TEST 75 VERIFY THE COLLATING SEQUENCE FOR LETTERS. 04230204 +C 04240204 +C 04250204 +C **** FCVS PROGRAM 204 - TEST 074 **** 04260204 +C 04270204 +C 04280204 + IVTNUM = 74 04290204 + IF (ICZERO) 30740, 0740, 30740 04300204 + 0740 CONTINUE 04310204 + IVCOMP = 1 04320204 + IVCORR = 210 04330204 + IF ('A' .LT. 'B') IVCOMP = IVCOMP * 2 04340204 + IF ('B' .LT. 'M') IVCOMP = IVCOMP * 3 04350204 + IF ('M' .LT. 'V') IVCOMP = IVCOMP * 5 04360204 + IF ('V' .LT. 'Z') IVCOMP = IVCOMP * 7 04370204 +40740 IF (IVCOMP - 210) 20740, 10740, 20740 04380204 +30740 IVDELE = IVDELE + 1 04390204 + WRITE (I02,80000) IVTNUM 04400204 + IF (ICZERO) 10740, 0751, 20740 04410204 +10740 IVPASS = IVPASS + 1 04420204 + WRITE (I02,80002) IVTNUM 04430204 + GO TO 0751 04440204 +20740 IVFAIL = IVFAIL + 1 04450204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04460204 + 0751 CONTINUE 04470204 +C 04480204 +C **** FCVS PROGRAM 204 - TEST 075 **** 04490204 +C 04500204 +C 04510204 + IVTNUM = 75 04520204 + IF (ICZERO) 30750, 0750, 30750 04530204 + 0750 CONTINUE 04540204 + IVCOMP = 0 04550204 + IVCORR = 25 04560204 + DO 752, I=1,25 04570204 + J= I + 1 04580204 + IF (CATN12(J) .GT. CATN12(I)) IVCOMP = IVCOMP + 1 04590204 + 752 CONTINUE 04600204 +40750 IF (IVCOMP - 25) 20750, 10750, 20750 04610204 +30750 IVDELE = IVDELE + 1 04620204 + WRITE (I02,80000) IVTNUM 04630204 + IF (ICZERO) 10750, 0761, 20750 04640204 +10750 IVPASS = IVPASS + 1 04650204 + WRITE (I02,80002) IVTNUM 04660204 + GO TO 0761 04670204 +20750 IVFAIL = IVFAIL + 1 04680204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04690204 + 0761 CONTINUE 04700204 +C 04710204 +C TEST 76 AND TEST 77 VERIFY THE COLLATING SEQUENCE FOR DIGITS. 04720204 +C 04730204 +C 04740204 +C **** FCVS PROGRAM 204 - TEST 076 **** 04750204 +C 04760204 +C 04770204 + IVTNUM = 76 04780204 + IF (ICZERO) 30760, 0760, 30760 04790204 + 0760 CONTINUE 04800204 + IVCOMP = 1 04810204 + IVCORR = 30 04820204 + IF ('0' .LT. '1') IVCOMP = IVCOMP * 2 04830204 + IF ('1' .LT. '5') IVCOMP = IVCOMP * 3 04840204 + IF ('5' .LT. '9') IVCOMP = IVCOMP * 5 04850204 +40760 IF (IVCOMP - 30) 20760, 10760, 20760 04860204 +30760 IVDELE = IVDELE + 1 04870204 + WRITE (I02,80000) IVTNUM 04880204 + IF (ICZERO) 10760, 0771, 20760 04890204 +10760 IVPASS = IVPASS + 1 04900204 + WRITE (I02,80002) IVTNUM 04910204 + GO TO 0771 04920204 +20760 IVFAIL = IVFAIL + 1 04930204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04940204 + 0771 CONTINUE 04950204 +C 04960204 +C **** FCVS PROGRAM 204 - TEST 077 **** 04970204 +C 04980204 +C 04990204 + IVTNUM = 77 05000204 + IF (ICZERO) 30770, 0770, 30770 05010204 + 0770 CONTINUE 05020204 + IVCOMP = 0 05030204 + IVCORR = 9 05040204 + DO 772, I=1,9 05050204 + J = I + 1 05060204 + IF (CATN13(I) .LT. CATN13(J)) IVCOMP = IVCOMP + 1 05070204 + 772 CONTINUE 05080204 +40770 IF (IVCOMP - 9) 20770, 10770, 20770 05090204 +30770 IVDELE = IVDELE + 1 05100204 + WRITE (I02,80000) IVTNUM 05110204 + IF (ICZERO) 10770, 0781, 20770 05120204 +10770 IVPASS = IVPASS + 1 05130204 + WRITE (I02,80002) IVTNUM 05140204 + GO TO 0781 05150204 +20770 IVFAIL = IVFAIL + 1 05160204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05170204 + 0781 CONTINUE 05180204 +C 05190204 +C **** FCVS PROGRAM 204 - TEST 078 **** 05200204 +C 05210204 +C TEST 78 VERIFIES THAT BLANK IS LESS THAN THE LETTER A AND BLANK05220204 +C IS LESS THAN THE DIGIT ZERO. 05230204 +C 05240204 + IVTNUM = 78 05250204 + IF (ICZERO) 30780, 0780, 30780 05260204 + 0780 CONTINUE 05270204 + IVCOMP = 1 05280204 + IVCORR = 6 05290204 + IF (' ' .LT. 'A') IVCOMP = IVCOMP * 2 05300204 + IF (' ' .LT. '0') IVCOMP = IVCOMP * 3 05310204 +40780 IF (IVCOMP - 6) 20780, 10780, 20780 05320204 +30780 IVDELE = IVDELE + 1 05330204 + WRITE (I02,80000) IVTNUM 05340204 + IF (ICZERO) 10780, 0791, 20780 05350204 +10780 IVPASS = IVPASS + 1 05360204 + WRITE (I02,80002) IVTNUM 05370204 + GO TO 0791 05380204 +20780 IVFAIL = IVFAIL + 1 05390204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05400204 + 0791 CONTINUE 05410204 +C 05420204 +C **** FCVS PROGRAM 204 - TEST 079 **** 05430204 +C 05440204 +C TEST 79 VERIFIES THAT THE DIGITS AND LETTERS ARE NOT INTERMIXED05450204 +C IN THE COLLATING SEQUENCE. EITHER ALL OF THE DIGITS MUST PRECEDE 05460204 +C A OR ALL OF THE DIGITS MUST FOLLOW Z. 05470204 +C 05480204 + IVTNUM = 79 05490204 + IF (ICZERO) 30790, 0790, 30790 05500204 + 0790 CONTINUE 05510204 + IVCOMP = 0 05520204 + IVCORR = 10 05530204 + IF ('0' .NE. 'A') GO TO 792 05540204 + IVCOMP = 111 05550204 + GO TO 40790 05560204 + 792 IF ('0' .GT. 'A') GO TO 793 05570204 +C 05580204 +C ZERO IS LESS THAN LETTER A, SO ALL DIGITS MUST BE LESS THAN A05590204 +C 05600204 + DO 794, I= 1,10 05610204 + IF (CATN13(I) .LT. 'A') IVCOMP = IVCOMP + 1 05620204 + 794 CONTINUE 05630204 + GO TO 40790 05640204 +C 05650204 +C ZERO IS GREATER THAN LETTER A, SO ALL DIGITS MUST BE GREATER 05660204 +C THAN LETTER Z. 05670204 +C 05680204 + 793 DO 795 I=1,10 05690204 + IF (CATN13(I) .GT. 'Z') IVCOMP = IVCOMP + 1 05700204 + 795 CONTINUE 05710204 +40790 IF (IVCOMP - 10) 20790,10790, 20790 05720204 +30790 IVDELE = IVDELE + 1 05730204 + WRITE (I02,80000) IVTNUM 05740204 + IF (ICZERO) 10790, 0801, 20790 05750204 +10790 IVPASS = IVPASS + 1 05760204 + WRITE (I02,80002) IVTNUM 05770204 + GO TO 0801 05780204 +20790 IVFAIL = IVFAIL + 1 05790204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05800204 + 0801 CONTINUE 05810204 +C 05820204 +C TEST 80 THROUGH TEST 85 PERFORM THE SAME COMPARISONS AS TEST 7405830204 +C THROUGH TEST 79 EXCEPT THAT THE ICHAR INTRINSIC FUNCTION IS USED 05840204 +C IN PLACE OF THE INDIVIDUAL CHARACTERS. 05850204 +C 05860204 +C TEST 80 AND TEST 81 VERIFY THE COLLATING SEQUENCE FOR LETTERS 05870204 +C USING THE ICHAR INTRINSIC FUNCTION. 05880204 +C 05890204 +C 05900204 +C **** FCVS PROGRAM 204 - TEST 080 **** 05910204 +C 05920204 +C 05930204 + IVTNUM = 80 05940204 + IF (ICZERO) 30800, 0800, 30800 05950204 + 0800 CONTINUE 05960204 + IVCOMP = 1 05970204 + IVCORR = 210 05980204 + IVON01 = ICHAR('A') 05990204 + IVON02 = ICHAR('B') 06000204 + IVON03 = ICHAR('M') 06010204 + IVON04 = ICHAR('V') 06020204 + IVON05 = ICHAR('Z') 06030204 + IF (IVON01 .LT. IVON02) IVCOMP = IVCOMP * 2 06040204 + IF (IVON02 .LT. IVON03) IVCOMP = IVCOMP * 3 06050204 + IF (IVON03 .LT. IVON04) IVCOMP = IVCOMP * 5 06060204 + IF (IVON04 .LT. IVON05) IVCOMP = IVCOMP * 7 06070204 +40800 IF (IVCOMP - 210) 20800, 10800, 20800 06080204 +30800 IVDELE = IVDELE + 1 06090204 + WRITE (I02,80000) IVTNUM 06100204 + IF (ICZERO) 10800, 0811, 20800 06110204 +10800 IVPASS = IVPASS + 1 06120204 + WRITE (I02,80002) IVTNUM 06130204 + GO TO 0811 06140204 +20800 IVFAIL = IVFAIL + 1 06150204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06160204 + 0811 CONTINUE 06170204 +C 06180204 +C **** FCVS PROGRAM 204 - TEST 081 **** 06190204 +C 06200204 +C 06210204 + IVTNUM = 81 06220204 + IF (ICZERO) 30810, 0810, 30810 06230204 + 0810 CONTINUE 06240204 + IVON01 = 0 06250204 + IVON02 = 0 06260204 + IVCOMP = 0 06270204 + IVCORR = 25 06280204 + DO 812, I=1,25 06290204 + J= I + 1 06300204 + IVON01 = ICHAR(CATN12(J)) 06310204 + IVON02 = ICHAR(CATN12(I)) 06320204 + IF (IVON01 .GT. IVON02) IVCOMP = IVCOMP + 1 06330204 + 812 CONTINUE 06340204 +40810 IF (IVCOMP - 25) 20810, 10810, 20810 06350204 +30810 IVDELE = IVDELE + 1 06360204 + WRITE (I02,80000) IVTNUM 06370204 + IF (ICZERO) 10810, 0821, 20810 06380204 +10810 IVPASS = IVPASS + 1 06390204 + WRITE (I02,80002) IVTNUM 06400204 + GO TO 0821 06410204 +20810 IVFAIL = IVFAIL + 1 06420204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06430204 + 0821 CONTINUE 06440204 +C 06450204 +C TEST 82 AND TEST 83 VERIFY THE COLLATING SEQUENCE FOR DIGITS 06460204 +C USING THE ICHAR INTRINSIC FUNCTION. 06470204 +C 06480204 +C 06490204 +C **** FCVS PROGRAM 204 - TEST 082 **** 06500204 +C 06510204 +C 06520204 + IVTNUM = 82 06530204 + IF (ICZERO) 30820, 0820, 30820 06540204 + 0820 CONTINUE 06550204 + IVCOMP = 1 06560204 + IVCORR = 30 06570204 + IF (ICHAR('0') .LT. ICHAR('1')) IVCOMP = IVCOMP *2 06580204 + IF (ICHAR('1') .LT. ICHAR('5')) IVCOMP = IVCOMP * 3 06590204 + IF (ICHAR('5') .LT. ICHAR('9')) IVCOMP = IVCOMP * 5 06600204 +40820 IF (IVCOMP - 30) 20820, 10820, 20820 06610204 +30820 IVDELE = IVDELE + 1 06620204 + WRITE (I02,80000) IVTNUM 06630204 + IF (ICZERO) 10820, 0831, 20820 06640204 +10820 IVPASS = IVPASS + 1 06650204 + WRITE (I02,80002) IVTNUM 06660204 + GO TO 0831 06670204 +20820 IVFAIL = IVFAIL + 1 06680204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06690204 + 0831 CONTINUE 06700204 +C 06710204 +C **** FCVS PROGRAM 204 - TEST 083 **** 06720204 +C 06730204 +C 06740204 + IVTNUM = 83 06750204 + IF (ICZERO) 30830, 0830, 30830 06760204 + 0830 CONTINUE 06770204 + IVON01 = 0 06780204 + IVON02 = 0 06790204 + IVCOMP = 0 06800204 + IVCORR = 9 06810204 + DO 832, I=1,9 06820204 + J = I + 1 06830204 + IVON01 = ICHAR(CATN13(J)) 06840204 + IVON02 = ICHAR(CATN13(I)) 06850204 + IF (IVON02 .LT. IVON01) IVCOMP = IVCOMP + 1 06860204 + 832 CONTINUE 06870204 +40830 IF (IVCOMP -9) 20830, 10830, 20830 06880204 +30830 IVDELE = IVDELE + 1 06890204 + WRITE (I02,80000) IVTNUM 06900204 + IF (ICZERO) 10830, 0841, 20830 06910204 +10830 IVPASS = IVPASS + 1 06920204 + WRITE (I02,80002) IVTNUM 06930204 + GO TO 0841 06940204 +20830 IVFAIL = IVFAIL + 1 06950204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06960204 + 0841 CONTINUE 06970204 +C 06980204 +C **** FCVS PROGRAM 204 - TEST 084 **** 06990204 +C 07000204 +C TEST 84 VERIFIES THAT BLANK IS LESS THAN THE LETTER A AND BLANK07010204 +C IS LESS THAN THE DIGIT ZERO. THE INTRINSIC FUNCTION ICHAR IS 07020204 +C USED IN THIS TEST. 07030204 +C 07040204 + IVTNUM = 84 07050204 + IF (ICZERO) 30840, 0840, 30840 07060204 + 0840 CONTINUE 07070204 + IVCOMP = 1 07080204 + IVCORR = 6 07090204 + IF (ICHAR(' ') .LT. ICHAR('A')) IVCOMP = IVCOMP * 2 07100204 + IF (ICHAR(' ') .LT. ICHAR('0')) IVCOMP = IVCOMP * 3 07110204 +40840 IF (IVCOMP - 6) 20840, 10840, 20840 07120204 +30840 IVDELE = IVDELE + 1 07130204 + WRITE (I02,80000) IVTNUM 07140204 + IF (ICZERO) 10840, 0851, 20840 07150204 +10840 IVPASS = IVPASS + 1 07160204 + WRITE (I02,80002) IVTNUM 07170204 + GO TO 0851 07180204 +20840 IVFAIL = IVFAIL + 1 07190204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07200204 + 0851 CONTINUE 07210204 +C 07220204 +C **** FCVS PROGRAM 204 - TEST 085 **** 07230204 +C 07240204 +C TEST 85 VERIFIES THAT THE DIGITS AND LETTERS ARE NOT INTERMIXED07250204 +C IN THE COLLATING SEQUENCE. THE ICHAR INTRINSIC FUNCTION IS USED 07260204 +C TO VERIFY THAT EITHER ALL OF THE DIGITS PRECEDE A OR ALL OF THE 07270204 +C DIGITS FOLLOW Z. 07280204 +C 07290204 + IVTNUM = 85 07300204 + IF (ICZERO) 30850, 0850, 30850 07310204 + 0850 CONTINUE 07320204 + IVCOMP = 0 07330204 + IVCORR = 10 07340204 + IF (ICHAR('0') .NE. ICHAR('A')) GO TO 852 07350204 + IVCOMP = 111 07360204 + GO TO 40850 07370204 + 852 IF (ICHAR('0') .GT. ICHAR('A')) GO TO 853 07380204 +C 07390204 +C ZERO IS LESS THAN LETTER A ACCORDING TO ICHAR INTRINSIC 07400204 +C FUNCTION VALUE. THUS, THE ICHAR VALUE FOR ALL DIGITS MUST BE 07410204 +C LESS THAN ICHAR VALUE FOR LETTER A. 07420204 +C 07430204 + DO 854, I=1,10 07440204 + IF (ICHAR(CATN13(I)) .LT. ICHAR('A')) IVCOMP = IVCOMP + 1 07450204 + 854 CONTINUE 07460204 + GO TO 40850 07470204 +C 07480204 +C ZERO IS GREATER THAN LETTER A ACCORDING TO ICHAR INTRINSIC 07490204 +C FUNCTION VALUE. THUS, THE ICHAR VALUE FOR ALL DIGITS MUST BE 07500204 +C GREATER THAN ICHAR VALUE FOR LETTER Z. 07510204 +C 07520204 + 853 DO 855, I=1,10 07530204 + IF (ICHAR(CATN13(I)).GT. ICHAR('Z')) IVCOMP = IVCOMP + 1 07540204 + 855 CONTINUE 07550204 +40850 IF (IVCOMP - 10) 20850, 10850, 20850 07560204 +30850 IVDELE = IVDELE + 1 07570204 + WRITE (I02,80000) IVTNUM 07580204 + IF (ICZERO) 10850, 0861, 20850 07590204 +10850 IVPASS = IVPASS + 1 07600204 + WRITE (I02,80002) IVTNUM 07610204 + GO TO 0861 07620204 +20850 IVFAIL = IVFAIL + 1 07630204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07640204 + 0861 CONTINUE 07650204 +C 07660204 +C **** FCVS PROGRAM 204 - TEST 086 **** 07670204 +C 07680204 +C THE ARRAY IAON11 IS SET EQUAL TO THE ICHAR INTRINSIC FUNCTION07690204 +C VALUE OF THE CORRESPONDING ELEMENT IN THE CATN11 ARRAY. THE 07700204 +C IAON11 ARRAY IS THEN SORTED IN ASCENDING ORDER, AND ENTRIES IN 07710204 +C THE CATN11 ARRAY ARE ARRANGED ACCORDING TO THE ASCENDING SORT 07720204 +C ORDER IN IAON11. THE RESULTING ORDER OF THE CATN11 ARRAY GIVES 07730204 +C THE PROCESSOR'S COLLATING SEQUENCE FOR THE FORTRAN SUBSET LANGUAGE07740204 +C CHARACTER SET. THE CATN11 ARRAY IS PRINTED AND MUST BE VISUALLY 07750204 +C CHECKED TO DETERMINE IF THE COLLATING SEQUENCE RULES ARE FOLLOWED 07760204 +C BY THE COMPILER. 07770204 +C 07780204 + IVTNUM = 86 07790204 + IF (ICZERO) 30860, 0860, 30860 07800204 + 0860 CONTINUE 07810204 + IVCOMP = 0 07820204 +C 07830204 +C INITIALIZE IAON11 TO ZERO. 07840204 + DO 862 I=1,47 07850204 + IAON11(I) = 0 07860204 + 862 CONTINUE 07870204 +C 07880204 +C PLACE ICHAR INTRINSIC VALUE IN IAON11. 07890204 +C 07900204 + DO 863, I= 1,47 07910204 + IAON11(I) = ICHAR(CATN11(I)) 07920204 + 863 CONTINUE 07930204 +C 07940204 +C SORT FORTRAN CHARACTERS ACCORDING TO THEIR POSITION IN THE 07950204 +C COLLATING SEQUENCE. 07960204 +C 07970204 + DO 864, I=1,46 07980204 + J=I 07990204 + N = I + 1 08000204 + DO 865 K = N,47 08010204 + IF (IAON11(J) .LT. IAON11(K)) GO TO 865 08020204 + J=K 08030204 + 865 CONTINUE 08040204 + IVON01 = IAON11(J) 08050204 + IAON11(J)= IAON11(I) 08060204 + IAON11(I)= IVON01 08070204 + CVTN01 = CATN11(J) 08080204 + CATN11(J) = CATN11(I) 08090204 + CATN11(I) = CVTN01 08100204 + 864 CONTINUE 08110204 + WRITE (I02, 866) CATN11 08120204 + WRITE (I02, 867) IAON11 08130204 + 866 FORMAT (3X,'FORTRAN CHARACTER SET IN ASCENDING ORDER',3X,/ 08140204 + 1 3X, 'VISUAL VERIFICATION REQUIRED' //,3X, 12(A1,3X)/ 08150204 + 2 3X, 12(A1,3X)/ 3X, 12(A1,3X)/ 3X, 11(A1,3X)) 08160204 + 867 FORMAT ( 3X/3X, 'ICHAR INTRINSIC FUNCTION VALUES FOR FORTRAN ', 08170204 + 1 'CHARACTER SET'// 3X, 12I4/ 3X, 12I4/ 3X, 12I4/ 08180204 + 2 3X,11I4//) 08190204 + IVCOMP = 1 08200204 + IVCORR = 1 08210204 +40860 IF (IVCOMP - 1) 20860, 10860, 20860 08220204 +30860 IVDELE = IVDELE + 1 08230204 + WRITE (I02,80000) IVTNUM 08240204 + IF (ICZERO) 10860, 0871, 20860 08250204 +10860 IVPASS = IVPASS + 1 08260204 + WRITE (I02,80002) IVTNUM 08270204 + GO TO 0871 08280204 +20860 IVFAIL = IVFAIL + 1 08290204 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08300204 + 0871 CONTINUE 08310204 +C 08320204 +C 08330204 +C WRITE OUT TEST SUMMARY 08340204 +C 08350204 + WRITE (I02,90004) 08360204 + WRITE (I02,90014) 08370204 + WRITE (I02,90004) 08380204 + WRITE (I02,90000) 08390204 + WRITE (I02,90004) 08400204 + WRITE (I02,90020) IVFAIL 08410204 + WRITE (I02,90022) IVPASS 08420204 + WRITE (I02,90024) IVDELE 08430204 + STOP 08440204 +90001 FORMAT (" ",24X,"FM204") 08450204 +90000 FORMAT (" ",20X,"END OF PROGRAM FM204" ) 08460204 +C 08470204 +C FORMATS FOR TEST DETAIL LINES 08480204 +C 08490204 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 08500204 +80002 FORMAT (" ",4X,I5,7X,"PASS") 08510204 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08520204 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08530204 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 08540204 +C 08550204 +C FORMAT STATEMENTS FOR PAGE HEADERS 08560204 +C 08570204 +90002 FORMAT ("1") 08580204 +90004 FORMAT (" ") 08590204 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08600204 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 08610204 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08620204 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 08630204 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 08640204 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08650204 +C 08660204 +C FORMAT STATEMENTS FOR RUN SUMMARY 08670204 +C 08680204 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 08690204 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 08700204 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 08710204 + END 08720204 diff --git a/Fortran/UnitTests/fcvs21_f95/FM204.reference_output b/Fortran/UnitTests/fcvs21_f95/FM204.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM204.reference_output @@ -0,0 +1,63 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM204 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 61 PASS + 62 PASS + 63 PASS + 64 PASS + 65 PASS + 66 PASS + 67 PASS + 68 PASS + 69 PASS + 70 PASS + 71 PASS + 72 PASS + 73 PASS + 74 PASS + 75 PASS + 76 PASS + 77 PASS + 78 PASS + 79 PASS + 80 PASS + 81 PASS + 82 PASS + 83 PASS + 84 PASS + 85 PASS + FORTRAN CHARACTER SET IN ASCENDING ORDER + VISUAL VERIFICATION REQUIRED + + ' ( ) * + , - . / 0 1 + 2 3 4 5 6 7 8 9 = A B C + D E F G H I J K L M N O + P Q R S T U V W X Y Z + + ICHAR INTRINSIC FUNCTION VALUES FOR FORTRAN CHARACTER SET + + 32 39 40 41 42 43 44 45 46 47 48 49 + 50 51 52 53 54 55 56 57 61 65 66 67 + 68 69 70 71 72 73 74 75 76 77 78 79 + 80 81 82 83 84 85 86 87 88 89 90 + + + 86 PASS + + ---------------------------------------------- + + END OF PROGRAM FM204 + + 0 TESTS FAILED + 26 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM205.f b/Fortran/UnitTests/fcvs21_f95/FM205.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM205.f @@ -0,0 +1,937 @@ + PROGRAM FM205 00010205 +C 00020205 +C 00030205 +C THE ROUTINE FM205 TESTS CHARACTER CONSTANTS, CHARACTER 00040205 +C VARIABLES, AND CHARACTER ARRAY ELEMENTS WITH A MAXIMUM LENGTH 00050205 +C OF 57 CHARACTERS. CHARACTER ASSIGNMENT STATEMENTS AND CHARACTER 00060205 +C RELATIONAL EXPRESSIONS OF THE FOLLOWING STATEMENT FORMS ARE 00070205 +C TESTED IN THIS ROUTINE. 00080205 +C 00090205 +C (1) CHARACTER ASSIGNMENT STATEMENTS 00100205 +C 00110205 +C CHARACTER VARIABLE = CHARACTER CONSTANT, 00120205 +C CHARACTER VARIABLE = CHARACTER VARIABLE, 00130205 +C CHARACTER ARRAY ELEMENT = CHARACTER CONSTANT, 00140205 +C CHARACTER ARRAY ELEMENT = CHARACTER VARIABLE, 00150205 +C CHARACTER ARRAY ELEMENT = CHARACTER ARRAY ELEMENT, 00160205 +C CHARACTER VARIABLE = CHARACTER ARRAY ELEMENT. 00170205 +C 00180205 +C THE CHARACTER ENTITIES IN AN ASSIGNMENT STATEMENT ARE THE 00190205 +C SAME LENGTH. 00200205 +C 00210205 +C (2) CHARACTER RELATIONAL EXPRESSIONS 00220205 +C 00230205 +C CHARACTER VARIABLE RELOP CHARACTER CONSTANT, 00240205 +C CHARACTER VARIABLE RELOP CHARACTER VARIABLE, 00250205 +C CHARACTER ARRAY ELEMENT RELOP CHARACTER CONSTANT, 00260205 +C CHARACTER ARRAY ELEMENT RELOP CHARACTER VARIABLE, 00270205 +C CHARACTER ARRAY ELEMENT RELOP CHAR. ARRAY ELEMENT. 00280205 +C 00290205 +C THE CHARACTER ENTITIES IN A RELATIONAL EXPRESSION ARE THE 00300205 +C SAME LENGTH. 00310205 +C 00320205 +C REFERENCES 00330205 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00340205 +C X3.9-1978. 00350205 +C 00360205 +C SECTION 4.8, CHARACTER TYPE 00370205 +C SECTION 4.8.1, CHARACTER CONSTANT 00380205 +C SECTION 6.2, CHARACTER EXPRESSIONS 00390205 +C SECTION 6.3.4, CHARACTER RELATIONAL EXPRESSION 00400205 +C SECTION 6.3.5, INTERPRETATION OF CHARACTER RELATIONAL 00410205 +C EXPRESSIONS 00420205 +C SECTION 8.4,2, CHARACTER TYPE-STATEMENT 00430205 +C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT 00440205 +C 00450205 +C 00460205 +C ******************************************************************00470205 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00480205 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00490205 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00500205 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00510205 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00520205 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00530205 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00540205 +C THE RESULT OF EXECUTING THESE TESTS. 00550205 +C 00560205 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00570205 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00580205 +C 00590205 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00600205 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00610205 +C SOFTWARE STANDARDS VALIDATION GROUP 00620205 +C BUILDING 225 RM A266 00630205 +C GAITHERSBURG, MD 20899 00640205 +C ******************************************************************00650205 +C 00660205 +C 00670205 + IMPLICIT LOGICAL (L) 00680205 + IMPLICIT CHARACTER*14 (C) 00690205 +C 00700205 + CHARACTER CVTN01*3,CVTN02*7,CVTN03*12 00710205 + CHARACTER CVTN04*25,CVTN05*41,CVTN06*57 00720205 + CHARACTER CVTN07*3,CVTN08*7,CVTN09*12 00730205 + CHARACTER CVTN10*25,CVTN11*41,CVTN12*57 00740205 + CHARACTER CATN11(6)*3,CATN12(7)*7,CATN13(3)*12 00750205 + CHARACTER CATN14(2)*25,CATN15(10)*41,CATN16(4)*57 00760205 +C 00770205 +C 00780205 +C 00790205 +C INITIALIZATION SECTION. 00800205 +C 00810205 +C INITIALIZE CONSTANTS 00820205 +C ******************** 00830205 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00840205 + I01 = 5 00850205 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00860205 + I02 = 6 00870205 +C SYSTEM ENVIRONMENT SECTION 00880205 +C 00890205 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00900205 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00910205 +C (UNIT NUMBER FOR CARD READER). 00920205 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00930205 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00940205 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00950205 +C 00960205 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00970205 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00980205 +C (UNIT NUMBER FOR PRINTER). 00990205 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01000205 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01010205 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01020205 +C 01030205 + IVPASS = 0 01040205 + IVFAIL = 0 01050205 + IVDELE = 0 01060205 + ICZERO = 0 01070205 +C 01080205 +C WRITE OUT PAGE HEADERS 01090205 +C 01100205 + WRITE (I02,90002) 01110205 + WRITE (I02,90006) 01120205 + WRITE (I02,90008) 01130205 + WRITE (I02,90004) 01140205 + WRITE (I02,90010) 01150205 + WRITE (I02,90004) 01160205 + WRITE (I02,90016) 01170205 + WRITE (I02,90001) 01180205 + WRITE (I02,90004) 01190205 + WRITE (I02,90012) 01200205 + WRITE (I02,90014) 01210205 + WRITE (I02,90004) 01220205 +C 01230205 +C 01240205 +C TEST 87 THROUGH TEST 92 VERIFY THE CHARACTER ASSIGNMENT 01250205 +C STATEMENT 01260205 +C 01270205 +C CHARACTER VARIABLE = CHARACTER CONSTANT 01280205 +C 01290205 +C IS CORRECT. THE VARIABLE AND CONSTANT ARE THE SAME LENGTH, AND 01300205 +C THE LENGTHS 3, 7, 12, 25, 41, AND 57 ARE USED IN THESE TESTS. 01310205 +C 01320205 +C 01330205 +C **** FCVS PROGRAM 205 - TEST 087 **** 01340205 +C 01350205 +C 01360205 + IVTNUM = 87 01370205 + IF (ICZERO) 30870, 0870, 30870 01380205 + 0870 CONTINUE 01390205 + IVCOMP = 0 01400205 + CVTN01 = 'ABC' 01410205 + IF (CVTN01 .EQ. 'ABC') IVCOMP = 1 01420205 + IVCORR = 1 01430205 +40870 IF (IVCOMP - 1) 20870, 10870, 20870 01440205 +30870 IVDELE = IVDELE + 1 01450205 + WRITE (I02,80000) IVTNUM 01460205 + IF (ICZERO) 10870, 0881, 20870 01470205 +10870 IVPASS = IVPASS + 1 01480205 + WRITE (I02,80002) IVTNUM 01490205 + GO TO 0881 01500205 +20870 IVFAIL = IVFAIL + 1 01510205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01520205 + 0881 CONTINUE 01530205 +C 01540205 +C **** FCVS PROGRAM 205 - TEST 088 **** 01550205 +C 01560205 +C 01570205 + IVTNUM = 88 01580205 + IF (ICZERO) 30880, 0880, 30880 01590205 + 0880 CONTINUE 01600205 + IVCOMP = 0 01610205 + IVCORR = 1 01620205 + CVTN02 = 'ABCDEFG' 01630205 + IF (CVTN02 .EQ. 'ABCDEFG') IVCOMP = 1 01640205 +40880 IF (IVCOMP - 1) 20880, 10880, 20880 01650205 +30880 IVDELE = IVDELE + 1 01660205 + WRITE (I02,80000) IVTNUM 01670205 + IF (ICZERO) 10880, 0891, 20880 01680205 +10880 IVPASS = IVPASS + 1 01690205 + WRITE (I02,80002) IVTNUM 01700205 + GO TO 0891 01710205 +20880 IVFAIL = IVFAIL + 1 01720205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01730205 + 0891 CONTINUE 01740205 +C 01750205 +C **** FCVS PROGRAM 205 - TEST 089 **** 01760205 +C 01770205 +C 01780205 + IVTNUM = 89 01790205 + IF (ICZERO) 30890, 0890, 30890 01800205 + 0890 CONTINUE 01810205 + IVCOMP = 0 01820205 + IVCORR = 1 01830205 + CVTN03 = 'ABCDEFGHIJKL' 01840205 + IF (CVTN03 .EQ. 'ABCDEFGHIJKL') IVCOMP = 1 01850205 +40890 IF (IVCOMP - 1) 20890, 10890, 20890 01860205 +30890 IVDELE = IVDELE + 1 01870205 + WRITE (I02,80000) IVTNUM 01880205 + IF (ICZERO) 10890, 0901, 20890 01890205 +10890 IVPASS = IVPASS + 1 01900205 + WRITE (I02,80002) IVTNUM 01910205 + GO TO 0901 01920205 +20890 IVFAIL = IVFAIL + 1 01930205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01940205 + 0901 CONTINUE 01950205 +C 01960205 +C **** FCVS PROGRAM 205 - TEST 090 **** 01970205 +C 01980205 +C 01990205 + IVTNUM = 90 02000205 + IF (ICZERO) 30900, 0900, 30900 02010205 + 0900 CONTINUE 02020205 + IVCOMP = 0 02030205 + IVCORR = 1 02040205 + CVTN04 = 'ABCDEFGHIJKLMNOPQRSTUVWXY' 02050205 + IF (CVTN04 .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXY') IVCOMP = 1 02060205 +40900 IF (IVCOMP - 1) 20900, 10900, 20900 02070205 +30900 IVDELE = IVDELE + 1 02080205 + WRITE (I02,80000) IVTNUM 02090205 + IF (ICZERO) 10900, 0911, 20900 02100205 +10900 IVPASS = IVPASS + 1 02110205 + WRITE (I02,80002) IVTNUM 02120205 + GO TO 0911 02130205 +20900 IVFAIL = IVFAIL + 1 02140205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02150205 + 0911 CONTINUE 02160205 +C 02170205 +C **** FCVS PROGRAM 205 - TEST 091 **** 02180205 +C 02190205 +C 02200205 + IVTNUM = 91 02210205 + IF (ICZERO) 30910, 0910, 30910 02220205 + 0910 CONTINUE 02230205 + IVCOMP = 0 02240205 + IVCORR = 1 02250205 + CVTN05 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO' 02260205 + IF (CVTN05 .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO') 02270205 + 1 IVCOMP = 1 02280205 +40910 IF (IVCOMP - 1) 20910, 10910, 20910 02290205 +30910 IVDELE = IVDELE + 1 02300205 + WRITE (I02,80000) IVTNUM 02310205 + IF (ICZERO) 10910, 0921, 20910 02320205 +10910 IVPASS = IVPASS + 1 02330205 + WRITE (I02,80002) IVTNUM 02340205 + GO TO 0921 02350205 +20910 IVFAIL = IVFAIL + 1 02360205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02370205 + 0921 CONTINUE 02380205 +C 02390205 +C **** FCVS PROGRAM 205 - TEST 092 **** 02400205 +C 02410205 +C 02420205 + IVTNUM = 92 02430205 + IF (ICZERO) 30920, 0920, 30920 02440205 + 0920 CONTINUE 02450205 + IVCOMP = 0 02460205 + IVCORR = 1 02470205 + CVTN06 = 02480205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE' 02490205 + IF (CVTN06 .EQ. 02500205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE') 02510205 + 2 IVCOMP = 1 02520205 +40920 IF (IVCOMP - 1) 20920, 10920, 20920 02530205 +30920 IVDELE = IVDELE + 1 02540205 + WRITE (I02,80000) IVTNUM 02550205 + IF (ICZERO) 10920, 0931, 20920 02560205 +10920 IVPASS = IVPASS + 1 02570205 + WRITE (I02,80002) IVTNUM 02580205 + GO TO 0931 02590205 +20920 IVFAIL = IVFAIL + 1 02600205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02610205 + 0931 CONTINUE 02620205 +C 02630205 +C TEST 93 THROUGH TEST 96 VERIFY THE CHARACTER ASSIGNMENT 02640205 +C STATEMENTS 02650205 +C 02660205 +C CHARACTER VARIABLE = CHARACTER CONSTANT 02670205 +C CHARACTER VARIABLE = CHARACTER VARIABLE 02680205 +C 02690205 +C ARE CORRECT. THE VARIABLES AND CONSTANT ARE THE SAME LENGTH, 02700205 +C AND THE LENGTHS 3, 12, 25, AND 57 ARE USED IN THESE TESTS. 02710205 +C 02720205 +C 02730205 +C **** FCVS PROGRAM 205 - TEST 093 **** 02740205 +C 02750205 +C 02760205 + IVTNUM = 93 02770205 + IF (ICZERO) 30930, 0930, 30930 02780205 + 0930 CONTINUE 02790205 + IVCOMP = 0 02800205 + IVCORR = 1 02810205 + CVTN07 = ' ' 02820205 + CVTN01 = 'ABC' 02830205 + CVTN07 = CVTN01 02840205 + IF (CVTN07 .EQ. 'ABC') IVCOMP = 1 02850205 +40930 IF (IVCOMP - 1) 20930, 10930, 20930 02860205 +30930 IVDELE = IVDELE + 1 02870205 + WRITE (I02,80000) IVTNUM 02880205 + IF (ICZERO) 10930, 0941, 20930 02890205 +10930 IVPASS = IVPASS + 1 02900205 + WRITE (I02,80002) IVTNUM 02910205 + GO TO 0941 02920205 +20930 IVFAIL = IVFAIL + 1 02930205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02940205 + 0941 CONTINUE 02950205 +C 02960205 +C **** FCVS PROGRAM 205 - TEST 094 **** 02970205 +C 02980205 +C 02990205 + IVTNUM = 94 03000205 + IF (ICZERO) 30940, 0940, 30940 03010205 + 0940 CONTINUE 03020205 + IVCOMP = 0 03030205 + IVCORR = 1 03040205 + CVTN03 = 'ABCDEFGHIJKL' 03050205 + CVTN09 = ' ' 03060205 + CVTN09 = CVTN03 03070205 + IF (CVTN09 .EQ. 'ABCDEFGHIJKL') IVCOMP = 1 03080205 +40940 IF (IVCOMP - 1) 20940, 10940, 20940 03090205 +30940 IVDELE = IVDELE + 1 03100205 + WRITE (I02,80000) IVTNUM 03110205 + IF (ICZERO) 10940, 0951, 20940 03120205 +10940 IVPASS = IVPASS + 1 03130205 + WRITE (I02,80002) IVTNUM 03140205 + GO TO 0951 03150205 +20940 IVFAIL = IVFAIL + 1 03160205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03170205 + 0951 CONTINUE 03180205 +C 03190205 +C **** FCVS PROGRAM 205 - TEST 095 **** 03200205 +C 03210205 +C 03220205 + IVTNUM = 95 03230205 + IF (ICZERO) 30950, 0950, 30950 03240205 + 0950 CONTINUE 03250205 + IVCOMP = 0 03260205 + IVCORR = 1 03270205 + CVTN04 = 'ABCDEFGHIJKLMNOPQRSTUVWXY' 03280205 + CVTN10 = ' ' 03290205 + CVTN10 = CVTN04 03300205 + IF (CVTN10 .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXY') IVCOMP = 1 03310205 +40950 IF (IVCOMP - 1) 20950, 10950, 20950 03320205 +30950 IVDELE = IVDELE + 1 03330205 + WRITE (I02,80000) IVTNUM 03340205 + IF (ICZERO) 10950, 0961, 20950 03350205 +10950 IVPASS = IVPASS + 1 03360205 + WRITE (I02,80002) IVTNUM 03370205 + GO TO 0961 03380205 +20950 IVFAIL = IVFAIL + 1 03390205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03400205 + 0961 CONTINUE 03410205 +C 03420205 +C **** FCVS PROGRAM 205 - TEST 096 **** 03430205 +C 03440205 +C 03450205 + IVTNUM = 96 03460205 + IF (ICZERO) 30960, 0960, 30960 03470205 + 0960 CONTINUE 03480205 + IVCOMP = 0 03490205 + IVCORR = 1 03500205 + CVTN12 = ' ' 03510205 + CVTN06 = 03520205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE' 03530205 + CVTN12 = CVTN06 03540205 + IF (CVTN12 .EQ. 03550205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE') 03560205 + 2 IVCOMP = 1 03570205 +40960 IF (IVCOMP - 1) 20960, 10960, 20960 03580205 +30960 IVDELE = IVDELE + 1 03590205 + WRITE (I02,80000) IVTNUM 03600205 + IF (ICZERO) 10960, 0971, 20960 03610205 +10960 IVPASS = IVPASS + 1 03620205 + WRITE (I02,80002) IVTNUM 03630205 + GO TO 0971 03640205 +20960 IVFAIL = IVFAIL + 1 03650205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03660205 + 0971 CONTINUE 03670205 +C 03680205 +C TEST 97 AND TEST 98 VERIFY THE CHARACTER ASSIGNMENT 03690205 +C STATEMENT 03700205 +C 03710205 +C CHARACTER ARRAY ELEMENT = CHARACTER CONSTANT 03720205 +C 03730205 +C IS CORRECT. THE ARRAY ELEMENT AND CONSTANT ARE THE SAME LENGTH, 03740205 +C AND THE LENGTHS 25 AND 41 ARE USED IN THESE TESTS. 03750205 +C 03760205 +C 03770205 +C **** FCVS PROGRAM 205 - TEST 097 **** 03780205 +C 03790205 +C 03800205 + IVTNUM = 97 03810205 + IF (ICZERO) 30970, 0970, 30970 03820205 + 0970 CONTINUE 03830205 + IVCOMP = 0 03840205 + IVCORR = 1 03850205 + CATN14(1) = 'ABCDEFGHIJKLMNOPQRSTUVWXY' 03860205 + IF (CATN14(1) .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXY') IVCOMP = 1 03870205 +40970 IF (IVCOMP - 1) 20970, 10970, 20970 03880205 +30970 IVDELE = IVDELE + 1 03890205 + WRITE (I02,80000) IVTNUM 03900205 + IF (ICZERO) 10970, 0981, 20970 03910205 +10970 IVPASS = IVPASS + 1 03920205 + WRITE (I02,80002) IVTNUM 03930205 + GO TO 0981 03940205 +20970 IVFAIL = IVFAIL + 1 03950205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03960205 + 0981 CONTINUE 03970205 +C 03980205 +C **** FCVS PROGRAM 205 - TEST 098 **** 03990205 +C 04000205 +C 04010205 + IVTNUM = 98 04020205 + IF (ICZERO) 30980, 0980, 30980 04030205 + 0980 CONTINUE 04040205 + IVCOMP = 0 04050205 + IVCORR = 1 04060205 + CATN15(8) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO' 04070205 + IF (CATN15(8) .EQ. 04080205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO') IVCOMP = 1 04090205 +40980 IF (IVCOMP - 1) 20980, 10980, 20980 04100205 +30980 IVDELE = IVDELE + 1 04110205 + WRITE (I02,80000) IVTNUM 04120205 + IF (ICZERO) 10980, 0991, 20980 04130205 +10980 IVPASS = IVPASS + 1 04140205 + WRITE (I02,80002) IVTNUM 04150205 + GO TO 0991 04160205 +20980 IVFAIL = IVFAIL + 1 04170205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04180205 + 0991 CONTINUE 04190205 +C 04200205 +C TEST 99 AND TEST 100 VERIFY THE CHARACTER ASSIGNMENT 04210205 +C STATEMENTS 04220205 +C 04230205 +C CHARACTER VARIABLE = CHARACTER CONSTANT 04240205 +C CHARACTER ARRAY ELEMENT = CHARACTER VARIABLE 04250205 +C 04260205 +C ARE CORRECT. THE CHARACTER ENTITIES ARE THE SAME LENGTH, 04270205 +C AND THE LENGTHS 3 AND 57 ARE USED IN THESE TESTS. 04280205 +C 04290205 +C 04300205 +C **** FCVS PROGRAM 205 - TEST 099 **** 04310205 +C 04320205 +C 04330205 + IVTNUM = 99 04340205 + IF (ICZERO) 30990, 0990, 30990 04350205 + 0990 CONTINUE 04360205 + IVCOMP = 0 04370205 + IVCORR = 1 04380205 + CVTN01 = 'ABC' 04390205 + CATN11(5) = CVTN01 04400205 + IF (CATN11(5) .EQ. 'ABC') IVCOMP = 1 04410205 +40990 IF (IVCOMP - 1) 20990, 10990, 20990 04420205 +30990 IVDELE = IVDELE + 1 04430205 + WRITE (I02,80000) IVTNUM 04440205 + IF (ICZERO) 10990, 1001, 20990 04450205 +10990 IVPASS = IVPASS + 1 04460205 + WRITE (I02,80002) IVTNUM 04470205 + GO TO 1001 04480205 +20990 IVFAIL = IVFAIL + 1 04490205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04500205 + 1001 CONTINUE 04510205 +C 04520205 +C **** FCVS PROGRAM 205 - TEST 100 **** 04530205 +C 04540205 +C 04550205 + IVTNUM = 100 04560205 + IF (ICZERO) 31000, 1000, 31000 04570205 + 1000 CONTINUE 04580205 + IVCOMP = 0 04590205 + IVCORR = 1 04600205 + CVTN06 = 04610205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE' 04620205 + CATN16(3) = CVTN06 04630205 + IF (CATN16(3) .EQ. 04640205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZABCDE') 04650205 + 2 IVCOMP = 1 04660205 +41000 IF (IVCOMP - 1) 21000, 11000, 21000 04670205 +31000 IVDELE = IVDELE + 1 04680205 + WRITE (I02,80000) IVTNUM 04690205 + IF (ICZERO) 11000, 1011, 21000 04700205 +11000 IVPASS = IVPASS + 1 04710205 + WRITE (I02,80002) IVTNUM 04720205 + GO TO 1011 04730205 +21000 IVFAIL = IVFAIL + 1 04740205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04750205 + 1011 CONTINUE 04760205 +C 04770205 +C TEST 101 AND TEST 102 VERIFY THE CHARACTER ASSIGNMENT 04780205 +C STATEMENTS 04790205 +C 04800205 +C CHARACTER ARRAY ELEMENT = CHARACTER CONSTANT 04810205 +C CHARACTER ARRAY ELEMENT = CHARACTER ARRAY ELEMENT 04820205 +C 04830205 +C ARE CORRECT. THE CHARACTER ENTITIES ARE THE SAME LENGTH, AND 04840205 +C THE LENGTHS 7 AND 41 ARE USED IN THESE TESTS. 04850205 +C 04860205 +C 04870205 +C **** FCVS PROGRAM 205 - TEST 101 **** 04880205 +C 04890205 +C 04900205 + IVTNUM = 101 04910205 + IF (ICZERO) 31010, 1010, 31010 04920205 + 1010 CONTINUE 04930205 + IVCOMP = 0 04940205 + IVCORR = 1 04950205 + CATN12(3) = 'ABCDEFG' 04960205 + CATN12(4) = CATN12(3) 04970205 + IF (CATN12(4) .EQ. 'ABCDEFG') IVCOMP = 1 04980205 +41010 IF (IVCOMP - 1) 21010, 11010, 21010 04990205 +31010 IVDELE = IVDELE + 1 05000205 + WRITE (I02,80000) IVTNUM 05010205 + IF (ICZERO) 11010, 1021, 21010 05020205 +11010 IVPASS = IVPASS + 1 05030205 + WRITE (I02,80002) IVTNUM 05040205 + GO TO 1021 05050205 +21010 IVFAIL = IVFAIL + 1 05060205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05070205 + 1021 CONTINUE 05080205 +C 05090205 +C **** FCVS PROGRAM 205 - TEST 102 **** 05100205 +C 05110205 +C 05120205 + IVTNUM = 102 05130205 + IF (ICZERO) 31020, 1020, 31020 05140205 + 1020 CONTINUE 05150205 + IVCOMP = 0 05160205 + IVCORR = 1 05170205 + CATN15(3) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO' 05180205 + CATN15(4) = CATN15(3) 05190205 + IF (CATN15(4) .EQ. 05200205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO') IVCOMP = 1 05210205 +41020 IF (IVCOMP - 1) 21020, 11020, 21020 05220205 +31020 IVDELE = IVDELE + 1 05230205 + WRITE (I02,80000) IVTNUM 05240205 + IF (ICZERO) 11020, 1031, 21020 05250205 +11020 IVPASS = IVPASS + 1 05260205 + WRITE (I02,80002) IVTNUM 05270205 + GO TO 1031 05280205 +21020 IVFAIL = IVFAIL + 1 05290205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05300205 + 1031 CONTINUE 05310205 +C 05320205 +C TEST 103 AND TEST 104 VERIFY THE CHARACTER ASSIGNMENT 05330205 +C STATEMENTS 05340205 +C 05350205 +C CHARACTER ARRAY ELEMENT = CHARACTER CONSTANT 05360205 +C CHARACTER VARIABLE = CHARACTER ARRAY ELEMENT 05370205 +C 05380205 +C ARE CORRECT. THE CHARACTER ENTITIES ARE THE SAME LENGTH, AND 05390205 +C THE LENGTHS 12 AND 25 ARE USED. 05400205 +C 05410205 +C 05420205 +C **** FCVS PROGRAM 205 - TEST 103 **** 05430205 +C 05440205 +C 05450205 + IVTNUM = 103 05460205 + IF (ICZERO) 31030, 1030, 31030 05470205 + 1030 CONTINUE 05480205 + IVCOMP = 0 05490205 + IVCORR = 1 05500205 + CATN13(1) = 'ABCDEFGHIJKL' 05510205 + CVTN09 = ' ' 05520205 + CVTN09 = CATN13(1) 05530205 + IF (CVTN09 .EQ. 'ABCDEFGHIJKL') IVCOMP = 1 05540205 +41030 IF (IVCOMP - 1) 21030, 11030, 21030 05550205 +31030 IVDELE = IVDELE + 1 05560205 + WRITE (I02,80000) IVTNUM 05570205 + IF (ICZERO) 11030, 1041, 21030 05580205 +11030 IVPASS = IVPASS + 1 05590205 + WRITE (I02,80002) IVTNUM 05600205 + GO TO 1041 05610205 +21030 IVFAIL = IVFAIL + 1 05620205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05630205 + 1041 CONTINUE 05640205 +C 05650205 +C **** FCVS PROGRAM 205 - TEST 104 **** 05660205 +C 05670205 +C 05680205 + IVTNUM = 104 05690205 + IF (ICZERO) 31040, 1040, 31040 05700205 + 1040 CONTINUE 05710205 + IVCOMP = 0 05720205 + IVCORR = 1 05730205 + CATN14(1) = 'ABCDEFGHIJKLMNOPQRSTUVWXY' 05740205 + CVTN10 = ' ' 05750205 + CVTN10 = CATN14(1) 05760205 + IF (CVTN10 .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXY') IVCOMP = 1 05770205 +41040 IF (IVCOMP - 1) 21040, 11040, 21040 05780205 +31040 IVDELE = IVDELE + 1 05790205 + WRITE (I02,80000) IVTNUM 05800205 + IF (ICZERO) 11040, 1051, 21040 05810205 +11040 IVPASS = IVPASS + 1 05820205 + WRITE (I02,80002) IVTNUM 05830205 + GO TO 1051 05840205 +21040 IVFAIL = IVFAIL + 1 05850205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05860205 + 1051 CONTINUE 05870205 +C 05880205 +C TEST 105 THROUGH TEST 110 VERIFY THE CHARACTER RELATIONAL 05890205 +C EXPRESSION USING EACH OF THE SIX RELATIONAL OPERATORS IN THE 05900205 +C STATEMENT FORM 05910205 +C 05920205 +C CHARACTER VARIABLE RELOP CHARACTER CONSTANT 05930205 +C 05940205 +C THE CHARACTER ENTITIES ARE THE SAME LENGTH, AND THE LENGTHS 05950205 +C 3, 7, 12, 25, 41, AND 57 ARE USED IN THESE TESTS. 05960205 +C 05970205 +C 05980205 +C **** FCVS PROGRAM 205 - TEST 105 **** 05990205 +C 06000205 +C 06010205 + IVTNUM = 105 06020205 + IF (ICZERO) 31050, 1050, 31050 06030205 + 1050 CONTINUE 06040205 + IVCOMP = 0 06050205 + IVCORR = 1 06060205 + CVTN07 = 'ZAB' 06070205 + IF (CVTN07 .EQ. 'ZAB') IVCOMP = 1 06080205 +41050 IF (IVCOMP - 1) 21050, 11050, 21050 06090205 +31050 IVDELE = IVDELE + 1 06100205 + WRITE (I02,80000) IVTNUM 06110205 + IF (ICZERO) 11050, 1061, 21050 06120205 +11050 IVPASS = IVPASS + 1 06130205 + WRITE (I02,80002) IVTNUM 06140205 + GO TO 1061 06150205 +21050 IVFAIL = IVFAIL + 1 06160205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06170205 + 1061 CONTINUE 06180205 +C 06190205 +C **** FCVS PROGRAM 205 - TEST 106 **** 06200205 +C 06210205 +C 06220205 + IVTNUM = 106 06230205 + IF (ICZERO) 31060, 1060, 31060 06240205 + 1060 CONTINUE 06250205 + IVCOMP = 0 06260205 + IVCORR = 1 06270205 + CVTN08 = 'ABDDEEF' 06280205 + IF (CVTN08 .GT. 'ABCDEEF') IVCOMP = 1 06290205 +41060 IF (IVCOMP - 1) 21060, 11060, 21060 06300205 +31060 IVDELE = IVDELE + 1 06310205 + WRITE (I02,80000) IVTNUM 06320205 + IF (ICZERO) 11060, 1071, 21060 06330205 +11060 IVPASS = IVPASS + 1 06340205 + WRITE (I02,80002) IVTNUM 06350205 + GO TO 1071 06360205 +21060 IVFAIL = IVFAIL + 1 06370205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06380205 + 1071 CONTINUE 06390205 +C 06400205 +C **** FCVS PROGRAM 205 - TEST 107 **** 06410205 +C 06420205 +C 06430205 + IVTNUM = 107 06440205 + IF (ICZERO) 31070, 1070, 31070 06450205 + 1070 CONTINUE 06460205 + IVCOMP = 0 06470205 + IVCORR = 1 06480205 + CVTN09 = 'ZXYZZZABCDEF' 06490205 + IF (CVTN09 .LT. 'ZXYZZZACCDEF') IVCOMP = 1 06500205 +41070 IF (IVCOMP - 1) 21070, 11070, 21070 06510205 +31070 IVDELE = IVDELE + 1 06520205 + WRITE (I02,80000) IVTNUM 06530205 + IF (ICZERO) 11070, 1081, 21070 06540205 +11070 IVPASS = IVPASS + 1 06550205 + WRITE (I02,80002) IVTNUM 06560205 + GO TO 1081 06570205 +21070 IVFAIL = IVFAIL + 1 06580205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06590205 + 1081 CONTINUE 06600205 +C 06610205 +C **** FCVS PROGRAM 205 - TEST 108 **** 06620205 +C 06630205 +C 06640205 + IVTNUM = 108 06650205 + IF (ICZERO) 31080, 1080, 31080 06660205 + 1080 CONTINUE 06670205 + IVCOMP = 0 06680205 + IVCORR = 1 06690205 + CVTN10 = 'ABCDEFGHIJKKMNOPQRSTUVWXY' 06700205 + IF ('ABCDEFGHIJKLMNOPQRSTUVWXY' .NE. CVTN10) IVCOMP = 1 06710205 +41080 IF (IVCOMP - 1) 21080, 11080, 21080 06720205 +31080 IVDELE = IVDELE + 1 06730205 + WRITE (I02,80000) IVTNUM 06740205 + IF (ICZERO) 11080, 1091, 21080 06750205 +11080 IVPASS = IVPASS + 1 06760205 + WRITE (I02,80002) IVTNUM 06770205 + GO TO 1091 06780205 +21080 IVFAIL = IVFAIL + 1 06790205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06800205 + 1091 CONTINUE 06810205 +C 06820205 +C **** FCVS PROGRAM 205 - TEST 109 **** 06830205 +C 06840205 +C 06850205 + IVTNUM = 109 06860205 + IF (ICZERO) 31090, 1090, 31090 06870205 + 1090 CONTINUE 06880205 + IVCOMP = 0 06890205 + IVCORR = 1 06900205 + CVTN11 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZAABCDEFGHIJKLMN' 06910205 + IF ('ABCDEFGHIJKLMNOPQRSTUVWXYZABBCDEFGHIJKLMN' .GE. CVTN11) 06920205 + 1 IVCOMP = 1 06930205 +41090 IF (IVCOMP - 1) 21090, 11090, 21090 06940205 +31090 IVDELE = IVDELE + 1 06950205 + WRITE (I02,80000) IVTNUM 06960205 + IF (ICZERO) 11090, 1101, 21090 06970205 +11090 IVPASS = IVPASS + 1 06980205 + WRITE (I02,80002) IVTNUM 06990205 + GO TO 1101 07000205 +21090 IVFAIL = IVFAIL + 1 07010205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07020205 + 1101 CONTINUE 07030205 +C 07040205 +C **** FCVS PROGRAM 205 - TEST 110 **** 07050205 +C 07060205 +C 07070205 + IVTNUM = 110 07080205 + IF (ICZERO) 31100, 1100, 31100 07090205 + 1100 CONTINUE 07100205 + IVCOMP = 0 07110205 + IVCORR = 1 07120205 + CVTN12 = 07130205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZAAAAA' 07140205 + IF ('ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYAAAAAA' 07150205 + 1 .LE. CVTN12) IVCOMP = 1 07160205 +41100 IF (IVCOMP - 1) 21100, 11100, 21100 07170205 +31100 IVDELE = IVDELE + 1 07180205 + WRITE (I02,80000) IVTNUM 07190205 + IF (ICZERO) 11100, 1111, 21100 07200205 +11100 IVPASS = IVPASS + 1 07210205 + WRITE (I02,80002) IVTNUM 07220205 + GO TO 1111 07230205 +21100 IVFAIL = IVFAIL + 1 07240205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07250205 + 1111 CONTINUE 07260205 +C 07270205 +C TEST 111 AND TEST 112 VERIFY THE CHARACTER RELATIONAL 07280205 +C EXPRESSION OF THE FORM 07290205 +C 07300205 +C CHARACTER VARIABLE RELOP CHARACTER VARIABLE 07310205 +C 07320205 +C THE CHARACTER ENTITIES ARE THE SAME LENGTH, AND THE LENGTHS 3 07330205 +C AND 41 ARE USED IN THESE TESTS. 07340205 +C 07350205 +C 07360205 +C **** FCVS PROGRAM 205 - TEST 111 **** 07370205 +C 07380205 +C 07390205 + IVTNUM = 111 07400205 + IF (ICZERO) 31110, 1110, 31110 07410205 + 1110 CONTINUE 07420205 + IVCOMP = 1 07430205 + IVCORR = 3 07440205 + CVTN01 = 'ABC' 07450205 + CVTN07 = 'BBC' 07460205 + IF (CVTN01 .EQ. CVTN07) IVCOMP = IVCOMP * 2 07470205 + IF (CVTN01 .NE. CVTN07) IVCOMP = IVCOMP * 3 07480205 +41110 IF (IVCOMP - 3) 21110, 11110, 21110 07490205 +31110 IVDELE = IVDELE + 1 07500205 + WRITE (I02,80000) IVTNUM 07510205 + IF (ICZERO) 11110, 1121, 21110 07520205 +11110 IVPASS = IVPASS + 1 07530205 + WRITE (I02,80002) IVTNUM 07540205 + GO TO 1121 07550205 +21110 IVFAIL = IVFAIL + 1 07560205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07570205 + 1121 CONTINUE 07580205 +C 07590205 +C **** FCVS PROGRAM 205 - TEST 112 **** 07600205 +C 07610205 +C 07620205 + IVTNUM = 112 07630205 + IF (ICZERO) 31120, 1120, 31120 07640205 + 1120 CONTINUE 07650205 + IVCOMP = 1 07660205 + IVCORR = 6 07670205 + CVTN05 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO' 07680205 + CVTN11 = 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNO' 07690205 + IF (CVTN05 .GE. CVTN11) IVCOMP = IVCOMP * 2 07700205 + IF (CVTN05 .LE. CVTN11) IVCOMP = IVCOMP * 3 07710205 +41120 IF (IVCOMP - 6) 21120, 11120, 21120 07720205 +31120 IVDELE = IVDELE + 1 07730205 + WRITE (I02,80000) IVTNUM 07740205 + IF (ICZERO) 11120, 1131, 21120 07750205 +11120 IVPASS = IVPASS + 1 07760205 + WRITE (I02,80002) IVTNUM 07770205 + GO TO 1131 07780205 +21120 IVFAIL = IVFAIL + 1 07790205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07800205 + 1131 CONTINUE 07810205 +C 07820205 +C TEST 113 AND TEST 114 VERIFY THE CHARACTER RELATIONAL 07830205 +C EXPRESSION OF THE FORM 07840205 +C 07850205 +C CHARACTER ARRAY ELEMENT RELOP CHARACTER CONSTANT 07860205 +C 07870205 +C THE CHARACTER ENTITIES ARE THE SAME LENGTH, AND THE LENGTHS 7 AND 07880205 +C 25 ARE USED IN THESE TESTS. 07890205 +C 07900205 +C 07910205 +C **** FCVS PROGRAM 205 - TEST 113 **** 07920205 +C 07930205 +C 07940205 + IVTNUM = 113 07950205 + IF (ICZERO) 31130, 1130, 31130 07960205 + 1130 CONTINUE 07970205 + IVCOMP = 1 07980205 + IVCORR = 6 07990205 + CATN12(3) = 'AB012CD' 08000205 + IF (CATN12(3) .LT. 'AB013CD') IVCOMP = IVCOMP * 2 08010205 + IF ('AB013CD' .GT. CATN12(3)) IVCOMP = IVCOMP * 3 08020205 +41130 IF (IVCOMP - 6) 21130, 11130, 21130 08030205 +31130 IVDELE = IVDELE + 1 08040205 + WRITE (I02,80000) IVTNUM 08050205 + IF (ICZERO) 11130, 1141, 21130 08060205 +11130 IVPASS = IVPASS + 1 08070205 + WRITE (I02,80002) IVTNUM 08080205 + GO TO 1141 08090205 +21130 IVFAIL = IVFAIL + 1 08100205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08110205 + 1141 CONTINUE 08120205 +C 08130205 +C **** FCVS PROGRAM 205 - TEST 114 **** 08140205 +C 08150205 +C 08160205 + IVTNUM = 114 08170205 + IF (ICZERO) 31140, 1140, 31140 08180205 + 1140 CONTINUE 08190205 + IVCOMP = 1 08200205 + IVCORR = 2 08210205 + CATN14(1) = 'ABCDEFGHIJKLMNOPQRSTUVWXX' 08220205 + IF (CATN14(1) .NE. 'ABCDEFGHIJKLMNOPQRSTUVWXY') 08230205 + 1 IVCOMP = IVCOMP * 2 08240205 + IF (CATN14(1) .EQ. 'ABCDEFGHIJKLMNOPQRSTUVWXY') 08250205 + 1 IVCOMP = IVCOMP * 3 08260205 +41140 IF (IVCOMP - 2) 21140, 11140, 21140 08270205 +31140 IVDELE = IVDELE + 1 08280205 + WRITE (I02,80000) IVTNUM 08290205 + IF (ICZERO) 11140, 1151, 21140 08300205 +11140 IVPASS = IVPASS + 1 08310205 + WRITE (I02,80002) IVTNUM 08320205 + GO TO 1151 08330205 +21140 IVFAIL = IVFAIL + 1 08340205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08350205 + 1151 CONTINUE 08360205 +C 08370205 +C **** FCVS PROGRAM 205 - TEST 115 **** 08380205 +C 08390205 +C TEST 115 VERIFIES THE CHARACTER RELATIONAL EXPRESSION 08400205 +C OF THE FORM 08410205 +C 08420205 +C CHARACTER ARRAY ELEMENT RELOP CHARACTER VARIABLE 08430205 +C 08440205 +C THE CHARACTER ENTITIES ARE 12 CHARACTERS IN LENGTH. 08450205 +C 08460205 + IVTNUM = 115 08470205 + IF (ICZERO) 31150, 1150, 31150 08480205 + 1150 CONTINUE 08490205 + IVCOMP = 1 08500205 + IVCORR = 2 08510205 + CATN13(3) = 'ABC+AAB/CDDF' 08520205 + IF (CATN13(3) .LT. 'BBC+AAB/CCCC') IVCOMP = IVCOMP * 2 08530205 + IF (CATN13(3) .GT. 'BBC+AAB/CCCC') IVCOMP = IVCOMP * 3 08540205 +41150 IF (IVCOMP - 2) 21150, 11150, 21150 08550205 +31150 IVDELE = IVDELE + 1 08560205 + WRITE (I02,80000) IVTNUM 08570205 + IF (ICZERO) 11150, 1161, 21150 08580205 +11150 IVPASS = IVPASS + 1 08590205 + WRITE (I02,80002) IVTNUM 08600205 + GO TO 1161 08610205 +21150 IVFAIL = IVFAIL + 1 08620205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08630205 + 1161 CONTINUE 08640205 +C 08650205 +C **** FCVS PROGRAM 205 - TEST 116 **** 08660205 +C 08670205 +C TEST 116 VERIFIES THE CHARACTER RELATIONAL EXPRESSION 08680205 +C OF THE FORM 08690205 +C 08700205 +C CHARACTER ARRAY ELEMENT RELOP CHARACTER ARRAY ELEMENT 08710205 +C 08720205 +C THE CHARACTER ENTITIES ARE 57 CHARACTERS IN LENGTH. 08730205 +C 08740205 + IVTNUM = 116 08750205 + IF (ICZERO) 31160, 1160, 31160 08760205 + 1160 CONTINUE 08770205 + IVCOMP = 1 08780205 + IVCORR = 30 08790205 + CATN16(1) = 08800205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ//012' 08810205 + CATN16(2) = 08820205 + 1 'ABCDEFGHIJKLMNOPQRSTUVWXYZABCDEFGHIJKLMNOPQRSTUVWXYZ//112' 08830205 + IF (CATN16 (1) .LT. CATN16 (2)) IVCOMP = IVCOMP * 2 08840205 + IF (CATN16 (1) .NE. CATN16 (2)) IVCOMP = IVCOMP * 3 08850205 + IF (CATN16 (1) .LE. CATN16 (2)) IVCOMP = IVCOMP * 5 08860205 +41160 IF (IVCOMP - 30) 21160, 11160, 21160 08870205 +31160 IVDELE = IVDELE + 1 08880205 + WRITE (I02,80000) IVTNUM 08890205 + IF (ICZERO) 11160, 1171, 21160 08900205 +11160 IVPASS = IVPASS + 1 08910205 + WRITE (I02,80002) IVTNUM 08920205 + GO TO 1171 08930205 +21160 IVFAIL = IVFAIL + 1 08940205 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08950205 + 1171 CONTINUE 08960205 +C 08970205 +C 08980205 +C WRITE OUT TEST SUMMARY 08990205 +C 09000205 + WRITE (I02,90004) 09010205 + WRITE (I02,90014) 09020205 + WRITE (I02,90004) 09030205 + WRITE (I02,90000) 09040205 + WRITE (I02,90004) 09050205 + WRITE (I02,90020) IVFAIL 09060205 + WRITE (I02,90022) IVPASS 09070205 + WRITE (I02,90024) IVDELE 09080205 + STOP 09090205 +90001 FORMAT (" ",24X,"FM205") 09100205 +90000 FORMAT (" ",20X,"END OF PROGRAM FM205" ) 09110205 +C 09120205 +C FORMATS FOR TEST DETAIL LINES 09130205 +C 09140205 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 09150205 +80002 FORMAT (" ",4X,I5,7X,"PASS") 09160205 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 09170205 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 09180205 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 09190205 +C 09200205 +C FORMAT STATEMENTS FOR PAGE HEADERS 09210205 +C 09220205 +90002 FORMAT ("1") 09230205 +90004 FORMAT (" ") 09240205 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 09250205 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 09260205 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 09270205 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 09280205 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 09290205 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 09300205 +C 09310205 +C FORMAT STATEMENTS FOR RUN SUMMARY 09320205 +C 09330205 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 09340205 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 09350205 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 09360205 + END 09370205 diff --git a/Fortran/UnitTests/fcvs21_f95/FM205.reference_output b/Fortran/UnitTests/fcvs21_f95/FM205.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM205.reference_output @@ -0,0 +1,51 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM205 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 87 PASS + 88 PASS + 89 PASS + 90 PASS + 91 PASS + 92 PASS + 93 PASS + 94 PASS + 95 PASS + 96 PASS + 97 PASS + 98 PASS + 99 PASS + 100 PASS + 101 PASS + 102 PASS + 103 PASS + 104 PASS + 105 PASS + 106 PASS + 107 PASS + 108 PASS + 109 PASS + 110 PASS + 111 PASS + 112 PASS + 113 PASS + 114 PASS + 115 PASS + 116 PASS + + ---------------------------------------------- + + END OF PROGRAM FM205 + + 0 TESTS FAILED + 30 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM251.f b/Fortran/UnitTests/fcvs21_f95/FM251.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM251.f @@ -0,0 +1,523 @@ + PROGRAM FM251 00010251 +C 00020251 +C 00030251 +C 00040251 +C THIS ROUTINE TESTS THE IMPLICIT STATEMENT FOR DECLARING 00050251 +C VARIABLES AS TYPE LOGICAL. THE TYPE OF A VARIABLE ( LOGICAL, 00060251 +C INTEGER, OR REAL ) IS SET BY BOTH IMPLICIT STATEMENTS AND ALSO 00070251 +C BY EXPLICIT TYPE STATEMENTS. TESTS ARE MADE TO CHECK THAT 00080251 +C EXPLICIT TYPE STATEMENTS OVERIDE THE TYPE SET BY AN IMPLICIT 00090251 +C STATEMENT FOR THE VARIABLES LISTED. 00100251 +C 00110251 +C REFERENCES 00120251 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00130251 +C X3.9-1977 00140251 +C SECTION 4.7, LOGICAL TYPE 00150251 +C SECTION 8.4.1, LOGICAL TYPE STAEMENT 00160251 +C SECTION 8.5, IMPLICIT STATEMENT 00170251 +C SECTION 11.5, LOGICAL IF STATEMENT 00180251 +C 00190251 +C 00200251 +C FM016 - TESTS LOGICAL TYPE STATEMENTS WITH VARIOUS FORMS OF 00210251 +C LOGICAL CONSTANTS AND VARIABLES. 00220251 +C 00230251 +C 00240251 +C 00250251 +C 00260251 +C ******************************************************************00270251 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00280251 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00290251 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00300251 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00310251 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00320251 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00330251 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00340251 +C THE RESULT OF EXECUTING THESE TESTS. 00350251 +C 00360251 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00370251 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00380251 +C 00390251 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00400251 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00410251 +C SOFTWARE STANDARDS VALIDATION GROUP 00420251 +C BUILDING 225 RM A266 00430251 +C GAITHERSBURG, MD 20899 00440251 +C ******************************************************************00450251 +C 00460251 +C 00470251 + IMPLICIT LOGICAL (L) 00480251 + IMPLICIT CHARACTER*14 (C) 00490251 +C 00500251 + IMPLICIT LOGICAL (M,N) 00510251 + IMPLICIT LOGICAL ( E-H, O, P-Q, S-T, X-Y ), INTEGER ( U-W ) 00520251 + IMPLICIT INTEGER (A, B), REAL (I, J) 00530251 + INTEGER IVCOMP, IVPASS, IVCORR, IVTNUM, IVDELE, IVFAIL, I01, I02 00540251 + INTEGER ICZERO 00550251 + INTEGER MVTN01 00560251 + REAL NVTN01 00570251 + LOGICAL MVTN02, NVTN02, MATN21(3,3) 00580251 + LOGICAL AVTN01 00590251 + LOGICAL IVTN01 00600251 +C 00610251 +C 00620251 +C 00630251 +C INITIALIZATION SECTION. 00640251 +C 00650251 +C INITIALIZE CONSTANTS 00660251 +C ******************** 00670251 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00680251 + I01 = 5 00690251 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00700251 + I02 = 6 00710251 +C SYSTEM ENVIRONMENT SECTION 00720251 +C 00730251 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00740251 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750251 +C (UNIT NUMBER FOR CARD READER). 00760251 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00770251 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00780251 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00790251 +C 00800251 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00810251 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00820251 +C (UNIT NUMBER FOR PRINTER). 00830251 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00840251 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850251 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00860251 +C 00870251 + IVPASS = 0 00880251 + IVFAIL = 0 00890251 + IVDELE = 0 00900251 + ICZERO = 0 00910251 +C 00920251 +C WRITE OUT PAGE HEADERS 00930251 +C 00940251 + WRITE (I02,90002) 00950251 + WRITE (I02,90006) 00960251 + WRITE (I02,90008) 00970251 + WRITE (I02,90004) 00980251 + WRITE (I02,90010) 00990251 + WRITE (I02,90004) 01000251 + WRITE (I02,90016) 01010251 + WRITE (I02,90001) 01020251 + WRITE (I02,90004) 01030251 + WRITE (I02,90012) 01040251 + WRITE (I02,90014) 01050251 + WRITE (I02,90004) 01060251 +C 01070251 +C 01080251 +C **** FCVS PROGRAM 251 - TEST 001 **** 01090251 +C 01100251 +C TEST 001 ASSIGNS A LOGICAL VALUE OF .TRUE. TO MVIN01 WHICH WAS 01110251 +C SPECIFIED AS TYPE LOGICAL IN AN IMPLICIT STATEMENT. 01120251 +C IMPLICIT LOGICAL (M,N) 01130251 +C 01140251 + IVTNUM = 1 01150251 + IF (ICZERO) 30010, 0010, 30010 01160251 + 0010 CONTINUE 01170251 + IVCOMP = 0 01180251 + MVIN01 = .TRUE. 01190251 + IF ( MVIN01 ) IVCOMP = 1 01200251 + IVCORR = 1 01210251 +40010 IF ( IVCOMP - 1 ) 20010, 10010, 20010 01220251 +30010 IVDELE = IVDELE + 1 01230251 + WRITE (I02,80000) IVTNUM 01240251 + IF (ICZERO) 10010, 0021, 20010 01250251 +10010 IVPASS = IVPASS + 1 01260251 + WRITE (I02,80002) IVTNUM 01270251 + GO TO 0021 01280251 +20010 IVFAIL = IVFAIL + 1 01290251 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01300251 + 0021 CONTINUE 01310251 +C 01320251 +C **** FCVS PROGRAM 251 - TEST 002 **** 01330251 +C 01340251 +C TEST 002 ASSIGNS A LOGICAL VALUE OF .FALSE. TO NVIN01 WHICH 01350251 +C WAS SPECIFIED AS TYPE LOGICAL IN AN IMPLICIT STATEMENT. 01360251 +C IMPLICIT LOGICAL (M,N) 01370251 +C 01380251 + IVTNUM = 2 01390251 + IF (ICZERO) 30020, 0020, 30020 01400251 + 0020 CONTINUE 01410251 + IVCOMP = 1 01420251 + LCON01 = .FALSE. 01430251 + NVIN01 = LCON01 01440251 + IF ( NVIN01 ) IVCOMP = 0 01450251 + IVCORR = 1 01460251 +40020 IF ( IVCOMP - 1 ) 20020, 10020, 20020 01470251 +30020 IVDELE = IVDELE + 1 01480251 + WRITE (I02,80000) IVTNUM 01490251 + IF (ICZERO) 10020, 0031, 20020 01500251 +10020 IVPASS = IVPASS + 1 01510251 + WRITE (I02,80002) IVTNUM 01520251 + GO TO 0031 01530251 +20020 IVFAIL = IVFAIL + 1 01540251 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01550251 + 0031 CONTINUE 01560251 +C 01570251 +C **** FCVS PROGRAM 251 - TEST 003 **** 01580251 +C 01590251 +C TEST 003 ASSIGNS AN INTEGER VALUE OF 4 TO MVTN01 WHICH 01600251 +C WAS SPECIFIED AS TYPE INTEGER EXPLICITLY IN A TYPE STATEMENT. 01610251 +C INTEGER MVTN01 01620251 +C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT INTEGER TYPE 01630251 +C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD 01640251 +C SET THE TYPE AS LOGICAL. 01650251 +C IMPLICIT LOGICAL (M,N) 01660251 +C 01670251 + IVTNUM = 3 01680251 + IF (ICZERO) 30030, 0030, 30030 01690251 + 0030 CONTINUE 01700251 + RVCOMP = 10.0 01710251 + MVTN01 = 4 01720251 + RVCOMP = MVTN01/5 01730251 + RVCORR = 0.0 01740251 +40030 IF ( RVCOMP ) 20030, 10030, 20030 01750251 +30030 IVDELE = IVDELE + 1 01760251 + WRITE (I02,80000) IVTNUM 01770251 + IF (ICZERO) 10030, 0041, 20030 01780251 +10030 IVPASS = IVPASS + 1 01790251 + WRITE (I02,80002) IVTNUM 01800251 + GO TO 0041 01810251 +20030 IVFAIL = IVFAIL + 1 01820251 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01830251 + 0041 CONTINUE 01840251 +C 01850251 +C **** FCVS PROGRAM 251 - TEST 004 **** 01860251 +C 01870251 +C TEST 004 ASSIGNS A REAL VALUE OF 4.0 TO NVTN01 WHICH 01880251 +C WAS SPECIFIED AS TYPE REAL EXPLICITLY IN A TYPE STATEMENT. 01890251 +C REAL NVTN01 01900251 +C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT REAL TYPE 01910251 +C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD 01920251 +C SET THE TYPE AS LOGICAL. 01930251 +C IMPLICIT LOGICAL (M,N) 01940251 +C 01950251 + IVTNUM = 4 01960251 + IF (ICZERO) 30040, 0040, 30040 01970251 + 0040 CONTINUE 01980251 + RVCOMP = 10.0 01990251 + NVTN01 = 4.0 02000251 + RVCOMP = NVTN01/5 02010251 + RVCORR = 0.8 02020251 +40040 IF ( RVCOMP - 0.79995 ) 20040, 10040, 40041 02030251 +40041 IF ( RVCOMP - 0.80005 ) 10040, 10040, 20040 02040251 +30040 IVDELE = IVDELE + 1 02050251 + WRITE (I02,80000) IVTNUM 02060251 + IF (ICZERO) 10040, 0051, 20040 02070251 +10040 IVPASS = IVPASS + 1 02080251 + WRITE (I02,80002) IVTNUM 02090251 + GO TO 0051 02100251 +20040 IVFAIL = IVFAIL + 1 02110251 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02120251 + 0051 CONTINUE 02130251 +C 02140251 +C **** FCVS PROGRAM 251 - TEST 005 **** 02150251 +C 02160251 +C TEST 005 ASSIGNS A LOGICAL VALUE OF .TRUE. TO MVTN02 WHICH WAS 02170251 +C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT AFTER ALSO02180251 +C HAVING ITS FIRST LETTER M SPECIFIED AS TYPE LOGICAL IN AN 02190251 +C IMPLICIT STATEMENT. 02200251 +C IMPLICIT LOGICAL (M,N) 02210251 +C LOGICAL MVTN02 02220251 +C 02230251 + IVTNUM = 5 02240251 + IF (ICZERO) 30050, 0050, 30050 02250251 + 0050 CONTINUE 02260251 + IVCOMP = 0 02270251 + LCON02 = .TRUE. 02280251 + MVTN02 = LCON02 02290251 + IF ( MVTN02 ) IVCOMP = 1 02300251 + IVCORR = 1 02310251 +40050 IF ( IVCOMP - 1 ) 20050, 10050, 20050 02320251 +30050 IVDELE = IVDELE + 1 02330251 + WRITE (I02,80000) IVTNUM 02340251 + IF (ICZERO) 10050, 0061, 20050 02350251 +10050 IVPASS = IVPASS + 1 02360251 + WRITE (I02,80002) IVTNUM 02370251 + GO TO 0061 02380251 +20050 IVFAIL = IVFAIL + 1 02390251 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02400251 + 0061 CONTINUE 02410251 +C 02420251 +C **** FCVS PROGRAM 251 - TEST 006 **** 02430251 +C 02440251 +C TEST 006 ASSIGNS A LOGICAL VALUE OF .FALSE. TO NVTN02 WHICH WAS02450251 +C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT AFTER ALSO02460251 +C HAVING ITS FIRST LETTER N SPECIFIED AS TYPE LOGICAL IN AN 02470251 +C IMPLICIT STATEMENT. 02480251 +C IMPLICIT LOGICAL (M,N) 02490251 +C LOGICAL NVTN02 02500251 +C 02510251 + IVTNUM = 6 02520251 + IF (ICZERO) 30060, 0060, 30060 02530251 + 0060 CONTINUE 02540251 + IVCOMP = 1 02550251 + NVTN02 = .FALSE. 02560251 + IF ( NVTN02 ) IVCOMP = 0 02570251 + IVCORR = 1 02580251 +40060 IF ( IVCOMP - 1 ) 20060, 10060, 20060 02590251 +30060 IVDELE = IVDELE + 1 02600251 + WRITE (I02,80000) IVTNUM 02610251 + IF (ICZERO) 10060, 0071, 20060 02620251 +10060 IVPASS = IVPASS + 1 02630251 + WRITE (I02,80002) IVTNUM 02640251 + GO TO 0071 02650251 +20060 IVFAIL = IVFAIL + 1 02660251 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02670251 + 0071 CONTINUE 02680251 +C 02690251 +C **** FCVS PROGRAM 251 - TEST 007 **** 02700251 +C 02710251 +C TEST 007 ASSIGNS A LOGICAL VALUE OF .TRUE. TO THE ARRAY ELEMENT02720251 +C MATN21(1,1) WHICH WAS SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT 02730251 +C TYPE STATEMENT AFTER ALSO HAVING ITS FIRST LETTER M SPECIFIED AS 02740251 +C TYPE LOGICAL IN AN IMPLICIT STATEMENT. 02750251 +C IMPLICIT LOGICAL (M,N) 02760251 +C LOGICAL MATN21(3,3) 02770251 +C 02780251 + IVTNUM = 7 02790251 + IF (ICZERO) 30070, 0070, 30070 02800251 + 0070 CONTINUE 02810251 + IVCOMP = 0 02820251 + MATN21(1,1) = .TRUE. 02830251 + IF ( MATN21(1,1) ) IVCOMP = 1 02840251 + IVCORR = 1 02850251 +40070 IF ( IVCOMP - 1 ) 20070, 10070, 20070 02860251 +30070 IVDELE = IVDELE + 1 02870251 + WRITE (I02,80000) IVTNUM 02880251 + IF (ICZERO) 10070, 0081, 20070 02890251 +10070 IVPASS = IVPASS + 1 02900251 + WRITE (I02,80002) IVTNUM 02910251 + GO TO 0081 02920251 +20070 IVFAIL = IVFAIL + 1 02930251 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02940251 + 0081 CONTINUE 02950251 +C 02960251 +C **** FCVS PROGRAM 251 - TEST 008 **** 02970251 +C 02980251 +C TEST 008 ASSIGNS AN INTEGER VALUE OF 4 TO AVIN01 WHICH WAS 02990251 +C SPECIFIED AS TYPE INTEGER IN AN IMPLICIT STATEMENT. 03000251 +C IMPLICIT INTEGER (A,B) 03010251 +C 03020251 + IVTNUM = 8 03030251 + IF (ICZERO) 30080, 0080, 30080 03040251 + 0080 CONTINUE 03050251 + RVCOMP = 10.0 03060251 + AVIN01 = 4 03070251 + RVCOMP = AVIN01/5 03080251 + RVCORR = 0.0 03090251 +40080 IF ( RVCOMP ) 20080, 10080, 20080 03100251 +30080 IVDELE = IVDELE + 1 03110251 + WRITE (I02,80000) IVTNUM 03120251 + IF (ICZERO) 10080, 0091, 20080 03130251 +10080 IVPASS = IVPASS + 1 03140251 + WRITE (I02,80002) IVTNUM 03150251 + GO TO 0091 03160251 +20080 IVFAIL = IVFAIL + 1 03170251 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03180251 + 0091 CONTINUE 03190251 +C 03200251 +C **** FCVS PROGRAM 251 - TEST 009 **** 03210251 +C 03220251 +C TEST 009 ASSIGNS A LOGICAL VALUE OF .TRUE. TO AVTN01 WHICH WAS 03230251 +C SPECIFIED AS TYPE LOGICAL EXPLICITLY IN A TYPE STATEMENT. 03240251 +C LOGICAL AVTN01 03250251 +C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT LOGICAL TYPE 03260251 +C STATEMENT CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD 03270251 +C SET THE TYPE AS INTEGER. 03280251 +C IMPLICIT INTEGER (A,B) 03290251 +C 03300251 + IVTNUM = 9 03310251 + IF (ICZERO) 30090, 0090, 30090 03320251 + 0090 CONTINUE 03330251 + IVCOMP = 0 03340251 + AVTN01 = .TRUE. 03350251 + IF ( AVTN01 ) IVCOMP = 1 03360251 + IVCORR = 1 03370251 +40090 IF ( IVCOMP - 1 ) 20090, 10090, 20090 03380251 +30090 IVDELE = IVDELE + 1 03390251 + WRITE (I02,80000) IVTNUM 03400251 + IF (ICZERO) 10090, 0101, 20090 03410251 +10090 IVPASS = IVPASS + 1 03420251 + WRITE (I02,80002) IVTNUM 03430251 + GO TO 0101 03440251 +20090 IVFAIL = IVFAIL + 1 03450251 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03460251 + 0101 CONTINUE 03470251 +C 03480251 +C **** FCVS PROGRAM 251 - TEST 010 **** 03490251 +C 03500251 +C TEST 010 ASSIGNS A REAL VALUE OF 4.0 TO IVIN01 WHICH WAS 03510251 +C SPECIFIED AS REAL IMPLICITLY IN AN IMPLICIT STATEMENT. 03520251 +C IMPLICIT REAL (I,J) 03530251 +C 03540251 + IVTNUM = 10 03550251 + IF (ICZERO) 30100, 0100, 30100 03560251 + 0100 CONTINUE 03570251 + RVCOMP = 10.0 03580251 + IVIN01 = 4.0 03590251 + RVCOMP = IVIN01/5 03600251 + RVCORR = 0.8 03610251 +40100 IF ( RVCOMP - 0.79995 ) 20100, 10100, 40101 03620251 +40101 IF ( RVCOMP - 0.80005 ) 10100, 10100, 20100 03630251 +30100 IVDELE = IVDELE + 1 03640251 + WRITE (I02,80000) IVTNUM 03650251 + IF (ICZERO) 10100, 0111, 20100 03660251 +10100 IVPASS = IVPASS + 1 03670251 + WRITE (I02,80002) IVTNUM 03680251 + GO TO 0111 03690251 +20100 IVFAIL = IVFAIL + 1 03700251 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03710251 + 0111 CONTINUE 03720251 +C 03730251 +C **** FCVS PROGRAM 251 - TEST 011 **** 03740251 +C 03750251 +C TEST 011 ASSIGNS A LOGICAL VALUE OF .FALSE. TO IVTN01 WHICH WAS03760251 +C SPECIFIED AS TYPE LOGICAL IN AN EXPLICIT TYPE STATEMENT. 03770251 +C LOGICAL IVTN01 03780251 +C THIS TEST IS TO DETERMINE WHETHER AN EXPLICIT TYPE STATEMENT 03790251 +C CAN OVERRIDE THE IMPLICIT STATEMENT WHICH WOULD SET THE TYPE 03800251 +C AS REAL. 03810251 +C IMPLICIT REAL (I,J) 03820251 +C 03830251 + IVTNUM = 11 03840251 + IF (ICZERO) 30110, 0110, 30110 03850251 + 0110 CONTINUE 03860251 + IVCOMP = 1 03870251 + IVTN01 = .FALSE. 03880251 + IF ( IVTN01 ) IVCOMP = 0 03890251 + IVCORR = 1 03900251 +40110 IF ( IVCOMP - 1 ) 20110, 10110, 20110 03910251 +30110 IVDELE = IVDELE + 1 03920251 + WRITE (I02,80000) IVTNUM 03930251 + IF (ICZERO) 10110, 0121, 20110 03940251 +10110 IVPASS = IVPASS + 1 03950251 + WRITE (I02,80002) IVTNUM 03960251 + GO TO 0121 03970251 +20110 IVFAIL = IVFAIL + 1 03980251 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03990251 + 0121 CONTINUE 04000251 +C 04010251 +C 04020251 +C THE NEXT TWO TESTS CHECK THE RANGE OF LETTERS THAT 04030251 +C ARE SET BY THE IMPLICIT STATEMENT AS FOLLOWS - 04040251 +C IMPLICIT LOGICAL ( E-H, O, P-Q, S-T, X-Y ), INTEGER ( U-W ) 04050251 +C 04060251 +C 04070251 +C 04080251 +C **** FCVS PROGRAM 251 - TEST 012 **** 04090251 +C 04100251 +C TEST 012 ASSIGNS A LOGICAL VALUE OF .TRUE. TO A SERIES OF 04110251 +C VARIABLES THAT BEGIN WITH THE FOLLOWING LETTERS - 04120251 +C 04130251 +C E F G H O P Q S T X Y 04140251 +C 04150251 +C VARIABLES THAT BEGIN WITH THESE LETTERS SHOULD BE IMPLICITLY TYPED04160251 +C LOGICAL BECAUSE OF THE IMPLICIT STATEMENT USING BOTH THE RANGE AND04170251 +C SINGLE LETTER SPECIFICATION FOR TYPE LOGICAL. THE VARIABLE XVIN0104180251 +C IS FIRST USED IN A LOGICAL IF STATEMENT. THE TRUE BRANCH SHOULD 04190251 +C BE TAKEN TO SET IVCOMP = 1. THEN EACH OF THE VARIABLES SET TO 04200251 +C .TRUE. ARE USED IN A SECOND LOGICAL IF STATEMENT WHICH IS ONE 04210251 +C LARGE LOGICAL CONJUNCTION ( VARIABLE .AND. VARIABLE .AND. ... ). 04220251 +C THE TRUE BRANCH SHOULD BE TAKEN TO INCREMENT THE VALUE OF IVCOMP 04230251 +C TO A FINAL VALUE OF THREE (3). 04240251 +C 04250251 +C 04260251 + IVTNUM = 12 04270251 + IF (ICZERO) 30120, 0120, 30120 04280251 + 0120 CONTINUE 04290251 + IVCOMP = 0 04300251 + IVCORR = 3 04310251 + EVIN01 = .TRUE. 04320251 + FVIN01 = .TRUE. 04330251 + GVIN01 = .TRUE. 04340251 + HVIN01 = .TRUE. 04350251 + OVIN01 = .TRUE. 04360251 + PVIN01 = .TRUE. 04370251 + QVIN01 = .TRUE. 04380251 + SVIN01 = .TRUE. 04390251 + TVIN01 = .TRUE. 04400251 + XVIN01 = .TRUE. 04410251 + YVIN01 = .TRUE. 04420251 + IF ( XVIN01 ) IVCOMP = 1 04430251 + IF ( EVIN01 .AND. FVIN01 .AND. GVIN01 .AND. HVIN01 .AND. OVIN01 04440251 + 1.AND. PVIN01 .AND. QVIN01 .AND. SVIN01 .AND. TVIN01 .AND. XVIN01 04450251 + 2.AND. YVIN01 ) IVCOMP = IVCOMP + 2 04460251 +40120 IF ( IVCOMP - 3 ) 20120, 10120, 20120 04470251 +30120 IVDELE = IVDELE + 1 04480251 + WRITE (I02,80000) IVTNUM 04490251 + IF (ICZERO) 10120, 0131, 20120 04500251 +10120 IVPASS = IVPASS + 1 04510251 + WRITE (I02,80002) IVTNUM 04520251 + GO TO 0131 04530251 +20120 IVFAIL = IVFAIL + 1 04540251 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04550251 + 0131 CONTINUE 04560251 +C 04570251 +C **** FCVS PROGRAM 251 - TEST 013 **** 04580251 +C 04590251 +C TEST 013 ASSIGNS AN INTEGER VALUE OF 4 TO VVIN01 WHICH 04600251 +C WAS SPECIFIED AS TYPE INTEGER IMPLICITLY USING THE RANGE OF 04610251 +C LETTERS U-W IN THE IMPLICIT INTEGER SPECIFICATION STATEMENT. 04620251 +C DIVISION IS USED TO DETERMINE WHETHER VVIN01 IS TYPE INTEGER. 04630251 +C 04640251 +C 04650251 + IVTNUM = 13 04660251 + IF (ICZERO) 30130, 0130, 30130 04670251 + 0130 CONTINUE 04680251 + RVCOMP = 10.0 04690251 + VVIN01 = 4 04700251 + RVCOMP = VVIN01/5 04710251 + RVCORR = 0.0 04720251 +40130 IF ( RVCOMP ) 20130, 10130, 20130 04730251 +30130 IVDELE = IVDELE + 1 04740251 + WRITE (I02,80000) IVTNUM 04750251 + IF (ICZERO) 10130, 0141, 20130 04760251 +10130 IVPASS = IVPASS + 1 04770251 + WRITE (I02,80002) IVTNUM 04780251 + GO TO 0141 04790251 +20130 IVFAIL = IVFAIL + 1 04800251 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04810251 + 0141 CONTINUE 04820251 +C 04830251 +C 04840251 +C WRITE OUT TEST SUMMARY 04850251 +C 04860251 + WRITE (I02,90004) 04870251 + WRITE (I02,90014) 04880251 + WRITE (I02,90004) 04890251 + WRITE (I02,90000) 04900251 + WRITE (I02,90004) 04910251 + WRITE (I02,90020) IVFAIL 04920251 + WRITE (I02,90022) IVPASS 04930251 + WRITE (I02,90024) IVDELE 04940251 + STOP 04950251 +90001 FORMAT (" ",24X,"FM251") 04960251 +90000 FORMAT (" ",20X,"END OF PROGRAM FM251" ) 04970251 +C 04980251 +C FORMATS FOR TEST DETAIL LINES 04990251 +C 05000251 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 05010251 +80002 FORMAT (" ",4X,I5,7X,"PASS") 05020251 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 05030251 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 05040251 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 05050251 +C 05060251 +C FORMAT STATEMENTS FOR PAGE HEADERS 05070251 +C 05080251 +90002 FORMAT ("1") 05090251 +90004 FORMAT (" ") 05100251 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05110251 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 05120251 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 05130251 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 05140251 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 05150251 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 05160251 +C 05170251 +C FORMAT STATEMENTS FOR RUN SUMMARY 05180251 +C 05190251 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 05200251 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 05210251 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 05220251 + END 05230251 diff --git a/Fortran/UnitTests/fcvs21_f95/FM251.reference_output b/Fortran/UnitTests/fcvs21_f95/FM251.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM251.reference_output @@ -0,0 +1,34 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM251 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + + ---------------------------------------------- + + END OF PROGRAM FM251 + + 0 TESTS FAILED + 13 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM254.f b/Fortran/UnitTests/fcvs21_f95/FM254.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM254.f @@ -0,0 +1,649 @@ + PROGRAM FM254 00010254 +C 00020254 +C 00030254 +C 00040254 +C THIS ROUTINE IS A TEST OF THE ELSE IF-BLOCK. TESTS WITHIN THIS00050254 +C ROUTINE ARE FOR THE SYNTAX OF THE BASIC ELSE IF STATEMENT AND 00060254 +C ELSE IF-BLOCK STRUCTURE. 00070254 +C 00080254 +C REFERENCES 00090254 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00100254 +C X3.9-1977 00110254 +C SECTION 11.7, ELSE IF STATEMENT 00120254 +C SECTION 11.7.1, ELSE IF-BLOCK 00130254 +C SECTION 11.7.2, EXECUTION OF THE ELSE IF STATEMENT 00140254 +C 00150254 +C 00160254 +C 00170254 +C 00180254 +C ******************************************************************00190254 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00200254 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00210254 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00220254 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00230254 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00240254 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00250254 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00260254 +C THE RESULT OF EXECUTING THESE TESTS. 00270254 +C 00280254 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00290254 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00300254 +C 00310254 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00320254 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00330254 +C SOFTWARE STANDARDS VALIDATION GROUP 00340254 +C BUILDING 225 RM A266 00350254 +C GAITHERSBURG, MD 20899 00360254 +C ******************************************************************00370254 +C 00380254 +C 00390254 + IMPLICIT LOGICAL (L) 00400254 + IMPLICIT CHARACTER*14 (C) 00410254 +C 00420254 + DIMENSION LADN11(2) 00430254 + LOGICAL LVTN01, LVTN02, LATN11(2), LADN11 00440254 + DATA LADN11/.TRUE., .FALSE./ 00450254 +C 00460254 +C 00470254 +C **** LOGICAL STATEMENT FUNCTION REFERENCED IN TEST 4 **** 00480254 +C 00490254 + LFIS01 ( L ) = L .AND. L 00500254 +C 00510254 +C 00520254 +C 00530254 +C 00540254 +C 00550254 +C INITIALIZATION SECTION. 00560254 +C 00570254 +C INITIALIZE CONSTANTS 00580254 +C ******************** 00590254 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00600254 + I01 = 5 00610254 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00620254 + I02 = 6 00630254 +C SYSTEM ENVIRONMENT SECTION 00640254 +C 00650254 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00660254 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670254 +C (UNIT NUMBER FOR CARD READER). 00680254 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00690254 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00700254 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00710254 +C 00720254 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00730254 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00740254 +C (UNIT NUMBER FOR PRINTER). 00750254 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00760254 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00770254 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00780254 +C 00790254 + IVPASS = 0 00800254 + IVFAIL = 0 00810254 + IVDELE = 0 00820254 + ICZERO = 0 00830254 +C 00840254 +C WRITE OUT PAGE HEADERS 00850254 +C 00860254 + WRITE (I02,90002) 00870254 + WRITE (I02,90006) 00880254 + WRITE (I02,90008) 00890254 + WRITE (I02,90004) 00900254 + WRITE (I02,90010) 00910254 + WRITE (I02,90004) 00920254 + WRITE (I02,90016) 00930254 + WRITE (I02,90001) 00940254 + WRITE (I02,90004) 00950254 + WRITE (I02,90012) 00960254 + WRITE (I02,90014) 00970254 + WRITE (I02,90004) 00980254 +C 00990254 +C 01000254 +C 01010254 +C THE SYNTAX OF THE ELSE IF STATEMENTS IN THE TESTS TO FOLLOW IS 01020254 +C 01030254 +C IF ( E1 ) THEN 01040254 +C IF-BLOCK 01050254 +C ELSE IF ( E2 ) THEN 01060254 +C ELSE IF-BLOCK 01070254 +C END IF 01080254 +C 01090254 +C THE NEXT FOUR TESTS WILL USE THE FOLLOWING COMBINATIONS OF TRUE 01100254 +C AND FALSE FOR E1 AND E2 AS SHOWN BELOW - 01110254 +C TEST NUMBER 1 2 3 4 01120254 +C E1 F F T T 01130254 +C E2 T F T F 01140254 +C 01150254 +C 01160254 +C 01170254 +C 01180254 +C **** FCVS PROGRAM 254 - TEST 001 **** 01190254 +C 01200254 +C TEST 001 USES A VERY SIMPLE ELSE IF STATEMENT. THE EXPRESSION 01210254 +C WITHIN THE PARENTHESES IS THE LOGICAL CONSTANT .TRUE. AND THE 01220254 +C EXECUTABLE STATEMENT WITHIN THE ELSE IF-BLOCK OF LEVEL ONE IS AN 01230254 +C INTEGER ARITHMETIC ASSIGNMENT STATEMENT. IN THIS TEST THE LOGICAL01240254 +C EXPRESSION E1 IS .FALSE. SO THE IF-BLOCK SHOULD NOT BE EXECUTED. 01250254 +C THE LOGICAL EXPRESSION E2 IS .TRUE. SO THE ELSE IF-BLOCK SHOULD 01260254 +C BE EXECUTED. 01270254 +C 01280254 +C 01290254 + IVTNUM = 1 01300254 + IF (ICZERO) 30010, 0010, 30010 01310254 + 0010 CONTINUE 01320254 + IVCOMP = 1 01330254 + IF ( .FALSE. ) THEN 01340254 + IVCOMP = IVCOMP * 2 01350254 + ELSE IF ( .TRUE. ) THEN 01360254 + IVCOMP = IVCOMP * 3 01370254 + END IF 01380254 +C 01390254 +C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 01400254 +C 01410254 + IVCORR = 3 01420254 +40010 IF ( IVCOMP - 3 ) 20010, 10010, 20010 01430254 +30010 IVDELE = IVDELE + 1 01440254 + WRITE (I02,80000) IVTNUM 01450254 + IF (ICZERO) 10010, 0021, 20010 01460254 +10010 IVPASS = IVPASS + 1 01470254 + WRITE (I02,80002) IVTNUM 01480254 + GO TO 0021 01490254 +20010 IVFAIL = IVFAIL + 1 01500254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01510254 + 0021 CONTINUE 01520254 +C 01530254 +C **** FCVS PROGRAM 254 - TEST 002 **** 01540254 +C 01550254 +C TEST 002 HAS E1 .FALSE. AND E2 .FALSE.. NEITHER THE IF-BLOCK 01560254 +C NOR THE ELSE IF-BLOCK SHOULD BE EXECUTED. 01570254 +C 01580254 +C 01590254 + IVTNUM = 2 01600254 + IF (ICZERO) 30020, 0020, 30020 01610254 + 0020 CONTINUE 01620254 + IVCOMP = 1 01630254 + LVON01 = .FALSE. 01640254 + LVON02 = .FALSE. 01650254 + IF ( LVON01 ) THEN 01660254 + IVCOMP = IVCOMP * 2 01670254 + ELSE IF ( LVON02 ) THEN 01680254 + IVCOMP = IVCOMP * 3 01690254 + END IF 01700254 + IVCORR = 1 01710254 +40020 IF ( IVCOMP - 1 ) 20020, 10020, 20020 01720254 +30020 IVDELE = IVDELE + 1 01730254 + WRITE (I02,80000) IVTNUM 01740254 + IF (ICZERO) 10020, 0031, 20020 01750254 +10020 IVPASS = IVPASS + 1 01760254 + WRITE (I02,80002) IVTNUM 01770254 + GO TO 0031 01780254 +20020 IVFAIL = IVFAIL + 1 01790254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01800254 + 0031 CONTINUE 01810254 +C 01820254 +C **** FCVS PROGRAM 254 - TEST 003 **** 01830254 +C 01840254 +C TEST 003 HAS E1 AS .TRUE. AND E2 AS .TRUE.. ONLY THE IF-BLOCK 01850254 +C SHOULD BE EXECUTED. THE ELSE IF-BLOCK SHOULD NOT BE EXECUTED. 01860254 +C 01870254 +C 01880254 + IVTNUM = 3 01890254 + IF (ICZERO) 30030, 0030, 30030 01900254 + 0030 CONTINUE 01910254 + IVCOMP = 1 01920254 + LVON01 = .TRUE. 01930254 + LVON02 = .TRUE. 01940254 + LVTN01 = LVON01 01950254 + LVTN02 = LVON02 01960254 + IF ( LVTN01 ) THEN 01970254 + IVCOMP = IVCOMP * 2 01980254 + ELSE IF ( LVTN02 ) THEN 01990254 + IVCOMP = IVCOMP * 3 02000254 + END IF 02010254 +C 02020254 +C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****02030254 +C 02040254 + IVCORR = 2 02050254 +40030 IF ( IVCOMP - 2 ) 20030, 10030, 20030 02060254 +30030 IVDELE = IVDELE + 1 02070254 + WRITE (I02,80000) IVTNUM 02080254 + IF (ICZERO) 10030, 0041, 20030 02090254 +10030 IVPASS = IVPASS + 1 02100254 + WRITE (I02,80002) IVTNUM 02110254 + GO TO 0041 02120254 +20030 IVFAIL = IVFAIL + 1 02130254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02140254 + 0041 CONTINUE 02150254 +C 02160254 +C **** FCVS PROGRAM 254 - TEST 004 **** 02170254 +C 02180254 +C TEST 004 HAS E1 AS .TRUE. AND E2 AS .FALSE.. ONLY THE IF-BLOCK02190254 +C SHOULD BE EXECUTED. THE ELSE IF-BLOCK SHOULD NOT BE EXECUTED. 02200254 +C 02210254 +C 02220254 + IVTNUM = 4 02230254 + IF (ICZERO) 30040, 0040, 30040 02240254 + 0040 CONTINUE 02250254 + IVCOMP = 1 02260254 + LVON01 = .TRUE. 02270254 + LVTN01 = LFIS01 ( LVON01 ) 02280254 + LVON02 = .FALSE. 02290254 + IF ( LVTN01 ) THEN 02300254 + IVCOMP = IVCOMP * 2 02310254 + ELSE IF ( LFIS01 ( LVON02 ) ) THEN 02320254 + IVCOMP = IVCOMP * 3 02330254 + END IF 02340254 +C 02350254 +C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****02360254 +C 02370254 + IVCORR = 2 02380254 +40040 IF ( IVCOMP - 2 ) 20040, 10040, 20040 02390254 +30040 IVDELE = IVDELE + 1 02400254 + WRITE (I02,80000) IVTNUM 02410254 + IF (ICZERO) 10040, 0051, 20040 02420254 +10040 IVPASS = IVPASS + 1 02430254 + WRITE (I02,80002) IVTNUM 02440254 + GO TO 0051 02450254 +20040 IVFAIL = IVFAIL + 1 02460254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02470254 + 0051 CONTINUE 02480254 +C 02490254 +C 02500254 +C THE SYNTAX OF THE ELSE IF STATEMENTS IN THE TESTS TO FOLLOW IS 02510254 +C 02520254 +C IF ( E1 ) THEN 02530254 +C IF-BLOCK 1 02540254 +C ELSE IF ( E2 ) THEN 02550254 +C ELSE IF-BLOCK 1 02560254 +C ELSE IF ( E3 ) THEN 02570254 +C ELSE IF-BLOCK 2 02580254 +C END IF 02590254 +C 02600254 +C 02610254 +C 02620254 +C **** FCVS PROGRAM 254 - TEST 005 **** 02630254 +C 02640254 +C TEST 005 HAS E1 AS TRUE. E2 AND E3 ARE FALSE. ONLY IF-BLOCK 102650254 +C SHOULD BE EXECUTED. ELSE IF-BLOCKS 1 AND 2 SHOULD NOT EXECUTE. 02660254 +C 02670254 +C 02680254 + IVTNUM = 5 02690254 + IF (ICZERO) 30050, 0050, 30050 02700254 + 0050 CONTINUE 02710254 + IVCOMP = 1 02720254 +C LADN11(1) IS SET TO .TRUE. IN A DATA STATEMENT. 02730254 + LVON02 = .FALSE. 02740254 + LVON03 = .FALSE. 02750254 + IF ( LADN11(1) ) THEN 02760254 + IVCOMP = IVCOMP * 2 02770254 + ELSE IF ( LVON02 ) THEN 02780254 + IVCOMP = IVCOMP * 3 02790254 + ELSE IF ( LVON03 ) THEN 02800254 + IVCOMP = IVCOMP * 5 02810254 + END IF 02820254 +C 02830254 +C **** IVCOMP IS DETERMINED BY IVCOMP = 2 = 1 * 2 ****02840254 +C 02850254 + IVCORR = 2 02860254 +40050 IF ( IVCOMP - 2 ) 20050, 10050, 20050 02870254 +30050 IVDELE = IVDELE + 1 02880254 + WRITE (I02,80000) IVTNUM 02890254 + IF (ICZERO) 10050, 0061, 20050 02900254 +10050 IVPASS = IVPASS + 1 02910254 + WRITE (I02,80002) IVTNUM 02920254 + GO TO 0061 02930254 +20050 IVFAIL = IVFAIL + 1 02940254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02950254 + 0061 CONTINUE 02960254 +C 02970254 +C **** FCVS PROGRAM 254 - TEST 006 **** 02980254 +C 02990254 +C TEST 006 HAS E1 AS FALSE, E2 AS TRUE, AND E3 AS FALSE. ONLY 03000254 +C ELSE IF-BLOCK 1 SHOULD EXECUTE. IF-BLOCK 1 AND ELSE IF-BLOCK 2 03010254 +C SHOULD NOT EXECUTE. 03020254 +C 03030254 +C 03040254 + IVTNUM = 6 03050254 + IF (ICZERO) 30060, 0060, 30060 03060254 + 0060 CONTINUE 03070254 + IVCOMP = 1 03080254 + LVON01 = .FALSE. 03090254 + LATN11(2) = .TRUE. 03100254 + LVON03 = .FALSE. 03110254 + IF ( LVON01 ) THEN 03120254 + IVCOMP = IVCOMP * 2 03130254 + ELSE IF ( LATN11(2) ) THEN 03140254 + IVCOMP = IVCOMP * 3 03150254 + ELSE IF ( LVON03 ) THEN 03160254 + IVCOMP = IVCOMP * 5 03170254 + END IF 03180254 +C 03190254 +C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 ****03200254 +C 03210254 + IVCORR = 3 03220254 +40060 IF ( IVCOMP - 3 ) 20060, 10060, 20060 03230254 +30060 IVDELE = IVDELE + 1 03240254 + WRITE (I02,80000) IVTNUM 03250254 + IF (ICZERO) 10060, 0071, 20060 03260254 +10060 IVPASS = IVPASS + 1 03270254 + WRITE (I02,80002) IVTNUM 03280254 + GO TO 0071 03290254 +20060 IVFAIL = IVFAIL + 1 03300254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03310254 + 0071 CONTINUE 03320254 +C 03330254 +C **** FCVS PROGRAM 254 - TEST 007 **** 03340254 +C 03350254 +C TEST 007 HAS E1 AS FALSE, E2 AS FALSE, AND E3 AS TRUE. ONLY 03360254 +C ELSE IF-BLOCK 2 SHOULD BE EXECUTED. IF-BLOCK 1 AND ELSE IF-BLOCK 03370254 +C 1 SHOULD NOT EXECUTE. 03380254 +C 03390254 +C 03400254 + IVTNUM = 7 03410254 + IF (ICZERO) 30070, 0070, 30070 03420254 + 0070 CONTINUE 03430254 + IVCOMP = 1 03440254 + LVON01 = .FALSE. 03450254 + LVON02 = .FALSE. 03460254 + LVON03 = .TRUE. 03470254 + IF ( LVON01 ) THEN 03480254 + IVCOMP = IVCOMP * 2 03490254 + ELSE IF ( LVON02 ) THEN 03500254 + IVCOMP = IVCOMP * 3 03510254 + ELSE IF ( LVON03 ) THEN 03520254 + IVCOMP = IVCOMP * 5 03530254 + END IF 03540254 +C 03550254 +C **** IVCOMP IS DETERMINED BY IVCOMP = 5 = 1 * 5 ****03560254 +C 03570254 + IVCORR = 5 03580254 +40070 IF ( IVCOMP - 5 ) 20070, 10070, 20070 03590254 +30070 IVDELE = IVDELE + 1 03600254 + WRITE (I02,80000) IVTNUM 03610254 + IF (ICZERO) 10070, 0081, 20070 03620254 +10070 IVPASS = IVPASS + 1 03630254 + WRITE (I02,80002) IVTNUM 03640254 + GO TO 0081 03650254 +20070 IVFAIL = IVFAIL + 1 03660254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03670254 + 0081 CONTINUE 03680254 +C 03690254 +C **** FCVS PROGRAM 254 - TEST 008 **** 03700254 +C 03710254 +C TEST 008 HAS E1 AS FALSE. BOTH E2 AND E3 ARE TRUE. ONLY ELSE 03720254 +C IF-BLOCK 1 SHOULD EXECUTE. IF-BLOCK 1 AND ELSE IF-BLOCK 2 SHOULD 03730254 +C NOT EXECUTE. THIS IS A TEST OF THE LOGIC FLOW WHEN ONE OF THE 03740254 +C EXPRESSIONS IN A STRING OF ELSE IF BLOCK STRUCTURES IS TRUE. ONLY03750254 +C THAT PARTICULAR ELSE IF-BLOCK SHOULD BE EXECUTED. THE REST OF THE03760254 +C STRING SHOULD BE SKIPPED. 03770254 +C 03780254 +C 03790254 + IVTNUM = 8 03800254 + IF (ICZERO) 30080, 0080, 30080 03810254 + 0080 CONTINUE 03820254 + IVCOMP = 1 03830254 + LVON01 = .FALSE. 03840254 + LVON02 = .TRUE. 03850254 + LVON03 = .TRUE. 03860254 + IF ( LVON01 ) THEN 03870254 + IVCOMP = IVCOMP * 2 03880254 + ELSE IF ( LVON02 ) THEN 03890254 + IVCOMP = IVCOMP * 3 03900254 + ELSE IF ( LVON03 ) THEN 03910254 + IVCOMP = IVCOMP * 5 03920254 + END IF 03930254 +C 03940254 +C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 ****03950254 +C 03960254 + IVCORR = 3 03970254 +40080 IF ( IVCOMP - 3 ) 20080, 10080, 20080 03980254 +30080 IVDELE = IVDELE + 1 03990254 + WRITE (I02,80000) IVTNUM 04000254 + IF (ICZERO) 10080, 0091, 20080 04010254 +10080 IVPASS = IVPASS + 1 04020254 + WRITE (I02,80002) IVTNUM 04030254 + GO TO 0091 04040254 +20080 IVFAIL = IVFAIL + 1 04050254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04060254 + 0091 CONTINUE 04070254 +C 04080254 +C 04090254 +C THE FOLLOWING TWO TESTS ARE TO CHECK THE EXECUTION OF AN ELSE 04100254 +C IF STATEMENT WITH AN EMPTY ELSE IF-BLOCK. THE SYNTAX FOR THE TWO 04110254 +C TESTS IS AS FOLLOWS - 04120254 +C 04130254 +C IF ( E1 ) THEN 04140254 +C IF-BLOCK 1 04150254 +C ELSE IF ( E2 ) THEN 04160254 +C ELSE IF ( E3 ) THEN 04170254 +C ELSE IF-BLOCK 1 04180254 +C END IF 04190254 +C 04200254 +C 04210254 +C 04220254 +C **** FCVS PROGRAM 254 - TEST 009 **** 04230254 +C 04240254 +C TEST 009 HAS E1 FALSE, E2 TRUE, AND E3 AS TRUE. THE STRUCTURE 04250254 +C ELSE IF ( E2 ) THEN 04260254 +C IS FOLLOWED BY AN EMPTY ELSE IF-BLOCK ALLOWED IN SECTION 11.7.1. 04270254 +C IN SECTION 11.7.2, IF THE VALUE OF THE EXPRESSION IS TRUE AND THE04280254 +C ELSE IF-BLOCK IS EMPTY, CONTROL IS TRANSFERRED TO THE NEXT END IF 04290254 +C STATEMENT THAT HAS THE SAME IF-LEVEL AS THE ELSE IF STATEMENT. 04300254 +C NEITHER IF-BLOCK 1 NOR ELSE IF-BLOCK 1 SHOULD BE EXECUTED. 04310254 +C 04320254 +C 04330254 + IVTNUM = 9 04340254 + IF (ICZERO) 30090, 0090, 30090 04350254 + 0090 CONTINUE 04360254 + IVCOMP = 1 04370254 + LVON01 = .FALSE. 04380254 + LVON02 = .TRUE. 04390254 + LVON03 = .TRUE. 04400254 + IF ( LVON01 ) THEN 04410254 + IVCOMP = IVCOMP * 2 04420254 + ELSE IF ( LVON02 ) THEN 04430254 + ELSE IF ( LVON03 ) THEN 04440254 + IVCOMP = IVCOMP * 3 04450254 + END IF 04460254 + IVCORR = 1 04470254 +40090 IF ( IVCOMP - 1 ) 20090, 10090, 20090 04480254 +30090 IVDELE = IVDELE + 1 04490254 + WRITE (I02,80000) IVTNUM 04500254 + IF (ICZERO) 10090, 0101, 20090 04510254 +10090 IVPASS = IVPASS + 1 04520254 + WRITE (I02,80002) IVTNUM 04530254 + GO TO 0101 04540254 +20090 IVFAIL = IVFAIL + 1 04550254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04560254 + 0101 CONTINUE 04570254 +C 04580254 +C **** FCVS PROGRAM 254 - TEST 010 **** 04590254 +C 04600254 +C TEST 010 ALSO HAS AN EMPTY ELSE IF-BLOCK. E1 AND E2 ARE FALSE.04610254 +C E3 IS TRUE. ONLY ELSE IF-BLOCK 1 SHOULD BE EXECUTED. IF-BLOCK 1 04620254 +C SHOULD NOT BE EXECUTED. IN SECTION 11.7.2, IF THE VALUE OF THE 04630254 +C EXPRESSION IS FALSE, CONTROL IS TRANSFERRED TO THE NEXT ELSE IF, 04640254 +C ELSE, OR END IF STATEMENT THAT HAS THE SAME IF-LEVEL AS THE ELSE 04650254 +C IF STATEMENT. 04660254 +C 04670254 +C 04680254 + IVTNUM = 10 04690254 + IF (ICZERO) 30100, 0100, 30100 04700254 + 0100 CONTINUE 04710254 + IVCOMP = 1 04720254 + LVON01 = .FALSE. 04730254 + LVON02 = .FALSE. 04740254 + LVON03 = .TRUE. 04750254 + IF ( LVON01 ) THEN 04760254 + IVCOMP = IVCOMP * 2 04770254 + ELSE IF ( LVON02 ) THEN 04780254 + ELSE IF ( LVON03 ) THEN 04790254 + IVCOMP = IVCOMP * 3 04800254 + END IF 04810254 +C 04820254 +C **** IVCOMP IS DETERMINED BY IVCOMP = 3 = 1 * 3 ****04830254 +C 04840254 + IVCORR = 3 04850254 +40100 IF ( IVCOMP - 3 ) 20100, 10100, 20100 04860254 +30100 IVDELE = IVDELE + 1 04870254 + WRITE (I02,80000) IVTNUM 04880254 + IF (ICZERO) 10100, 0111, 20100 04890254 +10100 IVPASS = IVPASS + 1 04900254 + WRITE (I02,80002) IVTNUM 04910254 + GO TO 0111 04920254 +20100 IVFAIL = IVFAIL + 1 04930254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04940254 + 0111 CONTINUE 04950254 +C 04960254 +C 04970254 +C THE NEXT TWO TESTS USE THE ELSE IF STRUCTURE INSIDE A BLOCKED 04980254 +C IF STRUCTURE OF LEVEL 2 AS FOLLOWS - 04990254 +C 05000254 +C IF ( E1 ) THEN 05010254 +C IF-BLOCK 1 05020254 +C IF ( E2 ) THEN 05030254 +C IF-BLOCK 2 05040254 +C ELSE IF ( E3 ) THEN 05050254 +C ELSE IF-BLOCK 1 05060254 +C ELSE IF ( E4 ) THEN 05070254 +C ELSE IF-BLOCK 2 05080254 +C END IF 05090254 +C ELSE IF ( E5 ) THEN 05100254 +C ELSE IF-BLOCK 3 05110254 +C ELSE IF ( E6 ) THEN 05120254 +C ELSE IF-BLOCK 4 05130254 +C END IF 05140254 +C 05150254 +C 05160254 +C 05170254 +C **** FCVS PROGRAM 254 - TEST 011 **** 05180254 +C 05190254 +C TEST 011 HAS E1 TRUE, E2 AND E3 AS FALSE, E4, E5, AND ALSO 05200254 +C E6 AS TRUE. IF-BLOCK 1, AND ELSE IF-BLOCK 2 SHOULD BE EXECUTED. 05210254 +C IF-BLOCK 2, ELSE IF-BLOCK 1, 3, AND 4 SHOULD NOT BE EXECUTED. 05220254 +C 05230254 +C 05240254 + IVTNUM = 11 05250254 + IF (ICZERO) 30110, 0110, 30110 05260254 + 0110 CONTINUE 05270254 + IVCOMP = 1 05280254 + LVON01 = .TRUE. 05290254 + LVON02 = .FALSE. 05300254 + LVON03 = .FALSE. 05310254 + LVON04 = .TRUE. 05320254 + LVON05 = .TRUE. 05330254 + LVON06 = .TRUE. 05340254 + IF ( LVON01 ) THEN 05350254 + IVCOMP = IVCOMP * 2 05360254 + IF ( LVON02 ) THEN 05370254 + IVCOMP = IVCOMP * 3 05380254 + ELSE IF ( LVON03 ) THEN 05390254 + IVCOMP = IVCOMP * 5 05400254 + ELSE IF ( LVON04 ) THEN 05410254 + IVCOMP = IVCOMP * 7 05420254 + END IF 05430254 + ELSE IF ( LVON05 ) THEN 05440254 + IVCOMP = IVCOMP * 11 05450254 + ELSE IF ( LVON06 ) THEN 05460254 + IVCOMP = IVCOMP * 13 05470254 + END IF 05480254 +C 05490254 +C **** IVCOMP IS DETERMINED BY IVCOMP = 14 = 1 * 2 * 7 ****05500254 +C 05510254 + IVCORR = 14 05520254 +40110 IF ( IVCOMP - 14 ) 20110, 10110, 20110 05530254 +30110 IVDELE = IVDELE + 1 05540254 + WRITE (I02,80000) IVTNUM 05550254 + IF (ICZERO) 10110, 0121, 20110 05560254 +10110 IVPASS = IVPASS + 1 05570254 + WRITE (I02,80002) IVTNUM 05580254 + GO TO 0121 05590254 +20110 IVFAIL = IVFAIL + 1 05600254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05610254 + 0121 CONTINUE 05620254 +C 05630254 +C **** FCVS PROGRAM 254 - TEST 012 **** 05640254 +C 05650254 +C TEST 012 HAS E1 AS FALSE, E2, E3, AND E4 ARE TRUE, E5 AS FALSE,05660254 +C AND E6 IS TRUE. ONLY ELSE IF-BLOCK 4 SHOULD BE EXECUTED. NO 05670254 +C OTHER IF-BLOCK OR ELSE IF-BLOCK SHOULD BE EXECUTED. 05680254 +C 05690254 +C 05700254 + IVTNUM = 12 05710254 + IF (ICZERO) 30120, 0120, 30120 05720254 + 0120 CONTINUE 05730254 + IVCOMP = 1 05740254 + LVON01 = .FALSE. 05750254 + LVON02 = .TRUE. 05760254 + LVON03 = .TRUE. 05770254 + LVON04 = .TRUE. 05780254 + LVON05 = .FALSE. 05790254 + LVON06 = .TRUE. 05800254 + IF ( LVON01 ) THEN 05810254 + IVCOMP = IVCOMP * 2 05820254 + IF ( LVON02 ) THEN 05830254 + IVCOMP = IVCOMP * 3 05840254 + ELSE IF ( LVON03 ) THEN 05850254 + IVCOMP = IVCOMP * 5 05860254 + ELSE IF ( LVON04 ) THEN 05870254 + IVCOMP = IVCOMP * 7 05880254 + END IF 05890254 + ELSE IF ( LVON05 ) THEN 05900254 + IVCOMP = IVCOMP * 11 05910254 + ELSE IF ( LVON06 ) THEN 05920254 + IVCOMP = IVCOMP * 13 05930254 + END IF 05940254 +C 05950254 +C **** IVCOMP IS DETERMINED BY IVCOMP = 13 = 1 * 13 ****05960254 +C 05970254 + IVCORR = 13 05980254 +40120 IF ( IVCOMP - 13 ) 20120, 10120, 20120 05990254 +30120 IVDELE = IVDELE + 1 06000254 + WRITE (I02,80000) IVTNUM 06010254 + IF (ICZERO) 10120, 0131, 20120 06020254 +10120 IVPASS = IVPASS + 1 06030254 + WRITE (I02,80002) IVTNUM 06040254 + GO TO 0131 06050254 +20120 IVFAIL = IVFAIL + 1 06060254 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06070254 + 0131 CONTINUE 06080254 +C 06090254 +C 06100254 +C WRITE OUT TEST SUMMARY 06110254 +C 06120254 + WRITE (I02,90004) 06130254 + WRITE (I02,90014) 06140254 + WRITE (I02,90004) 06150254 + WRITE (I02,90000) 06160254 + WRITE (I02,90004) 06170254 + WRITE (I02,90020) IVFAIL 06180254 + WRITE (I02,90022) IVPASS 06190254 + WRITE (I02,90024) IVDELE 06200254 + STOP 06210254 +90001 FORMAT (" ",24X,"FM254") 06220254 +90000 FORMAT (" ",20X,"END OF PROGRAM FM254" ) 06230254 +C 06240254 +C FORMATS FOR TEST DETAIL LINES 06250254 +C 06260254 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 06270254 +80002 FORMAT (" ",4X,I5,7X,"PASS") 06280254 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 06290254 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 06300254 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 06310254 +C 06320254 +C FORMAT STATEMENTS FOR PAGE HEADERS 06330254 +C 06340254 +90002 FORMAT ("1") 06350254 +90004 FORMAT (" ") 06360254 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06370254 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 06380254 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 06390254 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 06400254 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 06410254 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 06420254 +C 06430254 +C FORMAT STATEMENTS FOR RUN SUMMARY 06440254 +C 06450254 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 06460254 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 06470254 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 06480254 + END 06490254 diff --git a/Fortran/UnitTests/fcvs21_f95/FM254.reference_output b/Fortran/UnitTests/fcvs21_f95/FM254.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM254.reference_output @@ -0,0 +1,33 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM254 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ---------------------------------------------- + + END OF PROGRAM FM254 + + 0 TESTS FAILED + 12 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM256.f b/Fortran/UnitTests/fcvs21_f95/FM256.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM256.f @@ -0,0 +1,830 @@ + PROGRAM FM256 00010256 +C 00020256 +C 00030256 +C 00040256 +C THIS ROUTINE IS A TEST OF THE DO STATEMENT. THE DO IS TESTED 00050256 +C BOTH OUTSIDE AND INSIDE THE BLOCK-IF STRUCTURE. TESTS ARE MADE OF00060256 +C THE DO-VARIABLE WHEN THE DO BECOMES INACTIVE. OTHER TESTS CHECK 00070256 +C LOOP AND INCREMENTATION PROCESSING. THE DO-LOOP EXECUTION 00080256 +C IS TESTED FOR THOSE CONDITIONS WHICH MAKE THE DO-LOOP INACTIVE. 00090256 +C 00100256 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110256 +C X3.9-1978 00120256 +C SECTION 11.10, DO STATEMENT 00130256 +C SECTION 11.10.1, RANGE OF A DO-LOOP 00140256 +C SECTION 11.10.2, ACTIVE AND INACTIVE DO-LOOPS 00150256 +C SECTION 11.10.3, EXECUTING A DO STATEMENT 00160256 +C SECTION 11.10.4, LOOP CONTROL PROCESSING 00170256 +C SECTION 11.10.5, EXECUTION OF THE RANGE 00180256 +C SECTION 11.10.6, TERMINAL STATEMENT EXECUTION 00190256 +C SECTION 11.10.7, INCREMENTATION PROCESSING 00200256 +C 00210256 +C FM012 - TESTS THE DO STATEMENT WITH THE FORTRAN 66 CONCEPTS OF 00220256 +C EXTENDED RANGE OF A DO STATEMENT. 00230256 +C 00240256 +C 00250256 +C 00260256 +C ******************************************************************00270256 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00280256 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00290256 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00300256 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00310256 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00320256 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00330256 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00340256 +C THE RESULT OF EXECUTING THESE TESTS. 00350256 +C 00360256 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00370256 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00380256 +C 00390256 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00400256 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00410256 +C SOFTWARE STANDARDS VALIDATION GROUP 00420256 +C BUILDING 225 RM A266 00430256 +C GAITHERSBURG, MD 20899 00440256 +C ******************************************************************00450256 +C 00460256 +C 00470256 + IMPLICIT LOGICAL (L) 00480256 + IMPLICIT CHARACTER*14 (C) 00490256 +C 00500256 +C 00510256 +C 00520256 +C INITIALIZATION SECTION. 00530256 +C 00540256 +C INITIALIZE CONSTANTS 00550256 +C ******************** 00560256 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00570256 + I01 = 5 00580256 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00590256 + I02 = 6 00600256 +C SYSTEM ENVIRONMENT SECTION 00610256 +C 00620256 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00630256 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00640256 +C (UNIT NUMBER FOR CARD READER). 00650256 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00660256 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00670256 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00680256 +C 00690256 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00700256 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00710256 +C (UNIT NUMBER FOR PRINTER). 00720256 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00730256 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00740256 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00750256 +C 00760256 + IVPASS = 0 00770256 + IVFAIL = 0 00780256 + IVDELE = 0 00790256 + ICZERO = 0 00800256 +C 00810256 +C WRITE OUT PAGE HEADERS 00820256 +C 00830256 + WRITE (I02,90002) 00840256 + WRITE (I02,90006) 00850256 + WRITE (I02,90008) 00860256 + WRITE (I02,90004) 00870256 + WRITE (I02,90010) 00880256 + WRITE (I02,90004) 00890256 + WRITE (I02,90016) 00900256 + WRITE (I02,90001) 00910256 + WRITE (I02,90004) 00920256 + WRITE (I02,90012) 00930256 + WRITE (I02,90014) 00940256 + WRITE (I02,90004) 00950256 +C 00960256 +C 00970256 +C **** FCVS PROGRAM 256 - TEST 001 **** 00980256 +C 00990256 +C TEST 001 CHECKS THE SIMPLE DO STATEMENT WITH THE OPTIONAL 01000256 +C COMMAS AND ALL DO PARAMETERS SPECIFIED. THE LOOP IS ACTIVE FOR 01010256 +C TEN COUNTS. THE FINAL VALUE OF THE INTEGER COUNTER SHOULD BE 01020256 +C EQUAL TO TEN (10). THE FORM OF THE DO STATEMENT USED IN THIS TEST01030256 +C IS SHOWN BELOW - 01040256 +C 01050256 +C DO S, I = E1, E2, E3 01060256 +C 01070256 +C 01080256 + IVTNUM = 1 01090256 + IF (ICZERO) 30010, 0010, 30010 01100256 + 0010 CONTINUE 01110256 + IVCOMP = 0 01120256 + DO 0012, IVON01 = 1, 10, 1 01130256 + IVCOMP = IVCOMP + 1 01140256 + 0012 CONTINUE 01150256 + IVCORR = 10 01160256 +40010 IF ( IVCOMP - 10 ) 20010, 10010, 20010 01170256 +30010 IVDELE = IVDELE + 1 01180256 + WRITE (I02,80000) IVTNUM 01190256 + IF (ICZERO) 10010, 0021, 20010 01200256 +10010 IVPASS = IVPASS + 1 01210256 + WRITE (I02,80002) IVTNUM 01220256 + GO TO 0021 01230256 +20010 IVFAIL = IVFAIL + 1 01240256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01250256 + 0021 CONTINUE 01260256 +C 01270256 +C **** FCVS PROGRAM 256 - TEST 002 **** 01280256 +C 01290256 +C TEST 002 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THAT THE COMMAS01300256 +C THAT ARE OPTIONAL HAVE BEEN DELETED AS A SYNTAX CHECK. 01310256 +C 01320256 +C THE INCREMENTATION PARAMETER IS OPTIONAL AND NOT PRESENT IN 01330256 +C THIS TEST. ACCORDING TO SECTION 11.10.3, IF E3 DOES NOT APPEAR01340256 +C THEN M3 HAS A VALUE OF ONE. THE DO STATEMENT FOR THIS TEST IS OF 01350256 +C THE FORM SHOWN BELOW - 01360256 +C 01370256 +C DO S I = E1, E2 01380256 +C 01390256 +C 01400256 + IVTNUM = 2 01410256 + IF (ICZERO) 30020, 0020, 30020 01420256 + 0020 CONTINUE 01430256 + IVCOMP = 0 01440256 + DO 0022 IVON01 = 1, 10 01450256 + IVCOMP = IVCOMP + 1 01460256 + 0022 CONTINUE 01470256 + IVCORR = 10 01480256 +40020 IF ( IVCOMP - 10 ) 20020, 10020, 20020 01490256 +30020 IVDELE = IVDELE + 1 01500256 + WRITE (I02,80000) IVTNUM 01510256 + IF (ICZERO) 10020, 0031, 20020 01520256 +10020 IVPASS = IVPASS + 1 01530256 + WRITE (I02,80002) IVTNUM 01540256 + GO TO 0031 01550256 +20020 IVFAIL = IVFAIL + 1 01560256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01570256 + 0031 CONTINUE 01580256 +C 01590256 +C **** FCVS PROGRAM 256 - TEST 003 **** 01600256 +C 01610256 +C TEST 003 HAS A DO STATEMENT INSIDE A BLOCKED IF STRUCTURE. 01620256 +C THE LOGICAL EXPRESSION IS TRUE SO THE DO-LOOP SHOULD BE EXECUTED 01630256 +C A TOTAL OF TEN TIMES. 01640256 +C 01650256 +C 01660256 + IVTNUM = 3 01670256 + IF (ICZERO) 30030, 0030, 30030 01680256 + 0030 CONTINUE 01690256 + IVCOMP = 0 01700256 + LVON01 = .TRUE. 01710256 + IF ( LVON01 ) THEN 01720256 + DO 0032, IVON01 = 1, 10, 1 01730256 + IVCOMP = IVCOMP + 1 01740256 + 0032 CONTINUE 01750256 + END IF 01760256 + IVCORR = 10 01770256 +40030 IF ( IVCOMP - 10 ) 20030, 10030, 20030 01780256 +30030 IVDELE = IVDELE + 1 01790256 + WRITE (I02,80000) IVTNUM 01800256 + IF (ICZERO) 10030, 0041, 20030 01810256 +10030 IVPASS = IVPASS + 1 01820256 + WRITE (I02,80002) IVTNUM 01830256 + GO TO 0041 01840256 +20030 IVFAIL = IVFAIL + 1 01850256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01860256 + 0041 CONTINUE 01870256 +C 01880256 +C **** FCVS PROGRAM 256 - TEST 004 **** 01890256 +C 01900256 +C TEST 004 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THAT THE DO 01910256 +C STATEMENT IS LOCATED IN AN ELSE IF-BLOCK. THE DO-LOOP SHOULD BE 01920256 +C EXECUTED FIVE (5) TIMES. 01930256 +C 01940256 +C 01950256 + IVTNUM = 4 01960256 + IF (ICZERO) 30040, 0040, 30040 01970256 + 0040 CONTINUE 01980256 + IVCOMP = 0 01990256 + LVON01 = .FALSE. 02000256 + LVON02 = .TRUE. 02010256 + IF ( LVON01 ) THEN 02020256 + IVCOMP = 32000 02030256 + ELSE IF ( LVON02 ) THEN 02040256 + DO 0042 IVON01 = 1, 5 02050256 + IVCOMP = IVCOMP + 1 02060256 + 0042 CONTINUE 02070256 + END IF 02080256 + IVCORR = 5 02090256 +40040 IF ( IVCOMP - 5 ) 20040, 10040, 20040 02100256 +30040 IVDELE = IVDELE + 1 02110256 + WRITE (I02,80000) IVTNUM 02120256 + IF (ICZERO) 10040, 0051, 20040 02130256 +10040 IVPASS = IVPASS + 1 02140256 + WRITE (I02,80002) IVTNUM 02150256 + GO TO 0051 02160256 +20040 IVFAIL = IVFAIL + 1 02170256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02180256 + 0051 CONTINUE 02190256 +C 02200256 +C **** FCVS PROGRAM 256 - TEST 005 **** 02210256 +C 02220256 +C TEST 005 IS SIMILAR TO THE PREVIOUS TWO TESTS EXCEPT THAT THE 02230256 +C DO STATEMENT IS CONTAINED IN AN ELSE-BLOCK. THE DO-LOOP SHOULD BE02240256 +C EXECUTED A TOTAL OF 3 TIMES. 02250256 +C 02260256 +C 02270256 + IVTNUM = 5 02280256 + IF (ICZERO) 30050, 0050, 30050 02290256 + 0050 CONTINUE 02300256 + IVCOMP = 0 02310256 + LVON01 = .FALSE. 02320256 + LVON02 = .FALSE. 02330256 + IF ( LVON01 ) THEN 02340256 + IVCOMP = 100 02350256 + ELSE IF ( LVON02 ) THEN 02360256 + IVCOMP = 1000 02370256 + ELSE 02380256 + DO 0052, IVON01 = 1, 3 02390256 + IVCOMP = IVCOMP + 1 02400256 + 0052 CONTINUE 02410256 + END IF 02420256 + IVCORR = 3 02430256 +40050 IF ( IVCOMP - 3 ) 20050, 10050, 20050 02440256 +30050 IVDELE = IVDELE + 1 02450256 + WRITE (I02,80000) IVTNUM 02460256 + IF (ICZERO) 10050, 0061, 20050 02470256 +10050 IVPASS = IVPASS + 1 02480256 + WRITE (I02,80002) IVTNUM 02490256 + GO TO 0061 02500256 +20050 IVFAIL = IVFAIL + 1 02510256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02520256 + 0061 CONTINUE 02530256 +C 02540256 +C **** FCVS PROGRAM 256 - TEST 006 **** 02550256 +C 02560256 +C TEST 006 HAS A BLOCKED IF STRUCTURE INSIDE A DO-LOOP. 02570256 +C THE LOOP IS EXECUTED THREE (3) TIMES. ALL THREE PARTS OF THE 02580256 +C BLOCK-IF STRUCTURE SHOULD BE EXECUTED. 02590256 +C 02600256 +C 02610256 + IVTNUM = 6 02620256 + IF (ICZERO) 30060, 0060, 30060 02630256 + 0060 CONTINUE 02640256 + IVCOMP = 1 02650256 + DO 0062, IVON01 = 3, 5, 1 02660256 + IF ( IVON01 .LE. 3 ) THEN 02670256 + IVCOMP = IVCOMP * 2 02680256 + ELSE IF ( IVON01 .GT. 3 .AND. IVON01 .LT. 5 ) THEN 02690256 + IVCOMP = IVCOMP * 3 02700256 + ELSE 02710256 + IVCOMP = IVCOMP * 5 02720256 + END IF 02730256 + 0062 CONTINUE 02740256 +C 02750256 +C **** IVCOMP IS DETERMINED BY IVCOMP = 30 = 1 * 2 * 3 * 5 ****02760256 +C 02770256 + IVCORR = 30 02780256 +40060 IF ( IVCOMP - 30 ) 20060, 10060, 20060 02790256 +30060 IVDELE = IVDELE + 1 02800256 + WRITE (I02,80000) IVTNUM 02810256 + IF (ICZERO) 10060, 0071, 20060 02820256 +10060 IVPASS = IVPASS + 1 02830256 + WRITE (I02,80002) IVTNUM 02840256 + GO TO 0071 02850256 +20060 IVFAIL = IVFAIL + 1 02860256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02870256 + 0071 CONTINUE 02880256 +C 02890256 +C 02900256 +C THE FOLLOWING SERIES OF TESTS CHECK THE DO-VARIABLE WHEN THE 02910256 +C DO-LOOP BECOMES INACTIVE. ACCORDING TO SECTION 11.10.2, WHEN A 02920256 +C DO-LOOP BECOMES INACTIVE, THE DO-VARIABLE OF THE DO-LOOP RETAINS 02930256 +C ITS LAST DEFINED VALUE. 02940256 +C 02950256 +C 02960256 +C 02970256 +C **** FCVS PROGRAM 256 - TEST 007 **** 02980256 +C 02990256 +C TEST 007 CHECKS THAT THE DO-VARIABLE CONTAINS ITS LAST DEFINED 03000256 +C VALUE WHEN THE ITERATION COUNT IS ZERO. 03010256 +C 03020256 +C 03030256 + IVTNUM = 7 03040256 + IF (ICZERO) 30070, 0070, 30070 03050256 + 0070 CONTINUE 03060256 + IVCOMP = 0 03070256 + IVON02 = 0 03080256 + DO 0072 IVON01 = 100, 105, 2 03090256 + IVON02 = IVON02 + 1 03100256 + 0072 CONTINUE 03110256 + IVCOMP = IVON01 03120256 + IVCORR = 106 03130256 +40070 IF ( IVCOMP - 106 ) 20070, 10070, 20070 03140256 +30070 IVDELE = IVDELE + 1 03150256 + WRITE (I02,80000) IVTNUM 03160256 + IF (ICZERO) 10070, 0081, 20070 03170256 +10070 IVPASS = IVPASS + 1 03180256 + WRITE (I02,80002) IVTNUM 03190256 + GO TO 0081 03200256 +20070 IVFAIL = IVFAIL + 1 03210256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03220256 + 0081 CONTINUE 03230256 +C 03240256 +C **** FCVS PROGRAM 256 - TEST 008 **** 03250256 +C 03260256 +C TEST 008 CHECKS THAT THE LOOP COUNTER IN THE PREVIOUS TEST HAD 03270256 +C A VALUE OF THREE TO SHOW THAT THE DO-LOOP WAS EXECUTED THREE TIMES03280256 +C BEFORE TERMINATING ( BECOMMING INACTIVE ). 03290256 +C 03300256 +C 03310256 + IVTNUM = 8 03320256 + IF (ICZERO) 30080, 0080, 30080 03330256 + 0080 CONTINUE 03340256 + IVCOMP = 0 03350256 + IVCOMP = IVON02 03360256 + IVCORR = 3 03370256 +40080 IF ( IVCOMP - 3 ) 20080, 10080, 20080 03380256 +30080 IVDELE = IVDELE + 1 03390256 + WRITE (I02,80000) IVTNUM 03400256 + IF (ICZERO) 10080, 0091, 20080 03410256 +10080 IVPASS = IVPASS + 1 03420256 + WRITE (I02,80002) IVTNUM 03430256 + GO TO 0091 03440256 +20080 IVFAIL = IVFAIL + 1 03450256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03460256 + 0091 CONTINUE 03470256 +C 03480256 +C **** FCVS PROGRAM 256 - TEST 009 **** 03490256 +C 03500256 +C TEST 009 CHECKS THAT A DO-LOOP BECOMES INACTIVE IF THERE IS A 03510256 +C TRANSFER OF CONTROL OUTSIDE THE RANGE OF THE DO-LOOP. THE TRANS- 03520256 +C FER MUST BE INSIDE OF THE SAME PROGRAM UNIT - NOT A CALL OR 03530256 +C FUNCTION REFERENCE TO A SUBPROGRAM. 03540256 +C 03550256 +C THIS IS A SIGNIFICANT DIFFERENCE BETWEEN FORTRAN 66 AND FORTRAN03560256 +C 77. FORTRAN 66 HAD AN EXTENDED RANGE OF THE DO FEATURE WHICH 03570256 +C ALLOWED FOR A TRANSFER OUTSIDE THE RANGE OF A DO-LOOP WITHOUT 03580256 +C MAKING THE DO-LOOP INACTIVE. 03590256 +C 03600256 +C 03610256 + IVTNUM = 9 03620256 + IF (ICZERO) 30090, 0090, 30090 03630256 + 0090 CONTINUE 03640256 + IVCOMP = 0 03650256 + DO 0092 IVON01 = 1, 7 03660256 + IF ( IVON01 .GE. 3 ) GO TO 0093 03670256 + 0092 CONTINUE 03680256 + 0093 IVCOMP = IVON01 03690256 + IVCORR = 3 03700256 +40090 IF ( IVCOMP - 3 ) 20090, 10090, 20090 03710256 +30090 IVDELE = IVDELE + 1 03720256 + WRITE (I02,80000) IVTNUM 03730256 + IF (ICZERO) 10090, 0101, 20090 03740256 +10090 IVPASS = IVPASS + 1 03750256 + WRITE (I02,80002) IVTNUM 03760256 + GO TO 0101 03770256 +20090 IVFAIL = IVFAIL + 1 03780256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03790256 + 0101 CONTINUE 03800256 +C 03810256 +C **** FCVS PROGRAM 256 - TEST 010 **** 03820256 +C 03830256 +C TEST 010 CHECKS FOR AN INITIAL COUNT EQUAL TO ZERO BECAUSE 03840256 +C M1 IS GREATER THAN M2 AND M3 IS GREATER THAN ZERO - SEE SECTION 03850256 +C 11.10.3 FOR CONDITIONS WHICH MAKE THE ITERATION COUNT ZERO. 03860256 +C THE LOOP SHOULD NOT BE EXECUTED AT ALL. 03870256 +C 03880256 +C 03890256 + IVTNUM = 10 03900256 + IF (ICZERO) 30100, 0100, 30100 03910256 + 0100 CONTINUE 03920256 + IVCOMP = 0 03930256 + DO 0102, IVON01 = 100, 10, 3 03940256 + IVCOMP = IVCOMP + 1 03950256 + 0102 CONTINUE 03960256 + IVCORR = 0 03970256 +40100 IF ( IVCOMP ) 20100, 10100, 20100 03980256 +30100 IVDELE = IVDELE + 1 03990256 + WRITE (I02,80000) IVTNUM 04000256 + IF (ICZERO) 10100, 0111, 20100 04010256 +10100 IVPASS = IVPASS + 1 04020256 + WRITE (I02,80002) IVTNUM 04030256 + GO TO 0111 04040256 +20100 IVFAIL = IVFAIL + 1 04050256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04060256 + 0111 CONTINUE 04070256 +C 04080256 +C **** FCVS PROGRAM 256 - TEST 011 **** 04090256 +C 04100256 +C TEST 011 CHECKS FOR THE PROPER EXECUTION OF THE STEPS AS SHOWN 04110256 +C IN SECTION 11.10.3 - EXECUTING A DO STATEMENT. THE VARIABLE IVON004120256 +C SHOULD HAVE BEEN SET TO 100. THE ITERATION COUNT IS ZERO BY THE 04130256 +C FORMULA IN 11.10.3(3). AS DESCRIBED IN SECTION 11.10.4 - THE 04140256 +C ITERATION COUNT IS TESTED. IF IT IS NOT ZERO, EXECUTION OF THE 04150256 +C FIRST STATEMENT IN THE RANGE OF THE DO-LOOP BEGINS. IF THE 04160256 +C ITERATION COUNT IS ZERO, THE DO-LOOP BECOMES INACTIVE. 04170256 +C 04180256 +C 04190256 + IVTNUM = 11 04200256 + IF (ICZERO) 30110, 0110, 30110 04210256 + 0110 CONTINUE 04220256 + IVCOMP = 0 04230256 + IVCOMP = IVON01 04240256 + IVCORR = 100 04250256 +40110 IF ( IVCOMP - 100 ) 20110, 10110, 20110 04260256 +30110 IVDELE = IVDELE + 1 04270256 + WRITE (I02,80000) IVTNUM 04280256 + IF (ICZERO) 10110, 0121, 20110 04290256 +10110 IVPASS = IVPASS + 1 04300256 + WRITE (I02,80002) IVTNUM 04310256 + GO TO 0121 04320256 +20110 IVFAIL = IVFAIL + 1 04330256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04340256 + 0121 CONTINUE 04350256 +C 04360256 +C 04370256 +C THE FOLLOWING TWO TESTS ARE SIMILAR TO THE PREVIOUS TWO TESTS 04380256 +C IN THAT THE PARAMETERS OF THE DO STATEMENT MAKE THE ITERATION 04390256 +C COUNT ZERO WHEN THE DO STATEMENT IS EXECUTED. 04400256 +C 04410256 +C 04420256 +C 04430256 +C **** FCVS PROGRAM 256 - TEST 012 **** 04440256 +C 04450256 +C TEST 012 HAS M1 LESS THAN M2, BUT M3 IS NEGATIVE. THE LOOP 04460256 +C SHOULD NOT BE EXECUTED AT ALL. 04470256 +C 04480256 +C 04490256 + IVTNUM = 12 04500256 + IF (ICZERO) 30120, 0120, 30120 04510256 + 0120 CONTINUE 04520256 + IVCOMP = 0 04530256 + DO 0122 IVON01 = 10, 100, -3 04540256 + IVCOMP = IVCOMP + 1 04550256 + 0122 CONTINUE 04560256 + IVCORR = 0 04570256 +40120 IF ( IVCOMP ) 20120, 10120, 20120 04580256 +30120 IVDELE = IVDELE + 1 04590256 + WRITE (I02,80000) IVTNUM 04600256 + IF (ICZERO) 10120, 0131, 20120 04610256 +10120 IVPASS = IVPASS + 1 04620256 + WRITE (I02,80002) IVTNUM 04630256 + GO TO 0131 04640256 +20120 IVFAIL = IVFAIL + 1 04650256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04660256 + 0131 CONTINUE 04670256 +C 04680256 +C **** FCVS PROGRAM 256 - TEST 013 **** 04690256 +C 04700256 +C TEST 013 CHECKS THAT THE VALUE RETAINED FOR THE DO-VARIABLE 04710256 +C IN THE PREVIOUS TEST IS EQUAL TO THE INITIAL PARAMETER VALUE - M3.04720256 +C 04730256 +C 04740256 + IVTNUM = 13 04750256 + IF (ICZERO) 30130, 0130, 30130 04760256 + 0130 CONTINUE 04770256 + IVCOMP = 0 04780256 + IVCOMP = IVON01 04790256 + IVCORR = 10 04800256 +40130 IF ( IVCOMP - 10 ) 20130, 10130, 20130 04810256 +30130 IVDELE = IVDELE + 1 04820256 + WRITE (I02,80000) IVTNUM 04830256 + IF (ICZERO) 10130, 0141, 20130 04840256 +10130 IVPASS = IVPASS + 1 04850256 + WRITE (I02,80002) IVTNUM 04860256 + GO TO 0141 04870256 +20130 IVFAIL = IVFAIL + 1 04880256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04890256 + 0141 CONTINUE 04900256 +C 04910256 +C **** FCVS PROGRAM 256 - TEST 014 **** 04920256 +C 04930256 +C TEST 014 CHECKS FOR ONE EXECUTION OF THE RANGE OF A DO-LOOP 04940256 +C ACCORDING TO THE FORMULA SHOWN IN 11.10.3(3) WITH M1 = M2. 04950256 +C 04960256 +C THE DO-LOOPS IN THIS TEST ARE A NEST OF THREE EACH WITH ITS 04970256 +C OWN TERMINAL STATEMENT. 04980256 +C 04990256 +C 05000256 + IVTNUM = 14 05010256 + IF (ICZERO) 30140, 0140, 30140 05020256 + 0140 CONTINUE 05030256 + IVCOMP = 1 05040256 + DO 0144 IVON01 = 1, 1, 1 05050256 + IVCOMP = IVCOMP * 2 05060256 + DO 0143 IVON02 = 10,10,10 05070256 + IVCOMP = IVCOMP * 3 05080256 + DO 0142, IVON03 = 100, 100, -2 05090256 + IVCOMP = IVCOMP * 5 05100256 + 0142 CONTINUE 05110256 + 0143 CONTINUE 05120256 + 0144 CONTINUE 05130256 +C 05140256 +C **** IVCOMP IS DETERMINED BY IVCOMP = 30 = 1 * 2 * 3 * 5 ***05150256 +C 05160256 + IVCORR = 30 05170256 +40140 IF ( IVCOMP - 30 ) 20140, 10140, 20140 05180256 +30140 IVDELE = IVDELE + 1 05190256 + WRITE (I02,80000) IVTNUM 05200256 + IF (ICZERO) 10140, 0151, 20140 05210256 +10140 IVPASS = IVPASS + 1 05220256 + WRITE (I02,80002) IVTNUM 05230256 + GO TO 0151 05240256 +20140 IVFAIL = IVFAIL + 1 05250256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05260256 + 0151 CONTINUE 05270256 +C 05280256 +C **** FCVS PROGRAM 256 - TEST 015 **** 05290256 +C 05300256 +C TEST 015 IS A CHECK ON THE FIRST EXAMPLE SHOWN IN SECTION 05310256 +C 11.10.7. THIS IS A TEST OF INCREMENTATION PROCESSING OF TWO NEST 05320256 +C DO-LOOPS HAVING THE SAME TERMINAL STATEMENT. 05330256 +C 05340256 +C THIS IS A TEST OF A DO-LOOP THAT BECOMES ACTIVE INSIDE AN 05350256 +C ALREADY ACTIVE DO-LOOP. 05360256 +C 05370256 +C 05380256 + IVTNUM = 15 05390256 + IF (ICZERO) 30150, 0150, 30150 05400256 + 0150 CONTINUE 05410256 + IVCOMP = 0 05420256 + IVON01 = 0 05430256 + DO 0152 IVON02 = 1, 10 05440256 + IVON03 = IVON02 05450256 + DO 0152 IVON04 = 1, 5 05460256 + IVON05 = IVON04 05470256 + 0152 IVON01 = IVON01 + 1 05480256 + 0153 CONTINUE 05490256 + IVCOMP = IVON02 05500256 +C THIS IS THE VALUE FOR I IN THE EXAMPLE. 05510256 + IVCORR = 11 05520256 +40150 IF ( IVCOMP - 11 ) 20150, 10150, 20150 05530256 +30150 IVDELE = IVDELE + 1 05540256 + WRITE (I02,80000) IVTNUM 05550256 + IF (ICZERO) 10150, 0161, 20150 05560256 +10150 IVPASS = IVPASS + 1 05570256 + WRITE (I02,80002) IVTNUM 05580256 + GO TO 0161 05590256 +20150 IVFAIL = IVFAIL + 1 05600256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05610256 + 0161 CONTINUE 05620256 +C 05630256 +C **** FCVS PROGRAM 256 - TEST 016 **** 05640256 +C 05650256 +C TEST 016 CHECKS THE VALUE OF J (IVON03) IN THE FIRST EXAMPLE. 05660256 +C 05670256 +C 05680256 + IVTNUM = 16 05690256 + IF (ICZERO) 30160, 0160, 30160 05700256 + 0160 CONTINUE 05710256 + IVCOMP = 0 05720256 + IVCOMP = IVON03 05730256 + IVCORR = 10 05740256 +40160 IF ( IVCOMP - 10 ) 20160, 10160, 20160 05750256 +30160 IVDELE = IVDELE + 1 05760256 + WRITE (I02,80000) IVTNUM 05770256 + IF (ICZERO) 10160, 0171, 20160 05780256 +10160 IVPASS = IVPASS + 1 05790256 + WRITE (I02,80002) IVTNUM 05800256 + GO TO 0171 05810256 +20160 IVFAIL = IVFAIL + 1 05820256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05830256 + 0171 CONTINUE 05840256 +C 05850256 +C **** FCVS PROGRAM 256 - TEST 017 **** 05860256 +C 05870256 +C TEST 017 CHECKS THE VALUE OF K (IVON04) IN THE FIRST EXAMPLE. 05880256 +C 05890256 +C 05900256 + IVTNUM = 17 05910256 + IF (ICZERO) 30170, 0170, 30170 05920256 + 0170 CONTINUE 05930256 + IVCOMP = 0 05940256 + IVCOMP = IVON04 05950256 + IVCORR = 6 05960256 +40170 IF ( IVCOMP - 6 ) 20170, 10170, 20170 05970256 +30170 IVDELE = IVDELE + 1 05980256 + WRITE (I02,80000) IVTNUM 05990256 + IF (ICZERO) 10170, 0181, 20170 06000256 +10170 IVPASS = IVPASS + 1 06010256 + WRITE (I02,80002) IVTNUM 06020256 + GO TO 0181 06030256 +20170 IVFAIL = IVFAIL + 1 06040256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06050256 + 0181 CONTINUE 06060256 +C 06070256 +C **** FCVS PROGRAM 256 - TEST 018 **** 06080256 +C 06090256 +C TEST 018 CHECKS THE VALUE OF L (IVON05) IN THE FIRST EXAMPLE. 06100256 +C 06110256 +C 06120256 + IVTNUM = 18 06130256 + IF (ICZERO) 30180, 0180, 30180 06140256 + 0180 CONTINUE 06150256 + IVCOMP = 0 06160256 + IVCOMP = IVON05 06170256 + IVCORR = 5 06180256 +40180 IF ( IVCOMP - 5 ) 20180, 10180, 20180 06190256 +30180 IVDELE = IVDELE + 1 06200256 + WRITE (I02,80000) IVTNUM 06210256 + IF (ICZERO) 10180, 0191, 20180 06220256 +10180 IVPASS = IVPASS + 1 06230256 + WRITE (I02,80002) IVTNUM 06240256 + GO TO 0191 06250256 +20180 IVFAIL = IVFAIL + 1 06260256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06270256 + 0191 CONTINUE 06280256 +C 06290256 +C **** FCVS PROGRAM 256 - TEST 019 **** 06300256 +C 06310256 +C TEST 019 CHECKS THE VALUE OF N (IVON01) IN THE FIRST EXAMPLE. 06320256 +C 06330256 +C 06340256 + IVTNUM = 19 06350256 + IF (ICZERO) 30190, 0190, 30190 06360256 + 0190 CONTINUE 06370256 + IVCOMP = 0 06380256 + IVCOMP = IVON01 06390256 + IVCORR = 50 06400256 +40190 IF ( IVCOMP - 50 ) 20190, 10190, 20190 06410256 +30190 IVDELE = IVDELE + 1 06420256 + WRITE (I02,80000) IVTNUM 06430256 + IF (ICZERO) 10190, 0201, 20190 06440256 +10190 IVPASS = IVPASS + 1 06450256 + WRITE (I02,80002) IVTNUM 06460256 + GO TO 0201 06470256 +20190 IVFAIL = IVFAIL + 1 06480256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06490256 + 0201 CONTINUE 06500256 +C 06510256 +C **** FCVS PROGRAM 256 - TEST 020 **** 06520256 +C 06530256 +C TEST 020 IS A CHECK ON THE SECOND EXAMPLE IN SECTION 11.10.7. 06540256 +C IN THIS EXAMPLE, THE INNER DO-LOOP BECOMES ACTIVE AND THEN 06550256 +C IMMEDIATELY INACTIVE INSIDE AN ALREADY ACTIVE OUTER DO-LOOP. 06560256 +C 06570256 +C ALTHOUGH IN SOME WAYS SIMILAR TO THE FIRST EXAMPLE, THE SECOND 06580256 +C EXAMPLE SHOULD HAVE DIFFERENT FINAL VALUES ON THE INTEGER COUNTERS06590256 +C AND THE VALUE OF L (IVON10) WILL NOT BE TESTED BECAUSE IT IS NOT 06600256 +C DEFINED DURING THE RANGE OF THE DO-LOOP INVOLVED. 06610256 +C 06620256 +C 06630256 + IVTNUM = 20 06640256 + IF (ICZERO) 30200, 0200, 30200 06650256 + 0200 CONTINUE 06660256 + IVCOMP = 0 06670256 + IVON06 = 0 06680256 + DO 0202 IVON07 = 1, 10 06690256 + IVON08 = IVON07 06700256 + DO 0202 IVON09 = 5, 1 06710256 + IVON10 = IVON09 06720256 + 0202 IVON06 = IVON06 + 1 06730256 + 0203 CONTINUE 06740256 + IVCOMP = IVON07 06750256 +C THIS IS THE VALUE FOR I IN THE SECOND EXAMPLE. 06760256 + IVCORR = 11 06770256 +40200 IF ( IVCOMP - 11 ) 20200, 10200, 20200 06780256 +30200 IVDELE = IVDELE + 1 06790256 + WRITE (I02,80000) IVTNUM 06800256 + IF (ICZERO) 10200, 0211, 20200 06810256 +10200 IVPASS = IVPASS + 1 06820256 + WRITE (I02,80002) IVTNUM 06830256 + GO TO 0211 06840256 +20200 IVFAIL = IVFAIL + 1 06850256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06860256 + 0211 CONTINUE 06870256 +C 06880256 +C **** FCVS PROGRAM 256 - TEST 021 **** 06890256 +C 06900256 +C TEST 021 CHECKS THE VALUE OF J (IVON08) IN THE SECOND EXAMPLE. 06910256 +C 06920256 +C 06930256 + IVTNUM = 21 06940256 + IF (ICZERO) 30210, 0210, 30210 06950256 + 0210 CONTINUE 06960256 + IVCOMP = 0 06970256 + IVCOMP = IVON08 06980256 + IVCORR = 10 06990256 +40210 IF ( IVCOMP - 10 ) 20210, 10210, 20210 07000256 +30210 IVDELE = IVDELE + 1 07010256 + WRITE (I02,80000) IVTNUM 07020256 + IF (ICZERO) 10210, 0221, 20210 07030256 +10210 IVPASS = IVPASS + 1 07040256 + WRITE (I02,80002) IVTNUM 07050256 + GO TO 0221 07060256 +20210 IVFAIL = IVFAIL + 1 07070256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07080256 + 0221 CONTINUE 07090256 +C 07100256 +C **** FCVS PROGRAM 256 - TEST 022 **** 07110256 +C 07120256 +C TEST 022 CHECKS THE VALUE OF K (IVON09) IN THE SECOND EXAMPLE. 07130256 +C 07140256 +C 07150256 + IVTNUM = 22 07160256 + IF (ICZERO) 30220, 0220, 30220 07170256 + 0220 CONTINUE 07180256 + IVCOMP = 0 07190256 + IVCOMP = IVON09 07200256 + IVCORR = 5 07210256 +40220 IF ( IVCOMP - 5 ) 20220, 10220, 20220 07220256 +30220 IVDELE = IVDELE + 1 07230256 + WRITE (I02,80000) IVTNUM 07240256 + IF (ICZERO) 10220, 0231, 20220 07250256 +10220 IVPASS = IVPASS + 1 07260256 + WRITE (I02,80002) IVTNUM 07270256 + GO TO 0231 07280256 +20220 IVFAIL = IVFAIL + 1 07290256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07300256 + 0231 CONTINUE 07310256 +C 07320256 +C **** FCVS PROGRAM 256 - TEST 023 **** 07330256 +C 07340256 +C TEST 023 CHECKS THE VALUE OF N (IVON06) IN THE SECOND EXAMPLE. 07350256 +C 07360256 +C 07370256 + IVTNUM = 23 07380256 + IF (ICZERO) 30230, 0230, 30230 07390256 + 0230 CONTINUE 07400256 + IVCOMP = 0 07410256 + IVCOMP = IVON06 07420256 + IVCORR = 0 07430256 +40230 IF ( IVCOMP - 0 ) 20230, 10230, 20230 07440256 +30230 IVDELE = IVDELE + 1 07450256 + WRITE (I02,80000) IVTNUM 07460256 + IF (ICZERO) 10230, 0241, 20230 07470256 +10230 IVPASS = IVPASS + 1 07480256 + WRITE (I02,80002) IVTNUM 07490256 + GO TO 0241 07500256 +20230 IVFAIL = IVFAIL + 1 07510256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07520256 + 0241 CONTINUE 07530256 +C 07540256 +C **** FCVS PROGRAM 256 - TEST 024 **** 07550256 +C 07560256 +C TEST 024 IS A CHECK ON USING A LOGICAL IF STATEMENT AS THE 07570256 +C TERMINAL STATEMENT IN THE RANGE OF A DO-LOOP. THE LOGICAL IF 07580256 +C STATEMENT HAS AN UNCONDITIONAL GO TO STATEMENT AS ITS EXECUTABLE 07590256 +C STATEMENT AS ALLOWED IN SECTION 11.10. 07600256 +C 07610256 +C 07620256 + IVTNUM = 24 07630256 + IF (ICZERO) 30240, 0240, 30240 07640256 + 0240 CONTINUE 07650256 + IVCOMP = 0 07660256 + DO 0242 IVON01 = 1, 10 07670256 + IVCOMP = IVCOMP + 1 07680256 + 0242 IF ( IVON01 .GE. 5 ) GO TO 0243 07690256 +C 07700256 +C 07710256 +C IF THE LOGIC DOES NOT BRANCH OUT OF THE RANGE OF THE DO-LOOP WHEN 07720256 +C THE DO-VARIABLE (IVON01) IS EQUAL TO FIVE (5), THEN IVCOMP WILL BE07730256 +C SET BACK TO THE VALUE OF ZERO. 07740256 +C 07750256 + IVCOMP = 0 07760256 +C 07770256 +C 07780256 + 0243 IVCORR = 5 07790256 +40240 IF ( IVCOMP - 5 ) 20240, 10240, 20240 07800256 +30240 IVDELE = IVDELE + 1 07810256 + WRITE (I02,80000) IVTNUM 07820256 + IF (ICZERO) 10240, 0251, 20240 07830256 +10240 IVPASS = IVPASS + 1 07840256 + WRITE (I02,80002) IVTNUM 07850256 + GO TO 0251 07860256 +20240 IVFAIL = IVFAIL + 1 07870256 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07880256 + 0251 CONTINUE 07890256 +C 07900256 +C 07910256 +C WRITE OUT TEST SUMMARY 07920256 +C 07930256 + WRITE (I02,90004) 07940256 + WRITE (I02,90014) 07950256 + WRITE (I02,90004) 07960256 + WRITE (I02,90000) 07970256 + WRITE (I02,90004) 07980256 + WRITE (I02,90020) IVFAIL 07990256 + WRITE (I02,90022) IVPASS 08000256 + WRITE (I02,90024) IVDELE 08010256 + STOP 08020256 +90001 FORMAT (" ",24X,"FM256") 08030256 +90000 FORMAT (" ",20X,"END OF PROGRAM FM256" ) 08040256 +C 08050256 +C FORMATS FOR TEST DETAIL LINES 08060256 +C 08070256 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 08080256 +80002 FORMAT (" ",4X,I5,7X,"PASS") 08090256 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08100256 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08110256 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 08120256 +C 08130256 +C FORMAT STATEMENTS FOR PAGE HEADERS 08140256 +C 08150256 +90002 FORMAT ("1") 08160256 +90004 FORMAT (" ") 08170256 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08180256 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 08190256 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08200256 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 08210256 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 08220256 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08230256 +C 08240256 +C FORMAT STATEMENTS FOR RUN SUMMARY 08250256 +C 08260256 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 08270256 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 08280256 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 08290256 + END 08300256 diff --git a/Fortran/UnitTests/fcvs21_f95/FM256.reference_output b/Fortran/UnitTests/fcvs21_f95/FM256.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM256.reference_output @@ -0,0 +1,45 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM256 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + + ---------------------------------------------- + + END OF PROGRAM FM256 + + 0 TESTS FAILED + 24 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM258.f b/Fortran/UnitTests/fcvs21_f95/FM258.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM258.f @@ -0,0 +1,321 @@ + PROGRAM FM258 + +C***********************************************************************00010258 +C***** FORTRAN 77 00020258 +C***** FM258 00030258 +C***** BLKIF1 - (300) 00040258 +C***** 00050258 +C***********************************************************************00060258 +C***** GENERAL PURPOSE SUBSET REF 00070258 +C***** TEST BLOCK IF STATEMENTS 11.6 - 11.9 00080258 +C***** SIMPLE TESTS OF IF (E) THEN,ELSE,ELSEIF,ENDIF 00090258 +C***** 00100258 +CBB** ********************** BBCCOMNT **********************************00110258 +C**** 00120258 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130258 +C**** VERSION 2.1 00140258 +C**** 00150258 +C**** 00160258 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170258 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180258 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190258 +C**** BUILDING 225 RM A266 00200258 +C**** GAITHERSBURG, MD 20899 00210258 +C**** 00220258 +C**** 00230258 +C**** 00240258 +CBE** ********************** BBCCOMNT **********************************00250258 +CBB** ********************** BBCINITA **********************************00260258 +C**** SPECIFICATION STATEMENTS 00270258 +C**** 00280258 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290258 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300258 +CBE** ********************** BBCINITA **********************************00310258 +CBB** ********************** BBCINITB **********************************00320258 +C**** INITIALIZE SECTION 00330258 + DATA ZVERS, ZVERSD, ZDATE 00340258 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350258 + DATA ZCOMPL, ZNAME, ZTAPE 00360258 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370258 + DATA ZPROJ, ZTAPED, ZPROG 00380258 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390258 + DATA REMRKS /' '/ 00400258 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410258 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420258 +C**** 00430258 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440258 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450258 +CZ03 ZPROG = 'PROGRAM NAME' 00460258 +CZ04 ZDATE = 'DATE OF TEST' 00470258 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480258 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490258 +CZ07 ZNAME = 'NAME OF USER' 00500258 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510258 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520258 +C 00530258 + IVPASS = 0 00540258 + IVFAIL = 0 00550258 + IVDELE = 0 00560258 + IVINSP = 0 00570258 + IVTOTL = 0 00580258 + IVTOTN = 0 00590258 + ICZERO = 0 00600258 +C 00610258 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620258 + I01 = 05 00630258 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640258 + I02 = 06 00650258 +C 00660258 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670258 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680258 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690258 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700258 +C 00710258 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720258 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730258 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740258 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750258 +C 00760258 +CBE** ********************** BBCINITB **********************************00770258 + NUVI = I02 00780258 + ZPROG='FM258' 00790258 +CBB** ********************** BBCHED0A **********************************00800258 +C**** 00810258 +C**** WRITE REPORT TITLE 00820258 +C**** 00830258 + WRITE (I02, 90002) 00840258 + WRITE (I02, 90006) 00850258 + WRITE (I02, 90007) 00860258 + WRITE (I02, 90008) ZVERS, ZVERSD 00870258 + WRITE (I02, 90009) ZPROG, ZPROG 00880258 + WRITE (I02, 90010) ZDATE, ZCOMPL 00890258 +CBE** ********************** BBCHED0A **********************************00900258 +C***** TOTAL NUMBER OF EXPECTED TEST 00910258 + IVTOTL=8 00920258 +C***** HEADER FOR SEGMENT 300 00930258 + WRITE(NUVI,30000) 00940258 +30000 FORMAT(/1X," BLKIF1 - (300) BLOCK IF - SIMPLE TEST" // 00950258 + 1 " SUBSET REF. 11.6 - 11.9" ) 00960258 +CBB** ********************** BBCHED0B **********************************00970258 +C**** WRITE DETAIL REPORT HEADERS 00980258 +C**** 00990258 + WRITE (I02,90004) 01000258 + WRITE (I02,90004) 01010258 + WRITE (I02,90013) 01020258 + WRITE (I02,90014) 01030258 + WRITE (I02,90015) IVTOTL 01040258 +CBE** ********************** BBCHED0B **********************************01050258 +C***** 01060258 + WRITE (NUVI,30025) 01070258 +CT001* TEST 1 IF (E) THEN .*. ELSE .*. ENDIF 01080258 + IVTNUM = 1 01090258 + IVINSP=IVINSP+1 01100258 + WRITE(NUVI,80004) IVTNUM 01110258 + JVI = 0 01120258 +30001 JVI = JVI + 1 01130258 + IF (JVI .EQ. 2) THEN 01140258 + KVI = 2 01150258 + ELSE 01160258 + KVI = 1 01170258 + ENDIF 01180258 + LVI = JVI - KVI 01190258 + WRITE(NUVI,30018) LVI 01200258 + GOTO(30001,30002), JVI 01210258 +30002 CONTINUE 01220258 +CT002* TEST 2 IF (E) THEN .*. ENDIF 01230258 + IVTNUM = 2 01240258 + IVINSP=IVINSP+1 01250258 + WRITE(NUVI,80004) IVTNUM 01260258 + JVI = 0 01270258 + KVI = 1 01280258 +30003 JVI = JVI + 1 01290258 + IF (JVI .EQ. 2) THEN 01300258 + KVI = 2 01310258 + ENDIF 01320258 + LVI = JVI - KVI 01330258 + WRITE(NUVI,30018) LVI 01340258 + GOTO(30003,30004), JVI 01350258 +30004 CONTINUE 01360258 +CT003* TEST 3 IF (E) THEN ... ELSE .*. ENDIF 01370258 + IVTNUM = 3 01380258 + IVINSP=IVINSP+1 01390258 + WRITE(NUVI,80004) IVTNUM 01400258 + JVI = 0 01410258 + KVI = 1 01420258 +30005 JVI = JVI + 1 01430258 + IF (JVI .EQ. 1) THEN 01440258 + ELSE 01450258 + KVI = 2 01460258 + ENDIF 01470258 + LVI = JVI - KVI 01480258 + WRITE(NUVI,30018) LVI 01490258 + GOTO(30005,30006), JVI 01500258 +30006 CONTINUE 01510258 +CT004* TEST 4 IF (E) THEN .*. ELSEIF .*. ELSE .*. ENDIF 01520258 + IVTNUM = 4 01530258 + IVINSP=IVINSP+1 01540258 + WRITE(NUVI,80004) IVTNUM 01550258 + JVI = 0 01560258 +30007 JVI = JVI + 1 01570258 + IF (JVI .EQ. 1) THEN 01580258 + KVI = 1 01590258 + ELSEIF (JVI .EQ. 2) THEN 01600258 + KVI = 2 01610258 + ELSE 01620258 + KVI = 3 01630258 + ENDIF 01640258 + LVI = JVI - KVI 01650258 + WRITE(NUVI,30018) LVI 01660258 + GOTO(30007,30007,30008), JVI 01670258 +30008 CONTINUE 01680258 +CT005* TEST 5 IF (E) THEN .*. ELSEIF .*. ENDIF 01690258 + IVTNUM = 5 01700258 + IVINSP=IVINSP+1 01710258 + WRITE(NUVI,80004) IVTNUM 01720258 + JVI = 0 01730258 + KVI = 1 01740258 +30009 JVI = JVI + 1 01750258 + IF (JVI .GT. 2) THEN 01760258 + KVI = 3 01770258 + ELSEIF (JVI .EQ. 2) THEN 01780258 + KVI = 2 01790258 + ENDIF 01800258 + LVI = JVI - KVI 01810258 + WRITE(NUVI,30018) LVI 01820258 + GOTO(30009,30009,30010), JVI 01830258 +30010 CONTINUE 01840258 +CT006* TEST 6 IF (E) THEN .*. ELSEIF ... ELSE .*. ENDIF 01850258 + IVTNUM = 6 01860258 + IVINSP=IVINSP+1 01870258 + WRITE(NUVI,80004) IVTNUM 01880258 + JVI = 0 01890258 + KVI = 1 01900258 +30011 JVI = JVI + 1 01910258 + IF ( JVI .GT. 2) THEN 01920258 + KVI = 3 01930258 + ELSEIF (JVI .EQ. 1) THEN 01940258 + ELSE 01950258 + KVI = 2 01960258 + ENDIF 01970258 + LVI = JVI - KVI 01980258 + WRITE(NUVI,30018) LVI 01990258 + GOTO(30011,30011,30012), JVI 02000258 +30012 CONTINUE 02010258 +CT007* TEST 7 IF (E) THEN ... ELSEIF .*. ELSE .*. ENDIF 02020258 + IVTNUM = 7 02030258 + IVINSP=IVINSP+1 02040258 + WRITE(NUVI,80004) IVTNUM 02050258 + JVI = 0 02060258 + KVI = 1 02070258 +30013 JVI = JVI + 1 02080258 + IF (JVI .EQ. 1) THEN 02090258 + ELSEIF (JVI .LT. 3) THEN 02100258 + KVI = 2 02110258 + ELSE 02120258 + KVI = 3 02130258 + ENDIF 02140258 + LVI = JVI - KVI 02150258 + WRITE(NUVI,30018) LVI 02160258 + GOTO(30013,30013,30014), JVI 02170258 +30014 CONTINUE 02180258 +CT008* TEST 8 IF (E) THEN .*. ELSEIF .*. ELSEIF .*. ENDIF 02190258 + IVTNUM = 8 02200258 + IVINSP=IVINSP+1 02210258 + WRITE(NUVI,80004) IVTNUM 02220258 + JVI = 0 02230258 +30015 JVI = JVI + 1 02240258 + KVI = 4 02250258 + IF ( JVI .EQ. 1) THEN 02260258 + KVI = 1 02270258 + ELSEIF (JVI .EQ. 2) THEN 02280258 + KVI = 2 02290258 + ELSEIF (JVI .LT. 4) THEN 02300258 + KVI = 3 02310258 + ENDIF 02320258 + LVI = JVI - KVI 02330258 + WRITE(NUVI,30018) LVI 02340258 + GOTO(30015,30015,30015,30016), JVI 02350258 +C***** 02360258 +30016 CONTINUE 02370258 +C***** 02380258 +CBB** ********************** BBCSUM0 **********************************02390258 +C**** WRITE OUT TEST SUMMARY 02400258 +C**** 02410258 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02420258 + WRITE (I02, 90004) 02430258 + WRITE (I02, 90014) 02440258 + WRITE (I02, 90004) 02450258 + WRITE (I02, 90020) IVPASS 02460258 + WRITE (I02, 90022) IVFAIL 02470258 + WRITE (I02, 90024) IVDELE 02480258 + WRITE (I02, 90026) IVINSP 02490258 + WRITE (I02, 90028) IVTOTN, IVTOTL 02500258 +CBE** ********************** BBCSUM0 **********************************02510258 +CBB** ********************** BBCFOOT0 **********************************02520258 +C**** WRITE OUT REPORT FOOTINGS 02530258 +C**** 02540258 + WRITE (I02,90016) ZPROG, ZPROG 02550258 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02560258 + WRITE (I02,90019) 02570258 +CBE** ********************** BBCFOOT0 **********************************02580258 +CBB** ********************** BBCFMT0A **********************************02590258 +C**** FORMATS FOR TEST DETAIL LINES 02600258 +C**** 02610258 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02620258 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02630258 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02640258 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02650258 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02660258 + 1I6,/," ",15X,"CORRECT= " ,I6) 02670258 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02680258 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02690258 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02700258 + 1A21,/," ",16X,"CORRECT= " ,A21) 02710258 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02720258 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02730258 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02740258 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02750258 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02760258 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02770258 +80050 FORMAT (" ",48X,A31) 02780258 +CBE** ********************** BBCFMT0A **********************************02790258 +CBB** ********************** BBCFMT0B **********************************02800258 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02810258 +C**** 02820258 +90002 FORMAT ("1") 02830258 +90004 FORMAT (" ") 02840258 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02850258 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02860258 +90008 FORMAT (" ",21X,A13,A17) 02870258 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02880258 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02890258 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02900258 + 1 7X,"REMARKS",24X) 02910258 +90014 FORMAT (" ","----------------------------------------------" , 02920258 + 1 "---------------------------------" ) 02930258 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02940258 +C**** 02950258 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02960258 +C**** 02970258 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02980258 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02990258 + 1 A13) 03000258 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03010258 +C**** 03020258 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03030258 +C**** 03040258 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03050258 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03060258 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03070258 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03080258 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03090258 +CBE** ********************** BBCFMT0B **********************************03100258 +30026 FORMAT ("1", 26X,I1) 03110258 +30018 FORMAT(" ",26X,I10) 03120258 +30025 FORMAT(/49X,"TESTS 1-3 (2 COMPUTED RESULTS)" , 03130258 + 1 /49X,"TESTS 4-7 (3 COMPUTED RESULTS)" , 03140258 + 2 /49X,"TEST 8 (4 COMPUTED RESULTS)" , 03150258 + 3 /49X,"ALL ANSWERS SHOULD BE ZERO" ) 03160258 +C***** END OF TEST SEGMENT 300 03170258 + STOP 03180258 + END 03190258 diff --git a/Fortran/UnitTests/fcvs21_f95/FM258.reference_output b/Fortran/UnitTests/fcvs21_f95/FM258.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM258.reference_output @@ -0,0 +1,67 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM258BEGIN* TEST RESULTS - FM258 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + BLKIF1 - (300) BLOCK IF - SIMPLE TEST + + SUBSET REF. 11.6 - 11.9 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 8 TESTS + + + TESTS 1-3 (2 COMPUTED RESULTS) + TESTS 4-7 (3 COMPUTED RESULTS) + TEST 8 (4 COMPUTED RESULTS) + ALL ANSWERS SHOULD BE ZERO + 1 INSPECT + 0 + 0 + 2 INSPECT + 0 + 0 + 3 INSPECT + 0 + 0 + 4 INSPECT + 0 + 0 + 0 + 5 INSPECT + 0 + 0 + 0 + 6 INSPECT + 0 + 0 + 0 + 7 INSPECT + 0 + 0 + 0 + 8 INSPECT + 0 + 0 + 0 + 0 + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 8 TESTS REQUIRE INSPECTION + 8 OF 8 TESTS EXECUTED + + *FM258END* END OF TEST - FM258 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM261.f b/Fortran/UnitTests/fcvs21_f95/FM261.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM261.f @@ -0,0 +1,266 @@ + PROGRAM FM261 + +C***********************************************************************00010261 +C***** FORTRAN 77 00020261 +C***** FM261 00030261 +C***** BLKIF4 - (303) 00040261 +C***** THIS PROGRAM CALLS SUBROUTINES SN262, SN263 AND INTEGER 00050261 +C FUNCTION IF264 00060261 +C***********************************************************************00070261 +C***** GENERAL PURPOSE SUBSET REF 00080261 +C***** TEST BLOCK IF STATEMENTS 11.6 - 11.900090261 +C***** WITH SUBROUTINE CALLS 15.6 00100261 +C***** USES SUBROUTINES SN262 (750), SN263 (751) 00110261 +C***** AND FUNCTION IF264 (752) 00120261 +CBB** ********************** BBCCOMNT **********************************00130261 +C**** 00140261 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150261 +C**** VERSION 2.1 00160261 +C**** 00170261 +C**** 00180261 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190261 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200261 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00210261 +C**** BUILDING 225 RM A266 00220261 +C**** GAITHERSBURG, MD 20899 00230261 +C**** 00240261 +C**** 00250261 +C**** 00260261 +CBE** ********************** BBCCOMNT **********************************00270261 +CBB** ********************** BBCINITA **********************************00280261 +C**** SPECIFICATION STATEMENTS 00290261 +C**** 00300261 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310261 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320261 +CBE** ********************** BBCINITA **********************************00330261 +CBB** ********************** BBCINITB **********************************00340261 +C**** INITIALIZE SECTION 00350261 + DATA ZVERS, ZVERSD, ZDATE 00360261 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00370261 + DATA ZCOMPL, ZNAME, ZTAPE 00380261 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00390261 + DATA ZPROJ, ZTAPED, ZPROG 00400261 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00410261 + DATA REMRKS /' '/ 00420261 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00430261 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00440261 +C**** 00450261 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00460261 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00470261 +CZ03 ZPROG = 'PROGRAM NAME' 00480261 +CZ04 ZDATE = 'DATE OF TEST' 00490261 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00500261 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00510261 +CZ07 ZNAME = 'NAME OF USER' 00520261 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00530261 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00540261 +C 00550261 + IVPASS = 0 00560261 + IVFAIL = 0 00570261 + IVDELE = 0 00580261 + IVINSP = 0 00590261 + IVTOTL = 0 00600261 + IVTOTN = 0 00610261 + ICZERO = 0 00620261 +C 00630261 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640261 + I01 = 05 00650261 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660261 + I02 = 06 00670261 +C 00680261 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690261 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700261 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00710261 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00720261 +C 00730261 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00740261 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00750261 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00760261 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00770261 +C 00780261 +CBE** ********************** BBCINITB **********************************00790261 + NUVI = I02 00800261 + ZPROG = 'FM261' 00810261 +CBB** ********************** BBCHED0A **********************************00820261 +C**** 00830261 +C**** WRITE REPORT TITLE 00840261 +C**** 00850261 + WRITE (I02, 90002) 00860261 + WRITE (I02, 90006) 00870261 + WRITE (I02, 90007) 00880261 + WRITE (I02, 90008) ZVERS, ZVERSD 00890261 + WRITE (I02, 90009) ZPROG, ZPROG 00900261 + WRITE (I02, 90010) ZDATE, ZCOMPL 00910261 +CBE** ********************** BBCHED0A **********************************00920261 +C***** TOTAL NUMBER OF EXPECTED TESTS 00930261 + IVTOTL = 2 00940261 +C***** HEADER FOR SEGMENT 303 00950261 + WRITE(NUVI,30300) 00960261 +30300 FORMAT(" ",/" BLKIF4 - (303) BLOCK IF" // 00970261 + 1 " BLOCK IF WITH SUBPROGRAM CALL" // 00980261 + 2 " SUBSET REF. 11.6 - 11.9, 15.6" ) 00990261 +CBB** ********************** BBCHED0B **********************************01000261 +C**** WRITE DETAIL REPORT HEADERS 01010261 +C**** 01020261 + WRITE (I02,90004) 01030261 + WRITE (I02,90004) 01040261 + WRITE (I02,90013) 01050261 + WRITE (I02,90014) 01060261 + WRITE (I02,90015) IVTOTL 01070261 +CBE** ********************** BBCHED0B **********************************01080261 +C***** 01090261 + WRITE (NUVI, 30325) 01100261 +CT001* TEST 1 BLOCK IF WITH SUBROUTINE CALLS 01110261 + IVTNUM = 1 01120261 + IVINSP = IVINSP + 1 01130261 + WRITE (NUVI, 80004) IVTNUM 01140261 + IVI = 3 01150261 + CALL SN262 (IVI) 01160261 + IF (IVI .GT. 0) THEN 01170261 + CALL SN262 (IVI) 01180261 + ELSE 01190261 + CALL SN263 (IVI) 01200261 + ENDIF 01210261 + LVI = 7 - IVI 01220261 + WRITE (NUVI, 30301) LVI 01230261 +C***** CONTINUE 01240261 +CT002* TEST 2 CALL OF FUNCTION CONTAINING BLOCK IF 01250261 + IVTNUM = 2 01260261 + IVINSP = IVINSP + 1 01270261 + WRITE (NUVI, 80004) IVTNUM 01280261 + IVI = 7 01290261 + IVI = IF264 (IVI .GT. 0) 01300261 + LVI = 8 - IVI 01310261 + WRITE (NUVI, 30301) LVI 01320261 + IVI = IF264 (LVI .NE. 0) 01330261 + LVI = 6 - IVI 01340261 + WRITE (NUVI, 30301) LVI 01350261 +C***** 01360261 +30325 FORMAT (/49X,'TEST 1 (1 COMPUTED RESULT)'/ 01370261 + 1 49X,'TEST 2 (2 COMPUTED RESULTS)'/ 01380261 + 2 49X,'ALL ANSWERS SHOULD BE ZERO') 01390261 +30301 FORMAT (" ",26X,I10) 01400261 +C***** 01410261 +CBB** ********************** BBCSUM0 **********************************01420261 +C**** WRITE OUT TEST SUMMARY 01430261 +C**** 01440261 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01450261 + WRITE (I02, 90004) 01460261 + WRITE (I02, 90014) 01470261 + WRITE (I02, 90004) 01480261 + WRITE (I02, 90020) IVPASS 01490261 + WRITE (I02, 90022) IVFAIL 01500261 + WRITE (I02, 90024) IVDELE 01510261 + WRITE (I02, 90026) IVINSP 01520261 + WRITE (I02, 90028) IVTOTN, IVTOTL 01530261 +CBE** ********************** BBCSUM0 **********************************01540261 +CBB** ********************** BBCFOOT0 **********************************01550261 +C**** WRITE OUT REPORT FOOTINGS 01560261 +C**** 01570261 + WRITE (I02,90016) ZPROG, ZPROG 01580261 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 01590261 + WRITE (I02,90019) 01600261 +CBE** ********************** BBCFOOT0 **********************************01610261 +CBB** ********************** BBCFMT0A **********************************01620261 +C**** FORMATS FOR TEST DETAIL LINES 01630261 +C**** 01640261 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 01650261 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 01660261 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 01670261 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 01680261 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 01690261 + 1I6,/," ",15X,"CORRECT= " ,I6) 01700261 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01710261 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 01720261 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01730261 + 1A21,/," ",16X,"CORRECT= " ,A21) 01740261 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 01750261 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 01760261 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 01770261 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 01780261 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 01790261 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 01800261 +80050 FORMAT (" ",48X,A31) 01810261 +CBE** ********************** BBCFMT0A **********************************01820261 +CBB** ********************** BBCFMT0B **********************************01830261 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 01840261 +C**** 01850261 +90002 FORMAT ("1") 01860261 +90004 FORMAT (" ") 01870261 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )01880261 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 01890261 +90008 FORMAT (" ",21X,A13,A17) 01900261 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 01910261 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 01920261 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 01930261 + 1 7X,"REMARKS",24X) 01940261 +90014 FORMAT (" ","----------------------------------------------" , 01950261 + 1 "---------------------------------" ) 01960261 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 01970261 +C**** 01980261 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 01990261 +C**** 02000261 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02010261 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02020261 + 1 A13) 02030261 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02040261 +C**** 02050261 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02060261 +C**** 02070261 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02080261 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02090261 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02100261 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02110261 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02120261 +CBE** ********************** BBCFMT0B **********************************02130261 +C***** END OF TEST SEGMENT 303 02140261 + STOP 02150261 + END 02160261 + +C***********************************************************************00010262 +C***** FORTRAN 77 00020262 +C***** FM262 00030262 +C***** SN262 SN262 - (750) 00040262 +C***** SUBROUTINE CALLED BY FM261 00050262 +C***********************************************************************00060262 +C***** 00070262 + SUBROUTINE SN262 (IWVI) 00080262 +C***** 00090262 + IWVI = IWVI + 2 00100262 +C***** 00110262 + RETURN 00120262 + END 00130262 + +C***********************************************************************00010263 +C***** FORTRAN 77 00020263 +C***** FM263 00030263 +C***** SN263 SN263 - (751) 00040263 +C***** SUBROUTINE CALLED BY FM261 00050263 +C***********************************************************************00060263 +C***** 00070263 + SUBROUTINE SN263 (IWVI) 00080263 +C***** 00090263 + IWVI = IWVI * (-10) 00100263 +C***** 00110263 + RETURN 00120263 + END 00130263 + +C***********************************************************************00010264 +C***** FORTRAN 77 00020264 +C***** FM264 00030264 +C***** IF264 IF264 - (752) 00040264 +C***** INTEGER FUNCTION CALLED BY FM261 00050264 +C***********************************************************************00060264 +C***** 00070264 + INTEGER FUNCTION IF264 (AWVB) 00080264 + LOGICAL AWVB 00090264 +C***** 00100264 + IF (AWVB) THEN 00110264 + IF264 = 8 00120264 + RETURN 00130264 + ELSE 00140264 + IF264 = 6 00150264 + ENDIF 00160264 +C***** 00170264 + RETURN 00180264 + END 00190264 diff --git a/Fortran/UnitTests/fcvs21_f95/FM261.reference_output b/Fortran/UnitTests/fcvs21_f95/FM261.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM261.reference_output @@ -0,0 +1,43 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM261BEGIN* TEST RESULTS - FM261 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + BLKIF4 - (303) BLOCK IF + + BLOCK IF WITH SUBPROGRAM CALL + + SUBSET REF. 11.6 - 11.9, 15.6 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 2 TESTS + + + TEST 1 (1 COMPUTED RESULT) + TEST 2 (2 COMPUTED RESULTS) + ALL ANSWERS SHOULD BE ZERO + 1 INSPECT + 0 + 2 INSPECT + 0 + 0 + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 2 TESTS REQUIRE INSPECTION + 2 OF 2 TESTS EXECUTED + + *FM261END* END OF TEST - FM261 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM300.f b/Fortran/UnitTests/fcvs21_f95/FM300.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM300.f @@ -0,0 +1,695 @@ + PROGRAM FM300 00010300 +C 00020300 +C 00030300 +C THIS ROUTINE TESTS THE USE OF THE EQUIVALENCE STATEMENT TO 00040300 +C EQUATE STORAGE UNITS OF VARIABLES, ARRAYS AND ARRAY ELEMENTS. 00050300 +C ONLY INTEGER, REAL, LOGICAL AND CHARACTER DATA TYPES ARE TESTED. 00060300 +C NO ATTEMPT IS MADE TO TEST DATA OF DIFFERENT TYPES THAT ARE 00070300 +C EQUATED WITH THE EQUIVALENCE STATEMENT. 00080300 +C 00090300 +C REFERENCES. 00100300 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00110300 +C X3.9-1978 00120300 +C 00130300 +C SECTION 8.1, DIMENSION STATEMENT 00140300 +C SECTION 8.2, EQUIVALENCE STATEMENT 00150300 +C SECTION 9, DATA STATEMENT 00160300 +C 00170300 +C 00180300 +C ******************************************************************00190300 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00200300 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00210300 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00220300 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00230300 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00240300 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00250300 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00260300 +C THE RESULT OF EXECUTING THESE TESTS. 00270300 +C 00280300 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00290300 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00300300 +C 00310300 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00320300 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00330300 +C SOFTWARE STANDARDS VALIDATION GROUP 00340300 +C BUILDING 225 RM A266 00350300 +C GAITHERSBURG, MD 20899 00360300 +C ******************************************************************00370300 +C 00380300 +C 00390300 + IMPLICIT LOGICAL (L) 00400300 + IMPLICIT CHARACTER*14 (C) 00410300 +C 00420300 + 00430300 +C *** SPECIFICATION STATEMENTS FOR TEST 001 *** 00440300 +C 00450300 + EQUIVALENCE (IVOE01, IVOE02) 00460300 +C 00470300 +C *** SPECIFICATION STATEMENTS FOR TEST 002 *** 00480300 +C 00490300 + EQUIVALENCE (RVOE01, RVOE02) 00500300 +C 00510300 +C *** SPECIFICATION STATEMENTS FOR TEST 003 *** 00520300 +C 00530300 + EQUIVALENCE (LVOE01, LVOE02) 00540300 +C 00550300 +C *** SPECIFICATION STATEMENTS FOR TEST 004 *** 00560300 +C 00570300 + CHARACTER CVTE01*3, CVTE02*3, CVCOMP*3 00580300 + EQUIVALENCE (CVTE01, CVTE02) 00590300 +C 00600300 +C *** SPECIFICATION STATEMENTS FOR TEST 005 *** 00610300 +C 00620300 + EQUIVALENCE (IVOE03, IVOE04, IVOE05) 00630300 +C 00640300 +C *** SPECIFICATION STATEMENTS FOR TEST 006 *** 00650300 +C 00660300 + EQUIVALENCE (IVOE06, IVOE07, RVOE03) 00670300 +C 00680300 +C *** SPECIFICATION STATEMENTS FOR TESTS 007 AND 008 *** 00690300 +C 00700300 + EQUIVALENCE (IVOE08, IVOE09), (IVOE10, IVOE11) 00710300 +C 00720300 +C *** SPECIFICATION STATEMENTS FOR TEST 009 *** 00730300 +C 00740300 + EQUIVALENCE (IVOE12, IVOE13), (IVOE13, IVOE14) 00750300 +C 00760300 +C *** SPECIFICATION STATEMENTS FOR TEST 010 *** 00770300 +C 00780300 + EQUIVALENCE (IVOE15, IVOE16) 00790300 + EQUIVALENCE (IVOE16, IVOE17) 00800300 +C 00810300 +C *** SPECIFICATION STATEMENTS FOR TESTS 011 AND 012 *** 00820300 +C 00830300 + DIMENSION IADE11(2), IADE12(3) 00840300 + EQUIVALENCE (IADE11, IADE12) 00850300 +C 00860300 +C *** SPECIFICATION STATEMENTS FOR TESTS 013 AND 014 *** 00870300 +C 00880300 + DIMENSION RADE11(5), RADE12(5) 00890300 + EQUIVALENCE (RADE11(4), RADE12(2)) 00900300 +C 00910300 +C *** SPECIFICATION STATEMENTS FOR TEST 015 *** 00920300 +C 00930300 + DIMENSION IADE13(4), IADE14(4) 00940300 + EQUIVALENCE (IADE13, IADE14(3)) 00950300 +C 00960300 +C *** SPECIFICATION STATEMENTS FOR TEST 016 *** 00970300 +C 00980300 + DIMENSION IADE15(3) 00990300 + EQUIVALENCE (IADE15(2), IVOE18) 01000300 +C 01010300 +C *** SPECIFICATION STATEMENTS FOR TESTS 017 AND 018 *** 01020300 +C 01030300 + DIMENSION IADE21(2,2), IADE16(4) 01040300 + EQUIVALENCE (IADE21, IADE16) 01050300 +C 01060300 +C *** SPECIFICATION STATEMENTS FOR TEST 019 *** 01070300 +C 01080300 + EQUIVALENCE (IVOE19, IVOE20) 01090300 + DATA IVOE19/19/ 01100300 +C 01110300 +C 01120300 +C 01130300 +C INITIALIZATION SECTION. 01140300 +C 01150300 +C INITIALIZE CONSTANTS 01160300 +C ******************** 01170300 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01180300 + I01 = 5 01190300 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01200300 + I02 = 6 01210300 +C SYSTEM ENVIRONMENT SECTION 01220300 +C 01230300 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01240300 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01250300 +C (UNIT NUMBER FOR CARD READER). 01260300 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01270300 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01280300 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01290300 +C 01300300 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01310300 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01320300 +C (UNIT NUMBER FOR PRINTER). 01330300 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01340300 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01350300 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01360300 +C 01370300 + IVPASS = 0 01380300 + IVFAIL = 0 01390300 + IVDELE = 0 01400300 + ICZERO = 0 01410300 +C 01420300 +C WRITE OUT PAGE HEADERS 01430300 +C 01440300 + WRITE (I02,90002) 01450300 + WRITE (I02,90006) 01460300 + WRITE (I02,90008) 01470300 + WRITE (I02,90004) 01480300 + WRITE (I02,90010) 01490300 + WRITE (I02,90004) 01500300 + WRITE (I02,90016) 01510300 + WRITE (I02,90001) 01520300 + WRITE (I02,90004) 01530300 + WRITE (I02,90012) 01540300 + WRITE (I02,90014) 01550300 + WRITE (I02,90004) 01560300 +C 01570300 +C 01580300 +C **** FCVS PROGRAM 300 - TEST 001 **** 01590300 +C 01600300 +C THIS IS A TEST FOR EQUATING TWO INTEGER VARIABLES. 01610300 +C 01620300 +C 01630300 + IVTNUM = 1 01640300 + IF (ICZERO) 30010, 0010, 30010 01650300 + 0010 CONTINUE 01660300 + IVCOMP = 0 01670300 + IVOE01 = 5 01680300 + IVOE02 = 7 01690300 + IVCORR = 7 01700300 + IVCOMP = IVOE01 01710300 +40010 IF (IVCOMP - 7) 20010,10010,20010 01720300 +30010 IVDELE = IVDELE + 1 01730300 + WRITE (I02,80000) IVTNUM 01740300 + IF (ICZERO) 10010, 0021, 20010 01750300 +10010 IVPASS = IVPASS + 1 01760300 + WRITE (I02,80002) IVTNUM 01770300 + GO TO 0021 01780300 +20010 IVFAIL = IVFAIL + 1 01790300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01800300 + 0021 CONTINUE 01810300 +C 01820300 +C **** FCVS PROGRAM 300 - TEST 002 **** 01830300 +C 01840300 +C THIS IS A TEST FOR EQUATING TWO REAL VARIABLES. 01850300 +C 01860300 +C 01870300 + IVTNUM = 2 01880300 + IF (ICZERO) 30020, 0020, 30020 01890300 + 0020 CONTINUE 01900300 + RVCOMP = 0.0 01910300 + RVOE01 = 4.5 01920300 + RVOE02 = 1.2 01930300 + RVCORR = 1.2 01940300 + RVCOMP = RVOE01 01950300 +40020 IF (RVCOMP - 1.1995) 20020,10020,40021 01960300 +40021 IF (RVCOMP - 1.2005) 10020,10020,20020 01970300 +30020 IVDELE = IVDELE + 1 01980300 + WRITE (I02,80000) IVTNUM 01990300 + IF (ICZERO) 10020, 0031, 20020 02000300 +10020 IVPASS = IVPASS + 1 02010300 + WRITE (I02,80002) IVTNUM 02020300 + GO TO 0031 02030300 +20020 IVFAIL = IVFAIL + 1 02040300 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02050300 + 0031 CONTINUE 02060300 +C 02070300 +C **** FCVS PROGRAM 300 - TEST 003 **** 02080300 +C 02090300 +C THIS IS A TEST FOR EQUATING TWO LOGICAL VARIABLES. 02100300 +C 02110300 +C 02120300 + IVTNUM = 3 02130300 + IF (ICZERO) 30030, 0030, 30030 02140300 + 0030 CONTINUE 02150300 + LVOE01 = .TRUE. 02160300 + LVOE02 = .FALSE. 02170300 + IVCORR = 0 02180300 + IVCOMP = 0 02190300 + IF (LVOE01) IVCOMP = 1 02200300 +40030 IF (IVCOMP) 20030,10030,20030 02210300 +30030 IVDELE = IVDELE + 1 02220300 + WRITE (I02,80000) IVTNUM 02230300 + IF (ICZERO) 10030, 0041, 20030 02240300 +10030 IVPASS = IVPASS + 1 02250300 + WRITE (I02,80002) IVTNUM 02260300 + GO TO 0041 02270300 +20030 IVFAIL = IVFAIL + 1 02280300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02290300 + 0041 CONTINUE 02300300 +C 02310300 +C **** FCVS PROGRAM 300 - TEST 004 **** 02320300 +C 02330300 +C THIS IS A TEST FOR EQUATING TWO CHARACTER VARIABLES. 02340300 +C 02350300 +C 02360300 + IVTNUM = 4 02370300 + IF (ICZERO) 30040, 0040, 30040 02380300 + 0040 CONTINUE 02390300 + CVCOMP = ' ' 02400300 + CVTE01 = 'ABC' 02410300 + CVTE02 = 'DEF' 02420300 + CVCORR = 'DEF' 02430300 + CVCOMP = CVTE01 02440300 +40040 IF (CVCOMP .EQ. 'DEF') GO TO 10040 02450300 +40041 GO TO 20040 02460300 +30040 IVDELE = IVDELE + 1 02470300 + WRITE (I02,80000) IVTNUM 02480300 + IF (ICZERO) 10040, 0051, 20040 02490300 +10040 IVPASS = IVPASS + 1 02500300 + WRITE (I02,80002) IVTNUM 02510300 + GO TO 0051 02520300 +20040 IVFAIL = IVFAIL + 1 02530300 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 02540300 + 0051 CONTINUE 02550300 +C 02560300 +C **** FCVS PROGRAM 300 - TEST 005 **** 02570300 +C 02580300 +C THIS IS A TEST FOR EQUATING THREE INTEGER VARIABLES. 02590300 +C 02600300 +C 02610300 + IVTNUM = 5 02620300 + IF (ICZERO) 30050, 0050, 30050 02630300 + 0050 CONTINUE 02640300 + IVCOMP = 0 02650300 + IVOE03 = 3 02660300 + IVOE04 = 4 02670300 + IVOE05 = 5 02680300 + IVCORR = 5 02690300 + IVCOMP = IVOE03 02700300 +40050 IF (IVCOMP - 5) 20050,40051,20050 02710300 +40051 IVCOMP = IVOE04 02720300 +40052 IF (IVCOMP - 5) 20050,10050,20050 02730300 +30050 IVDELE = IVDELE + 1 02740300 + WRITE (I02,80000) IVTNUM 02750300 + IF (ICZERO) 10050, 0061, 20050 02760300 +10050 IVPASS = IVPASS + 1 02770300 + WRITE (I02,80002) IVTNUM 02780300 + GO TO 0061 02790300 +20050 IVFAIL = IVFAIL + 1 02800300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02810300 + 0061 CONTINUE 02820300 +C 02830300 +C **** FCVS PROGRAM 300 - TEST 006 **** 02840300 +C 02850300 +C THIS IS A TEST FOR EQUATING TWO INTEGER VARIABLES AND ONE 02860300 +C REAL VARIABLE WITHIN ONE EQUIVALENCE STATEMENT LIST OF NAMES. THE02870300 +C VALUE OF THE REAL VARIABLE IS NOT TESTED. 02880300 +C 02890300 +C 02900300 + IVTNUM = 6 02910300 + IF (ICZERO) 30060, 0060, 30060 02920300 + 0060 CONTINUE 02930300 + IVCOMP = 0 02940300 + RVOE03 = 3.445 02950300 + IVOE06 = 6 02960300 + IVOE07 = 7 02970300 + IVCORR = 7 02980300 + IVCOMP = IVOE06 02990300 +40060 IF (IVCOMP - 7) 20060,10060,20060 03000300 +30060 IVDELE = IVDELE + 1 03010300 + WRITE (I02,80000) IVTNUM 03020300 + IF (ICZERO) 10060, 0071, 20060 03030300 +10060 IVPASS = IVPASS + 1 03040300 + WRITE (I02,80002) IVTNUM 03050300 + GO TO 0071 03060300 +20060 IVFAIL = IVFAIL + 1 03070300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03080300 + 0071 CONTINUE 03090300 +C 03100300 +C **** FCVS PROGRAM 300 - TEST 007 **** 03110300 +C 03120300 +C THIS IS A TEST FOR EQUATING INTEGER VARIABLES USING TWO LISTS 03130300 +C OF NAMES IN ONE EQUIVALENCE STATEMENT. NAMES SPECIFIED IN THE 03140300 +C FIRST LIST ARE NOT EQUATED TO NAMES IN THE SECOND LIST. THIS 03150300 +C TEST CHECKS THE EQUIVALINCE OF THE VARIABLES IN THE FIRST LIST. 03160300 +C 03170300 +C 03180300 + IVTNUM = 7 03190300 + IF (ICZERO) 30070, 0070, 30070 03200300 + 0070 CONTINUE 03210300 + IVCOMP = 0 03220300 + IVOE08 = 8 03230300 + IVOE09 = 9 03240300 + IVOE10 = 10 03250300 + IVOE11 = 11 03260300 + IVCORR = 9 03270300 + IVCOMP = IVOE08 03280300 +40070 IF (IVCOMP - 9) 20070,10070,20070 03290300 +30070 IVDELE = IVDELE + 1 03300300 + WRITE (I02,80000) IVTNUM 03310300 + IF (ICZERO) 10070, 0081, 20070 03320300 +10070 IVPASS = IVPASS + 1 03330300 + WRITE (I02,80002) IVTNUM 03340300 + GO TO 0081 03350300 +20070 IVFAIL = IVFAIL + 1 03360300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03370300 + 0081 CONTINUE 03380300 +C 03390300 +C **** FCVS PROGRAM 300 - TEST 008 **** 03400300 +C 03410300 +C THIS TEST CHECKS THE EQUIVALENCE OF THE VARIABLES IN THE 03420300 +C SECOND LIST. 03430300 +C 03440300 +C 03450300 + IVTNUM = 8 03460300 + IF (ICZERO) 30080, 0080, 30080 03470300 + 0080 CONTINUE 03480300 + IVCOMP = 0 03490300 + IVCORR = 11 03500300 + IVCOMP = IVOE10 03510300 +40080 IF (IVCOMP - 11) 20080,10080,20080 03520300 +30080 IVDELE = IVDELE + 1 03530300 + WRITE (I02,80000) IVTNUM 03540300 + IF (ICZERO) 10080, 0091, 20080 03550300 +10080 IVPASS = IVPASS + 1 03560300 + WRITE (I02,80002) IVTNUM 03570300 + GO TO 0091 03580300 +20080 IVFAIL = IVFAIL + 1 03590300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03600300 + 0091 CONTINUE 03610300 +C 03620300 +C **** FCVS PROGRAM 300 - TEST 009 **** 03630300 +C 03640300 +C THIS IS A TEST FOR EQUATING INTEGER VARIABLES IN ONE LIST 03650300 +C WITH INTEGER VARIABLES IN A SECOND LIST OF THE SAME EQUIVALENCE 03660300 +C STATEMENT. ALL VARIABLES SHOULD BE EQUATED AND SHARE THE SAME 03670300 +C STORAGE UNIT. 03680300 +C 03690300 +C 03700300 + IVTNUM = 9 03710300 + IF (ICZERO) 30090, 0090, 30090 03720300 + 0090 CONTINUE 03730300 + IVCOMP = 0 03740300 + IVOE12 = 12 03750300 + IVOE13 = 13 03760300 + IVOE14 = 14 03770300 + IVCORR = 14 03780300 + IVCOMP = IVOE13 03790300 +40090 IF (IVCOMP - 14) 20090,40091,20090 03800300 +40091 IVCOMP = IVOE12 03810300 +40092 IF (IVCOMP - 14) 20090,10090,20090 03820300 +30090 IVDELE = IVDELE + 1 03830300 + WRITE (I02,80000) IVTNUM 03840300 + IF (ICZERO) 10090, 0101, 20090 03850300 +10090 IVPASS = IVPASS + 1 03860300 + WRITE (I02,80002) IVTNUM 03870300 + GO TO 0101 03880300 +20090 IVFAIL = IVFAIL + 1 03890300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03900300 + 0101 CONTINUE 03910300 +C 03920300 +C **** FCVS PROGRAM 300 - TEST 010 **** 03930300 +C 03940300 +C THIS IS A TEST FOR EQUATING INTEGER VARIABLES SPECIFIED IN ONE 03950300 +C EQUIVALENCE STATEMENT WITH INTEGER VARIABLES SPECIFIED IN A 03960300 +C SECOND EQUIVALENCE STATEMENT. ONE VARIABLE IS SPECIFIED IN BOTH 03970300 +C STATEMENTS, THEREFORE ALL VARIABLES SHOULD BE EQUATED AND SHARE 03980300 +C THE SAME STORAGE UNIT. 03990300 +C 04000300 +C 04010300 + IVTNUM = 10 04020300 + IF (ICZERO) 30100, 0100, 30100 04030300 + 0100 CONTINUE 04040300 + IVCOMP = 0 04050300 + IVOE15 = 15 04060300 + IVOE16 = 16 04070300 + IVOE17 = 17 04080300 + IVCORR = 17 04090300 + IVCOMP = IVOE16 04100300 +40100 IF (IVCOMP - 17) 20100,40101,20100 04110300 +40101 IVCOMP = IVOE15 04120300 +40102 IF (IVCOMP - 17) 20100,10100,20100 04130300 +30100 IVDELE = IVDELE + 1 04140300 + WRITE (I02,80000) IVTNUM 04150300 + IF (ICZERO) 10100, 0111, 20100 04160300 +10100 IVPASS = IVPASS + 1 04170300 + WRITE (I02,80002) IVTNUM 04180300 + GO TO 0111 04190300 +20100 IVFAIL = IVFAIL + 1 04200300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04210300 + 0111 CONTINUE 04220300 +C 04230300 +C **** FCVS PROGRAM 300 - TEST 011 **** 04240300 +C 04250300 +C THIS IS A TEST FOR EQUATING TWO INTEGER ARRAYS UNQUALIFIED 04260300 +C BY A SUBSCRIPT IN THE EQUIVALENCE STATEMENT. ALL ARRAY ELEMENTS 04270300 +C SPECIFIED BY THE SAME SUBSCRIPT VALUE, BEGINNING WITH THE FIRST 04280300 +C ARRAY ELEMENT, SHOULD BE EQUATED AND SHARE THE SAME STORAGE UNIT. 04290300 +C THIS TEST CHECKS THE EQUIVALENCE OF THE FIRST ARRAY ELEMENTS. 04300300 +C 04310300 +C 04320300 + IVTNUM = 11 04330300 + IF (ICZERO) 30110, 0110, 30110 04340300 + 0110 CONTINUE 04350300 + IVCOMP = 0 04360300 + IADE11(1) = 111 04370300 + IADE11(2) = 112 04380300 + IADE12(1) = 121 04390300 + IADE12(2) = 122 04400300 + IADE12(3) = 123 04410300 + IVCORR = 121 04420300 + IVCOMP = IADE11(1) 04430300 +40110 IF (IVCOMP - 121) 20110,10110,20110 04440300 +30110 IVDELE = IVDELE + 1 04450300 + WRITE (I02,80000) IVTNUM 04460300 + IF (ICZERO) 10110, 0121, 20110 04470300 +10110 IVPASS = IVPASS + 1 04480300 + WRITE (I02,80002) IVTNUM 04490300 + GO TO 0121 04500300 +20110 IVFAIL = IVFAIL + 1 04510300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04520300 + 0121 CONTINUE 04530300 +C 04540300 +C **** FCVS PROGRAM 300 - TEST 012 **** 04550300 +C 04560300 +C THIS TEST CHECKS THE EQUIVALENCE OF THE SECOND ARRAY ELEMENTS. 04570300 +C 04580300 +C 04590300 + IVTNUM = 12 04600300 + IF (ICZERO) 30120, 0120, 30120 04610300 + 0120 CONTINUE 04620300 + IVCOMP = 0 04630300 + IVCORR = 122 04640300 + IVCOMP = IADE11(2) 04650300 +40120 IF (IVCOMP - 122) 20120,10120,20120 04660300 +30120 IVDELE = IVDELE + 1 04670300 + WRITE (I02,80000) IVTNUM 04680300 + IF (ICZERO) 10120, 0131, 20120 04690300 +10120 IVPASS = IVPASS + 1 04700300 + WRITE (I02,80002) IVTNUM 04710300 + GO TO 0131 04720300 +20120 IVFAIL = IVFAIL + 1 04730300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04740300 + 0131 CONTINUE 04750300 +C 04760300 +C **** FCVS PROGRAM 300 - TEST 013 **** 04770300 +C 04780300 +C THIS IS A TEST FOR EQUATING TWO REAL ARRAY ELEMENTS. THIS 04790300 +C TEST CHECKS THE EQUIVALENCE OF THE TWO ARRAY ELEMENTS SPECIFIED 04800300 +C IN THE EQUIVALENCE STATEMENT. 04810300 +C 04820300 +C 04830300 + IVTNUM = 13 04840300 + IF (ICZERO) 30130, 0130, 30130 04850300 + 0130 CONTINUE 04860300 + RVCOMP = 0.0 04870300 + RADE11(4) = 11.4 04880300 + RADE12(2) = 1.22 04890300 + RVCORR = 1.22 04900300 + RVCOMP = RADE11(4) 04910300 +40130 IF (RVCOMP - 1.2195) 20130,10130,40131 04920300 +40131 IF (RVCOMP - 1.2205) 10130,10130,20130 04930300 +30130 IVDELE = IVDELE + 1 04940300 + WRITE (I02,80000) IVTNUM 04950300 + IF (ICZERO) 10130, 0141, 20130 04960300 +10130 IVPASS = IVPASS + 1 04970300 + WRITE (I02,80002) IVTNUM 04980300 + GO TO 0141 04990300 +20130 IVFAIL = IVFAIL + 1 05000300 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05010300 + 0141 CONTINUE 05020300 +C 05030300 +C **** FCVS PROGRAM 300 - TEST 014 **** 05040300 +C 05050300 +C THIS TEST CHECKS THE EQUIVALENCE OF THE ARRAY ELEMENTS 05060300 +C WITH A SUBSCRIPT VALUE ONE LESS THAN THOSE TESTED IN THE 05070300 +C PREVIOUS TEST. THESE ELEMENTS SHOULD BE EQUATED AND SHARE THE 05080300 +C SAME STORAGE UNIT DUE TO THE WAY ARRAY ELEMENTS OCCUPY 05090300 +C CONSECUTIVE STORAGE UNITS. 05100300 +C 05110300 +C 05120300 + IVTNUM = 14 05130300 + IF (ICZERO) 30140, 0140, 30140 05140300 + 0140 CONTINUE 05150300 + RVCOMP = 0.0 05160300 + RADE11(3) = .113 05170300 + RADE12(1) = 122. 05180300 + RVCORR = 122. 05190300 + RVCOMP = RADE11(3) 05200300 +40140 IF (RVCOMP - 121.95) 20140,10140,40141 05210300 +40141 IF (RVCOMP - 122.05) 10140,10140,20140 05220300 +30140 IVDELE = IVDELE + 1 05230300 + WRITE (I02,80000) IVTNUM 05240300 + IF (ICZERO) 10140, 0151, 20140 05250300 +10140 IVPASS = IVPASS + 1 05260300 + WRITE (I02,80002) IVTNUM 05270300 + GO TO 0151 05280300 +20140 IVFAIL = IVFAIL + 1 05290300 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05300300 + 0151 CONTINUE 05310300 +C 05320300 +C **** FCVS PROGRAM 300 - TEST 015 **** 05330300 +C 05340300 +C THIS IS A TEST TO EQUATE AN ARRAY NAME TO AN ARRAY ELEMENT 05350300 +C NAME. 05360300 +C 05370300 +C 05380300 + IVTNUM = 15 05390300 + IF (ICZERO) 30150, 0150, 30150 05400300 + 0150 CONTINUE 05410300 + IVCOMP = 0 05420300 + IADE13(1) = 131 05430300 + IADE14(3) = 143 05440300 + IVCORR = 143 05450300 + IVCOMP = IADE13(1) 05460300 +40150 IF (IVCOMP - 143) 20150,10150,20150 05470300 +30150 IVDELE = IVDELE + 1 05480300 + WRITE (I02,80000) IVTNUM 05490300 + IF (ICZERO) 10150, 0161, 20150 05500300 +10150 IVPASS = IVPASS + 1 05510300 + WRITE (I02,80002) IVTNUM 05520300 + GO TO 0161 05530300 +20150 IVFAIL = IVFAIL + 1 05540300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05550300 + 0161 CONTINUE 05560300 +C 05570300 +C **** FCVS PROGRAM 300 - TEST 016 **** 05580300 +C 05590300 +C THIS IS A TEST TO EQUATE AN ARRAY ELEMENT TO AN INTEGER 05600300 +C VARIABLE. 05610300 +C 05620300 +C 05630300 + IVTNUM = 16 05640300 + IF (ICZERO) 30160, 0160, 30160 05650300 + 0160 CONTINUE 05660300 + IVCOMP = 0 05670300 + IADE15(2) = 152 05680300 + IVOE18 = 18 05690300 + IVCORR = 18 05700300 + IVCOMP = IADE15(2) 05710300 +40160 IF (IVCOMP - 18) 20160,10160,20160 05720300 +30160 IVDELE = IVDELE + 1 05730300 + WRITE (I02,80000) IVTNUM 05740300 + IF (ICZERO) 10160, 0171, 20160 05750300 +10160 IVPASS = IVPASS + 1 05760300 + WRITE (I02,80002) IVTNUM 05770300 + GO TO 0171 05780300 +20160 IVFAIL = IVFAIL + 1 05790300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05800300 + 0171 CONTINUE 05810300 +C 05820300 +C **** FCVS PROGRAM 300 - TEST 017 **** 05830300 +C 05840300 +C THIS IS A TEST TO EQUATE A ONE DIMENSIONAL ARRAY TO A TWO 05850300 +C DIMENSIONAL ARRAY. THIS TEST CHECKS THE SECOND ARRAY ELEMENTS. 05860300 +C 05870300 +C 05880300 + IVTNUM = 17 05890300 + IF (ICZERO) 30170, 0170, 30170 05900300 + 0170 CONTINUE 05910300 + IVCOMP = 0 05920300 + IADE21(2,1) = 212 05930300 + IADE16(2) = 162 05940300 + IVCORR = 162 05950300 + IVCOMP = IADE21(2,1) 05960300 +40170 IF (IVCOMP - 162) 20170,10170,20170 05970300 +30170 IVDELE = IVDELE + 1 05980300 + WRITE (I02,80000) IVTNUM 05990300 + IF (ICZERO) 10170, 0181, 20170 06000300 +10170 IVPASS = IVPASS + 1 06010300 + WRITE (I02,80002) IVTNUM 06020300 + GO TO 0181 06030300 +20170 IVFAIL = IVFAIL + 1 06040300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06050300 + 0181 CONTINUE 06060300 +C 06070300 +C **** FCVS PROGRAM 300 - TEST 018 **** 06080300 +C 06090300 +C THIS TEST CHECKS THE THIRD ARRAY ELEMENTS FROM THE PREVIOUS 06100300 +C TEST. 06110300 +C 06120300 +C 06130300 + IVTNUM = 18 06140300 + IF (ICZERO) 30180, 0180, 30180 06150300 + 0180 CONTINUE 06160300 + IVCOMP = 0 06170300 + IADE21(1,2) = 2112 06180300 + IADE16(3) = 163 06190300 + IVCORR = 163 06200300 + IVCOMP = IADE21(1,2) 06210300 +40180 IF (IVCOMP - 163) 20180,10180,20180 06220300 +30180 IVDELE = IVDELE + 1 06230300 + WRITE (I02,80000) IVTNUM 06240300 + IF (ICZERO) 10180, 0191, 20180 06250300 +10180 IVPASS = IVPASS + 1 06260300 + WRITE (I02,80002) IVTNUM 06270300 + GO TO 0191 06280300 +20180 IVFAIL = IVFAIL + 1 06290300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06300300 + 0191 CONTINUE 06310300 +C 06320300 +C **** FCVS PROGRAM 300 - TEST 019 **** 06330300 +C 06340300 +C THIS IS A TEST TO EQUATE TWO INTEGER VARIABLES ONE OF WHICH 06350300 +C IS INITIALIZED IN A DATA STATEMENT. 06360300 +C 06370300 +C 06380300 + IVTNUM = 19 06390300 + IF (ICZERO) 30190, 0190, 30190 06400300 + 0190 CONTINUE 06410300 + IVCOMP = 0 06420300 + IVCORR = 19 06430300 + IVCOMP = IVOE20 06440300 +40190 IF (IVCOMP - 19) 20190,10190,20190 06450300 +30190 IVDELE = IVDELE + 1 06460300 + WRITE (I02,80000) IVTNUM 06470300 + IF (ICZERO) 10190, 0201, 20190 06480300 +10190 IVPASS = IVPASS + 1 06490300 + WRITE (I02,80002) IVTNUM 06500300 + GO TO 0201 06510300 +20190 IVFAIL = IVFAIL + 1 06520300 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06530300 + 0201 CONTINUE 06540300 +C 06550300 +C 06560300 +C WRITE OUT TEST SUMMARY 06570300 +C 06580300 + WRITE (I02,90004) 06590300 + WRITE (I02,90014) 06600300 + WRITE (I02,90004) 06610300 + WRITE (I02,90000) 06620300 + WRITE (I02,90004) 06630300 + WRITE (I02,90020) IVFAIL 06640300 + WRITE (I02,90022) IVPASS 06650300 + WRITE (I02,90024) IVDELE 06660300 + STOP 06670300 +90001 FORMAT (" ",24X,"FM300") 06680300 +90000 FORMAT (" ",20X,"END OF PROGRAM FM300" ) 06690300 +C 06700300 +C FORMATS FOR TEST DETAIL LINES 06710300 +C 06720300 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 06730300 +80002 FORMAT (" ",4X,I5,7X,"PASS") 06740300 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 06750300 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 06760300 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 06770300 +C 06780300 +C FORMAT STATEMENTS FOR PAGE HEADERS 06790300 +C 06800300 +90002 FORMAT ("1") 06810300 +90004 FORMAT (" ") 06820300 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06830300 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 06840300 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 06850300 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 06860300 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 06870300 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 06880300 +C 06890300 +C FORMAT STATEMENTS FOR RUN SUMMARY 06900300 +C 06910300 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 06920300 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 06930300 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 06940300 + END 06950300 diff --git a/Fortran/UnitTests/fcvs21_f95/FM300.reference_output b/Fortran/UnitTests/fcvs21_f95/FM300.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM300.reference_output @@ -0,0 +1,40 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM300 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + + ---------------------------------------------- + + END OF PROGRAM FM300 + + 0 TESTS FAILED + 19 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM301.f b/Fortran/UnitTests/fcvs21_f95/FM301.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM301.f @@ -0,0 +1,704 @@ + PROGRAM FM301 00010301 +C 00020301 +C 00030301 +C FM301 TESTS THE USE OF THE TYPE-STATEMENT TO EXPLICITLY 00040301 +C DEFINE THE DATA TYPE FOR VARIABLES, ARRAYS, AND STATEMENT 00050301 +C FUNCTIONS. ONLY INTEGER, REAL, LOGICAL AND CHARACTER DATA 00060301 +C TYPES ARE TESTED IN THIS ROUTINE. INTEGER AND REAL VARIABLES 00070301 +C AND ARRAYS ARE TESTED IN A MANNER WHICH BOTH CONFIRMS AND 00080301 +C OVERRIDES THE IMPLICIT TYPING OF THE DATA ENTITIES. 00090301 +C 00100301 +C FM301 DOES NOT ATTEMPT TO TEST ALL OF THE ELEMENTARY SYNTAX 00110301 +C FORMS OF THE TYPE-STATEMENT. THESE FORMS ARE TESTED ADEQUATELY 00120301 +C WITHIN THE BOILER PLATE AND OTHER AUDIT PROGRAMS. 00130301 +C 00140301 +C REFERENCES. 00150301 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160301 +C X3.9-1978 00170301 +C 00180301 +C SECTION 4.1, DATA TYPES 00190301 +C SECTION 8.4, TYPE-STATEMENT 00200301 +C SECTION 8.5, IMPLICIT STATEMENT 00210301 +C SECTION 15.4, STATEMENT FUNCTION 00220301 +C 00230301 +C 00240301 +C ******************************************************************00250301 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00260301 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00270301 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00280301 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00290301 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00300301 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00310301 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00320301 +C THE RESULT OF EXECUTING THESE TESTS. 00330301 +C 00340301 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00350301 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00360301 +C 00370301 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00380301 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00390301 +C SOFTWARE STANDARDS VALIDATION GROUP 00400301 +C BUILDING 225 RM A266 00410301 +C GAITHERSBURG, MD 20899 00420301 +C ******************************************************************00430301 +C 00440301 +C 00450301 + IMPLICIT LOGICAL (L) 00460301 + IMPLICIT CHARACTER*14 (C) 00470301 +C 00480301 + 00490301 +C 00500301 +C *** IMPLICIT STATEMENT FOR TEST 006 *** 00510301 +C 00520301 + IMPLICIT LOGICAL (M) 00530301 +C 00540301 +C *** IMPLICIT STATEMENT FOR TEST 017 *** 00550301 +C 00560301 + IMPLICIT INTEGER (G) 00570301 +C 00580301 +C *** IMPLICIT STATEMENT FOR TEST 018 *** 00590301 +C 00600301 + IMPLICIT CHARACTER*2 (F) 00610301 +C 00620301 +C *** SPECIFICATION STATEMENTS FOR TEST 001 *** 00630301 +C 00640301 + INTEGER AVTN01 00650301 +C 00660301 +C *** SPECIFICATION STATEMENTS FOR TEST 002 *** 00670301 +C 00680301 + REAL KVTN01 00690301 +C 00700301 +C *** SPECIFICATION STATEMENTS FOR TEST 003 *** 00710301 +C 00720301 + INTEGER KVTN02, AVTN02, KVTN03 00730301 +C 00740301 +C *** SPECIFICATION STATEMENTS FOR TEST 004 *** 00750301 +C 00760301 + REAL AVTN03, AVTN04, KVTN04 00770301 +C 00780301 +C *** SPECIFICATION STATEMENTS FOR TEST 005 *** 00790301 +C 00800301 + LOGICAL HVTN01 00810301 +C 00820301 +C *** SPECIFICATION STATEMENTS FOR TEST 006 *** 00830301 +C (ALSO SEE THE IMPLICIT STATEMENTS FOR TEST 006) 00840301 +C 00850301 + REAL MVTN01 00860301 +C 00870301 +C *** SPECIFICATION STATEMENTS FOR TEST 007 *** 00880301 +C 00890301 + INTEGER NVTN11(4) 00900301 +C 00910301 +C *** SPECIFICATION STATEMENTS FOR TEST 008 *** 00920301 +C 00930301 + REAL NVTN22(2,2) 00940301 +C 00950301 +C *** SPECIFICATION STATEMENTS FOR TESTS 009 AND 010 *** 00960301 +C 00970301 + INTEGER NVTN33(3,3,3), AVTN15(5) 00980301 +C 00990301 +C *** SPECIFICATION STATEMENTS FOR TEST 011 *** 01000301 +C 01010301 + DIMENSION NVTN14(5) 01020301 + INTEGER NVTN14 01030301 +C 01040301 +C *** SPECIFICATION STATEMENTS FOR TEST 012 *** 01050301 +C 01060301 + DIMENSION AVTN16(4) 01070301 + INTEGER AVTN16 01080301 +C 01090301 +C *** SPECIFICATION STATEMENTS FOR TESTS 013 AND 014 *** 01100301 +C 01110301 + CHARACTER CVTN01*14, CATN12(4)*14 01120301 +C 01130301 +C *** SPECIFICATION STATEMENTS FOR TEST 015 *** 01140301 +C 01150301 + DIMENSION CADN13(6) 01160301 + CHARACTER CADN13*14 01170301 +C 01180301 +C *** SPECIFICATION STATEMENTS FOR TEST 016 *** 01190301 +C 01200301 + CHARACTER KVTN05 01210301 +C 01220301 +C *** SPECIFICATION STATEMENTS FOR TEST 017 *** 01230301 +C (ALSO SEE THE IMPLICIT STATEMENT FOR TEST 017) 01240301 +C 01250301 + CHARACTER GVTN01*3 01260301 +C 01270301 +C *** SPECIFICATION STATEMENTS FOR TEST 018 *** 01280301 +C (ALSO SEE THE IMPLICIT STATEMENT FOR TEST 018) 01290301 +C 01300301 + CHARACTER FVTN01*3 01310301 +C 01320301 +C *** SPECIFICATION STATEMENTS FOR TEST 019 *** 01330301 +C 01340301 + INTEGER IFTN01 01350301 + IFTN01(IDON01) = IDON01 + 1 01360301 +C 01370301 +C 01380301 +C 01390301 +C INITIALIZATION SECTION. 01400301 +C 01410301 +C INITIALIZE CONSTANTS 01420301 +C ******************** 01430301 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01440301 + I01 = 5 01450301 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01460301 + I02 = 6 01470301 +C SYSTEM ENVIRONMENT SECTION 01480301 +C 01490301 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01500301 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01510301 +C (UNIT NUMBER FOR CARD READER). 01520301 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01530301 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01540301 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01550301 +C 01560301 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01570301 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01580301 +C (UNIT NUMBER FOR PRINTER). 01590301 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01600301 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01610301 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01620301 +C 01630301 + IVPASS = 0 01640301 + IVFAIL = 0 01650301 + IVDELE = 0 01660301 + ICZERO = 0 01670301 +C 01680301 +C WRITE OUT PAGE HEADERS 01690301 +C 01700301 + WRITE (I02,90002) 01710301 + WRITE (I02,90006) 01720301 + WRITE (I02,90008) 01730301 + WRITE (I02,90004) 01740301 + WRITE (I02,90010) 01750301 + WRITE (I02,90004) 01760301 + WRITE (I02,90016) 01770301 + WRITE (I02,90001) 01780301 + WRITE (I02,90004) 01790301 + WRITE (I02,90012) 01800301 + WRITE (I02,90014) 01810301 + WRITE (I02,90004) 01820301 +C 01830301 +C 01840301 +C **** FCVS PROGRAM 301 - TEST 001 **** 01850301 +C 01860301 +C TEST 001 DEFINES AN INTEGER VARIABLE OVERRIDING THE IMPLICIT 01870301 +C COMPILER DEFAULT TYPE SPECIFYING REAL. 01880301 +C 01890301 +C 01900301 + IVTNUM = 1 01910301 + IF (ICZERO) 30010, 0010, 30010 01920301 + 0010 CONTINUE 01930301 + IVCOMP = 0 01940301 + AVTN01 = 100 01950301 + IVCORR = 100 01960301 + IVCOMP = AVTN01 01970301 +40010 IF (IVCOMP - 100) 20010, 10010, 20010 01980301 +30010 IVDELE = IVDELE + 1 01990301 + WRITE (I02,80000) IVTNUM 02000301 + IF (ICZERO) 10010, 0021, 20010 02010301 +10010 IVPASS = IVPASS + 1 02020301 + WRITE (I02,80002) IVTNUM 02030301 + GO TO 0021 02040301 +20010 IVFAIL = IVFAIL + 1 02050301 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02060301 + 0021 CONTINUE 02070301 +C 02080301 +C **** FCVS PROGRAM 301 - TEST 002 **** 02090301 +C 02100301 +C TEST 002 DEFINES A REAL VARIABLE OVERRIDING THE IMPLICIT 02110301 +C COMPILER DEFAULT TYPE SPECIFYING INTEGER. 02120301 +C 02130301 +C 02140301 + IVTNUM = 2 02150301 + IF (ICZERO) 30020, 0020, 30020 02160301 + 0020 CONTINUE 02170301 + RVCOMP = 0.0 02180301 + KVTN01 = 1.004 02190301 + RVCORR = 1.004 02200301 + RVCOMP = KVTN01 02210301 +40020 IF (RVCOMP - 1.0035) 20020, 10020, 40021 02220301 +40021 IF (RVCOMP - 1.0045) 10020, 10020, 20020 02230301 +30020 IVDELE = IVDELE + 1 02240301 + WRITE (I02,80000) IVTNUM 02250301 + IF (ICZERO) 10020, 0031, 20020 02260301 +10020 IVPASS = IVPASS + 1 02270301 + WRITE (I02,80002) IVTNUM 02280301 + GO TO 0031 02290301 +20020 IVFAIL = IVFAIL + 1 02300301 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02310301 + 0031 CONTINUE 02320301 +C 02330301 +C **** FCVS PROGRAM 301 - TEST 003 **** 02340301 +C 02350301 +C TEST 003 DEFINES A SERIES OF INTEGER VARIABLES IN ONE TYPE- 02360301 +C STATEMENT. TWO VARIABLES CONFIRM THE IMPLICIT INTEGER TYPING. 02370301 +C THE OTHER VARIABLE OVERRIDES THE IMPLICIT TYPING. 02380301 +C 02390301 +C 02400301 + IVTNUM = 3 02410301 + IF (ICZERO) 30030, 0030, 30030 02420301 + 0030 CONTINUE 02430301 + IVCOMP = 0 02440301 + KVTN02 = 20 02450301 + KVTN03 = 30 02460301 + AVTN02 = 200 02470301 + IVCORR = 20 02480301 + IVCOMP = KVTN02 02490301 +40030 IF (IVCOMP - 20) 20030, 40031, 20030 02500301 +40031 IVCORR = 30 02510301 + IVCOMP = KVTN03 02520301 +40033 IF (IVCOMP - 30) 20030, 40034, 20030 02530301 +40034 IVCORR = 200 02540301 + IVCOMP = AVTN02 02550301 +40035 IF (IVCOMP - 200) 20030, 10030, 20030 02560301 +30030 IVDELE = IVDELE + 1 02570301 + WRITE (I02,80000) IVTNUM 02580301 + IF (ICZERO) 10030, 0041, 20030 02590301 +10030 IVPASS = IVPASS + 1 02600301 + WRITE (I02,80002) IVTNUM 02610301 + GO TO 0041 02620301 +20030 IVFAIL = IVFAIL + 1 02630301 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02640301 + 0041 CONTINUE 02650301 +C 02660301 +C **** FCVS PROGRAM 301 - TEST 004 **** 02670301 +C 02680301 +C TEST 004 DEFINES A SERIES OF REAL VARIABLES IN ONE TYPE- 02690301 +C STATEMENT. TWO VARIABLES CONFIRM THE IMPLICIT REAL TYPING. THE 02700301 +C THIRD VARIABLE OVERRIDES THE IMPLICIT TYPING. 02710301 +C 02720301 +C 02730301 + IVTNUM = 4 02740301 + IF (ICZERO) 30040, 0040, 30040 02750301 + 0040 CONTINUE 02760301 + RVCOMP = 0.0 02770301 + AVTN03 = 3.0 02780301 + AVTN04 = 4. 02790301 + KVTN04 = .4 02800301 + RVCORR = 3.0 02810301 + RVCOMP = AVTN03 02820301 +40040 IF (RVCOMP - 2.9995) 20040, 40042, 40041 02830301 +40041 IF (RVCOMP - 3.0005) 40042, 40042, 20040 02840301 +40042 RVCORR = 4. 02850301 + RVCOMP = AVTN04 02860301 +40043 IF (RVCOMP - 3.9995) 20040, 40045, 40044 02870301 +40044 IF (RVCOMP - 4.0005) 40045, 40045, 20040 02880301 +40045 RVCORR = .4 02890301 + RVCOMP = KVTN04 02900301 +40046 IF (RVCOMP - .39995) 20040, 10040, 40047 02910301 +40047 IF (RVCOMP - .40005) 10040, 10040, 20040 02920301 +30040 IVDELE = IVDELE + 1 02930301 + WRITE (I02,80000) IVTNUM 02940301 + IF (ICZERO) 10040, 0051, 20040 02950301 +10040 IVPASS = IVPASS + 1 02960301 + WRITE (I02,80002) IVTNUM 02970301 + GO TO 0051 02980301 +20040 IVFAIL = IVFAIL + 1 02990301 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03000301 + 0051 CONTINUE 03010301 +C 03020301 +C **** FCVS PROGRAM 301 - TEST 005 **** 03030301 +C 03040301 +C TEST 005 DEFINES A LOGICAL VARIABLE. 03050301 +C 03060301 +C 03070301 + IVTNUM = 5 03080301 + IF (ICZERO) 30050, 0050, 30050 03090301 + 0050 CONTINUE 03100301 + HVTN01 = .TRUE. 03110301 + IVCORR = 1 03120301 + IVCOMP = 0 03130301 + IF (HVTN01) IVCOMP = 1 03140301 +40050 IF (IVCOMP - 1) 20050, 10050, 20050 03150301 +30050 IVDELE = IVDELE + 1 03160301 + WRITE (I02,80000) IVTNUM 03170301 + IF (ICZERO) 10050, 0061, 20050 03180301 +10050 IVPASS = IVPASS + 1 03190301 + WRITE (I02,80002) IVTNUM 03200301 + GO TO 0061 03210301 +20050 IVFAIL = IVFAIL + 1 03220301 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03230301 + 0061 CONTINUE 03240301 +C 03250301 +C **** FCVS PROGRAM 301 - TEST 006 **** 03260301 +C 03270301 +C TEST 006 DEFINES A REAL VARIABLE WITH A TYPE-STATEMENT THAT 03280301 +C OVERRIDES THE IMPLICIT STATEMENT TYPING OF THE INTEGER LETTER 'M' 03290301 +C AS LOGICAL. 03300301 +C 03310301 +C 03320301 + IVTNUM = 6 03330301 + IF (ICZERO) 30060, 0060, 30060 03340301 + 0060 CONTINUE 03350301 + RVCOMP = 0.0 03360301 + MVTN01 = 12.345 03370301 + RVCORR = 12.345 03380301 + RVCOMP = MVTN01 03390301 +40060 IF (RVCOMP - 12.340) 20060, 10060, 40061 03400301 +40061 IF (RVCOMP - 12.350) 10060, 10060, 20060 03410301 +30060 IVDELE = IVDELE + 1 03420301 + WRITE (I02,80000) IVTNUM 03430301 + IF (ICZERO) 10060, 0071, 20060 03440301 +10060 IVPASS = IVPASS + 1 03450301 + WRITE (I02,80002) IVTNUM 03460301 + GO TO 0071 03470301 +20060 IVFAIL = IVFAIL + 1 03480301 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03490301 + 0071 CONTINUE 03500301 +C 03510301 +C **** FCVS PROGRAM 301 - TEST 007 **** 03520301 +C 03530301 +C TEST 007 DEFINES A ONE DIMENSIONAL INTEGER ARRAY. 03540301 +C 03550301 +C 03560301 + IVTNUM = 7 03570301 + IF (ICZERO) 30070, 0070, 30070 03580301 + 0070 CONTINUE 03590301 + IVCOMP = 0 03600301 + NVTN11(3) = 3 03610301 + IVCORR = 3 03620301 + IVCOMP = NVTN11(3) 03630301 +40070 IF (IVCOMP - 3) 20070, 10070, 20070 03640301 +30070 IVDELE = IVDELE + 1 03650301 + WRITE (I02,80000) IVTNUM 03660301 + IF (ICZERO) 10070, 0081, 20070 03670301 +10070 IVPASS = IVPASS + 1 03680301 + WRITE (I02,80002) IVTNUM 03690301 + GO TO 0081 03700301 +20070 IVFAIL = IVFAIL + 1 03710301 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03720301 + 0081 CONTINUE 03730301 +C 03740301 +C **** FCVS PROGRAM 301 - TEST 008 **** 03750301 +C 03760301 +C TEST 008 DEFINES A TWO DIMENSIONAL REAL ARRAY THAT OVERRIDES 03770301 +C THE IMPLICIT TYPING OF INTEGER. 03780301 +C 03790301 +C 03800301 + IVTNUM = 8 03810301 + IF (ICZERO) 30080, 0080, 30080 03820301 + 0080 CONTINUE 03830301 + RVCOMP = 0.0 03840301 + NVTN22(1,2) = 2.12 03850301 + RVCORR = 2.12 03860301 + RVCOMP = NVTN22(1,2) 03870301 +40080 IF (RVCOMP - 2.1195) 20080, 10080, 40081 03880301 +40081 IF (RVCOMP - 2.1205) 10080, 10080, 20080 03890301 +30080 IVDELE = IVDELE + 1 03900301 + WRITE (I02,80000) IVTNUM 03910301 + IF (ICZERO) 10080, 0091, 20080 03920301 +10080 IVPASS = IVPASS + 1 03930301 + WRITE (I02,80002) IVTNUM 03940301 + GO TO 0091 03950301 +20080 IVFAIL = IVFAIL + 1 03960301 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03970301 + 0091 CONTINUE 03980301 +C 03990301 +C **** FCVS PROGRAM 301 - TEST 009 **** 04000301 +C 04010301 +C TEST 009 DEFINES TWO INTEGER ARRAYS WITH ONE TYPE-STATEMENT. 04020301 +C ONE ARRAY IS THREE DIMENSIONAL WHILE THE OTHER ARRAY OVERRIDES 04030301 +C THE IMPLICIT TYPING OF REAL. ONLY THE THREE DIMENSIONAL ARRAY 04040301 +C IS CHECKED IN THIS TEST. 04050301 +C 04060301 +C 04070301 + IVTNUM = 9 04080301 + IF (ICZERO) 30090, 0090, 30090 04090301 + 0090 CONTINUE 04100301 + IVCOMP = 0 04110301 + NVTN33(1,2,3) = 123 04120301 + IVCORR = 123 04130301 + IVCOMP = NVTN33(1,2,3) 04140301 +40090 IF (IVCOMP - 123) 20090, 10090, 20090 04150301 +30090 IVDELE = IVDELE + 1 04160301 + WRITE (I02,80000) IVTNUM 04170301 + IF (ICZERO) 10090, 0101, 20090 04180301 +10090 IVPASS = IVPASS + 1 04190301 + WRITE (I02,80002) IVTNUM 04200301 + GO TO 0101 04210301 +20090 IVFAIL = IVFAIL + 1 04220301 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04230301 + 0101 CONTINUE 04240301 +C 04250301 +C **** FCVS PROGRAM 301 - TEST 010 **** 04260301 +C 04270301 +C TEST 010 CHECKS THE SECOND ARRAY DESCRIBED IN THE PREVIOUS 04280301 +C TEST. 04290301 +C 04300301 +C 04310301 + IVTNUM = 10 04320301 + IF (ICZERO) 30100, 0100, 30100 04330301 + 0100 CONTINUE 04340301 + IVCOMP = 0 04350301 + AVTN15(2) = 5 04360301 + IVCORR = 5 04370301 + IVCOMP = AVTN15(2) 04380301 +40100 IF (IVCOMP - 5) 20100, 10100, 20100 04390301 +30100 IVDELE = IVDELE + 1 04400301 + WRITE (I02,80000) IVTNUM 04410301 + IF (ICZERO) 10100, 0111, 20100 04420301 +10100 IVPASS = IVPASS + 1 04430301 + WRITE (I02,80002) IVTNUM 04440301 + GO TO 0111 04450301 +20100 IVFAIL = IVFAIL + 1 04460301 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04470301 + 0111 CONTINUE 04480301 +C 04490301 +C **** FCVS PROGRAM 301 - TEST 011 **** 04500301 +C 04510301 +C TEST 011 USES THE TYPE-STATEMENT TO EXPLICITLY TYPE AN ARRAY 04520301 +C THAT WAS DEFINED WITH A DIMENSION STATEMENT. 04530301 +C 04540301 +C 04550301 + IVTNUM = 11 04560301 + IF (ICZERO) 30110, 0110, 30110 04570301 + 0110 CONTINUE 04580301 + IVCOMP = 0 04590301 + NVTN14(5) = 5 04600301 + IVCORR = 5 04610301 + IVCOMP = NVTN14(5) 04620301 +40110 IF (IVCOMP - 5) 20110, 10110, 20110 04630301 +30110 IVDELE = IVDELE + 1 04640301 + WRITE (I02,80000) IVTNUM 04650301 + IF (ICZERO) 10110, 0121, 20110 04660301 +10110 IVPASS = IVPASS + 1 04670301 + WRITE (I02,80002) IVTNUM 04680301 + GO TO 0121 04690301 +20110 IVFAIL = IVFAIL + 1 04700301 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04710301 + 0121 CONTINUE 04720301 +C 04730301 +C **** FCVS PROGRAM 301 - TEST 012 **** 04740301 +C 04750301 +C TEST 012 USES THE TYPE-STATEMENT TO OVERRIDE THE TYPING OF 04760301 +C AN ARRAY THAT WAS DEFINED WITH A DIMENSION STATEMENT. 04770301 +C 04780301 + IVTNUM = 12 04790301 + IF (ICZERO) 30120, 0120, 30120 04800301 + 0120 CONTINUE 04810301 + IVCOMP = 0 04820301 + AVTN16(3) = 163 04830301 + IVCORR = 163 04840301 + IVCOMP = AVTN16(3) 04850301 +40120 IF (IVCOMP - 163) 20120, 10120, 20120 04860301 +30120 IVDELE = IVDELE + 1 04870301 + WRITE (I02,80000) IVTNUM 04880301 + IF (ICZERO) 10120, 0131, 20120 04890301 +10120 IVPASS = IVPASS + 1 04900301 + WRITE (I02,80002) IVTNUM 04910301 + GO TO 0131 04920301 +20120 IVFAIL = IVFAIL + 1 04930301 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04940301 + 0131 CONTINUE 04950301 +C 04960301 +C **** FCVS PROGRAM 301 - TEST 013 **** 04970301 +C 04980301 +C TEST 013 USES ONE CHARACTER TYPE-STATEMENT TO SPECIFY BOTH A 04990301 +C VARIABLE AND AN ARRAY DECLARATOR. ONLY THE VARIABLE IS CHECKED 05000301 +C IN THIS TEST. 05010301 +C 05020301 + IVTNUM = 13 05030301 + IF (ICZERO) 30130, 0130, 30130 05040301 + 0130 CONTINUE 05050301 + CVTN01 = '12345678901234' 05060301 + CVCOMP = ' ' 05070301 + CVCORR = '12345678901234' 05080301 + CVCOMP = CVTN01 05090301 +40130 IF (CVCOMP .EQ. '12345678901234') GO TO 10130 05100301 +40131 GO TO 20130 05110301 +30130 IVDELE = IVDELE + 1 05120301 + WRITE (I02,80000) IVTNUM 05130301 + IF (ICZERO) 10130, 0141, 20130 05140301 +10130 IVPASS = IVPASS + 1 05150301 + WRITE (I02,80002) IVTNUM 05160301 + GO TO 0141 05170301 +20130 IVFAIL = IVFAIL + 1 05180301 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05190301 + 0141 CONTINUE 05200301 +C 05210301 +C **** FCVS PROGRAM 301 - TEST 014 **** 05220301 +C 05230301 +C TEST 014 CHECKS THE ARRAY DECLARATOR FROM THE PREVIOUS TEST. 05240301 +C 05250301 + IVTNUM = 14 05260301 + IF (ICZERO) 30140, 0140, 30140 05270301 + 0140 CONTINUE 05280301 + CVCOMP = ' ' 05290301 + CATN12(2) = 'ABCDEFGHIJKLMN' 05300301 + CVCORR = 'ABCDEFGHIJKLMN' 05310301 + CVCOMP = CATN12(2) 05320301 +40140 IF (CVCOMP .EQ. 'ABCDEFGHIJKLMN') GO TO 10140 05330301 +40141 GO TO 20140 05340301 +30140 IVDELE = IVDELE + 1 05350301 + WRITE (I02,80000) IVTNUM 05360301 + IF (ICZERO) 10140, 0151, 20140 05370301 +10140 IVPASS = IVPASS + 1 05380301 + WRITE (I02,80002) IVTNUM 05390301 + GO TO 0151 05400301 +20140 IVFAIL = IVFAIL + 1 05410301 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05420301 + 0151 CONTINUE 05430301 +C 05440301 +C **** FCVS PROGRAM 301 - TEST 015 **** 05450301 +C 05460301 +C TEST 015 USES THE CHARACTER TYPE-STATEMENT TO SPECIFY AN 05470301 +C ARRAY-NAME. THE ARRAY IS DECLARED IN A DIMENSION STATEMENT. 05480301 +C 05490301 + IVTNUM = 15 05500301 + IF (ICZERO) 30150, 0150, 30150 05510301 + 0150 CONTINUE 05520301 + CVCOMP = ' ' 05530301 + CADN13(3) = '12345678901234' 05540301 + CVCORR = '12345678901234' 05550301 + CVCOMP = CADN13(3) 05560301 +40150 IF (CVCOMP .EQ. '12345678901234') GO TO 10150 05570301 +40151 GO TO 20150 05580301 +30150 IVDELE = IVDELE + 1 05590301 + WRITE (I02,80000) IVTNUM 05600301 + IF (ICZERO) 10150, 0161, 20150 05610301 +10150 IVPASS = IVPASS + 1 05620301 + WRITE (I02,80002) IVTNUM 05630301 + GO TO 0161 05640301 +20150 IVFAIL = IVFAIL + 1 05650301 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05660301 + 0161 CONTINUE 05670301 +C 05680301 +C **** FCVS PROGRAM 301 - TEST 016 **** 05690301 +C 05700301 +C TEST 016 USES THE CHARACTER TYPE-STATEMENT TO OVERRIDE THE 05710301 +C IMPLICIT (DEFAULT) TYPING OF INTEGER. 05720301 +C 05730301 + IVTNUM = 16 05740301 + IF (ICZERO) 30160, 0160, 30160 05750301 + 0160 CONTINUE 05760301 + CVCOMP = ' ' 05770301 + KVTN05 = 'A' 05780301 + CVCORR = 'A' 05790301 + CVCOMP = KVTN05 05800301 +40160 IF (CVCOMP .EQ. 'A') GO TO 10160 05810301 +40161 GO TO 20160 05820301 +30160 IVDELE = IVDELE + 1 05830301 + WRITE (I02,80000) IVTNUM 05840301 + IF (ICZERO) 10160, 0171, 20160 05850301 +10160 IVPASS = IVPASS + 1 05860301 + WRITE (I02,80002) IVTNUM 05870301 + GO TO 0171 05880301 +20160 IVFAIL = IVFAIL + 1 05890301 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05900301 + 0171 CONTINUE 05910301 +C 05920301 +C **** FCVS PROGRAM 301 - TEST 017 **** 05930301 +C 05940301 +C TEST 017 USES THE CHARACTER TYPE-STATEMENT TO OVERRIDE THE 05950301 +C IMPLICIT TYPING OF THE LETTER 'G' AS INTEGER. 05960301 +C 05970301 + IVTNUM = 17 05980301 + IF (ICZERO) 30170, 0170, 30170 05990301 + 0170 CONTINUE 06000301 + CVCOMP = ' ' 06010301 + GVTN01 = 'ABC' 06020301 + CVCORR = 'ABC' 06030301 + CVCOMP = GVTN01 06040301 +40170 IF (CVCOMP .EQ. 'ABC') GO TO 10170 06050301 +40171 GO TO 20170 06060301 +30170 IVDELE = IVDELE + 1 06070301 + WRITE (I02,80000) IVTNUM 06080301 + IF (ICZERO) 10170, 0181, 20170 06090301 +10170 IVPASS = IVPASS + 1 06100301 + WRITE (I02,80002) IVTNUM 06110301 + GO TO 0181 06120301 +20170 IVFAIL = IVFAIL + 1 06130301 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06140301 + 0181 CONTINUE 06150301 +C 06160301 +C **** FCVS PROGRAM 301 - TEST 018 **** 06170301 +C 06180301 +C TEST 018 USES THE CHARAACTER TYPE-STATEMENT TO OVERRIDE THE 06190301 +C LENGTH OF A CHARACTER FIELD DEFINED BY AN IMPLICIT STATEMENT. 06200301 +C 06210301 + IVTNUM = 18 06220301 + IF (ICZERO) 30180, 0180, 30180 06230301 + 0180 CONTINUE 06240301 + CVCOMP = ' ' 06250301 + FVTN01 = 'ABC' 06260301 + CVCORR = 'ABC' 06270301 + CVCOMP = FVTN01 06280301 +40180 IF (CVCOMP .EQ. 'ABC') GO TO 10180 06290301 +40181 GO TO 20180 06300301 +30180 IVDELE = IVDELE + 1 06310301 + WRITE (I02,80000) IVTNUM 06320301 + IF (ICZERO) 10180, 0191, 20180 06330301 +10180 IVPASS = IVPASS + 1 06340301 + WRITE (I02,80002) IVTNUM 06350301 + GO TO 0191 06360301 +20180 IVFAIL = IVFAIL + 1 06370301 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06380301 + 0191 CONTINUE 06390301 +C 06400301 +C **** FCVS PROGRAM 301 - TEST 019 **** 06410301 +C 06420301 +C TEST 019 USES THE TYPE-STATEMENT TO SPECIFY AN INTEGER 06430301 +C STATEMENT FUNCTION. 06440301 +C 06450301 + IVTNUM = 19 06460301 + IF (ICZERO) 30190, 0190, 30190 06470301 + 0190 CONTINUE 06480301 + IVCOMP = 0 06490301 + IVON01 = 5 06500301 + IVON02 = IFTN01(IVON01) 06510301 + IVCORR = 6 06520301 + IVCOMP = IVON02 06530301 +40190 IF (IVCOMP - 6) 20190, 10190, 20190 06540301 +30190 IVDELE = IVDELE + 1 06550301 + WRITE (I02,80000) IVTNUM 06560301 + IF (ICZERO) 10190, 0201, 20190 06570301 +10190 IVPASS = IVPASS + 1 06580301 + WRITE (I02,80002) IVTNUM 06590301 + GO TO 0201 06600301 +20190 IVFAIL = IVFAIL + 1 06610301 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06620301 + 0201 CONTINUE 06630301 +C 06640301 +C 06650301 +C WRITE OUT TEST SUMMARY 06660301 +C 06670301 + WRITE (I02,90004) 06680301 + WRITE (I02,90014) 06690301 + WRITE (I02,90004) 06700301 + WRITE (I02,90000) 06710301 + WRITE (I02,90004) 06720301 + WRITE (I02,90020) IVFAIL 06730301 + WRITE (I02,90022) IVPASS 06740301 + WRITE (I02,90024) IVDELE 06750301 + STOP 06760301 +90001 FORMAT (" ",24X,"FM301") 06770301 +90000 FORMAT (" ",20X,"END OF PROGRAM FM301" ) 06780301 +C 06790301 +C FORMATS FOR TEST DETAIL LINES 06800301 +C 06810301 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 06820301 +80002 FORMAT (" ",4X,I5,7X,"PASS") 06830301 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 06840301 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 06850301 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 06860301 +C 06870301 +C FORMAT STATEMENTS FOR PAGE HEADERS 06880301 +C 06890301 +90002 FORMAT ("1") 06900301 +90004 FORMAT (" ") 06910301 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06920301 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 06930301 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 06940301 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 06950301 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 06960301 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 06970301 +C 06980301 +C FORMAT STATEMENTS FOR RUN SUMMARY 06990301 +C 07000301 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 07010301 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 07020301 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 07030301 + END 07040301 diff --git a/Fortran/UnitTests/fcvs21_f95/FM301.reference_output b/Fortran/UnitTests/fcvs21_f95/FM301.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM301.reference_output @@ -0,0 +1,40 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM301 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + + ---------------------------------------------- + + END OF PROGRAM FM301 + + 0 TESTS FAILED + 19 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM302.f b/Fortran/UnitTests/fcvs21_f95/FM302.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM302.f @@ -0,0 +1,810 @@ + PROGRAM FM302 00010302 +C 00020302 +C 00030302 +C THIS ROUTINE TESTS THE SUBSET LEVEL FEATURES OF THE COMMON 00040302 +C SPECIFICATION STATEMENT. INTEGER, REAL AND LOGICAL VARIABLES AND 00050302 +C ARRAYS ARE PASSED BACK-AND-FORTH BETWEEN THE MAIN PROGRAM,EXTERNAL00060302 +C FUNCTIONS AND SUBROUTINES. BOTH NAMED AND UNNAMED (BLANK) COMMON 00070302 +C ARE TESTED. SPECIFIC TESTS ARE INCLUDED FOR RENAMING ENTITIES IN 00080302 +C COMMON BETWEEN PROGRAM UNITS, THE PASSING OF DATA THROUGH COMMON 00090302 +C BY EQUIVALENCE ASSOCIATION, AND THE SPECIFYING OF BLANK COMMON OF 00100302 +C DIFFERENT LENGTHS IN DIFFERENT PROGRAM UNITS. THE SUBSET LEVEL 00110302 +C FEATURES OF THE COMMON STATEMENT ARE ALSO TESTED IN FM022 THROUGH 00120302 +C FM025, FM050 AND FM056. 00130302 +C 00140302 +C REFERENCES. 00150302 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00160302 +C X3.9-1978 00170302 +C 00180302 +C SECTION 8.2, EQUIVALENCE STATEMENT 00190302 +C SECTION 8.3, COMMON STATEMENT 00200302 +C SECTION 15.5, EXTERNAL FUNCTIONS 00210302 +C SECTION 15.6, SUBROUTINES 00220302 +C SECTION 15.9.4, COMMON BLOCKS 00230302 +C 00240302 +C 00250302 +C ******************************************************************00260302 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00270302 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00280302 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00290302 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00300302 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00310302 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00320302 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00330302 +C THE RESULT OF EXECUTING THESE TESTS. 00340302 +C 00350302 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00360302 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00370302 +C 00380302 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00390302 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00400302 +C SOFTWARE STANDARDS VALIDATION GROUP 00410302 +C BUILDING 225 RM A266 00420302 +C GAITHERSBURG, MD 20899 00430302 +C ******************************************************************00440302 +C 00450302 +C 00460302 + IMPLICIT LOGICAL (L) 00470302 + IMPLICIT CHARACTER*14 (C) 00480302 +C 00490302 + 00500302 +C 00510302 +C *** SPECIFICATION STATEMENT FOR TEST 001 *** 00520302 +C 00530302 + COMMON IVCN01 00540302 +C 00550302 +C *** SPECIFICATION STATEMENT FOR TEST 002 *** 00560302 +C 00570302 + COMMON //IVCN02,LVCN01 00580302 +C 00590302 +C *** SPECIFICATION STATEMENT FOR TEST 003 *** 00600302 +C 00610302 + COMMON RVCN01//IVCN03 00620302 +C 00630302 +C *** SPECIFICATION STATEMENT FOR TEST 004 *** 00640302 +C 00650302 + COMMON IVCN04, IVCN05, // IACN11(4) 00660302 +C 00670302 +C *** SPECIFICATION STATEMENT FOR TEST 005 *** 00680302 +C 00690302 + COMMON /BLK1/ IVCNA1 00700302 +C 00710302 +C *** SPECIFICATION STATEMENT FOR TEST 006 *** 00720302 +C 00730302 + COMMON /BLK2/IVCNB1,RVCNB1, /BLK2/IVCNB2 00740302 +C 00750302 +C *** SPECIFICATION STATEMENT FOR TEST 007 *** 00760302 +C 00770302 + DIMENSION RACN11(10) 00780302 + COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3) 00790302 +C 00800302 +C *** SPECIFICATION STATEMENT FOR TEST 008 *** 00810302 +C 00820302 + COMMON /BLK5/IVCND1, IVCND2 00830302 +C 00840302 +C *** SPECIFICATION STATEMENT FOR TEST 009 *** 00850302 +C 00860302 + COMMON IVCN06/BLK5/RVCND1,LVCND1//IVCN07,IVCN08/BLK6/RVCNE1 00870302 +C 00880302 +C *** SPECIFICATION STATEMENT FOR TEST 010 *** 00890302 +C 00900302 + DIMENSION IACN1F(3) 00910302 + COMMON /BLK7/IVCNF1,IVCNF2,IVCNF3,IACN1F 00920302 +C 00930302 +C *** SPECIFICATION STATEMENT FOR TEST 011 *** 00940302 +C 00950302 + EQUIVALENCE (IVCEH1,IVCEH2) 00960302 + COMMON /BLK8/IVCEH1 00970302 +C 00980302 +C *** SPECIFICATION STATEMENT FOR TEST 012 00990302 + EQUIVALENCE (IVCE09,IVCE10) 01000302 + COMMON IVCE09 01010302 +C 01020302 +C *** SPECIFICATION STATEMENT FOR TEST 013 01030302 +C 01040302 + EQUIVALENCE (IVCEI1,IACE1I) 01050302 + DIMENSION IACE1I(3) 01060302 + COMMON /BLK9/IVCEI1 01070302 +C 01080302 +C *** SPECIFICATION STATEMENT FOR TEST 014 *** 01090302 +C 01100302 + COMMON IVCN12 01110302 +C 01120302 +C *** SPECIFICATION STATEMENT FOR TEST 015 *** 01130302 +C 01140302 + COMMON /BLK10/IVCNJ1 01150302 +C 01160302 +C *** SPECIFICATION STATEMENT FOR TEST 016 *** 01170302 +C 01180302 + COMMON /BLKCHR/CVTN01,CVTN02,CATN11 01190302 + CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5 01200302 + INTEGER FF304 01210302 +C 01220302 +C 01230302 +C 01240302 +C INITIALIZATION SECTION. 01250302 +C 01260302 +C INITIALIZE CONSTANTS 01270302 +C ******************** 01280302 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01290302 + I01 = 5 01300302 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01310302 + I02 = 6 01320302 +C SYSTEM ENVIRONMENT SECTION 01330302 +C 01340302 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01350302 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01360302 +C (UNIT NUMBER FOR CARD READER). 01370302 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01380302 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01390302 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01400302 +C 01410302 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01420302 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01430302 +C (UNIT NUMBER FOR PRINTER). 01440302 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01450302 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01460302 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01470302 +C 01480302 + IVPASS = 0 01490302 + IVFAIL = 0 01500302 + IVDELE = 0 01510302 + ICZERO = 0 01520302 +C 01530302 +C WRITE OUT PAGE HEADERS 01540302 +C 01550302 + WRITE (I02,90002) 01560302 + WRITE (I02,90006) 01570302 + WRITE (I02,90008) 01580302 + WRITE (I02,90004) 01590302 + WRITE (I02,90010) 01600302 + WRITE (I02,90004) 01610302 + WRITE (I02,90016) 01620302 + WRITE (I02,90001) 01630302 + WRITE (I02,90004) 01640302 + WRITE (I02,90012) 01650302 + WRITE (I02,90014) 01660302 + WRITE (I02,90004) 01670302 +C 01680302 +C 01690302 +C THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA 01700302 +C ENTITIES BEING PASSED THROUGH COMMON TO SUBROUTINE FS303. ONLY 01710302 +C ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM. THE 01720302 +C CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON ARE 01730302 +C THEN CHECKED IN THIS PROGRAM. 01740302 +C 01750302 +C 01760302 + IVCN01 = 3 01770302 + IVCN02 = 2 01780302 + LVCN01 = .FALSE. 01790302 + IVCNA1 = 25 01800302 + IVCNB1 = 3 01810302 + RVCNB1 = 4.0 01820302 + IVCNB2 = 5 01830302 + LVCNC1 = .TRUE. 01840302 + IVCNC1 = 13 01850302 + RACN11(1) = 1. 01860302 + RACN11(10) = 10.0 01870302 + IACN21(1,1) = 11 01880302 + IACN21(2,3) = 23 01890302 + IVCNF1 = 41 01900302 + IVCNF3 = 43 01910302 + IACN1F(1) = 141 01920302 + IACN1F(2) = 142 01930302 + IVCEH1 = 1 01940302 + IVCEH2 = 5 01950302 + CVTN01 = 'AB' 01960302 + CVTN02 = 'CDE' 01970302 + CATN11(1) = 'FGHIJ' 01980302 + CATN11(2) = 'KLMNO' 01990302 + CATN11(3) = 'PQRST' 02000302 + CALL FS303 02010302 +C 02020302 +C THE FOLLOWING ASSIGNMENT STATEMENTS INITIALIZE THE DATA 02030302 +C ENTITIES BEING PASSED THROUGH COMMON TO EXTERNAL FUNCTION FF304. 02040302 +C ONLY ONE REFERENCE TO THIS SUBPROGRAM IS MADE FROM THIS PROGRAM. 02050302 +C THE CONTENTS OF THE DATA ENTITIES BEING RETURNED THROUGH COMMON 02060302 +C ARE THEN CHECKED IN THIS PROGRAM. 02070302 +C 02080302 + RVCN01 = 6.4 02090302 + IVCN03 = 11 02100302 + IVCN03 = IVCN03*2 02110302 + IVCN04 = 16 02120302 + IVCN05 = 16 02130302 + IACN11(1) = 1 02140302 + IACN11(2) = 2 02150302 + IACN11(3) = 3 02160302 + IACN11(4) = 4 02170302 + IVCND1 = +33 02180302 + IVCND2 = 10 02190302 + IVCN06 = 6 02200302 + IVCN07 = 7 02210302 + IVCN08 = 8 02220302 + RVCND1 = 1.3 02230302 + LVCND1 = .FALSE. 02240302 + RVCNE1 = +3.5 02250302 + IVCE09 = 9 02260302 + IVCE10 = 10 02270302 + IVCEI1 = 5 02280302 + IACE1I(1) = 10 02290302 + IACE1I(2) = 15 02300302 + IACE1I(3) = 20 02310302 + IVCNJ1 = 1 02320302 + IVON99 = FF304 ( ) 02330302 +C 02340302 +C TESTS 001 THROUGH 009 ARE DESIGNED TO TEST VARIOUS 02350302 +C SYNTACTICAL CONSTRUCTS OF THE COMMON STATEMENT USING NAMED AND 02360302 +C UNNAMED (BLANK) COMMON IN THE MAIN PROGRAM, A SUBROUTINE AND AN 02370302 +C EXTERNAL FUNCTION. DATA ENTITIES CONSIST OF INTEGER, REAL AND 02380302 +C LOGICAL VARIABLES AND INTEGER AND REAL ARRAYS. 02390302 +C 02400302 +C **** FCVS PROGRAM 302 - TEST 001 **** 02410302 +C 02420302 +C TESTS 001 AND 002 TEST THE USE OF UNNAMED COMMON IN A MAIN 02430302 +C PROGRAM AND A SUBROUTINE. 02440302 +C 02450302 + IVTNUM = 1 02460302 + IF (ICZERO) 30010, 0010, 30010 02470302 + 0010 CONTINUE 02480302 + IVCOMP = 0 02490302 + IVCOMP = IVCN01 02500302 + IVCORR = 4 02510302 +40010 IF (IVCOMP - 4) 20010, 10010, 20010 02520302 +30010 IVDELE = IVDELE + 1 02530302 + WRITE (I02,80000) IVTNUM 02540302 + IF (ICZERO) 10010, 0021, 20010 02550302 +10010 IVPASS = IVPASS + 1 02560302 + WRITE (I02,80002) IVTNUM 02570302 + GO TO 0021 02580302 +20010 IVFAIL = IVFAIL + 1 02590302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02600302 + 0021 CONTINUE 02610302 +C 02620302 +C **** FCVS PROGRAM 302 - TEST 002 **** 02630302 +C 02640302 +C 02650302 + IVTNUM = 2 02660302 + IF (ICZERO) 30020, 0020, 30020 02670302 + 0020 CONTINUE 02680302 + IVCOMP = 1 02690302 + IF (IVCN02 .EQ. 7) IVCOMP = IVCOMP * 2 02700302 + IF (LVCN01) IVCOMP = IVCOMP * 3 02710302 + IVCORR = 6 02720302 +C 6 = 2 * 3 02730302 +40020 IF (IVCOMP - 6) 20020, 10020, 20020 02740302 +30020 IVDELE = IVDELE + 1 02750302 + WRITE (I02,80000) IVTNUM 02760302 + IF (ICZERO) 10020, 0031, 20020 02770302 +10020 IVPASS = IVPASS + 1 02780302 + WRITE (I02,80002) IVTNUM 02790302 + GO TO 0031 02800302 +20020 IVFAIL = IVFAIL + 1 02810302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02820302 + 0031 CONTINUE 02830302 +C 02840302 +C **** FCVS PROGRAM 302 - TEST 003 **** 02850302 +C 02860302 +C TESTS 003 AND 004 TEST THE USE OF UNNAMED COMMON IN A MAIN 02870302 +C PROGRAM AND AN EXTERNAL FUNCTION. 02880302 +C 02890302 + IVTNUM = 3 02900302 + IF (ICZERO) 30030, 0030, 30030 02910302 + 0030 CONTINUE 02920302 + IVCOMP = 1 02930302 + IF (RVCN01 .GE. 4.1995 .AND. RVCN01 .LE. 4.2005) IVCOMP=IVCOMP*2 02940302 + IF (IVCN03 .EQ. 23) IVCOMP = IVCOMP * 3 02950302 + IVCORR = 6 02960302 +C 6 = 2 * 3 02970302 +40030 IF (IVCOMP - 6) 20030, 10030, 20030 02980302 +30030 IVDELE = IVDELE + 1 02990302 + WRITE (I02,80000) IVTNUM 03000302 + IF (ICZERO) 10030, 0041, 20030 03010302 +10030 IVPASS = IVPASS + 1 03020302 + WRITE (I02,80002) IVTNUM 03030302 + GO TO 0041 03040302 +20030 IVFAIL = IVFAIL + 1 03050302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03060302 + 0041 CONTINUE 03070302 +C 03080302 +C **** FCVS PROGRAM 302 - TEST 004 **** 03090302 +C 03100302 +C 03110302 + IVTNUM = 4 03120302 + IF (ICZERO) 30040, 0040, 30040 03130302 + 0040 CONTINUE 03140302 + IVCOMP = 1 03150302 + IF (IVCN04 .EQ. 8) IVCOMP = IVCOMP * 2 03160302 + IF (IVCN05 .EQ. 16) IVCOMP = IVCOMP * 3 03170302 + IF (IACN11(1) .EQ. 5) IVCOMP = IVCOMP * 5 03180302 + IF (IACN11(2) .EQ. 5) IVCOMP = IVCOMP * 7 03190302 + IF (IACN11(3) .EQ. 5) IVCOMP = IVCOMP * 11 03200302 + IF (IACN11(4) .EQ. 5) IVCOMP = IVCOMP * 13 03210302 + IVCORR = 30030 03220302 +C 30030 = 2 * 3 * 5 * 7 * 11 * 13 03230302 +40040 IF (IVCOMP - 30030) 20040, 10040, 20040 03240302 +30040 IVDELE = IVDELE + 1 03250302 + WRITE (I02,80000) IVTNUM 03260302 + IF (ICZERO) 10040, 0051, 20040 03270302 +10040 IVPASS = IVPASS + 1 03280302 + WRITE (I02,80002) IVTNUM 03290302 + GO TO 0051 03300302 +20040 IVFAIL = IVFAIL + 1 03310302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03320302 + 0051 CONTINUE 03330302 +C 03340302 +C **** FCVS PROGRAM 302 - TEST 005 **** 03350302 +C 03360302 +C TESTS 005 THROUGH 007 TEST THE USE OF NAMED COMMON BLOCKS 03370302 +C IN A MAIN PROGRAM AND A SUBROUTINE. 03380302 +C 03390302 + IVTNUM = 5 03400302 + IF (ICZERO) 30050, 0050, 30050 03410302 + 0050 CONTINUE 03420302 + IVCOMP = 0 03430302 + IVCOMP = IVCNA1 03440302 + IVCORR = 5 03450302 +40050 IF (IVCOMP - 5) 20050, 10050, 20050 03460302 +30050 IVDELE = IVDELE + 1 03470302 + WRITE (I02,80000) IVTNUM 03480302 + IF (ICZERO) 10050, 0061, 20050 03490302 +10050 IVPASS = IVPASS + 1 03500302 + WRITE (I02,80002) IVTNUM 03510302 + GO TO 0061 03520302 +20050 IVFAIL = IVFAIL + 1 03530302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03540302 + 0061 CONTINUE 03550302 +C 03560302 +C **** FCVS PROGRAM 302 - TEST 006 **** 03570302 +C 03580302 +C 03590302 + IVTNUM = 6 03600302 + IF (ICZERO) 30060, 0060, 30060 03610302 + 0060 CONTINUE 03620302 + IVCOMP = 1 03630302 + IF (IVCNB1 .EQ. 8) IVCOMP = IVCOMP * 2 03640302 + IF (RVCNB1 .GE. 3.4995 .AND. RVCNB1 .LE. 3.5005) IVCOMP=IVCOMP*3 03650302 + IF (IVCNB2 .EQ. 5) IVCOMP = IVCOMP * 5 03660302 + IVCORR = 30 03670302 +C 30 = 2 * 3 * 5 03680302 +40060 IF (IVCOMP - 30) 20060, 10060, 20060 03690302 +30060 IVDELE = IVDELE + 1 03700302 + WRITE (I02,80000) IVTNUM 03710302 + IF (ICZERO) 10060, 0071, 20060 03720302 +10060 IVPASS = IVPASS + 1 03730302 + WRITE (I02,80002) IVTNUM 03740302 + GO TO 0071 03750302 +20060 IVFAIL = IVFAIL + 1 03760302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03770302 + 0071 CONTINUE 03780302 +C 03790302 +C **** FCVS PROGRAM 302 - TEST 007 **** 03800302 +C 03810302 +C 03820302 + IVTNUM = 7 03830302 + IF (ICZERO) 30070, 0070, 30070 03840302 + 0070 CONTINUE 03850302 + IVCOMP = 1 03860302 + IF (.NOT. LVCNC1) IVCOMP = IVCOMP * 2 03870302 + IF (IVCNC1 .EQ. 12) IVCOMP = IVCOMP * 3 03880302 + IF (RACN11(1).GE.110.95 .AND. RACN11(1).LE.111.05) IVCOMP=IVCOMP*503890302 + IF (RACN11(10).GE.109.95.AND.RACN11(10).LE.110.05)IVCOMP=IVCOMP*7 03900302 + IF (IACN21(1,1) .EQ. 12) IVCOMP = IVCOMP * 11 03910302 + IF (IACN21 (2,3) .EQ. 24) IVCOMP = IVCOMP * 13 03920302 + IVCORR = 30030 03930302 +C 30030 = 2* 3 * 5 * 7 * 11 * 13 03940302 +40070 IF (IVCOMP - 30030) 20070, 10070, 20070 03950302 +30070 IVDELE = IVDELE + 1 03960302 + WRITE (I02,80000) IVTNUM 03970302 + IF (ICZERO) 10070, 0081, 20070 03980302 +10070 IVPASS = IVPASS + 1 03990302 + WRITE (I02,80002) IVTNUM 04000302 + GO TO 0081 04010302 +20070 IVFAIL = IVFAIL + 1 04020302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04030302 + 0081 CONTINUE 04040302 +C 04050302 +C **** FCVS PROGRAM 302 - TEST 008 **** 04060302 +C 04070302 +C TESTS 008 AND 009 TEST THE USE OF NAMED COMMON BLOCKS IN A 04080302 +C MAIN PROGRAM AND AN EXTERNAL FUNCTION. 04090302 +C 04100302 + IVTNUM = 8 04110302 + IF (ICZERO) 30080, 0080, 30080 04120302 + 0080 CONTINUE 04130302 + IVCOMP = 1 04140302 + IF (IVCND1 .EQ. 34) IVCOMP = IVCOMP * 2 04150302 + IF (IVCND2 .EQ. 11) IVCOMP = IVCOMP * 3 04160302 + IVCORR = 6 04170302 +C 6 = 2 * 3 04180302 +40080 IF (IVCOMP - 6) 20080, 10080, 20080 04190302 +30080 IVDELE = IVDELE + 1 04200302 + WRITE (I02,80000) IVTNUM 04210302 + IF (ICZERO) 10080, 0091, 20080 04220302 +10080 IVPASS = IVPASS + 1 04230302 + WRITE (I02,80002) IVTNUM 04240302 + GO TO 0091 04250302 +20080 IVFAIL = IVFAIL + 1 04260302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04270302 + 0091 CONTINUE 04280302 +C 04290302 +C **** FCVS PROGRAM 302 - TEST 009 **** 04300302 +C 04310302 +C 04320302 + IVTNUM = 9 04330302 + IF (ICZERO) 30090, 0090, 30090 04340302 + 0090 CONTINUE 04350302 + IVCOMP = 1 04360302 + IF (IVCN06 .EQ. 7) IVCOMP = IVCOMP * 2 04370302 + IF (RVCND1 .GE. 4.4995 .AND. RVCND1 .LE. 4.5005) IVCOMP = IVCOMP*304380302 + IF (LVCND1) IVCOMP = IVCOMP * 5 04390302 + IF (IVCN07 .EQ. -7) IVCOMP = IVCOMP * 7 04400302 + IF (IVCN08 .EQ. -3) IVCOMP = IVCOMP * 11 04410302 + IF (RVCNE1.GE.-6.7005.AND.RVCNE1.LE.-6.6995) IVCOMP=IVCOMP*13 04420302 + IVCORR = 30030 04430302 +C 30030 = 2 * 3 * 5 * 7 * 11 * 13 04440302 +40090 IF (IVCOMP - 30030) 20090, 10090, 20090 04450302 +30090 IVDELE = IVDELE + 1 04460302 + WRITE (I02,80000) IVTNUM 04470302 + IF (ICZERO) 10090, 0101, 20090 04480302 +10090 IVPASS = IVPASS + 1 04490302 + WRITE (I02,80002) IVTNUM 04500302 + GO TO 0101 04510302 +20090 IVFAIL = IVFAIL + 1 04520302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04530302 + 0101 CONTINUE 04540302 +C 04550302 +C **** FCVS PROGRAM 302 - TEST 010 **** 04560302 +C 04570302 +C TEST 010 IS DESIGNED TO TEST THE ABILITY TO RENAME ENTITIES 04580302 +C IN NAMED COMMON BETWEEN A MAIN PROGRAM AND A SUBROUTINE. 04590302 +C 04600302 + IVTNUM = 10 04610302 + IF (ICZERO) 30100, 0100, 30100 04620302 + 0100 CONTINUE 04630302 + IVCOMP = 1 04640302 + IF (IVCNF1 .EQ. 42) IVCOMP = IVCOMP * 2 04650302 + IF (IVCNF2 .EQ. 43) IVCOMP = IVCOMP * 3 04660302 + IF (IVCNF3 .EQ. 44) IVCOMP = IVCOMP * 5 04670302 + IF (IACN1F(1) .EQ. 142) IVCOMP = IVCOMP * 7 04680302 + IF (IACN1F(2) .EQ. 143) IVCOMP = IVCOMP * 11 04690302 + IF (IACN1F(3) .EQ. 144) IVCOMP = IVCOMP * 13 04700302 + IVCORR = 30030 04710302 +C 30030 = 2 * 3 * 5 * 7 * 11 * 13 04720302 +40100 IF (IVCOMP - 30030) 20100, 10100, 20100 04730302 +30100 IVDELE = IVDELE + 1 04740302 + WRITE (I02,80000) IVTNUM 04750302 + IF (ICZERO) 10100, 0111, 20100 04760302 +10100 IVPASS = IVPASS + 1 04770302 + WRITE (I02,80002) IVTNUM 04780302 + GO TO 0111 04790302 +20100 IVFAIL = IVFAIL + 1 04800302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04810302 + 0111 CONTINUE 04820302 +C 04830302 +C **** FCVS PROGRAM 302 - TEST 011 **** 04840302 +C 04850302 +C TEST 011 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN 04860302 +C NAMED COMMON BY EQUIVALENCE ASSOCIATION. 04870302 +C 04880302 + IVTNUM = 11 04890302 + IF (ICZERO) 30110, 0110, 30110 04900302 + 0110 CONTINUE 04910302 + IVCOMP = 0 04920302 + IVCOMP = IVCEH2 04930302 + IVCORR = 6 04940302 +40110 IF (IVCOMP - 6) 20110, 10110, 20110 04950302 +30110 IVDELE = IVDELE + 1 04960302 + WRITE (I02,80000) IVTNUM 04970302 + IF (ICZERO) 10110, 0121, 20110 04980302 +10110 IVPASS = IVPASS + 1 04990302 + WRITE (I02,80002) IVTNUM 05000302 + GO TO 0121 05010302 +20110 IVFAIL = IVFAIL + 1 05020302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05030302 + 0121 CONTINUE 05040302 +C 05050302 +C **** FCVS PROGRAM 302 - TEST 012 **** 05060302 +C 05070302 +C TEST 012 IS DESIGNED TO TEST THE STORAGE OF A VARIABLE IN 05080302 +C UNNAMED COMMON BY EQUIVALENCE ASSOCIATION. 05090302 +C 05100302 + IVTNUM = 12 05110302 + IF (ICZERO) 30120, 0120, 30120 05120302 + 0120 CONTINUE 05130302 + IVCOMP = 1 05140302 + IF (IVCE09 .EQ. 100) IVCOMP = IVCOMP * 2 05150302 + IF (IVCE10 .EQ. 100) IVCOMP = IVCOMP * 3 05160302 + IVCORR = 6 05170302 +C 6 = 2 * 3 05180302 +40120 IF (IVCOMP - 6) 20120, 10120, 20120 05190302 +30120 IVDELE = IVDELE + 1 05200302 + WRITE (I02,80000) IVTNUM 05210302 + IF (ICZERO) 10120, 0131, 20120 05220302 +10120 IVPASS = IVPASS + 1 05230302 + WRITE (I02,80002) IVTNUM 05240302 + GO TO 0131 05250302 +20120 IVFAIL = IVFAIL + 1 05260302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05270302 + 0131 CONTINUE 05280302 +C 05290302 +C **** FCVS PROGRAM 302 - TEST 013 **** 05300302 +C 05310302 +C TEST 013 IS DESIGNED TO TEST THE EXTENSION OF NAMED COMMON 05320302 +C BLOCK STORAGE BY EQUIVALENCE ASSOCIATION OF A VARIABLE AND AN 05330302 +C ARRAY. 05340302 +C 05350302 + IVTNUM = 13 05360302 + IF (ICZERO) 30130, 0130, 30130 05370302 + 0130 CONTINUE 05380302 + IVCOMP = 1 05390302 + IF (IVCEI1 .EQ. 11) IVCOMP = IVCOMP * 2 05400302 + IF (IACE1I(1) .EQ. 11) IVCOMP = IVCOMP * 3 05410302 + IF (IACE1I(2) .EQ. 16) IVCOMP = IVCOMP * 5 05420302 + IF (IACE1I(3) .EQ. 21) IVCOMP = IVCOMP * 7 05430302 + IVCORR = 210 05440302 +C 210 = 2 * 3 * 5 * 7 05450302 +40130 IF (IVCOMP - 210) 20130, 10130, 20130 05460302 +30130 IVDELE = IVDELE + 1 05470302 + WRITE (I02,80000) IVTNUM 05480302 + IF (ICZERO) 10130, 0141, 20130 05490302 +10130 IVPASS = IVPASS + 1 05500302 + WRITE (I02,80002) IVTNUM 05510302 + GO TO 0141 05520302 +20130 IVFAIL = IVFAIL + 1 05530302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05540302 + 0141 CONTINUE 05550302 +C 05560302 +C **** FCVS PROGRAM 302 - TEST 014 **** 05570302 +C 05580302 +C TEST 014 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA 05590302 +C THROUGH UNNAMED COMMON FROM EXTERNAL FUNCTIONS WHICH HAVE MORE 05600302 +C ENTITIES IN UNNAMED COMMON THAN THE MAIN PROGRAM. 05610302 +C 05620302 + IVTNUM = 14 05630302 + IF (ICZERO) 30140, 0140, 30140 05640302 + 0140 CONTINUE 05650302 + IVCOMP = 0 05660302 + IVCOMP = IVCN12 05670302 + IVCORR = 11 05680302 +40140 IF (IVCOMP - 11) 20140, 10140, 20140 05690302 +30140 IVDELE = IVDELE + 1 05700302 + WRITE (I02,80000) IVTNUM 05710302 + IF (ICZERO) 10140, 0151, 20140 05720302 +10140 IVPASS = IVPASS + 1 05730302 + WRITE (I02,80002) IVTNUM 05740302 + GO TO 0151 05750302 +20140 IVFAIL = IVFAIL + 1 05760302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05770302 + 0151 CONTINUE 05780302 +C 05790302 +C **** FCVS PROGRAM 302 - TEST 015 **** 05800302 +C 05810302 +C TEST 015 IS DESIGNED TO TEST THE ABILITY OF PASSING DATA 05820302 +C THROUGH NAMED COMMON BETWEEN EXTERNAL FUNCTIONS WHERE THE NAMED 05830302 +C COMMON BLOCK IS NOT SPECIFIED IN THE MAIN PROGRAM. 05840302 +C 05850302 + IVTNUM = 15 05860302 + IF (ICZERO) 30150, 0150, 30150 05870302 + 0150 CONTINUE 05880302 + IVCOMP = 0 05890302 + IVCOMP = IVCNJ1 05900302 + IVCORR = 5 05910302 +40150 IF (IVCOMP - 5) 20150, 10150, 20150 05920302 +30150 IVDELE = IVDELE + 1 05930302 + WRITE (I02,80000) IVTNUM 05940302 + IF (ICZERO) 10150, 0161, 20150 05950302 +10150 IVPASS = IVPASS + 1 05960302 + WRITE (I02,80002) IVTNUM 05970302 + GO TO 0161 05980302 +20150 IVFAIL = IVFAIL + 1 05990302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06000302 + 0161 CONTINUE 06010302 +C 06020302 +C **** FCVS PROGRAM 302 - TEST 016 **** 06030302 +C 06040302 +C TEST 016 IS DESIGNED TO TEST THE PASSING OF CHARACTER DATA 06050302 +C IN NAMED COMMON BETWEEN THE MAIN PROGRAM AND A SUBROUTINE. 06060302 +C 06070302 + IVTNUM = 16 06080302 + IF (ICZERO) 30160, 0160, 30160 06090302 + 0160 CONTINUE 06100302 + IVCOMP = 1 06110302 + IF (CVTN01 .EQ. 'YZ') IVCOMP = IVCOMP * 2 06120302 + IF (CVTN02 .EQ. 'UVW') IVCOMP = IVCOMP * 3 06130302 + IF (CATN11(1) .EQ. 'VWXYZ') IVCOMP = IVCOMP * 5 06140302 + IF (CATN11(2) .EQ. 'KLMNO') IVCOMP = IVCOMP * 7 06150302 + IF (CATN11(3) .EQ. 'ABCDE') IVCOMP = IVCOMP * 11 06160302 + IVCORR = 2310 06170302 +C 2310 = 2 * 3 * 5 * 7 * 11 06180302 +40160 IF (IVCOMP - 2310) 20160, 10160, 20160 06190302 +30160 IVDELE = IVDELE + 1 06200302 + WRITE (I02,80000) IVTNUM 06210302 + IF (ICZERO) 10160, 0171, 20160 06220302 +10160 IVPASS = IVPASS + 1 06230302 + WRITE (I02,80002) IVTNUM 06240302 + GO TO 0171 06250302 +20160 IVFAIL = IVFAIL + 1 06260302 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06270302 + 0171 CONTINUE 06280302 +C 06290302 +C 06300302 +C WRITE OUT TEST SUMMARY 06310302 +C 06320302 + WRITE (I02,90004) 06330302 + WRITE (I02,90014) 06340302 + WRITE (I02,90004) 06350302 + WRITE (I02,90000) 06360302 + WRITE (I02,90004) 06370302 + WRITE (I02,90020) IVFAIL 06380302 + WRITE (I02,90022) IVPASS 06390302 + WRITE (I02,90024) IVDELE 06400302 + STOP 06410302 +90001 FORMAT (" ",24X,"FM302") 06420302 +90000 FORMAT (" ",20X,"END OF PROGRAM FM302" ) 06430302 +C 06440302 +C FORMATS FOR TEST DETAIL LINES 06450302 +C 06460302 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 06470302 +80002 FORMAT (" ",4X,I5,7X,"PASS") 06480302 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 06490302 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 06500302 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 06510302 +C 06520302 +C FORMAT STATEMENTS FOR PAGE HEADERS 06530302 +C 06540302 +90002 FORMAT ("1") 06550302 +90004 FORMAT (" ") 06560302 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06570302 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 06580302 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 06590302 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 06600302 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 06610302 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 06620302 +C 06630302 +C FORMAT STATEMENTS FOR RUN SUMMARY 06640302 +C 06650302 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 06660302 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 06670302 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 06680302 + END 06690302 + + SUBROUTINE FS303 00010303 +C 00020303 +C FS303 IS A SUBROUTINE WHICH IS CALLED ONCE FROM PROGRAM FM302. 00030303 +C IT IS USED TO MODIFY VARIABLES AND ARRAY PASSED THROUGH NAMED AND 00040303 +C UNNAMED COMMON FROM FM302. AFTER THE DATA ENTITIES ARE MODIFIED 00050303 +C CONTROL IS RETURNED TO FM302 WHERE EACH ENTITY IS TESTED. 00060303 +C 00070303 + IMPLICIT LOGICAL (L) 00080303 + DIMENSION RACN11(10) 00090303 + COMMON IVCN01 00100303 + COMMON //IVCN02, LVCN01 00110303 + COMMON RVCN01//IVCN03 00120303 + COMMON IVCN04,IVCN05, //IACN11(4) 00130303 + COMMON /BLK1/IVCNA1 00140303 + COMMON /BLK2/IVCNB1,RVCNB1,/BLK2/IVCNB2 00150303 + COMMON /BLK3/LVCNC1,IVCNC1/BLK4/RACN11,IACN21(2,3) 00160303 + COMMON /BLK7/IACN1G(5),IVCNG1 00170303 + COMMON /BLK8/IVCNH1 00180303 + COMMON /BLKCHR/CVTN01,CVTN02,CATN11 00190303 + CHARACTER CVTN01*2, CVTN02*3, CATN11(3)*5 00200303 +C TEST 001 00210303 + IVCN01 = IVCN01 + 1 00220303 +C TEST 002 00230303 + IVCN02 = IVCN02 + 5 00240303 + LVCN01 = .NOT. LVCN01 00250303 +C TEST 005 00260303 + IVCNA1 = IVCNA1 / 5 00270303 +C TEST 006 00280303 + IVCNB1 = IVCNB1 + IVCNB2 00290303 + RVCNB1 = 3.5 00300303 +C TEST 007 00310303 + LVCNC1 = .FALSE. 00320303 + IVCNC1 = IVCNC1 - 1 00330303 + RACN11(1) = 111. 00340303 + RACN11(10) = 110. 00350303 + IACN21(1,1) = IACN21(1,1) + 1 00360303 + IACN21(2,3) = IACN21(2,3) + 1 00370303 +C TEST 010 00380303 + IACN1G(1) = IACN1G(1) + 1 00390303 + IACN1G(2) = 43 00400303 + IACN1G(3) = IACN1G(3) + 1 00410303 + IACN1G(4) = IACN1G(4) + 1 00420303 + IACN1G(5) = IACN1G(5) + 1 00430303 + IVCNG1 = 144 00440303 +C TEST 011 00450303 + IVCNH1 = IVCNH1 + 1 00460303 +C TEST 017 00470303 + CVTN01 = 'YZ' 00480303 + CVTN02 = 'UVW' 00490303 + CATN11(1) = 'VWXYZ' 00500303 + CATN11(3) = 'ABCDE' 00510303 + RETURN 00520303 + END 00530303 + + INTEGER FUNCTION FF304 () 00010304 +C 00020304 +C FF304 IS AN EXTERNAL FUNCTION WHICH IS REFERENCED ONCE FROM 00030304 +C PROGRAM FM302. IT IS USED TO MODIFY VARIABLES AND ARRAYS PASSED 00040304 +C THROUGH NAMED AND UNNAMED COMMON FROM FM302. AFTER THE DATA 00050304 +C ENTITIES ARE MODIFIED CONTROL IS RETURNED TO FM302 WHERE EACH 00060304 +C ENTITY IS TESTED. A FUNCTION VALUE OF 999 IS RETURNED BUT IT IS 00070304 +C NOT SIGNIFICANT NOR IS IT TESTED BY FM302. 00080304 +C 00090304 + IMPLICIT LOGICAL (L) 00100304 + DIMENSION IACN11(4) 00110304 + COMMON IVCN01 00120304 + COMMON IVCN02, LVCN01 00130304 + COMMON RVCN01, IVCN03 00140304 + COMMON IVCN04,IVCN05,IACN11 00150304 + COMMON /BLK5/IVCND1,IVCND2 00160304 + COMMON IVCN06 00170304 + COMMON /BLK5/RVCND1,LVCND1 00180304 + COMMON IVCN07, IVCN08 00190304 + COMMON /BLK6/RVCNE1 00200304 + COMMON IVCN10 00210304 + COMMON /BLK9/IVCNI1, IVCNI2, IVCNI3 00220304 + COMMON IVCN12, IVCN13 00230304 + COMMON /BLK10/IVCNJ1 00240304 + COMMON /BLK11/IVCNK1 00250304 + INTEGER FF305 00260304 +C TEST 003 00270304 + RVCN01 = 4.2 00280304 + IVCN03 = IVCN03 + 1 00290304 +C TEST 004 00300304 + IVCN04 = 32 00310304 + IVCN04 = IVCN04 / 4 00320304 + IVCN05 = IVCN05 00330304 + IACN11(1) = IACN11(1) + 4 00340304 + IACN11(2) = IACN11(2) + 3 00350304 + IACN11(3) = IACN11(3) + 2 00360304 + IACN11(4) = IACN11(4) + 1 00370304 +C TEST 008 00380304 + IVCND1 = IVCND1 + 1 00390304 + IVCND2 = IVCND2 + 1 00400304 +C TEST 009 00410304 + IVCN06 = IVCN06 + 1 00420304 + RVCND1 = 4.5 00430304 + LVCND1 = .TRUE. 00440304 + IVCN07 = -IVCN07 00450304 + IVCN08 = -3 00460304 + RVCNE1 = -6.7 00470304 +C TEST 012 00480304 + IVCN10 = IVCN10 * IVCN10 00490304 +C TEST 013 00500304 + IVCNI1 = IVCNI1 + 1 00510304 + IVCNI2 = IVCNI2 + 1 00520304 + IVCNI3 = IVCNI3 + 1 00530304 +C TEST 014 00540304 + IVCN13 = 5 00550304 +C TEST 015 00560304 + IVCNK1 = 3 00570304 +C 00580304 +C FOR TESTS 014 AND 015 EXTERNAL FUNCTION FF305 IS REFERENCED 00590304 +C 00600304 + IVON99 = FF305 () 00610304 +C TEST 014 00620304 + IVCN12 = IVCN13 00630304 +C TEST 015 00640304 + IVCNJ1 = IVCNK1 00650304 + FF304 = 999 00660304 + RETURN 00670304 + END 00680304 + + INTEGER FUNCTION FF305 () 00010305 +C 00020305 +C FF305 IS AN EXTERNAL FUNCTION WHICH IS USED IN TEST 014 AND 00030305 +C 015 OF PROGRAM FM302. THIS SUBPROGRAM IS REFERENCED FROM EXTERNAL 00040305 +C FUNCTION FF304. 00050305 +C 00060305 + COMMON IACN11(15) 00070305 + COMMON IVCN12, IVCN13, IVCN14 00080305 + COMMON /BLK10/IVCNJ1, /BLK11/IVCNK1 00090305 +C TEST 014 00100305 + IVCN14 = 11 00110305 + IVCN13 = IVCN14 00120305 +C TEST 015 00130305 + IVCNK1 = 5 00140305 + FF305 = 999 00150305 + RETURN 00160305 + END 00170305 diff --git a/Fortran/UnitTests/fcvs21_f95/FM302.reference_output b/Fortran/UnitTests/fcvs21_f95/FM302.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM302.reference_output @@ -0,0 +1,37 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM302 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + + ---------------------------------------------- + + END OF PROGRAM FM302 + + 0 TESTS FAILED + 16 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM306.f b/Fortran/UnitTests/fcvs21_f95/FM306.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM306.f @@ -0,0 +1,477 @@ + PROGRAM FM306 00010306 +C 00020306 +C 00030306 +C THIS ROUTINE TESTS THE USE OF THE SUBSET LEVEL FEATURES OF 00040306 +C THE IMPLICIT SPECIFICATION STATEMENT. THE DEFAULT IMPLIED INTEGER00050306 +C AND REAL TYPING IS EITHER CONFIRMED OR OVERRIDDEN TO SPECIFY 00060306 +C INTEGER, REAL AND LOGICAL TYPING. ALL 26 ALPHABETIC LETTERS ARE 00070306 +C USED TO INDICATE THE IMPLICIT TYPING. VARIABLE AND ARRAY 00080306 +C ENTITIES ARE USED TO TEST THE ACTUAL TYPING. THE SUBSET LEVEL 00090306 +C FEATURES OF THE IMPLICIT STATEMENT ARE ALSO TESTED IN ROUTINES 00100306 +C FM201 AND FM251. 00110306 +C 00120306 +C REFERENCES. 00130306 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00140306 +C X3.9-1978 00150306 +C 00160306 +C SECTION 4.1.2, TYPE RULES FOR DATA AND PROCEDURE IDENTIFIERS. 00170306 +C SECTION 8.5, IMPLICIT STATEMENT 00180306 +C 00190306 +C 00200306 +C ******************************************************************00210306 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00220306 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00230306 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00240306 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00250306 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00260306 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00270306 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00280306 +C THE RESULT OF EXECUTING THESE TESTS. 00290306 +C 00300306 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00310306 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00320306 +C 00330306 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00340306 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00350306 +C SOFTWARE STANDARDS VALIDATION GROUP 00360306 +C BUILDING 225 RM A266 00370306 +C GAITHERSBURG, MD 20899 00380306 +C ******************************************************************00390306 +C 00400306 +C 00410306 + IMPLICIT LOGICAL (L) 00420306 + IMPLICIT CHARACTER*14 (C) 00430306 +C 00440306 + IMPLICIT INTEGER (A) 00450306 + IMPLICIT LOGICAL (B) 00460306 + IMPLICIT INTEGER (D,E,F) 00470306 + IMPLICIT REAL (G-H) 00480306 + IMPLICIT INTEGER (I) 00490306 + IMPLICIT REAL (J) 00500306 + IMPLICIT INTEGER (K,O-Q) 00510306 + IMPLICIT REAL (M), REAL (N) 00520306 + IMPLICIT REAL (R) 00530306 + IMPLICIT REAL (S), INTEGER (T-V) 00540306 + IMPLICIT INTEGER (W), REAL (X), LOGICAL (Y), INTEGER (Z) 00550306 + DIMENSION AAIN11(5) 00560306 + DIMENSION HAIN11(5) 00570306 +C 00580306 +C 00590306 +C 00600306 +C INITIALIZATION SECTION. 00610306 +C 00620306 +C INITIALIZE CONSTANTS 00630306 +C ******************** 00640306 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00650306 + I01 = 5 00660306 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00670306 + I02 = 6 00680306 +C SYSTEM ENVIRONMENT SECTION 00690306 +C 00700306 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00710306 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720306 +C (UNIT NUMBER FOR CARD READER). 00730306 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00740306 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00750306 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00760306 +C 00770306 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00780306 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00790306 +C (UNIT NUMBER FOR PRINTER). 00800306 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00810306 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00820306 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00830306 +C 00840306 + IVPASS = 0 00850306 + IVFAIL = 0 00860306 + IVDELE = 0 00870306 + ICZERO = 0 00880306 +C 00890306 +C WRITE OUT PAGE HEADERS 00900306 +C 00910306 + WRITE (I02,90002) 00920306 + WRITE (I02,90006) 00930306 + WRITE (I02,90008) 00940306 + WRITE (I02,90004) 00950306 + WRITE (I02,90010) 00960306 + WRITE (I02,90004) 00970306 + WRITE (I02,90016) 00980306 + WRITE (I02,90001) 00990306 + WRITE (I02,90004) 01000306 + WRITE (I02,90012) 01010306 + WRITE (I02,90014) 01020306 + WRITE (I02,90004) 01030306 +C 01040306 +C 01050306 +C **** FCVS PROGRAM 306 - TEST 001 **** 01060306 +C 01070306 +C TEST 001 IS DESIGNED TO CONFIRM IMPLICIT INTEGER TYPING. 01080306 +C 01090306 + IVTNUM = 1 01100306 + IF (ICZERO) 30010, 0010, 30010 01110306 + 0010 CONTINUE 01120306 + RVCOMP = 10.0 01130306 + IVIN01 = 4 01140306 + RVCOMP = IVIN01 / 5 01150306 + RVCORR = 0.0 01160306 +40010 IF (RVCOMP) 20010, 10010, 20010 01170306 +30010 IVDELE = IVDELE + 1 01180306 + WRITE (I02,80000) IVTNUM 01190306 + IF (ICZERO) 10010, 0021, 20010 01200306 +10010 IVPASS = IVPASS + 1 01210306 + WRITE (I02,80002) IVTNUM 01220306 + GO TO 0021 01230306 +20010 IVFAIL = IVFAIL + 1 01240306 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01250306 + 0021 CONTINUE 01260306 +C 01270306 +C **** FCVS PROGRAM 306 - TEST 002 **** 01280306 +C 01290306 +C TEST 002 IS DESIGNED TO CONFIRM IMPLICIT REAL TYPING. 01300306 +C 01310306 + IVTNUM = 2 01320306 + IF (ICZERO) 30020, 0020, 30020 01330306 + 0020 CONTINUE 01340306 + RVCOMP = 10.0 01350306 + RVIN01 = 4 01360306 + RVCOMP = RVIN01/5 01370306 + RVCORR = .8 01380306 +40020 IF (RVCOMP - .79995) 20020, 10020, 40021 01390306 +40021 IF (RVCOMP - .80005) 10020, 10020, 20020 01400306 +30020 IVDELE = IVDELE + 1 01410306 + WRITE (I02,80000) IVTNUM 01420306 + IF (ICZERO) 10020, 0031, 20020 01430306 +10020 IVPASS = IVPASS + 1 01440306 + WRITE (I02,80002) IVTNUM 01450306 + GO TO 0031 01460306 +20020 IVFAIL = IVFAIL + 1 01470306 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01480306 + 0031 CONTINUE 01490306 +C 01500306 +C **** FCVS PROGRAM 306 - TEST 003 **** 01510306 +C 01520306 +C TEST 003 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF 01530306 +C INTEGER WITH IMPLICIT TYPING OF REAL. 01540306 +C 01550306 + IVTNUM = 3 01560306 + IF (ICZERO) 30030, 0030, 30030 01570306 + 0030 CONTINUE 01580306 + RVCOMP = 10.0 01590306 + JVIN01 = 4 01600306 + RVCOMP = JVIN01/5 01610306 + RVCORR = .8 01620306 +40030 IF (RVCOMP - .79995) 20030, 10030, 40031 01630306 +40031 IF (RVCOMP - .80005) 10030, 10030, 20030 01640306 +30030 IVDELE = IVDELE + 1 01650306 + WRITE (I02,80000) IVTNUM 01660306 + IF (ICZERO) 10030, 0041, 20030 01670306 +10030 IVPASS = IVPASS + 1 01680306 + WRITE (I02,80002) IVTNUM 01690306 + GO TO 0041 01700306 +20030 IVFAIL = IVFAIL + 1 01710306 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01720306 + 0041 CONTINUE 01730306 +C 01740306 +C **** FCVS PROGRAM 306 - TEST 004 **** 01750306 +C 01760306 +C TEST 004 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF 01770306 +C INTEGER WITH IMPLICIT TYPING OF LOGICAL. 01780306 +C 01790306 + IVTNUM = 4 01800306 + IF (ICZERO) 30040, 0040, 30040 01810306 + 0040 CONTINUE 01820306 + LVIN01 = .TRUE. 01830306 + IVCORR = 1 01840306 + IVCOMP = 0 01850306 + IF (LVIN01) IVCOMP = 1 01860306 +40040 IF (IVCOMP - 1) 20040, 10040, 20040 01870306 +30040 IVDELE = IVDELE + 1 01880306 + WRITE (I02,80000) IVTNUM 01890306 + IF (ICZERO) 10040, 0051, 20040 01900306 +10040 IVPASS = IVPASS + 1 01910306 + WRITE (I02,80002) IVTNUM 01920306 + GO TO 0051 01930306 +20040 IVFAIL = IVFAIL + 1 01940306 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01950306 + 0051 CONTINUE 01960306 +C 01970306 +C **** FCVS PROGRAM 306 - TEST 005 **** 01980306 +C 01990306 +C TEST 005 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF 02000306 +C REAL WITH IMPLICIT TYPING OF INTEGER. 02010306 +C 02020306 + IVTNUM = 5 02030306 + IF (ICZERO) 30050, 0050, 30050 02040306 + 0050 CONTINUE 02050306 + RVCOMP = 10.0 02060306 + AAIN11(2) = 4 02070306 + RVCOMP = AAIN11(2)/5 02080306 + RVCORR = 0.0 02090306 +40050 IF (RVCOMP) 20050, 10050, 20050 02100306 +30050 IVDELE = IVDELE + 1 02110306 + WRITE (I02,80000) IVTNUM 02120306 + IF (ICZERO) 10050, 0061, 20050 02130306 +10050 IVPASS = IVPASS + 1 02140306 + WRITE (I02,80002) IVTNUM 02150306 + GO TO 0061 02160306 +20050 IVFAIL = IVFAIL + 1 02170306 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02180306 + 0061 CONTINUE 02190306 +C 02200306 +C **** FCVS PROGRAM 306 - TEST 006 **** 02210306 +C 02220306 +C TEST 006 IS DESIGNED TO OVERRIDE IMPLICIT DEFAULT TYPING OF REAL 02230306 +C WITH IMPLICIT TYPING OF LOGICAL. 02240306 +C 02250306 + IVTNUM = 6 02260306 + IF (ICZERO) 30060, 0060, 30060 02270306 + 0060 CONTINUE 02280306 + BVIN01 = .TRUE. 02290306 + IVCORR = 1 02300306 + IVCOMP = 0 02310306 + IF (BVIN01) IVCOMP = 1 02320306 +40060 IF (IVCOMP - 1) 20060, 10060, 20060 02330306 +30060 IVDELE = IVDELE + 1 02340306 + WRITE (I02,80000) IVTNUM 02350306 + IF (ICZERO) 10060, 0071, 20060 02360306 +10060 IVPASS = IVPASS + 1 02370306 + WRITE (I02,80002) IVTNUM 02380306 + GO TO 0071 02390306 +20060 IVFAIL = IVFAIL + 1 02400306 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02410306 + 0071 CONTINUE 02420306 +C 02430306 +C TESTS 007 THROUGH 012 ARE DESIGNED TO TEST VARIOUS SYNTACTICAL 02440306 +C CONSTRUCTS OF THE IMPLICIT STATEMENT. 02450306 +C 02460306 +C 02470306 +C **** FCVS PROGRAM 306 - TEST 007 **** 02480306 +C 02490306 +C TEST 007 TESTS THE SPECIFYING OF MORE THAN ONE ALPHABETIC 02500306 +C CHARACTER IN AN IMPLICIT STATEMENT. 02510306 +C 02520306 + IVTNUM = 7 02530306 + IF (ICZERO) 30070, 0070, 30070 02540306 + 0070 CONTINUE 02550306 + DVIN01 = 4 02560306 + EVIN01 = 4 02570306 + FVIN01 = 4 02580306 + RVCMP1 = DVIN01/5 02590306 + RVCMP2 = EVIN01/5 02600306 + RVCMP3 = FVIN01/5 02610306 + IVCOMP = 1 02620306 + IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2 02630306 + IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3 02640306 + IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5 02650306 + IVCORR = 30 02660306 +C 30 = 2 * 3 * 5 02670306 +40070 IF (IVCOMP - 30) 20070, 10070, 20070 02680306 +30070 IVDELE = IVDELE + 1 02690306 + WRITE (I02,80000) IVTNUM 02700306 + IF (ICZERO) 10070, 0081, 20070 02710306 +10070 IVPASS = IVPASS + 1 02720306 + WRITE (I02,80002) IVTNUM 02730306 + GO TO 0081 02740306 +20070 IVFAIL = IVFAIL + 1 02750306 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02760306 + 0081 CONTINUE 02770306 +C 02780306 +C **** FCVS PROGRAM 306 - TEST 008 **** 02790306 +C 02800306 +C TEST 008 TESTS THE SPECIFYING A RANGE OF SINGLE LETTERS IN 02810306 +C ALPHABETIC ORDER IN AN IMPLICIT STATEMENT. 02820306 +C 02830306 + IVTNUM = 8 02840306 + IF (ICZERO) 30080, 0080, 30080 02850306 + 0080 CONTINUE 02860306 + GVIN01 = 4 02870306 + HAIN11(4) = 4 02880306 + RVCMP1 = GVIN01/5 02890306 + RVCMP2 = HAIN11(4)/5 02900306 + IVCOMP = 1 02910306 + IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2 02920306 + IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3 02930306 + IVCORR = 6 02940306 +C 6 = 2 * 3 02950306 +40080 IF (IVCOMP - 6) 20080, 10080, 20080 02960306 +30080 IVDELE = IVDELE + 1 02970306 + WRITE (I02,80000) IVTNUM 02980306 + IF (ICZERO) 10080, 0091, 20080 02990306 +10080 IVPASS = IVPASS + 1 03000306 + WRITE (I02,80002) IVTNUM 03010306 + GO TO 0091 03020306 +20080 IVFAIL = IVFAIL + 1 03030306 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03040306 + 0091 CONTINUE 03050306 +C 03060306 +C **** FCVS PROGRAM 306 - TEST 009 **** 03070306 +C 03080306 +C TEST 009 TESTS THE SPECIFYING A SINGLE LETTER AND A RANGE OF 03090306 +C SINGLE LETTERS IN ALPHABETIC ORDER IN AN IMPLICIT STATEMENT. 03100306 +C 03110306 + IVTNUM = 9 03120306 + IF (ICZERO) 30090, 0090, 30090 03130306 + 0090 CONTINUE 03140306 + KVIN01 = 4 03150306 + OVIN01 = 4 03160306 + PVIN01 = 4 03170306 + QVIN01 = 4 03180306 + RVCMP1 = KVIN01/5 03190306 + RVCMP2 = OVIN01/5 03200306 + RVCMP3 = PVIN01/5 03210306 + RVCMP4 = QVIN01/5 03220306 + IVCOMP = 1 03230306 + IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2 03240306 + IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3 03250306 + IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5 03260306 + IF (RVCMP4 .EQ. 0.0) IVCOMP = IVCOMP * 7 03270306 + IVCORR = 210 03280306 +C 210 = 2 * 3 * 5 * 7 03290306 +40090 IF (IVCOMP - 210) 20090, 10090, 20090 03300306 +30090 IVDELE = IVDELE + 1 03310306 + WRITE (I02,80000) IVTNUM 03320306 + IF (ICZERO) 10090, 0101, 20090 03330306 +10090 IVPASS = IVPASS + 1 03340306 + WRITE (I02,80002) IVTNUM 03350306 + GO TO 0101 03360306 +20090 IVFAIL = IVFAIL + 1 03370306 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03380306 + 0101 CONTINUE 03390306 +C 03400306 +C **** FCVS PROGRAM 306 - TEST 010 **** 03410306 +C 03420306 +C TEST 010 TESTS THE SPECIFYING OF MORE THAN ONE TYPING IN ONE 03430306 +C IMPLICIT STATEMENT. 03440306 +C 03450306 + IVTNUM = 10 03460306 + IF (ICZERO) 30100, 0100, 30100 03470306 + 0100 CONTINUE 03480306 + SVIN01 = 4 03490306 + TVIN01 = 4 03500306 + UVIN01 = 4 03510306 + VVIN01 = 4 03520306 + RVCMP1 = SVIN01/5 03530306 + RVCMP2 = TVIN01/5 03540306 + RVCMP3 = UVIN01/5 03550306 + RVCMP4 = VVIN01/5 03560306 + IVCOMP = 1 03570306 + IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2 03580306 + IF (RVCMP2 .EQ. 0.0) IVCOMP = IVCOMP * 3 03590306 + IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 5 03600306 + IF (RVCMP4 .EQ. 0.0) IVCOMP = IVCOMP * 7 03610306 + IVCORR = 210 03620306 +C 210 = 2 * 3 * 5 * 7 03630306 + IF (IVCOMP - 210) 20100, 10100, 20100 03640306 +30100 IVDELE = IVDELE + 1 03650306 + WRITE (I02,80000) IVTNUM 03660306 + IF (ICZERO) 10100, 0111, 20100 03670306 +10100 IVPASS = IVPASS + 1 03680306 + WRITE (I02,80002) IVTNUM 03690306 + GO TO 0111 03700306 +20100 IVFAIL = IVFAIL + 1 03710306 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03720306 + 0111 CONTINUE 03730306 +C 03740306 +C **** FCVS PROGRAM 306 - TEST 011 **** 03750306 +C 03760306 +C TEST 011 TESTS THE SPECIFYING OF INTEGER, REAL, AND LOGICAL 03770306 +C TYPING IN ONE IMPLICIT STATEMENT. IN THIS TEST INTEGER TYPING 03780306 +C IS REPEATED A SECOND TIME. 03790306 +C 03800306 + IVTNUM = 11 03810306 + IF (ICZERO) 30110, 0110, 30110 03820306 + 0110 CONTINUE 03830306 + WVIN01 = 4 03840306 + XVIN01 = 4 03850306 + YVIN01 = .TRUE. 03860306 + ZVIN01 = 4 03870306 + RVCMP1 = WVIN01/5 03880306 + RVCMP2 = XVIN01/5 03890306 + LVCOMP = YVIN01 03900306 + RVCMP3 = ZVIN01/5 03910306 + IVCOMP = 1 03920306 + IF (RVCMP1 .EQ. 0.0) IVCOMP = IVCOMP * 2 03930306 + IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3 03940306 + IF (LVCOMP) IVCOMP = IVCOMP * 5 03950306 + IF (RVCMP3 .EQ. 0.0) IVCOMP = IVCOMP * 7 03960306 + IVCORR = 210 03970306 +C 210 = 2 * 3 * 5 * 7 03980306 +40110 IF (IVCOMP - 210) 20110, 10110, 20110 03990306 +30110 IVDELE = IVDELE + 1 04000306 + WRITE (I02,80000) IVTNUM 04010306 + IF (ICZERO) 10110, 0121, 20110 04020306 +10110 IVPASS = IVPASS + 1 04030306 + WRITE (I02,80002) IVTNUM 04040306 + GO TO 0121 04050306 +20110 IVFAIL = IVFAIL + 1 04060306 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04070306 + 0121 CONTINUE 04080306 +C 04090306 +C **** FCVS PROGRAM 306 - TEST 012 **** 04100306 +C 04110306 +C TEST 012 TESTS THE SPECIFYING OF REAL TYPING TWICE IN ONE 04120306 +C IMPLICIT STATEMENT. 04130306 +C 04140306 + IVTNUM = 12 04150306 + IF (ICZERO) 30120, 0120, 30120 04160306 + 0120 CONTINUE 04170306 + MVIN01 = 4 04180306 + NVIN01 = 4 04190306 + RVCMP1 = MVIN01/5 04200306 + RVCMP2 = NVIN01/5 04210306 + IVCOMP = 1 04220306 + IF (RVCMP1 .GE. .79995 .AND. RVCMP1 .LE. .80005) IVCOMP=IVCOMP*2 04230306 + IF (RVCMP2 .GE. .79995 .AND. RVCMP2 .LE. .80005) IVCOMP=IVCOMP*3 04240306 + IVCORR = 6 04250306 +C 6 = 2 * 3 04260306 + IF (IVCOMP - 6) 20120, 10120, 20120 04270306 +30120 IVDELE = IVDELE + 1 04280306 + WRITE (I02,80000) IVTNUM 04290306 + IF (ICZERO) 10120, 0131, 20120 04300306 +10120 IVPASS = IVPASS + 1 04310306 + WRITE (I02,80002) IVTNUM 04320306 + GO TO 0131 04330306 +20120 IVFAIL = IVFAIL + 1 04340306 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04350306 + 0131 CONTINUE 04360306 +C 04370306 +C 04380306 +C WRITE OUT TEST SUMMARY 04390306 +C 04400306 + WRITE (I02,90004) 04410306 + WRITE (I02,90014) 04420306 + WRITE (I02,90004) 04430306 + WRITE (I02,90000) 04440306 + WRITE (I02,90004) 04450306 + WRITE (I02,90020) IVFAIL 04460306 + WRITE (I02,90022) IVPASS 04470306 + WRITE (I02,90024) IVDELE 04480306 + STOP 04490306 +90001 FORMAT (" ",24X,"FM306") 04500306 +90000 FORMAT (" ",20X,"END OF PROGRAM FM306" ) 04510306 +C 04520306 +C FORMATS FOR TEST DETAIL LINES 04530306 +C 04540306 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 04550306 +80002 FORMAT (" ",4X,I5,7X,"PASS") 04560306 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 04570306 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 04580306 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 04590306 +C 04600306 +C FORMAT STATEMENTS FOR PAGE HEADERS 04610306 +C 04620306 +90002 FORMAT ("1") 04630306 +90004 FORMAT (" ") 04640306 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04650306 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 04660306 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 04670306 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 04680306 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 04690306 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 04700306 +C 04710306 +C FORMAT STATEMENTS FOR RUN SUMMARY 04720306 +C 04730306 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 04740306 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 04750306 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 04760306 + END 04770306 diff --git a/Fortran/UnitTests/fcvs21_f95/FM306.reference_output b/Fortran/UnitTests/fcvs21_f95/FM306.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM306.reference_output @@ -0,0 +1,33 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM306 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ---------------------------------------------- + + END OF PROGRAM FM306 + + 0 TESTS FAILED + 12 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM307.f b/Fortran/UnitTests/fcvs21_f95/FM307.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM307.f @@ -0,0 +1,897 @@ + PROGRAM FM307 00010307 +C 00020307 +C 00030307 +C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE FUNCTION 00040307 +C TYPE IS REAL AND THE ARGUMENTS ARE EITHER INTEGER OR REAL. THE 00050307 +C FUNCTION NINT IS AN EXCEPTION AND HAS AN INTEGER FUNCTION TYPE. 00060307 +C THE REAL OR INTEGER ARGUMENTS CONSIST OF POSITIVE, NEGATIVE AND 00070307 +C UNSIGNED CONSTANTS, VARIABLES AND ARRAY ELEMENT VALUES. EACH 00080307 +C INTRINSIC FUNCTION IS TESTED WITH THREE OR FOUR DIFFERENT 00090307 +C COMBINATIONS OF ACTUAL ARGUMENTS DESIGNED TO TEST NOT ONLY THE 00100307 +C VARIOUS COMBINATIONS OF DATA USAGES BUT ALSO TO TEST THE RANGE OF 00110307 +C ARGUMENT AND FUNCTION VALUES, WHERE THAT IS APPROPRIATE. THE 00120307 +C INTRINSIC FUNCTIONS TESTED IN THIS ROUTINE INCLUDE. 00130307 +C 00140307 +C SPECIFIC TYPE OF 00150307 +C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION00160307 +C ------------------ ------ -------- --------00170307 +C CONVERSION TO REAL REAL INTEGER REAL 00180307 +C NEAREST WHOLE NUMBER ANINT REAL REAL 00190307 +C NEAREST INTEGER NINT REAL INTEGER 00200307 +C TANGENT TAN REAL REAL 00210307 +C ARCSINE ASIN REAL REAL 00220307 +C ARCCOSINE ACOS REAL REAL 00230307 +C HYPERBOLIC SINE SINH REAL REAL 00240307 +C HYPERBOLIC COSINE COSH REAL REAL 00250307 +C 00260307 +C SUBSET LEVEL ROUTINES FM097 THROUGH FM099 AND FM308 ALSO 00270307 +C TEST THE USE OF INTEGER AND REAL INTRINSIC FUNCTIONS. 00280307 +C 00290307 +C REFERENCES. 00300307 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00310307 +C X3.9-1978 00320307 +C 00330307 +C SECTION 15.3, INTRINSIC FUNCTIONS 00340307 +C SECTION 15.9.2, ACTUAL ARGUMENTS 00350307 +C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00360307 +C TABLE 5, INTRINSIC FUNCTIONS (INCLUDING NOTES) 00370307 +C SECTION 15.10.1, RESTRICTION ON RANGE OF ARGUMENTS AND RESULTS00380307 +C 00390307 +C 00400307 +C ******************************************************************00410307 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00420307 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00430307 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00440307 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00450307 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00460307 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00470307 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00480307 +C THE RESULT OF EXECUTING THESE TESTS. 00490307 +C 00500307 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00510307 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00520307 +C 00530307 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00540307 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00550307 +C SOFTWARE STANDARDS VALIDATION GROUP 00560307 +C BUILDING 225 RM A266 00570307 +C GAITHERSBURG, MD 20899 00580307 +C ******************************************************************00590307 +C 00600307 +C 00610307 + IMPLICIT LOGICAL (L) 00620307 + IMPLICIT CHARACTER*14 (C) 00630307 +C 00640307 + DIMENSION IAON11(4) 00650307 + DIMENSION RAON11(4) 00660307 + DATA PI/3.141592654/ 00670307 +C 00680307 +C 00690307 +C 00700307 +C INITIALIZATION SECTION. 00710307 +C 00720307 +C INITIALIZE CONSTANTS 00730307 +C ******************** 00740307 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00750307 + I01 = 5 00760307 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00770307 + I02 = 6 00780307 +C SYSTEM ENVIRONMENT SECTION 00790307 +C 00800307 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00810307 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00820307 +C (UNIT NUMBER FOR CARD READER). 00830307 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00840307 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850307 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00860307 +C 00870307 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00880307 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00890307 +C (UNIT NUMBER FOR PRINTER). 00900307 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00910307 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00920307 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00930307 +C 00940307 + IVPASS = 0 00950307 + IVFAIL = 0 00960307 + IVDELE = 0 00970307 + ICZERO = 0 00980307 +C 00990307 +C WRITE OUT PAGE HEADERS 01000307 +C 01010307 + WRITE (I02,90002) 01020307 + WRITE (I02,90006) 01030307 + WRITE (I02,90008) 01040307 + WRITE (I02,90004) 01050307 + WRITE (I02,90010) 01060307 + WRITE (I02,90004) 01070307 + WRITE (I02,90016) 01080307 + WRITE (I02,90001) 01090307 + WRITE (I02,90004) 01100307 + WRITE (I02,90012) 01110307 + WRITE (I02,90014) 01120307 + WRITE (I02,90004) 01130307 +C 01140307 +C 01150307 +C TEST 001 THROUGH TEST 004 CONTAIN INTRINSIC FUNCTION TESTS FOR 01160307 +C TYPE CONVERSION TO REAL (REAL) WHERE THE FUNCTION IS REAL AND THE 01170307 +C ARGUMENT IS INTEGER. 01180307 +C 01190307 +C 01200307 +C **** FCVS PROGRAM 307 - TEST 001 **** 01210307 +C 01220307 +C CONSTANT ARGUMENT 01230307 +C 01240307 + IVTNUM = 1 01250307 + IF (ICZERO) 30010, 0010, 30010 01260307 + 0010 CONTINUE 01270307 + RVCOMP = 10.0 01280307 + RVCOMP = REAL (6) 01290307 + RVCORR = 6.0 01300307 +40010 IF (RVCOMP - 5.9995) 20010,10010,40011 01310307 +40011 IF (RVCOMP - 6.0005) 10010,10010,20010 01320307 +30010 IVDELE = IVDELE + 1 01330307 + WRITE (I02,80000) IVTNUM 01340307 + IF (ICZERO) 10010, 0021, 20010 01350307 +10010 IVPASS = IVPASS + 1 01360307 + WRITE (I02,80002) IVTNUM 01370307 + GO TO 0021 01380307 +20010 IVFAIL = IVFAIL + 1 01390307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01400307 + 0021 CONTINUE 01410307 +C 01420307 +C **** FCVS PROGRAM 307 - TEST 002 **** 01430307 +C 01440307 +C VARIABLE ARGUMENT 01450307 +C 01460307 + IVTNUM = 2 01470307 + IF (ICZERO) 30020, 0020, 30020 01480307 + 0020 CONTINUE 01490307 + RVCOMP = 10.0 01500307 + IVON01 = 6 01510307 + RVCOMP = REAL (IVON01) 01520307 + RVCORR = 6.0 01530307 +40020 IF (RVCOMP - 5.9995) 20020,10020,40021 01540307 +40021 IF (RVCOMP - 6.0005) 10020, 10020, 20020 01550307 +30020 IVDELE = IVDELE + 1 01560307 + WRITE (I02,80000) IVTNUM 01570307 + IF (ICZERO) 10020, 0031, 20020 01580307 +10020 IVPASS = IVPASS + 1 01590307 + WRITE (I02,80002) IVTNUM 01600307 + GO TO 0031 01610307 +20020 IVFAIL = IVFAIL + 1 01620307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01630307 + 0031 CONTINUE 01640307 +C 01650307 +C **** FCVS PROGRAM 307 - TEST 003 **** 01660307 +C 01670307 +C ARRAY ELEMENT NAME ARGUMENT 01680307 +C 01690307 + IVTNUM = 3 01700307 + IF (ICZERO) 30030, 0030, 30030 01710307 + 0030 CONTINUE 01720307 + RVCOMP = 10.0 01730307 + IAON11(3) = 6 01740307 + RVCOMP = REAL (IAON11(3)) 01750307 + RVCORR = 6.0 01760307 +40030 IF (RVCOMP - 5.9995) 20030, 10030, 40031 01770307 +40031 IF (RVCOMP - 6.0005) 10030, 10030, 20030 01780307 +30030 IVDELE = IVDELE + 1 01790307 + WRITE (I02,80000) IVTNUM 01800307 + IF (ICZERO) 10030, 0041, 20030 01810307 +10030 IVPASS = IVPASS + 1 01820307 + WRITE (I02,80002) IVTNUM 01830307 + GO TO 0041 01840307 +20030 IVFAIL = IVFAIL + 1 01850307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01860307 + 0041 CONTINUE 01870307 +C 01880307 +C **** FCVS PROGRAM 307 - TEST 004 **** 01890307 +C 01900307 +C EXPRESSION AS ARGUMENT 01910307 +C 01920307 + IVTNUM = 4 01930307 + IF (ICZERO) 30040, 0040, 30040 01940307 + 0040 CONTINUE 01950307 + RVCOMP = 10.0 01960307 + IVON01 = 6 01970307 + RVCOMP = REAL (IVON01 - 6) 01980307 + RVCORR = 0.0 01990307 +40040 IF(RVCOMP + .00005) 20040, 10040, 40041 02000307 +40041 IF(RVCOMP - .00005) 10040, 10040, 20040 02010307 +30040 IVDELE = IVDELE + 1 02020307 + WRITE (I02,80000) IVTNUM 02030307 + IF (ICZERO) 10040, 0051, 20040 02040307 +10040 IVPASS = IVPASS + 1 02050307 + WRITE (I02,80002) IVTNUM 02060307 + GO TO 0051 02070307 +20040 IVFAIL = IVFAIL + 1 02080307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02090307 + 0051 CONTINUE 02100307 +C 02110307 +C TEST 005 THROUGH TEST 008 CONTAIN INTRINSIC FUNCTION TESTS FOR 02120307 +C FINDING THE NEAREST WHOLE NUMBER (ANINT) WHERE THE FUNCTION AND 02130307 +C ARGUMENT TYPES ARE BOTH REAL. 02140307 +C 02150307 +C 02160307 +C **** FCVS PROGRAM 307 - TEST 005 **** 02170307 +C 02180307 +C CONSTANT ARGUMENT 02190307 +C 02200307 + IVTNUM = 5 02210307 + IF (ICZERO) 30050, 0050, 30050 02220307 + 0050 CONTINUE 02230307 + RVCOMP = 10.0 02240307 + RVCOMP = ANINT (3.4994) 02250307 + RVCORR = 3.0 02260307 +40050 IF (RVCOMP - 2.9995) 20050, 10050, 40051 02270307 +40051 IF (RVCOMP - 3.0005) 10050, 10050, 20050 02280307 +30050 IVDELE = IVDELE + 1 02290307 + WRITE (I02,80000) IVTNUM 02300307 + IF (ICZERO) 10050, 0061, 20050 02310307 +10050 IVPASS = IVPASS + 1 02320307 + WRITE (I02,80002) IVTNUM 02330307 + GO TO 0061 02340307 +20050 IVFAIL = IVFAIL + 1 02350307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02360307 + 0061 CONTINUE 02370307 +C 02380307 +C **** FCVS PROGRAM 307 - TEST 006 **** 02390307 +C 02400307 +C VARIABLE ARGUMENT 02410307 +C 02420307 + IVTNUM = 6 02430307 + IF (ICZERO) 30060, 0060, 30060 02440307 + 0060 CONTINUE 02450307 + RVCOMP = 10.0 02460307 + RVON01 = -3.4994 02470307 + RVCOMP = ANINT (RVON01) 02480307 + RVCORR = -3.0 02490307 +40060 IF (RVCOMP + 3.0005) 20060, 10060, 40061 02500307 +40061 IF (RVCOMP + 2.9995) 10060, 10060, 20060 02510307 +30060 IVDELE = IVDELE + 1 02520307 + WRITE (I02,80000) IVTNUM 02530307 + IF (ICZERO) 10060, 0071, 20060 02540307 +10060 IVPASS = IVPASS + 1 02550307 + WRITE (I02,80002) IVTNUM 02560307 + GO TO 0071 02570307 +20060 IVFAIL = IVFAIL + 1 02580307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02590307 + 0071 CONTINUE 02600307 +C 02610307 +C **** FCVS PROGRAM 307 - TEST 007 **** 02620307 +C 02630307 +C ARRAY ELEMENT NAME ARGUMENT 02640307 +C 02650307 + IVTNUM = 7 02660307 + IF (ICZERO) 30070, 0070, 30070 02670307 + 0070 CONTINUE 02680307 + RVCOMP = 10.0 02690307 + RAON11(3) = 3.0000 02700307 + RVCOMP = ANINT (RAON11(3)) 02710307 + RVCORR = 3.0 02720307 +40070 IF (RVCOMP - 2.9995) 20070, 10070, 40071 02730307 +40071 IF (RVCOMP - 3.0005) 10070, 10070, 20070 02740307 +30070 IVDELE = IVDELE + 1 02750307 + WRITE (I02,80000) IVTNUM 02760307 + IF (ICZERO) 10070, 0081, 20070 02770307 +10070 IVPASS = IVPASS + 1 02780307 + WRITE (I02,80002) IVTNUM 02790307 + GO TO 0081 02800307 +20070 IVFAIL = IVFAIL + 1 02810307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02820307 + 0081 CONTINUE 02830307 +C 02840307 +C **** FCVS PROGRAM 307 - TEST 008 **** 02850307 +C 02860307 +C ZERO ARGUMENT 02870307 +C 02880307 + IVTNUM = 8 02890307 + IF (ICZERO) 30080, 0080, 30080 02900307 + 0080 CONTINUE 02910307 + RVCOMP = 10.0 02920307 + RVCOMP = ANINT (0.0) 02930307 + RVCORR = 0.0 02940307 +40080 IF (RVCOMP) 20080, 10080, 20080 02950307 +30080 IVDELE = IVDELE + 1 02960307 + WRITE (I02,80000) IVTNUM 02970307 + IF (ICZERO) 10080, 0091, 20080 02980307 +10080 IVPASS = IVPASS + 1 02990307 + WRITE (I02,80002) IVTNUM 03000307 + GO TO 0091 03010307 +20080 IVFAIL = IVFAIL + 1 03020307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03030307 + 0091 CONTINUE 03040307 +C 03050307 +C TEST 009 THROUGH TEST 012 CONTAIN INTRINSIC FUNCTION TESTS FOR 03060307 +C FINDING THE NEAREST INTEGER (NINT) WHERE THE ARGUMENT IS REAL 03070307 +C AND THE FUNCTION TYPE IS INTEGER. 03080307 +C 03090307 +C 03100307 +C **** FCVS PROGRAM 307 - TEST 009 **** 03110307 +C 03120307 +C CONSTANT ARGUMENT 03130307 +C 03140307 + IVTNUM = 9 03150307 + IF (ICZERO) 30090, 0090, 30090 03160307 + 0090 CONTINUE 03170307 + IVCOMP = 10 03180307 + IVCOMP = NINT (3.4994) 03190307 + IVCORR = 3 03200307 +40090 IF (IVCOMP - 3) 20090, 10090, 20090 03210307 +30090 IVDELE = IVDELE + 1 03220307 + WRITE (I02,80000) IVTNUM 03230307 + IF (ICZERO) 10090, 0101, 20090 03240307 +10090 IVPASS = IVPASS + 1 03250307 + WRITE (I02,80002) IVTNUM 03260307 + GO TO 0101 03270307 +20090 IVFAIL = IVFAIL + 1 03280307 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03290307 + 0101 CONTINUE 03300307 +C 03310307 +C **** FCVS PROGRAM 307 - TEST 010 **** 03320307 +C 03330307 +C VARIABLE ARGUMENT 03340307 +C 03350307 + IVTNUM = 10 03360307 + IF (ICZERO) 30100, 0100, 30100 03370307 + 0100 CONTINUE 03380307 + IVCOMP = 10 03390307 + RVON01 = -3.4994 03400307 + IVCOMP = NINT (RVON01) 03410307 + IVCORR = -3 03420307 +40100 IF (IVCOMP +3) 20100, 10100, 20100 03430307 +30100 IVDELE = IVDELE + 1 03440307 + WRITE (I02,80000) IVTNUM 03450307 + IF (ICZERO) 10100, 0111, 20100 03460307 +10100 IVPASS = IVPASS + 1 03470307 + WRITE (I02,80002) IVTNUM 03480307 + GO TO 0111 03490307 +20100 IVFAIL = IVFAIL + 1 03500307 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03510307 + 0111 CONTINUE 03520307 +C 03530307 +C **** FCVS PROGRAM 307 - TEST 011 **** 03540307 +C 03550307 +C ARRAY ELEMENT NAME ARGUMENT 03560307 +C 03570307 + IVTNUM = 11 03580307 + IF (ICZERO) 30110, 0110, 30110 03590307 + 0110 CONTINUE 03600307 + IVCOMP = 10 03610307 + RAON11(1) = 3.0000 03620307 + IVCOMP = NINT (RAON11(1)) 03630307 + IVCORR = 3 03640307 +40110 IF (IVCOMP -3) 20110, 10110, 20110 03650307 +30110 IVDELE = IVDELE + 1 03660307 + WRITE (I02,80000) IVTNUM 03670307 + IF (ICZERO) 10110, 0121, 20110 03680307 +10110 IVPASS = IVPASS + 1 03690307 + WRITE (I02,80002) IVTNUM 03700307 + GO TO 0121 03710307 +20110 IVFAIL = IVFAIL + 1 03720307 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03730307 + 0121 CONTINUE 03740307 +C 03750307 +C **** FCVS PROGRAM 307 - TEST 012 **** 03760307 +C 03770307 +C ZERO ARGUMENT 03780307 +C 03790307 + IVTNUM = 12 03800307 + IF (ICZERO) 30120, 0120, 30120 03810307 + 0120 CONTINUE 03820307 + IVCOMP = 10 03830307 + IVCOMP = NINT (0.0) 03840307 + IVCORR = 0 03850307 +40120 IF (IVCOMP) 20120, 10120, 20120 03860307 +30120 IVDELE = IVDELE + 1 03870307 + WRITE (I02,80000) IVTNUM 03880307 + IF (ICZERO) 10120, 0131, 20120 03890307 +10120 IVPASS = IVPASS + 1 03900307 + WRITE (I02,80002) IVTNUM 03910307 + GO TO 0131 03920307 +20120 IVFAIL = IVFAIL + 1 03930307 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03940307 + 0131 CONTINUE 03950307 +C 03960307 +C TEST 013 THROUGH TEST 017 CONTAIN INTRINSIC FUNCTION TESTS FOR 03970307 +C FINDING THE TRIGONOMETRIC TANGENT (TAN) WHERE THE FUNCTION AND 03980307 +C ARGUMENT TYPES ARE BOTH REAL. ALL ARGUMENTS ARE GIVEN IN RADIANS 03990307 +C WHERE ONE RADIAN EQUALS 57.296 DEGREES. 04000307 +C 04010307 +C 04020307 +C **** FCVS PROGRAM 307 - TEST 013 **** 04030307 +C 04040307 +C FIND THE TANGENT OF 0 DEGREES (0.0 RADIANS) 04050307 +C 04060307 + IVTNUM = 13 04070307 + IF (ICZERO) 30130, 0130, 30130 04080307 + 0130 CONTINUE 04090307 + RVCOMP = 10.0 04100307 + RVCOMP = TAN (0.0) 04110307 + RVCORR = 0.0 04120307 +40130 IF (RVCOMP) 20130, 10130, 20130 04130307 +30130 IVDELE = IVDELE + 1 04140307 + WRITE (I02,80000) IVTNUM 04150307 + IF (ICZERO) 10130, 0141, 20130 04160307 +10130 IVPASS = IVPASS + 1 04170307 + WRITE (I02,80002) IVTNUM 04180307 + GO TO 0141 04190307 +20130 IVFAIL = IVFAIL + 1 04200307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04210307 + 0141 CONTINUE 04220307 +C 04230307 +C **** FCVS PROGRAM 307 - TEST 014 **** 04240307 +C 04250307 +C FIND THE TANGENT OF 135 DEGREES (2.3562 RADIANS) 04260307 +C 04270307 + IVTNUM = 14 04280307 + IF (ICZERO) 30140, 0140, 30140 04290307 + 0140 CONTINUE 04300307 + RVCOMP = 10.0 04310307 + RVON01 = 3 * PI / 4 04320307 + RVCOMP = TAN (RVON01) 04330307 + RVCORR = -1.0 04340307 +40140 IF (RVCOMP + 1.0005) 20140, 10140, 40141 04350307 +40141 IF (RVCOMP + .9995) 10140, 10140, 20140 04360307 +30140 IVDELE = IVDELE + 1 04370307 + WRITE (I02,80000) IVTNUM 04380307 + IF (ICZERO) 10140, 0151, 20140 04390307 +10140 IVPASS = IVPASS + 1 04400307 + WRITE (I02,80002) IVTNUM 04410307 + GO TO 0151 04420307 +20140 IVFAIL = IVFAIL + 1 04430307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04440307 + 0151 CONTINUE 04450307 +C 04460307 +C **** FCVS PROGRAM 307 - TEST 015 **** 04470307 +C 04480307 +C FIND THE TANGENT OF 540 DEGREES (9.4248 RADIANS) 04490307 +C 04500307 + IVTNUM = 15 04510307 + IF (ICZERO) 30150, 0150, 30150 04520307 + 0150 CONTINUE 04530307 + RVCOMP = 10.0 04540307 + RAON11(2) = 3 * PI 04550307 + RVCOMP = TAN (RAON11(2)) 04560307 + RVCORR = 0.0 04570307 +40150 IF (RVCOMP + .00005) 20150, 10150, 40151 04580307 +40151 IF (RVCOMP - .00005) 10150, 10150, 20150 04590307 +30150 IVDELE = IVDELE + 1 04600307 + WRITE (I02,80000) IVTNUM 04610307 + IF (ICZERO) 10150, 0161, 20150 04620307 +10150 IVPASS = IVPASS + 1 04630307 + WRITE (I02,80002) IVTNUM 04640307 + GO TO 0161 04650307 +20150 IVFAIL = IVFAIL + 1 04660307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04670307 + 0161 CONTINUE 04680307 +C 04690307 +C **** FCVS PROGRAM 307 - TEST 016 **** 04700307 +C 04710307 +C FIND THE TANGENT OF 30 DEGREES (.52360 RADIANS) 04720307 +C 04730307 + IVTNUM = 16 04740307 + IF (ICZERO) 30160, 0160, 30160 04750307 + 0160 CONTINUE 04760307 + RVCOMP = 10.0 04770307 + RVON01 = PI/6 04780307 + RVCOMP = TAN (RVON01) 04790307 + RVCORR = .57735 04800307 +40160 IF (RVCOMP - .57730) 20160, 10160, 40161 04810307 +40161 IF (RVCOMP - .57740) 10160, 10160, 20160 04820307 +30160 IVDELE = IVDELE + 1 04830307 + WRITE (I02,80000) IVTNUM 04840307 + IF (ICZERO) 10160, 0171, 20160 04850307 +10160 IVPASS = IVPASS + 1 04860307 + WRITE (I02,80002) IVTNUM 04870307 + GO TO 0171 04880307 +20160 IVFAIL = IVFAIL + 1 04890307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04900307 + 0171 CONTINUE 04910307 +C 04920307 +C **** FCVS PROGRAM 307 - TEST 017 **** 04930307 +C 04940307 +C FIND THE TANGENT OF 30 DEGREES BY DIVIDING THE SINE OF 30 DEGREES 04950307 +C BY THE COSINE OF 30 DEGREES. 04960307 +C 04970307 + IVTNUM = 17 04980307 + IF (ICZERO) 30170, 0170, 30170 04990307 + 0170 CONTINUE 05000307 + RVCOMP = 10.0 05010307 + RVON01 = PI/6 05020307 + RVCOMP = SIN(RVON01)/COS(RVON01) 05030307 + RVCORR = .57735 05040307 +40170 IF (RVCOMP - .57730) 20170, 10170, 40171 05050307 +40171 IF (RVCOMP - .57740) 10170, 10170, 20170 05060307 +30170 IVDELE = IVDELE + 1 05070307 + WRITE (I02,80000) IVTNUM 05080307 + IF (ICZERO) 10170, 0181, 20170 05090307 +10170 IVPASS = IVPASS + 1 05100307 + WRITE (I02,80002) IVTNUM 05110307 + GO TO 0181 05120307 +20170 IVFAIL = IVFAIL + 1 05130307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05140307 + 0181 CONTINUE 05150307 +C 05160307 +C TEST 018 THROUGH TEST 021 CONTAIN INTRINSIC FUNCTION TESTS FOR 05170307 +C FINDING THE TRIGONOMETRIC ARCSINE (ASIN) WHERE THE FUNCTION AND 05180307 +C ARGUMENT TYPES ARE BOTH REAL. THE ABSOLUTE VALUES OF ALL 05190307 +C ARGUMENTS ARE LESS THAN OR EQUAL TO ONE. THE FUNCTION VALUES 05200307 +C ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES. 05210307 +C 05220307 +C 05230307 +C **** FCVS PROGRAM 307 - TEST 018 **** 05240307 +C 05250307 +C THE ARCSINE OF +1. IS 90 DEGREES (1.5708 RADIANS) 05260307 +C 05270307 + IVTNUM = 18 05280307 + IF (ICZERO) 30180, 0180, 30180 05290307 + 0180 CONTINUE 05300307 + RVCOMP = 10.0 05310307 + RVCOMP = ASIN (+1.0) 05320307 + RVCORR = 1.5708 05330307 +40180 IF (RVCOMP - 1.5703) 20180, 10180, 40181 05340307 +40181 IF (RVCOMP - 1.5713) 10180, 10180, 20180 05350307 +30180 IVDELE = IVDELE + 1 05360307 + WRITE (I02,80000) IVTNUM 05370307 + IF (ICZERO) 10180, 0191, 20180 05380307 +10180 IVPASS = IVPASS + 1 05390307 + WRITE (I02,80002) IVTNUM 05400307 + GO TO 0191 05410307 +20180 IVFAIL = IVFAIL + 1 05420307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05430307 + 0191 CONTINUE 05440307 +C 05450307 +C **** FCVS PROGRAM 307 - TEST 019 **** 05460307 +C 05470307 +C THE ARCSINE OF -1. IS -90 DEGREES (-1.5708 RADIANS) 05480307 +C 05490307 + IVTNUM = 19 05500307 + IF (ICZERO) 30190, 0190, 30190 05510307 + 0190 CONTINUE 05520307 + RVCOMP = 10.0 05530307 + RVON01 = -1.0 05540307 + RVCOMP = ASIN(RVON01) 05550307 + RVCORR = -1.5708 05560307 +40190 IF (RVCOMP + 1.5713) 20190, 10190, 40191 05570307 +40191 IF (RVCOMP + 1.5703) 10190, 10190, 20190 05580307 +30190 IVDELE = IVDELE + 1 05590307 + WRITE (I02,80000) IVTNUM 05600307 + IF (ICZERO) 10190, 0201, 20190 05610307 +10190 IVPASS = IVPASS + 1 05620307 + WRITE (I02,80002) IVTNUM 05630307 + GO TO 0201 05640307 +20190 IVFAIL = IVFAIL + 1 05650307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05660307 + 0201 CONTINUE 05670307 +C 05680307 +C **** FCVS PROGRAM 307 - TEST 020 **** 05690307 +C 05700307 +C THE ARCSINE OF -.5 TS -30 DEGREES (-.52360 RADIANS) 05710307 +C 05720307 + IVTNUM = 20 05730307 + IF (ICZERO) 30200, 0200, 30200 05740307 + 0200 CONTINUE 05750307 + RVCOMP = 10.0 05760307 + RAON11(1) = -.5 05770307 + RVCOMP = ASIN (RAON11(1)) 05780307 + RVCORR = -.52360 05790307 +40200 IF (RVCOMP + .52365) 20200, 10200, 40201 05800307 +40201 IF (RVCOMP + .52355) 10200, 10200, 20200 05810307 +30200 IVDELE = IVDELE + 1 05820307 + WRITE (I02,80000) IVTNUM 05830307 + IF (ICZERO) 10200, 0211, 20200 05840307 +10200 IVPASS = IVPASS + 1 05850307 + WRITE (I02,80002) IVTNUM 05860307 + GO TO 0211 05870307 +20200 IVFAIL = IVFAIL + 1 05880307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05890307 + 0211 CONTINUE 05900307 +C 05910307 +C **** FCVS PROGRAM 307 - TEST 021 **** 05920307 +C 05930307 +C THE ARCSINE OF 0.0 IS 0 DEGREES (0.0 RADIANS) 05940307 +C 05950307 + IVTNUM = 21 05960307 + IF (ICZERO) 30210, 0210, 30210 05970307 + 0210 CONTINUE 05980307 + RVCOMP = 10.0 05990307 + RVON01 = 0.0 06000307 + RVCOMP = ASIN (RVON01) 06010307 + RVCORR = 0.0 06020307 +40210 IF (RVCOMP) 20210, 10210, 20210 06030307 +30210 IVDELE = IVDELE + 1 06040307 + WRITE (I02,80000) IVTNUM 06050307 + IF (ICZERO) 10210, 0221, 20210 06060307 +10210 IVPASS = IVPASS + 1 06070307 + WRITE (I02,80002) IVTNUM 06080307 + GO TO 0221 06090307 +20210 IVFAIL = IVFAIL + 1 06100307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06110307 + 0221 CONTINUE 06120307 +C 06130307 +C TEST 022 THROUGH TEST 025 CONTAIN INTRINSIC FUNCTION TESTS FOR 06140307 +C FINDING THE TRIGONOMETRIC ARCCOSINE (ACOS) WHERE THE FUNCTION 06150307 +C AND ARGUMENT TYPES ARE BOTH REAL. THE ABSOLUTE VALUES ALL 06160307 +C ARGUMENTS ARE LESS THAN OR EQUAL TO ONE. THE FUNCTION VALUES 06170307 +C ARE EXPRESSED IN RADIANS WHERE ONE RADIAN EQUALS 57.296 DEGREES. 06180307 +C 06190307 +C 06200307 +C **** FCVS PROGRAM 307 - TEST 022 **** 06210307 +C 06220307 +C THE ARCCOSINE OF +1. IS 0 DEGREES ( 0.0 RADIANS) 06230307 +C 06240307 + IVTNUM = 22 06250307 + IF (ICZERO) 30220, 0220, 30220 06260307 + 0220 CONTINUE 06270307 + RVCOMP = 10.0 06280307 + RVCOMP = ACOS(+1.) 06290307 + RVCORR = 0.0 06300307 +40220 IF (RVCOMP + .00005) 20220, 10220, 40221 06310307 +40221 IF (RVCOMP - .00005) 10220, 10220, 20220 06320307 +30220 IVDELE = IVDELE + 1 06330307 + WRITE (I02,80000) IVTNUM 06340307 + IF (ICZERO) 10220, 0231, 20220 06350307 +10220 IVPASS = IVPASS + 1 06360307 + WRITE (I02,80002) IVTNUM 06370307 + GO TO 0231 06380307 +20220 IVFAIL = IVFAIL + 1 06390307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06400307 + 0231 CONTINUE 06410307 +C 06420307 +C **** FCVS PROGRAM 307 - TEST 023 **** 06430307 +C 06440307 +C THE ARCCOSINE OF -1. IS 180 DEGREES (3.1416 RADIANS) 06450307 +C 06460307 + IVTNUM = 23 06470307 + IF (ICZERO) 30230, 0230, 30230 06480307 + 0230 CONTINUE 06490307 + RVCOMP = 10.0 06500307 + RVON01 = -1.0 06510307 + RVCOMP = ACOS (RVON01) 06520307 + RVCORR = 3.1416 06530307 +40230 IF (RVCOMP - 3.1411) 20230, 10230, 40231 06540307 +40231 IF (RVCOMP - 3.1421) 10230, 10230, 20230 06550307 +30230 IVDELE = IVDELE + 1 06560307 + WRITE (I02,80000) IVTNUM 06570307 + IF (ICZERO) 10230, 0241, 20230 06580307 +10230 IVPASS = IVPASS + 1 06590307 + WRITE (I02,80002) IVTNUM 06600307 + GO TO 0241 06610307 +20230 IVFAIL = IVFAIL + 1 06620307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06630307 + 0241 CONTINUE 06640307 +C 06650307 +C **** FCVS PROGRAM 307 - TEST 024 **** 06660307 +C 06670307 +C THE ARCCOSINE OF -.5 IS 120 DEGREES (2.0944 RADIANS) 06680307 +C 06690307 + IVTNUM = 24 06700307 + IF (ICZERO) 30240, 0240, 30240 06710307 + 0240 CONTINUE 06720307 + RVCOMP = 10.0 06730307 + RAON11(1) = -.5 06740307 + RVCOMP = ACOS (RAON11(1)) 06750307 + RVCORR = 2.0944 06760307 +40240 IF (RVCOMP - 2.0939) 20240, 10240, 40241 06770307 +40241 IF (RVCOMP - 2.0949) 10240, 10240, 20240 06780307 +30240 IVDELE = IVDELE + 1 06790307 + WRITE (I02,80000) IVTNUM 06800307 + IF (ICZERO) 10240, 0251, 20240 06810307 +10240 IVPASS = IVPASS + 1 06820307 + WRITE (I02,80002) IVTNUM 06830307 + GO TO 0251 06840307 +20240 IVFAIL = IVFAIL + 1 06850307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06860307 + 0251 CONTINUE 06870307 +C 06880307 +C **** FCVS PROGRAM 307 - TEST 025 **** 06890307 +C 06900307 +C THE ARCCOSINE OF 0.0 IS 90 DEGREES (1.5708 RADIANS) 06910307 +C 06920307 + IVTNUM = 25 06930307 + IF (ICZERO) 30250, 0250, 30250 06940307 + 0250 CONTINUE 06950307 + RVCOMP = 10.0 06960307 + RVCOMP = ACOS (0.) 06970307 + RVCORR = 1.5708 06980307 +40250 IF (RVCOMP - 1.5703) 20250, 10250, 40251 06990307 +40251 IF (RVCOMP - 1.5713) 10250, 10250, 20250 07000307 +30250 IVDELE = IVDELE + 1 07010307 + WRITE (I02,80000) IVTNUM 07020307 + IF (ICZERO) 10250, 0261, 20250 07030307 +10250 IVPASS = IVPASS + 1 07040307 + WRITE (I02,80002) IVTNUM 07050307 + GO TO 0261 07060307 +20250 IVFAIL = IVFAIL + 1 07070307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07080307 + 0261 CONTINUE 07090307 +C 07100307 +C TEST 026 THROUGH TEST 028 CONTAIN INTRINSIC FUNCTION TESTS FOR 07110307 +C FINDING THE HYPERBOLIC SINE (SINH) WHERE THE FUNCTION AND 07120307 +C ARGUMENT TYPES ARE BOTH REAL. ONLY POSITIVE ARGUMENTS ARE 07130307 +C TESTED. 07140307 +C 07150307 +C 07160307 +C **** FCVS PROGRAM 307 - TEST 026 **** 07170307 +C 07180307 +C CONSTANT ARGUMENT 07190307 +C 07200307 + IVTNUM = 26 07210307 + IF (ICZERO) 30260, 0260, 30260 07220307 + 0260 CONTINUE 07230307 + RVCOMP = 10.0 07240307 + RVCOMP = SINH (0.0) 07250307 + RVCORR = 0.0 07260307 +40260 IF (RVCOMP + .00005) 20260, 10260, 40261 07270307 +40261 IF (RVCOMP - .00005) 10260, 10260, 20260 07280307 +30260 IVDELE = IVDELE + 1 07290307 + WRITE (I02,80000) IVTNUM 07300307 + IF (ICZERO) 10260, 0271, 20260 07310307 +10260 IVPASS = IVPASS + 1 07320307 + WRITE (I02,80002) IVTNUM 07330307 + GO TO 0271 07340307 +20260 IVFAIL = IVFAIL + 1 07350307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07360307 + 0271 CONTINUE 07370307 +C 07380307 +C **** FCVS PROGRAM 307 - TEST 027 **** 07390307 +C 07400307 +C VARIABLE ARGUMENT 07410307 +C 07420307 + IVTNUM = 27 07430307 + IF (ICZERO) 30270, 0270, 30270 07440307 + 0270 CONTINUE 07450307 + RVCOMP =10.0 07460307 + RVON01 = 2.0 07470307 + RVCOMP = SINH (RVON01) 07480307 + RVCORR = 3.6269 07490307 +40270 IF (RVCOMP - 3.6264) 20270, 10270, 40271 07500307 +40271 IF (RVCOMP - 3.6274) 10270, 10270, 20270 07510307 +30270 IVDELE = IVDELE + 1 07520307 + WRITE (I02,80000) IVTNUM 07530307 + IF (ICZERO) 10270, 0281, 20270 07540307 +10270 IVPASS = IVPASS + 1 07550307 + WRITE (I02,80002) IVTNUM 07560307 + GO TO 0281 07570307 +20270 IVFAIL = IVFAIL + 1 07580307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07590307 + 0281 CONTINUE 07600307 +C 07610307 +C **** FCVS PROGRAM 307 - TEST 028 **** 07620307 +C 07630307 +C ARRAY ELEMENT NAME ARGUMENT 07640307 +C 07650307 + IVTNUM = 28 07660307 + IF (ICZERO) 30280, 0280, 30280 07670307 + 0280 CONTINUE 07680307 + RVCOMP = 10.0 07690307 + RAON11(1) = 6.0 07700307 + RVCOMP = SINH (RAON11(1)) 07710307 + RVCORR = 201.71 07720307 +40280 IF (RVCOMP - 201.66) 20280, 10280, 40281 07730307 +40281 IF (RVCOMP - 201.76) 10280, 10280, 20280 07740307 +30280 IVDELE = IVDELE + 1 07750307 + WRITE (I02,80000) IVTNUM 07760307 + IF (ICZERO) 10280, 0291, 20280 07770307 +10280 IVPASS = IVPASS + 1 07780307 + WRITE (I02,80002) IVTNUM 07790307 + GO TO 0291 07800307 +20280 IVFAIL = IVFAIL + 1 07810307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07820307 + 0291 CONTINUE 07830307 +C 07840307 +C TEST 029 THROUGH TEST 031 CONTAIN INTRINSIC FUNCTION TESTS FOR 07850307 +C FINDING THE HYPERBOLIC COSINE (COSH) WHERE THE FUNCTION AND 07860307 +C ARGUMENT TYPES ARE BOTH REAL. ONLY POSITIVE ARGUMENTS ARE TESTED.07870307 +C 07880307 +C 07890307 +C **** FCVS PROGRAM 307 - TEST 029 **** 07900307 +C 07910307 +C CONSTANT ARGUMENT 07920307 +C 07930307 + IVTNUM = 29 07940307 + IF (ICZERO) 30290, 0290, 30290 07950307 + 0290 CONTINUE 07960307 + RVCOMP = 10.0 07970307 + RVCOMP = COSH (0.0) 07980307 + RVCORR = 1.0 07990307 +40290 IF (RVCOMP - .9995) 20290, 10290, 40291 08000307 +40291 IF (RVCOMP - 1.0005) 10290, 10290, 20290 08010307 +30290 IVDELE = IVDELE + 1 08020307 + WRITE (I02,80000) IVTNUM 08030307 + IF (ICZERO) 10290, 0301, 20290 08040307 +10290 IVPASS = IVPASS + 1 08050307 + WRITE (I02,80002) IVTNUM 08060307 + GO TO 0301 08070307 +20290 IVFAIL = IVFAIL + 1 08080307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08090307 + 0301 CONTINUE 08100307 +C 08110307 +C **** FCVS PROGRAM 307 - TEST 030 **** 08120307 +C 08130307 +C VARIABLE ARGUMENT 08140307 +C 08150307 + IVTNUM = 30 08160307 + IF (ICZERO) 30300, 0300, 30300 08170307 + 0300 CONTINUE 08180307 + RVCOMP = 10.0 08190307 + RVON01 = 2.0 08200307 + RVCOMP = COSH (RVON01) 08210307 + RVCORR = 3.7622 08220307 +40300 IF (RVCOMP - 3.7617) 20300, 10300, 40301 08230307 +40301 IF (RVCOMP - 3.7627) 10300, 10300, 20300 08240307 +30300 IVDELE = IVDELE + 1 08250307 + WRITE (I02,80000) IVTNUM 08260307 + IF (ICZERO) 10300, 0311, 20300 08270307 +10300 IVPASS = IVPASS + 1 08280307 + WRITE (I02,80002) IVTNUM 08290307 + GO TO 0311 08300307 +20300 IVFAIL = IVFAIL + 1 08310307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08320307 + 0311 CONTINUE 08330307 +C 08340307 +C **** FCVS PROGRAM 307 - TEST 031 **** 08350307 +C 08360307 +C ARRAY ELEMENT NAME ARGUMENT 08370307 +C 08380307 + IVTNUM = 31 08390307 + IF (ICZERO) 30310, 0310, 30310 08400307 + 0310 CONTINUE 08410307 + RVCOMP = 10.0 08420307 + RAON11(2) = 6.0 08430307 + RVCOMP = COSH (RAON11(2)) 08440307 + RVCORR = 201.72 08450307 +40310 IF (RVCOMP - 201.67) 20310, 10310, 40311 08460307 +40311 IF (RVCOMP - 201.77) 10310, 10310, 20310 08470307 +30310 IVDELE = IVDELE + 1 08480307 + WRITE (I02,80000) IVTNUM 08490307 + IF (ICZERO) 10310, 0321, 20310 08500307 +10310 IVPASS = IVPASS + 1 08510307 + WRITE (I02,80002) IVTNUM 08520307 + GO TO 0321 08530307 +20310 IVFAIL = IVFAIL + 1 08540307 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08550307 + 0321 CONTINUE 08560307 +C 08570307 +C 08580307 +C WRITE OUT TEST SUMMARY 08590307 +C 08600307 + WRITE (I02,90004) 08610307 + WRITE (I02,90014) 08620307 + WRITE (I02,90004) 08630307 + WRITE (I02,90000) 08640307 + WRITE (I02,90004) 08650307 + WRITE (I02,90020) IVFAIL 08660307 + WRITE (I02,90022) IVPASS 08670307 + WRITE (I02,90024) IVDELE 08680307 + STOP 08690307 +90001 FORMAT (" ",24X,"FM307") 08700307 +90000 FORMAT (" ",20X,"END OF PROGRAM FM307" ) 08710307 +C 08720307 +C FORMATS FOR TEST DETAIL LINES 08730307 +C 08740307 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 08750307 +80002 FORMAT (" ",4X,I5,7X,"PASS") 08760307 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08770307 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08780307 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 08790307 +C 08800307 +C FORMAT STATEMENTS FOR PAGE HEADERS 08810307 +C 08820307 +90002 FORMAT ("1") 08830307 +90004 FORMAT (" ") 08840307 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08850307 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 08860307 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08870307 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 08880307 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 08890307 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08900307 +C 08910307 +C FORMAT STATEMENTS FOR RUN SUMMARY 08920307 +C 08930307 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 08940307 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 08950307 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 08960307 + END 08970307 diff --git a/Fortran/UnitTests/fcvs21_f95/FM307.reference_output b/Fortran/UnitTests/fcvs21_f95/FM307.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM307.reference_output @@ -0,0 +1,52 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM307 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + + ---------------------------------------------- + + END OF PROGRAM FM307 + + 0 TESTS FAILED + 31 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM308.f b/Fortran/UnitTests/fcvs21_f95/FM308.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM308.f @@ -0,0 +1,941 @@ + PROGRAM FM308 00010308 +C 00020308 +C 00030308 +C THIS ROUTINE TESTS INTRINSIC FUNCTIONS WHERE THE ACTUAL 00040308 +C ARGUMENTS CONSIST OF INTRINSIC FUNCTION REFERENCES, EXTERNAL 00050308 +C FUNCTION REFERENCES, STATEMENT FUNCTION REFERENCES, AND 00060308 +C EXPRESSIONS INVOLVING OPERATORS. THE ARGUMENT AND FUNCTION 00070308 +C TYPES OF ALL INTRINSIC FUNCTIONS TESTED ARE EITHER INTEGER OR 00080308 +C REAL. THE INTRINSIC AND EXTERNAL SPECIFICATION STATEMENTS ARE 00090308 +C SPECIFIED IN ORDER TO ALLOW INTRINSIC AND EXTERNAL FUNCTIONS TO 00100308 +C BE USED AS ACTUAL ARGUMENTS. THE IMPLICIT STATEMENT AND THE 00110308 +C TYPE-STATEMENT ARE TESTED TO ENSURE THAT THEY DO NOT CHANGE THE 00120308 +C TYPE OF AN INTRINSIC FUNCTION. THE COMMON STATEMENT IS USED TO 00130308 +C PASS DATA ENTITIES TO AN EXTERNAL FUNCTION. THE DATA STATEMENT 00140308 +C IS USED TO ENSURE THAT INITIALLY DEFINED ENTITIES CAN BE USED AS 00150308 +C ACTUAL ARGUMENTS. THE EQUIVALENCE STATEMENT IS USED TO EQUATE A 00160308 +C VARIABLE USED AS AN ACTUAL ARGUMENT. THE INTRINSIC FUNCTIONS 00170308 +C TESTED IN THIS ROUTINE INCLUDE. 00180308 +C 00190308 +C SPECIFIC TYPE OF 00200308 +C INTRINSIC FUNCTION NAME ARGUMENT FUNCTION00210308 +C ------------------ -------- -------- --------00220308 +C TYPE CONVERSION INT REAL INTEGER 00230308 +C TYPE CONVERSION IFIX REAL INTEGER 00240308 +C TYPE CONVERSION FLOAT INTEGER REAL 00250308 +C TYPE CONVERSION REAL INTEGER REAL 00260308 +C TRUNCATION AINT REAL REAL 00270308 +C NEAREST WHOLE NUMBER ANINT REAL REAL 00280308 +C NEAREST INTEGER NINT REAL INTEGER 00290308 +C ABSOLUTE VALUE IABS INTEGER INTEGER 00300308 +C ABSOLUTE VALUE ABS REAL REAL 00310308 +C REMAINDERING MOD INTEGER INTEGER 00320308 +C REMAINDERING AMOD REAL REAL 00330308 +C TRANSFER OF SIGN ISIGN INTEGER INTEGER 00340308 +C TRANSFER OF SIGN SIGN REAL REAL 00350308 +C POSITIVE DIFFERENCE IDIM INTEGER INTEGER 00360308 +C POSITIVE DIFFERENCE DIM REAL REAL 00370308 +C CHOOSING LARGEST VALUE MAX0 INTEGER INTEGER 00380308 +C CHOOSING LARGEST VALUE AMAX0 INTEGER REAL 00390308 +C CHOOSING LARGEST VALUE MAX1 REAL INTEGER 00400308 +C CHOOSING SMALLEST VALUE AMIN1 REAL REAL 00410308 +C CHOOSING SMALLEST VALUE MIN1 REAL INTEGER 00420308 +C SQUARE ROOT SQRT REAL REAL 00430308 +C EXPONENTIAL EXP REAL REAL 00440308 +C NATURAL LOGARITHM ALOG REAL REAL 00450308 +C SINE SIN REAL REAL 00460308 +C COSINE COS REAL REAL 00470308 +C TANGENT TAN REAL REAL 00480308 +C ARCSINE ASIN REAL REAL 00490308 +C ARCCOSINE ACOS REAL REAL 00500308 +C ARCTANGENT ATAN REAL REAL 00510308 +C HYPERBOLIC SINE SINH REAL REAL 00520308 +C HYPERBOLIC COSINE COSH REAL REAL 00530308 +C HYPERBOLIC TANGENT TANH REAL REAL 00540308 +C 00550308 +C SUBSET LEVEL ROUTINES FM097, FM098, FM099 AND FM307 TEST THE 00560308 +C USE OF INTEGER AND REAL INTRINSIC FUNCTIONS USING INTEGER AND REAL00570308 +C CONSTANTS, VARIABLES AND ARRAY ELEMENT ENTITIES AS ACTUAL 00580308 +C ARGUMENTS. 00590308 +C 00600308 +C REFERENCES. 00610308 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00620308 +C X3.9-1978 00630308 +C 00640308 +C SECTION 8.2, EQUIVALENCE STATEMENT 00650308 +C SECTION 8.3, COMMON STATEMENT 00660308 +C SECTION 8.4, TYPE-STATEMENTS 00670308 +C SECTION 8.5, IMPLICIT STATEMENT 00680308 +C SECTION 8.7, EXTERNAL STATEMENT 00690308 +C SECTION 8.8, INTRINSIC STATEMENT 00700308 +C SECTION 9, DATA STATEMENT 00710308 +C SECTION 15.3, INTRINSIC FUNCTION 00720308 +C SECTION 15.4, STATEMENT FUNCTION 00730308 +C SECTION 15.5, EXTERNAL FUNCTION 00740308 +C SECTION 15.5.2, .REFERENCING AN EXTERNAL FUNCTION 00750308 +C SECTION 15.9.2, ACTUAL ARGUMENTS 00760308 +C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00770308 +C TABLE 5, INTRINSIC FUNCTIONS (INCLUDING NOTES) 00780308 +C SECTION 15.10.1, RESTRICTIONS ON RANGE OF ARGUMENTS AND RESULTS00790308 +C 00800308 +C 00810308 +C ******************************************************************00820308 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00830308 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00840308 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00850308 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00860308 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00870308 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00880308 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00890308 +C THE RESULT OF EXECUTING THESE TESTS. 00900308 +C 00910308 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00920308 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00930308 +C 00940308 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00950308 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00960308 +C SOFTWARE STANDARDS VALIDATION GROUP 00970308 +C BUILDING 225 RM A266 00980308 +C GAITHERSBURG, MD 20899 00990308 +C ******************************************************************01000308 +C 01010308 +C 01020308 + IMPLICIT LOGICAL (L) 01030308 + IMPLICIT CHARACTER*14 (C) 01040308 +C 01050308 + IMPLICIT INTEGER (E) 01060308 + IMPLICIT REAL (N) 01070308 + INTEGER MAX1 01080308 + REAL SINH 01090308 + DIMENSION RADN11(5) 01100308 + DIMENSION IADN11(5) 01110308 + COMMON RVCN01 01120308 + EQUIVALENCE (IVOE01,IVOE02) 01130308 + EXTERNAL FF309,FF310 01140308 + INTRINSIC ABS, AINT, IABS, ISIGN, SQRT 01150308 + DATA RVON04/2.23/ 01160308 + RFOS01(RDON01) = RDON01 + 1.0 01170308 +C 01180308 +C 01190308 +C 01200308 +C INITIALIZATION SECTION. 01210308 +C 01220308 +C INITIALIZE CONSTANTS 01230308 +C ******************** 01240308 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01250308 + I01 = 5 01260308 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01270308 + I02 = 6 01280308 +C SYSTEM ENVIRONMENT SECTION 01290308 +C 01300308 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01310308 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01320308 +C (UNIT NUMBER FOR CARD READER). 01330308 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01340308 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01350308 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01360308 +C 01370308 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01380308 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01390308 +C (UNIT NUMBER FOR PRINTER). 01400308 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01410308 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01420308 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01430308 +C 01440308 + IVPASS = 0 01450308 + IVFAIL = 0 01460308 + IVDELE = 0 01470308 + ICZERO = 0 01480308 +C 01490308 +C WRITE OUT PAGE HEADERS 01500308 +C 01510308 + WRITE (I02,90002) 01520308 + WRITE (I02,90006) 01530308 + WRITE (I02,90008) 01540308 + WRITE (I02,90004) 01550308 + WRITE (I02,90010) 01560308 + WRITE (I02,90004) 01570308 + WRITE (I02,90016) 01580308 + WRITE (I02,90001) 01590308 + WRITE (I02,90004) 01600308 + WRITE (I02,90012) 01610308 + WRITE (I02,90014) 01620308 + WRITE (I02,90004) 01630308 +C 01640308 +C 01650308 +C TEST 032 THROUGH TEST 040 TEST INTRINSIC FUNCTIONS USING 01660308 +C INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS. 01670308 +C 01680308 +C 01690308 +C **** FCVS PROGRAM 308 - TEST 032 **** 01700308 +C 01710308 +C 01720308 + IVTNUM = 32 01730308 + IF (ICZERO) 30320, 0320, 30320 01740308 + 0320 CONTINUE 01750308 + RVCOMP = 10.0 01760308 + RVCOMP = ANINT (ABS (-2.78) ) 01770308 + RVCORR = 3.0 01780308 +40320 IF (RVCOMP - 2.9995) 20320, 10320, 40321 01790308 +40321 IF (RVCOMP - 3.0005) 10320, 10320, 20320 01800308 +30320 IVDELE = IVDELE + 1 01810308 + WRITE (I02,80000) IVTNUM 01820308 + IF (ICZERO) 10320, 0331, 20320 01830308 +10320 IVPASS = IVPASS + 1 01840308 + WRITE (I02,80002) IVTNUM 01850308 + GO TO 0331 01860308 +20320 IVFAIL = IVFAIL + 1 01870308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01880308 + 0331 CONTINUE 01890308 +C 01900308 +C **** FCVS PROGRAM 308 - TEST 033 **** 01910308 +C 01920308 +C 01930308 + IVTNUM = 33 01940308 + IF (ICZERO) 30330, 0330, 30330 01950308 + 0330 CONTINUE 01960308 + RVCOMP = 10.0 01970308 + RVCOMP = ATAN (AINT (1.2) ) 01980308 + RVCORR = .78540 01990308 +40330 IF (RVCOMP - .78535) 20330, 10330, 40331 02000308 +40331 IF (RVCOMP - .78545) 10330, 10330, 20330 02010308 +30330 IVDELE = IVDELE + 1 02020308 + WRITE (I02,80000) IVTNUM 02030308 + IF (ICZERO) 10330, 0341, 20330 02040308 +10330 IVPASS = IVPASS + 1 02050308 + WRITE (I02,80002) IVTNUM 02060308 + GO TO 0341 02070308 +20330 IVFAIL = IVFAIL + 1 02080308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02090308 + 0341 CONTINUE 02100308 +C 02110308 +C **** FCVS PROGRAM 308 - TEST 034 **** 02120308 +C 02130308 +C 02140308 + IVTNUM = 34 02150308 + IF (ICZERO) 30340, 0340, 30340 02160308 + 0340 CONTINUE 02170308 + RVCOMP = 10.0 02180308 + RVCOMP = COS (ABS (-.78540) ) 02190308 + RVCORR = .70711 02200308 +40340 IF (RVCOMP - .70706) 20340, 10340, 40341 02210308 +40341 IF (RVCOMP - .70716) 10340, 10340, 20340 02220308 +30340 IVDELE = IVDELE + 1 02230308 + WRITE (I02,80000) IVTNUM 02240308 + IF (ICZERO) 10340, 0351, 20340 02250308 +10340 IVPASS = IVPASS + 1 02260308 + WRITE (I02,80002) IVTNUM 02270308 + GO TO 0351 02280308 +20340 IVFAIL = IVFAIL + 1 02290308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02300308 + 0351 CONTINUE 02310308 +C 02320308 +C **** FCVS PROGRAM 308 - TEST 035 **** 02330308 +C 02340308 +C 02350308 + IVTNUM = 35 02360308 + IF (ICZERO) 30350, 0350, 30350 02370308 + 0350 CONTINUE 02380308 + RVCOMP = 10.0 02390308 + IVON01 = 6 02400308 + RVCOMP = AMAX0 (1, IVON01, IABS(-7) ) 02410308 + RVCORR = 7.0 02420308 +40350 IF (RVCOMP - 6.9995) 20350, 10350, 40351 02430308 +40351 IF (RVCOMP - 7.0005) 10350, 10350, 20350 02440308 +30350 IVDELE = IVDELE + 1 02450308 + WRITE (I02,80000) IVTNUM 02460308 + IF (ICZERO) 10350, 0361, 20350 02470308 +10350 IVPASS = IVPASS + 1 02480308 + WRITE (I02,80002) IVTNUM 02490308 + GO TO 0361 02500308 +20350 IVFAIL = IVFAIL + 1 02510308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02520308 + 0361 CONTINUE 02530308 +C 02540308 +C **** FCVS PROGRAM 308 - TEST 036 **** 02550308 +C 02560308 +C 02570308 + IVTNUM = 36 02580308 + IF (ICZERO) 30360, 0360, 30360 02590308 + 0360 CONTINUE 02600308 + IVCOMP = 10 02610308 + IVCOMP = IABS (ISIGN (7, -2)) 02620308 + IVCORR = 7 02630308 +40360 IF (IVCOMP - 7) 20360, 10360, 20360 02640308 +30360 IVDELE = IVDELE + 1 02650308 + WRITE (I02,80000) IVTNUM 02660308 + IF (ICZERO) 10360, 0371, 20360 02670308 +10360 IVPASS = IVPASS + 1 02680308 + WRITE (I02,80002) IVTNUM 02690308 + GO TO 0371 02700308 +20360 IVFAIL = IVFAIL + 1 02710308 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02720308 + 0371 CONTINUE 02730308 +C 02740308 +C **** FCVS PROGRAM 308 - TEST 037 **** 02750308 +C 02760308 +C 02770308 + IVTNUM = 37 02780308 + IF (ICZERO) 30370, 0370, 30370 02790308 + 0370 CONTINUE 02800308 + IVCOMP = 10 02810308 + IVCOMP = MOD (5, IABS (-3) ) 02820308 + IVCORR = 2 02830308 +40370 IF (IVCOMP - 2) 20370, 10370, 20370 02840308 +30370 IVDELE = IVDELE + 1 02850308 + WRITE (I02,80000) IVTNUM 02860308 + IF (ICZERO) 10370, 0381, 20370 02870308 +10370 IVPASS = IVPASS + 1 02880308 + WRITE (I02,80002) IVTNUM 02890308 + GO TO 0381 02900308 +20370 IVFAIL = IVFAIL + 1 02910308 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02920308 + 0381 CONTINUE 02930308 +C 02940308 +C **** FCVS PROGRAM 308 - TEST 038 **** 02950308 +C 02960308 +C 02970308 + IVTNUM = 38 02980308 + IF (ICZERO) 30380, 0380, 30380 02990308 + 0380 CONTINUE 03000308 + IVCOMP = 10 03010308 + IVCOMP = ISIGN (-3, IABS (-5) ) 03020308 + IVCORR = 3 03030308 +40380 IF (IVCOMP - 3) 20380, 10380, 20380 03040308 +30380 IVDELE = IVDELE + 1 03050308 + WRITE (I02,80000) IVTNUM 03060308 + IF (ICZERO) 10380, 0391, 20380 03070308 +10380 IVPASS = IVPASS + 1 03080308 + WRITE (I02,80002) IVTNUM 03090308 + GO TO 0391 03100308 +20380 IVFAIL = IVFAIL + 1 03110308 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03120308 + 0391 CONTINUE 03130308 +C 03140308 +C **** FCVS PROGRAM 308 - TEST 039 **** 03150308 +C 03160308 +C REPEAT FUNCTION REFERENCE TWICE IN ONE INTRINSIC FUNCTION 03170308 +C REFERENCE. 03180308 +C 03190308 + IVTNUM = 39 03200308 + IF (ICZERO) 30390, 0390, 30390 03210308 + 0390 CONTINUE 03220308 + IVCOMP = 10 03230308 + IVCOMP = MAX0 (IABS (-5), IABS (-6) ) 03240308 + IVCORR = 6 03250308 +40390 IF (IVCOMP -6) 20390, 10390, 20390 03260308 +30390 IVDELE = IVDELE + 1 03270308 + WRITE (I02,80000) IVTNUM 03280308 + IF (ICZERO) 10390, 0401, 20390 03290308 +10390 IVPASS = IVPASS + 1 03300308 + WRITE (I02,80002) IVTNUM 03310308 + GO TO 0401 03320308 +20390 IVFAIL = IVFAIL + 1 03330308 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03340308 + 0401 CONTINUE 03350308 +C 03360308 +C **** FCVS PROGRAM 308 - TEST 040 **** 03370308 +C 03380308 +C USE INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT TO ITSELF. 03390308 +C 03400308 + IVTNUM = 40 03410308 + IF (ICZERO) 30400, 0400, 30400 03420308 + 0400 CONTINUE 03430308 + RVCOMP = 10.0 03440308 + RVCOMP = SQRT (SQRT (25.) ) 03450308 + RVCORR = 2.2361 03460308 +40400 IF (RVCOMP - 2.2356) 20400, 10400, 40401 03470308 +40401 IF (RVCOMP - 2.2366) 10400, 10400, 20400 03480308 +30400 IVDELE = IVDELE + 1 03490308 + WRITE (I02,80000) IVTNUM 03500308 + IF (ICZERO) 10400, 0411, 20400 03510308 +10400 IVPASS = IVPASS + 1 03520308 + WRITE (I02,80002) IVTNUM 03530308 + GO TO 0411 03540308 +20400 IVFAIL = IVFAIL + 1 03550308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03560308 + 0411 CONTINUE 03570308 +C 03580308 +C TEST 041 THROUGH TEST 045 TEST INTRINSIC FUNCTIONS USING EXTERNAL 03590308 +C FUNCTION REFERENCES AS ACTUAL ARGUMENTS. 03600308 +C 03610308 +C 03620308 +C **** FCVS PROGRAM 308 - TEST 041 **** 03630308 +C 03640308 +C 03650308 + IVTNUM = 41 03660308 + IF (ICZERO) 30410, 0410, 30410 03670308 + 0410 CONTINUE 03680308 + RVCOMP = 10.0 03690308 + RVCOMP = ALOG (FF309 (29.0) ) 03700308 + RVCORR = 3.4012 03710308 +40410 IF (RVCOMP - 3.4007) 20410, 10410, 40411 03720308 +40411 IF (RVCOMP - 3.4017) 10410, 10410, 20410 03730308 +30410 IVDELE = IVDELE + 1 03740308 + WRITE (I02,80000) IVTNUM 03750308 + IF (ICZERO) 10410, 0421, 20410 03760308 +10410 IVPASS = IVPASS + 1 03770308 + WRITE (I02,80002) IVTNUM 03780308 + GO TO 0421 03790308 +20410 IVFAIL = IVFAIL + 1 03800308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03810308 + 0421 CONTINUE 03820308 +C 03830308 +C **** FCVS PROGRAM 308 - TEST 042 **** 03840308 +C 03850308 +C 03860308 + IVTNUM = 42 03870308 + IF (ICZERO) 30420, 0420, 30420 03880308 + 0420 CONTINUE 03890308 + RVCOMP = 10.0 03900308 + RVCOMP = ASIN (FF309 (0.) ) 03910308 + RVCORR = 1.5708 03920308 +40420 IF (RVCOMP - 1.5703) 20420, 10420, 40421 03930308 +40421 IF (RVCOMP - 1.5713) 10420, 10420, 20420 03940308 +30420 IVDELE = IVDELE + 1 03950308 + WRITE (I02,80000) IVTNUM 03960308 + IF (ICZERO) 10420, 0431, 20420 03970308 +10420 IVPASS = IVPASS + 1 03980308 + WRITE (I02,80002) IVTNUM 03990308 + GO TO 0431 04000308 +20420 IVFAIL = IVFAIL + 1 04010308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04020308 + 0431 CONTINUE 04030308 +C 04040308 +C **** FCVS PROGRAM 308 - TEST 043 **** 04050308 +C 04060308 +C 04070308 + IVTNUM = 43 04080308 + IF (ICZERO) 30430, 0430, 30430 04090308 + 0430 CONTINUE 04100308 + RVCOMP = 10.0 04110308 + RVON01 = 1.5 04120308 + RVCOMP = COSH (FF309 (RVON01) ) 04130308 + RVCORR = 6.1323 04140308 +40430 IF (RVCOMP - 6.1318) 20430, 10430, 40431 04150308 +40431 IF (RVCOMP - 6.1328) 10430, 10430, 20430 04160308 +30430 IVDELE = IVDELE + 1 04170308 + WRITE (I02,80000) IVTNUM 04180308 + IF (ICZERO) 10430, 0441, 20430 04190308 +10430 IVPASS = IVPASS + 1 04200308 + WRITE (I02,80002) IVTNUM 04210308 + GO TO 0441 04220308 +20430 IVFAIL = IVFAIL + 1 04230308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04240308 + 0441 CONTINUE 04250308 +C 04260308 +C **** FCVS PROGRAM 308 - TEST 044 **** 04270308 +C 04280308 +C 04290308 + IVTNUM = 44 04300308 + IF (ICZERO) 30440, 0440, 30440 04310308 + 0440 CONTINUE 04320308 + IVCOMP = 10 04330308 + IVCOMP = IFIX (FF309 (33.3) ) 04340308 + IVCORR = 34 04350308 +40440 IF (IVCOMP - 34) 20440, 10440, 20440 04360308 +30440 IVDELE = IVDELE + 1 04370308 + WRITE (I02,80000) IVTNUM 04380308 + IF (ICZERO) 10440, 0451, 20440 04390308 +10440 IVPASS = IVPASS + 1 04400308 + WRITE (I02,80002) IVTNUM 04410308 + GO TO 0451 04420308 +20440 IVFAIL = IVFAIL + 1 04430308 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04440308 + 0451 CONTINUE 04450308 +C 04460308 +C **** FCVS PROGRAM 308 - TEST 045 **** 04470308 +C 04480308 +C 04490308 + IVTNUM = 45 04500308 + IF (ICZERO) 30450, 0450, 30450 04510308 + 0450 CONTINUE 04520308 + RVCOMP = 10.0 04530308 + RADN11(2) = 2.1416 04540308 + RVCOMP = TAN (FF309 (RADN11(2))) 04550308 + RVCORR = 0.0 04560308 +40450 IF (RVCOMP + .00005) 20450, 10450, 40451 04570308 +40451 IF (RVCOMP - .00005) 10450, 10450, 20450 04580308 +30450 IVDELE = IVDELE + 1 04590308 + WRITE (I02,80000) IVTNUM 04600308 + IF (ICZERO) 10450, 0461, 20450 04610308 +10450 IVPASS = IVPASS + 1 04620308 + WRITE (I02,80002) IVTNUM 04630308 + GO TO 0461 04640308 +20450 IVFAIL = IVFAIL + 1 04650308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04660308 + 0461 CONTINUE 04670308 +C 04680308 +C TEST 046 THROUGH TEST 052 TEST INTRINSIC FUNCTIONS USING 04690308 +C EXPRESSIONS INVOLVING OPERATORS AS ACTUAL ARGUMENTS. 04700308 +C 04710308 +C 04720308 +C **** FCVS PROGRAM 308 - TEST 046 **** 04730308 +C 04740308 +C 04750308 + IVTNUM = 46 04760308 + IF (ICZERO) 30460, 0460, 30460 04770308 + 0460 CONTINUE 04780308 + RVCOMP = 10.0 04790308 + RVCOMP = ABS (3.4 - 8.2) 04800308 + RVCORR = 4.8 04810308 +40460 IF (RVCOMP - 4.7995) 20460, 10460, 40461 04820308 +40461 IF (RVCOMP - 4.8005) 10460, 10460, 20460 04830308 +30460 IVDELE = IVDELE + 1 04840308 + WRITE (I02,80000) IVTNUM 04850308 + IF (ICZERO) 10460, 0471, 20460 04860308 +10460 IVPASS = IVPASS + 1 04870308 + WRITE (I02,80002) IVTNUM 04880308 + GO TO 0471 04890308 +20460 IVFAIL = IVFAIL + 1 04900308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04910308 + 0471 CONTINUE 04920308 +C 04930308 +C **** FCVS PROGRAM 308 - TEST 047 **** 04940308 +C 04950308 +C 04960308 + IVTNUM = 47 04970308 + IF (ICZERO) 30470, 0470, 30470 04980308 + 0470 CONTINUE 04990308 + RVCOMP = 10.0 05000308 + IVON01 = 2 05010308 + RVON01 = 3.0 05020308 + RVCOMP = ACOS (IVON01 - RVON01 * .5) 05030308 + RVCORR = 1.0472 05040308 +40470 IF (RVCOMP - 1.0467) 20470, 10470, 40471 05050308 +40471 IF (RVCOMP - 1.0477) 10470, 10470, 20470 05060308 +30470 IVDELE = IVDELE + 1 05070308 + WRITE (I02,80000) IVTNUM 05080308 + IF (ICZERO) 10470, 0481, 20470 05090308 +10470 IVPASS = IVPASS + 1 05100308 + WRITE (I02,80002) IVTNUM 05110308 + GO TO 0481 05120308 +20470 IVFAIL = IVFAIL + 1 05130308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05140308 + 0481 CONTINUE 05150308 +C 05160308 +C **** FCVS PROGRAM 308 - TEST 048 **** 05170308 +C 05180308 +C 05190308 + IVTNUM = 48 05200308 + IF (ICZERO) 30480, 0480, 30480 05210308 + 0480 CONTINUE 05220308 + RVCOMP = 10.0 05230308 + IVON01 = 2 05240308 + RVON01 = -4.8 05250308 + RVON02 = 4.5 05260308 + RVCOMP = AMIN1 (RVON01, (IVON01 - 3.2) * RVON02) 05270308 + RVCORR = -5.4 05280308 +40480 IF (RVCOMP + 5.4005 ) 20480, 10480, 40481 05290308 +40481 IF (RVCOMP + 5.3995 ) 10480, 10480, 20480 05300308 +30480 IVDELE = IVDELE + 1 05310308 + WRITE (I02,80000) IVTNUM 05320308 + IF (ICZERO) 10480, 0491, 20480 05330308 +10480 IVPASS = IVPASS + 1 05340308 + WRITE (I02,80002) IVTNUM 05350308 + GO TO 0491 05360308 +20480 IVFAIL = IVFAIL + 1 05370308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05380308 + 0491 CONTINUE 05390308 +C 05400308 +C **** FCVS PROGRAM 308 - TEST 049 **** 05410308 +C 05420308 +C 05430308 + IVTNUM = 49 05440308 + IF (ICZERO) 30490, 0490, 30490 05450308 + 0490 CONTINUE 05460308 + RVCOMP = 10.0 05470308 + RVON01 = 12.0 05480308 + IADN11(1) = 3 05490308 + RADN11(2) = 2.5 05500308 + RVCOMP = AMOD (RVON01 / IADN11(1), 12 / RADN11(2)) 05510308 + RVCORR = 4.0 05520308 +40490 IF (RVCOMP - 3.9995) 20490, 10490, 40491 05530308 +40491 IF (RVCOMP - 4.0005) 10490, 10490, 20490 05540308 +30490 IVDELE = IVDELE + 1 05550308 + WRITE (I02,80000) IVTNUM 05560308 + IF (ICZERO) 10490, 0501, 20490 05570308 +10490 IVPASS = IVPASS + 1 05580308 + WRITE (I02,80002) IVTNUM 05590308 + GO TO 0501 05600308 +20490 IVFAIL = IVFAIL + 1 05610308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05620308 + 0501 CONTINUE 05630308 +C 05640308 +C **** FCVS PROGRAM 308 - TEST 050 **** 05650308 +C 05660308 +C 05670308 + IVTNUM = 50 05680308 + IF (ICZERO) 30500, 0500, 30500 05690308 + 0500 CONTINUE 05700308 + IVCOMP = 10 05710308 + IVON01 = 2 05720308 + IVON02 = 9 05730308 + IVCOMP = IDIM (IVON01 ** 3, IVON02) 05740308 + IVCORR = 0 05750308 +40500 IF (IVCOMP) 20500, 10500, 20500 05760308 +30500 IVDELE = IVDELE + 1 05770308 + WRITE (I02,80000) IVTNUM 05780308 + IF (ICZERO) 10500, 0511, 20500 05790308 +10500 IVPASS = IVPASS + 1 05800308 + WRITE (I02,80002) IVTNUM 05810308 + GO TO 0511 05820308 +20500 IVFAIL = IVFAIL + 1 05830308 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05840308 + 0511 CONTINUE 05850308 +C 05860308 +C **** FCVS PROGRAM 308 - TEST 051 **** 05870308 +C 05880308 +C 05890308 + IVTNUM = 51 05900308 + IF (ICZERO) 30510, 0510, 30510 05910308 + 0510 CONTINUE 05920308 + RVCOMP = 10.0 05930308 + IVON01 = 6 05940308 + RVCOMP = REAL (IABS (-3) + IVON01) 05950308 + RVCORR = 9.0 05960308 +40510 IF (RVCOMP - 8.9995) 20510, 10510, 40511 05970308 +40511 IF (RVCOMP - 9.0005) 10510, 10510, 20510 05980308 +30510 IVDELE = IVDELE + 1 05990308 + WRITE (I02,80000) IVTNUM 06000308 + IF (ICZERO) 10510, 0521, 20510 06010308 +10510 IVPASS = IVPASS + 1 06020308 + WRITE (I02,80002) IVTNUM 06030308 + GO TO 0521 06040308 +20510 IVFAIL = IVFAIL + 1 06050308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06060308 + 0521 CONTINUE 06070308 +C 06080308 +C **** FCVS PROGRAM 308 - TEST 052 **** 06090308 +C 06100308 +C 06110308 + IVTNUM = 52 06120308 + IF (ICZERO) 30520, 0520, 30520 06130308 + 0520 CONTINUE 06140308 + RVCOMP = 10.0 06150308 + RVON01 = 2.3 06160308 + IVON01 = 150 06170308 + IADN11(1) = 3 06180308 + RVCOMP = SIGN(13+RVON01*IABS(-4)-IVON01/FF309(1.)**IADN11(1),-1.) 06190308 + RVCORR = -3.45 06200308 +40520 IF (RVCOMP + 3.4505) 20520, 10520, 40521 06210308 +40521 IF (RVCOMP + 3.4495) 10520, 10520, 20520 06220308 +30520 IVDELE = IVDELE + 1 06230308 + WRITE (I02,80000) IVTNUM 06240308 + IF (ICZERO) 10520, 0531, 20520 06250308 +10520 IVPASS = IVPASS + 1 06260308 + WRITE (I02,80002) IVTNUM 06270308 + GO TO 0531 06280308 +20520 IVFAIL = IVFAIL + 1 06290308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06300308 + 0531 CONTINUE 06310308 +C 06320308 +C TEST 053 THROUGH TEST 056 TEST INTRINSIC FUNCTIONS USING 06330308 +C STATEMENT FUNCTION REFERENCES AS ACTUAL ARGUMENTS. 06340308 +C 06350308 +C 06360308 +C **** FCVS PROGRAM 308 - TEST 053 **** 06370308 +C 06380308 +C 06390308 + IVTNUM = 53 06400308 + IF (ICZERO) 30530, 0530, 30530 06410308 + 0530 CONTINUE 06420308 + RVCOMP = 10.0 06430308 + RVCOMP = DIM (RFOS01(5.4), 6.0) 06440308 + RVCORR = .4 06450308 +40530 IF (RVCOMP - .39995) 20530, 10530, 40531 06460308 +40531 IF (RVCOMP - .40005) 10530, 10530, 20530 06470308 +30530 IVDELE = IVDELE + 1 06480308 + WRITE (I02,80000) IVTNUM 06490308 + IF (ICZERO) 10530, 0541, 20530 06500308 +10530 IVPASS = IVPASS + 1 06510308 + WRITE (I02,80002) IVTNUM 06520308 + GO TO 0541 06530308 +20530 IVFAIL = IVFAIL + 1 06540308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06550308 + 0541 CONTINUE 06560308 +C 06570308 +C **** FCVS PROGRAM 308 - TEST 054 **** 06580308 +C 06590308 +C 06600308 + IVTNUM = 54 06610308 + IF (ICZERO) 30540, 0540, 30540 06620308 + 0540 CONTINUE 06630308 + IVCOMP = 10 06640308 + IVCOMP = INT(RFOS01(2.01)) 06650308 + IVCORR = 3 06660308 +40540 IF (IVCOMP - 3) 20540, 10540, 20540 06670308 +30540 IVDELE = IVDELE + 1 06680308 + WRITE (I02,80000) IVTNUM 06690308 + IF (ICZERO) 10540, 0551, 20540 06700308 +10540 IVPASS = IVPASS + 1 06710308 + WRITE (I02,80002) IVTNUM 06720308 + GO TO 0551 06730308 +20540 IVFAIL = IVFAIL + 1 06740308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06750308 + 0551 CONTINUE 06760308 +C 06770308 +C **** FCVS PROGRAM 308 - TEST 055 **** 06780308 +C 06790308 +C 06800308 + IVTNUM = 55 06810308 + IF (ICZERO) 30550, 0550, 30550 06820308 + 0550 CONTINUE 06830308 + RVCOMP = 10.0 06840308 + RVON01 = 0.5708 06850308 + RVCOMP = SIN (RFOS01 (RVON01) / 2) 06860308 + RVCORR = .70711 06870308 +40550 IF (RVCOMP - .70706) 20550, 10550, 40551 06880308 +40551 IF (RVCOMP - .70716) 10550, 10550, 20550 06890308 +30550 IVDELE = IVDELE + 1 06900308 + WRITE (I02,80000) IVTNUM 06910308 + IF (ICZERO) 10550, 0561, 20550 06920308 +10550 IVPASS = IVPASS + 1 06930308 + WRITE (I02,80002) IVTNUM 06940308 + GO TO 0561 06950308 +20550 IVFAIL = IVFAIL + 1 06960308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06970308 + 0561 CONTINUE 06980308 +C 06990308 +C **** FCVS PROGRAM 308 - TEST 056 **** 07000308 +C 07010308 +C 07020308 + IVTNUM = 56 07030308 + IF (ICZERO) 30560, 0560, 30560 07040308 + 0560 CONTINUE 07050308 + RVCOMP = 10.0 07060308 + RADN11(2) = 1.5 07070308 + RVCOMP = TANH(RFOS01(RADN11(2))) 07080308 + RVCORR = .98661 07090308 +40560 IF (RVCOMP - .98656) 20560, 10560, 40561 07100308 +40561 IF (RVCOMP - .98666) 10560, 10560, 20560 07110308 +30560 IVDELE = IVDELE + 1 07120308 + WRITE (I02,80000) IVTNUM 07130308 + IF (ICZERO) 10560, 0571, 20560 07140308 +10560 IVPASS = IVPASS + 1 07150308 + WRITE (I02,80002) IVTNUM 07160308 + GO TO 0571 07170308 +20560 IVFAIL = IVFAIL + 1 07180308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07190308 + 0571 CONTINUE 07200308 +C 07210308 +C **** FCVS PROGRAM 308 - TEST 057 **** 07220308 +C 07230308 +C TEST 057 TESTS THE INTRINSIC FUNCTION AINT USING AN EXTERNAL 07240308 +C FUNCTION REFERENCE AS AN ACTUAL ARGUMENT AND THE COMMON 07250308 +C STATEMENT AS A MEANS OF PASSING DATA TO THE EXTERNAL FUNCTION. 07260308 +C 07270308 + IVTNUM = 57 07280308 + IF (ICZERO) 30570, 0570, 30570 07290308 + 0570 CONTINUE 07300308 + RVCOMP = 10.0 07310308 + RVCN01 = 25.3 07320308 + RVCOMP = AINT(FF310( )) 07330308 + RVCORR = 26.0 07340308 +40570 IF (RVCOMP - 25.995) 20570, 10570, 40571 07350308 +40571 IF (RVCOMP - 26.005) 10570, 10570, 20570 07360308 +30570 IVDELE = IVDELE + 1 07370308 + WRITE (I02,80000) IVTNUM 07380308 + IF (ICZERO) 10570, 0581, 20570 07390308 +10570 IVPASS = IVPASS + 1 07400308 + WRITE (I02,80002) IVTNUM 07410308 + GO TO 0581 07420308 +20570 IVFAIL = IVFAIL + 1 07430308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07440308 + 0581 CONTINUE 07450308 +C 07460308 +C **** FCVS PROGRAM 308 - TEST 058 **** 07470308 +C 07480308 +C TEST 058 TESTS THE INTRINSIC FUNCTION FLOAT BY USING A VARIABLE 07490308 +C EQUATED BY EQUIVALENCE ASSOCIATION AS AN ACTUAL ARGUMENT. 07500308 +C 07510308 + IVTNUM = 58 07520308 + IF (ICZERO) 30580, 0580, 30580 07530308 + 0580 CONTINUE 07540308 + RVCOMP = 10.0 07550308 + IVOE01 = 5 07560308 + RVCOMP = FLOAT(IVOE01) 07570308 + RVCORR = 5.0 07580308 +40580 IF (RVCOMP - 4.9995) 20580, 10580, 40581 07590308 +40581 IF (RVCOMP - 5.0005) 10580, 10580, 20580 07600308 +30580 IVDELE = IVDELE + 1 07610308 + WRITE (I02,80000) IVTNUM 07620308 + IF (ICZERO) 10580, 0591, 20580 07630308 +10580 IVPASS = IVPASS + 1 07640308 + WRITE (I02,80002) IVTNUM 07650308 + GO TO 0591 07660308 +20580 IVFAIL = IVFAIL + 1 07670308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07680308 + 0591 CONTINUE 07690308 +C 07700308 +C **** FCVS PROGRAM 308 - TEST 059 **** 07710308 +C 07720308 +C TEST 059 TESTS THE INTRINSIC FUNCTION MIN1 BY USING A VARIABLE 07730308 +C INITIALIZED BY THE DATA STATEMENT AS AN ACTUAL ARGUMENT. 07740308 +C 07750308 + IVTNUM = 59 07760308 + IF (ICZERO) 30590, 0590, 30590 07770308 + 0590 CONTINUE 07780308 + IVCOMP = 10 07790308 + IVCOMP = MIN1(6., RVON04, 7.3) 07800308 + IVCORR = 2 07810308 +40590 IF (IVCOMP - 2) 20590, 10590, 20590 07820308 +30590 IVDELE = IVDELE + 1 07830308 + WRITE (I02,80000) IVTNUM 07840308 + IF (ICZERO) 10590, 0601, 20590 07850308 +10590 IVPASS = IVPASS + 1 07860308 + WRITE (I02,80002) IVTNUM 07870308 + GO TO 0601 07880308 +20590 IVFAIL = IVFAIL + 1 07890308 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07900308 + 0601 CONTINUE 07910308 +C 07920308 +C **** FCVS PROGRAM 308 - TEST 060 **** 07930308 +C 07940308 +C TEST 060 ATTEMPTS TO OVERRIDE THE TYPING OF REAL FOR THE 07950308 +C INTRINSIC FUNCTION EXP WITH IMPLICIT INTEGER TYPING. 07960308 +C 07970308 + IVTNUM = 60 07980308 + IF (ICZERO) 30600, 0600, 30600 07990308 + 0600 CONTINUE 08000308 + RVCOMP = 10.0 08010308 + RVON01 = 2.05 08020308 + RVCOMP = EXP(RVON01) 08030308 + RVCORR = 7.7679 08040308 +40600 IF (RVCOMP - 7.7674) 20600, 10600, 40601 08050308 +40601 IF (RVCOMP - 7.7684) 10600, 10600, 20600 08060308 +30600 IVDELE = IVDELE + 1 08070308 + WRITE (I02,80000) IVTNUM 08080308 + IF (ICZERO) 10600, 0611, 20600 08090308 +10600 IVPASS = IVPASS + 1 08100308 + WRITE (I02,80002) IVTNUM 08110308 + GO TO 0611 08120308 +20600 IVFAIL = IVFAIL + 1 08130308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08140308 + 0611 CONTINUE 08150308 +C 08160308 +C **** FCVS PROGRAM 308 - TEST 061 **** 08170308 +C 08180308 +C TEST 061 ATTEMPTS TO OVERRIDE THE TYPING OF INTEGER FOR THE 08190308 +C INTRINSIC FUNCTION NINT WITH IMPLICIT REAL TYPING. 08200308 +C 08210308 + IVTNUM = 61 08220308 + IF (ICZERO) 30610, 0610, 30610 08230308 + 0610 CONTINUE 08240308 + RVCOMP = 10.0 08250308 + RVON01 = 3.78 08260308 + RVCOMP = NINT(RVON01) / 5 08270308 + RVCORR = 0.0 08280308 +40610 IF (RVCOMP + .00005) 20610, 10610, 40611 08290308 +40611 IF (RVCOMP - .00005) 10610, 10610, 20610 08300308 +30610 IVDELE = IVDELE + 1 08310308 + WRITE (I02,80000) IVTNUM 08320308 + IF (ICZERO) 10610, 0621, 20610 08330308 +10610 IVPASS = IVPASS + 1 08340308 + WRITE (I02,80002) IVTNUM 08350308 + GO TO 0621 08360308 +20610 IVFAIL = IVFAIL + 1 08370308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08380308 + 0621 CONTINUE 08390308 +C 08400308 +C **** FCVS PROGRAM 308 - TEST 062 **** 08410308 +C 08420308 +C TEST 062 ATTEMPTS TO OVERRIDE THE TYPING OF REAL FOR THE 08430308 +C INTRINSIC FUNCTION SINH WITH TYPE-STATEMENT TYPING OF INTEGER. 08440308 +C 08450308 + IVTNUM = 62 08460308 + IF (ICZERO) 30620, 0620, 30620 08470308 + 0620 CONTINUE 08480308 + RVCOMP = 10.0 08490308 + RVCOMP = SINH(2.0) 08500308 + RVCORR = 3.6269 08510308 +40620 IF (RVCOMP - 3.6264) 20620, 10620, 40621 08520308 +40621 IF (RVCOMP - 3.6274) 10620, 10620, 20620 08530308 +30620 IVDELE = IVDELE + 1 08540308 + WRITE (I02,80000) IVTNUM 08550308 + IF (ICZERO) 10620, 0631, 20620 08560308 +10620 IVPASS = IVPASS + 1 08570308 + WRITE (I02,80002) IVTNUM 08580308 + GO TO 0631 08590308 +20620 IVFAIL = IVFAIL + 1 08600308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08610308 + 0631 CONTINUE 08620308 +C 08630308 +C **** FCVS PROGRAM 308 - TEST 063 **** 08640308 +C 08650308 +C TEST 063 ATTEMPTS TO OVERRIDE THE TYPING OF INTEGER FOR THE 08660308 +C INTRINSIC FUNCTION MAX1 WITH TYPE-STATEMENT TYPING OF REAL. 08670308 +C 08680308 + IVTNUM = 63 08690308 + IF (ICZERO) 30630, 0630, 30630 08700308 + 0630 CONTINUE 08710308 + RVCOMP = 10.0 08720308 + RVCOMP = MAX1(2.3, 3.1, 4.4) / 5 08730308 + RVCORR = 0.0 08740308 +40630 IF (RVCOMP + .00005) 20630, 10630, 40631 08750308 +40631 IF (RVCOMP - .00005) 10630, 10630, 20630 08760308 +30630 IVDELE = IVDELE + 1 08770308 + WRITE (I02,80000) IVTNUM 08780308 + IF (ICZERO) 10630, 0641, 20630 08790308 +10630 IVPASS = IVPASS + 1 08800308 + WRITE (I02,80002) IVTNUM 08810308 + GO TO 0641 08820308 +20630 IVFAIL = IVFAIL + 1 08830308 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08840308 + 0641 CONTINUE 08850308 +C 08860308 +C 08870308 +C WRITE OUT TEST SUMMARY 08880308 +C 08890308 + WRITE (I02,90004) 08900308 + WRITE (I02,90014) 08910308 + WRITE (I02,90004) 08920308 + WRITE (I02,90000) 08930308 + WRITE (I02,90004) 08940308 + WRITE (I02,90020) IVFAIL 08950308 + WRITE (I02,90022) IVPASS 08960308 + WRITE (I02,90024) IVDELE 08970308 + STOP 08980308 +90001 FORMAT (" ",24X,"FM308") 08990308 +90000 FORMAT (" ",20X,"END OF PROGRAM FM308" ) 09000308 +C 09010308 +C FORMATS FOR TEST DETAIL LINES 09020308 +C 09030308 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 09040308 +80002 FORMAT (" ",4X,I5,7X,"PASS") 09050308 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 09060308 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 09070308 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 09080308 +C 09090308 +C FORMAT STATEMENTS FOR PAGE HEADERS 09100308 +C 09110308 +90002 FORMAT ("1") 09120308 +90004 FORMAT (" ") 09130308 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 09140308 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 09150308 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 09160308 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 09170308 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 09180308 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 09190308 +C 09200308 +C FORMAT STATEMENTS FOR RUN SUMMARY 09210308 +C 09220308 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 09230308 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 09240308 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 09250308 + END 09260308 + + REAL FUNCTION FF309(RDON01) 00010309 +C THIS FUNCTION IS USED TO INCREMENT THE ARGUMENT VALUE BY 00020309 +C ONE AND RETURN THE RESULT AS THE FUNCTION VALUE. 00030309 + FF309 = RDON01 + 1.0 00040309 + RETURN 00050309 + END 00060309 + + REAL FUNCTION FF310 ( ) 00010310 +C THIS FUNCTION IS USED TO INCREMENT BY ONE A VALUE PASSED 00020310 +C TO THE FUNCTION THROUGH COMMON. 00030310 + COMMON RVCN01 00040310 + FF310 = RVCN01 + 1.0 00050310 + RETURN 00060310 + END 00070310 diff --git a/Fortran/UnitTests/fcvs21_f95/FM308.reference_output b/Fortran/UnitTests/fcvs21_f95/FM308.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM308.reference_output @@ -0,0 +1,53 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM308 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 32 PASS + 33 PASS + 34 PASS + 35 PASS + 36 PASS + 37 PASS + 38 PASS + 39 PASS + 40 PASS + 41 PASS + 42 PASS + 43 PASS + 44 PASS + 45 PASS + 46 PASS + 47 PASS + 48 PASS + 49 PASS + 50 PASS + 51 PASS + 52 PASS + 53 PASS + 54 PASS + 55 PASS + 56 PASS + 57 PASS + 58 PASS + 59 PASS + 60 PASS + 61 PASS + 62 PASS + 63 PASS + + ---------------------------------------------- + + END OF PROGRAM FM308 + + 0 TESTS FAILED + 32 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM311.f b/Fortran/UnitTests/fcvs21_f95/FM311.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM311.f @@ -0,0 +1,1154 @@ + PROGRAM FM311 00010311 +C 00020311 +C 00030311 +C THIS ROUTINE TESTS THE USE OF THE FORTRAN IN-LINE STATEMENT 00040311 +C FUNCTION OF TYPES INTEGER, REAL AND LOGICAL. SPECIFIC FEATURES 00050311 +C TESTED INCLUDE, 00060311 +C 00070311 +C A) REAL STATEMENT FUNCTIONS USING REAL CONSTANTS AND VARIABLES 00080311 +C IN THE EXPRESSION AND AS ACTUAL ARGUMENTS. 00090311 +C 00100311 +C B) STATEMENT FUNCTIONS WHICH REQUIRE CONVERSION OF THE 00110311 +C EXPRESSION TO REAL AND INTEGER TYPING. 00120311 +C 00130311 +C C) THE USE OF VARIABLES, ARRAY ELEMENTS, EXTERNAL REFERENCES, 00140311 +C AND INITIALLY DEFINED ENITIIES IN THE EXPRESSION. 00150311 +C 00160311 +C D) VARIOUS DEFINITIONS AND USES OF DUMMY ARGUMENTS. 00170311 +C 00180311 +C E) ACTUAL ARGUMENTS CONSISTING OF EXPRESSIONS, INTRINSIC 00190311 +C FUNCTION REFERENCES, AND EXTERNAL FUNCTION REFERENCES. 00200311 +C 00210311 +C F) CONFIRMING AND OVERRIDING THE TYPING OF STATEMENT FUNCTIONS 00220311 +C AND DUMMY ARGUMENTS. 00230311 +C 00240311 +C G) USE OF STATEMENT FUNCTIONS AND DUMMY ARGUMENTS IN THE MAIN 00250311 +C PROGRAM AND IN EXTERNAL FUNCTION AND SUBROUTINE SUBPROGRAMS.00260311 +C 00270311 +C THE SUBSET LEVEL FEATURES OF STATEMENT FUNCTIONS ARE ALSO TESTED 00280311 +C IN ROUTINE FM020. 00290311 +C 00300311 +C REFERENCES. 00310311 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00320311 +C X3.9-1978 00330311 +C 00340311 +C SECTION 8.3, COMMON STATEMENT 00350311 +C SECTION 8.4, TYPE-STATEMENT 00360311 +C SECTION 8.5, IMPLICIT STATEMENT 00370311 +C SECTION 8.7, EXTERNAL STATEMENT 00380311 +C SECTION 8.8, INTRINSIC STATEMENT 00390311 +C SECTION 9, DATA STATEMENT 00400311 +C SECTION 15.3, INTRINSIC FUNCTIONS 00410311 +C SECTION 15.4, STATEMENT FUNCTION 00420311 +C SECTION 15.5, EXTERNAL FUNCTIONS 00430311 +C SECTION 15.6, SUBROUTINES 00440311 +C SECTION 15.9.1, DUMMY ARGUMENTS 00450311 +C SECTION 15.9.2, ACTUAL ARGUMENTS 00460311 +C SECTION 15.9.3, ASSOCIATION OF DUMMY AND ACTUAL ARGUMENTS 00470311 +C 00480311 +C 00490311 +C ******************************************************************00500311 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00510311 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00520311 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00530311 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00540311 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00550311 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00560311 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00570311 +C THE RESULT OF EXECUTING THESE TESTS. 00580311 +C 00590311 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00600311 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00610311 +C 00620311 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00630311 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00640311 +C SOFTWARE STANDARDS VALIDATION GROUP 00650311 +C BUILDING 225 RM A266 00660311 +C GAITHERSBURG, MD 20899 00670311 +C ******************************************************************00680311 +C 00690311 +C 00700311 + IMPLICIT LOGICAL (L) 00710311 + IMPLICIT CHARACTER*14 (C) 00720311 +C 00730311 + IMPLICIT INTEGER (A) 00740311 + IMPLICIT INTEGER (B) 00750311 + IMPLICIT REAL (K) 00760311 + IMPLICIT REAL (M) 00770311 + REAL NDON01 00780311 + INTEGER EDON01 00790311 + INTEGER FF312, FF314 00800311 + EXTERNAL FF312 00810311 + INTRINSIC NINT 00820311 + DIMENSION RADN11(4), RADN12(4), RADN13(4) 00830311 + DIMENSION IADN11(4), IADN12(4) 00840311 + DIMENSION LADN11(4) 00850311 + COMMON /IFOS19/IVCN01 00860311 + DATA IVOND1/6/ 00870311 +C TEST 001 00880311 + RFOS01(RDON01) = 3.5 00890311 +C TEST 002 00900311 + RFOS02(RDON02) = RDON02 00910311 +C TEST 003 00920311 + RFOS03(RDON03) = RDON03 + 1.0 00930311 +C TEST 004 00940311 + IFOS01(RDON04) = RDON04 + 1.0 00950311 +C TEST 005 00960311 + RFOS04(IDON01) = IDON01 + 1 00970311 +C TEST 006 00980311 + IFOS02(IDON02) = IDON02 + 1.95 00990311 +C TEST 007 01000311 + IFOS03(IDON03) = IDON03 + IVON01 01010311 +C TEST 008 01020311 + RFOS05(RDON05) = RDON05 + RVON02 01030311 +C TEST 009 01040311 + LFOS01(LDON01) = LDON01 .OR. LVON01 01050311 +C TEST 010 01060311 + IFOS04(IDON04) = IDON04 + IADN11(1) 01070311 +C TEST 011 01080311 + RFOS06(RDON06) = RDON06 + RADN12(3) 01090311 +C TEST 012 01100311 + LFOS02(LDON02) = .NOT. LDON02 .AND. LADN11(2) 01110311 +C TEST 013 01120311 + RFOS07(IDON05) = RADN13(IDON05) 01130311 +C TEST 014 01140311 + IFOS05(IDON06) = IDON06 + FF312(4) 01150311 +C TEST 015 01160311 + IFOS06(IDON07) = (IDON07 + 1) 01170311 +C TEST 016 01180311 + IFOS07(IDON08) = IDON08 + IVOND1 01190311 +C TEST 017 01200311 + IFOS08(IDON09) = IDON09 + 1 01210311 + IFOS09(IDON10) = IFOS08(IDON10) + 1 01220311 +C TEST 018 01230311 + IFOS10() = IVON02 01240311 +C TEST 019 01250311 + IFOS11(IDON11,IDON12,IDON13) = IDON11 + IDON12 + IDON13 01260311 +C TEST 020 01270311 + IFOS12(IDON14) = IDON14 + 1 01280311 + IFOS13(IDON14) = IDON14 + 2 01290311 +C TEST 021,022,023 01300311 + IFOS14(IDON15) = IDON15 + 1 01310311 +C TEST 024 01320311 + KFOS01(IDON16) = IDON16 + 1.0 01330311 +C TEST 025 01340311 + AFOS01(RDON07) = RDON07 + 1.0 01350311 +C TEST 026 01360311 + RFOS08(MDON01) = MDON01 / 5 01370311 +C TEST 027 01380311 + RFOS09(BDON01) = BDON01 / 5 01390311 +C TEST 028 01400311 + RFOS10(NDON01) = NDON01 / 5 01410311 +C TEST 029 01420311 + RFOS11(EDON01) = EDON01 / 5 01430311 +C TEST 030 01440311 + IFOS15(IVON04) = IVON04 + 1 01450311 +C TEST 031 01460311 + IFOS16(IDON17) = IDON17 + 1 01470311 +C TEST 032 01480311 + IFOS17(IDON18) = IDON18 + 1 01490311 +C TEST 037 01500311 + IFOS19(IDON21) = IDON21 + 1 01510311 +C 01520311 +C 01530311 +C 01540311 +C INITIALIZATION SECTION. 01550311 +C 01560311 +C INITIALIZE CONSTANTS 01570311 +C ******************** 01580311 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01590311 + I01 = 5 01600311 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01610311 + I02 = 6 01620311 +C SYSTEM ENVIRONMENT SECTION 01630311 +C 01640311 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01650311 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01660311 +C (UNIT NUMBER FOR CARD READER). 01670311 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01680311 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01690311 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01700311 +C 01710311 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01720311 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01730311 +C (UNIT NUMBER FOR PRINTER). 01740311 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01750311 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01760311 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01770311 +C 01780311 + IVPASS = 0 01790311 + IVFAIL = 0 01800311 + IVDELE = 0 01810311 + ICZERO = 0 01820311 +C 01830311 +C WRITE OUT PAGE HEADERS 01840311 +C 01850311 + WRITE (I02,90002) 01860311 + WRITE (I02,90006) 01870311 + WRITE (I02,90008) 01880311 + WRITE (I02,90004) 01890311 + WRITE (I02,90010) 01900311 + WRITE (I02,90004) 01910311 + WRITE (I02,90016) 01920311 + WRITE (I02,90001) 01930311 + WRITE (I02,90004) 01940311 + WRITE (I02,90012) 01950311 + WRITE (I02,90014) 01960311 + WRITE (I02,90004) 01970311 +C 01980311 +C 01990311 +C TEST 001 THROUGH TEST 003 TEST REAL STATEMENT FUNCTIONS WHERE THE 02000311 +C EXPRESSION CONSISTS OF REAL CONSTANTS AND VARIABLES AND THE ACTUAL02010311 +C ARGUMENTS ARE EITHER REAL CONSTANTS OR VARIABLES. 02020311 +C 02030311 +C 02040311 +C **** FCVS PROGRAM 311 - TEST 001 **** 02050311 +C 02060311 +C EXPRESSION CONSISTS OF REAL CONSTANT (NO DUMMY ARGUMENT). 02070311 +C 02080311 + IVTNUM = 1 02090311 + IF (ICZERO) 30010, 0010, 30010 02100311 + 0010 CONTINUE 02110311 + RVCOMP = 0.0 02120311 + RVCOMP = RFOS01(1.0) 02130311 + RVCORR = 3.5 02140311 +40010 IF (RVCOMP - 3.4995) 20010, 10010, 40011 02150311 +40011 IF (RVCOMP - 3.5005) 10010, 10010, 20010 02160311 +30010 IVDELE = IVDELE + 1 02170311 + WRITE (I02,80000) IVTNUM 02180311 + IF (ICZERO) 10010, 0021, 20010 02190311 +10010 IVPASS = IVPASS + 1 02200311 + WRITE (I02,80002) IVTNUM 02210311 + GO TO 0021 02220311 +20010 IVFAIL = IVFAIL + 1 02230311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02240311 + 0021 CONTINUE 02250311 +C 02260311 +C **** FCVS PROGRAM 311 - TEST 002 **** 02270311 +C 02280311 +C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL 02290311 +C CONSTANT. 02300311 +C 02310311 + IVTNUM = 2 02320311 + IF (ICZERO) 30020, 0020, 30020 02330311 + 0020 CONTINUE 02340311 + RVCOMP = 0.0 02350311 + RVCOMP = RFOS02(1.3333) 02360311 + RVCORR = 1.3333 02370311 +40020 IF (RVCOMP - 1.3328) 20020, 10020, 40021 02380311 +40021 IF (RVCOMP - 1.3338) 10020, 10020, 20020 02390311 +30020 IVDELE = IVDELE + 1 02400311 + WRITE (I02,80000) IVTNUM 02410311 + IF (ICZERO) 10020, 0031, 20020 02420311 +10020 IVPASS = IVPASS + 1 02430311 + WRITE (I02,80002) IVTNUM 02440311 + GO TO 0031 02450311 +20020 IVFAIL = IVFAIL + 1 02460311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02470311 + 0031 CONTINUE 02480311 +C 02490311 +C **** FCVS PROGRAM 311 - TEST 003 **** 02500311 +C 02510311 +C DUMMY ARGUMENT USED IN EXPRESSION AND ACTUAL ARGUMENT IS REAL 02520311 +C VARIABLE. 02530311 +C 02540311 + IVTNUM = 3 02550311 + IF (ICZERO) 30030, 0030, 30030 02560311 + 0030 CONTINUE 02570311 + RVCOMP = 0.0 02580311 + RVON01 = 4.5 02590311 + RVCOMP = RFOS03(RVON01) 02600311 + RVCORR = 5.5 02610311 +40030 IF (RVCOMP - 5.4995) 20030, 10030, 40031 02620311 +40031 IF (RVCOMP - 5.5005) 10030, 10030, 20030 02630311 +30030 IVDELE = IVDELE + 1 02640311 + WRITE (I02,80000) IVTNUM 02650311 + IF (ICZERO) 10030, 0041, 20030 02660311 +10030 IVPASS = IVPASS + 1 02670311 + WRITE (I02,80002) IVTNUM 02680311 + GO TO 0041 02690311 +20030 IVFAIL = IVFAIL + 1 02700311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02710311 + 0041 CONTINUE 02720311 +C 02730311 +C TEST 004 THROUGH TEST 006 TEST STATEMENT FUNCTIONS WHICH REQUIRE 02740311 +C TYPE CONVERSION OF THE EXPRESSION. 02750311 +C 02760311 +C 02770311 +C **** FCVS PROGRAM 311 - TEST 004 **** 02780311 +C 02790311 +C INTEGER STATEMENT FUNCTION WITH REAL EXPRESSION. 02800311 +C 02810311 + IVTNUM = 4 02820311 + IF (ICZERO) 30040, 0040, 30040 02830311 + 0040 CONTINUE 02840311 + IVCOMP = 0 02850311 + IVCOMP = IFOS01(2.3) 02860311 + IVCORR = 3 02870311 +40040 IF (IVCOMP - 3) 20040, 10040, 20040 02880311 +30040 IVDELE = IVDELE + 1 02890311 + WRITE (I02,80000) IVTNUM 02900311 + IF (ICZERO) 10040, 0051, 20040 02910311 +10040 IVPASS = IVPASS + 1 02920311 + WRITE (I02,80002) IVTNUM 02930311 + GO TO 0051 02940311 +20040 IVFAIL = IVFAIL + 1 02950311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02960311 + 0051 CONTINUE 02970311 +C 02980311 +C **** FCVS PROGRAM 311 - TEST 005 **** 02990311 +C 03000311 +C REAL STATEMENT FUNCTION WITH INTEGER EXPRESSION 03010311 +C 03020311 + IVTNUM = 5 03030311 + IF (ICZERO) 30050, 0050, 30050 03040311 + 0050 CONTINUE 03050311 + RVCOMP = 0.0 03060311 + RVCOMP = RFOS04(3) 03070311 + RVCORR = 4.0 03080311 +40050 IF (RVCOMP - 3.9995) 20050, 10050, 40051 03090311 +40051 IF (RVCOMP - 4.0005) 10050, 10050, 20050 03100311 +30050 IVDELE = IVDELE + 1 03110311 + WRITE (I02,80000) IVTNUM 03120311 + IF (ICZERO) 10050, 0061, 20050 03130311 +10050 IVPASS = IVPASS + 1 03140311 + WRITE (I02,80002) IVTNUM 03150311 + GO TO 0061 03160311 +20050 IVFAIL = IVFAIL + 1 03170311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03180311 + 0061 CONTINUE 03190311 +C 03200311 +C **** FCVS PROGRAM 311 - TEST 006 **** 03210311 +C 03220311 +C INTEGER STATEMENT FUNCTION WITH EXPRESSION CONSISTING OF INTEGER 03230311 +C AND REAL PRIMARIES. 03240311 +C 03250311 + IVTNUM = 6 03260311 + IF (ICZERO) 30060, 0060, 30060 03270311 + 0060 CONTINUE 03280311 + IVCOMP = 0 03290311 + IVCOMP = IFOS02(2) 03300311 + IVCORR = 3 03310311 +40060 IF (IVCOMP - 3) 20060, 10060, 20060 03320311 +30060 IVDELE = IVDELE + 1 03330311 + WRITE (I02,80000) IVTNUM 03340311 + IF (ICZERO) 10060, 0071, 20060 03350311 +10060 IVPASS = IVPASS + 1 03360311 + WRITE (I02,80002) IVTNUM 03370311 + GO TO 0071 03380311 +20060 IVFAIL = IVFAIL + 1 03390311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03400311 + 0071 CONTINUE 03410311 +C 03420311 +C TEST 007 THROUGH TEST 017 TEST THE USAGE OF VARIOUS PRIMARIES 03430311 +C IN THE EXPRESSION OF A STATEMENT FUNCTION. 03440311 +C 03450311 +C 03460311 +C **** FCVS PROGRAM 311 - TEST 007 **** 03470311 +C 03480311 +C USE INTEGER VARIABLE AS PRIMARY 03490311 +C 03500311 + IVTNUM = 7 03510311 + IF (ICZERO) 30070, 0070, 30070 03520311 + 0070 CONTINUE 03530311 + IVCOMP = 0 03540311 + IVON01 = 3 03550311 + IVCOMP = IFOS03(4) 03560311 + IVCORR = 7 03570311 +40070 IF (IVCOMP - 7) 20070, 10070, 20070 03580311 +30070 IVDELE = IVDELE + 1 03590311 + WRITE (I02,80000) IVTNUM 03600311 + IF (ICZERO) 10070, 0081, 20070 03610311 +10070 IVPASS = IVPASS + 1 03620311 + WRITE (I02,80002) IVTNUM 03630311 + GO TO 0081 03640311 +20070 IVFAIL = IVFAIL + 1 03650311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03660311 + 0081 CONTINUE 03670311 +C 03680311 +C **** FCVS PROGRAM 311 - TEST 008 **** 03690311 +C 03700311 +C USE REAL VARIABLE AS PRIMARY. 03710311 +C 03720311 + IVTNUM = 8 03730311 + IF (ICZERO) 30080, 0080, 30080 03740311 + 0080 CONTINUE 03750311 + RVCOMP = 0.0 03760311 + RVON02 = 1.5 03770311 + RADN11(2) = 1.3 03780311 + RVCOMP = RFOS05(RADN11(2)) 03790311 + RVCORR = 2.8 03800311 +40080 IF (RVCOMP - 2.7995) 20080, 10080, 40081 03810311 +40081 IF (RVCOMP - 2.8005) 10080, 10080, 20080 03820311 +30080 IVDELE = IVDELE + 1 03830311 + WRITE (I02,80000) IVTNUM 03840311 + IF (ICZERO) 10080, 0091, 20080 03850311 +10080 IVPASS = IVPASS + 1 03860311 + WRITE (I02,80002) IVTNUM 03870311 + GO TO 0091 03880311 +20080 IVFAIL = IVFAIL + 1 03890311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03900311 + 0091 CONTINUE 03910311 +C 03920311 +C **** FCVS PROGRAM 311 - TEST 009 **** 03930311 +C 03940311 +C USE LOGICAL VARIABLE AS PRIMARY. 03950311 +C 03960311 + IVTNUM = 9 03970311 + IF (ICZERO) 30090, 0090, 30090 03980311 + 0090 CONTINUE 03990311 + LVON01 = .TRUE. 04000311 + IVCOMP = 0 04010311 + IF (LFOS01(.FALSE.)) IVCOMP = 1 04020311 + IVCORR = 1 04030311 +40090 IF (IVCOMP - 1) 20090, 10090, 20090 04040311 +30090 IVDELE = IVDELE + 1 04050311 + WRITE (I02,80000) IVTNUM 04060311 + IF (ICZERO) 10090, 0101, 20090 04070311 +10090 IVPASS = IVPASS + 1 04080311 + WRITE (I02,80002) IVTNUM 04090311 + GO TO 0101 04100311 +20090 IVFAIL = IVFAIL + 1 04110311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04120311 + 0101 CONTINUE 04130311 +C 04140311 +C **** FCVS PROGRAM 311 - TEST 010 **** 04150311 +C 04160311 +C USE INTEGER ARRAY ELEMENT NAME AS PRIMARY. 04170311 +C 04180311 + IVTNUM = 10 04190311 + IF (ICZERO) 30100, 0100, 30100 04200311 + 0100 CONTINUE 04210311 + IVCOMP = 0 04220311 + IADN11(1) = 7 04230311 + IVCOMP = IFOS04(-4) 04240311 + IVCORR = 3 04250311 +40100 IF (IVCOMP - 3) 20100, 10100, 20100 04260311 +30100 IVDELE = IVDELE + 1 04270311 + WRITE (I02,80000) IVTNUM 04280311 + IF (ICZERO) 10100, 0111, 20100 04290311 +10100 IVPASS = IVPASS + 1 04300311 + WRITE (I02,80002) IVTNUM 04310311 + GO TO 0111 04320311 +20100 IVFAIL = IVFAIL + 1 04330311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04340311 + 0111 CONTINUE 04350311 +C 04360311 +C **** FCVS PROGRAM 311 - TEST 011 **** 04370311 +C 04380311 +C USE REAL ARRAY ELEMENT NAME AS PRIMARY. 04390311 +C 04400311 + IVTNUM = 11 04410311 + IF (ICZERO) 30110, 0110, 30110 04420311 + 0110 CONTINUE 04430311 + RVCOMP = 0.0 04440311 + RADN12(3) = 1.23 04450311 + RVCOMP = RFOS06(3.0) 04460311 + RVCORR = 4.23 04470311 +40110 IF (RVCOMP - 4.2295) 20110, 10110, 40111 04480311 +40111 IF (RVCOMP - 4.2305) 10110, 10110, 20110 04490311 +30110 IVDELE = IVDELE + 1 04500311 + WRITE (I02,80000) IVTNUM 04510311 + IF (ICZERO) 10110, 0121, 20110 04520311 +10110 IVPASS = IVPASS + 1 04530311 + WRITE (I02,80002) IVTNUM 04540311 + GO TO 0121 04550311 +20110 IVFAIL = IVFAIL + 1 04560311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04570311 + 0121 CONTINUE 04580311 +C 04590311 +C **** FCVS PROGRAM 311 - TEST 012 **** 04600311 +C 04610311 +C USE LOGICAL ARRAY ELEMENT NAME AS PRIMARY. 04620311 +C 04630311 + IVTNUM = 12 04640311 + IF (ICZERO) 30120, 0120, 30120 04650311 + 0120 CONTINUE 04660311 + LADN11(2) = .TRUE. 04670311 + IVCOMP = 0 04680311 + IF (LFOS02(.FALSE.)) IVCOMP = 1 04690311 + IVCORR = 1 04700311 +40120 IF (IVCOMP - 1) 20120, 10120, 20120 04710311 +30120 IVDELE = IVDELE + 1 04720311 + WRITE (I02,80000) IVTNUM 04730311 + IF (ICZERO) 10120, 0131, 20120 04740311 +10120 IVPASS = IVPASS + 1 04750311 + WRITE (I02,80002) IVTNUM 04760311 + GO TO 0131 04770311 +20120 IVFAIL = IVFAIL + 1 04780311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04790311 + 0131 CONTINUE 04800311 +C 04810311 +C **** FCVS PROGRAM 311 - TEST 013 **** 04820311 +C 04830311 +C USE A REAL ARRAY ELEMENT NAME AS PRIMARY WHERE THE SUBSCRIPT 04840311 +C VALUE IS THE DUMMY ARGUMENT NAME. 04850311 +C 04860311 + IVTNUM = 13 04870311 + IF (ICZERO) 30130, 0130, 30130 04880311 + 0130 CONTINUE 04890311 + RVCOMP = 0.0 04900311 + RADN13(4) = 13.4 04910311 + RVCOMP = RFOS07(4) 04920311 + RVCORR = 13.4 04930311 +40130 IF (RVCOMP - 13.395) 20130, 10130, 40131 04940311 +40131 IF (RVCOMP - 13.405) 10130, 10130, 20130 04950311 +30130 IVDELE = IVDELE + 1 04960311 + WRITE (I02,80000) IVTNUM 04970311 + IF (ICZERO) 10130, 0141, 20130 04980311 +10130 IVPASS = IVPASS + 1 04990311 + WRITE (I02,80002) IVTNUM 05000311 + GO TO 0141 05010311 +20130 IVFAIL = IVFAIL + 1 05020311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05030311 + 0141 CONTINUE 05040311 +C 05050311 +C **** FCVS PROGRAM 311 - TEST 014 **** 05060311 +C 05070311 +C USE EXTERNAL FUNCTION REFERENCE AS PRIMARY. 05080311 +C 05090311 + IVTNUM = 14 05100311 + IF (ICZERO) 30140, 0140, 30140 05110311 + 0140 CONTINUE 05120311 + IVCOMP = 0 05130311 + IVCOMP = IFOS05(6) 05140311 + IVCORR = 11 05150311 +40140 IF (IVCOMP - 11) 20140, 10140, 20140 05160311 +30140 IVDELE = IVDELE + 1 05170311 + WRITE (I02,80000) IVTNUM 05180311 + IF (ICZERO) 10140, 0151, 20140 05190311 +10140 IVPASS = IVPASS + 1 05200311 + WRITE (I02,80002) IVTNUM 05210311 + GO TO 0151 05220311 +20140 IVFAIL = IVFAIL + 1 05230311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05240311 + 0151 CONTINUE 05250311 +C 05260311 +C **** FCVS PROGRAM 311 - TEST 015 **** 05270311 +C 05280311 +C USE EXPRESSION ENCLOSED IN PARENTHESES. 05290311 +C 05300311 + IVTNUM = 15 05310311 + IF (ICZERO) 30150, 0150, 30150 05320311 + 0150 CONTINUE 05330311 + IVCOMP = 0 05340311 + IVCOMP = IFOS06(4) 05350311 + IVCORR = 5 05360311 +40150 IF (IVCOMP - 5) 20150, 10150, 20150 05370311 +30150 IVDELE = IVDELE + 1 05380311 + WRITE (I02,80000) IVTNUM 05390311 + IF (ICZERO) 10150, 0161, 20150 05400311 +10150 IVPASS = IVPASS + 1 05410311 + WRITE (I02,80002) IVTNUM 05420311 + GO TO 0161 05430311 +20150 IVFAIL = IVFAIL + 1 05440311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05450311 + 0161 CONTINUE 05460311 +C 05470311 +C **** FCVS PROGRAM 311 - TEST 016 **** 05480311 +C 05490311 +C USE VARIABLE INITIALLY DEFINED IN DATA STATEMENT AS PRIMARY. 05500311 +C 05510311 + IVTNUM = 16 05520311 + IF (ICZERO) 30160, 0160, 30160 05530311 + 0160 CONTINUE 05540311 + IVCOMP = 0 05550311 + IVCOMP = IFOS07(3) 05560311 + IVCORR = 9 05570311 +40160 IF (IVCOMP - 9) 20160, 10160, 20160 05580311 +30160 IVDELE = IVDELE + 1 05590311 + WRITE (I02,80000) IVTNUM 05600311 + IF (ICZERO) 10160, 0171, 20160 05610311 +10160 IVPASS = IVPASS + 1 05620311 + WRITE (I02,80002) IVTNUM 05630311 + GO TO 0171 05640311 +20160 IVFAIL = IVFAIL + 1 05650311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05660311 + 0171 CONTINUE 05670311 +C 05680311 +C **** FCVS PROGRAM 311 - TEST 017 **** 05690311 +C 05700311 +C USE PREVIOUSLY DEFINED STATEMENT FUNCTION REFERENCE AS PRIMARY. 05710311 +C 05720311 + IVTNUM = 17 05730311 + IF (ICZERO) 30170, 0170, 30170 05740311 + 0170 CONTINUE 05750311 + IVCOMP = 0 05760311 + IVCOMP = IFOS09(3) 05770311 + IVCORR = 5 05780311 +40170 IF (IVCOMP - 5) 20170, 10170, 20170 05790311 +30170 IVDELE = IVDELE + 1 05800311 + WRITE (I02,80000) IVTNUM 05810311 + IF (ICZERO) 10170, 0181, 20170 05820311 +10170 IVPASS = IVPASS + 1 05830311 + WRITE (I02,80002) IVTNUM 05840311 + GO TO 0181 05850311 +20170 IVFAIL = IVFAIL + 1 05860311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05870311 + 0181 CONTINUE 05880311 +C 05890311 +C TEST 018 THROUGH TEST 020 APPLY TO THE DEFINITION OF THE 05900311 +C STATEMENT FUNCTION DUMMY ARGUMENTS. 05910311 +C 05920311 +C 05930311 +C **** FCVS PROGRAM 311 - TEST 018 **** 05940311 +C 05950311 +C DEFINE STATEMENT FUNCTION WITH NO DUMMY ARGUMENTS. 05960311 +C 05970311 + IVTNUM = 18 05980311 + IF (ICZERO) 30180, 0180, 30180 05990311 + 0180 CONTINUE 06000311 + IVCOMP = 0 06010311 + IVON02 = 4 06020311 + IVCOMP = IFOS10() 06030311 + IVCORR = 4 06040311 +40180 IF (IVCOMP - 4) 20180, 10180, 20180 06050311 +30180 IVDELE = IVDELE + 1 06060311 + WRITE (I02,80000) IVTNUM 06070311 + IF (ICZERO) 10180, 0191, 20180 06080311 +10180 IVPASS = IVPASS + 1 06090311 + WRITE (I02,80002) IVTNUM 06100311 + GO TO 0191 06110311 +20180 IVFAIL = IVFAIL + 1 06120311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06130311 + 0191 CONTINUE 06140311 +C 06150311 +C **** FCVS PROGRAM 311 - TEST 019 **** 06160311 +C 06170311 +C DEFINE STATEMENT FUNCTION WITH THREE DUMMY ARGUMENTS. 06180311 +C 06190311 + IVTNUM = 19 06200311 + IF (ICZERO) 30190, 0190, 30190 06210311 + 0190 CONTINUE 06220311 + IVCOMP = 0 06230311 + IVCOMP = IFOS11(1,2,3) 06240311 + IVCORR = 6 06250311 +40190 IF (IVCOMP - 6) 20190, 10190, 20190 06260311 +30190 IVDELE = IVDELE + 1 06270311 + WRITE (I02,80000) IVTNUM 06280311 + IF (ICZERO) 10190, 0201, 20190 06290311 +10190 IVPASS = IVPASS + 1 06300311 + WRITE (I02,80002) IVTNUM 06310311 + GO TO 0201 06320311 +20190 IVFAIL = IVFAIL + 1 06330311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06340311 + 0201 CONTINUE 06350311 +C 06360311 +C **** FCVS PROGRAM 311 - TEST 020 **** 06370311 +C 06380311 +C USE THE SAME DUMMY ARGUMENT NAME IN TWO DIFFERENT 06390311 +C STATEMENT FUNCTIONS. 06400311 +C 06410311 + IVTNUM = 20 06420311 + IF (ICZERO) 30200, 0200, 30200 06430311 + 0200 CONTINUE 06440311 + IVCOMP = 1 06450311 + IF (IFOS12(3) .EQ. 4) IVCOMP = IVCOMP * 2 06460311 + IF (IFOS13(4) .EQ. 6) IVCOMP = IVCOMP * 3 06470311 + IVCORR = 6 06480311 +C 6 = 2 * 3 06490311 +40200 IF (IVCOMP - 6) 20200, 10200, 20200 06500311 +30200 IVDELE = IVDELE + 1 06510311 + WRITE (I02,80000) IVTNUM 06520311 + IF (ICZERO) 10200, 0211, 20200 06530311 +10200 IVPASS = IVPASS + 1 06540311 + WRITE (I02,80002) IVTNUM 06550311 + GO TO 0211 06560311 +20200 IVFAIL = IVFAIL + 1 06570311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06580311 + 0211 CONTINUE 06590311 +C 06600311 +C TEST 021 THROUGH TEST 022 TEST THE USAGE OF DIFFERENT TYPES OF 06610311 +C ACTUAL ARGUMENTS IN A STATEMENT FUNCTION REFERENCE. 06620311 +C 06630311 +C 06640311 +C **** FCVS PROGRAM 311 - TEST 021 **** 06650311 +C 06660311 +C USE AN EXPRESSION WITH OPERATORS AS AN ACTUAL ARGUMENT. 06670311 +C 06680311 + IVTNUM = 21 06690311 + IF (ICZERO) 30210, 0210, 30210 06700311 + 0210 CONTINUE 06710311 + IVCOMP = 0 06720311 + IVON03 = 4 06730311 + IVCOMP = IFOS14(IVON03 * 4 + 1) 06740311 + IVCORR = 18 06750311 +40210 IF (IVCOMP - 18) 20210, 10210, 20210 06760311 +30210 IVDELE = IVDELE + 1 06770311 + WRITE (I02,80000) IVTNUM 06780311 + IF (ICZERO) 10210, 0221, 20210 06790311 +10210 IVPASS = IVPASS + 1 06800311 + WRITE (I02,80002) IVTNUM 06810311 + GO TO 0221 06820311 +20210 IVFAIL = IVFAIL + 1 06830311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06840311 + 0221 CONTINUE 06850311 +C 06860311 +C **** FCVS PROGRAM 311 - TEST 022 **** 06870311 +C 06880311 +C USE AN INTRINSIC FUNCTION REFERENCE AS AN ACTUAL ARGUMENT. 06890311 +C 06900311 + IVTNUM = 22 06910311 + IF (ICZERO) 30220, 0220, 30220 06920311 + 0220 CONTINUE 06930311 + IVCOMP = 0 06940311 + RVON01 = 1.75 06950311 + IVCOMP = IFOS14(NINT(RVON01)) 06960311 + IVCORR = 3 06970311 +40220 IF (IVCOMP - 3) 20220, 10220, 20220 06980311 +30220 IVDELE = IVDELE + 1 06990311 + WRITE (I02,80000) IVTNUM 07000311 + IF (ICZERO) 10220, 0231, 20220 07010311 +10220 IVPASS = IVPASS + 1 07020311 + WRITE (I02,80002) IVTNUM 07030311 + GO TO 0231 07040311 +20220 IVFAIL = IVFAIL + 1 07050311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07060311 + 0231 CONTINUE 07070311 +C 07080311 +C **** FCVS PROGRAM 311 - TEST 023 **** 07090311 +C 07100311 +C USE AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL ARGUMENT. 07110311 +C 07120311 + IVTNUM = 23 07130311 + IF (ICZERO) 30230, 0230, 30230 07140311 + 0230 CONTINUE 07150311 + IVCOMP = 0 07160311 + IVCOMP = IFOS14(FF312(5)) 07170311 + IVCORR = 7 07180311 +40230 IF (IVCOMP - 7) 20230, 10230, 20230 07190311 +30230 IVDELE = IVDELE + 1 07200311 + WRITE (I02,80000) IVTNUM 07210311 + IF (ICZERO) 10230, 0241, 20230 07220311 +10230 IVPASS = IVPASS + 1 07230311 + WRITE (I02,80002) IVTNUM 07240311 + GO TO 0241 07250311 +20230 IVFAIL = IVFAIL + 1 07260311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07270311 + 0241 CONTINUE 07280311 +C 07290311 +C TEST 024 THROUGH TEST 029 APPLY TO THE TYPING OF STATEMENT 07300311 +C FUNCTIONS AND THE ASSOCIATED DUMMY ARGUMENT NAMES. 07310311 +C 07320311 +C 07330311 +C **** FCVS PROGRAM 311 - TEST 024 **** 07340311 +C 07350311 +C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION WITH 07360311 +C THE IMPLICIT STATEMENT TYPING OF REAL. 07370311 +C 07380311 + IVTNUM = 24 07390311 + IF (ICZERO) 30240, 0240, 30240 07400311 + 0240 CONTINUE 07410311 + RVCOMP = 10.0 07420311 + RVCOMP = KFOS01(3) / 5 07430311 + RVCORR = 0.8 07440311 +40240 IF (RVCOMP - .79995) 20240, 10240, 40241 07450311 +40241 IF (RVCOMP - .80005) 10240, 10240, 20240 07460311 +30240 IVDELE = IVDELE + 1 07470311 + WRITE (I02,80000) IVTNUM 07480311 + IF (ICZERO) 10240, 0251, 20240 07490311 +10240 IVPASS = IVPASS + 1 07500311 + WRITE (I02,80002) IVTNUM 07510311 + GO TO 0251 07520311 +20240 IVFAIL = IVFAIL + 1 07530311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07540311 + 0251 CONTINUE 07550311 +C 07560311 +C **** FCVS PROGRAM 311 - TEST 025 **** 07570311 +C 07580311 +C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION WITH 07590311 +C THE IMPLICIT STATEMENT TYPING OF INTEGER. 07600311 +C 07610311 + IVTNUM = 25 07620311 + IF (ICZERO) 30250, 0250, 30250 07630311 + 0250 CONTINUE 07640311 + RVCOMP = 10.0 07650311 + RVCOMP = AFOS01(3.0) / 5 07660311 + RVCORR = 0.0 07670311 +40250 IF (RVCOMP + .00005) 20250, 10250, 40251 07680311 +40251 IF (RVCOMP - .00005) 10250, 10250, 20250 07690311 +30250 IVDELE = IVDELE + 1 07700311 + WRITE (I02,80000) IVTNUM 07710311 + IF (ICZERO) 10250, 0261, 20250 07720311 +10250 IVPASS = IVPASS + 1 07730311 + WRITE (I02,80002) IVTNUM 07740311 + GO TO 0261 07750311 +20250 IVFAIL = IVFAIL + 1 07760311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07770311 + 0261 CONTINUE 07780311 +C 07790311 +C **** FCVS PROGRAM 311 - TEST 026 **** 07800311 +C 07810311 +C OVERRIDE THE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION 07820311 +C DUMMY ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF REAL. 07830311 +C 07840311 + IVTNUM = 26 07850311 + IF (ICZERO) 30260, 0260, 30260 07860311 + 0260 CONTINUE 07870311 + RVCOMP = 10.0 07880311 + RVCOMP = RFOS08(4.0) 07890311 + RVCORR = 0.8 07900311 +40260 IF (RVCOMP - .79995) 20260, 10260, 40261 07910311 +40261 IF (RVCOMP - .80005) 10260, 10260, 20260 07920311 +30260 IVDELE = IVDELE + 1 07930311 + WRITE (I02,80000) IVTNUM 07940311 + IF (ICZERO) 10260, 0271, 20260 07950311 +10260 IVPASS = IVPASS + 1 07960311 + WRITE (I02,80002) IVTNUM 07970311 + GO TO 0271 07980311 +20260 IVFAIL = IVFAIL + 1 07990311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08000311 + 0271 CONTINUE 08010311 +C 08020311 +C **** FCVS PROGRAM 311 - TEST 027 **** 08030311 +C 08040311 +C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08050311 +C ARGUMENT WITH THE IMPLICIT STATEMENT TYPING OF INTEGER. 08060311 +C 08070311 + IVTNUM = 27 08080311 + IF (ICZERO) 30270, 0270, 30270 08090311 + 0270 CONTINUE 08100311 + RVCOMP = 10.0 08110311 + RVCOMP = RFOS09(4) 08120311 + RVCORR = 0.0 08130311 +40270 IF (RVCOMP + .00005) 20270, 10270, 40271 08140311 +40271 IF (RVCOMP - .00005) 10270, 10270, 20270 08150311 +30270 IVDELE = IVDELE + 1 08160311 + WRITE (I02,80000) IVTNUM 08170311 + IF (ICZERO) 10270, 0281, 20270 08180311 +10270 IVPASS = IVPASS + 1 08190311 + WRITE (I02,80002) IVTNUM 08200311 + GO TO 0281 08210311 +20270 IVFAIL = IVFAIL + 1 08220311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08230311 + 0281 CONTINUE 08240311 +C 08250311 +C **** FCVS PROGRAM 311 - TEST 028 **** 08260311 +C 08270311 +C OVERRIDE INTEGER DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08280311 +C ARGUMENT WITH TYPE-STATEMENT TYPING OF REAL. 08290311 +C 08300311 + IVTNUM = 28 08310311 + IF (ICZERO) 30280, 0280, 30280 08320311 + 0280 CONTINUE 08330311 + RVCOMP = 10.0 08340311 + RVCOMP = RFOS10(4.0) 08350311 + RVCORR = 0.8 08360311 +40280 IF (RVCOMP - .79995) 20280, 10280, 40281 08370311 +40281 IF (RVCOMP - .80005) 10280, 10280, 20280 08380311 +30280 IVDELE = IVDELE + 1 08390311 + WRITE (I02,80000) IVTNUM 08400311 + IF (ICZERO) 10280, 0291, 20280 08410311 +10280 IVPASS = IVPASS + 1 08420311 + WRITE (I02,80002) IVTNUM 08430311 + GO TO 0291 08440311 +20280 IVFAIL = IVFAIL + 1 08450311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08460311 + 0291 CONTINUE 08470311 +C 08480311 +C **** FCVS PROGRAM 311 - TEST 029 **** 08490311 +C 08500311 +C OVERRIDE THE REAL DEFAULT TYPING OF A STATEMENT FUNCTION DUMMY 08510311 +C ARGUMENT WITH TYPE-STATEMENT TYPING OF INTEGER. 08520311 +C 08530311 + IVTNUM = 29 08540311 + IF (ICZERO) 30290, 0290, 30290 08550311 + 0290 CONTINUE 08560311 + RVCOMP = 10.0 08570311 + RVCOMP = RFOS11(4) 08580311 + RVCORR = 0.0 08590311 +40290 IF (RVCOMP + .00005) 20290, 10290, 40291 08600311 +40291 IF (RVCOMP - .00005) 10290, 10290, 20290 08610311 +30290 IVDELE = IVDELE + 1 08620311 + WRITE (I02,80000) IVTNUM 08630311 + IF (ICZERO) 10290, 0301, 20290 08640311 +10290 IVPASS = IVPASS + 1 08650311 + WRITE (I02,80002) IVTNUM 08660311 + GO TO 0301 08670311 +20290 IVFAIL = IVFAIL + 1 08680311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08690311 + 0301 CONTINUE 08700311 +C 08710311 +C **** FCVS PROGRAM 311 - TEST 030 **** 08720311 +C 08730311 +C TEST 030 TESTS A STATEMENT FUNCTION WHERE THE DUMMY ARGUMENT 08740311 +C NAME IS IDENTICAL TO A VARIABLE NAME WITHIN THE PROGRAM. 08750311 +C 08760311 + IVTNUM = 30 08770311 + IF (ICZERO) 30300, 0300, 30300 08780311 + 0300 CONTINUE 08790311 + IVON04 = 10 08800311 + IVCOMP = 1 08810311 + IF (IFOS15(3) .EQ. 4) IVCOMP = IVCOMP * 2 08820311 + IF (IVON04 .EQ. 10) IVCOMP = IVCOMP * 3 08830311 + IVCORR = 6 08840311 +C 6 = 2 * 3 08850311 +40300 IF (IVCOMP - 6) 20300, 10300, 20300 08860311 +30300 IVDELE = IVDELE + 1 08870311 + WRITE (I02,80000) IVTNUM 08880311 + IF (ICZERO) 10300, 0311, 20300 08890311 +10300 IVPASS = IVPASS + 1 08900311 + WRITE (I02,80002) IVTNUM 08910311 + GO TO 0311 08920311 +20300 IVFAIL = IVFAIL + 1 08930311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08940311 + 0311 CONTINUE 08950311 +C 08960311 +C **** FCVS PROGRAM 311 - TEST 031 **** 08970311 +C 08980311 +C TEST 031 TESTS THE ASSIGNMENT OF A STATEMENT FUNCTION TO AN 08990311 +C ARRAY ELEMENT. 09000311 +C 09010311 + IVTNUM = 31 09020311 + IF (ICZERO) 30310, 0310, 30310 09030311 + 0310 CONTINUE 09040311 + IVCOMP = 0 09050311 + IADN12(3) = IFOS16(4) 09060311 + IVCOMP = IADN12(3) 09070311 + IVCORR = 5 09080311 +40310 IF (IVCOMP - 5) 20310, 10310, 20310 09090311 +30310 IVDELE = IVDELE + 1 09100311 + WRITE (I02,80000) IVTNUM 09110311 + IF (ICZERO) 10310, 0321, 20310 09120311 +10310 IVPASS = IVPASS + 1 09130311 + WRITE (I02,80002) IVTNUM 09140311 + GO TO 0321 09150311 +20310 IVFAIL = IVFAIL + 1 09160311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09170311 + 0321 CONTINUE 09180311 +C 09190311 +C **** FCVS PROGRAM 311 - TEST 032 **** 09200311 +C 09210311 +C TEST 032 TESTS THE USE OF A STATEMENT FUNCTION REFERENCE 09220311 +C IN AN ARITHMETIC EXPRESSION. 09230311 +C 09240311 + IVTNUM = 32 09250311 + IF (ICZERO) 30320, 0320, 30320 09260311 + 0320 CONTINUE 09270311 + IVCOMP = 0 09280311 + IVON05 = 12 09290311 + IVCOMP = IVON05 + IFOS17(4) * 2 - 3 09300311 + IVCORR = 19 09310311 +40320 IF (IVCOMP - 19) 20320, 10320, 20320 09320311 +30320 IVDELE = IVDELE + 1 09330311 + WRITE (I02,80000) IVTNUM 09340311 + IF (ICZERO) 10320, 0331, 20320 09350311 +10320 IVPASS = IVPASS + 1 09360311 + WRITE (I02,80002) IVTNUM 09370311 + GO TO 0331 09380311 +20320 IVFAIL = IVFAIL + 1 09390311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09400311 + 0331 CONTINUE 09410311 +C 09420311 +C **** FCVS PROGRAM 311 - TEST 033 **** 09430311 +C 09440311 +C TEST 033 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND 09450311 +C REFERENCE WITHIN AN EXTERNAL FUNCTION. 09460311 +C 09470311 + IVTNUM = 33 09480311 + IF (ICZERO) 30330, 0330, 30330 09490311 + 0330 CONTINUE 09500311 + RVCOMP = 0.0 09510311 + RVCOMP = FF313(1.3) 09520311 + RVCORR = 5.8 09530311 +40330 IF (RVCOMP - 5.7995) 20330, 10330, 40331 09540311 +40331 IF (RVCOMP - 5.8005) 10330, 10330, 20330 09550311 +30330 IVDELE = IVDELE + 1 09560311 + WRITE (I02,80000) IVTNUM 09570311 + IF (ICZERO) 10330, 0341, 20330 09580311 +10330 IVPASS = IVPASS + 1 09590311 + WRITE (I02,80002) IVTNUM 09600311 + GO TO 0341 09610311 +20330 IVFAIL = IVFAIL + 1 09620311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09630311 + 0341 CONTINUE 09640311 +C 09650311 +C **** FCVS PROGRAM 311 - TEST 034 **** 09660311 +C 09670311 +C TEST 034 TESTS THE USE OF A STATEMENT FUNCTION DEFINITION AND 09680311 +C REFERENCE WITHIN A SUBROUTINE. 09690311 +C 09700311 + IVTNUM = 34 09710311 + IF (ICZERO) 30340, 0340, 30340 09720311 + 0340 CONTINUE 09730311 + RVCOMP = 0.0 09740311 + RVON05 = 10.0 09750311 + CALL FS316(RVON05) 09760311 + RVCOMP = RVON05 09770311 + RVCORR = 5.5 09780311 +40340 IF (RVCOMP - 5.4995) 20340, 10340, 40341 09790311 +40341 IF (RVCOMP - 5.5005) 10340, 10340, 20340 09800311 +30340 IVDELE = IVDELE + 1 09810311 + WRITE (I02,80000) IVTNUM 09820311 + IF (ICZERO) 10340, 0351, 20340 09830311 +10340 IVPASS = IVPASS + 1 09840311 + WRITE (I02,80002) IVTNUM 09850311 + GO TO 0351 09860311 +20340 IVFAIL = IVFAIL + 1 09870311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09880311 + 0351 CONTINUE 09890311 +C 09900311 +C **** FCVS PROGRAM 311 - TEST 035 **** 09910311 +C 09920311 +C TEST 035 REFERENCES THE DUMMY ARGUMENT NAME OF AN EXTERNAL 09930311 +C FUNCTION WITHIN THE EXPRESSION OF A STATEMENT FUNCTION DEFINED 09940311 +C IN THAT EXTERNAL FUNCTION. 09950311 +C 09960311 + IVTNUM = 35 09970311 + IF (ICZERO) 30350, 0350, 30350 09980311 + 0350 CONTINUE 09990311 + IVCOMP = 0 10000311 + IVCOMP = FF314(4) 10010311 + IVCORR = 7 10020311 +40350 IF (IVCOMP - 7) 20350, 10350, 20350 10030311 +30350 IVDELE = IVDELE + 1 10040311 + WRITE (I02,80000) IVTNUM 10050311 + IF (ICZERO) 10350, 0361, 20350 10060311 +10350 IVPASS = IVPASS + 1 10070311 + WRITE (I02,80002) IVTNUM 10080311 + GO TO 0361 10090311 +20350 IVFAIL = IVFAIL + 1 10100311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10110311 + 0361 CONTINUE 10120311 +C 10130311 +C **** FCVS PROGRAM 311 - TEST 036 **** 10140311 +C 10150311 +C TEST 036 TESTS A STATEMENT FUNCTION DEFINED WITHIN AN EXTERNAL 10160311 +C FUNCTION IN WHICH THE STATEMENT FUNCTION DUMMY ARGUMENT NAME IS 10170311 +C IDENTICAL TO THE EXTERNAL FUNCTION DUMMY ARGUMENT NAME. 10180311 +C 10190311 + IVTNUM = 36 10200311 + IF (ICZERO) 30360, 0360, 30360 10210311 + 0360 CONTINUE 10220311 + RVCOMP = 0.0 10230311 + RVCOMP = FF315(5.5) 10240311 + RVCORR = 16.7 10250311 +40360 IF (RVCOMP - 16.695) 20360, 10360, 40361 10260311 +40361 IF (RVCOMP - 16.705) 10360, 10360, 20360 10270311 +30360 IVDELE = IVDELE + 1 10280311 + WRITE (I02,80000) IVTNUM 10290311 + IF (ICZERO) 10360, 0371, 20360 10300311 +10360 IVPASS = IVPASS + 1 10310311 + WRITE (I02,80002) IVTNUM 10320311 + GO TO 0371 10330311 +20360 IVFAIL = IVFAIL + 1 10340311 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 10350311 + 0371 CONTINUE 10360311 +C 10370311 +C **** FCVS PROGRAM 311 - TEST 037 **** 10380311 +C 10390311 +C TEST 037 TESTS THE USAGE OF THE NAME OF A COMMON BLOCK AS THE 10400311 +C SYMBOLIC NAME OF A STATEMENT FUNCTION. 10410311 +C 10420311 + IVTNUM = 37 10430311 + IF (ICZERO) 30370, 0370, 30370 10440311 + 0370 CONTINUE 10450311 + IVCOMP = 0 10460311 + IVCOMP = IFOS19(4) 10470311 + IVCORR = 5 10480311 +40370 IF (IVCOMP - 5) 20370, 10370, 20370 10490311 +30370 IVDELE = IVDELE + 1 10500311 + WRITE (I02,80000) IVTNUM 10510311 + IF (ICZERO) 10370, 0381, 20370 10520311 +10370 IVPASS = IVPASS + 1 10530311 + WRITE (I02,80002) IVTNUM 10540311 + GO TO 0381 10550311 +20370 IVFAIL = IVFAIL + 1 10560311 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10570311 + 0381 CONTINUE 10580311 +C 10590311 +C 10600311 +C WRITE OUT TEST SUMMARY 10610311 +C 10620311 + WRITE (I02,90004) 10630311 + WRITE (I02,90014) 10640311 + WRITE (I02,90004) 10650311 + WRITE (I02,90000) 10660311 + WRITE (I02,90004) 10670311 + WRITE (I02,90020) IVFAIL 10680311 + WRITE (I02,90022) IVPASS 10690311 + WRITE (I02,90024) IVDELE 10700311 + STOP 10710311 +90001 FORMAT (" ",24X,"FM311") 10720311 +90000 FORMAT (" ",20X,"END OF PROGRAM FM311" ) 10730311 +C 10740311 +C FORMATS FOR TEST DETAIL LINES 10750311 +C 10760311 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 10770311 +80002 FORMAT (" ",4X,I5,7X,"PASS") 10780311 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 10790311 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 10800311 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 10810311 +C 10820311 +C FORMAT STATEMENTS FOR PAGE HEADERS 10830311 +C 10840311 +90002 FORMAT ("1") 10850311 +90004 FORMAT (" ") 10860311 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 10870311 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 10880311 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 10890311 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 10900311 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 10910311 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 10920311 +C 10930311 +C FORMAT STATEMENTS FOR RUN SUMMARY 10940311 +C 10950311 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 10960311 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 10970311 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 10980311 + END 10990311 + + INTEGER FUNCTION FF312(IDONX1) 00010312 +C THIS SUBPROGRAM IS USED BY TESTS 014 AND 023 OF THE MAIN PROGRAM 00020312 +C FM311 TO TEST STATEMENT FUNCTION. IN TEST 014 REFERENCE TO FF312 00030312 +C IS USED IN THE EXPRESSION OF A STATEMENT FUNCTION. IN TEST 023 00040312 +C REFERENCE TO FF312 IS USED AS AN ACTUAL ARGUMENT IN A STATEMENT 00050312 +C FUNCTION REFERENCE. THIS ROUTINE MERELY INCREMENTS THE VALUE OF 00060312 +C ACTUAL/DUMMY ARGUMENT BY ONE AND RETURN THE RESULT AS THE 00070312 +C FUNCTION VALUE. 00080312 + IDONX2 = IDONX1 + 1 00090312 + FF312 = IDONX2 00100312 + RETURN 00110312 + END 00120312 + + REAL FUNCTION FF313(RDON08) 00010313 +C THIS SUBPROGRAM IS USED BY TEST 033 OF THE MAIN PROGRAM FM311 TO 00020313 +C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030313 +C AN EXTERNAL FUNCTION. 00040313 + RFOS12(RDON09) = RDON09 + 1.0 00050313 + RVON04 = RFOS12(3.5) 00060313 + FF313 = RDON08 + RVON04 00070313 + RETURN 00080313 + END 00090313 + + INTEGER FUNCTION FF314(IDON19) 00010314 +C THIS SUBPROGRAM IS USED BY TEST 035 OF THE MAIN PROGRAM FM311 TO 00020314 +C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030314 +C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION DUMMY 00040314 +C ARGUMENT IS REFERENCED WITHIN THE EXPRESSION OF THE STATEMENT 00050314 +C FUNCTION. 00060314 + IFOS18(IDON20) = IDON19 + IDON20 00070314 + FF314 = IFOS18(3) 00080314 + RETURN 00090314 + END 00100314 + + REAL FUNCTION FF315(RDON12) 00010315 +C THIS SUBPROGRAM IS USED BY TEST 036 OF THE MAIN PROGRAM FM311 TO 00020315 +C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030315 +C AN EXTERNAL FUNCTION. IN THIS TEST THE EXTERNAL FUNCTION AND 00040315 +C STATEMENT FUNCTION DUMMY ARGUMENTS NAMES ARE IDENTICAL. 00050315 + RFOS14(RDON12) = RDON12 + 1.0 00060315 + RVON06 = 10.2 00070315 + RVON07 = RFOS14(RVON06) 00080315 + FF315 = RDON12 + RVON07 00090315 + RETURN 00100315 + END 00110315 + + SUBROUTINE FS316(RDON10) 00010316 +C THIS SUBPROGRAM IS USED BY TEST 034 OF THE MAIN PROGRAM FM311 TO 00020316 +C TEST THE DEFINITION AND REFERENCE OF A STATEMENT FUNCTION WITHIN 00030316 +C A SUBROUTINE. 00040316 + RFOS13(RDON11) = RDON11 + 1.0 00050316 + RDON10 = RFOS13(3.5) + 1.0 00060316 + RETURN 00070316 + END 00080316 diff --git a/Fortran/UnitTests/fcvs21_f95/FM311.reference_output b/Fortran/UnitTests/fcvs21_f95/FM311.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM311.reference_output @@ -0,0 +1,58 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM311 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + 36 PASS + 37 PASS + + ---------------------------------------------- + + END OF PROGRAM FM311 + + 0 TESTS FAILED + 37 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM317.f b/Fortran/UnitTests/fcvs21_f95/FM317.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM317.f @@ -0,0 +1,1075 @@ + PROGRAM FM317 00010317 +C 00020317 +C 00030317 +C THIS ROUTINE TESTS SUBSET LEVEL FEATURES OF EXTERNAL 00040317 +C FUNCTION SUBPROGRAMS. TESTS ARE DESIGNED TO CHECK THE 00050317 +C ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH 00060317 +C VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS. THESE 00070317 +C INCLUDE, 00080317 +C 00090317 +C 1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY 00100317 +C ARGUMENT INCLUDE, 00110317 +C 00120317 +C A) CONSTANT 00130317 +C B) VARIABLE NAME 00140317 +C C) ARRAY ELEMENT NAME 00150317 +C D) EXPRESSION INVOLVING OPERATORS 00160317 +C E) EXPRESSION ENCLOSED IN PARENTHESES 00170317 +C F) INTRINSIC FUNCTION REFERENCE 00180317 +C G) EXTERNAL FUNCTION REFERENCE 00190317 +C H) STATEMENT FUNCTION REFERENCE 00200317 +C I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME 00210317 +C 00220317 +C 2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY 00230317 +C ARGUMENT INCLUDE, 00240317 +C 00250317 +C A) ARRAY NAME 00260317 +C B) ARRAY ELEMENT NAME 00270317 +C 00280317 +C 3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY 00290317 +C ARGUMENT INCLUDE, 00300317 +C 00310317 +C A) EXTERNAL FUNCTION NAME 00320317 +C B) INTRINSIC FUNCTION NAME 00330317 +C C) SUBROUTINE NAME 00340317 +C 00350317 +C SUBSET LEVEL ROUTINES FM028,FM050 AND FM080 ALSO TEST THE USE OF 00360317 +C EXTERNAL FUNCTIONS. 00370317 +C 00380317 +C REFERENCES. 00390317 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00400317 +C X3.9-1978 00410317 +C 00420317 +C SECTION 2.8, DUMMY ARGUMENTS 00430317 +C SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR 00440317 +C SECTION 5.5, DUMMY AND ACTUAL ARRAYS 00450317 +C SECTION 8.1, DIMENSION STATEMENT 00460317 +C SECTION 8.3, COMMON STATEMENT 00470317 +C SECTION 8.4, TYPE-STATEMENT 00480317 +C SECTION 8.7, EXTERNAL STATEMENT 00490317 +C SECTION 8.8, INTRINSIC STATEMENT 00500317 +C SECTION 15.2, REFERENCING A FUNCTION 00510317 +C SECTION 15.3, INTRINSIC FUNCTIONS 00520317 +C SECTION 15.5, EXTERNAL FUNCTIONS 00530317 +C SECTION 15.6, SUBROUTINES 00540317 +C SECTION 15.9, ARGUMENTS AND COMMON BLOCKS 00550317 +C 00560317 +C 00570317 +C ******************************************************************00580317 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00590317 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00600317 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00610317 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00620317 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00630317 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00640317 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00650317 +C THE RESULT OF EXECUTING THESE TESTS. 00660317 +C 00670317 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00680317 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00690317 +C 00700317 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00710317 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00720317 +C SOFTWARE STANDARDS VALIDATION GROUP 00730317 +C BUILDING 225 RM A266 00740317 +C GAITHERSBURG, MD 20899 00750317 +C ******************************************************************00760317 +C 00770317 +C 00780317 + IMPLICIT LOGICAL (L) 00790317 + IMPLICIT CHARACTER*14 (C) 00800317 +C 00810317 + INTEGER FF318, FF321, FF322, FF324, FF325 00820317 + LOGICAL FF320 00830317 + INTRINSIC ABS, IABS, NINT 00840317 + EXTERNAL FF318, FF321, FF325, FS327 00850317 + DIMENSION IADN11(4), IADN12(4) 00860317 + DIMENSION RADN11(4), RADN12(4) 00870317 + DIMENSION LADN11(4) 00880317 + COMMON IACN11(6), RACN11(10) 00890317 + INTEGER IATN11(2,3) 00900317 + REAL RATN11(3,4) 00910317 + IFOS01(IDON04) = IDON04 + 1 00920317 +C 00930317 +C 00940317 +C 00950317 +C INITIALIZATION SECTION. 00960317 +C 00970317 +C INITIALIZE CONSTANTS 00980317 +C ******************** 00990317 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01000317 + I01 = 5 01010317 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01020317 + I02 = 6 01030317 +C SYSTEM ENVIRONMENT SECTION 01040317 +C 01050317 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01060317 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01070317 +C (UNIT NUMBER FOR CARD READER). 01080317 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01090317 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01100317 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01110317 +C 01120317 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01130317 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01140317 +C (UNIT NUMBER FOR PRINTER). 01150317 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01160317 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01170317 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01180317 +C 01190317 + IVPASS = 0 01200317 + IVFAIL = 0 01210317 + IVDELE = 0 01220317 + ICZERO = 0 01230317 +C 01240317 +C WRITE OUT PAGE HEADERS 01250317 +C 01260317 + WRITE (I02,90002) 01270317 + WRITE (I02,90006) 01280317 + WRITE (I02,90008) 01290317 + WRITE (I02,90004) 01300317 + WRITE (I02,90010) 01310317 + WRITE (I02,90004) 01320317 + WRITE (I02,90016) 01330317 + WRITE (I02,90001) 01340317 + WRITE (I02,90004) 01350317 + WRITE (I02,90012) 01360317 + WRITE (I02,90014) 01370317 + WRITE (I02,90004) 01380317 +C 01390317 +C 01400317 +C TEST 001 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 01410317 +C OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS EXTERNAL FUNCTION 01420317 +C DUMMY ARGUMENTS. INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE 01430317 +C TESTED. 01440317 +C 01450317 +C 01460317 +C **** FCVS PROGRAM 317 - TEST 001 **** 01470317 +C 01480317 +C INTEGER CONSTANT AS ACTUAL ARGUMENT 01490317 +C 01500317 + IVTNUM = 1 01510317 + IF (ICZERO) 30010, 0010, 30010 01520317 + 0010 CONTINUE 01530317 + IVCOMP = 0 01540317 + IVCOMP = FF318(3) 01550317 + IVCORR = 4 01560317 +40010 IF (IVCOMP - 4) 20010, 10010, 20010 01570317 +30010 IVDELE = IVDELE + 1 01580317 + WRITE (I02,80000) IVTNUM 01590317 + IF (ICZERO) 10010, 0021, 20010 01600317 +10010 IVPASS = IVPASS + 1 01610317 + WRITE (I02,80002) IVTNUM 01620317 + GO TO 0021 01630317 +20010 IVFAIL = IVFAIL + 1 01640317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01650317 + 0021 CONTINUE 01660317 +C 01670317 +C **** FCVS PROGRAM 317 - TEST 002 **** 01680317 +C 01690317 +C REAL CONSTANT AS ACTUAL ARGUMENT 01700317 +C 01710317 + IVTNUM = 2 01720317 + IF (ICZERO) 30020, 0020, 30020 01730317 + 0020 CONTINUE 01740317 + RVCOMP = 0.0 01750317 + RVCOMP = FF319(3.0) 01760317 + RVCORR = 4.0 01770317 +40020 IF (RVCOMP - 3.9995) 20020, 10020, 40021 01780317 +40021 IF (RVCOMP - 4.0005) 10020, 10020, 20020 01790317 +30020 IVDELE = IVDELE + 1 01800317 + WRITE (I02,80000) IVTNUM 01810317 + IF (ICZERO) 10020, 0031, 20020 01820317 +10020 IVPASS = IVPASS + 1 01830317 + WRITE (I02,80002) IVTNUM 01840317 + GO TO 0031 01850317 +20020 IVFAIL = IVFAIL + 1 01860317 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 01870317 + 0031 CONTINUE 01880317 +C 01890317 +C **** FCVS PROGRAM 317 - TEST 003 **** 01900317 +C 01910317 +C LOGICAL CONSTANT AS ACTUAL ARGUMENT 01920317 +C 01930317 + IVTNUM = 3 01940317 + IF (ICZERO) 30030, 0030, 30030 01950317 + 0030 CONTINUE 01960317 + IVCOMP = 0 01970317 + IF (FF320(.FALSE.)) IVCOMP = 1 01980317 + IVCORR = 1 01990317 +40030 IF (IVCOMP - 1) 20030, 10030, 20030 02000317 +30030 IVDELE = IVDELE + 1 02010317 + WRITE (I02,80000) IVTNUM 02020317 + IF (ICZERO) 10030, 0041, 20030 02030317 +10030 IVPASS = IVPASS + 1 02040317 + WRITE (I02,80002) IVTNUM 02050317 + GO TO 0041 02060317 +20030 IVFAIL = IVFAIL + 1 02070317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02080317 + 0041 CONTINUE 02090317 +C 02100317 +C **** FCVS PROGRAM 317 - TEST 004 **** 02110317 +C 02120317 +C INTEGER VARIABLE AS ACTUAL ARGUMENT 02130317 +C 02140317 + IVTNUM = 4 02150317 + IF (ICZERO) 30040, 0040, 30040 02160317 + 0040 CONTINUE 02170317 + IVCOMP = 0 02180317 + IVON01 = 7 02190317 + IVCOMP = FF318(IVON01) 02200317 + IVCORR = 8 02210317 +40040 IF (IVCOMP - 8) 20040, 10040, 20040 02220317 +30040 IVDELE = IVDELE + 1 02230317 + WRITE (I02,80000) IVTNUM 02240317 + IF (ICZERO) 10040, 0051, 20040 02250317 +10040 IVPASS = IVPASS + 1 02260317 + WRITE (I02,80002) IVTNUM 02270317 + GO TO 0051 02280317 +20040 IVFAIL = IVFAIL + 1 02290317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02300317 + 0051 CONTINUE 02310317 +C 02320317 +C **** FCVS PROGRAM 317 - TEST 005 **** 02330317 +C 02340317 +C REAL VARIABLE AS ACTUAL ARGUMENT 02350317 +C 02360317 + IVTNUM = 5 02370317 + IF (ICZERO) 30050, 0050, 30050 02380317 + 0050 CONTINUE 02390317 + RVCOMP = 0.0 02400317 + RVON01 = 7.0 02410317 + RVCOMP = FF319(RVON01) 02420317 + RVCORR = 8.0 02430317 +40050 IF (RVCOMP - 7.9995) 20050, 10050, 40051 02440317 +40051 IF (RVCOMP - 8.0005) 10050, 10050, 20050 02450317 +30050 IVDELE = IVDELE + 1 02460317 + WRITE (I02,80000) IVTNUM 02470317 + IF (ICZERO) 10050, 0061, 20050 02480317 +10050 IVPASS = IVPASS + 1 02490317 + WRITE (I02,80002) IVTNUM 02500317 + GO TO 0061 02510317 +20050 IVFAIL = IVFAIL + 1 02520317 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02530317 + 0061 CONTINUE 02540317 +C 02550317 +C **** FCVS PROGRAM 317 - TEST 006 **** 02560317 +C 02570317 +C LOGICAL VARIABLE AS ACTUAL ARGUMENT 02580317 +C 02590317 + IVTNUM = 6 02600317 + IF (ICZERO) 30060, 0060, 30060 02610317 + 0060 CONTINUE 02620317 + LVON01 = .TRUE. 02630317 + IVCOMP = 0 02640317 + IF (.NOT. FF320(LVON01)) IVCOMP = 1 02650317 + IVCORR = 1 02660317 +40060 IF (IVCOMP - 1) 20060, 10060, 20060 02670317 +30060 IVDELE = IVDELE + 1 02680317 + WRITE (I02,80000) IVTNUM 02690317 + IF (ICZERO) 10060, 0071, 20060 02700317 +10060 IVPASS = IVPASS + 1 02710317 + WRITE (I02,80002) IVTNUM 02720317 + GO TO 0071 02730317 +20060 IVFAIL = IVFAIL + 1 02740317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02750317 + 0071 CONTINUE 02760317 +C 02770317 +C **** FCVS PROGRAM 317 - TEST 007 **** 02780317 +C 02790317 +C INTEGER ARRAY ELEMENT NAME AS ACTUAL ARGUMENT 02800317 +C 02810317 + IVTNUM = 7 02820317 + IF (ICZERO) 30070, 0070, 30070 02830317 + 0070 CONTINUE 02840317 + IVCOMP = 0 02850317 + IADN11(2) = 2 02860317 + IVCOMP = FF318(IADN11(2)) 02870317 + IVCORR = 3 02880317 +40070 IF (IVCOMP - 3) 20070, 10070, 20070 02890317 +30070 IVDELE = IVDELE + 1 02900317 + WRITE (I02,80000) IVTNUM 02910317 + IF (ICZERO) 10070, 0081, 20070 02920317 +10070 IVPASS = IVPASS + 1 02930317 + WRITE (I02,80002) IVTNUM 02940317 + GO TO 0081 02950317 +20070 IVFAIL = IVFAIL + 1 02960317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02970317 + 0081 CONTINUE 02980317 +C 02990317 +C **** FCVS PROGRAM 317 - TEST 008 **** 03000317 +C 03010317 +C REAL ARRAY ELEMENT NAME AS ACTUAL ARGUMENT 03020317 +C 03030317 + IVTNUM = 8 03040317 + IF (ICZERO) 30080, 0080, 30080 03050317 + 0080 CONTINUE 03060317 + RVCOMP = 0.0 03070317 + RADN11(4) = 4.0 03080317 + RVCOMP = FF319(RADN11(4)) 03090317 + RVCORR = 5.0 03100317 +40080 IF (RVCOMP - 4.9995) 20080, 10080, 40081 03110317 +40081 IF (RVCOMP - 5.0005) 10080, 10080, 20080 03120317 +30080 IVDELE = IVDELE + 1 03130317 + WRITE (I02,80000) IVTNUM 03140317 + IF (ICZERO) 10080, 0091, 20080 03150317 +10080 IVPASS = IVPASS + 1 03160317 + WRITE (I02,80002) IVTNUM 03170317 + GO TO 0091 03180317 +20080 IVFAIL = IVFAIL + 1 03190317 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03200317 + 0091 CONTINUE 03210317 +C 03220317 +C **** FCVS PROGRAM 317 - TEST 009 **** 03230317 +C 03240317 +C LOGICAL ARRAY ELEMENT NAME AS ACTUAL ARGUMENT 03250317 +C 03260317 + IVTNUM = 9 03270317 + IF (ICZERO) 30090, 0090, 30090 03280317 + 0090 CONTINUE 03290317 + LADN11(1) = .FALSE. 03300317 + IVCOMP = 0 03310317 + IF (FF320(LADN11(1))) IVCOMP = 1 03320317 + IVCORR = 1 03330317 +40090 IF (IVCOMP - 1) 20090, 10090, 20090 03340317 +30090 IVDELE = IVDELE + 1 03350317 + WRITE (I02,80000) IVTNUM 03360317 + IF (ICZERO) 10090, 0101, 20090 03370317 +10090 IVPASS = IVPASS + 1 03380317 + WRITE (I02,80002) IVTNUM 03390317 + GO TO 0101 03400317 +20090 IVFAIL = IVFAIL + 1 03410317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03420317 + 0101 CONTINUE 03430317 +C 03440317 +C **** FCVS PROGRAM 317 - TEST 010 **** 03450317 +C 03460317 +C INTEGER EXPRESSION INVOLVING OPERATORS AS ACTUAL ARGUMENT 03470317 +C 03480317 + IVTNUM = 10 03490317 + IF (ICZERO) 30100, 0100, 30100 03500317 + 0100 CONTINUE 03510317 + IVCOMP = 0 03520317 + IVON02 = 2 03530317 + IVON03 = 3 03540317 + IVCOMP = FF318(IVON02 + 3 * IVON03 - 7) 03550317 + IVCORR = 5 03560317 +40100 IF (IVCOMP - 5) 20100, 10100, 20100 03570317 +30100 IVDELE = IVDELE + 1 03580317 + WRITE (I02,80000) IVTNUM 03590317 + IF (ICZERO) 10100, 0111, 20100 03600317 +10100 IVPASS = IVPASS + 1 03610317 + WRITE (I02,80002) IVTNUM 03620317 + GO TO 0111 03630317 +20100 IVFAIL = IVFAIL + 1 03640317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03650317 + 0111 CONTINUE 03660317 +C 03670317 +C **** FCVS PROGRAM 317 - TEST 011 **** 03680317 +C 03690317 +C REAL EXPRESSION INVOLVING OPERATORS AS ACTUAL ARGUMENT 03700317 +C 03710317 + IVTNUM = 11 03720317 + IF (ICZERO) 30110, 0110, 30110 03730317 + 0110 CONTINUE 03740317 + RVCOMP = 0.0 03750317 + RVON02 = 2. 03760317 + RVON03 = 1.2 03770317 + RVCOMP = FF319(RVON02 * RVON03 /.6) 03780317 + RVCORR = 5.0 03790317 +40110 IF (RVCOMP - 4.9995) 20110, 10110, 40111 03800317 +40111 IF (RVCOMP - 5.0005) 10110, 10110, 20110 03810317 +30110 IVDELE = IVDELE + 1 03820317 + WRITE (I02,80000) IVTNUM 03830317 + IF (ICZERO) 10110, 0121, 20110 03840317 +10110 IVPASS = IVPASS + 1 03850317 + WRITE (I02,80002) IVTNUM 03860317 + GO TO 0121 03870317 +20110 IVFAIL = IVFAIL + 1 03880317 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03890317 + 0121 CONTINUE 03900317 +C 03910317 +C **** FCVS PROGRAM 317 - TEST 012 **** 03920317 +C 03930317 +C REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS03940317 +C AS ACTUAL ARGUMENT. 03950317 +C 03960317 + IVTNUM = 12 03970317 + IF (ICZERO) 30120, 0120, 30120 03980317 + 0120 CONTINUE 03990317 + RVCOMP = 0.0 04000317 + IVON01 = 2 04010317 + RADN11(2) = 2.5 04020317 + RVCOMP = FF319(IVON01**3 * (RADN11(2) - 1) + 2.0) 04030317 + RVCORR = 15.0 04040317 +40120 IF (RVCOMP - 14.995) 20120, 10120, 40121 04050317 +40121 IF (RVCOMP - 15.005) 10120, 10120, 20120 04060317 +30120 IVDELE = IVDELE + 1 04070317 + WRITE (I02,80000) IVTNUM 04080317 + IF (ICZERO) 10120, 0131, 20120 04090317 +10120 IVPASS = IVPASS + 1 04100317 + WRITE (I02,80002) IVTNUM 04110317 + GO TO 0131 04120317 +20120 IVFAIL = IVFAIL + 1 04130317 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04140317 + 0131 CONTINUE 04150317 +C 04160317 +C **** FCVS PROGRAM 317 - TEST 013 **** 04170317 +C 04180317 +C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL 04190317 +C ARGUMENT. 04200317 +C 04210317 + IVTNUM = 13 04220317 + IF (ICZERO) 30130, 0130, 30130 04230317 + 0130 CONTINUE 04240317 + LVON01 = .TRUE. 04250317 + IVCOMP = 0 04260317 + IF (FF320(.NOT. LVON01)) IVCOMP = 1 04270317 + IVCORR = 1 04280317 +40130 IF (IVCOMP - 1) 20130, 10130, 20130 04290317 +30130 IVDELE = IVDELE + 1 04300317 + WRITE (I02,80000) IVTNUM 04310317 + IF (ICZERO) 10130, 0141, 20130 04320317 +10130 IVPASS = IVPASS + 1 04330317 + WRITE (I02,80002) IVTNUM 04340317 + GO TO 0141 04350317 +20130 IVFAIL = IVFAIL + 1 04360317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04370317 + 0141 CONTINUE 04380317 +C 04390317 +C **** FCVS PROGRAM 317 - TEST 014 **** 04400317 +C 04410317 +C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE 04420317 +C ARGUMENT. 04430317 +C 04440317 + IVTNUM = 14 04450317 + IF (ICZERO) 30140, 0140, 30140 04460317 + 0140 CONTINUE 04470317 + LVON01 = .TRUE. 04480317 + LVON02 = .FALSE. 04490317 + IVCOMP = 0 04500317 + IF (.NOT. FF320(LVON01 .OR. LVON02)) IVCOMP = 1 04510317 + IVCORR = 1 04520317 +40140 IF (IVCOMP - 1) 20140, 10140, 20140 04530317 +30140 IVDELE = IVDELE + 1 04540317 + WRITE (I02,80000) IVTNUM 04550317 + IF (ICZERO) 10140, 0151, 20140 04560317 +10140 IVPASS = IVPASS + 1 04570317 + WRITE (I02,80002) IVTNUM 04580317 + GO TO 0151 04590317 +20140 IVFAIL = IVFAIL + 1 04600317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04610317 + 0151 CONTINUE 04620317 +C 04630317 +C **** FCVS PROGRAM 317 - TEST 015 **** 04640317 +C 04650317 +C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL 04660317 +C ARGUMENT. 04670317 +C 04680317 + IVTNUM = 15 04690317 + IF (ICZERO) 30150, 0150, 30150 04700317 + 0150 CONTINUE 04710317 + LVON01 = .FALSE. 04720317 + LVON02 = .TRUE. 04730317 + IVCOMP = 0 04740317 + IF (FF320(LVON01 .AND. LVON02)) IVCOMP = 1 04750317 + IVCORR = 1 04760317 +40150 IF (IVCOMP - 1) 20150, 10150, 20150 04770317 +30150 IVDELE = IVDELE + 1 04780317 + WRITE (I02,80000) IVTNUM 04790317 + IF (ICZERO) 10150, 0161, 20150 04800317 +10150 IVPASS = IVPASS + 1 04810317 + WRITE (I02,80002) IVTNUM 04820317 + GO TO 0161 04830317 +20150 IVFAIL = IVFAIL + 1 04840317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04850317 + 0161 CONTINUE 04860317 +C 04870317 +C **** FCVS PROGRAM 317 - TEST 016 **** 04880317 +C 04890317 +C EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT 04900317 +C 04910317 + IVTNUM = 16 04920317 + IF (ICZERO) 30160, 0160, 30160 04930317 + 0160 CONTINUE 04940317 + IVCOMP = 0 04950317 + IVON01 = 6 04960317 + IVCOMP = FF318((IVON01 + 3)) 04970317 + IVCORR = 10 04980317 +40160 IF (IVCOMP - 10) 20160, 10160, 20160 04990317 +30160 IVDELE = IVDELE + 1 05000317 + WRITE (I02,80000) IVTNUM 05010317 + IF (ICZERO) 10160, 0171, 20160 05020317 +10160 IVPASS = IVPASS + 1 05030317 + WRITE (I02,80002) IVTNUM 05040317 + GO TO 0171 05050317 +20160 IVFAIL = IVFAIL + 1 05060317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05070317 + 0171 CONTINUE 05080317 +C 05090317 +C **** FCVS PROGRAM 317 - TEST 017 **** 05100317 +C 05110317 +C REAL INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT. 05120317 +C 05130317 + IVTNUM = 17 05140317 + IF (ICZERO) 30170, 0170, 30170 05150317 + 0170 CONTINUE 05160317 + RVCOMP = 0.0 05170317 + RVON01 = -5.2 05180317 + RVCOMP = FF319(ABS(RVON01)) 05190317 + RVCORR = 6.2 05200317 +40170 IF (RVCOMP - 6.1995) 20170, 10170, 40171 05210317 +40171 IF (RVCOMP - 6.2005) 10170, 10170, 20170 05220317 +30170 IVDELE = IVDELE + 1 05230317 + WRITE (I02,80000) IVTNUM 05240317 + IF (ICZERO) 10170, 0181, 20170 05250317 +10170 IVPASS = IVPASS + 1 05260317 + WRITE (I02,80002) IVTNUM 05270317 + GO TO 0181 05280317 +20170 IVFAIL = IVFAIL + 1 05290317 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05300317 + 0181 CONTINUE 05310317 +C 05320317 +C **** FCVS PROGRAM 317 - TEST 018 **** 05330317 +C 05340317 +C INTEGER INTRINSIC FUNCTION REFERENCE AS ACTUAL ARGUMENT. 05350317 +C 05360317 + IVTNUM = 18 05370317 + IF (ICZERO) 30180, 0180, 30180 05380317 + 0180 CONTINUE 05390317 + IVCOMP = 0 05400317 + RVON01 = 4.7 05410317 + IVCOMP = FF318(NINT(RVON01)) 05420317 + IVCORR = 6 05430317 +40180 IF (IVCOMP - 6) 20180, 10180, 20180 05440317 +30180 IVDELE = IVDELE + 1 05450317 + WRITE (I02,80000) IVTNUM 05460317 + IF (ICZERO) 10180, 0191, 20180 05470317 +10180 IVPASS = IVPASS + 1 05480317 + WRITE (I02,80002) IVTNUM 05490317 + GO TO 0191 05500317 +20180 IVFAIL = IVFAIL + 1 05510317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05520317 + 0191 CONTINUE 05530317 +C 05540317 +C **** FCVS PROGRAM 317 - TEST 019 **** 05550317 +C 05560317 +C EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT. 05570317 +C 05580317 + IVTNUM = 19 05590317 + IF (ICZERO) 30190, 0190, 30190 05600317 + 0190 CONTINUE 05610317 + IVCOMP = 0 05620317 + IVON01 = 4 05630317 + IVCOMP = FF318(FF321(IVON01)) 05640317 + IVCORR = 6 05650317 +40190 IF (IVCOMP - 6) 20190, 10190, 20190 05660317 +30190 IVDELE = IVDELE + 1 05670317 + WRITE (I02,80000) IVTNUM 05680317 + IF (ICZERO) 10190, 0201, 20190 05690317 +10190 IVPASS = IVPASS + 1 05700317 + WRITE (I02,80002) IVTNUM 05710317 + GO TO 0201 05720317 +20190 IVFAIL = IVFAIL + 1 05730317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05740317 + 0201 CONTINUE 05750317 +C 05760317 +C **** FCVS PROGRAM 317 - TEST 020 **** 05770317 +C 05780317 +C EXTERNAL FUNCTION REFERENCE WHICH USES A REFERENCE TO ITSELF 05790317 +C AS AN ACTUAL ARGUMENT. 05800317 +C 05810317 + IVTNUM = 20 05820317 + IF (ICZERO) 30200, 0200, 30200 05830317 + 0200 CONTINUE 05840317 + IVCOMP = 0 05850317 + IVCOMP = FF318(FF318(4)) 05860317 + IVCORR = 6 05870317 +40200 IF (IVCOMP - 6) 20200, 10200, 20200 05880317 +30200 IVDELE = IVDELE + 1 05890317 + WRITE (I02,80000) IVTNUM 05900317 + IF (ICZERO) 10200, 0211, 20200 05910317 +10200 IVPASS = IVPASS + 1 05920317 + WRITE (I02,80002) IVTNUM 05930317 + GO TO 0211 05940317 +20200 IVFAIL = IVFAIL + 1 05950317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05960317 + 0211 CONTINUE 05970317 +C 05980317 +C **** FCVS PROGRAM 317 - TEST 021 **** 05990317 +C 06000317 +C USE AN ACTUAL ARGUMENT NAME WHICH IS IDENTICAL TO THE DUMMY 06010317 +C ARGUMENT NAME. 06020317 +C 06030317 + IVTNUM = 21 06040317 + IF (ICZERO) 30210, 0210, 30210 06050317 + 0210 CONTINUE 06060317 + IVCOMP = 0 06070317 + IDON01 = 10 06080317 + IVCOMP = FF318(IDON01) 06090317 + IVCORR = 11 06100317 +40210 IF (IVCOMP - 11) 20210, 10210, 20210 06110317 +30210 IVDELE = IVDELE + 1 06120317 + WRITE (I02,80000) IVTNUM 06130317 + IF (ICZERO) 10210, 0221, 20210 06140317 +10210 IVPASS = IVPASS + 1 06150317 + WRITE (I02,80002) IVTNUM 06160317 + GO TO 0221 06170317 +20210 IVFAIL = IVFAIL + 1 06180317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06190317 + 0221 CONTINUE 06200317 +C 06210317 +C **** FCVS PROGRAM 317 - TEST 022 **** 06220317 +C 06230317 +C USE STATEMENT FUNCTION REFERENCE AS ACTUAL ARGUMENT. 06240317 +C 06250317 + IVTNUM = 22 06260317 + IF (ICZERO) 30220, 0220, 30220 06270317 + 0220 CONTINUE 06280317 + IVCOMP = 0 06290317 + IVCOMP = FF318(IFOS01(4)) 06300317 + IVCORR = 6 06310317 +40220 IF (IVCOMP - 6) 20220, 10220, 20220 06320317 +30220 IVDELE = IVDELE + 1 06330317 + WRITE (I02,80000) IVTNUM 06340317 + IF (ICZERO) 10220, 0231, 20220 06350317 +10220 IVPASS = IVPASS + 1 06360317 + WRITE (I02,80002) IVTNUM 06370317 + GO TO 0231 06380317 +20220 IVFAIL = IVFAIL + 1 06390317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06400317 + 0231 CONTINUE 06410317 +C 06420317 +C TEST 023 THROUGH TEST 028 ARE DESIGNED TO ASSOCIATE VARIOUS 06430317 +C FORMS OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS EXTERNAL 06440317 +C FUNCTION DUMMY ARGUMENTS. 06450317 +C 06460317 +C 06470317 +C **** FCVS PROGRAM 317 - TEST 023 **** 06480317 +C 06490317 +C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 06500317 +C ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY 06510317 +C ARGUMENT ARRAY DECLARATOR. 06520317 +C 06530317 + IVTNUM = 23 06540317 + IF (ICZERO) 30230, 0230, 30230 06550317 + 0230 CONTINUE 06560317 + IVCOMP = 0 06570317 + IADN12(1) = 1 06580317 + IADN12(2) = 10 06590317 + IADN12(3) = 100 06600317 + IADN12(4) = 1000 06610317 + IVCOMP = FF322(IADN12) 06620317 + IVCORR = 1111 06630317 +40230 IF (IVCOMP - 1111) 20230, 10230, 20230 06640317 +30230 IVDELE = IVDELE + 1 06650317 + WRITE (I02,80000) IVTNUM 06660317 + IF (ICZERO) 10230, 0241, 20230 06670317 +10230 IVPASS = IVPASS + 1 06680317 + WRITE (I02,80002) IVTNUM 06690317 + GO TO 0241 06700317 +20230 IVFAIL = IVFAIL + 1 06710317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06720317 + 0241 CONTINUE 06730317 +C 06740317 +C **** FCVS PROGRAM 317 - TEST 024 **** 06750317 +C 06760317 +C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE 06770317 +C ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED 06780317 +C DUMMY ARGUMENT ARRAY. 06790317 +C 06800317 + IVTNUM = 24 06810317 + IF (ICZERO) 30240, 0240, 30240 06820317 + 0240 CONTINUE 06830317 + IVCOMP = 0 06840317 + IACN11(1) = 1 06850317 + IACN11(2) = 10 06860317 + IACN11(3) = 100 06870317 + IACN11(4) = 1000 06880317 + IACN11(5) = 10000 06890317 + IVCOMP = FF322(IACN11) 06900317 + IVCORR = 1111 06910317 +40240 IF (IVCOMP - 1111) 20240, 10240, 20240 06920317 +30240 IVDELE = IVDELE + 1 06930317 + WRITE (I02,80000) IVTNUM 06940317 + IF (ICZERO) 10240, 0251, 20240 06950317 +10240 IVPASS = IVPASS + 1 06960317 + WRITE (I02,80002) IVTNUM 06970317 + GO TO 0251 06980317 +20240 IVFAIL = IVFAIL + 1 06990317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07000317 + 0251 CONTINUE 07010317 +C 07020317 +C **** FCVS PROGRAM 317 - TEST 025 **** 07030317 +C 07040317 +C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 07050317 +C ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT 07060317 +C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR. 07070317 +C THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR. 07080317 +C 07090317 + IVTNUM = 25 07100317 + IF (ICZERO) 30250, 0250, 30250 07110317 + 0250 CONTINUE 07120317 + IVCOMP = 0 07130317 + IATN11(1,1) = 1 07140317 + IATN11(2,1) = 10 07150317 + IATN11(1,2) = 100 07160317 + IATN11(2,2) = 1000 07170317 + IATN11(1,3) = 10000 07180317 + IVCOMP = FF322(IATN11) 07190317 + IVCORR = 1111 07200317 +40250 IF (IVCOMP - 1111) 20250, 10250, 20250 07210317 +30250 IVDELE = IVDELE + 1 07220317 + WRITE (I02,80000) IVTNUM 07230317 + IF (ICZERO) 10250, 0261, 20250 07240317 +10250 IVPASS = IVPASS + 1 07250317 + WRITE (I02,80002) IVTNUM 07260317 + GO TO 0261 07270317 +20250 IVFAIL = IVFAIL + 1 07280317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07290317 + 0261 CONTINUE 07300317 +C 07310317 +C **** FCVS PROGRAM 317 - TEST 026 **** 07320317 +C 07330317 +C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE 07340317 +C ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL. ALL 07350317 +C ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE 07360317 +C DUMMY ARRAY OF THE EXTERNAL FUNCTION. 07370317 +C 07380317 + IVTNUM = 26 07390317 + IF (ICZERO) 30260, 0260, 30260 07400317 + 0260 CONTINUE 07410317 + RVCOMP = 0.0 07420317 + RADN12(1) = 1. 07430317 + RADN12(2) = 10. 07440317 + RADN12(3) = 100. 07450317 + RADN12(4) = 1000. 07460317 + RVCOMP = FF323(RADN12(1)) 07470317 + RVCORR = 1111. 07480317 +40260 IF (RVCOMP - 1110.5) 20260, 10260, 40261 07490317 +40261 IF (RVCOMP - 1111.5) 10260, 10260, 20260 07500317 +30260 IVDELE = IVDELE + 1 07510317 + WRITE (I02,80000) IVTNUM 07520317 + IF (ICZERO) 10260, 0271, 20260 07530317 +10260 IVPASS = IVPASS + 1 07540317 + WRITE (I02,80002) IVTNUM 07550317 + GO TO 0271 07560317 +20260 IVFAIL = IVFAIL + 1 07570317 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07580317 + 0271 CONTINUE 07590317 +C 07600317 +C **** FCVS PROGRAM 317 - TEST 027 **** 07610317 +C 07620317 +C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 07630317 +C OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT 07640317 +C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL07650317 +C ARRAY ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 (OUT OF A 07660317 +C POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE 07670317 +C EXTERNAL FUNCTION. 07680317 +C 07690317 + IVTNUM = 27 07700317 + IF (ICZERO) 30270, 0270, 30270 07710317 + 0270 CONTINUE 07720317 + RVCOMP = 0.0 07730317 + RACN11(4) = 1. 07740317 + RACN11(5) = 10. 07750317 + RACN11(6) = 100. 07760317 + RACN11(7) = 1000. 07770317 + RACN11(8) = 10000. 07780317 + RACN11(9) = 100000. 07790317 + RVCORR = 11110. 07800317 + RVCOMP = FF323(RACN11(5)) 07810317 +40270 IF (RVCOMP - 11105.) 20270, 10270, 40271 07820317 +40271 IF (RVCOMP - 11115.) 10270, 10270, 20270 07830317 +30270 IVDELE = IVDELE + 1 07840317 + WRITE (I02,80000) IVTNUM 07850317 + IF (ICZERO) 10270, 0281, 20270 07860317 +10270 IVPASS = IVPASS + 1 07870317 + WRITE (I02,80002) IVTNUM 07880317 + GO TO 0281 07890317 +20270 IVFAIL = IVFAIL + 1 07900317 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07910317 + 0281 CONTINUE 07920317 +C 07930317 +C **** FCVS PROGRAM 317 - TEST 028 **** 07940317 +C 07950317 +C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 07960317 +C OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE 07970317 +C ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL ARRAY ELEMENTS WITH 07980317 +C SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12 07990317 +C ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE EXTERNAL 08000317 +C FUNCTION. 08010317 +C 08020317 + IVTNUM = 28 08030317 + IF (ICZERO) 30280, 0280, 30280 08040317 + 0280 CONTINUE 08050317 + RVCOMP = 0.0 08060317 + RATN11(2,3) = 1. 08070317 + RATN11(3,3) = 10. 08080317 + RATN11(1,4) = 100. 08090317 + RATN11(2,4) = 1000. 08100317 + RATN11(3,4) = 10000. 08110317 + RVCOMP = FF323(RATN11(3,3)) 08120317 + RVCORR = 11110. 08130317 +40280 IF (RVCOMP - 11105.) 20280, 10280, 40281 08140317 +40281 IF (RVCOMP - 11115.) 10280, 10280, 20280 08150317 +30280 IVDELE = IVDELE + 1 08160317 + WRITE (I02,80000) IVTNUM 08170317 + IF (ICZERO) 10280, 0291, 20280 08180317 +10280 IVPASS = IVPASS + 1 08190317 + WRITE (I02,80002) IVTNUM 08200317 + GO TO 0291 08210317 +20280 IVFAIL = IVFAIL + 1 08220317 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08230317 + 0291 CONTINUE 08240317 +C 08250317 +C TEST 029 THROUGH TEST 032 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 08260317 +C OF ACTUAL ARGUMENTS TO PROCEDURES USED AS DUMMY ARGUMENTS. 08270317 +C ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN EXTERNAL FUNCTION,08280317 +C AN INTRINSIC FUNCTION, AND A SUBROUTINE. 08290317 +C 08300317 +C 08310317 +C **** FCVS PROGRAM 317 - TEST 029 **** 08320317 +C 08330317 +C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. 08340317 +C 08350317 + IVTNUM = 29 08360317 + IF (ICZERO) 30290, 0290, 30290 08370317 + 0290 CONTINUE 08380317 + IVCOMP = 0 08390317 + IVCOMP = FF324(FF325,5) 08400317 + IVCORR = 7 08410317 +40290 IF (IVCOMP - 7) 20290, 10290, 20290 08420317 +30290 IVDELE = IVDELE + 1 08430317 + WRITE (I02,80000) IVTNUM 08440317 + IF (ICZERO) 10290, 0301, 20290 08450317 +10290 IVPASS = IVPASS + 1 08460317 + WRITE (I02,80002) IVTNUM 08470317 + GO TO 0301 08480317 +20290 IVFAIL = IVFAIL + 1 08490317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08500317 + 0301 CONTINUE 08510317 +C 08520317 +C **** FCVS PROGRAM 317 - TEST 030 **** 08530317 +C 08540317 +C USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT. 08550317 +C 08560317 + IVTNUM = 30 08570317 + IF (ICZERO) 30300, 0300, 30300 08580317 + 0300 CONTINUE 08590317 + IVCOMP = 0 08600317 + IVCOMP = FF324(IABS,-7) 08610317 + IVCORR = 8 08620317 +40300 IF (IVCOMP - 8) 20300, 10300, 20300 08630317 +30300 IVDELE = IVDELE + 1 08640317 + WRITE (I02,80000) IVTNUM 08650317 + IF (ICZERO) 10300, 0311, 20300 08660317 +10300 IVPASS = IVPASS + 1 08670317 + WRITE (I02,80002) IVTNUM 08680317 + GO TO 0311 08690317 +20300 IVFAIL = IVFAIL + 1 08700317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08710317 + 0311 CONTINUE 08720317 +C 08730317 +C **** FCVS PROGRAM 317 - TEST 031 **** 08740317 +C 08750317 +C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. THE 08760317 +C INTRINSIC FUNCTION NAME (NINT) IS USED AS THE DUMMY PROCEDURE 08770317 +C NAME IN THE EXTERNAL FUNCTION AND THEREFORE CAN NOT BE USED AS 08780317 +C AN INTRINSIC FUNCTION WITHIN THAT PROGRAM UNIT. HOWEVER IT CAN 08790317 +C BE REFERENCED IN THE MAIN PROGRAM FM317 AND IN THE SUBPROGRAM 08800317 +C FF325. 08810317 +C 08820317 + IVTNUM = 31 08830317 + IF (ICZERO) 30310, 0310, 30310 08840317 + 0310 CONTINUE 08850317 + IVCOMP = 0 08860317 + IVCOMP = NINT(3.7) + FF324(FF325,2) 08870317 + IVCORR = 8 08880317 +40310 IF (IVCOMP - 8) 20310, 10310, 20310 08890317 +30310 IVDELE = IVDELE + 1 08900317 + WRITE (I02,80000) IVTNUM 08910317 + IF (ICZERO) 10310, 0321, 20310 08920317 +10310 IVPASS = IVPASS + 1 08930317 + WRITE (I02,80002) IVTNUM 08940317 + GO TO 0321 08950317 +20310 IVFAIL = IVFAIL + 1 08960317 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08970317 + 0321 CONTINUE 08980317 +C 08990317 +C **** FCVS PROGRAM 317 - TEST 032 **** 09000317 +C 09010317 +C USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT. 09020317 +C 09030317 + IVTNUM = 32 09040317 + IF (ICZERO) 30320, 0320, 30320 09050317 + 0320 CONTINUE 09060317 + RVCOMP = 0.0 09070317 + RVON01 = 3.5 09080317 + RVCOMP = FF326(FS327,RVON01) 09090317 + RVCORR = 5.5 09100317 +40320 IF (RVCOMP - 5.4995) 20320, 10320, 40321 09110317 +40321 IF (RVCOMP - 5.5005) 10320, 10320, 20320 09120317 +30320 IVDELE = IVDELE + 1 09130317 + WRITE (I02,80000) IVTNUM 09140317 + IF (ICZERO) 10320, 0331, 20320 09150317 +10320 IVPASS = IVPASS + 1 09160317 + WRITE (I02,80002) IVTNUM 09170317 + GO TO 0331 09180317 +20320 IVFAIL = IVFAIL + 1 09190317 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 09200317 + 0331 CONTINUE 09210317 +C 09220317 +C 09230317 +C WRITE OUT TEST SUMMARY 09240317 +C 09250317 + WRITE (I02,90004) 09260317 + WRITE (I02,90014) 09270317 + WRITE (I02,90004) 09280317 + WRITE (I02,90000) 09290317 + WRITE (I02,90004) 09300317 + WRITE (I02,90020) IVFAIL 09310317 + WRITE (I02,90022) IVPASS 09320317 + WRITE (I02,90024) IVDELE 09330317 + STOP 09340317 +90001 FORMAT (" ",24X,"FM317") 09350317 +90000 FORMAT (" ",20X,"END OF PROGRAM FM317" ) 09360317 +C 09370317 +C FORMATS FOR TEST DETAIL LINES 09380317 +C 09390317 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 09400317 +80002 FORMAT (" ",4X,I5,7X,"PASS") 09410317 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 09420317 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 09430317 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 09440317 +C 09450317 +C FORMAT STATEMENTS FOR PAGE HEADERS 09460317 +C 09470317 +90002 FORMAT ("1") 09480317 +90004 FORMAT (" ") 09490317 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 09500317 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 09510317 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 09520317 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 09530317 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 09540317 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 09550317 +C 09560317 +C FORMAT STATEMENTS FOR RUN SUMMARY 09570317 +C 09580317 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 09590317 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 09600317 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 09610317 + END 09620317 + + INTEGER FUNCTION FF318(IDON01) 00010318 +C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020318 +C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF INTEGER ACTUAL 00030318 +C ARGUMENTS TO AN INTEGER VARIABLE NAME USED AS AN EXTERNAL 00040318 +C FUNCTION DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT 00050318 +C VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060318 + FF318 = IDON01 + 1 00070318 + RETURN 00080318 + END 00090318 + + REAL FUNCTION FF319(RDON01) 00010319 +C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020319 +C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF REAL ACTUAL 00030319 +C ARGUMENTS TO A REAL VARIABLE NAME USED AS AN EXTERNAL FUNCTION 00040319 +C DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY 00050319 +C ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060319 + FF319 = RDON01 + 1.0 00070319 + RETURN 00080319 + END 00090319 + + LOGICAL FUNCTION FF320(LDON01) 00010320 +C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020320 +C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF LOGICAL ACTUAL 00030320 +C ARGUMENTS TO A LOGICAL VARIABLE NAME USED AS AN EXTERNAL 00040320 +C FUNCTION DUMMY ARGUMENT. THIS ROUTINE NEGATES THE ARGUMENT 00050320 +C VALUE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060320 + LOGICAL LDON01 00070320 + FF320 = .NOT. LDON01 00080320 + RETURN 00090320 + END 00100320 + + INTEGER FUNCTION FF321(IDON02) 00010321 +C THIS FUNCTION IS USED IN TEST 019 OF MAIN PROGRAM FM317 AS 00020321 +C THE TEST OF THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN 00030321 +C ACTUAL ARGUMENT TO A VARIABLE NAME USED AS AN EXTERNAL FUNCTION 00040321 +C DUMMY ARGUMENT. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY 00050321 +C ONE AND RETURNS THE RESULT AS THE FUNCTION VALUE. 00060321 + FF321 = IDON02 + 1 00070321 + RETURN 00080321 + END 00090321 + + INTEGER FUNCTION FF322(IDDN11) 00010322 +C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020322 +C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF ARRAY NAMES USED AS 00030322 +C ACTUAL ARGUMENTS TO AN ARRAY NAME USED AS AN EXTERNAL FUNCTION 00040322 +C DUMMY ARGUMENT. THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN 00050322 +C THE DUMMY ARRAY AND RETURNS THE SUM AS THE FUNCTION VALUE. 00060322 + DIMENSION IDDN11(4) 00070322 + FF322 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4) 00080322 + RETURN 00090322 + END 00100322 + + REAL FUNCTION FF323(RDTN21) 00010323 +C THIS FUNCTION IS USED BY VARIOUS TESTS IN MAIN PROGRAM FM317 00020323 +C TO TEST THE ASSOCIATION OF VARIOUS FORMS OF ARRAY ELEMENT NAMES 00030323 +C USED AS ACTUAL ARGUMENTS TO AN ARRAY NAME USED AS AN EXTERNAL 00040323 +C FUNCTION DUMMY ARGUMENT. THIS ROUTINE ADDS TOGETHER THE FOUR 00050323 +C ELEMENTS IN THE DUMMY ARRAY AND RETURNS THE SUM AS THE FUNCTION 00060323 +C VALUE. 00070323 + REAL RDTN21(2,2) 00080323 + FF323 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2) 00090323 + RETURN 00100323 + END 00110323 + + INTEGER FUNCTION FF324(NINT, IDON03) 00010324 +C THIS FUNCTION IS USED BY TESTS 029, 030 AND 031 OF MAIN 00020324 +C PROGRAM FM317 TO TEST THE ASSOCIATION OF EXTERNAL FUNCTION AND 00030324 +C INTRINSIC FUNCTION NAMES USED AS ACTUAL ARGUMENTS TO A PROCEDURE 00040324 +C NAME USED AS A DUMMY ARGUMENT. THIS FUNCTION REFERENCES THE 00050324 +C EXTERNAL FUNCTION OR INTRINSIC FUNCTION PASSED AS A PROCEDURE 00060324 +C NAME ARGUMENT, INCREMENTING THE RESULT BY ONE BEFORE RETURNING 00070324 +C THE RESULT AS THE FUNCTION VALUE. 00080324 + FF324 = NINT(IDON03) + 1 00090324 +C **** THE NAME NINT IS A DUMMY ARGUMENT 00100324 +C AND NOT AN INTRINSIC FUNCTION REFERENCE ***** 00110324 + RETURN 00120324 + END 00130324 + + INTEGER FUNCTION FF325(IDON05) 00010325 +C THIS FUNCTION IS USED BY TESTS 029 AND 031 OF MAIN PROGRAM 00020325 +C FM317 TO TEST THE ASSOCIATION OF AN EXTERNAL FUNCTION NAME USED AS00030325 +C AN ACTUAL ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. 00040325 +C FF325 IS REFERENCED FROM EXTERNAL FUNCTION FF324 VIA A DUMMY 00050325 +C PROCEDURE NAME REFERENCE. THIS ROUTINE ADDS THE RESULT OF AN 00060325 +C INTRINSIC FUNCTION REFERENCE (NINT) TO THE ARGUMENT VALUE AND 00070325 +C RETURNS THE SUM AS THE FUNCTION VALUE. 00080325 + FF325 = IDON05 + NINT(1.2) 00090325 + RETURN 00100325 + END 00110325 + + REAL FUNCTION FF326(RDON02,RDON03) 00010326 +C THIS FUNCTION IS USED BY TEST 032 OF MAIN PROGRAM FM317 TO 00020326 +C TEST THE ASSOCIATION OF A SUBROUTINE NAME USED AS AN ACTUAL 00030326 +C ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. THIS 00040326 +C FUNCTION CALLS THE SUBROUTINE (FS327) PASSED AS A PROCEDURE NAME 00050326 +C ARGUMENT. THE VALUE OF THE ARGUMENT RETURNED FROM THIS 00060326 +C REFERENCE IS THEN INCREMENTED BY ONE BEFORE RETURNING THE SUM AS 00070326 +C THE FUNCTION VALUE. 00080326 + CALL RDON02(RDON03) 00090326 + FF326 = RDON03 + 1.0 00100326 + RETURN 00110326 + END 00120326 + + SUBROUTINE FS327(RDON04) 00010327 +C THIS SUBROUTINE IS USED BY TEST 032 OF MAIN PROGRAM FM317 TO 00020327 +C TEST THE ASSOCIATION OF A SUBROUTINE NAME USED AS AN ACTUAL 00030327 +C ARGUMENT TO A PROCEDURE NAME USED AS A DUMMY ARGUMENT. FS327 IS 00040327 +C CALLED FROM EXTERNAL PROGRAM FF326 VIA A DUMMY PROCEDURE NAME 00050327 +C REFERENCE. THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE. 00060327 + RDON04 = RDON04 + 1.0 00070327 + RETURN 00080327 + END 00090327 diff --git a/Fortran/UnitTests/fcvs21_f95/FM317.reference_output b/Fortran/UnitTests/fcvs21_f95/FM317.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM317.reference_output @@ -0,0 +1,53 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM317 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + + ---------------------------------------------- + + END OF PROGRAM FM317 + + 0 TESTS FAILED + 32 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM328.f b/Fortran/UnitTests/fcvs21_f95/FM328.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM328.f @@ -0,0 +1,879 @@ + PROGRAM FM328 00010328 +C 00020328 +C 00030328 +C THIS ROUTINE TEST SUBSET LEVEL FEATURES OF 00040328 +C SUBROUTINE SUBPROGRAMS. TESTS ARE DESIGNED TO CHECK THE 00050328 +C ASSOCIATION OF ALL PERMISSIBLE FORMS OF ACTUAL ARGUMENTS WITH 00060328 +C VARIABLE, ARRAY AND PROCEDURE NAME DUMMY ARGUMENTS. THESE 00070328 +C INCLUDE, 00080328 +C 00090328 +C 1) ACTUAL ARGUMENTS ASSOCIATED TO VARIABLE NAME DUMMY 00100328 +C ARGUMENT INCLUDE, 00110328 +C 00120328 +C A) CONSTANT 00130328 +C B) VARIABLE NAME 00140328 +C C) ARRAY ELEMENT NAME 00150328 +C D) EXPRESSION INVOLVING OPERATORS 00160328 +C E) EXPRESSION ENCLOSED IN PARENTHESES 00170328 +C F) INTRINSIC FUNCTION REFERENCE 00180328 +C G) EXTERNAL FUNCTION REFERENCE 00190328 +C H) STATEMENT FUNCTION REFERENCE 00200328 +C I) ACTUAL ARGUMENT NAME SAME AS DUMMY ARGUMENT NAME 00210328 +C 00220328 +C 2) ACTUAL ARGUMENTS ASSOCIATED TO ARRAY NAME DUMMY 00230328 +C ARGUMENT INCLUDE, 00240328 +C 00250328 +C A) ARRAY NAME 00260328 +C B) ARRAY ELEMENT NAME 00270328 +C 00280328 +C 3) ACTUAL ARGUMENTS ASSOCIATED TO PROCEDURE NAME DUMMY 00290328 +C ARGUMENT INCLUDE, 00300328 +C 00310328 +C A) EXTERNAL FUNCTION NAME 00320328 +C B) INTRINSIC FUNCTION NAME 00330328 +C C) SUBROUTINE NAME 00340328 +C 00350328 +C ALL DATA PASSED TO THE REFERENCED SUBPROGRAMS ARE PASSED VIA 00360328 +C ARGUMENT VALUES, WHILE ALL RESULTS RETURNED TO FM328 ARE 00370328 +C RETURNED VIA VARIABLES IN NAMED COMMON. SUBSET LEVEL ROUTINES 00380328 +C FM026, FM050 AND FM056 ALSO TEST THE USE OF SUBROUTINES. 00390328 +C 00400328 +C REFERENCES. 00410328 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00420328 +C X3.9-1978 00430328 +C 00440328 +C SECTION 2.8, DUMMY ARGUMENTS 00450328 +C SECTION 5.1.2.2, DUMMY ARRAY DECLARATOR 00460328 +C SECTION 5.5, DUMMY AND ACTUAL ARRAYS 00470328 +C SECTION 8.1, DIMENSION STATEMENT 00480328 +C SECTION 8.3, COMMON STATEMENT 00490328 +C SECTION 8.4, TYPE-STATEMENT 00500328 +C SECTION 8.7, EXTERNAL STATEMENT 00510328 +C SECTION 8.8, INTRINSIC STATEMENT 00520328 +C SECTION 15.2, REFERENCING A FUNCTION 00530328 +C SECTION 15.3, INTRINSIC FUNCTIONS 00540328 +C SECTION 15.5, EXTERNAL FUNCTIONS 00550328 +C SECTION 15.6, SUBROUTINES 00560328 +C SECTION 15.9, ARGUMENTS AND COMMON BLOCKS 00570328 +C 00580328 +C 00590328 +C ******************************************************************00600328 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00610328 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00620328 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00630328 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00640328 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00650328 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00660328 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00670328 +C THE RESULT OF EXECUTING THESE TESTS. 00680328 +C 00690328 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00700328 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00710328 +C 00720328 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00730328 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00740328 +C SOFTWARE STANDARDS VALIDATION GROUP 00750328 +C BUILDING 225 RM A266 00760328 +C GAITHERSBURG, MD 20899 00770328 +C ******************************************************************00780328 +C 00790328 +C 00800328 + IMPLICIT LOGICAL (L) 00810328 + IMPLICIT CHARACTER*14 (C) 00820328 +C 00830328 + INTEGER IATN11(2,3) 00840328 + REAL RATN11(3,4) 00850328 + INTEGER FF330 00860328 + DIMENSION IADN11(4), IADN12(4) 00870328 + DIMENSION RADN11(4), RADN12(4) 00880328 + DIMENSION LADN11(4) 00890328 + COMMON /BLK1/IVCN01, RVCN01, LVCN01 00900328 + COMMON IACN11(6), RACN11(10) 00910328 + EXTERNAL FF330, FS335 00920328 + INTRINSIC ABS, IABS, NINT 00930328 + IFOS01(IDON04) = IDON04 + 1 00940328 + RFOS01(RDON04) = RDON04 + 1.0 00950328 + LFOS01(LDON04) = .NOT. LDON04 00960328 +C 00970328 +C 00980328 +C 00990328 +C INITIALIZATION SECTION. 01000328 +C 01010328 +C INITIALIZE CONSTANTS 01020328 +C ******************** 01030328 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01040328 + I01 = 5 01050328 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01060328 + I02 = 6 01070328 +C SYSTEM ENVIRONMENT SECTION 01080328 +C 01090328 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01100328 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01110328 +C (UNIT NUMBER FOR CARD READER). 01120328 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01130328 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01140328 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01150328 +C 01160328 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01170328 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01180328 +C (UNIT NUMBER FOR PRINTER). 01190328 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01200328 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01210328 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01220328 +C 01230328 + IVPASS = 0 01240328 + IVFAIL = 0 01250328 + IVDELE = 0 01260328 + ICZERO = 0 01270328 +C 01280328 +C WRITE OUT PAGE HEADERS 01290328 +C 01300328 + WRITE (I02,90002) 01310328 + WRITE (I02,90006) 01320328 + WRITE (I02,90008) 01330328 + WRITE (I02,90004) 01340328 + WRITE (I02,90010) 01350328 + WRITE (I02,90004) 01360328 + WRITE (I02,90016) 01370328 + WRITE (I02,90001) 01380328 + WRITE (I02,90004) 01390328 + WRITE (I02,90012) 01400328 + WRITE (I02,90014) 01410328 + WRITE (I02,90004) 01420328 +C 01430328 +C 01440328 +C TEST 001 THROUGH TEST 013 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 01450328 +C OF ACTUAL ARGUMENTS TO VARIABLE NAMES USED AS SUBROUTINE 01460328 +C DUMMY ARGUMENTS. INTEGER, REAL AND LOGICAL DUMMY ARGUMENTS ARE 01470328 +C TESTED. 01480328 +C 01490328 +C 01500328 +C **** FCVS PROGRAM 328 - TEST 001 **** 01510328 +C 01520328 +C USE INTEGER, REAL AND LOGICAL CONSTANTS AS ACTUAL ARGUMENTS. 01530328 +C 01540328 + IVTNUM = 1 01550328 + IF (ICZERO) 30010, 0010, 30010 01560328 + 0010 CONTINUE 01570328 + CALL FS329(3, 3.0, .FALSE.) 01580328 + IVCOMP = 1 01590328 + IF (IVCN01 .EQ. 4) IVCOMP = IVCOMP * 2 01600328 + IF (RVCN01 .GE. 3.9995 .AND. RVCN01 .LE. 4.0005) IVCOMP = IVCOMP*301610328 + IF (LVCN01) IVCOMP = IVCOMP * 5 01620328 + IVCORR = 30 01630328 +40010 IF (IVCOMP - 30) 20010, 10010, 20010 01640328 +30010 IVDELE = IVDELE + 1 01650328 + WRITE (I02,80000) IVTNUM 01660328 + IF (ICZERO) 10010, 0021, 20010 01670328 +10010 IVPASS = IVPASS + 1 01680328 + WRITE (I02,80002) IVTNUM 01690328 + GO TO 0021 01700328 +20010 IVFAIL = IVFAIL + 1 01710328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01720328 + 0021 CONTINUE 01730328 +C 01740328 +C **** FCVS PROGRAM 328 - TEST 002 **** 01750328 +C 01760328 +C USE INTEGER, REAL AND LOGICAL VARIABLES AS ACTUAL ARGUMENTS. 01770328 +C 01780328 + IVTNUM = 2 01790328 + IF (ICZERO) 30020, 0020, 30020 01800328 + 0020 CONTINUE 01810328 + IVON01 = 7 01820328 + RVON01 = 7.0 01830328 + LVON01 = .TRUE. 01840328 + CALL FS329(IVON01, RVON01, LVON01) 01850328 + IVCOMP = 1 01860328 + IF (IVCN01 .EQ. 8) IVCOMP =IVCOMP * 2 01870328 + IF (RVCN01 .GE. 7.9995 .AND. RVCN01 .LE. 8.0005) IVCOMP = IVCOMP*301880328 + IF (.NOT. LVCN01) IVCOMP = IVCOMP * 5 01890328 + IVCORR = 30 01900328 +40020 IF (IVCOMP - 30) 20020, 10020, 20020 01910328 +30020 IVDELE = IVDELE + 1 01920328 + WRITE (I02,80000) IVTNUM 01930328 + IF (ICZERO) 10020, 0031, 20020 01940328 +10020 IVPASS = IVPASS + 1 01950328 + WRITE (I02,80002) IVTNUM 01960328 + GO TO 0031 01970328 +20020 IVFAIL = IVFAIL + 1 01980328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01990328 + 0031 CONTINUE 02000328 +C 02010328 +C **** FCVS PROGRAM 328 - TEST 003 **** 02020328 +C 02030328 +C USE INTEGER, REAL AND LOGICAL ARRAY ELEMENT NAMES AS ACTUAL 02040328 +C ARGUMENTS. 02050328 +C 02060328 + IVTNUM = 3 02070328 + IF (ICZERO) 30030, 0030, 30030 02080328 + 0030 CONTINUE 02090328 + IADN11(2) = 2 02100328 + RADN11(4) = 4.0 02110328 + LADN11(1) = .FALSE. 02120328 + CALL FS329(IADN11(2), RADN11(4), LADN11(1)) 02130328 + IVCOMP = 1 02140328 + IF (IVCN01 .EQ. 3) IVCOMP = IVCOMP * 2 02150328 + IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*302160328 + IF (LVCN01) IVCOMP = IVCOMP * 5 02170328 + IVCORR = 30 02180328 +40030 IF (IVCOMP - 30) 20030, 10030, 20030 02190328 +30030 IVDELE = IVDELE + 1 02200328 + WRITE (I02,80000) IVTNUM 02210328 + IF (ICZERO) 10030, 0041, 20030 02220328 +10030 IVPASS = IVPASS + 1 02230328 + WRITE (I02,80002) IVTNUM 02240328 + GO TO 0041 02250328 +20030 IVFAIL = IVFAIL + 1 02260328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02270328 + 0041 CONTINUE 02280328 +C 02290328 +C **** FCVS PROGRAM 328 - TEST 004 **** 02300328 +C 02310328 +C INTEGER AND REAL EXPRESSIONS INVOLVING OPERATORS AS ACTUAL 02320328 +C ARGUMENTS. 02330328 +C 02340328 + IVTNUM = 4 02350328 + IF (ICZERO) 30040, 0040, 30040 02360328 + 0040 CONTINUE 02370328 + IVON02 = 2 02380328 + IVON03 = 3 02390328 + RVON02 = 2. 02400328 + RVON03 = 1.2 02410328 + CALL FS329(IVON02 + 3 * IVON03 - 7, RVON02 *RVON03 / .6, .TRUE.) 02420328 + IVCOMP = 1 02430328 + IF (IVCN01 .EQ. 5) IVCOMP = IVCOMP * 2 02440328 + IF (RVCN01 .GE. 4.9995 .AND. RVCN01 .LE. 5.0005) IVCOMP = IVCOMP*302450328 + IVCORR = 6 02460328 +40040 IF (IVCOMP - 6) 20040, 10040, 20040 02470328 +30040 IVDELE = IVDELE + 1 02480328 + WRITE (I02,80000) IVTNUM 02490328 + IF (ICZERO) 10040, 0051, 20040 02500328 +10040 IVPASS = IVPASS + 1 02510328 + WRITE (I02,80002) IVTNUM 02520328 + GO TO 0051 02530328 +20040 IVFAIL = IVFAIL + 1 02540328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02550328 + 0051 CONTINUE 02560328 +C 02570328 +C **** FCVS PROGRAM 328 - TEST 005 **** 02580328 +C 02590328 +C REAL EXPRESSION INVOLVING INTEGER AND REAL PRIMARIES AND OPERATORS02600328 +C AS ACTUAL ARGUMENT. 02610328 +C 02620328 + IVTNUM = 5 02630328 + IF (ICZERO) 30050, 0050, 30050 02640328 + 0050 CONTINUE 02650328 + RVCOMP = 0.0 02660328 + IVON01 = 2 02670328 + RADN11(2) = 2.5 02680328 + CALL FS329(1, IVON01**3 * (RADN11(2) - 1) + 2.0, .TRUE.) 02690328 + RVCOMP = RVCN01 02700328 + RVCORR = 15.0 02710328 +40050 IF (RVCOMP - 14.995) 20050, 10050, 40051 02720328 +40051 IF (RVCOMP - 15.005) 10050, 10050, 20050 02730328 +30050 IVDELE = IVDELE + 1 02740328 + WRITE (I02,80000) IVTNUM 02750328 + IF (ICZERO) 10050, 0061, 20050 02760328 +10050 IVPASS = IVPASS + 1 02770328 + WRITE (I02,80002) IVTNUM 02780328 + GO TO 0061 02790328 +20050 IVFAIL = IVFAIL + 1 02800328 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02810328 + 0061 CONTINUE 02820328 +C 02830328 +C **** FCVS PROGRAM 328 - TEST 006 **** 02840328 +C 02850328 +C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.NOT.) AS ACTUAL 02860328 +C ARGUMENT. 02870328 +C 02880328 + IVTNUM = 6 02890328 + IF (ICZERO) 30060, 0060, 30060 02900328 + 0060 CONTINUE 02910328 + LVON01 = .TRUE. 02920328 + CALL FS329(1, 1.0, .NOT. LVON01) 02930328 + IVCOMP = 0 02940328 + IF (LVCN01) IVCOMP = 1 02950328 + IVCORR = 1 02960328 +40060 IF (IVCOMP - 1) 20060, 10060, 20060 02970328 +30060 IVDELE = IVDELE + 1 02980328 + WRITE (I02,80000) IVTNUM 02990328 + IF (ICZERO) 10060, 0071, 20060 03000328 +10060 IVPASS = IVPASS + 1 03010328 + WRITE (I02,80002) IVTNUM 03020328 + GO TO 0071 03030328 +20060 IVFAIL = IVFAIL + 1 03040328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03050328 + 0071 CONTINUE 03060328 +C 03070328 +C **** FCVS PROGRAM 328 - TEST 007 **** 03080328 +C 03090328 +C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.OR.) AS ACTIVE 03100328 +C ARGUMENT. 03110328 +C 03120328 + IVTNUM = 7 03130328 + IF (ICZERO) 30070, 0070, 30070 03140328 + 0070 CONTINUE 03150328 + LVON01 = .TRUE. 03160328 + LVON02 = .FALSE. 03170328 + CALL FS329(1, 1.0, LVON01 .OR. LVON02) 03180328 + IVCOMP = 0 03190328 + IF (.NOT. LVCN01) IVCOMP = 1 03200328 + IVCORR = 1 03210328 +40070 IF (IVCOMP - 1) 20070, 10070, 20070 03220328 +30070 IVDELE = IVDELE + 1 03230328 + WRITE (I02,80000) IVTNUM 03240328 + IF (ICZERO) 10070, 0081, 20070 03250328 +10070 IVPASS = IVPASS + 1 03260328 + WRITE (I02,80002) IVTNUM 03270328 + GO TO 0081 03280328 +20070 IVFAIL = IVFAIL + 1 03290328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03300328 + 0081 CONTINUE 03310328 +C 03320328 +C **** FCVS PROGRAM 328 - TEST 008 **** 03330328 +C 03340328 +C LOGICAL EXPRESSION INVOLVING LOGICAL OPERATOR (.AND.) AS ACTUAL 03350328 +C ARGUMENT. 03360328 +C 03370328 + IVTNUM = 8 03380328 + IF (ICZERO) 30080, 0080, 30080 03390328 + 0080 CONTINUE 03400328 + LVON01 = .FALSE. 03410328 + LVON02 = .TRUE. 03420328 + CALL FS329(1, 1.0, LVON01 .AND. LVON02) 03430328 + IVCOMP = 0 03440328 + IF (LVCN01) IVCOMP = 1 03450328 + IVCORR = 1 03460328 +40080 IF (IVCOMP - 1) 20080, 10080, 20080 03470328 +30080 IVDELE = IVDELE + 1 03480328 + WRITE (I02,80000) IVTNUM 03490328 + IF (ICZERO) 10080, 0091, 20080 03500328 +10080 IVPASS = IVPASS + 1 03510328 + WRITE (I02,80002) IVTNUM 03520328 + GO TO 0091 03530328 +20080 IVFAIL = IVFAIL + 1 03540328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03550328 + 0091 CONTINUE 03560328 +C 03570328 +C **** FCVS PROGRAM 328 - TEST 009 **** 03580328 +C 03590328 +C EXPRESSION ENCLOSED IN PARENTHESES AS ACTUAL ARGUMENT. 03600328 +C 03610328 + IVTNUM = 9 03620328 + IF (ICZERO) 30090, 0090, 30090 03630328 + 0090 CONTINUE 03640328 + IVCOMP = 0 03650328 + IVON01 = 6 03660328 + CALL FS329((IVON01 + 3), 1.0, .TRUE.) 03670328 + IVCOMP = IVCN01 03680328 + IVCORR = 10 03690328 +40090 IF (IVCOMP - 10) 20090, 10090, 20090 03700328 +30090 IVDELE = IVDELE + 1 03710328 + WRITE (I02,80000) IVTNUM 03720328 + IF (ICZERO) 10090, 0101, 20090 03730328 +10090 IVPASS = IVPASS + 1 03740328 + WRITE (I02,80002) IVTNUM 03750328 + GO TO 0101 03760328 +20090 IVFAIL = IVFAIL + 1 03770328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03780328 + 0101 CONTINUE 03790328 +C 03800328 +C **** FCVS PROGRAM 328 - TEST 010 **** 03810328 +C 03820328 +C INTEGER AND REAL INTRINSIC FUNCTION REFERENCES AS ACTUAL ARGUMENTS03830328 +C 03840328 + IVTNUM = 10 03850328 + IF (ICZERO) 30100, 0100, 30100 03860328 + 0100 CONTINUE 03870328 + RVON01 = 4.7 03880328 + RVON02 = -5.2 03890328 + CALL FS329(NINT(RVON01), ABS(RVON02), .TRUE.) 03900328 + IVCOMP = 1 03910328 + IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2 03920328 + IF (RVCN01 .GE. 6.1995 .AND. RVCN01 .LE. 6.2005) IVCOMP = IVCOMP*303930328 + IVCORR = 6 03940328 +40100 IF (IVCOMP - 6) 20100, 10100, 20100 03950328 +30100 IVDELE = IVDELE + 1 03960328 + WRITE (I02,80000) IVTNUM 03970328 + IF (ICZERO) 10100, 0111, 20100 03980328 +10100 IVPASS = IVPASS + 1 03990328 + WRITE (I02,80002) IVTNUM 04000328 + GO TO 0111 04010328 +20100 IVFAIL = IVFAIL + 1 04020328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04030328 + 0111 CONTINUE 04040328 +C 04050328 +C **** FCVS PROGRAM 328 - TEST 011 **** 04060328 +C 04070328 +C EXTERNAL FUNCTION REFERENCE AS ACTUAL ARGUMENT. 04080328 +C 04090328 + IVTNUM = 11 04100328 + IF (ICZERO) 30110, 0110, 30110 04110328 + 0110 CONTINUE 04120328 + IVCOMP = 0 04130328 + IVON01 = 4 04140328 + CALL FS329(FF330(IVON01), 1.0, .TRUE.) 04150328 + IVCOMP = IVCN01 04160328 + IVCORR = 6 04170328 +40110 IF (IVCOMP - 6) 20110, 10110, 20110 04180328 +30110 IVDELE = IVDELE + 1 04190328 + WRITE (I02,80000) IVTNUM 04200328 + IF (ICZERO) 10110, 0121, 20110 04210328 +10110 IVPASS = IVPASS + 1 04220328 + WRITE (I02,80002) IVTNUM 04230328 + GO TO 0121 04240328 +20110 IVFAIL = IVFAIL + 1 04250328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04260328 + 0121 CONTINUE 04270328 +C 04280328 +C **** FCVS PROGRAM 328 - TEST 012 **** 04290328 +C 04300328 +C USE ACTUAL ARGUMENT NAMES WHICH ARE IDENTICAL TO THE DUMMY 04310328 +C ARGUMENT NAMES. 04320328 +C 04330328 + IVTNUM = 12 04340328 + IF (ICZERO) 30120, 0120, 30120 04350328 + 0120 CONTINUE 04360328 + IDON01 = 10 04370328 + RDON01 = 10.0 04380328 + LDON01 = .FALSE. 04390328 + CALL FS329(IDON01, RDON01, LDON01) 04400328 + IVCOMP = 1 04410328 + IF (IVCN01 .EQ. 11) IVCOMP = IVCOMP * 2 04420328 + IF (RVCN01 .GE. 10.995 .AND. RVCN01 .LE. 11.005) IVCOMP = IVCOMP*304430328 + IF (LVCN01) IVCOMP = IVCOMP * 5 04440328 + IVCORR = 30 04450328 +40120 IF (IVCOMP - 30) 20120, 10120, 20120 04460328 +30120 IVDELE = IVDELE + 1 04470328 + WRITE (I02,80000) IVTNUM 04480328 + IF (ICZERO) 10120, 0131, 20120 04490328 +10120 IVPASS = IVPASS + 1 04500328 + WRITE (I02,80002) IVTNUM 04510328 + GO TO 0131 04520328 +20120 IVFAIL = IVFAIL + 1 04530328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04540328 + 0131 CONTINUE 04550328 +C 04560328 +C **** FCVS PROGRAM 328 - TEST 013 **** 04570328 +C 04580328 +C USE INTEGER, REAL AND LOGICAL STATEMENT FUNCTION REFERENCES AS 04590328 +C ARGUMENT NAMES. 04600328 +C 04610328 + IVTNUM = 13 04620328 + IF (ICZERO) 30130, 0130, 30130 04630328 + 0130 CONTINUE 04640328 + RVON01 = 5.0 04650328 + CALL FS329(IFOS01(4), RFOS01(RVON01), LFOS01(.TRUE.)) 04660328 + IVCOMP = 1 04670328 + IF (IVCN01 .EQ. 6) IVCOMP = IVCOMP * 2 04680328 + IF (RVCN01 .GE. 6.9995 .AND. RVCN01 .LE. 7.0005) IVCOMP = IVCOMP*304690328 + IF (LVCN01) IVCOMP = IVCOMP * 5 04700328 + IVCORR = 30 04710328 +40130 IF (IVCOMP - 30) 20130, 10130, 20130 04720328 +30130 IVDELE = IVDELE + 1 04730328 + WRITE (I02,80000) IVTNUM 04740328 + IF (ICZERO) 10130, 0141, 20130 04750328 +10130 IVPASS = IVPASS + 1 04760328 + WRITE (I02,80002) IVTNUM 04770328 + GO TO 0141 04780328 +20130 IVFAIL = IVFAIL + 1 04790328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04800328 + 0141 CONTINUE 04810328 +C 04820328 +C TEST 014 THROUGH TEST 019 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 04830328 +C OF ACTUAL ARGUMENTS TO ARRAY NAMES USED AS SUBROUTINE DUMMY 04840328 +C ARGUMENTS. 04850328 +C 04860328 +C 04870328 +C **** FCVS PROGRAM 328 - TEST 014 **** 04880328 +C 04890328 +C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 04900328 +C ARGUMENT ARRAY DECLARATOR IS IDENTICAL TO THE ASSOCIATED DUMMY 04910328 +C ARGUMENT ARRAY DECLARATOR. 04920328 +C 04930328 + IVTNUM = 14 04940328 + IF (ICZERO) 30140, 0140, 30140 04950328 + 0140 CONTINUE 04960328 + IVCOMP = 0 04970328 + IADN12(1) = 1 04980328 + IADN12(2) = 10 04990328 + IADN12(3) = 100 05000328 + IADN12(4) = 1000 05010328 + CALL FS331(IADN12) 05020328 + IVCOMP = IVCN01 05030328 + IVCORR = 1111 05040328 +40140 IF (IVCOMP - 1111) 20140, 10140, 20140 05050328 +30140 IVDELE = IVDELE + 1 05060328 + WRITE (I02,80000) IVTNUM 05070328 + IF (ICZERO) 10140, 0151, 20140 05080328 +10140 IVPASS = IVPASS + 1 05090328 + WRITE (I02,80002) IVTNUM 05100328 + GO TO 0151 05110328 +20140 IVFAIL = IVFAIL + 1 05120328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05130328 + 0151 CONTINUE 05140328 +C 05150328 +C **** FCVS PROGRAM 328 - TEST 015 **** 05160328 +C 05170328 +C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE OF THE 05180328 +C ACTUAL ARGUMENT ARRAY IS LARGER THAN THE SIZE OF THE ASSOCIATED 05190328 +C DUMMY ARGUMENT ARRAY. 05200328 +C 05210328 + IVTNUM = 15 05220328 + IF (ICZERO) 30150, 0150, 30150 05230328 + 0150 CONTINUE 05240328 + IVCOMP = 0 05250328 + IACN11(1) = 1 05260328 + IACN11(2) = 10 05270328 + IACN11(3) = 100 05280328 + IACN11(4) = 1000 05290328 + IACN11(5) = 10000 05300328 + CALL FS331(IACN11) 05310328 + IVCOMP = IVCN01 05320328 + IVCORR = 1111 05330328 +40150 IF (IVCOMP - 1111) 20150, 10150, 20150 05340328 +30150 IVDELE = IVDELE + 1 05350328 + WRITE (I02,80000) IVTNUM 05360328 + IF (ICZERO) 10150, 0161, 20150 05370328 +10150 IVPASS = IVPASS + 1 05380328 + WRITE (I02,80002) IVTNUM 05390328 + GO TO 0161 05400328 +20150 IVFAIL = IVFAIL + 1 05410328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05420328 + 0161 CONTINUE 05430328 +C 05440328 +C **** FCVS PROGRAM 328 - TEST 016 **** 05450328 +C 05460328 +C USE AN ARRAY NAME AS AN ACTUAL ARGUMENT IN WHICH THE ACTUAL 05470328 +C ARGUMENT ARRAY DECLARATOR IS LARGER AND HAS MORE SUBSCRIPT 05480328 +C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARGUMENT ARRAY DECLARATOR. 05490328 +C 05500328 + IVTNUM = 16 05510328 + IF (ICZERO) 30160, 0160, 30160 05520328 + 0160 CONTINUE 05530328 + IVCOMP = 0 05540328 + IATN11(1,1) = 1 05550328 + IATN11(2,1) = 10 05560328 + IATN11(1,2) = 100 05570328 + IATN11(2,2) = 1000 05580328 + IATN11(1,3) = 10000 05590328 + CALL FS331(IATN11) 05600328 + IVCOMP = IVCN01 05610328 + IVCORR = 1111 05620328 +40160 IF (IVCOMP - 1111) 20160, 10160, 20160 05630328 +30160 IVDELE = IVDELE + 1 05640328 + WRITE (I02,80000) IVTNUM 05650328 + IF (ICZERO) 10160, 0171, 20160 05660328 +10160 IVPASS = IVPASS + 1 05670328 + WRITE (I02,80002) IVTNUM 05680328 + GO TO 0171 05690328 +20160 IVFAIL = IVFAIL + 1 05700328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05710328 + 0171 CONTINUE 05720328 +C 05730328 +C **** FCVS PROGRAM 328 - TEST 017 **** 05740328 +C 05750328 +C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE 05760328 +C ASSOCIATED ACTUAL AND DUMMY ARRAY DECLARATORS ARE IDENTICAL. ALL 05770328 +C ARRAY ELEMENTS OF THE ACTUAL ARRAY SHOULD BE PASSED TO THE 05780328 +C DUMMY ARRAY OF THE SUBROUTINE. 05790328 +C 05800328 + IVTNUM = 17 05810328 + IF (ICZERO) 30170, 0170, 30170 05820328 + 0170 CONTINUE 05830328 + RVCOMP = 0.0 05840328 + RADN12(1) = 1. 05850328 + RADN12(2) = 10. 05860328 + RADN12(3) = 100. 05870328 + RADN12(4) = 1000. 05880328 + CALL FS332(RADN12(1)) 05890328 + RVCOMP = RVCN01 05900328 + RVCORR = 1111. 05910328 +40170 IF (RVCOMP - 1110.5) 20170, 10170, 40171 05920328 +40171 IF (RVCOMP - 1111.5) 10170, 10170, 20170 05930328 +30170 IVDELE = IVDELE + 1 05940328 + WRITE (I02,80000) IVTNUM 05950328 + IF (ICZERO) 10170, 0181, 20170 05960328 +10170 IVPASS = IVPASS + 1 05970328 + WRITE (I02,80002) IVTNUM 05980328 + GO TO 0181 05990328 +20170 IVFAIL = IVFAIL + 1 06000328 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06010328 + 0181 CONTINUE 06020328 +C 06030328 +C **** FCVS PROGRAM 328 - TEST 018 **** 06040328 +C 06050328 +C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 06060328 +C OF THE ACTUAL ARGUMENT ARRAY IS LARGER AND HAS FEWER SUBSCRIPT 06070328 +C EXPRESSIONS THAN THE ASSOCIATED DUMMY ARRAY. ONLY ACTUAL ARRAY 06080328 +C ELEMENTS WITH SUBSCRIPT VALUES OF 5, 6, 7 AND 8 ( OUT OF A 06090328 +C POSSIBLE 10 ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF 06100328 +C THE SUBROUTINE. 06110328 +C 06120328 + IVTNUM = 18 06130328 + IF (ICZERO) 30180, 0180, 30180 06140328 + 0180 CONTINUE 06150328 + RVCOMP = 0.0 06160328 + RACN11(4) = 1. 06170328 + RACN11(5) = 10. 06180328 + RACN11(6) = 100. 06190328 + RACN11(7) = 1000. 06200328 + RACN11(8) = 10000. 06210328 + RACN11(9) = 100000. 06220328 + CALL FS332(RACN11(5)) 06230328 + RVCOMP = RVCN01 06240328 + RVCORR = 11110. 06250328 +40180 IF (RVCOMP - 11105.) 20180, 10180, 40181 06260328 +40181 IF (RVCOMP - 11115.) 10180, 10180, 20180 06270328 +30180 IVDELE = IVDELE + 1 06280328 + WRITE (I02,80000) IVTNUM 06290328 + IF (ICZERO) 10180, 0191, 20180 06300328 +10180 IVPASS = IVPASS + 1 06310328 + WRITE (I02,80002) IVTNUM 06320328 + GO TO 0191 06330328 +20180 IVFAIL = IVFAIL + 1 06340328 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06350328 + 0191 CONTINUE 06360328 +C 06370328 +C **** FCVS PROGRAM 328 - TEST 019 **** 06380328 +C 06390328 +C USE AN ARRAY ELEMENT NAME AS AN ACTUAL ARGUMENT IN WHICH THE SIZE 06400328 +C OF THE ACTUAL ARGUMENT ARRAY IS LARGE THAN THE SIZE OF THE 06410328 +C ASSOCIATED DUMMY ARGUMENT ARRAY. ONLY ACTUAL ARRAY ELEMENTS WITH 06420328 +C SUBSCRIPT VALUES OF 9, 10, 11 AND 12 (OUT OF A POSSIBLE 12 06430328 +C ELEMENTS) SHOULD BE PASSED TO THE DUMMY ARRAY OF THE SUBROUTINE. 06440328 +C 06450328 + IVTNUM = 19 06460328 + IF (ICZERO) 30190, 0190, 30190 06470328 + 0190 CONTINUE 06480328 + RVCOMP = 0.0 06490328 + RATN11(2,3) = 1. 06500328 + RATN11(3,3) = 10. 06510328 + RATN11(1,4) = 100. 06520328 + RATN11(2,4) = 1000. 06530328 + RATN11(3,4) = 10000. 06540328 + CALL FS332(RATN11(3,3)) 06550328 + RVCOMP = RVCN01 06560328 + RVCORR = 11110. 06570328 +40190 IF (RVCOMP - 11105.) 20190, 10190, 40191 06580328 +40191 IF (RVCOMP - 11115.) 10190, 10190, 20190 06590328 +30190 IVDELE = IVDELE + 1 06600328 + WRITE (I02,80000) IVTNUM 06610328 + IF (ICZERO) 10190, 0201, 20190 06620328 +10190 IVPASS = IVPASS + 1 06630328 + WRITE (I02,80002) IVTNUM 06640328 + GO TO 0201 06650328 +20190 IVFAIL = IVFAIL + 1 06660328 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06670328 + 0201 CONTINUE 06680328 +C 06690328 +C TEST 020 THROUGH TEST 022 ARE DESIGNED TO ASSOCIATE VARIOUS FORMS 06700328 +C OF ACTUAL ARGUMENTS TO PROCEDURES USED AS SUBROUTINE DUMMY 06710328 +C ARGUMENTS. ACTUAL ARGUMENTS TESTED INCLUDE THE NAMES OF AN 06720328 +C EXTERNAL FUNCTION, AN INTRINSIC FUNCTION AND A SUBROUTINE. 06730328 +C 06740328 +C 06750328 +C **** FCVS PROGRAM 328 - TEST 020 **** 06760328 +C 06770328 +C USE AN EXTERNAL FUNCTION NAME AS AN ACTUAL ARGUMENT. 06780328 +C 06790328 + IVTNUM = 20 06800328 + IF (ICZERO) 30200, 0200, 30200 06810328 + 0200 CONTINUE 06820328 + IVCOMP = 0 06830328 + CALL FS333(FF330, 5) 06840328 + IVCOMP = IVCN01 06850328 + IVCORR = 7 06860328 +40200 IF (IVCOMP - 7) 20200, 10200, 20200 06870328 +30200 IVDELE = IVDELE + 1 06880328 + WRITE (I02,80000) IVTNUM 06890328 + IF (ICZERO) 10200, 0211, 20200 06900328 +10200 IVPASS = IVPASS + 1 06910328 + WRITE (I02,80002) IVTNUM 06920328 + GO TO 0211 06930328 +20200 IVFAIL = IVFAIL + 1 06940328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06950328 + 0211 CONTINUE 06960328 +C 06970328 +C **** FCVS PROGRAM 328 - TEST 021 **** 06980328 +C 06990328 +C USE AN INTRINSIC FUNCTION NAME AS AN ACTUAL ARGUMENT. 07000328 +C 07010328 + IVTNUM = 21 07020328 + IF (ICZERO) 30210, 0210, 30210 07030328 + 0210 CONTINUE 07040328 + IVCOMP = 0 07050328 + CALL FS333(IABS, -7) 07060328 + IVCOMP = IVCN01 07070328 + IVCORR = 8 07080328 +40210 IF (IVCOMP - 8) 20210, 10210, 20210 07090328 +30210 IVDELE = IVDELE + 1 07100328 + WRITE (I02,80000) IVTNUM 07110328 + IF (ICZERO) 10210, 0221, 20210 07120328 +10210 IVPASS = IVPASS + 1 07130328 + WRITE (I02,80002) IVTNUM 07140328 + GO TO 0221 07150328 +20210 IVFAIL = IVFAIL + 1 07160328 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07170328 + 0221 CONTINUE 07180328 +C 07190328 +C **** FCVS PROGRAM 328 - TEST 022 **** 07200328 +C 07210328 +C USE A SUBROUTINE NAME AS AN ACTUAL ARGUMENT. 07220328 +C 07230328 + IVTNUM = 22 07240328 + IF (ICZERO) 30220, 0220, 30220 07250328 + 0220 CONTINUE 07260328 + RVCOMP = 0.0 07270328 + RVON01 = 3.5 07280328 + CALL FS334(FS335, RVON01) 07290328 + RVCOMP = RVCN01 07300328 + RVCORR = 5.5 07310328 +40220 IF (RVCOMP - 5.4995) 20220, 10220, 40221 07320328 +40221 IF (RVCOMP - 5.5005) 10220, 10220, 20220 07330328 +30220 IVDELE = IVDELE + 1 07340328 + WRITE (I02,80000) IVTNUM 07350328 + IF (ICZERO) 10220, 0231, 20220 07360328 +10220 IVPASS = IVPASS + 1 07370328 + WRITE (I02,80002) IVTNUM 07380328 + GO TO 0231 07390328 +20220 IVFAIL = IVFAIL + 1 07400328 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07410328 + 0231 CONTINUE 07420328 +C 07430328 +C 07440328 +C WRITE OUT TEST SUMMARY 07450328 +C 07460328 + WRITE (I02,90004) 07470328 + WRITE (I02,90014) 07480328 + WRITE (I02,90004) 07490328 + WRITE (I02,90000) 07500328 + WRITE (I02,90004) 07510328 + WRITE (I02,90020) IVFAIL 07520328 + WRITE (I02,90022) IVPASS 07530328 + WRITE (I02,90024) IVDELE 07540328 + STOP 07550328 +90001 FORMAT (" ",24X,"FM328") 07560328 +90000 FORMAT (" ",20X,"END OF PROGRAM FM328" ) 07570328 +C 07580328 +C FORMATS FOR TEST DETAIL LINES 07590328 +C 07600328 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 07610328 +80002 FORMAT (" ",4X,I5,7X,"PASS") 07620328 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 07630328 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 07640328 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 07650328 +C 07660328 +C FORMAT STATEMENTS FOR PAGE HEADERS 07670328 +C 07680328 +90002 FORMAT ("1") 07690328 +90004 FORMAT (" ") 07700328 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07710328 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 07720328 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 07730328 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 07740328 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 07750328 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 07760328 +C 07770328 +C FORMAT STATEMENTS FOR RUN SUMMARY 07780328 +C 07790328 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 07800328 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 07810328 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 07820328 + END 07830328 + + SUBROUTINE FS329(IDON01, RDON01, LDON01) 00010329 +C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020329 +C FM328 TO TEST THE DIFFERENT FORMS OF INTEGER, REAL AND LOGICAL 00030329 +C ACTUAL ARGUMENTS THAT CAN BE ASSOCIATED WITH INTEGER, REAL AND 00040329 +C LOGICAL DUMMY ARGUMENTS. THIS ROUTINE INCREMENTS THE INTEGER 00050329 +C AND REAL ARGUMENTS BY ONE AND NEGATES THE LOGICAL ARGUMENT. ALL 00060329 +C RESULTS ARE THEN RETURNED TO FM328 VIA VARIABLES IN NAMED COMMON. 00070329 + IMPLICIT LOGICAL (L) 00080329 + COMMON /BLK1/ IVCN01, RVCN01, LVCN01 00090329 + IVCN01 = IDON01 + 1 00100329 + RVCN01 = RDON01 + 1.0 00110329 + LVCN01 = .NOT. LDON01 00120329 + RETURN 00130329 + END 00140329 + + INTEGER FUNCTION FF330(IDON02) 00010330 +C THIS FUNCTION IS USED BY TEST 011 OF THE MAIN PROGRAM FM328 TO00020330 +C TEST THE USE OF AN EXTERNAL FUNCTION REFERENCE AS AN ACTUAL 00030330 +C ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS A VARIABLE NAME. 00040330 +C THIS FUNCTION IS ALSO REFERENCED FROM SUBROUTINE FS333 VIA A 00050330 +C DUMMY PROCEDURE NAME REFERENCE. THIS FUNCTION INCREMENTS THE 00060330 +C ARGUMENT VALUE BY ONE AND RETURNS THE RESULT AS THE FUNCTION 00070330 +C VALUE. 00080330 + FF330 = IDON02 + 1 00090330 + RETURN 00100330 + END 00110330 + + SUBROUTINE FS331(IDDN11) 00010331 +C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020331 +C FM328 TO TEST THE USE OF AN ARRAY NAME AS AN ACTUAL ARGUMENT WHEN 00030331 +C THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME. THIS ROUTINE 00040331 +C ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY ARGUMENT ARRAY AND 00050331 +C RETURNS THE RESULTS VIA A VARIABLE IN NAMED COMMON. 00060331 + LOGICAL LVCN01 00070331 + DIMENSION IDDN11(4) 00080331 + COMMON /BLK1/IVCN01, RVCN01, LVCN01 00090331 + IVCN01 = IDDN11(1) + IDDN11(2) + IDDN11(3) + IDDN11(4) 00100331 + RETURN 00110331 + END 00120331 + + SUBROUTINE FS332(RDTN21) 00010332 +C THIS SUBROUTINE IS USED BY VARIOUS TESTS IN THE MAIN PROGRAM 00020332 +C FM328 TO TEST THE USE OF AN ARRAY ELEMENT NAME AS AN ACTUAL 00030332 +C ARGUMENT WHEN THE ASSOCIATED DUMMY ARGUMENT IS AN ARRAY NAME. 00040332 +C THIS ROUTINE ADDS TOGETHER THE FOUR ELEMENTS IN THE DUMMY 00050332 +C ARGUMENT ARRAY AND RETURNS THE RESULT VIA A VARIABLE IN NAMED 00060332 +C COMMON. 00070332 + IMPLICIT LOGICAL (L) 00080332 + REAL RDTN21(2,2) 00090332 + COMMON /BLK1/IVCN01, RVCN01, LVCN01 00100332 + RVCN01 = RDTN21(1,1) + RDTN21(2,1) + RDTN21(1,2) + RDTN21(2,2) 00110332 + RETURN 00120332 + END 00130332 + + SUBROUTINE FS333(NINT, IDON03) 00010333 +C THIS SUBROUTINE IS USED BY TESTS 020 AND 021 OF THE MAIN 00020333 +C PROGRAM FM328 TO TEST THE USE OF EXTERNAL AND INTRINSIC FUNCTION 00030333 +C NAMES AS ACTUAL ARGUMENTS WHEN THE ASSOCIATED DUMMY ARGUMENT IS A 00040333 +C PROCEDURE NAME. THIS SUBROUTINE REFERENCES THE EXTERNAL FUNCTION 00050333 +C FF330 OR THE INTRINSIC FUNCTION IABS DEPENDING ON THE ACTUAL 00060333 +C ARGUMENT PASSED TO IT. THE RESULT OF THIS FUNCTION REFERENCE IS 00070333 +C THEN INCREMENTED BY ONE AND THE RESULT IS RETURNED TO FS328 VIA 00080333 +C A VARIABLE IN NAMED COMMON. 00090333 + IMPLICIT LOGICAL (L) 00100333 + COMMON /BLK1/IVCN01, RVCN01, LVCN01 00110333 + IVCN01 = NINT(IDON03) + 1 00120333 +C **** THE NAME NINT IS A DUMMY ARGUMENT NAME 00130333 +C AND NOT AN INTRINSIC FUNCTION REFERENCE **** 00140333 + RETURN 00150333 + END 00160333 + + SUBROUTINE FS334(IDON06, RDON03) 00010334 +C THIS SUBROUTINE IS USED BY TEST 022 OF THE MAIN PROGRAM 00020334 +C FM328 TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT 00030334 +C WHEN THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME. THIS 00040334 +C SUBROUTINE CALLS THE SUBROUTINE FS335 VIA A DUMMY PROCEDURE NAME 00050334 +C REFERENCE. THE ARGUMENT VALUE WHICH IS RETURNED FROM THE FS335 00060334 +C REFERENCE IS THEN INCREMENTED BY ONE AND RETURNED TO FM328 VIA 00070334 +C A VARIABLE IN NAMED COMMON. 00080334 + IMPLICIT LOGICAL (L) 00090334 + COMMON /BLK1/IVCN01, RVCN01, LVCN01 00100334 + CALL IDON06(RDON03) 00110334 + RVCN01 = RDON03 + 1.0 00120334 + RETURN 00130334 + END 00140334 + + SUBROUTINE FS335(RDON04) 00010335 +C THIS SUBROUITNE IS USED BY TEST 022 OF THE MAIN PROGRAM FM32800020335 +C TO TEST THE USE OF A SUBROUTINE NAME AS AN ACTUAL ARGUMENT WHEN 00030335 +C THE ASSOCIATED DUMMY ARGUMENT IS A PROCEDURE NAME. FS335 IS 00040335 +C CALLED FROM SUBROUTINE FS334 VIA A DUMMY PROCEDURE NAME REFERENCE.00050335 +C THIS ROUTINE INCREMENTS THE ARGUMENT VALUE BY ONE. 00060335 + RDON04 = RDON04 + 1.0 00070335 + RETURN 00080335 + END 00090335 diff --git a/Fortran/UnitTests/fcvs21_f95/FM328.reference_output b/Fortran/UnitTests/fcvs21_f95/FM328.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM328.reference_output @@ -0,0 +1,43 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM328 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + + ---------------------------------------------- + + END OF PROGRAM FM328 + + 0 TESTS FAILED + 22 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM351.f b/Fortran/UnitTests/fcvs21_f95/FM351.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM351.f @@ -0,0 +1,901 @@ + PROGRAM FM351 00010351 +C 00020351 +C 00030351 +C THIS PROGRAM CONTAINS TESTS FOR COMPOUND ARITHMETIC 00040351 +C EXPRESSIONS WHICH NECESSITATE THE APPLICATION OF THE RULES 00050351 +C FOR ARITHMETIC OPERATOR PRECEDENCE. THESE TESTS INCLUDE ONES 00060351 +C WHICH EXERCIZE THE 00070351 +C 00080351 +C (1) USE OF ALL ARITHMETIC OPERATOR TYPES IN THE SAME STATEMENT. 00090351 +C (2) USE OF PARENTHESES TO OVERRIDE DEFAULT PRECEDENCES. 00100351 +C (3) USE OF ALL CLASSES OF PRIMARY OPERANDS. 00110351 +C (4) USE OF NESTED FUNCTION REFERENCES. 00120351 +C (5) USE OF MIXED DATA TYPES. 00130351 +C 00140351 +C REFERENCES - 00150351 +C 00160351 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, X3.9-197700170351 +C 00180351 +C SECTION 6.1 ARITHMETIC EXPRESSIONS 00190351 +C SECTION 6.5 PRECEDENCE OF OPERATORS 00200351 +C SECTION 6.6 EVALUATION OF EXPRESSIONS 00210351 +C 00220351 +C 00230351 +C ******************************************************************00240351 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00250351 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00260351 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00270351 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00280351 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00290351 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00300351 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00310351 +C THE RESULT OF EXECUTING THESE TESTS. 00320351 +C 00330351 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00340351 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00350351 +C 00360351 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00370351 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00380351 +C SOFTWARE STANDARDS VALIDATION GROUP 00390351 +C BUILDING 225 RM A266 00400351 +C GAITHERSBURG, MD 20899 00410351 +C ******************************************************************00420351 +C 00430351 +C 00440351 + IMPLICIT LOGICAL (L) 00450351 + IMPLICIT CHARACTER*14 (C) 00460351 +C 00470351 + DIMENSION IADN11(5), RADN11(5) 00480351 + IFOS01(IDON01,IDON02,IDON03) = IDON01 ** IDON02 ** IDON03 00490351 + IFOS02(IDON04,IDON05) = IADN11(IDON04) / IADN11(IDON05) 00500351 + IFOS04(IDON09,IDON10) = IADN11(IDON09) + IABS(IDON10) 00510351 + IFOS03(IDON06,IDON07,IDON08) = IFOS04(IDON06,IDON07) * IDON08 00520351 + RFOS01(RDON01,RDON02,RDON03) = RDON01 ** RDON02 ** RDON03 00530351 + RFOS02(IDON11,IDON12) = RADN11(IDON11) / RADN11(IDON12) 00540351 + RFOS04(IDON13,RDON10) = RADN11(IDON13) + ABS(RDON10) 00550351 + RFOS03(RDON06,RDON07,RDON08) = RFOS04(INT(RDON06),RDON07) * RDON0800560351 + IFOS05(IDON14,IDON16) = RADN11(IDON14) + IABS(IDON16) 00570351 + RFOS06(RDON17,IDON18,RDON19) = IFOS05(INT(RDON17),IDON18) * RDON1900580351 +C 00590351 +C 00600351 +C 00610351 +C INITIALIZATION SECTION. 00620351 +C 00630351 +C INITIALIZE CONSTANTS 00640351 +C ******************** 00650351 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00660351 + I01 = 5 00670351 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00680351 + I02 = 6 00690351 +C SYSTEM ENVIRONMENT SECTION 00700351 +C 00710351 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00720351 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00730351 +C (UNIT NUMBER FOR CARD READER). 00740351 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00750351 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00760351 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00770351 +C 00780351 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00790351 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00800351 +C (UNIT NUMBER FOR PRINTER). 00810351 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00820351 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00830351 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00840351 +C 00850351 + IVPASS = 0 00860351 + IVFAIL = 0 00870351 + IVDELE = 0 00880351 + ICZERO = 0 00890351 +C 00900351 +C WRITE OUT PAGE HEADERS 00910351 +C 00920351 + WRITE (I02,90002) 00930351 + WRITE (I02,90006) 00940351 + WRITE (I02,90008) 00950351 + WRITE (I02,90004) 00960351 + WRITE (I02,90010) 00970351 + WRITE (I02,90004) 00980351 + WRITE (I02,90016) 00990351 + WRITE (I02,90001) 01000351 + WRITE (I02,90004) 01010351 + WRITE (I02,90012) 01020351 + WRITE (I02,90014) 01030351 + WRITE (I02,90004) 01040351 +C 01050351 +C 01060351 +C TESTS 1 THROUGH 10 DEAL ENTIRELY WITH INTEGER EXPRESSIONS. 01070351 +C 01080351 +C 01090351 +C **** FCVS PROGRAM 351 - TEST 001 **** 01100351 +C 01110351 +C TEST 1 CHECKS AN INTEGER EXPRESSION WHERE ALL FIVE ARITHMETIC 01120351 +C OPERATORS ARE USED AND ALL OPERAND PRIMARIES ARE SIMPLE INTEGER 01130351 +C VARIABLES. NO PARENTHESES ARE USED TO UPSET DEFAULT PRECEDENCES. 01140351 +C 01150351 + IVTNUM = 1 01160351 + IF (ICZERO) 30010, 0010, 30010 01170351 + 0010 CONTINUE 01180351 + IVON01 = 7 01190351 + IVON02 = 3 01200351 + IVON03 = 573 01210351 + IVON04 = 23 01220351 + IVON05 = 3 01230351 + IVON06 = -7 01240351 + IVCOMP = IVON01 ** IVON02 + IVON03 - IVON04 * IVON05 / IVON06 01250351 + IVCORR = 925 01260351 +40010 IF (IVCOMP - 925) 20010, 10010, 20010 01270351 +30010 IVDELE = IVDELE + 1 01280351 + WRITE (I02,80000) IVTNUM 01290351 + IF (ICZERO) 10010, 0021, 20010 01300351 +10010 IVPASS = IVPASS + 1 01310351 + WRITE (I02,80002) IVTNUM 01320351 + GO TO 0021 01330351 +20010 IVFAIL = IVFAIL + 1 01340351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01350351 + 0021 CONTINUE 01360351 +C 01370351 +C **** FCVS PROGRAM 351 - TEST 002 **** 01380351 +C 01390351 +C TEST 2, LIKE TEST 1, CHECKS AN INTEGER EXPRESSION WHERE ALL 01400351 +C FIVE ARITHMETIC OPERATORS ARE USED AND ALL OPERANDS ARE SIMPLE 01410351 +C INTEGER VARIABLES; BUT IN THIS TEST, PARENTHESES ARE USED, AS IS 01420351 +C A UNARY OPERATOR. 01430351 +C 01440351 + IVTNUM = 2 01450351 + IF (ICZERO) 30020, 0020, 30020 01460351 + 0020 CONTINUE 01470351 + IVON01 = 7 01480351 + IVON02 = 3 01490351 + IVON03 = 5 01500351 + IVON04 = -3 01510351 + IVON05 = 3 01520351 + IVCOMP = -(IVON01 / IVON02) + (IVON03 * IVON04 ** IVON05) 01530351 + IVCORR = -137 01540351 +40020 IF (IVCOMP + 137) 20020, 10020, 20020 01550351 +30020 IVDELE = IVDELE + 1 01560351 + WRITE (I02,80000) IVTNUM 01570351 + IF (ICZERO) 10020, 0031, 20020 01580351 +10020 IVPASS = IVPASS + 1 01590351 + WRITE (I02,80002) IVTNUM 01600351 + GO TO 0031 01610351 +20020 IVFAIL = IVFAIL + 1 01620351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01630351 + 0031 CONTINUE 01640351 +C 01650351 +C **** FCVS PROGRAM 351 - TEST 003 **** 01660351 +C 01670351 +C TEST 3 IS SIMILAR TO TEST 2 EXCEPT THAT IT EMPLOYS NESTED 01680351 +C PARENTHESES. 01690351 +C 01700351 + IVTNUM = 3 01710351 + IF (ICZERO) 30030, 0030, 30030 01720351 + 0030 CONTINUE 01730351 + IVON01 = 5 01740351 + IVON02 = 3 01750351 + IVON03 = 5 01760351 + IVON04 = 17 01770351 + IVON05 = 14 01780351 + IVON06 = 3 01790351 + IVCOMP = IVON01 ** (-(IVON02 + (IVON03 - IVON04)) - (IVON05 / 01800351 + 1 IVON06)) 01810351 + IVCORR = 3125 01820351 +40030 IF (IVCOMP - 3125) 20030, 10030, 20030 01830351 +30030 IVDELE = IVDELE + 1 01840351 + WRITE (I02,80000) IVTNUM 01850351 + IF (ICZERO) 10030, 0041, 20030 01860351 +10030 IVPASS = IVPASS + 1 01870351 + WRITE (I02,80002) IVTNUM 01880351 + GO TO 0041 01890351 +20030 IVFAIL = IVFAIL + 1 01900351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01910351 + 0041 CONTINUE 01920351 +C 01930351 +C **** FCVS PROGRAM 351 - TEST 004 **** 01940351 +C 01950351 +C TEST 4 IS SIMILAR TO TEST 2 AND 3 EXCEPT THAT THE 01960351 +C PARENTHESES USED ARE EFFECTIVELY EXTRANEOUS. 01970351 +C 01980351 + IVTNUM = 4 01990351 + IF (ICZERO) 30040, 0040, 30040 02000351 + 0040 CONTINUE 02010351 + IVON01 = 3 02020351 + IVON02 = 4 02030351 + IVON03 = 5 02040351 + IVON04 = 2 02050351 + IVON05 = 3 02060351 + IVON06 = 4 02070351 + IVCOMP = ((IVON01) ** (IVON02) + (IVON03) - (IVON04) * 02080351 + 1 (IVON05) / (IVON06)) 02090351 + IVCORR = 85 02100351 +40040 IF (IVCOMP - 85) 20040, 10040, 20040 02110351 +30040 IVDELE = IVDELE + 1 02120351 + WRITE (I02,80000) IVTNUM 02130351 + IF (ICZERO) 10040, 0051, 20040 02140351 +10040 IVPASS = IVPASS + 1 02150351 + WRITE (I02,80002) IVTNUM 02160351 + GO TO 0051 02170351 +20040 IVFAIL = IVFAIL + 1 02180351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02190351 + 0051 CONTINUE 02200351 +C 02210351 +C **** FCVS PROGRAM 351 - TEST 005 **** 02220351 +C 02230351 +C TEST 5 CONTINUES THE TESTING OF EXPRESSIONS USING ONLY 02240351 +C INTEGER VARIABLE OPERANDS CONNECTED BY ARITHMETIC OPERATORS, 02250351 +C AND USING PARENTHESES TO OVERRIDE PRECEDENCES. 02260351 +C 02270351 + IVTNUM = 5 02280351 + IF (ICZERO) 30050, 0050, 30050 02290351 + 0050 CONTINUE 02300351 + IVON01 = 57 02310351 + IVON02 = -3 02320351 + IVON03 = 4 02330351 + IVON04 = -1 02340351 + IVON05 = -5 02350351 + IVON06 = -2 02360351 + IVCOMP = -IVON01 ** (IVON02 + IVON03 - IVON04) * 02370351 + 1 (IVON05 / IVON06) 02380351 + IVCORR = -6498 02390351 +40050 IF (IVCOMP + 6498) 20050, 10050, 20050 02400351 +30050 IVDELE = IVDELE + 1 02410351 + WRITE (I02,80000) IVTNUM 02420351 + IF (ICZERO) 10050, 0061, 20050 02430351 +10050 IVPASS = IVPASS + 1 02440351 + WRITE (I02,80002) IVTNUM 02450351 + GO TO 0061 02460351 +20050 IVFAIL = IVFAIL + 1 02470351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02480351 + 0061 CONTINUE 02490351 +C 02500351 +C **** FCVS PROGRAM 351 - TEST 006 **** 02510351 +C 02520351 +C TEST 6 CONTINUES THE TESTING OF EXPRESSIONS USING ONLY 02530351 +C INTEGER VARIABLE OPERANDS CONNECTED BY ARITHMETIC OPERATORS, 02540351 +C AND USING PARENTHESES TO OVERRIDE PRECEDENCES. 02550351 +C 02560351 + IVTNUM = 6 02570351 + IF (ICZERO) 30060, 0060, 30060 02580351 + 0060 CONTINUE 02590351 + IVON01 = 5 02600351 + IVON02 = 3 02610351 + IVON03 = 4 02620351 + IVON04 = 5496 02630351 + IVON05 = 7 02640351 + IVON06 = -3 02650351 + IVCOMP = ((IVON01 * (IVON02 / IVON03)) + IVON04) / IVON05 - 02660351 + 1 (-IVON06) 02670351 + IVCORR = 782 02680351 +40060 IF (IVCOMP - 782) 20060, 10060, 20060 02690351 +30060 IVDELE = IVDELE + 1 02700351 + WRITE (I02,80000) IVTNUM 02710351 + IF (ICZERO) 10060, 0071, 20060 02720351 +10060 IVPASS = IVPASS + 1 02730351 + WRITE (I02,80002) IVTNUM 02740351 + GO TO 0071 02750351 +20060 IVFAIL = IVFAIL + 1 02760351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02770351 + 0071 CONTINUE 02780351 +C 02790351 +C **** FCVS PROGRAM 351 - TEST 007 **** 02800351 +C 02810351 +C IN TEST 7, AN INTEGER EXPRESSION INVOLVING ALL FIVE 02820351 +C ARITHMETIC OPERATORS TOGETHER WITH PARENTHESES IS EVALUATED, 02830351 +C BUT UNLIKE TESTS 1 THROUGH 6 WHERE ALL OPERANDS WERE INTEGER 02840351 +C VARIABLES, THE OPERANDS IN TEST 7 ARE CLASSED AS INTEGER 02850351 +C VARIABLES, INTEGER CONSTANTS, INTEGER ARRAY ELEMENTS, AND INTEGER 02860351 +C FUNCTION REFERENCES. 02870351 +C 02880351 + IVTNUM = 7 02890351 + IF (ICZERO) 30070, 0070, 30070 02900351 + 0070 CONTINUE 02910351 + IVON01 = 573 02920351 + IVON02 = 1 02930351 + IVON03 = 3 02940351 + IVON04 = 2 02950351 + IVON05 = 3 02960351 + IADN11(3) = 3071 02970351 + IVCOMP = (IVON01 + 1) - (5 + IADN11(IVON03)) / 02980351 + 1 (IFOS01(IVON03,IVON04,IVON05) ** IVON02) 02990351 + IVCORR = 574 03000351 +40070 IF (IVCOMP - 574) 20070, 10070, 20070 03010351 +30070 IVDELE = IVDELE + 1 03020351 + WRITE (I02,80000) IVTNUM 03030351 + IF (ICZERO) 10070, 0081, 20070 03040351 +10070 IVPASS = IVPASS + 1 03050351 + WRITE (I02,80002) IVTNUM 03060351 + GO TO 0081 03070351 +20070 IVFAIL = IVFAIL + 1 03080351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03090351 + 0081 CONTINUE 03100351 +C 03110351 +C **** FCVS PROGRAM 351 - TEST 008 **** 03120351 +C 03130351 +C TEST 8 IS IDENTICAL TO TEST 7 EXCEPT THAT PARENTHESES ARE 03140351 +C USED TO CHANGE THE ORDER OF SUB-EXPRESSION EVALUATION. 03150351 +C 03160351 + IVTNUM = 8 03170351 + IF (ICZERO) 30080, 0080, 30080 03180351 + 0080 CONTINUE 03190351 + IVON01 = 573 03200351 + IVON02 = 1 03210351 + IVON03 = 3 03220351 + IVON04 = 2 03230351 + IVON05 = 3 03240351 + IADN11(3) = 3071 03250351 + IVCOMP = ((IVON01 + 1) - (5 + IADN11(IVON03))) / 03260351 + 1 IFOS01(IVON03,IVON04,IVON05) ** IVON02 03270351 + IVCORR = 0 03280351 +40080 IF (IVCOMP) 20080, 10080, 20080 03290351 +30080 IVDELE = IVDELE + 1 03300351 + WRITE (I02,80000) IVTNUM 03310351 + IF (ICZERO) 10080, 0091, 20080 03320351 +10080 IVPASS = IVPASS + 1 03330351 + WRITE (I02,80002) IVTNUM 03340351 + GO TO 0091 03350351 +20080 IVFAIL = IVFAIL + 1 03360351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03370351 + 0091 CONTINUE 03380351 +C 03390351 +C **** FCVS PROGRAM 351 - TEST 009 **** 03400351 +C 03410351 +C TEST 9 IS SIMILAR TO TESTS 7 AND 8 EXCEPT THAT THE 03420351 +C FUNCTION REFERENCE IN TURN EVALUATES ARRAY ELEMENTS. 03430351 +C 03440351 + IVTNUM = 9 03450351 + IF (ICZERO) 30090, 0090, 30090 03460351 + 0090 CONTINUE 03470351 + IVON01 = 7 03480351 + IVON02 = 3 03490351 + IVON03 = 2 03500351 + IVON04 = 1 03510351 + IVON05 = 4 03520351 + IADN11(1) = 5 03530351 + IADN11(2) = 2 03540351 + IADN11(4) = 2 03550351 + IVCOMP = (IVON01 - 8 * IFOS02(IVON04,IVON03)) / IADN11(IVON05) + 03560351 + 1 13 ** IVON02 03570351 + IVCORR = 2193 03580351 +40090 IF (IVCOMP - 2193) 20090, 10090, 20090 03590351 +30090 IVDELE = IVDELE + 1 03600351 + WRITE (I02,80000) IVTNUM 03610351 + IF (ICZERO) 10090, 0101, 20090 03620351 +10090 IVPASS = IVPASS + 1 03630351 + WRITE (I02,80002) IVTNUM 03640351 + GO TO 0101 03650351 +20090 IVFAIL = IVFAIL + 1 03660351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03670351 + 0101 CONTINUE 03680351 +C 03690351 +C **** FCVS PROGRAM 351 - TEST 010 **** 03700351 +C 03710351 +C TEST 10 EVALUATES AN INTEGER EXPRESSION WHICH CONTAINS 03720351 +C FUNCTION REFERENCES NESTED TO THREE LEVELS. THE OUTER TWO 03730351 +C LEVELS ARE STATEMENT FUNCTION REFERENCES AND THE INNERMOST LEVEL 03740351 +C IS AN INTRINSIC FUNCTION REFERENCE. 03750351 +C 03760351 + IVTNUM = 10 03770351 + IF (ICZERO) 30100, 0100, 30100 03780351 + 0100 CONTINUE 03790351 + IVON01 = -51 03800351 + IVON02 = 4 03810351 + IVON03 = -101 03820351 + IVON04 = 13 03830351 + IVON05 = 3 03840351 + IVON06 = 5 03850351 + IVON07 = -37 03860351 + IADN11(4) = 87 03870351 + IADN11(5) = 409 03880351 + IVCOMP = (IVON01 + IFOS03(IVON02,IVON03,IVON04)) * IVON05 - 03890351 + 1 IFOS04(IVON06,IVON07) 03900351 + IVCORR = 6733 03910351 +40100 IF (IVCOMP - 6733) 20100, 10100, 20100 03920351 +30100 IVDELE = IVDELE + 1 03930351 + WRITE (I02,80000) IVTNUM 03940351 + IF (ICZERO) 10100, 0111, 20100 03950351 +10100 IVPASS = IVPASS + 1 03960351 + WRITE (I02,80002) IVTNUM 03970351 + GO TO 0111 03980351 +20100 IVFAIL = IVFAIL + 1 03990351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04000351 + 0111 CONTINUE 04010351 +C 04020351 +C TESTS 11 THROUGH 20 REPEAT TESTS 1 THROUGH 10 EXCEPT THAT 04030351 +C TESTS 11 THROUGH 20 DEAL ENTIRELY WITH REAL ARITHMETIC 04040351 +C EXPRESSIONS. 04050351 +C 04060351 +C 04070351 +C **** FCVS PROGRAM 351 - TEST 011 **** 04080351 +C 04090351 +C TEST 11 TESTS A REAL EXPRESSION WHERE ALL FIVE ARITHMETIC 04100351 +C OPERATORS ARE USED AND ALL OPERAND PRIMARIES ARE SIMPLE REAL 04110351 +C VARIABLES. 04120351 +C 04130351 + IVTNUM = 11 04140351 + IF (ICZERO) 30110, 0110, 30110 04150351 + 0110 CONTINUE 04160351 + RVON01 = 3.2 04170351 + RVON02 = 23.051 04180351 + RVON03 = 1545 E7 04190351 + RVON04 = -23.457 04200351 + RVON05 = .02 E3 04210351 + RVON06 = 7.210745323 E-10 04220351 + RVCOMP = RVON01 ** RVON02 + RVON03 - RVON04 * RVON05 / RVON06 04230351 + RVCORR = 1.10683 E12 04240351 +40110 IF (RVCOMP - 1.1063 E12) 20110, 10110, 40111 04250351 +40111 IF (RVCOMP - 1.1073 E12) 10110, 10110, 20110 04260351 +30110 IVDELE = IVDELE + 1 04270351 + WRITE (I02,80000) IVTNUM 04280351 + IF (ICZERO) 10110, 0121, 20110 04290351 +10110 IVPASS = IVPASS + 1 04300351 + WRITE (I02,80002) IVTNUM 04310351 + GO TO 0121 04320351 +20110 IVFAIL = IVFAIL + 1 04330351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04340351 + 0121 CONTINUE 04350351 +C 04360351 +C **** FCVS PROGRAM 351 - TEST 012 **** 04370351 +C 04380351 +C TEST 12, LIKE TEST 11, CHECKS A REAL EXPRESSION WHERE ALL 04390351 +C FIVE ARITHMETIC OPERATORS ARE USED AND ALL OPERANDS ARE REAL 04400351 +C VARIABLES, BUT IN TEST 12, PARENTHESES ARE USED, AS IS ALSO A 04410351 +C UNARY OPERATOR. 04420351 +C 04430351 + IVTNUM = 12 04440351 + IF (ICZERO) 30120, 0120, 30120 04450351 + 0120 CONTINUE 04460351 + RVON01 = 3.2 04470351 + RVON02 = 23.051 04480351 + RVON03 = 1545 E-3 04490351 + RVON04 = 5.75 E-1 04500351 + RVON05 = 2.22 E+1 04510351 + RVCOMP = -(RVON01 / RVON02) + (RVON03 * RVON04 ** RVON05) 04520351 + RVCORR = -.13882 04530351 +40120 IF (RVCOMP + .13887) 20120, 10120, 40121 04540351 +40121 IF (RVCOMP + .13877) 10120, 10120, 20120 04550351 +30120 IVDELE = IVDELE + 1 04560351 + WRITE (I02,80000) IVTNUM 04570351 + IF (ICZERO) 10120, 0131, 20120 04580351 +10120 IVPASS = IVPASS + 1 04590351 + WRITE (I02,80002) IVTNUM 04600351 + GO TO 0131 04610351 +20120 IVFAIL = IVFAIL + 1 04620351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04630351 + 0131 CONTINUE 04640351 +C 04650351 +C **** FCVS PROGRAM 351 - TEST 013 **** 04660351 +C 04670351 +C TEST 13 IS SIMILAR TO TEST 12 EXCEPT THAT TEST 13 EMPLOYS 04680351 +C NESTED PARENTHESES. 04690351 +C 04700351 + IVTNUM = 13 04710351 + IF (ICZERO) 30130, 0130, 30130 04720351 + 0130 CONTINUE 04730351 + RVON01 = 3.2 04740351 + RVON02 = -63.051 04750351 + RVON03 = 1545 E-3 04760351 + RVON04 = 5.75 E-1 04770351 + RVON05 = 2.22 E1 04780351 + RVON06 = 0.523 04790351 + RVCOMP = RVON01 ** (-(RVON02 + (RVON03 - RVON04)) - 04800351 + 1 (RVON05 / RVON06)) 04810351 + RVCORR = 8.27757 E9 04820351 +40130 IF (RVCOMP - 8.2770 E9) 20130, 10130, 40131 04830351 +40131 IF (RVCOMP - 8.2780 E9) 10130, 10130, 20130 04840351 +30130 IVDELE = IVDELE + 1 04850351 + WRITE (I02,80000) IVTNUM 04860351 + IF (ICZERO) 10130, 0141, 20130 04870351 +10130 IVPASS = IVPASS + 1 04880351 + WRITE (I02,80002) IVTNUM 04890351 + GO TO 0141 04900351 +20130 IVFAIL = IVFAIL + 1 04910351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04920351 + 0141 CONTINUE 04930351 +C 04940351 +C **** FCVS PROGRAM 351 - TEST 014 **** 04950351 +C 04960351 +C TEST 14 IS SIMILAR TO TESTS 12 AND 13 EXCEPT THAT THE 04970351 +C PARENTHESES USED ARE EFFECTIVELY EXTRANEOUS. 04980351 +C 04990351 + IVTNUM = 14 05000351 + IF (ICZERO) 30140, 0140, 30140 05010351 + 0140 CONTINUE 05020351 + RVON01 = 5.4515 E18 05030351 + RVON02 = .076923 05040351 + RVON03 = 23 E-2 05050351 + RVON04 = 7 E7 05060351 + RVON05 = 45.23 E5 05070351 + RVON06 = 5.65375 E12 05080351 + RVCOMP = ((RVON01) ** (RVON02) + (RVON03) - (RVON04) * (RVON05) / 05090351 + 1 (RVON06)) 05100351 + RVCORR = -28.147 05110351 +40140 IF (RVCOMP + 28.152) 20140, 10140, 40141 05120351 +40141 IF (RVCOMP + 28.142) 10140, 10140, 20140 05130351 +30140 IVDELE = IVDELE + 1 05140351 + WRITE (I02,80000) IVTNUM 05150351 + IF (ICZERO) 10140, 0151, 20140 05160351 +10140 IVPASS = IVPASS + 1 05170351 + WRITE (I02,80002) IVTNUM 05180351 + GO TO 0151 05190351 +20140 IVFAIL = IVFAIL + 1 05200351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05210351 + 0151 CONTINUE 05220351 +C 05230351 +C **** FCVS PROGRAM 351 - TEST 015 **** 05240351 +C 05250351 +C TEST 15 CONTINUES THE TESTING OF EXPRESSIONS USING ONLY 05260351 +C REAL VARIABLE OPERANDS CONNECTED BY ARITHMETIC OPERATORS, AND 05270351 +C USING PARENTHESES TO OVERRIDE PRECEDENCES. 05280351 +C 05290351 + IVTNUM = 15 05300351 + IF (ICZERO) 30150, 0150, 30150 05310351 + 0150 CONTINUE 05320351 + RVON01 = .11341 E1 05330351 + RVON02 = 7.1417 05340351 + RVON03 = 5.2113 E1 05350351 + RVON04 = 10.001 05360351 + RVON05 = 7.241 E5 05370351 + RVON06 = 5.7777 E-3 05380351 + RVCOMP = -RVON01 ** (RVON02 + RVON03 - RVON04) * (RVON05 / RVON06)05390351 + RVCORR = -6.1635 E10 05400351 +40150 IF (RVCOMP + 6.1640 E10) 20150, 10150, 40151 05410351 +40151 IF (RVCOMP + 6.1630 E10) 10150, 10150, 20150 05420351 +30150 IVDELE = IVDELE + 1 05430351 + WRITE (I02,80000) IVTNUM 05440351 + IF (ICZERO) 10150, 0161, 20150 05450351 +10150 IVPASS = IVPASS + 1 05460351 + WRITE (I02,80002) IVTNUM 05470351 + GO TO 0161 05480351 +20150 IVFAIL = IVFAIL + 1 05490351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05500351 + 0161 CONTINUE 05510351 +C 05520351 +C **** FCVS PROGRAM 351 - TEST 016 **** 05530351 +C 05540351 +C TEST 16 CONTINUES THE TESTING OF EXPRESSIONS USING ONLY 05550351 +C REAL VARIABLE OPERANDS CONNECTED BY ARITHMETIC OPERATORS, AND 05560351 +C USING PARENTHESES TO OVERRIDE PRECEDENCES. 05570351 +C 05580351 + IVTNUM = 16 05590351 + IF (ICZERO) 30160, 0160, 30160 05600351 + 0160 CONTINUE 05610351 + RVON01 = 6.4003 E18 05620351 + RVON02 = -3.7717 E-2 05630351 + RVON03 = -5.1195 E3 05640351 + RVON04 = 1.7521 E14 05650351 + RVON05 = 1.0533 E3 05660351 + RVON06 = -9.4207 E11 05670351 + RVCOMP = ((RVON01 * (RVON02 / RVON03)) + RVON04) / RVON05 - 05680351 + 1 (-RVON06) 05690351 + RVCORR = -7.3096 E11 05700351 +40160 IF (RVCOMP + 7.3101 E11) 20160, 10160, 40161 05710351 +40161 IF (RVCOMP + 7.3091 E11) 10160, 10160, 20160 05720351 +30160 IVDELE = IVDELE + 1 05730351 + WRITE (I02,80000) IVTNUM 05740351 + IF (ICZERO) 10160, 0171, 20160 05750351 +10160 IVPASS = IVPASS + 1 05760351 + WRITE (I02,80002) IVTNUM 05770351 + GO TO 0171 05780351 +20160 IVFAIL = IVFAIL + 1 05790351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05800351 + 0171 CONTINUE 05810351 +C 05820351 +C **** FCVS PROGRAM 351 - TEST 017 **** 05830351 +C 05840351 +C IN TEST 17, A REAL EXPRESSION INVOLVING ALL FIVE ARITHMETIC 05850351 +C OPERATORS IS EVALUATED, BUT UNLIKE TESTS 11 THROUGH 16 WHERE 05860351 +C ALL OPERANDS WERE REAL VARIABLES, THE OPERANDS IN TEST 17 ARE 05870351 +C CLASSED AS REAL VARIABLES, REAL CONSTANTS, REAL ARRAY ELEMENTS, 05880351 +C AND REAL FUNCTION REFERENCES. 05890351 +C 05900351 + IVTNUM = 17 05910351 + IF (ICZERO) 30170, 0170, 30170 05920351 + 0170 CONTINUE 05930351 + RVON01 = 5.247 E10 05940351 + IVON01 = 3 05950351 + RVON02 = 1.07 E1 05960351 + RVON03 = 5.23 05970351 + RVON04 = 1.001 05980351 + RVON05 = 1.573 05990351 + RADN11(3) = 0.3947 E18 06000351 + RVCOMP = (RVON01 + 3.491 E10) - (4 E17 + RADN11(IVON01)) / 06010351 + 1 (RFOS01(RVON03,RVON04,RVON05) ** RVON02) 06020351 + RVCORR = 7.1526 E10 06030351 +40170 IF (RVCOMP - 7.1521 E10) 20170, 10170, 40171 06040351 +40171 IF (RVCOMP - 7.1531 E10) 10170, 10170, 20170 06050351 +30170 IVDELE = IVDELE + 1 06060351 + WRITE (I02,80000) IVTNUM 06070351 + IF (ICZERO) 10170, 0181, 20170 06080351 +10170 IVPASS = IVPASS + 1 06090351 + WRITE (I02,80002) IVTNUM 06100351 + GO TO 0181 06110351 +20170 IVFAIL = IVFAIL + 1 06120351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06130351 + 0181 CONTINUE 06140351 +C 06150351 +C **** FCVS PROGRAM 351 - TEST 018 **** 06160351 +C 06170351 +C TEST 18 IS IDENTICAL TO TEST 17 EXCEPT THAT PARENTHESES ARE 06180351 +C USED TO CHANGE THE ORDER OF SUB-EXPRESSION EVALUATION. 06190351 +C 06200351 + IVTNUM = 18 06210351 + IF (ICZERO) 30180, 0180, 30180 06220351 + 0180 CONTINUE 06230351 + RVON01 = 5.247 E10 06240351 + IVON01 = 3 06250351 + RVON02 = 1.07 E1 06260351 + RVON03 = 5.23 06270351 + RVON04 = 1.001 06280351 + RVON05 = 1.573 06290351 + RADN11(3) = 0.3947 E18 06300351 + RVCOMP = ((RVON01 + 3.491 E10) - (4 E17 + RADN11(IVON01))) / 06310351 + 1 RFOS01(RVON03,RVON04,RVON05) ** RVON02 06320351 + RVCORR = -1.5854 E10 06330351 +40180 IF (RVCOMP + 1.5859 E10) 20180, 10180, 40181 06340351 +40181 IF (RVCOMP + 1.5849 E10) 10180, 10180, 20180 06350351 +30180 IVDELE = IVDELE + 1 06360351 + WRITE (I02,80000) IVTNUM 06370351 + IF (ICZERO) 10180, 0191, 20180 06380351 +10180 IVPASS = IVPASS + 1 06390351 + WRITE (I02,80002) IVTNUM 06400351 + GO TO 0191 06410351 +20180 IVFAIL = IVFAIL + 1 06420351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06430351 + 0191 CONTINUE 06440351 +C 06450351 +C **** FCVS PROGRAM 351 - TEST 019 **** 06460351 +C 06470351 +C TEST 19 IS SIMILAR TO TESTS 17 AND 18 EXCEPT THAT THE 06480351 +C FUNCTION REFERENCES IN TURN EVALUATE ARRAY ELEMENTS. 06490351 +C 06500351 + IVTNUM = 19 06510351 + IF (ICZERO) 30190, 0190, 30190 06520351 + 0190 CONTINUE 06530351 + RVON01 = 5.026 E2 06540351 + RVON02 = 1.386 E1 06550351 + IVON03 = 2 06560351 + RVON04 = 1.9999 06570351 + RVON05 = 4.0127 06580351 + RADN11(1) = 3.004 E18 06590351 + RADN11(2) = 2.5705 E-1 06600351 + RADN11(4) = 7.993 E16 06610351 + RVCOMP = (RVON01 - 5.902 * RFOS02(INT(RVON04),INT(RVON05))) / 06620351 + 1 RADN11(IVON03) + 1.5372 ** RVON02 06630351 + RVCORR = 1.4797 E3 06640351 +40190 IF (RVCORR - 1.4792 E3) 20190, 10190, 40191 06650351 +40191 IF (RVCORR - 1.4802 E3) 10190, 10190, 20190 06660351 +30190 IVDELE = IVDELE + 1 06670351 + WRITE (I02,80000) IVTNUM 06680351 + IF (ICZERO) 10190, 0201, 20190 06690351 +10190 IVPASS = IVPASS + 1 06700351 + WRITE (I02,80002) IVTNUM 06710351 + GO TO 0201 06720351 +20190 IVFAIL = IVFAIL + 1 06730351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 06740351 + 0201 CONTINUE 06750351 +C 06760351 +C **** FCVS PROGRAM 351 - TEST 020 **** 06770351 +C 06780351 +C TEST 20 EVALUATES A REAL EXPRESSION WHICH CONTAINS FUNCTION 06790351 +C REFERENCES NESTED TO THREE LEVELS. THE OUTER TWO LEVELS ARE 06800351 +C STATEMENT FUNCTION REFERENCES AND THE INNERMOST LEVEL IS AN 06810351 +C INTRINSIC FUNCTION REFERENCE. 06820351 +C 06830351 + IVTNUM = 20 06840351 + IF (ICZERO) 30200, 0200, 30200 06850351 + 0200 CONTINUE 06860351 + RVON01 = 4.7117 E05 06870351 + RVON02 = 5.987 06880351 + RVON03 = 2.00000 E5 06890351 + RVON04 = 1.0 E2 06900351 + RVON05 = 1.5222 E9 06910351 + IVON06 = 4 06920351 + RVON07 = -3.2107 E14 06930351 + RADN11(4) = 7.425 E14 06940351 + RADN11(5) = -2.4015 E5 06950351 + RVCOMP = (RVON01 + RFOS03(RVON02,RVON03,RVON04)) * RVON05 - 06960351 + 1 RFOS04(IVON06,RVON07) 06970351 + RVCORR = -6.4580 E15 06980351 +40200 IF (RVCOMP + 6.4585 E15) 20200, 10200, 40201 06990351 +40201 IF (RVCOMP + 6.4575 E15) 10200, 10200, 20200 07000351 +30200 IVDELE = IVDELE + 1 07010351 + WRITE (I02,80000) IVTNUM 07020351 + IF (ICZERO) 10200, 0211, 20200 07030351 +10200 IVPASS = IVPASS + 1 07040351 + WRITE (I02,80002) IVTNUM 07050351 + GO TO 0211 07060351 +20200 IVFAIL = IVFAIL + 1 07070351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07080351 + 0211 CONTINUE 07090351 +C 07100351 +C TESTS 21 THROUGH 25 DEAL WITH MIXTURES OF REAL AND INTEGER 07110351 +C EXPRESSIONS; I.E., THESE ARE TESTS WHICH EVALUATE EXPRESSIONS 07120351 +C CONTAINING BOTH REAL SUB-EXPRESSIONS AND INTEGER SUB-EXPRESSIONS 07130351 +C AND THEN ASSIGN THE RESULTS TO EITHER AN INTEGER OR A REAL 07140351 +C VARIABLE. 07150351 +C 07160351 +C 07170351 +C **** FCVS PROGRAM 351 - TEST 021 **** 07180351 +C 07190351 +C TEST 21 USES ALL FIVE ARITHMETIC OPERATORS AND A COMBINATION 07200351 +C OF INTEGER AND REAL VARIABLES. NO PARENTHESES ARE USED. FINAL 07210351 +C ASSIGNMENT IS TO AN INTEGER VARIABLE. 07220351 +C 07230351 + IVTNUM = 21 07240351 + IF (ICZERO) 30210, 0210, 30210 07250351 + 0210 CONTINUE 07260351 + IVON01 = 17 07270351 + IVON02 = 3 07280351 + RVON03 = 5.4732 E+2 07290351 + RVON04 = 1.523 07300351 + IVON05 = 798 07310351 + IVCOMP = IVON01 ** IVON02 + RVON03 - RVON04 * IVON05 / IVON01 07320351 + IVCORR = 5388 07330351 +40210 IF (IVCOMP - 5388) 20210, 10210, 20210 07340351 +30210 IVDELE = IVDELE + 1 07350351 + WRITE (I02,80000) IVTNUM 07360351 + IF (ICZERO) 10210, 0221, 20210 07370351 +10210 IVPASS = IVPASS + 1 07380351 + WRITE (I02,80002) IVTNUM 07390351 + GO TO 0221 07400351 +20210 IVFAIL = IVFAIL + 1 07410351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07420351 + 0221 CONTINUE 07430351 +C 07440351 +C **** FCVS PROGRAM 351 - TEST 022 **** 07450351 +C 07460351 +C TEST 22 IS LIKE TEST 21 EXCEPT THAT PARENTHESES ARE USED, 07470351 +C AS IS A UNARY OPERATOR. FINAL ASSIGNMENT IS TO A REAL VARIABLE. 07480351 +C 07490351 + IVTNUM = 22 07500351 + IF (ICZERO) 30220, 0220, 30220 07510351 + 0220 CONTINUE 07520351 + IVON01 = 798 07530351 + IVON02 = 17 07540351 + RVON03 = 9.34578 E-2 07550351 + IVON04 = 15985 07560351 + RVON05 = 0.72357 07570351 + RVCOMP = -(IVON01 / IVON02) + (RVON03 * IVON04 ** RVON05) 07580351 + RVCORR = 5.68717 E1 07590351 +40220 IF (RVCOMP - 5.6866 E1) 20220, 10220, 40221 07600351 +40221 IF (RVCOMP - 5.6876 E1) 10220, 10220, 20220 07610351 +30220 IVDELE = IVDELE + 1 07620351 + WRITE (I02,80000) IVTNUM 07630351 + IF (ICZERO) 10220, 0231, 20220 07640351 +10220 IVPASS = IVPASS + 1 07650351 + WRITE (I02,80002) IVTNUM 07660351 + GO TO 0231 07670351 +20220 IVFAIL = IVFAIL + 1 07680351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07690351 + 0231 CONTINUE 07700351 +C 07710351 +C **** FCVS PROGRAM 351 - TEST 023 **** 07720351 +C 07730351 +C TEST 23 IS SIMILAR TO TEST 22 EXCEPT THAT IT EMPLOYS NESTED 07740351 +C PARENTHESES. 07750351 +C 07760351 + IVTNUM = 23 07770351 + IF (ICZERO) 30230, 0230, 30230 07780351 + 0230 CONTINUE 07790351 + IVON01 = 2 07800351 + IVON02 = 183 07810351 + RVON03 = 58.7025 07820351 + IVON04 = 197 07830351 + IVON05 = 87 07840351 + RVON06 = 2.4611 E15 07850351 + RVCOMP = IVON01 ** (-(IVON02 + (RVON03 - IVON04)) - 07860351 + 1 (IVON05 / RVON06)) 07870351 + RVCORR = 3.4931 E-14 07880351 +40230 IF (RVCOMP - 3.4926 E-14) 20230, 10230, 40231 07890351 +40231 IF (RVCOMP - 3.4936 E-14) 10230, 10230, 20230 07900351 +30230 IVDELE = IVDELE + 1 07910351 + WRITE (I02,80000) IVTNUM 07920351 + IF (ICZERO) 10230, 0241, 20230 07930351 +10230 IVPASS = IVPASS + 1 07940351 + WRITE (I02,80002) IVTNUM 07950351 + GO TO 0241 07960351 +20230 IVFAIL = IVFAIL + 1 07970351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 07980351 + 0241 CONTINUE 07990351 +C 08000351 +C **** FCVS PROGRAM 351 - TEST 024 **** 08010351 +C 08020351 +C TEST 24 IS IDENTICAL TO TEST 23 EXCEPT THAT THE FINAL 08030351 +C ASSIGNMENT IS TO AN INTEGER VARIABLE INSTEAD OF A REAL VARIABLE. 08040351 +C 08050351 + IVTNUM = 24 08060351 + IF (ICZERO) 30240, 0240, 30240 08070351 + 0240 CONTINUE 08080351 + IVON01 = 2 08090351 + IVON02 = 183 08100351 + RVON03 = 58.7025 08110351 + IVON04 = 197 08120351 + IVON05 = 87 08130351 + RVON06 = 2.4611 E15 08140351 + IVCOMP = IVON01 ** (-(IVON02 + (RVON03 - IVON04)) - 08150351 + 1 (IVON05 / RVON06)) 08160351 + IVCORR = 0 08170351 +40240 IF (IVCOMP) 20240, 10240, 20240 08180351 +30240 IVDELE = IVDELE + 1 08190351 + WRITE (I02,80000) IVTNUM 08200351 + IF (ICZERO) 10240, 0251, 20240 08210351 +10240 IVPASS = IVPASS + 1 08220351 + WRITE (I02,80002) IVTNUM 08230351 + GO TO 0251 08240351 +20240 IVFAIL = IVFAIL + 1 08250351 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08260351 + 0251 CONTINUE 08270351 +C 08280351 +C **** FCVS PROGRAM 351 - TEST 025 **** 08290351 +C 08300351 +C TEST 25 IS SIMILAR TO TESTS 9 AND 19 EXCEPT THAT A MIXTURE 08310351 +C OF REAL AND INTEGER OPERANDS ARE USED, AND FINAL ASSIGNMENT IS 08320351 +C TO A REAL VARIABLE. 08330351 +C 08340351 + IVTNUM = 25 08350351 + IF (ICZERO) 30250, 0250, 30250 08360351 + 0250 CONTINUE 08370351 + RVON01 = 4.7117 08380351 + RVON02 = 5.998 08390351 + IVON03 = 2 08400351 + RVON04 = 1E2 08410351 + IVON05 = 20 08420351 + IVON06 = 4 08430351 + IVON07 = -3 08440351 + RADN11(4) = 7.425 08450351 + RADN11(5) = -2.4015 08460351 + RVCOMP = (RVON01 + RFOS06(AINT(RVON02),IVON03,RVON04)) * IVON05 - 08470351 + 1 IFOS05(IVON06,IVON07) 08480351 + RVCORR = 84.234 08490351 +40250 IF (RVCOMP - 84.229) 20250, 10250, 40251 08500351 +40251 IF (RVCOMP - 84.239) 10250, 10250, 20250 08510351 +30250 IVDELE = IVDELE + 1 08520351 + WRITE (I02,80000) IVTNUM 08530351 + IF (ICZERO) 10250, 0261, 20250 08540351 +10250 IVPASS = IVPASS + 1 08550351 + WRITE (I02,80002) IVTNUM 08560351 + GO TO 0261 08570351 +20250 IVFAIL = IVFAIL + 1 08580351 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 08590351 + 0261 CONTINUE 08600351 +C 08610351 +C 08620351 +C WRITE OUT TEST SUMMARY 08630351 +C 08640351 + WRITE (I02,90004) 08650351 + WRITE (I02,90014) 08660351 + WRITE (I02,90004) 08670351 + WRITE (I02,90000) 08680351 + WRITE (I02,90004) 08690351 + WRITE (I02,90020) IVFAIL 08700351 + WRITE (I02,90022) IVPASS 08710351 + WRITE (I02,90024) IVDELE 08720351 + STOP 08730351 +90001 FORMAT (" ",24X,"FM351") 08740351 +90000 FORMAT (" ",20X,"END OF PROGRAM FM351" ) 08750351 +C 08760351 +C FORMATS FOR TEST DETAIL LINES 08770351 +C 08780351 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 08790351 +80002 FORMAT (" ",4X,I5,7X,"PASS") 08800351 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08810351 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08820351 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 08830351 +C 08840351 +C FORMAT STATEMENTS FOR PAGE HEADERS 08850351 +C 08860351 +90002 FORMAT ("1") 08870351 +90004 FORMAT (" ") 08880351 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08890351 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 08900351 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08910351 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 08920351 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 08930351 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08940351 +C 08950351 +C FORMAT STATEMENTS FOR RUN SUMMARY 08960351 +C 08970351 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 08980351 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 08990351 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 09000351 + END 09010351 diff --git a/Fortran/UnitTests/fcvs21_f95/FM351.reference_output b/Fortran/UnitTests/fcvs21_f95/FM351.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM351.reference_output @@ -0,0 +1,46 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM351 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + + ---------------------------------------------- + + END OF PROGRAM FM351 + + 0 TESTS FAILED + 25 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM352.f b/Fortran/UnitTests/fcvs21_f95/FM352.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM352.f @@ -0,0 +1,883 @@ + PROGRAM FM352 00010352 +C 00020352 +C 00030352 +C THIS PROGRAM CHECKS BASIC RELATIONAL EXPRESSIONS INVOLVING 00040352 +C OPERANDS OF REAL DATA TYPE. IN EACH TEST, NOT ONLY THE RELATIONAL00050352 +C EXPRESSION IS TESTED, BUT THE TRICHOTOMY LAW OF MATHEMATICAL 00060352 +C RELATIONSHIPS IS ALSO TESTED (E.G., IF A .LT. B, THEN A CAN NOT 00070352 +C BE .GT. THAN B, AND A CAN NOT BE .EQ. B). A TEST VARIABLE 00080352 +C (IVCOMP) IS USED TO REPORT THE RESULT OF THE TEST AS FOLLOWS, 00090352 +C IVCOMP = 0 IF BOTH THE TESTED RELATIONAL OPERATOR AND THE 00100352 +C TRICHOTOMY TEST PASS. 00110352 +C IVCOMP = 1 IF THE RELATIONAL TEST FAILS AND THE TRICHOTOMY 00120352 +C TEST PASSES (WHICH WOULD INDICATE THAT A TESTED 00130352 +C NOT .LT., .GT., OR .EQ. B). 00140352 +C IVCOMP = 2 IF THE RELATIONAL TEST PASSES AND THE TRICHOTOMY 00150352 +C TEST FAILS (WHICH WOULD INDICATE THAT A TESTED 00160352 +C .LT., .GT., AND .EQ. B). 00170352 +C IVCOMP = 3 IF BOTH THE RELATIONAL TEST AND THE TRICHOTOMY 00180352 +C TEST FAIL (WHICH WOULD INDICATE THE RELATIONAL 00190352 +C EXPRESSION TESTED OPPOSITE TO THAT EXPECTED 00200352 +C (E.G., WHERE A WAS SUPPOSED TO BE .LT. B, IN 00210352 +C FACT A .LT. B WAS FOUND TO BE FALSE AND A .GE. B 00220352 +C WAS FOUND TO BE TRUE). 00230352 +C 00240352 +C 00250352 +C REFERENCES - 00260352 +C 00270352 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, X3.9-197700280352 +C SECTION 4.4, REAL TYPE 00290352 +C SECTION 6.3, RELATIONAL EXPRESSIONS 00300352 +C SECTION 6.5, PRECEDENCE OF OPERATORS 00310352 +C SECTION 6.6, EVALUATION OF EXPRESSIONS 00320352 +C 00330352 +C 00340352 +C ******************************************************************00350352 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00360352 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00370352 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00380352 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00390352 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00400352 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00410352 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00420352 +C THE RESULT OF EXECUTING THESE TESTS. 00430352 +C 00440352 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00450352 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00460352 +C 00470352 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00480352 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00490352 +C SOFTWARE STANDARDS VALIDATION GROUP 00500352 +C BUILDING 225 RM A266 00510352 +C GAITHERSBURG, MD 20899 00520352 +C ******************************************************************00530352 +C 00540352 +C 00550352 + IMPLICIT LOGICAL (L) 00560352 + IMPLICIT CHARACTER*14 (C) 00570352 +C 00580352 + DIMENSION RADN11(2) 00590352 + RFOS01(RDON01,RDON02) = RDON01 + RDON02 00600352 +C 00610352 +C 00620352 +C 00630352 +C INITIALIZATION SECTION. 00640352 +C 00650352 +C INITIALIZE CONSTANTS 00660352 +C ******************** 00670352 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00680352 + I01 = 5 00690352 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00700352 + I02 = 6 00710352 +C SYSTEM ENVIRONMENT SECTION 00720352 +C 00730352 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00740352 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750352 +C (UNIT NUMBER FOR CARD READER). 00760352 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00770352 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00780352 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00790352 +C 00800352 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00810352 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00820352 +C (UNIT NUMBER FOR PRINTER). 00830352 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00840352 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00850352 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00860352 +C 00870352 + IVPASS = 0 00880352 + IVFAIL = 0 00890352 + IVDELE = 0 00900352 + ICZERO = 0 00910352 +C 00920352 +C WRITE OUT PAGE HEADERS 00930352 +C 00940352 + WRITE (I02,90002) 00950352 + WRITE (I02,90006) 00960352 + WRITE (I02,90008) 00970352 + WRITE (I02,90004) 00980352 + WRITE (I02,90010) 00990352 + WRITE (I02,90004) 01000352 + WRITE (I02,90016) 01010352 + WRITE (I02,90001) 01020352 + WRITE (I02,90004) 01030352 + WRITE (I02,90012) 01040352 + WRITE (I02,90014) 01050352 + WRITE (I02,90004) 01060352 +C 01070352 +C 01080352 +C TESTS 1 THROUGH 13 CHECK BASIC RELATIONAL EXPRESSIONS USING 01090352 +C ONLY REAL VARIABLE OPERANDS. ALL THE VARIABLES ARE ASSIGNED REAL 01100352 +C CONSTANTS WITH EXPONENTIAL FORMAT. 01110352 +C 01120352 +C 01130352 +C **** FCVS PROGRAM 352 - TEST 001 **** 01140352 +C 01150352 +C TEST 1 CHECKS THE .LT. OPERATOR USING TWO REAL OPERANDS 01160352 +C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT. 01170352 +C 01180352 + IVTNUM = 1 01190352 + IF (ICZERO) 30010, 0010, 30010 01200352 + 0010 CONTINUE 01210352 + RVON01 = 1.0001 E17 01220352 + RVON02 = 1.0001 E18 01230352 + IVCOMP = 0 01240352 + IVCORR = 0 01250352 +40010 IF(RVON01 .LT. RVON02) GO TO 40011 01260352 + IVCOMP = 1 01270352 +40011 IF (RVON01 .GE. RVON02) IVCOMP = IVCOMP + 2 01280352 + IF (IVCOMP) 20010, 10010, 20010 01290352 +30010 IVDELE = IVDELE + 1 01300352 + WRITE (I02,80000) IVTNUM 01310352 + IF (ICZERO) 10010, 0021, 20010 01320352 +10010 IVPASS = IVPASS + 1 01330352 + WRITE (I02,80002) IVTNUM 01340352 + GO TO 0021 01350352 +20010 IVFAIL = IVFAIL + 1 01360352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01370352 + 0021 CONTINUE 01380352 +C 01390352 +C **** FCVS PROGRAM 352 - TEST 002 **** 01400352 +C 01410352 +C TEST 2 CHECKS THE .LT. OPERATOR USING TWO REAL OPERANDS 01420352 +C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT. 01430352 +C 01440352 + IVTNUM = 2 01450352 + IF (ICZERO) 30020, 0020, 30020 01460352 + 0020 CONTINUE 01470352 + RVON01 = 1.0001 E17 01480352 + RVON02 = 1.9999 E17 01490352 + IVCOMP = 0 01500352 + IVCORR = 0 01510352 +40020 IF (RVON01 .LT. RVON02) GO TO 40021 01520352 + IVCOMP = 1 01530352 +40021 IF (RVON01 .GE. RVON02) IVCOMP = IVCOMP + 2 01540352 + IF (IVCOMP) 20020, 10020, 20020 01550352 +30020 IVDELE = IVDELE + 1 01560352 + WRITE (I02,80000) IVTNUM 01570352 + IF (ICZERO) 10020, 0031, 20020 01580352 +10020 IVPASS = IVPASS + 1 01590352 + WRITE (I02,80002) IVTNUM 01600352 + GO TO 0031 01610352 +20020 IVFAIL = IVFAIL + 1 01620352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01630352 + 0031 CONTINUE 01640352 +C 01650352 +C **** FCVS PROGRAM 352 - TEST 003 **** 01660352 +C 01670352 +C TEST 3 CHECKS THE .LE. OPERATOR USING TWO REAL OPERANDS 01680352 +C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT. 01690352 +C 01700352 + IVTNUM = 3 01710352 + IF (ICZERO) 30030, 0030, 30030 01720352 + 0030 CONTINUE 01730352 + RVON01 = 1.0001 E17 01740352 + RVON02 = 1.0001 E18 01750352 + IVCOMP = 0 01760352 + IVCORR = 0 01770352 +40030 IF (RVON01 .LE. RVON02) GO TO 40031 01780352 + IVCOMP = 1 01790352 +40031 IF (RVON01 .GT. RVON02) IVCOMP = IVCOMP + 2 01800352 + IF (IVCOMP) 20030, 10030, 20030 01810352 +30030 IVDELE = IVDELE + 1 01820352 + WRITE (I02,80000) IVTNUM 01830352 + IF (ICZERO) 10030, 0041, 20030 01840352 +10030 IVPASS = IVPASS + 1 01850352 + WRITE (I02,80002) IVTNUM 01860352 + GO TO 0041 01870352 +20030 IVFAIL = IVFAIL + 1 01880352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01890352 + 0041 CONTINUE 01900352 +C 01910352 +C **** FCVS PROGRAM 352 - TEST 004 **** 01920352 +C 01930352 +C TEST 4 CHECKS THE .LE. OPERATOR USING TWO REAL OPERANDS 01940352 +C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT. 01950352 +C 01960352 + IVTNUM = 4 01970352 + IF (ICZERO) 30040, 0040, 30040 01980352 + 0040 CONTINUE 01990352 + RVON01 = 1.0001 E17 02000352 + RVON02 = 1.9999 E17 02010352 + IVCOMP = 0 02020352 + IVCORR = 0 02030352 +40040 IF (RVON01 .LE. RVON02) GO TO 40041 02040352 + IVCOMP = 1 02050352 +40041 IF (RVON01 .GT. RVON02) IVCOMP = IVCOMP + 2 02060352 + IF (IVCOMP) 20040, 10040, 20040 02070352 +30040 IVDELE = IVDELE + 1 02080352 + WRITE (I02,80000) IVTNUM 02090352 + IF (ICZERO) 10040, 0051, 20040 02100352 +10040 IVPASS = IVPASS + 1 02110352 + WRITE (I02,80002) IVTNUM 02120352 + GO TO 0051 02130352 +20040 IVFAIL = IVFAIL + 1 02140352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02150352 + 0051 CONTINUE 02160352 +C 02170352 +C **** FCVS PROGRAM 352 - TEST 005 **** 02180352 +C 02190352 +C TEST 5 CHECKS THE .LE. OPERATOR USING TWO REAL OPERANDS 02200352 +C WHICH HAVE BEEN ASSIGNED THE SAME REAL CONSTANT. 02210352 +C 02220352 + IVTNUM = 5 02230352 + IF (ICZERO) 30050, 0050, 30050 02240352 + 0050 CONTINUE 02250352 + RVON01 = 1.0001 E17 02260352 + RVON02 = 1.0001 E17 02270352 + IVCOMP = 0 02280352 + IVCORR = 0 02290352 +40050 IF (RVON01 .LE. RVON02) GO TO 40051 02300352 + IVCOMP = 1 02310352 +40051 IF (RVON01 .GT. RVON02) IVCOMP = IVCOMP + 2 02320352 + IF (IVCOMP) 20050, 10050, 20050 02330352 +30050 IVDELE = IVDELE + 1 02340352 + WRITE (I02,80000) IVTNUM 02350352 + IF (ICZERO) 10050, 0061, 20050 02360352 +10050 IVPASS = IVPASS + 1 02370352 + WRITE (I02,80002) IVTNUM 02380352 + GO TO 0061 02390352 +20050 IVFAIL = IVFAIL + 1 02400352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02410352 + 0061 CONTINUE 02420352 +C 02430352 +C **** FCVS PROGRAM 352 - TEST 006 **** 02440352 +C 02450352 +C TEST 6 CHECKS THE .NE. OPERATOR USING TWO REAL OPERANDS 02460352 +C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT. 02470352 +C 02480352 + IVTNUM = 6 02490352 + IF (ICZERO) 30060, 0060, 30060 02500352 + 0060 CONTINUE 02510352 + RVON01 = 1.0001 E17 02520352 + RVON02 = 1.0001 E18 02530352 + IVCOMP = 0 02540352 + IVCORR = 0 02550352 +40060 IF (RVON01 .NE. RVON02) GO TO 40061 02560352 + IVCOMP = 1 02570352 +40061 IF (RVON01 .EQ. RVON02) IVCOMP = IVCOMP + 2 02580352 + IF (IVCOMP) 20060, 10060, 20060 02590352 +30060 IVDELE = IVDELE + 1 02600352 + WRITE (I02,80000) IVTNUM 02610352 + IF (ICZERO) 10060, 0071, 20060 02620352 +10060 IVPASS = IVPASS + 1 02630352 + WRITE (I02,80002) IVTNUM 02640352 + GO TO 0071 02650352 +20060 IVFAIL = IVFAIL + 1 02660352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02670352 + 0071 CONTINUE 02680352 +C 02690352 +C **** FCVS PROGRAM 352 - TEST 007 **** 02700352 +C 02710352 +C TEST 7 CHECKS THE .NE. OPERATOR USING TWO REAL OPERANDS 02720352 +C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT. 02730352 +C 02740352 + IVTNUM = 7 02750352 + IF (ICZERO) 30070, 0070, 30070 02760352 + 0070 CONTINUE 02770352 + RVON01 = 1.0001 E17 02780352 + RVON02 = 1.9999 E17 02790352 + IVCOMP = 0 02800352 + IVCORR = 0 02810352 +40070 IF (RVON01 .NE. RVON02) GO TO 40071 02820352 + IVCOMP = 1 02830352 +40071 IF (RVON01 .EQ. RVON02) IVCOMP = IVCOMP + 2 02840352 + IF (IVCOMP) 20070, 10070, 20070 02850352 +30070 IVDELE = IVDELE + 1 02860352 + WRITE (I02,80000) IVTNUM 02870352 + IF (ICZERO) 10070, 0081, 20070 02880352 +10070 IVPASS = IVPASS + 1 02890352 + WRITE (I02,80002) IVTNUM 02900352 + GO TO 0081 02910352 +20070 IVFAIL = IVFAIL + 1 02920352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02930352 + 0081 CONTINUE 02940352 +C 02950352 +C **** FCVS PROGRAM 352 - TEST 008 **** 02960352 +C 02970352 +C TEST 8 CHECKS THE .EQ. OPERATOR USING TWO REAL OPERANDS 02980352 +C WHICH HAVE BEEN ASSIGNED THE SAME REAL CONSTANT. 02990352 +C 03000352 + IVTNUM = 8 03010352 + IF (ICZERO) 30080, 0080, 30080 03020352 + 0080 CONTINUE 03030352 + RVON01 = 1.0001 E17 03040352 + RVON02 = 1.0001 E17 03050352 + IVCOMP = 0 03060352 + IVCORR = 0 03070352 +40080 IF (RVON01 .EQ. RVON02) GO TO 40081 03080352 + IVCOMP = 1 03090352 +40081 IF (RVON01 .NE. RVON02) IVCOMP = IVCOMP + 2 03100352 + IF (IVCOMP) 20080, 10080, 20080 03110352 +30080 IVDELE = IVDELE + 1 03120352 + WRITE (I02,80000) IVTNUM 03130352 + IF (ICZERO) 10080, 0091, 20080 03140352 +10080 IVPASS = IVPASS + 1 03150352 + WRITE (I02,80002) IVTNUM 03160352 + GO TO 0091 03170352 +20080 IVFAIL = IVFAIL + 1 03180352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03190352 + 0091 CONTINUE 03200352 +C 03210352 +C **** FCVS PROGRAM 352 - TEST 009 **** 03220352 +C 03230352 +C TEST 9 CHECKS THE .GT. OPERATOR USING TWO REAL OPERANDS 03240352 +C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT. 03250352 +C 03260352 + IVTNUM = 9 03270352 + IF (ICZERO) 30090, 0090, 30090 03280352 + 0090 CONTINUE 03290352 + RVON01 = 1.0001 E18 03300352 + RVON02 = 1.0001 E17 03310352 + IVCOMP = 0 03320352 + IVCORR = 0 03330352 +40090 IF(RVON01 .GT. RVON02) GO TO 40091 03340352 + IVCOMP = 1 03350352 +40091 IF (RVON01 .LE. RVON02) IVCOMP = IVCOMP + 2 03360352 + IF (IVCOMP) 20090, 10090, 20090 03370352 +30090 IVDELE = IVDELE + 1 03380352 + WRITE (I02,80000) IVTNUM 03390352 + IF (ICZERO) 10090, 0101, 20090 03400352 +10090 IVPASS = IVPASS + 1 03410352 + WRITE (I02,80002) IVTNUM 03420352 + GO TO 0101 03430352 +20090 IVFAIL = IVFAIL + 1 03440352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03450352 + 0101 CONTINUE 03460352 +C 03470352 +C **** FCVS PROGRAM 352 - TEST 010 **** 03480352 +C 03490352 +C TEST 10 CHECKS THE .GT. OPERATOR USING TWO REAL OPERANDS 03500352 +C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT. 03510352 +C 03520352 + IVTNUM = 10 03530352 + IF (ICZERO) 30100, 0100, 30100 03540352 + 0100 CONTINUE 03550352 + RVON01 = 1.9999 E17 03560352 + RVON02 = 1.0001 E17 03570352 + IVCOMP = 0 03580352 + IVCORR = 0 03590352 +40100 IF (RVON01 .GT. RVON02) GO TO 40101 03600352 + IVCOMP = 1 03610352 +40101 IF (RVON01 .LE. RVON02) IVCOMP = IVCOMP + 2 03620352 + IF (IVCOMP) 20100, 10100, 20100 03630352 +30100 IVDELE = IVDELE + 1 03640352 + WRITE (I02,80000) IVTNUM 03650352 + IF (ICZERO) 10100, 0111, 20100 03660352 +10100 IVPASS = IVPASS + 1 03670352 + WRITE (I02,80002) IVTNUM 03680352 + GO TO 0111 03690352 +20100 IVFAIL = IVFAIL + 1 03700352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03710352 + 0111 CONTINUE 03720352 +C 03730352 +C **** FCVS PROGRAM 352 - TEST 011 **** 03740352 +C 03750352 +C TEST 11 CHECKS THE .GE. OPERATOR USING TWO REAL OPERANDS 03760352 +C WHERE THE MANTISSAS ARE EQUAL BUT THE EXPONENTS ARE DIFFERENT. 03770352 +C 03780352 + IVTNUM = 11 03790352 + IF (ICZERO) 30110, 0110, 30110 03800352 + 0110 CONTINUE 03810352 + RVON01 = 1.0001 E18 03820352 + RVON02 = 1.0001 E17 03830352 + IVCOMP = 0 03840352 + IVCORR = 0 03850352 +40110 IF (RVON01 .GE. RVON02) GO TO 40111 03860352 + IVCOMP = 1 03870352 +40111 IF (RVON01 .LT. RVON02) IVCOMP = IVCOMP + 2 03880352 + IF (IVCOMP) 20110, 10110, 20110 03890352 +30110 IVDELE = IVDELE + 1 03900352 + WRITE (I02,80000) IVTNUM 03910352 + IF (ICZERO) 10110, 0121, 20110 03920352 +10110 IVPASS = IVPASS + 1 03930352 + WRITE (I02,80002) IVTNUM 03940352 + GO TO 0121 03950352 +20110 IVFAIL = IVFAIL + 1 03960352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03970352 + 0121 CONTINUE 03980352 +C 03990352 +C **** FCVS PROGRAM 352 - TEST 012 **** 04000352 +C 04010352 +C TEST 12 CHECKS THE .GE. OPERATOR USING TWO REAL OPERANDS 04020352 +C WHERE THE EXPONENTS ARE EQUAL BUT THE MANTISSAS ARE DIFFERENT. 04030352 +C 04040352 + IVTNUM = 12 04050352 + IF (ICZERO) 30120, 0120, 30120 04060352 + 0120 CONTINUE 04070352 + RVON01 = 1.9999 E17 04080352 + RVON02 = 1.0001 E17 04090352 + IVCOMP = 0 04100352 + IVCORR = 0 04110352 +40120 IF (RVON01 .GE. RVON02) GO TO 40121 04120352 + IVCOMP = 1 04130352 +40121 IF (RVON01 .LT. RVON02) IVCOMP = IVCOMP + 2 04140352 + IF (IVCOMP) 20120, 10120, 20120 04150352 +30120 IVDELE = IVDELE + 1 04160352 + WRITE (I02,80000) IVTNUM 04170352 + IF (ICZERO) 10120, 0131, 20120 04180352 +10120 IVPASS = IVPASS + 1 04190352 + WRITE (I02,80002) IVTNUM 04200352 + GO TO 0131 04210352 +20120 IVFAIL = IVFAIL + 1 04220352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04230352 + 0131 CONTINUE 04240352 +C 04250352 +C **** FCVS PROGRAM 352 - TEST 013 **** 04260352 +C 04270352 +C TEST 13 CHECKS THE .GE. OPERATOR USING TWO REAL OPERANDS 04280352 +C WHERE EACH HAS BEEN ASSIGNED THE SAME REAL CONSTANT. 04290352 +C 04300352 + IVTNUM = 13 04310352 + IF (ICZERO) 30130, 0130, 30130 04320352 + 0130 CONTINUE 04330352 + RVON01 = 1.0001 E17 04340352 + RVON02 = 1.0001 E17 04350352 + IVCOMP = 0 04360352 + IVCORR = 0 04370352 +40130 IF (RVON01 .GE. RVON02) GO TO 40131 04380352 + IVCOMP = 1 04390352 +40131 IF (RVON01 .LT. RVON02) IVCOMP = IVCOMP + 2 04400352 + IF (IVCOMP) 20130, 10130, 20130 04410352 +30130 IVDELE = IVDELE + 1 04420352 + WRITE (I02,80000) IVTNUM 04430352 + IF (ICZERO) 10130, 0141, 20130 04440352 +10130 IVPASS = IVPASS + 1 04450352 + WRITE (I02,80002) IVTNUM 04460352 + GO TO 0141 04470352 +20130 IVFAIL = IVFAIL + 1 04480352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04490352 + 0141 CONTINUE 04500352 +C 04510352 +C TESTS 14 THROUGH 28 REPETITIVELY CHECK THE .LT. RELATIONSHIP 04520352 +C USING ALL TYPES AND ORDERINGS OF TWO REAL OPERANDS. 04530352 +C 04540352 +C 04550352 +C TESTS 14 THROUGH 16 CHECK REAL-VARIABLE .LT OTHER-REAL-TYPES.04560352 +C 04570352 +C 04580352 +C **** FCVS PROGRAM 352 - TEST 014 **** 04590352 +C 04600352 +C TEST 14 CHECKS REAL-VARIABLE .LT. REAL-CONSTANT 04610352 +C 04620352 + IVTNUM = 14 04630352 + IF (ICZERO) 30140, 0140, 30140 04640352 + 0140 CONTINUE 04650352 + RVON01 = 1.0001 E17 04660352 + IVCOMP = 0 04670352 + IVCORR = 0 04680352 +40140 IF (RVON01 .LT. 1.9999 E17) GO TO 40141 04690352 + IVCOMP = 1 04700352 +40141 IF (RVON01 .GE. 1.9999 E17) IVCOMP = IVCOMP + 2 04710352 + IF (IVCOMP) 20140, 10140, 20140 04720352 +30140 IVDELE = IVDELE + 1 04730352 + WRITE (I02,80000) IVTNUM 04740352 + IF (ICZERO) 10140, 0151, 20140 04750352 +10140 IVPASS = IVPASS + 1 04760352 + WRITE (I02,80002) IVTNUM 04770352 + GO TO 0151 04780352 +20140 IVFAIL = IVFAIL + 1 04790352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04800352 + 0151 CONTINUE 04810352 +C 04820352 +C **** FCVS PROGRAM 352 - TEST 015 **** 04830352 +C 04840352 +C TEST 15 CHECKS REAL-VARIABLE .LT. ARRAY-ELEMENT 04850352 +C 04860352 + IVTNUM = 15 04870352 + IF (ICZERO) 30150, 0150, 30150 04880352 + 0150 CONTINUE 04890352 + RADN11(1) = 1.9999 E17 04900352 + RVON01 = 1.0001 E17 04910352 + IVCOMP = 0 04920352 + IVCORR = 0 04930352 +40150 IF (RVON01 .LT. RADN11(1)) GO TO 40151 04940352 + IVCOMP = 1 04950352 +40151 IF (RVON01 .GE. RADN11(1)) IVCOMP = IVCOMP + 2 04960352 + IF (IVCOMP) 20150, 10150, 20150 04970352 +30150 IVDELE = IVDELE + 1 04980352 + WRITE (I02,80000) IVTNUM 04990352 + IF (ICZERO) 10150, 0161, 20150 05000352 +10150 IVPASS = IVPASS + 1 05010352 + WRITE (I02,80002) IVTNUM 05020352 + GO TO 0161 05030352 +20150 IVFAIL = IVFAIL + 1 05040352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05050352 + 0161 CONTINUE 05060352 +C 05070352 +C **** FCVS PROGRAM 352 - TEST 016 **** 05080352 +C 05090352 +C TEST 16 CHECKS REAL-VARIABLE .LT. FUNCTION-REFERENCE 05100352 +C 05110352 + IVTNUM = 16 05120352 + IF (ICZERO) 30160, 0160, 30160 05130352 + 0160 CONTINUE 05140352 + RVON01 = 1.0001 E17 05150352 + RVON02 = 1 E17 05160352 + RVON03 = 0.9999 E17 05170352 + IVCOMP = 0 05180352 + IVCORR = 0 05190352 +40160 IF (RVON01 .LT. RFOS01(RVON02,RVON03)) GO TO 40161 05200352 + IVCOMP = 1 05210352 +40161 IF (RVON01 .GE. RFOS01(RVON02,RVON03)) IVCOMP = IVCOMP + 2 05220352 + IF (IVCOMP) 20160, 10160, 20160 05230352 +30160 IVDELE = IVDELE + 1 05240352 + WRITE (I02,80000) IVTNUM 05250352 + IF (ICZERO) 10160, 0171, 20160 05260352 +10160 IVPASS = IVPASS + 1 05270352 + WRITE (I02,80002) IVTNUM 05280352 + GO TO 0171 05290352 +20160 IVFAIL = IVFAIL + 1 05300352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05310352 + 0171 CONTINUE 05320352 +C 05330352 +C TESTS 17 THROUGH 20 CHECK REAL-CONSTANT .LT. OTHER-REAL-TYPES05340352 +C 05350352 +C 05360352 +C **** FCVS PROGRAM 352 - TEST 017 **** 05370352 +C 05380352 +C TEST 17 CHECKS REAL-CONSTANT .LT. REAL-CONSTANT 05390352 +C 05400352 + IVTNUM = 17 05410352 + IF (ICZERO) 30170, 0170, 30170 05420352 + 0170 CONTINUE 05430352 + IVCOMP = 0 05440352 + IVCORR = 0 05450352 +40170 IF (1.0001 E17 .LT. 1.9999 E17) GO TO 40171 05460352 + IVCOMP = 1 05470352 +40171 IF (1.0001 E17 .GE. 1.9999 E17) IVCOMP = IVCOMP + 2 05480352 + IF (IVCOMP) 20170, 10170, 20170 05490352 +30170 IVDELE = IVDELE + 1 05500352 + WRITE (I02,80000) IVTNUM 05510352 + IF (ICZERO) 10170, 0181, 20170 05520352 +10170 IVPASS = IVPASS + 1 05530352 + WRITE (I02,80002) IVTNUM 05540352 + GO TO 0181 05550352 +20170 IVFAIL = IVFAIL + 1 05560352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05570352 + 0181 CONTINUE 05580352 +C 05590352 +C **** FCVS PROGRAM 352 - TEST 018 **** 05600352 +C 05610352 +C TEST 18 CHECKS REAL-CONSTANT .LT. REAL-ARRAY-ELEMENT 05620352 +C 05630352 + IVTNUM = 18 05640352 + IF (ICZERO) 30180, 0180, 30180 05650352 + 0180 CONTINUE 05660352 + RADN11(1) = 1.9999 E17 05670352 + IVCOMP = 0 05680352 + IVCORR = 0 05690352 +40180 IF (1.0001 E17 .LT. RADN11(1)) GO TO 40181 05700352 + IVCOMP = 1 05710352 +40181 IF (1.0001 E17 .GE. RADN11(1)) IVCOMP = IVCOMP + 2 05720352 + IF (IVCOMP) 20180, 10180, 20180 05730352 +30180 IVDELE = IVDELE + 1 05740352 + WRITE (I02,80000) IVTNUM 05750352 + IF (ICZERO) 10180, 0191, 20180 05760352 +10180 IVPASS = IVPASS + 1 05770352 + WRITE (I02,80002) IVTNUM 05780352 + GO TO 0191 05790352 +20180 IVFAIL = IVFAIL + 1 05800352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05810352 + 0191 CONTINUE 05820352 +C 05830352 +C **** FCVS PROGRAM 352 - TEST 019 **** 05840352 +C 05850352 +C TEST 19 CHECKS REAL-CONSTANT .LT. REAL-VARIABLE 05860352 +C 05870352 + IVTNUM = 19 05880352 + IF (ICZERO) 30190, 0190, 30190 05890352 + 0190 CONTINUE 05900352 + RVON01 = 1.9999 E17 05910352 + IVCOMP = 0 05920352 + IVCORR = 0 05930352 +40190 IF (1.0001 E17 .LT. RVON01) GO TO 40191 05940352 + IVCOMP = 1 05950352 +40191 IF (1.0001 E17 .GE. RVON01) IVCOMP = IVCOMP + 2 05960352 + IF (IVCOMP) 20190, 10190, 20190 05970352 +30190 IVDELE = IVDELE + 1 05980352 + WRITE (I02,80000) IVTNUM 05990352 + IF (ICZERO) 10190, 0201, 20190 06000352 +10190 IVPASS = IVPASS + 1 06010352 + WRITE (I02,80002) IVTNUM 06020352 + GO TO 0201 06030352 +20190 IVFAIL = IVFAIL + 1 06040352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06050352 + 0201 CONTINUE 06060352 +C 06070352 +C **** FCVS PROGRAM 352 - TEST 020 **** 06080352 +C 06090352 +C TEST 20 CHECKS REAL-CONSTANT .LT. REAL-FUNCTION-REFERENCE 06100352 +C 06110352 + IVTNUM = 20 06120352 + IF (ICZERO) 30200, 0200, 30200 06130352 + 0200 CONTINUE 06140352 + RVON01 = 1 E17 06150352 + RVON02 = 0.9999 E17 06160352 + IVCOMP = 0 06170352 + IVCORR = 0 06180352 +40200 IF (1.0001 E17 .LT. RFOS01(RVON01,RVON02)) GO TO 40201 06190352 + IVCOMP = 1 06200352 +40201 IF (1.0001 E17 .GE. RFOS01(RVON01,RVON02)) IVCOMP = IVCOMP + 2 06210352 + IF (IVCOMP) 20200, 10200, 20200 06220352 +30200 IVDELE = IVDELE + 1 06230352 + WRITE (I02,80000) IVTNUM 06240352 + IF (ICZERO) 10200, 0211, 20200 06250352 +10200 IVPASS = IVPASS + 1 06260352 + WRITE (I02,80002) IVTNUM 06270352 + GO TO 0211 06280352 +20200 IVFAIL = IVFAIL + 1 06290352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06300352 + 0211 CONTINUE 06310352 +C 06320352 +C TESTS 21 THROUGH 24 CHECK REAL-ARRAY-ELEMENT .LT. OTHER-REALS06330352 +C 06340352 +C 06350352 +C **** FCVS PROGRAM 352 - TEST 021 **** 06360352 +C 06370352 +C TEST 21 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-CONSTANT 06380352 +C 06390352 + IVTNUM = 21 06400352 + IF (ICZERO) 30210, 0210, 30210 06410352 + 0210 CONTINUE 06420352 + RADN11(1) = 1.0001 E17 06430352 + IVCOMP = 0 06440352 + IVCORR = 0 06450352 +40210 IF (RADN11(1) .LT. 1.9999 E17) GO TO 40211 06460352 + IVCOMP = 1 06470352 +40211 IF (RADN11(1) .GE. 1.9999 E17) IVCOMP = IVCOMP + 2 06480352 + IF (IVCOMP) 20210, 10210, 20210 06490352 +30210 IVDELE = IVDELE + 1 06500352 + WRITE (I02,80000) IVTNUM 06510352 + IF (ICZERO) 10210, 0221, 20210 06520352 +10210 IVPASS = IVPASS + 1 06530352 + WRITE (I02,80002) IVTNUM 06540352 + GO TO 0221 06550352 +20210 IVFAIL = IVFAIL + 1 06560352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06570352 + 0221 CONTINUE 06580352 +C 06590352 +C **** FCVS PROGRAM 352 - TEST 022 **** 06600352 +C 06610352 +C TEST 22 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-ARRAY-ELEMENT 06620352 +C 06630352 + IVTNUM = 22 06640352 + IF (ICZERO) 30220, 0220, 30220 06650352 + 0220 CONTINUE 06660352 + RADN11(1) = 1.0001 E17 06670352 + RADN11(2) = 1.9999 E17 06680352 + IVCOMP = 0 06690352 + IVCORR = 0 06700352 +40220 IF (RADN11(1) .LT. RADN11(2)) GO TO 40221 06710352 + IVCOMP = 1 06720352 +40221 IF (RADN11(1) .GE. RADN11(2)) IVCOMP = IVCOMP + 2 06730352 + IF (IVCOMP) 20220, 10220, 20220 06740352 +30220 IVDELE = IVDELE + 1 06750352 + WRITE (I02,80000) IVTNUM 06760352 + IF (ICZERO) 10220, 0231, 20220 06770352 +10220 IVPASS = IVPASS + 1 06780352 + WRITE (I02,80002) IVTNUM 06790352 + GO TO 0231 06800352 +20220 IVFAIL = IVFAIL + 1 06810352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06820352 + 0231 CONTINUE 06830352 +C 06840352 +C **** FCVS PROGRAM 352 - TEST 023 **** 06850352 +C 06860352 +C TEST 23 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-VARIABLE 06870352 +C 06880352 + IVTNUM = 23 06890352 + IF (ICZERO) 30230, 0230, 30230 06900352 + 0230 CONTINUE 06910352 + RVON01 = 1.9999 E17 06920352 + RADN11(1) = 1.0001 E17 06930352 + IVCORR = 0 06940352 + IVCOMP = 0 06950352 +40230 IF (RADN11(1) .LT. RVON01) GO TO 40231 06960352 + IVCOMP = 1 06970352 +40231 IF (RADN11(1) .GE. RVON01) IVCOMP = IVCOMP + 2 06980352 + IF (IVCOMP) 20230, 10230, 20230 06990352 +30230 IVDELE = IVDELE + 1 07000352 + WRITE (I02,80000) IVTNUM 07010352 + IF (ICZERO) 10230, 0241, 20230 07020352 +10230 IVPASS = IVPASS + 1 07030352 + WRITE (I02,80002) IVTNUM 07040352 + GO TO 0241 07050352 +20230 IVFAIL = IVFAIL + 1 07060352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07070352 + 0241 CONTINUE 07080352 +C 07090352 +C **** FCVS PROGRAM 352 - TEST 024 **** 07100352 +C 07110352 +C TEST 24 CHECKS REAL-ARRAY-ELEMENT .LT. REAL-FUNCTION-REF. 07120352 +C 07130352 + IVTNUM = 24 07140352 + IF (ICZERO) 30240, 0240, 30240 07150352 + 0240 CONTINUE 07160352 + RVON01 = 1.0000 E17 07170352 + RVON02 = 0.9999 E17 07180352 + RADN11(1) = 1.0001 E17 07190352 + IVCORR = 0 07200352 + IVCOMP = 0 07210352 +40240 IF (RADN11(1) .LT. RFOS01(RVON01,RVON02)) GO TO 40241 07220352 + IVCOMP = 1 07230352 +40241 IF (RADN11(1) .GE. RFOS01(RVON01,RVON02)) IVCOMP = IVCOMP + 2 07240352 + IF (IVCOMP) 20240, 10240, 20240 07250352 +30240 IVDELE = IVDELE + 1 07260352 + WRITE (I02,80000) IVTNUM 07270352 + IF (ICZERO) 10240, 0251, 20240 07280352 +10240 IVPASS = IVPASS + 1 07290352 + WRITE (I02,80002) IVTNUM 07300352 + GO TO 0251 07310352 +20240 IVFAIL = IVFAIL + 1 07320352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07330352 + 0251 CONTINUE 07340352 +C 07350352 +C TESTS 25 THROUGH 28 CHECK REAL-FUNCTION-REFERENCE .LT. 07360352 +C OTHER-REAL-TYPES 07370352 +C 07380352 +C 07390352 +C **** FCVS PROGRAM 352 - TEST 025 **** 07400352 +C 07410352 +C TEST 25 CHECKS REAL-FUNCTION-REFERENCE .LT. REAL-CONSTANT 07420352 +C 07430352 + IVTNUM = 25 07440352 + IF (ICZERO) 30250, 0250, 30250 07450352 + 0250 CONTINUE 07460352 + RVON01 = 1.0000 E17 07470352 + RVON02 = 0.0001 E17 07480352 + IVCOMP = 0 07490352 + IVCORR = 0 07500352 +40250 IF (RFOS01(RVON01,RVON02) .LT. 1.9999 E17) GO TO 40251 07510352 + IVCOMP = 1 07520352 +40251 IF (RFOS01(RVON01,RVON02) .GE. 1.9999 E17) IVCOMP = IVCOMP + 2 07530352 + IF (IVCOMP) 20250, 10250, 20250 07540352 +30250 IVDELE = IVDELE + 1 07550352 + WRITE (I02,80000) IVTNUM 07560352 + IF (ICZERO) 10250, 0261, 20250 07570352 +10250 IVPASS = IVPASS + 1 07580352 + WRITE (I02,80002) IVTNUM 07590352 + GO TO 0261 07600352 +20250 IVFAIL = IVFAIL + 1 07610352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07620352 + 0261 CONTINUE 07630352 +C 07640352 +C **** FCVS PROGRAM 352 - TEST 026 **** 07650352 +C 07660352 +C TEST 26 CHECKS REAL-FUNCTION-REFERENCE .LT. REAL-ARRAY-ELEMNT07670352 +C 07680352 + IVTNUM = 26 07690352 + IF (ICZERO) 30260, 0260, 30260 07700352 + 0260 CONTINUE 07710352 + RVON01 = 1 E17 07720352 + RVON02 = 0.0001 E17 07730352 + RADN11(1) = 1.9999 E17 07740352 + IVCOMP = 0 07750352 + IVCORR = 0 07760352 +40260 IF (RFOS01(RVON01,RVON02) .LT. RADN11(1)) GO TO 40261 07770352 + IVCOMP = 1 07780352 +40261 IF (RFOS01(RVON01,RVON02) .GE. RADN11(1)) IVCOMP = IVCOMP + 2 07790352 + IF (IVCOMP) 20260, 10260, 20260 07800352 +30260 IVDELE = IVDELE + 1 07810352 + WRITE (I02,80000) IVTNUM 07820352 + IF (ICZERO) 10260, 0271, 20260 07830352 +10260 IVPASS = IVPASS + 1 07840352 + WRITE (I02,80002) IVTNUM 07850352 + GO TO 0271 07860352 +20260 IVFAIL = IVFAIL + 1 07870352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07880352 + 0271 CONTINUE 07890352 +C 07900352 +C **** FCVS PROGRAM 352 - TEST 027 **** 07910352 +C 07920352 +C TEST 27 CHECKS REAL-FUNCTION-REFERENCE .LT. REAL-VARIABLE 07930352 +C 07940352 + IVTNUM = 27 07950352 + IF (ICZERO) 30270, 0270, 30270 07960352 + 0270 CONTINUE 07970352 + RVON01 = 1 E17 07980352 + RVON02 = 0.0001 E17 07990352 + RVON03 = 1.9999 E17 08000352 + IVCOMP = 0 08010352 + IVCORR = 0 08020352 +40270 IF (RFOS01(RVON01,RVON02) .LT. RVON03) GO TO 40271 08030352 + IVCOMP = 1 08040352 +40271 IF (RFOS01(RVON01,RVON02) .GE. RVON03) IVCOMP = IVCOMP + 2 08050352 + IF (IVCOMP) 20270, 10270, 20270 08060352 +30270 IVDELE = IVDELE + 1 08070352 + WRITE (I02,80000) IVTNUM 08080352 + IF (ICZERO) 10270, 0281, 20270 08090352 +10270 IVPASS = IVPASS + 1 08100352 + WRITE (I02,80002) IVTNUM 08110352 + GO TO 0281 08120352 +20270 IVFAIL = IVFAIL + 1 08130352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08140352 + 0281 CONTINUE 08150352 +C 08160352 +C **** FCVS PROGRAM 352 - TEST 028 **** 08170352 +C 08180352 +C TEST 28 CHECKS REAL-FUNCTION-REFERENCE .LT REAL-FUNCTION-REF.08190352 +C 08200352 + IVTNUM = 28 08210352 + IF (ICZERO) 30280, 0280, 30280 08220352 + 0280 CONTINUE 08230352 + RVON01 = 1 E17 08240352 + RVON02 = 0.0001 E17 08250352 + RVON03 = 0.9999 E17 08260352 + IVCOMP = 0 08270352 + IVCORR = 0 08280352 +40280 IF (RFOS01(RVON01,RVON02) .LT. RFOS01(RVON01,RVON03)) GO TO 40281 08290352 + IVCOMP = 1 08300352 +40281 IF (RFOS01(RVON01,RVON02) .GE. RFOS01(RVON01,RVON03)) 08310352 + 1 IVCOMP = IVCOMP + 2 08320352 + IF (IVCOMP) 20280, 10280, 20280 08330352 +30280 IVDELE = IVDELE + 1 08340352 + WRITE (I02,80000) IVTNUM 08350352 + IF (ICZERO) 10280, 0291, 20280 08360352 +10280 IVPASS = IVPASS + 1 08370352 + WRITE (I02,80002) IVTNUM 08380352 + GO TO 0291 08390352 +20280 IVFAIL = IVFAIL + 1 08400352 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08410352 + 0291 CONTINUE 08420352 +C 08430352 +C 08440352 +C WRITE OUT TEST SUMMARY 08450352 +C 08460352 + WRITE (I02,90004) 08470352 + WRITE (I02,90014) 08480352 + WRITE (I02,90004) 08490352 + WRITE (I02,90000) 08500352 + WRITE (I02,90004) 08510352 + WRITE (I02,90020) IVFAIL 08520352 + WRITE (I02,90022) IVPASS 08530352 + WRITE (I02,90024) IVDELE 08540352 + STOP 08550352 +90001 FORMAT (" ",24X,"FM352") 08560352 +90000 FORMAT (" ",20X,"END OF PROGRAM FM352" ) 08570352 +C 08580352 +C FORMATS FOR TEST DETAIL LINES 08590352 +C 08600352 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 08610352 +80002 FORMAT (" ",4X,I5,7X,"PASS") 08620352 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 08630352 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 08640352 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 08650352 +C 08660352 +C FORMAT STATEMENTS FOR PAGE HEADERS 08670352 +C 08680352 +90002 FORMAT ("1") 08690352 +90004 FORMAT (" ") 08700352 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08710352 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 08720352 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 08730352 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 08740352 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 08750352 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 08760352 +C 08770352 +C FORMAT STATEMENTS FOR RUN SUMMARY 08780352 +C 08790352 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 08800352 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 08810352 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 08820352 + END 08830352 diff --git a/Fortran/UnitTests/fcvs21_f95/FM352.reference_output b/Fortran/UnitTests/fcvs21_f95/FM352.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM352.reference_output @@ -0,0 +1,49 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM352 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + + ---------------------------------------------- + + END OF PROGRAM FM352 + + 0 TESTS FAILED + 28 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM353.f b/Fortran/UnitTests/fcvs21_f95/FM353.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM353.f @@ -0,0 +1,316 @@ + PROGRAM FM353 + +C***********************************************************************00010353 +C***** FORTRAN 77 00020353 +C***** FM353 XINT - (150) 00030353 +C***** 00040353 +C***********************************************************************00050353 +C***** GENERAL PURPOSE SUBSET REF00060353 +C***** TEST INTRINSIC FUNCTION - IFIX - (CONVERSION FROM 15.3 00070353 +C***** REAL TO INTEGER) (TABLE 5)00080353 +C***** TEST INTRINSIC FUNCTION - INT - (TRUNCATION -- SIGN 00090353 +C***** OF A * LARGEST INTEGER LE ABS(A) ) 00100353 +C***** 00110353 +C***** 00120353 +CBB** ********************** BBCCOMNT **********************************00130353 +C**** 00140353 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150353 +C**** VERSION 2.1 00160353 +C**** 00170353 +C**** 00180353 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190353 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200353 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00210353 +C**** BUILDING 225 RM A266 00220353 +C**** GAITHERSBURG, MD 20899 00230353 +C**** 00240353 +C**** 00250353 +C**** 00260353 +CBE** ********************** BBCCOMNT **********************************00270353 +CBB** ********************** BBCINITA **********************************00280353 +C**** SPECIFICATION STATEMENTS 00290353 +C**** 00300353 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310353 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320353 +CBE** ********************** BBCINITA **********************************00330353 +CBB** ********************** BBCINITB **********************************00340353 +C**** INITIALIZE SECTION 00350353 + DATA ZVERS, ZVERSD, ZDATE 00360353 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00370353 + DATA ZCOMPL, ZNAME, ZTAPE 00380353 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00390353 + DATA ZPROJ, ZTAPED, ZPROG 00400353 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00410353 + DATA REMRKS /' '/ 00420353 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00430353 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00440353 +C**** 00450353 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00460353 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00470353 +CZ03 ZPROG = 'PROGRAM NAME' 00480353 +CZ04 ZDATE = 'DATE OF TEST' 00490353 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00500353 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00510353 +CZ07 ZNAME = 'NAME OF USER' 00520353 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00530353 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00540353 +C 00550353 + IVPASS = 0 00560353 + IVFAIL = 0 00570353 + IVDELE = 0 00580353 + IVINSP = 0 00590353 + IVTOTL = 0 00600353 + IVTOTN = 0 00610353 + ICZERO = 0 00620353 +C 00630353 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640353 + I01 = 05 00650353 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660353 + I02 = 06 00670353 +C 00680353 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690353 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700353 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00710353 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00720353 +C 00730353 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00740353 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00750353 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00760353 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00770353 +C 00780353 +CBE** ********************** BBCINITB **********************************00790353 + NUVI = I02 00800353 + IVTOTL = 14 00810353 + ZPROG='FM353' 00820353 +CBB** ********************** BBCHED0A **********************************00830353 +C**** 00840353 +C**** WRITE REPORT TITLE 00850353 +C**** 00860353 + WRITE (I02, 90002) 00870353 + WRITE (I02, 90006) 00880353 + WRITE (I02, 90007) 00890353 + WRITE (I02, 90008) ZVERS, ZVERSD 00900353 + WRITE (I02, 90009) ZPROG, ZPROG 00910353 + WRITE (I02, 90010) ZDATE, ZCOMPL 00920353 +CBE** ********************** BBCHED0A **********************************00930353 +C***** 00940353 +C***** HEADER FOR SEGMENT 150 00950353 + WRITE (NUVI,15001) 00960353 +15001 FORMAT (" ",/ 2X,"XINT - (150) INTRINSIC FUNCTIONS--" /17X, 00970353 + 1 " IFIX, INT (TYPE CONVERSION)" / 2X, 00980353 + 2 "SUBSET REF. - 15.3" ) 00990353 +C***** 01000353 +CBB** ********************** BBCHED0B **********************************01010353 +C**** WRITE DETAIL REPORT HEADERS 01020353 +C**** 01030353 + WRITE (I02,90004) 01040353 + WRITE (I02,90004) 01050353 + WRITE (I02,90013) 01060353 + WRITE (I02,90014) 01070353 + WRITE (I02,90015) IVTOTL 01080353 +CBE** ********************** BBCHED0B **********************************01090353 +15003 FORMAT(1X,2X,I3,4X,"INSPECT",5X, I5, 5X, I5) 01100353 +15004 FORMAT( /48X," BELOW ANSWERS SHOULD BE ZERO " /49X, 01110353 + 1 "FOR TEST SEGMENT TO PASS " ) 01120353 +15005 FORMAT (49X,"- EACH TEST HAS TWO PARTS." ) 01130353 + WRITE (NUVI, 15005) 01140353 + WRITE(NUVI, 15004) 01150353 + WRITE(NUVI,15002) 01160353 +15002 FORMAT (23X, " IFIX", 5X, " INT ") 01170353 +C***** 01180353 +CT001* TEST 1 THE VALUE ZERO 01190353 + IVTNUM = 1 01200353 + RACVS = 0.0 01210353 + IAAVI = IFIX(RACVS) 01220353 + IABVI = INT(RACVS) 01230353 + IADVI = IAAVI - 0 01240353 + IAEVI = IABVI - 0 01250353 + WRITE(NUVI,15003) IVTNUM,IADVI, IAEVI 01260353 +CT002* TEST 2 A VALUE IN (0,1) 01270353 + IVTNUM = 2 01280353 + RACVS = 0.375 01290353 + IAAVI = IFIX(RACVS) 01300353 + IABVI = INT(RACVS) 01310353 + IADVI = IAAVI - 0 01320353 + IAEVI = IABVI - 0 01330353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 01340353 +CT003* TEST 3 THE VALUE ONE 01350353 + IVTNUM = 3 01360353 + RACVS = 1.00001 01370353 + IAAVI = IFIX(RACVS) 01380353 + IABVI = INT(RACVS) 01390353 + IADVI = IAAVI - 1 01400353 + IAEVI = IABVI - 1 01410353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 01420353 +CT004* TEST 4 AN INTEGRAL VALUE OTHER THAN 0 OR 1 01430353 + IVTNUM = 4 01440353 + RACVS = 6.00001 01450353 + IAAVI = IFIX(RACVS) 01460353 + IABVI = INT(RACVS) 01470353 + IADVI = IAAVI - 6 01480353 + IAEVI = IABVI - 6 01490353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 01500353 +CT005* TEST 5 A VALUE IN (X,X+1) 01510353 + IVTNUM = 5 01520353 + RACVS = 3.75 01530353 + IAAVI = IFIX(RACVS) 01540353 + IABVI = INT(RACVS) 01550353 + IADVI = IAAVI - 3 01560353 + IAEVI = IABVI - 3 01570353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 01580353 +CT006* TEST 6 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1) 01590353 + IVTNUM = 6 01600353 + RACVS = -0.375 01610353 + IAAVI = IFIX(RACVS) 01620353 + IABVI = INT(RACVS) 01630353 + IADVI = IAAVI - 0 01640353 + IAEVI = IABVI - 0 01650353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 01660353 +CT007* TEST 7 THE VALUE -1 01670353 + IVTNUM = 7 01680353 + RACVS = -1.00001 01690353 + IAAVI = IFIX(RACVS) 01700353 + IABVI = INT(RACVS) 01710353 + IADVI = IAAVI + 1 01720353 + IAEVI = IABVI + 1 01730353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 01740353 +CT008* TEST 8 A NEGATIVE INTEGRAL VALUE 01750353 + IVTNUM = 8 01760353 + RACVS = -6.00001 01770353 + IAAVI = IFIX(RACVS) 01780353 + IABVI = INT(RACVS) 01790353 + IADVI = IAAVI + 6 01800353 + IAEVI = IABVI + 6 01810353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 01820353 +CT009* TEST 9 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1) 01830353 + IVTNUM = 9 01840353 + RACVS = -3.75 01850353 + IAAVI = IFIX(RACVS) 01860353 + IABVI = INT(RACVS) 01870353 + IADVI = IAAVI + 3 01880353 + IAEVI = IABVI + 3 01890353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 01900353 +CT010* TEST 10 ZERO PREFIXED WITH A MINUS SIGN 01910353 + IVTNUM = 10 01920353 + RACVS = 0 01930353 + IAAVI = IFIX(-RACVS) 01940353 + IABVI = INT(-RACVS) 01950353 + IADVI = IAAVI - 0 01960353 + IAEVI = IABVI - 0 01970353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 01980353 +CT011* TEST 011 IFIX, INT USED IN AN ARITHMETIC EXPRESSION 01990353 + IVTNUM = 011 02000353 + RAAVS = 3.75 02010353 + IAFVI = 3 02020353 + IAAVI = 25 + IAFVI * IFIX(RAAVS) 02030353 + IABVI = 25 + IAFVI * INT(RAAVS) 02040353 + IADVI = IAAVI - 34 02050353 + IAEVI = IABVI - 34 02060353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 02070353 +CT012* TEST 12 AN ARITHMETIC EXPRESSION PRESENTED TO IFIX, INT 02080353 + IVTNUM = 12 02090353 + RAAVS = 25.5 02100353 + RABVS = 12.25 02110353 + IAAVI = IFIX(RAAVS - RABVS) 02120353 + IABVI = INT(RAAVS - RABVS) 02130353 + IADVI = IAAVI - 13 02140353 + IAEVI = IABVI - 13 02150353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 02160353 +CT013* TEST 13 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 02170353 + IVTNUM = 13 02180353 + RAAVS = 11.75 02190353 + RABVS = 12.625 02200353 + IAAVI = IFIX(RAAVS + RABVS) 02210353 + IABVI = INT(RAAVS + RABVS) 02220353 + IACVI = RAAVS + RABVS 02230353 + IADVI = IAAVI - IACVI 02240353 + IAEVI = IABVI - IACVI 02250353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 02260353 +CT014* TEST 14 ARGUMENT OF LOW MAGNITUDE 02270353 + IVTNUM = 14 02280353 + RACVS = -3.05923E-33 02290353 + IAAVI = IFIX(RACVS) 02300353 + IABVI = INT(RACVS) 02310353 + IADVI = IAAVI - 0 02320353 + IAEVI = IABVI - 0 02330353 + WRITE(NUVI,15003) IVTNUM, IADVI, IAEVI 02340353 +C***** 02350353 +C***** 02360353 + IVINSP = 14 02370353 +CBB** ********************** BBCSUM0 **********************************02380353 +C**** WRITE OUT TEST SUMMARY 02390353 +C**** 02400353 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02410353 + WRITE (I02, 90004) 02420353 + WRITE (I02, 90014) 02430353 + WRITE (I02, 90004) 02440353 + WRITE (I02, 90020) IVPASS 02450353 + WRITE (I02, 90022) IVFAIL 02460353 + WRITE (I02, 90024) IVDELE 02470353 + WRITE (I02, 90026) IVINSP 02480353 + WRITE (I02, 90028) IVTOTN, IVTOTL 02490353 +CBE** ********************** BBCSUM0 **********************************02500353 +CBB** ********************** BBCFOOT0 **********************************02510353 +C**** WRITE OUT REPORT FOOTINGS 02520353 +C**** 02530353 + WRITE (I02,90016) ZPROG, ZPROG 02540353 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02550353 + WRITE (I02,90019) 02560353 +CBE** ********************** BBCFOOT0 **********************************02570353 +CBB** ********************** BBCFMT0A **********************************02580353 +C**** FORMATS FOR TEST DETAIL LINES 02590353 +C**** 02600353 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02610353 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02620353 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02630353 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02640353 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02650353 + 1I6,/," ",15X,"CORRECT= " ,I6) 02660353 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02670353 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02680353 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02690353 + 1A21,/," ",16X,"CORRECT= " ,A21) 02700353 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02710353 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02720353 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02730353 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02740353 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02750353 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02760353 +80050 FORMAT (" ",48X,A31) 02770353 +CBE** ********************** BBCFMT0A **********************************02780353 +CBB** ********************** BBCFMT0B **********************************02790353 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02800353 +C**** 02810353 +90002 FORMAT ("1") 02820353 +90004 FORMAT (" ") 02830353 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02840353 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02850353 +90008 FORMAT (" ",21X,A13,A17) 02860353 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02870353 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02880353 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02890353 + 1 7X,"REMARKS",24X) 02900353 +90014 FORMAT (" ","----------------------------------------------" , 02910353 + 1 "---------------------------------" ) 02920353 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02930353 +C**** 02940353 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02950353 +C**** 02960353 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02970353 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02980353 + 1 A13) 02990353 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03000353 +C**** 03010353 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03020353 +C**** 03030353 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03040353 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03050353 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03060353 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03070353 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03080353 +CBE** ********************** BBCFMT0B **********************************03090353 +C***** 03100353 +C***** END OF TEST SEGMENT 150 03110353 + STOP 03120353 + END 03130353 + 03140353 diff --git a/Fortran/UnitTests/fcvs21_f95/FM353.reference_output b/Fortran/UnitTests/fcvs21_f95/FM353.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM353.reference_output @@ -0,0 +1,51 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM353BEGIN* TEST RESULTS - FM353 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XINT - (150) INTRINSIC FUNCTIONS-- + IFIX, INT (TYPE CONVERSION) + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 14 TESTS + + - EACH TEST HAS TWO PARTS. + + BELOW ANSWERS SHOULD BE ZERO + FOR TEST SEGMENT TO PASS + IFIX INT + 1 INSPECT 0 0 + 2 INSPECT 0 0 + 3 INSPECT 0 0 + 4 INSPECT 0 0 + 5 INSPECT 0 0 + 6 INSPECT 0 0 + 7 INSPECT 0 0 + 8 INSPECT 0 0 + 9 INSPECT 0 0 + 10 INSPECT 0 0 + 11 INSPECT 0 0 + 12 INSPECT 0 0 + 13 INSPECT 0 0 + 14 INSPECT 0 0 + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 14 TESTS REQUIRE INSPECTION + 14 OF 14 TESTS EXECUTED + + *FM353END* END OF TEST - FM353 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM354.f b/Fortran/UnitTests/fcvs21_f95/FM354.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM354.f @@ -0,0 +1,382 @@ + PROGRAM FM354 + +C***********************************************************************00010354 +C***** FORTRAN 77 00020354 +C***** FM354 XREAL - (152) 00030354 +C***** 00040354 +C***********************************************************************00050354 +C***** GENERAL PURPOSE SUBSET REF00060354 +C***** TEST INTRINSIC FUNCTIONS FLOAT AND REAL 15.3 00070354 +C***** (CONVERSION FROM INTEGER TO REAL) (TABLE 5)00080354 +C***** 00090354 +CBB** ********************** BBCCOMNT **********************************00100354 +C**** 00110354 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120354 +C**** VERSION 2.1 00130354 +C**** 00140354 +C**** 00150354 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160354 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170354 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180354 +C**** BUILDING 225 RM A266 00190354 +C**** GAITHERSBURG, MD 20899 00200354 +C**** 00210354 +C**** 00220354 +C**** 00230354 +CBE** ********************** BBCCOMNT **********************************00240354 +CBB** ********************** BBCINITA **********************************00250354 +C**** SPECIFICATION STATEMENTS 00260354 +C**** 00270354 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00280354 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00290354 +CBE** ********************** BBCINITA **********************************00300354 +CBB** ********************** BBCINITB **********************************00310354 +C**** INITIALIZE SECTION 00320354 + DATA ZVERS, ZVERSD, ZDATE 00330354 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00340354 + DATA ZCOMPL, ZNAME, ZTAPE 00350354 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00360354 + DATA ZPROJ, ZTAPED, ZPROG 00370354 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00380354 + DATA REMRKS /' '/ 00390354 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00400354 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00410354 +C**** 00420354 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00430354 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00440354 +CZ03 ZPROG = 'PROGRAM NAME' 00450354 +CZ04 ZDATE = 'DATE OF TEST' 00460354 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00470354 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00480354 +CZ07 ZNAME = 'NAME OF USER' 00490354 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00500354 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00510354 +C 00520354 + IVPASS = 0 00530354 + IVFAIL = 0 00540354 + IVDELE = 0 00550354 + IVINSP = 0 00560354 + IVTOTL = 0 00570354 + IVTOTN = 0 00580354 + ICZERO = 0 00590354 +C 00600354 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00610354 + I01 = 05 00620354 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00630354 + I02 = 06 00640354 +C 00650354 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00660354 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670354 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00680354 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00690354 +C 00700354 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00710354 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00720354 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00730354 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00740354 +C 00750354 +CBE** ********************** BBCINITB **********************************00760354 + NUVI = I02 00770354 + IVTOTL = 14 00780354 + ZPROG = 'FM354' 00790354 +CBB** ********************** BBCHED0A **********************************00800354 +C**** 00810354 +C**** WRITE REPORT TITLE 00820354 +C**** 00830354 + WRITE (I02, 90002) 00840354 + WRITE (I02, 90006) 00850354 + WRITE (I02, 90007) 00860354 + WRITE (I02, 90008) ZVERS, ZVERSD 00870354 + WRITE (I02, 90009) ZPROG, ZPROG 00880354 + WRITE (I02, 90010) ZDATE, ZCOMPL 00890354 +CBE** ********************** BBCHED0A **********************************00900354 +C***** 00910354 +C***** HEADER FOR SEGMENT 152 00920354 + WRITE (NUVI,15201) 00930354 +15201 FORMAT (" ", // 2X,"XREAL - (152) INTRINSIC FUNCTIONS--" //17X, 00940354 + 1 "FLOAT, REAL (TYPE CONVERSION)" // 2X, 00950354 + 2 "SUBSET REF. - 15.3" ) 00960354 +CBB** ********************** BBCHED0B **********************************00970354 +C**** WRITE DETAIL REPORT HEADERS 00980354 +C**** 00990354 + WRITE (I02,90004) 01000354 + WRITE (I02,90004) 01010354 + WRITE (I02,90013) 01020354 + WRITE (I02,90014) 01030354 + WRITE (I02,90015) IVTOTL 01040354 +CBE** ********************** BBCHED0B **********************************01050354 +C***** 01060354 +C***** TEST OF FLOAT 01070354 +C***** 01080354 + WRITE(NUVI, 15204) 01090354 +15204 FORMAT (/ 8X, "TEST OF FLOAT" ) 01100354 +CT001* TEST 1 THE VALUE ZERO 01110354 + IVTNUM = 1 01120354 + IBCVI = 0 01130354 + RBAVS = FLOAT(IBCVI) 01140354 + IF (RBAVS + 0.00005) 20010, 10010, 40010 01150354 +40010 IF (RBAVS - 0.00005) 10010, 10010, 20010 01160354 +10010 IVPASS = IVPASS + 1 01170354 + WRITE (NUVI, 80002) IVTNUM 01180354 + GO TO 0011 01190354 +20010 IVFAIL = IVFAIL + 1 01200354 + RVCORR = 0.0 01210354 + WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR 01220354 + 0011 CONTINUE 01230354 +CT002* TEST 2 A POSITIVE INTEGER 01240354 + IVTNUM = 2 01250354 + IBCVI = 3 01260354 + RBAVS = FLOAT(IBCVI) 01270354 + IF (RBAVS - 2.9998) 20020, 10020, 40020 01280354 +40020 IF (RBAVS - 3.0002) 10020, 10020, 20020 01290354 +10020 IVPASS = IVPASS + 1 01300354 + WRITE (NUVI, 80002) IVTNUM 01310354 + GO TO 0021 01320354 +20020 IVFAIL = IVFAIL + 1 01330354 + RVCORR = 3.0 01340354 + WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR 01350354 + 0021 CONTINUE 01360354 +CT003* TEST 3 A NEGATIVE INTEGER 01370354 + IVTNUM = 3 01380354 + IBCVI = -3 01390354 + RBAVS = FLOAT(IBCVI) 01400354 + IF (RBAVS + 3.0002) 20030, 10030, 40030 01410354 +40030 IF (RBAVS + 2.9998) 10030, 10030, 20030 01420354 +10030 IVPASS = IVPASS + 1 01430354 + WRITE (NUVI, 80002) IVTNUM 01440354 + GO TO 0031 01450354 +20030 IVFAIL = IVFAIL + 1 01460354 + RVCORR = -3.0 01470354 + WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR 01480354 + 0031 CONTINUE 01490354 +CT004* TEST 4 A ZERO PREFIXED WITH A MINUS SIGN 01500354 + IVTNUM = 4 01510354 + IBCVI = 0 01520354 + RBAVS = FLOAT(-IBCVI) 01530354 + IF (RBAVS + 0.00005) 20040, 10040, 40040 01540354 +40040 IF (RBAVS - 0.00005) 10040, 10040, 20040 01550354 +10040 IVPASS = IVPASS + 1 01560354 + WRITE (NUVI, 80002) IVTNUM 01570354 + GO TO 0041 01580354 +20040 IVFAIL = IVFAIL + 1 01590354 + RVCORR = 0.0 01600354 + WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR 01610354 + 0041 CONTINUE 01620354 +CT005* TEST 5 FLOAT USED IN AN ARITHMETIC EXPRESSION 01630354 + IVTNUM = 5 01640354 + RBFVS = -3.0 01650354 + IBCVI = 3 01660354 + RBAVS = 16.1875 + RBFVS/FLOAT(IBCVI) 01670354 + IF (RBAVS - 15.186) 20050, 10050, 40050 01680354 +40050 IF (RBAVS - 15.189) 10050, 10050, 20050 01690354 +10050 IVPASS = IVPASS + 1 01700354 + WRITE (NUVI, 80002) IVTNUM 01710354 + GO TO 0051 01720354 +20050 IVFAIL = IVFAIL + 1 01730354 + RVCORR = 15.1875 01740354 + WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR 01750354 + 0051 CONTINUE 01760354 +CT006* TEST 6 AN ARITHMETIC EXPRESSION PRESENTED TO FLOAT 01770354 + IVTNUM = 6 01780354 + IBAVI = -7 01790354 + IBBVI = 27 01800354 + RBAVS = FLOAT(IBAVI - IBBVI * 2) 01810354 + IF (RBAVS + 61.003) 20060, 10060, 40060 01820354 +40060 IF (RBAVS + 60.997) 10060, 10060, 20060 01830354 +10060 IVPASS = IVPASS + 1 01840354 + WRITE (NUVI, 80002) IVTNUM 01850354 + GO TO 0061 01860354 +20060 IVFAIL = IVFAIL + 1 01870354 + RVCORR = -61.0 01880354 + WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR 01890354 + 0061 CONTINUE 01900354 +CT007* TEST 7 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 01910354 + IVTNUM = 7 01920354 + IBAVI = 2 01930354 + IBBVI = 10 01940354 + RBAVS = FLOAT(IBBVI ** IBAVI) 01950354 + IF (RBAVS - 99.995) 20070, 10070, 40070 01960354 +40070 IF (RBAVS - 100.01) 10070, 10070, 20070 01970354 +10070 IVPASS = IVPASS + 1 01980354 + WRITE (NUVI, 80002) IVTNUM 01990354 + GO TO 0071 02000354 +20070 IVFAIL = IVFAIL + 1 02010354 + RVCORR = 100.0 02020354 + WRITE(NUVI, 80012) IVTNUM, RBAVS, RVCORR 02030354 + 0071 CONTINUE 02040354 +C***** 02050354 +C***** TEST OF REAL 02060354 +C***** 02070354 + WRITE(NUVI, 15202) 02080354 +15202 FORMAT (/ 08X, "TEST OF REAL" ) 02090354 +CT008* TEST 8 THE VALUE ZERO 02100354 + IVTNUM = 8 02110354 + IBCVI = 0 02120354 + RBBVS = REAL(IBCVI) 02130354 + IF (RBBVS + 0.00005) 20080, 10080, 40080 02140354 +40080 IF (RBBVS - 0.00005) 10080, 10080, 20080 02150354 +10080 IVPASS = IVPASS + 1 02160354 + WRITE (NUVI, 80002) IVTNUM 02170354 + GO TO 0081 02180354 +20080 IVFAIL = IVFAIL + 1 02190354 + RVCORR = 0.0 02200354 + WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR 02210354 + 0081 CONTINUE 02220354 +CT009* TEST 9 A POSITIVE INTEGER 02230354 + IVTNUM = 9 02240354 + IBCVI = 3 02250354 + RBBVS = REAL(IBCVI) 02260354 + IF (RBBVS - 2.9998) 20090, 10090, 40090 02270354 +40090 IF (RBBVS - 3.0002) 10090, 10090, 20090 02280354 +10090 IVPASS = IVPASS + 1 02290354 + WRITE (NUVI, 80002) IVTNUM 02300354 + GO TO 0091 02310354 +20090 IVFAIL = IVFAIL + 1 02320354 + RVCORR = 3.0 02330354 + WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR 02340354 + 0091 CONTINUE 02350354 +CT010* TEST 10 A NEGATIVE INTEGER 02360354 + IVTNUM = 10 02370354 + IBCVI = -3 02380354 + RBBVS = REAL(IBCVI) 02390354 + IF (RBBVS + 3.0002) 20100, 10100, 40100 02400354 +40100 IF (RBBVS + 2.9998) 10100, 10100, 20100 02410354 +10100 IVPASS = IVPASS + 1 02420354 + WRITE (NUVI, 80002) IVTNUM 02430354 + GO TO 0101 02440354 +20100 IVFAIL = IVFAIL + 1 02450354 + RVCORR = -3.0 02460354 + WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR 02470354 + 0101 CONTINUE 02480354 +CT011* TEST 11 A ZERO PREFIXED WITH A MINUS SIGN 02490354 + IVTNUM = 11 02500354 + IBCVI = 0 02510354 + RBBVS = REAL(-IBCVI) 02520354 + IF (RBBVS + 0.00005) 20110, 10110, 40110 02530354 +40110 IF (RBBVS - 0.00005) 10110, 10110, 20110 02540354 +10110 IVPASS = IVPASS + 1 02550354 + WRITE (NUVI, 80002) IVTNUM 02560354 + GO TO 0111 02570354 +20110 IVFAIL = IVFAIL + 1 02580354 + RVCORR = 0.0 02590354 + WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR 02600354 + 0111 CONTINUE 02610354 +CT012* TEST 12 REAL USED IN AN ARITHMETIC EXPRESSION 02620354 + IVTNUM = 12 02630354 + RBFVS = -3.0 02640354 + IBCVI = 3 02650354 + RBBVS = 16.1875 + RBFVS/REAL(IBCVI) 02660354 + IF (RBBVS - 15.186) 20120, 10120, 40120 02670354 +40120 IF (RBBVS - 15.189) 10120, 10120, 20120 02680354 +10120 IVPASS = IVPASS + 1 02690354 + WRITE (NUVI, 80002) IVTNUM 02700354 + GO TO 0121 02710354 +20120 IVFAIL = IVFAIL + 1 02720354 + RVCORR = 15.1875 02730354 + WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR 02740354 + 0121 CONTINUE 02750354 +CT013* TEST 13 AN ARITHMETIC EXPRESSION PRESENTED TO REAL 02760354 + IVTNUM = 13 02770354 + IBAVI = -7 02780354 + IBBVI = 27 02790354 + RBBVS = REAL(IBAVI - IBBVI * 2) 02800354 + IF (RBBVS + 61.003) 20130, 10130, 40130 02810354 +40130 IF (RBBVS + 60.997) 10130, 10130, 20130 02820354 +10130 IVPASS = IVPASS + 1 02830354 + WRITE (NUVI, 80002) IVTNUM 02840354 + GO TO 0131 02850354 +20130 IVFAIL = IVFAIL + 1 02860354 + RVCORR = 61.0 02870354 + WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR 02880354 + 0131 CONTINUE 02890354 +CT014* TEST 14 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 02900354 + IVTNUM = 14 02910354 + IBAVI = 2 02920354 + IBBVI = 10 02930354 + RBBVS = REAL(IBBVI ** IBAVI) 02940354 + IF (RBBVS - 99.995) 20140, 10140, 40140 02950354 +40140 IF (RBBVS - 100.01) 10140, 10140, 20140 02960354 +10140 IVPASS = IVPASS + 1 02970354 + WRITE (NUVI, 80002) IVTNUM 02980354 + GO TO 0141 02990354 +20140 IVFAIL = IVFAIL + 1 03000354 + RVCORR = 100.0 03010354 + WRITE(NUVI, 80012) IVTNUM, RBBVS, RVCORR 03020354 + 0141 CONTINUE 03030354 +CBB** ********************** BBCSUM0 **********************************03040354 +C**** WRITE OUT TEST SUMMARY 03050354 +C**** 03060354 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03070354 + WRITE (I02, 90004) 03080354 + WRITE (I02, 90014) 03090354 + WRITE (I02, 90004) 03100354 + WRITE (I02, 90020) IVPASS 03110354 + WRITE (I02, 90022) IVFAIL 03120354 + WRITE (I02, 90024) IVDELE 03130354 + WRITE (I02, 90026) IVINSP 03140354 + WRITE (I02, 90028) IVTOTN, IVTOTL 03150354 +CBE** ********************** BBCSUM0 **********************************03160354 +CBB** ********************** BBCFOOT0 **********************************03170354 +C**** WRITE OUT REPORT FOOTINGS 03180354 +C**** 03190354 + WRITE (I02,90016) ZPROG, ZPROG 03200354 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03210354 + WRITE (I02,90019) 03220354 +CBE** ********************** BBCFOOT0 **********************************03230354 +CBB** ********************** BBCFMT0A **********************************03240354 +C**** FORMATS FOR TEST DETAIL LINES 03250354 +C**** 03260354 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03270354 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03280354 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03290354 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03300354 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03310354 + 1I6,/," ",15X,"CORRECT= " ,I6) 03320354 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03330354 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03340354 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03350354 + 1A21,/," ",16X,"CORRECT= " ,A21) 03360354 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03370354 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03380354 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03390354 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03400354 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03410354 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03420354 +80050 FORMAT (" ",48X,A31) 03430354 +CBE** ********************** BBCFMT0A **********************************03440354 +CBB** ********************** BBCFMT0B **********************************03450354 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03460354 +C**** 03470354 +90002 FORMAT ("1") 03480354 +90004 FORMAT (" ") 03490354 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03500354 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03510354 +90008 FORMAT (" ",21X,A13,A17) 03520354 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03530354 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03540354 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03550354 + 1 7X,"REMARKS",24X) 03560354 +90014 FORMAT (" ","----------------------------------------------" , 03570354 + 1 "---------------------------------" ) 03580354 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03590354 +C**** 03600354 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03610354 +C**** 03620354 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03630354 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03640354 + 1 A13) 03650354 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03660354 +C**** 03670354 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03680354 +C**** 03690354 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03700354 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03710354 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03720354 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03730354 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03740354 +CBE** ********************** BBCFMT0B **********************************03750354 +C***** 03760354 +C***** END OF TEST SEGMENT 152 03770354 + STOP 03780354 + END 03790354 + 03800354 diff --git a/Fortran/UnitTests/fcvs21_f95/FM354.reference_output b/Fortran/UnitTests/fcvs21_f95/FM354.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM354.reference_output @@ -0,0 +1,53 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM354BEGIN* TEST RESULTS - FM354 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + XREAL - (152) INTRINSIC FUNCTIONS-- + + FLOAT, REAL (TYPE CONVERSION) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 14 TESTS + + + TEST OF FLOAT + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + + TEST OF REAL + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + + ------------------------------------------------------------------------------- + + 14 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 14 OF 14 TESTS EXECUTED + + *FM354END* END OF TEST - FM354 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM355.f b/Fortran/UnitTests/fcvs21_f95/FM355.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM355.f @@ -0,0 +1,822 @@ + PROGRAM FM355 + +C***********************************************************************00010355 +C***** FORTRAN 77 00020355 +C***** FM355 XAINT - (154) 00030355 +C***** 00040355 +C***********************************************************************00050355 +C***** GENERAL PURPOSE SUBSET REF00060355 +C***** TEST INTRINSIC FUNCTIONS AINT, ANINT, NINT 15.3 00070355 +C***** TRUNCATION (SIGN OF A * LARGEST INTEGER LE ABS(A) ) (TABLE 5)00080355 +C***** 00090355 +C***** GENERAL COMMENTS 00100355 +C***** FLOAT FUNCTION ASSUMED WORKING 00110355 +C***** 00120355 +CBB** ********************** BBCCOMNT **********************************00130355 +C**** 00140355 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150355 +C**** VERSION 2.1 00160355 +C**** 00170355 +C**** 00180355 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190355 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200355 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00210355 +C**** BUILDING 225 RM A266 00220355 +C**** GAITHERSBURG, MD 20899 00230355 +C**** 00240355 +C**** 00250355 +C**** 00260355 +CBE** ********************** BBCCOMNT **********************************00270355 +CBB** ********************** BBCINITA **********************************00280355 +C**** SPECIFICATION STATEMENTS 00290355 +C**** 00300355 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310355 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320355 +CBE** ********************** BBCINITA **********************************00330355 +CBB** ********************** BBCINITB **********************************00340355 +C**** INITIALIZE SECTION 00350355 + DATA ZVERS, ZVERSD, ZDATE 00360355 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00370355 + DATA ZCOMPL, ZNAME, ZTAPE 00380355 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00390355 + DATA ZPROJ, ZTAPED, ZPROG 00400355 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00410355 + DATA REMRKS /' '/ 00420355 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00430355 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00440355 +C**** 00450355 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00460355 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00470355 +CZ03 ZPROG = 'PROGRAM NAME' 00480355 +CZ04 ZDATE = 'DATE OF TEST' 00490355 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00500355 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00510355 +CZ07 ZNAME = 'NAME OF USER' 00520355 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00530355 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00540355 +C 00550355 + IVPASS = 0 00560355 + IVFAIL = 0 00570355 + IVDELE = 0 00580355 + IVINSP = 0 00590355 + IVTOTL = 0 00600355 + IVTOTN = 0 00610355 + ICZERO = 0 00620355 +C 00630355 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640355 + I01 = 05 00650355 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660355 + I02 = 06 00670355 +C 00680355 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690355 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700355 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00710355 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00720355 +C 00730355 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00740355 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00750355 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00760355 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00770355 +C 00780355 +CBE** ********************** BBCINITB **********************************00790355 + NUVI = I02 00800355 + IVTOTL = 48 00810355 + ZPROG = 'FM355' 00820355 +CBB** ********************** BBCHED0A **********************************00830355 +C**** 00840355 +C**** WRITE REPORT TITLE 00850355 +C**** 00860355 + WRITE (I02, 90002) 00870355 + WRITE (I02, 90006) 00880355 + WRITE (I02, 90007) 00890355 + WRITE (I02, 90008) ZVERS, ZVERSD 00900355 + WRITE (I02, 90009) ZPROG, ZPROG 00910355 + WRITE (I02, 90010) ZDATE, ZCOMPL 00920355 +CBE** ********************** BBCHED0A **********************************00930355 +C***** 00940355 +C***** HEADER FOR SEGMENT 154 00950355 + WRITE (NUVI,15401) 00960355 +15401 FORMAT (" ", // 2X,"XAINT - (154) INTRINSIC FUNCTIONS--" //10X,00970355 + 1 "AINT, ANINT, NINT (TYPE CONVERSION) " // 00980355 + 2 " SUBSET REF. - 15.3" ) 00990355 +CBB** ********************** BBCHED0B **********************************01000355 +C**** WRITE DETAIL REPORT HEADERS 01010355 +C**** 01020355 + WRITE (I02,90004) 01030355 + WRITE (I02,90004) 01040355 + WRITE (I02,90013) 01050355 + WRITE (I02,90014) 01060355 + WRITE (I02,90015) IVTOTL 01070355 +CBE** ********************** BBCHED0B **********************************01080355 +C***** 01090355 +C***** TEST OF AINT 01100355 +C***** 01110355 + WRITE(NUVI, 15402) 01120355 +15402 FORMAT (/ 8X, "TEST OF AINT" ) 01130355 +CT001* TEST 1 THE VALUE ZERO 01140355 + IVTNUM = 1 01150355 + RCBVS = 0.0 01160355 + RCAVS = AINT(RCBVS) 01170355 + IF (RCAVS + 0.00005) 20010, 10010, 40010 01180355 +40010 IF (RCAVS - 0.00005) 10010, 10010, 20010 01190355 +10010 IVPASS = IVPASS + 1 01200355 + WRITE (NUVI, 80002) IVTNUM 01210355 + GO TO 0011 01220355 +20010 IVFAIL = IVFAIL + 1 01230355 + RVCORR = 0.0 01240355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01250355 + 0011 CONTINUE 01260355 +CT002* TEST 2 ZERO PREFIXED WITH A MINUS SIGN 01270355 + IVTNUM = 2 01280355 + RCDVS = -0.0 01290355 + RCAVS = AINT(RCBVS) 01300355 + IF (RCAVS + 0.00005) 20020, 10020, 40020 01310355 +40020 IF (RCAVS - 0.00005) 10020, 10020, 20020 01320355 +10020 IVPASS = IVPASS + 1 01330355 + WRITE (NUVI, 80002) IVTNUM 01340355 + GO TO 0021 01350355 +20020 IVFAIL = IVFAIL + 1 01360355 + RVCORR = -0.0 01370355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01380355 + 0021 CONTINUE 01390355 +CT003* TEST 3 A VALUE IN (0,1) 01400355 + IVTNUM = 3 01410355 + RCDVS = 0.375 01420355 + RCAVS = AINT(RCBVS) 01430355 + IF (RCAVS + 0.00005) 20030, 10030, 40030 01440355 +40030 IF (RCAVS - 0.00005) 10030, 10030, 20030 01450355 +10030 IVPASS = IVPASS + 1 01460355 + WRITE (NUVI, 80002) IVTNUM 01470355 + GO TO 0031 01480355 +20030 IVFAIL = IVFAIL + 1 01490355 + RVCORR = 0.0 01500355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01510355 + 0031 CONTINUE 01520355 +CT004* TEST 4 THE VALUE 1 01530355 + IVTNUM = 4 01540355 + RCBVS = FLOAT(1) 01550355 + RCAVS = AINT(RCBVS) 01560355 + IF (RCAVS - 0.99995) 20040, 10040, 40040 01570355 +40040 IF (RCAVS - 1.0001) 10040, 10040, 20040 01580355 +10040 IVPASS = IVPASS + 1 01590355 + WRITE (NUVI, 80002) IVTNUM 01600355 + GO TO 0041 01610355 +20040 IVFAIL = IVFAIL + 1 01620355 + RVCORR = 1.0 01630355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01640355 + 0041 CONTINUE 01650355 +CT005* TEST 5 AN INTEGRAL VALUE OTHER THAN 0, 1 01660355 + IVTNUM = 5 01670355 + RCBVS = FLOAT(6) 01680355 + RCAVS = AINT(RCBVS) 01690355 + IF (RCAVS - 5.9997) 20050, 10050, 40050 01700355 +40050 IF (RCAVS - 6.0003) 10050, 10050, 20050 01710355 +10050 IVPASS = IVPASS + 1 01720355 + WRITE (NUVI, 80002) IVTNUM 01730355 + GO TO 0051 01740355 +20050 IVFAIL = IVFAIL + 1 01750355 + RVCORR = 6.0 01760355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01770355 + 0051 CONTINUE 01780355 +CT006* TEST 6 A VALUE IN (X,X+1) 01790355 + IVTNUM = 6 01800355 + RCBVS = 3.75 01810355 + RCAVS = AINT(RCBVS) 01820355 + IF (RCAVS - 2.9998) 20060, 10060, 40060 01830355 +40060 IF (RCAVS - 3.0002) 10060, 10060, 20060 01840355 +10060 IVPASS = IVPASS + 1 01850355 + WRITE (NUVI, 80002) IVTNUM 01860355 + GO TO 0061 01870355 +20060 IVFAIL = IVFAIL + 1 01880355 + RVCORR = 3.0 01890355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 01900355 + 0061 CONTINUE 01910355 +CT007* TEST 7 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1) 01920355 + IVTNUM = 7 01930355 + RCBVS = -0.375 01940355 + RCAVS = AINT(RCBVS) 01950355 + IF (RCAVS + 0.00005) 20070, 10070, 40070 01960355 +40070 IF (RCAVS - 0.00005) 10070, 10070, 20070 01970355 +10070 IVPASS = IVPASS + 1 01980355 + WRITE (NUVI, 80002) IVTNUM 01990355 + GO TO 0071 02000355 +20070 IVFAIL = IVFAIL + 1 02010355 + RVCORR = 0.0 02020355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02030355 + 0071 CONTINUE 02040355 +CT008* TEST 8 THE VALUE -1 02050355 + IVTNUM = 8 02060355 + RCBVS = FLOAT(-1) 02070355 + RCAVS = AINT(RCBVS) 02080355 + IF (RCAVS + 1.0001) 20080, 10080, 40080 02090355 +40080 IF (RCAVS + 0.99995) 10080, 10080, 20080 02100355 +10080 IVPASS = IVPASS + 1 02110355 + WRITE (NUVI, 80002) IVTNUM 02120355 + GO TO 0081 02130355 +20080 IVFAIL = IVFAIL + 1 02140355 + RVCORR = -1.0 02150355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02160355 + 0081 CONTINUE 02170355 +CT009* TEST 9 A NEGATIVE INTEGRAL VALUE 02180355 + IVTNUM = 9 02190355 + RCBVS = FLOAT(-6) 02200355 + RCAVS = AINT(RCBVS) 02210355 + IF (RCAVS + 6.0003) 20090, 10090, 40090 02220355 +40090 IF (RCAVS + 5.9997) 10090, 10090, 20090 02230355 +10090 IVPASS = IVPASS + 1 02240355 + WRITE (NUVI, 80002) IVTNUM 02250355 + GO TO 0091 02260355 +20090 IVFAIL = IVFAIL + 1 02270355 + RVCORR = -6.0 02280355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02290355 + 0091 CONTINUE 02300355 +CT010* TEST 10 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1) 02310355 + IVTNUM = 10 02320355 + RCBVS = -3.75 02330355 + RCAVS = AINT(RCBVS) 02340355 + IF (RCAVS + 3.0002) 20100, 10100, 40100 02350355 +40100 IF (RCAVS + 2.9998) 10100, 10100, 20100 02360355 +10100 IVPASS = IVPASS + 1 02370355 + WRITE (NUVI, 80002) IVTNUM 02380355 + GO TO 0101 02390355 +20100 IVFAIL = IVFAIL + 1 02400355 + RVCORR = -3.0 02410355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02420355 + 0101 CONTINUE 02430355 +CT011* TEST 11 AN ARITHMETIC EXPRESSION PRESENTED TO AINT 02440355 + IVTNUM = 11 02450355 + RCBVS = 3.25 02460355 + RCDVS = 3.0 02470355 + RCAVS = AINT(FLOAT(25) + RCDVS * RCBVS) 02480355 + IF (RCAVS - 33.998) 20110, 10110, 40110 02490355 +40110 IF (RCAVS - 34.002) 10110, 10110, 20110 02500355 +10110 IVPASS = IVPASS + 1 02510355 + WRITE (NUVI, 80002) IVTNUM 02520355 + GO TO 0111 02530355 +20110 IVFAIL = IVFAIL + 1 02540355 + RVCORR = 34.0 02550355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02560355 + 0111 CONTINUE 02570355 +CT012* TEST 12 AN ARGUMENT OF LOW MAGNITUDE 02580355 + IVTNUM = 12 02590355 + RCBVS = 3.7521E-36 02600355 + RCAVS = AINT(RCBVS) 02610355 + IF (RCAVS + 0.00005) 20120, 10120, 40120 02620355 +40120 IF (RCAVS - 0.00005) 10120, 10120, 20120 02630355 +10120 IVPASS = IVPASS + 1 02640355 + WRITE (NUVI, 80002) IVTNUM 02650355 + GO TO 0121 02660355 +20120 IVFAIL = IVFAIL + 1 02670355 + RVCORR = 0.0 02680355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02690355 + 0121 CONTINUE 02700355 +C***** 02710355 + WRITE(NUVI, 90002) 02720355 + WRITE(NUVI, 90013) 02730355 + WRITE(NUVI, 90014) 02740355 +C***** 02750355 +C***** TEST OF ANINT 02760355 +C***** 02770355 + WRITE(NUVI, 15404) 02780355 +15404 FORMAT (/ 08X, "TEST OF ANINT" ) 02790355 +C***** 02800355 +CT013* TEST 13 THE VALUE ZERO 02810355 + IVTNUM = 13 02820355 + RCBVS = 0.0 02830355 + RCAVS = ANINT(RCBVS) 02840355 + IF (RCAVS + 0.00005) 20130, 10130, 40130 02850355 +40130 IF (RCAVS - 0.00005) 10130, 10130, 20130 02860355 +10130 IVPASS = IVPASS + 1 02870355 + WRITE (NUVI, 80002) IVTNUM 02880355 + GO TO 0131 02890355 +20130 IVFAIL = IVFAIL + 1 02900355 + RVCORR = 0.0 02910355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 02920355 + 0131 CONTINUE 02930355 +CT014* TEST 14 THE VALUE ZERO PREFIXED WITH A MINUS SIGN 02940355 + IVTNUM = 14 02950355 + RCDVS = 0.0 02960355 + RCAVS = ANINT(-RCBVS) 02970355 + IF (RCAVS + 0.00005) 20140, 10140, 40140 02980355 +40140 IF (RCAVS - 0.00005) 10140, 10140, 20140 02990355 +10140 IVPASS = IVPASS + 1 03000355 + WRITE (NUVI, 80002) IVTNUM 03010355 + GO TO 0141 03020355 +20140 IVFAIL = IVFAIL + 1 03030355 + RVCORR = 0.0 03040355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03050355 + 0141 CONTINUE 03060355 +CT015* TEST 15 A VALUE IN (0,.5) 03070355 + IVTNUM = 15 03080355 + RCBVS = 0.25 03090355 + RCAVS = ANINT(RCBVS) 03100355 + IF (RCAVS + 0.00005) 20150, 10150, 40150 03110355 +40150 IF (RCAVS - 0.00005) 10150, 10150, 20150 03120355 +10150 IVPASS = IVPASS + 1 03130355 + WRITE (NUVI, 80002) IVTNUM 03140355 + GO TO 0151 03150355 +20150 IVFAIL = IVFAIL + 1 03160355 + RVCORR = 0.0 03170355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03180355 + 0151 CONTINUE 03190355 +CT016* TEST 16 THE VALUE 0.5 03200355 + IVTNUM = 16 03210355 + RCBVS = FLOAT(1) / FLOAT(2) 03220355 + RCAVS = ANINT(RCBVS) 03230355 + IF (RCAVS - 0.99995) 20160, 10160, 40160 03240355 +40160 IF (RCAVS - 1.0001) 10160, 10160, 20160 03250355 +10160 IVPASS = IVPASS + 1 03260355 + WRITE (NUVI, 80002) IVTNUM 03270355 + GO TO 0161 03280355 +20160 IVFAIL = IVFAIL + 1 03290355 + RVCORR = 1.0 03300355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03310355 + 0161 CONTINUE 03320355 +CT017* TEST 17 A VALUE IN (.5,1) 03330355 + IVTNUM = 17 03340355 + RCBVS = 0.75 03350355 + RCAVS = ANINT(RCBVS) 03360355 + IF (RCAVS - 0.99995) 20170, 10170, 40170 03370355 +40170 IF (RCAVS - 1.0001) 10170, 10170, 20170 03380355 +10170 IVPASS = IVPASS + 1 03390355 + WRITE (NUVI, 80002) IVTNUM 03400355 + GO TO 0171 03410355 +20170 IVFAIL = IVFAIL + 1 03420355 + RVCORR = 1.0 03430355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03440355 + 0171 CONTINUE 03450355 +CT018* TEST 18 AN INTEGRAL VALUE OTHER THAN 0,1 03460355 + IVTNUM = 18 03470355 + RCBVS = FLOAT(5) 03480355 + RCAVS = ANINT(RCBVS) 03490355 + IF (RCAVS - 4.9997) 20180, 10180, 40180 03500355 +40180 IF (RCAVS - 5.0003) 10180, 10180, 20180 03510355 +10180 IVPASS = IVPASS + 1 03520355 + WRITE (NUVI, 80002) IVTNUM 03530355 + GO TO 0181 03540355 +20180 IVFAIL = IVFAIL + 1 03550355 + RVCORR = 5.0 03560355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03570355 + 0181 CONTINUE 03580355 +CT019* TEST 19 A VALUE IN (X,X+.5) 03590355 + IVTNUM = 19 03600355 + RCBVS = 10.46875 03610355 + RCAVS = ANINT(RCBVS) 03620355 + IF (RCAVS - 9.9995) 20190, 10190, 40190 03630355 +40190 IF (RCAVS - 10.001) 10190, 10190, 20190 03640355 +10190 IVPASS = IVPASS + 1 03650355 + WRITE (NUVI, 80002) IVTNUM 03660355 + GO TO 0191 03670355 +20190 IVFAIL = IVFAIL + 1 03680355 + RVCORR = 10.0 03690355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03700355 + 0191 CONTINUE 03710355 +CT020* TEST 20 A VALUE WITH FRACTIONAL PART OF 0.5 03720355 + IVTNUM = 20 03730355 + RCBVS = FLOAT(16) - FLOAT(1) / FLOAT(2) 03740355 + RCAVS = ANINT(RCBVS) 03750355 + IF (RCAVS - 15.999) 20200, 10200, 40200 03760355 +40200 IF (RCAVS - 16.001) 10200, 10200, 20200 03770355 +10200 IVPASS = IVPASS + 1 03780355 + WRITE (NUVI, 80002) IVTNUM 03790355 + GO TO 0201 03800355 +20200 IVFAIL = IVFAIL + 1 03810355 + RVCORR = 16.0 03820355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03830355 + 0201 CONTINUE 03840355 +CT021* TEST 21 A VALUE IN (X+.5,X+1) 03850355 + IVTNUM = 21 03860355 + RCBVS = 27.96875 03870355 + RCAVS = ANINT(RCBVS) 03880355 + IF (RCAVS - 27.998) 20210, 10210, 40210 03890355 +40210 IF (RCAVS - 28.002) 10210, 10210, 20210 03900355 +10210 IVPASS = IVPASS + 1 03910355 + WRITE (NUVI, 80002) IVTNUM 03920355 + GO TO 0211 03930355 +20210 IVFAIL = IVFAIL + 1 03940355 + RVCORR = 28.0 03950355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 03960355 + 0211 CONTINUE 03970355 +CT022* TEST 22 A NEGATIVE VALUE WITH MAGNITUDE IN (0,.5) 03980355 + IVTNUM = 22 03990355 + RCBVS = -0.25 04000355 + RCAVS = ANINT(RCBVS) 04010355 + IF (RCAVS + 0.00005) 20220, 10220, 40220 04020355 +40220 IF (RCAVS - 0.00005) 10220, 10220, 20220 04030355 +10220 IVPASS = IVPASS + 1 04040355 + WRITE (NUVI, 80002) IVTNUM 04050355 + GO TO 0221 04060355 +20220 IVFAIL = IVFAIL + 1 04070355 + RVCORR = -0.0 04080355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04090355 + 0221 CONTINUE 04100355 +CT023* TEST 23 THE VALUE -0.5 04110355 + IVTNUM = 23 04120355 + RCBVS = FLOAT(-1) / FLOAT(2) 04130355 + RCAVS = ANINT(RCBVS) 04140355 + IF (RCAVS + 1.0001) 20230, 10230, 40230 04150355 +40230 IF (RCAVS + 0.99995) 10230, 10230, 20230 04160355 +10230 IVPASS = IVPASS + 1 04170355 + WRITE (NUVI, 80002) IVTNUM 04180355 + GO TO 0231 04190355 +20230 IVFAIL = IVFAIL + 1 04200355 + RVCORR = -1.0 04210355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04220355 + 0231 CONTINUE 04230355 +CT024* TEST 24 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1) 04240355 + IVTNUM = 24 04250355 + RCBVS = -0.75 04260355 + RCAVS = ANINT(RCBVS) 04270355 + IF (RCAVS + 1.0001) 20240, 10240, 40240 04280355 +40240 IF (RCAVS + 0.99995) 10240, 10240, 20240 04290355 +10240 IVPASS = IVPASS + 1 04300355 + WRITE (NUVI, 80002) IVTNUM 04310355 + GO TO 0241 04320355 +20240 IVFAIL = IVFAIL + 1 04330355 + RVCORR = -1.0 04340355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04350355 + 0241 CONTINUE 04360355 +CT025* TEST 25 A NEGATIVE INTEGRAL VALUE 04370355 + IVTNUM = 25 04380355 + RCBVS = FLOAT(-5) 04390355 + RCAVS = ANINT(RCBVS) 04400355 + IF (RCAVS + 5.0003) 20250, 10250, 40250 04410355 +40250 IF (RCAVS + 4.9997) 10250, 10250, 20250 04420355 +10250 IVPASS = IVPASS + 1 04430355 + WRITE (NUVI, 80002) IVTNUM 04440355 + GO TO 0251 04450355 +20250 IVFAIL = IVFAIL + 1 04460355 + RVCORR = -5.0 04470355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04480355 + 0251 CONTINUE 04490355 +CT026* TEST 26 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5) 04500355 + IVTNUM = 26 04510355 + RCBVS = -10.46875 04520355 + RCAVS = ANINT(RCBVS) 04530355 + IF (RCAVS + 10.001) 20260, 10260, 40260 04540355 +40260 IF (RCAVS + 9.9995) 10260, 10260, 20260 04550355 +10260 IVPASS = IVPASS + 1 04560355 + WRITE (NUVI, 80002) IVTNUM 04570355 + GO TO 0261 04580355 +20260 IVFAIL = IVFAIL + 1 04590355 + RVCORR = -10.0 04600355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04610355 + 0261 CONTINUE 04620355 +CT027* TEST 27 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT .5 04630355 + IVTNUM = 27 04640355 + RCBVS = FLOAT(-15) - FLOAT(1) / FLOAT(2) 04650355 + RCAVS = ANINT(RCBVS) 04660355 + IF (RCAVS + 16.001) 20270, 10270, 40270 04670355 +40270 IF (RCAVS + 15.999) 10270, 10270, 20270 04680355 +10270 IVPASS = IVPASS + 1 04690355 + WRITE (NUVI, 80002) IVTNUM 04700355 + GO TO 0271 04710355 +20270 IVFAIL = IVFAIL + 1 04720355 + RVCORR = -16.0 04730355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04740355 + 0271 CONTINUE 04750355 +CT028* TEST 28 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1) 04760355 + IVTNUM = 28 04770355 + RCBVS = -27.96875 04780355 + RCAVS = ANINT(RCBVS) 04790355 + IF (RCAVS + 28.002) 20280, 10280, 40280 04800355 +40280 IF (RCAVS + 27.998) 10280, 10280, 20280 04810355 +10280 IVPASS = IVPASS + 1 04820355 + WRITE (NUVI, 80002) IVTNUM 04830355 + GO TO 0281 04840355 +20280 IVFAIL = IVFAIL + 1 04850355 + RVCORR = -28.0 04860355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 04870355 + 0281 CONTINUE 04880355 +CT029* TEST 29 AN ARITHMETIC EXPRESSION PRESENTED TO ANINT 04890355 + IVTNUM = 29 04900355 + RCDVS = 8.00 04910355 + RCBVS = 7.25 04920355 + RCAVS = ANINT(RCDVS - RCBVS) 04930355 + IF (RCAVS - 0.99995) 20290, 10290, 40290 04940355 +40290 IF (RCAVS - 1.0001) 10290, 10290, 20290 04950355 +10290 IVPASS = IVPASS + 1 04960355 + WRITE (NUVI, 80002) IVTNUM 04970355 + GO TO 0291 04980355 +20290 IVFAIL = IVFAIL + 1 04990355 + RVCORR = 1.0 05000355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 05010355 + 0291 CONTINUE 05020355 +CT030* TEST 30 AN ARGUMENT OF LOW MAGNITUDE 05030355 + IVTNUM = 30 05040355 + RCBVS = -5.9876E-35 05050355 + RCAVS = ANINT(RCBVS) 05060355 + IF (RCAVS + 0.00005) 20300, 10300, 40300 05070355 +40300 IF (RCAVS - 0.00005) 10300, 10300, 20300 05080355 +10300 IVPASS = IVPASS + 1 05090355 + WRITE (NUVI, 80002) IVTNUM 05100355 + GO TO 0301 05110355 +20300 IVFAIL = IVFAIL + 1 05120355 + RVCORR = 0.0 05130355 + WRITE(NUVI, 80012) IVTNUM, RCAVS, RVCORR 05140355 + 0301 CONTINUE 05150355 +C***** 05160355 + WRITE(NUVI, 90002) 05170355 + WRITE(NUVI, 90013) 05180355 + WRITE(NUVI, 90014) 05190355 +C***** 05200355 +C***** TEST OF NINT 05210355 +C***** 05220355 + WRITE(NUVI, 15405) 05230355 +15405 FORMAT (/ 8X, "TEST OF NINT" ) 05240355 +C***** 05250355 +CT031* TEST 31 THE VALUE ZERO 05260355 + IVTNUM = 31 05270355 + RCBVS = 0.0 05280355 + ICAVI = NINT(RCBVS) 05290355 + IF (ICAVI - 0) 20310, 10310, 20310 05300355 +10310 IVPASS = IVPASS + 1 05310355 + WRITE (NUVI, 80002) IVTNUM 05320355 + GO TO 0311 05330355 +20310 IVFAIL = IVFAIL + 1 05340355 + IVCORR = 0 05350355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05360355 + 0311 CONTINUE 05370355 +CT032* TEST 32 ZERO PREFIXED WITH A MINUS SIGN 05380355 + IVTNUM = 32 05390355 + RCDVS = 0.0 05400355 + ICAVI = NINT(-RCDVS) 05410355 + IF (ICAVI - 0) 20320, 10320, 20320 05420355 +10320 IVPASS = IVPASS + 1 05430355 + WRITE (NUVI, 80002) IVTNUM 05440355 + GO TO 0321 05450355 +20320 IVFAIL = IVFAIL + 1 05460355 + IVCORR = 0 05470355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05480355 + 0321 CONTINUE 05490355 +CT033* TEST 33 A VALUE IN (0,.5) 05500355 + IVTNUM = 33 05510355 + RCBVS = 0.25 05520355 + ICAVI = NINT(RCBVS) 05530355 + IF (ICAVI - 0) 20330, 10330, 20330 05540355 +10330 IVPASS = IVPASS + 1 05550355 + WRITE (NUVI, 80002) IVTNUM 05560355 + GO TO 0331 05570355 +20330 IVFAIL = IVFAIL + 1 05580355 + IVCORR = 0 05590355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05600355 + 0331 CONTINUE 05610355 +CT034* TEST 34 THE VALUE 0.5 05620355 + IVTNUM = 34 05630355 + RCBVS = FLOAT(1) / FLOAT(2) 05640355 + ICAVI = NINT(RCBVS) 05650355 + IF (ICAVI - 1) 20340, 10340, 20340 05660355 +10340 IVPASS = IVPASS + 1 05670355 + WRITE (NUVI, 80002) IVTNUM 05680355 + GO TO 0341 05690355 +20340 IVFAIL = IVFAIL + 1 05700355 + IVCORR = 1 05710355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05720355 + 0341 CONTINUE 05730355 +CT035* TEST 35 A VALUE IN (.5,1) 05740355 + IVTNUM = 35 05750355 + RCBVS = 0.75 05760355 + ICAVI = NINT(RCBVS) 05770355 + IF (ICAVI - 1) 20350, 10350, 20350 05780355 +10350 IVPASS = IVPASS + 1 05790355 + WRITE (NUVI, 80002) IVTNUM 05800355 + GO TO 0351 05810355 +20350 IVFAIL = IVFAIL + 1 05820355 + IVCORR = 1 05830355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05840355 + 0351 CONTINUE 05850355 +CT036* TEST 36 AN INTEGRAL VALUE OTHER THAN 0, 1 05860355 + IVTNUM = 36 05870355 + RCBVS = FLOAT(5) 05880355 + ICAVI = NINT(RCBVS) 05890355 + IF (ICAVI - 5) 20360, 10360, 20360 05900355 +10360 IVPASS = IVPASS + 1 05910355 + WRITE (NUVI, 80002) IVTNUM 05920355 + GO TO 0361 05930355 +20360 IVFAIL = IVFAIL + 1 05940355 + IVCORR = 5 05950355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 05960355 + 0361 CONTINUE 05970355 +CT037* TEST 37 A VALUE IN (X,X+.5) 05980355 + IVTNUM = 37 05990355 + RCBVS = 10.46875 06000355 + ICAVI = NINT(RCBVS) 06010355 + IF (ICAVI - 10) 20370, 10370, 20370 06020355 +10370 IVPASS = IVPASS + 1 06030355 + WRITE (NUVI, 80002) IVTNUM 06040355 + GO TO 0371 06050355 +20370 IVFAIL = IVFAIL + 1 06060355 + IVCORR = 10 06070355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06080355 + 0371 CONTINUE 06090355 +CT038* TEST 38 A VALUE WITH FRACTIONAL PART OF 0.5 06100355 + IVTNUM = 38 06110355 + RCBVS = FLOAT(15) + FLOAT(1) / FLOAT(2) 06120355 + ICAVI = NINT(RCBVS) 06130355 + IF (ICAVI - 16) 20380, 10380, 20380 06140355 +10380 IVPASS = IVPASS + 1 06150355 + WRITE (NUVI, 80002) IVTNUM 06160355 + GO TO 0381 06170355 +20380 IVFAIL = IVFAIL + 1 06180355 + IVCORR = 16 06190355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06200355 + 0381 CONTINUE 06210355 +CT039* TEST 39 A VALUE IN (X+.5,X+1) 06220355 + IVTNUM = 39 06230355 + RCBVS = 27.96875 06240355 + ICAVI = NINT(RCBVS) 06250355 + IF (ICAVI - 28) 20390, 10390, 20390 06260355 +10390 IVPASS = IVPASS + 1 06270355 + WRITE (NUVI, 80002) IVTNUM 06280355 + GO TO 0391 06290355 +20390 IVFAIL = IVFAIL + 1 06300355 + IVCORR = 28 06310355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06320355 + 0391 CONTINUE 06330355 +CT040* TEST 40 A NEGATIVE VALUE WITH MAGNITUDE IN (0.,5) 06340355 + IVTNUM = 40 06350355 + RCBVS = -0.25 06360355 + ICAVI = NINT(RCBVS) 06370355 + IF (ICAVI - 0) 20400, 10400, 20400 06380355 +10400 IVPASS = IVPASS + 1 06390355 + WRITE (NUVI, 80002) IVTNUM 06400355 + GO TO 0401 06410355 +20400 IVFAIL = IVFAIL + 1 06420355 + IVCORR = 0 06430355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06440355 + 0401 CONTINUE 06450355 +CT041* TEST 41 THE VALUE -0.5 06460355 + IVTNUM = 41 06470355 + RCBVS = FLOAT(-1) / FLOAT(2) 06480355 + ICAVI = NINT(RCBVS) 06490355 + IF (ICAVI + 1) 20410, 10410, 20410 06500355 +10410 IVPASS = IVPASS + 1 06510355 + WRITE (NUVI, 80002) IVTNUM 06520355 + GO TO 0411 06530355 +20410 IVFAIL = IVFAIL + 1 06540355 + IVCORR = -1 06550355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06560355 + 0411 CONTINUE 06570355 +CT042* TEST 42 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1) 06580355 + IVTNUM = 42 06590355 + RCBVS = -0.75 06600355 + ICAVI = NINT(RCBVS) 06610355 + IF (ICAVI + 1) 20420, 10420, 20420 06620355 +10420 IVPASS = IVPASS + 1 06630355 + WRITE (NUVI, 80002) IVTNUM 06640355 + GO TO 0421 06650355 +20420 IVFAIL = IVFAIL + 1 06660355 + IVCORR = -1 06670355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06680355 + 0421 CONTINUE 06690355 +CT043* TEST 43 A NEGATIVE INTEGRAL VALUE 06700355 + IVTNUM = 43 06710355 + RCBVS = FLOAT(-5) 06720355 + ICAVI = NINT(RCBVS) 06730355 + IF (ICAVI + 5) 20430, 10430, 20430 06740355 +10430 IVPASS = IVPASS + 1 06750355 + WRITE (NUVI, 80002) IVTNUM 06760355 + GO TO 0431 06770355 +20430 IVFAIL = IVFAIL + 1 06780355 + IVCORR = -5 06790355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06800355 + 0431 CONTINUE 06810355 +CT044* TEST 44 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5) 06820355 + IVTNUM = 44 06830355 + RCBVS = -10.46875 06840355 + ICAVI = NINT(RCBVS) 06850355 + IF (ICAVI + 10) 20440, 10440, 20440 06860355 +10440 IVPASS = IVPASS + 1 06870355 + WRITE (NUVI, 80002) IVTNUM 06880355 + GO TO 0441 06890355 +20440 IVFAIL = IVFAIL + 1 06900355 + IVCORR = -10 06910355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 06920355 + 0441 CONTINUE 06930355 +CT045* TEST 45 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT 0.5 S106940355 + IVTNUM = 45 06950355 + RCBVS = FLOAT(-15) - FLOAT(1) / FLOAT(2) 06960355 + ICAVI = NINT(RCBVS) 06970355 + IF (ICAVI + 16) 20450, 10450, 20450 06980355 +10450 IVPASS = IVPASS + 1 06990355 + WRITE (NUVI, 80002) IVTNUM 07000355 + GO TO 0451 07010355 +20450 IVFAIL = IVFAIL + 1 07020355 + IVCORR = -16 07030355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 07040355 + 0451 CONTINUE 07050355 +CT046* TEST 46 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1) S107060355 + IVTNUM = 46 07070355 + RCBVS = -27.96875 07080355 + ICAVI = NINT(RCBVS) 07090355 + IF (ICAVI + 28) 20460, 10460, 20460 07100355 +10460 IVPASS = IVPASS + 1 07110355 + WRITE (NUVI, 80002) IVTNUM 07120355 + GO TO 0461 07130355 +20460 IVFAIL = IVFAIL + 1 07140355 + IVCORR = -28 07150355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 07160355 + 0461 CONTINUE 07170355 +CT047* TEST 47 AN ARITHMETIC EXPRESSION PRESENTED TO NINT S107180355 + IVTNUM = 47 07190355 + RCDVS = 8.00 07200355 + RCEVS = 7.25 07210355 + ICAVI = NINT(RCDVS - RCEVS) 07220355 + IF (ICAVI - 1) 20470, 10470, 20470 07230355 +10470 IVPASS = IVPASS + 1 07240355 + WRITE (NUVI, 80002) IVTNUM 07250355 + GO TO 0471 07260355 +20470 IVFAIL = IVFAIL + 1 07270355 + IVCORR = 1 07280355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 07290355 + 0471 CONTINUE 07300355 +CT048* TEST 48 AN ARGUMENT OF LOW MAGNITUDE 07310355 + IVTNUM = 48 07320355 + RCBVS = -5.9876E-33 07330355 + ICAVI = NINT(RCBVS) 07340355 + IF (ICAVI - 0) 20480, 10480, 20480 07350355 +10480 IVPASS = IVPASS + 1 07360355 + WRITE (NUVI, 80002) IVTNUM 07370355 + GO TO 0481 07380355 +20480 IVFAIL = IVFAIL + 1 07390355 + IVCORR = 0 07400355 + WRITE (NUVI, 80010) IVTNUM, ICAVI, IVCORR 07410355 + 0481 CONTINUE 07420355 +C***** 07430355 +CBB** ********************** BBCSUM0 **********************************07440355 +C**** WRITE OUT TEST SUMMARY 07450355 +C**** 07460355 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 07470355 + WRITE (I02, 90004) 07480355 + WRITE (I02, 90014) 07490355 + WRITE (I02, 90004) 07500355 + WRITE (I02, 90020) IVPASS 07510355 + WRITE (I02, 90022) IVFAIL 07520355 + WRITE (I02, 90024) IVDELE 07530355 + WRITE (I02, 90026) IVINSP 07540355 + WRITE (I02, 90028) IVTOTN, IVTOTL 07550355 +CBE** ********************** BBCSUM0 **********************************07560355 +CBB** ********************** BBCFOOT0 **********************************07570355 +C**** WRITE OUT REPORT FOOTINGS 07580355 +C**** 07590355 + WRITE (I02,90016) ZPROG, ZPROG 07600355 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 07610355 + WRITE (I02,90019) 07620355 +CBE** ********************** BBCFOOT0 **********************************07630355 +CBB** ********************** BBCFMT0A **********************************07640355 +C**** FORMATS FOR TEST DETAIL LINES 07650355 +C**** 07660355 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 07670355 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 07680355 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 07690355 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 07700355 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 07710355 + 1I6,/," ",15X,"CORRECT= " ,I6) 07720355 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07730355 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 07740355 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07750355 + 1A21,/," ",16X,"CORRECT= " ,A21) 07760355 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 07770355 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 07780355 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 07790355 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 07800355 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 07810355 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 07820355 +80050 FORMAT (" ",48X,A31) 07830355 +CBE** ********************** BBCFMT0A **********************************07840355 +CBB** ********************** BBCFMT0B **********************************07850355 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 07860355 +C**** 07870355 +90002 FORMAT ("1") 07880355 +90004 FORMAT (" ") 07890355 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )07900355 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07910355 +90008 FORMAT (" ",21X,A13,A17) 07920355 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 07930355 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 07940355 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 07950355 + 1 7X,"REMARKS",24X) 07960355 +90014 FORMAT (" ","----------------------------------------------" , 07970355 + 1 "---------------------------------" ) 07980355 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 07990355 +C**** 08000355 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08010355 +C**** 08020355 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 08030355 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 08040355 + 1 A13) 08050355 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 08060355 +C**** 08070355 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 08080355 +C**** 08090355 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 08100355 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 08110355 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 08120355 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 08130355 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 08140355 +CBE** ********************** BBCFMT0B **********************************08150355 +C***** 08160355 +C***** END OF TEST SEGMENT 154 08170355 + STOP 08180355 + END 08190355 + 08200355 diff --git a/Fortran/UnitTests/fcvs21_f95/FM355.reference_output b/Fortran/UnitTests/fcvs21_f95/FM355.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM355.reference_output @@ -0,0 +1,95 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM355BEGIN* TEST RESULTS - FM355 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + XAINT - (154) INTRINSIC FUNCTIONS-- + + AINT, ANINT, NINT (TYPE CONVERSION) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 48 TESTS + + + TEST OF AINT + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF ANINT + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF NINT + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + 36 PASS + 37 PASS + 38 PASS + 39 PASS + 40 PASS + 41 PASS + 42 PASS + 43 PASS + 44 PASS + 45 PASS + 46 PASS + 47 PASS + 48 PASS + + ------------------------------------------------------------------------------- + + 48 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 48 OF 48 TESTS EXECUTED + + *FM355END* END OF TEST - FM355 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM356.f b/Fortran/UnitTests/fcvs21_f95/FM356.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM356.f @@ -0,0 +1,322 @@ + PROGRAM FM356 + +C***********************************************************************00010356 +C***** FORTRAN 77 00020356 +C***** FM356 XABS - (156) 00030356 +C***** 00040356 +C***********************************************************************00050356 +C***** GENERAL PURPOSE SUBSET REF00060356 +C***** TEST INTRINSIC FUNCTION ABS,IABS (ABSOLUTE VALUE) 15.3 00070356 +C***** (TABLE 5)00080356 +C***** 00090356 +CBB** ********************** BBCCOMNT **********************************00100356 +C**** 00110356 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120356 +C**** VERSION 2.1 00130356 +C**** 00140356 +C**** 00150356 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160356 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170356 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180356 +C**** BUILDING 225 RM A266 00190356 +C**** GAITHERSBURG, MD 20899 00200356 +C**** 00210356 +C**** 00220356 +C**** 00230356 +CBE** ********************** BBCCOMNT **********************************00240356 +CBB** ********************** BBCINITA **********************************00250356 +C**** SPECIFICATION STATEMENTS 00260356 +C**** 00270356 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00280356 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00290356 +CBE** ********************** BBCINITA **********************************00300356 +CBB** ********************** BBCINITB **********************************00310356 +C**** INITIALIZE SECTION 00320356 + DATA ZVERS, ZVERSD, ZDATE 00330356 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00340356 + DATA ZCOMPL, ZNAME, ZTAPE 00350356 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00360356 + DATA ZPROJ, ZTAPED, ZPROG 00370356 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00380356 + DATA REMRKS /' '/ 00390356 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00400356 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00410356 +C**** 00420356 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00430356 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00440356 +CZ03 ZPROG = 'PROGRAM NAME' 00450356 +CZ04 ZDATE = 'DATE OF TEST' 00460356 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00470356 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00480356 +CZ07 ZNAME = 'NAME OF USER' 00490356 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00500356 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00510356 +C 00520356 + IVPASS = 0 00530356 + IVFAIL = 0 00540356 + IVDELE = 0 00550356 + IVINSP = 0 00560356 + IVTOTL = 0 00570356 + IVTOTN = 0 00580356 + ICZERO = 0 00590356 +C 00600356 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00610356 + I01 = 05 00620356 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00630356 + I02 = 06 00640356 +C 00650356 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00660356 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670356 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00680356 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00690356 +C 00700356 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00710356 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00720356 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00730356 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00740356 +C 00750356 +CBE** ********************** BBCINITB **********************************00760356 + NUVI = I02 00770356 + IVTOTL = 10 00780356 + ZPROG = 'FM356' 00790356 +CBB** ********************** BBCHED0A **********************************00800356 +C**** 00810356 +C**** WRITE REPORT TITLE 00820356 +C**** 00830356 + WRITE (I02, 90002) 00840356 + WRITE (I02, 90006) 00850356 + WRITE (I02, 90007) 00860356 + WRITE (I02, 90008) ZVERS, ZVERSD 00870356 + WRITE (I02, 90009) ZPROG, ZPROG 00880356 + WRITE (I02, 90010) ZDATE, ZCOMPL 00890356 +CBE** ********************** BBCHED0A **********************************00900356 +C***** 00910356 +C***** HEADER FOR SEGMENT 156 00920356 + WRITE(NUVI,15601) 00930356 +15601 FORMAT( " ", // " XABS - (156) INTRINSIC FUNCTIONS--" // 11X, 00940356 + 1 "ABS, IABS (ABSOLUTE VALUE)" // 00950356 + 2 " SUBSET REF. - 15.3" ) 00960356 +CBB** ********************** BBCHED0B **********************************00970356 +C**** WRITE DETAIL REPORT HEADERS 00980356 +C**** 00990356 + WRITE (I02,90004) 01000356 + WRITE (I02,90004) 01010356 + WRITE (I02,90013) 01020356 + WRITE (I02,90014) 01030356 + WRITE (I02,90015) IVTOTL 01040356 +CBE** ********************** BBCHED0B **********************************01050356 +C***** 01060356 +C***** TEST OF ABS 01070356 +C***** 01080356 + WRITE(NUVI, 15602) 01090356 +15602 FORMAT (/ 8X, "TEST OF ABS" ) 01100356 +CT001* TEST 1 THE VALUE ZERO 01110356 + IVTNUM = 1 01120356 + RDDVS = 0.0 01130356 + RDAVS = ABS(RDDVS) 01140356 + IF (RDAVS + .00005) 20010, 10010, 40010 01150356 +40010 IF (RDAVS - .00005) 10010, 10010, 20010 01160356 +10010 IVPASS = IVPASS + 1 01170356 + WRITE (NUVI, 80002) IVTNUM 01180356 + GO TO 0011 01190356 +20010 IVFAIL = IVFAIL + 1 01200356 + RVCORR = 0.0 01210356 + WRITE (NUVI, 80012) IVTNUM, RDAVS, RVCORR 01220356 + 0011 CONTINUE 01230356 +CT002* TEST 2 ZERO PREFIXED WITH A MINUS SIGN 01240356 + IVTNUM = 2 01250356 + RDDVS = 0.0 01260356 + RDAVS = ABS(-RDDVS) 01270356 + IF (RDAVS + .00005) 20020, 10020, 40020 01280356 +40020 IF (RDAVS - .00005) 10020, 10020, 20020 01290356 +10020 IVPASS = IVPASS + 1 01300356 + WRITE (NUVI, 80002) IVTNUM 01310356 + GO TO 0021 01320356 +20020 IVFAIL = IVFAIL + 1 01330356 + RVCORR = 0.0 01340356 + WRITE (NUVI, 80012) IVTNUM, RDAVS, RVCORR 01350356 + 0021 CONTINUE 01360356 +CT003* TEST 3 A POSITIVE NON-INTEGRAL VALUE 01370356 + IVTNUM = 3 01380356 + RDDVS = 35.875 01390356 + RDAVS = ABS(RDDVS) 01400356 + IF (RDAVS - 35.873) 20030, 10030, 40030 01410356 +40030 IF (RDAVS - 35.877) 10030, 10030, 20030 01420356 +10030 IVPASS = IVPASS + 1 01430356 + WRITE (NUVI, 80002) IVTNUM 01440356 + GO TO 0031 01450356 +20030 IVFAIL = IVFAIL + 1 01460356 + RVCORR = 35.875 01470356 + WRITE (NUVI, 80012) IVTNUM, RDAVS, RVCORR 01480356 + 0031 CONTINUE 01490356 +CT004* TEST 4 A NEGATIVE NON-INTEGRAL VALUE 01500356 + IVTNUM = 4 01510356 + RDBVS = -35.875 01520356 + RDAVS = ABS(RDBVS) 01530356 + IF (RDAVS - 35.873) 20040, 10040, 40040 01540356 +40040 IF (RDAVS - 35.877) 10040, 10040, 20040 01550356 +10040 IVPASS = IVPASS + 1 01560356 + WRITE (NUVI, 80002) IVTNUM 01570356 + GO TO 0041 01580356 +20040 IVFAIL = IVFAIL + 1 01590356 + RVCORR = 35.875 01600356 + WRITE (NUVI, 80012) IVTNUM, RDAVS, RVCORR 01610356 + 0041 CONTINUE 01620356 +CT005* TEST 5 ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 01630356 + IVTNUM = 5 01640356 + RDDVS = 2.625 01650356 + RDEVS = 3.0 01660356 + RDAVS = ABS(-RDDVS - RDEVS ** 3) 01670356 + IF (RDAVS - 29.623) 20050, 10050, 40050 01680356 +40050 IF (RDAVS - 29.627) 10050, 10050, 20050 01690356 +10050 IVPASS = IVPASS + 1 01700356 + WRITE (NUVI, 80002) IVTNUM 01710356 + GO TO 0051 01720356 +20050 IVFAIL = IVFAIL + 1 01730356 + RVCORR = 29.625 01740356 + WRITE (NUVI, 80012) IVTNUM, RDAVS, RVCORR 01750356 + 0051 CONTINUE 01760356 +C***** 01770356 +C***** TEST OF IABS 01780356 +C***** 01790356 + WRITE(NUVI, 15604) 01800356 +15604 FORMAT (/ 8X, "TEST OF IABS" ) 01810356 +C***** 01820356 +CT006* TEST 6 THE VALUE ZERO 01830356 + IVTNUM = 6 01840356 + IDDVI = 0 01850356 + IDAVI = IABS(IDDVI) 01860356 + IF (IDAVI - 0) 20060, 10060, 20060 01870356 +10060 IVPASS = IVPASS + 1 01880356 + WRITE (NUVI, 80002) IVTNUM 01890356 + GO TO 0061 01900356 +20060 IVFAIL = IVFAIL + 1 01910356 + IVCORR = 0 01920356 + WRITE (NUVI, 80010) IVTNUM, IDAVI, IVCORR 01930356 + 0061 CONTINUE 01940356 +CT007* TEST 7 ZERO PREFIXED WITH A MINUS SIGN 01950356 + IVTNUM = 7 01960356 + IDDVI = 0 01970356 + IDAVI = IABS(-IDDVI) 01980356 + IF (IDAVI - 0) 20070, 10070, 20070 01990356 +10070 IVPASS = IVPASS + 1 02000356 + WRITE (NUVI, 80002) IVTNUM 02010356 + GO TO 0071 02020356 +20070 IVFAIL = IVFAIL + 1 02030356 + IVCORR = 0 02040356 + WRITE (NUVI, 80010) IVTNUM, IDAVI, IVCORR 02050356 + 0071 CONTINUE 02060356 +CT008* TEST 8 A POSITIVE INTEGER 02070356 + IVTNUM = 8 02080356 + IDBVI = 73 02090356 + IDAVI = IABS(IDBVI) 02100356 + IF (IDAVI - 73) 20080, 10080, 20080 02110356 +10080 IVPASS = IVPASS + 1 02120356 + WRITE (NUVI, 80002) IVTNUM 02130356 + GO TO 0081 02140356 +20080 IVFAIL = IVFAIL + 1 02150356 + IVCORR = 73 02160356 + WRITE (NUVI, 80010) IVTNUM, IDAVI, IVCORR 02170356 + 0081 CONTINUE 02180356 +CT009* TEST 9 A NEGATIVE INTEGER 02190356 + IVTNUM = 9 02200356 + IDDVI = -10 02210356 + IDAVI = IABS(IDDVI) 02220356 + IF (IDAVI - 10) 20090, 10090, 20090 02230356 +10090 IVPASS = IVPASS + 1 02240356 + WRITE (NUVI, 80002) IVTNUM 02250356 + GO TO 0091 02260356 +20090 IVFAIL = IVFAIL + 1 02270356 + IVCORR = 10 02280356 + WRITE (NUVI, 80010) IVTNUM, IDAVI, IVCORR 02290356 + 0091 CONTINUE 02300356 +CT010* TEST 10 ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 02310356 + IVTNUM = 10 02320356 + IDDVI = -3 02330356 + IDAVI = IABS(IDDVI ** 3) 02340356 + IF (IDAVI - 27) 20100, 10100, 20100 02350356 +10100 IVPASS = IVPASS + 1 02360356 + WRITE (NUVI, 80002) IVTNUM 02370356 + GO TO 0101 02380356 +20100 IVFAIL = IVFAIL + 1 02390356 + IVCORR = 27 02400356 + WRITE (NUVI, 80010) IVTNUM, IDAVI, IVCORR 02410356 + 0101 CONTINUE 02420356 +C***** 02430356 +CBB** ********************** BBCSUM0 **********************************02440356 +C**** WRITE OUT TEST SUMMARY 02450356 +C**** 02460356 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02470356 + WRITE (I02, 90004) 02480356 + WRITE (I02, 90014) 02490356 + WRITE (I02, 90004) 02500356 + WRITE (I02, 90020) IVPASS 02510356 + WRITE (I02, 90022) IVFAIL 02520356 + WRITE (I02, 90024) IVDELE 02530356 + WRITE (I02, 90026) IVINSP 02540356 + WRITE (I02, 90028) IVTOTN, IVTOTL 02550356 +CBE** ********************** BBCSUM0 **********************************02560356 +CBB** ********************** BBCFOOT0 **********************************02570356 +C**** WRITE OUT REPORT FOOTINGS 02580356 +C**** 02590356 + WRITE (I02,90016) ZPROG, ZPROG 02600356 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02610356 + WRITE (I02,90019) 02620356 +CBE** ********************** BBCFOOT0 **********************************02630356 +CBB** ********************** BBCFMT0A **********************************02640356 +C**** FORMATS FOR TEST DETAIL LINES 02650356 +C**** 02660356 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02670356 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02680356 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02690356 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02700356 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02710356 + 1I6,/," ",15X,"CORRECT= " ,I6) 02720356 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02730356 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02740356 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02750356 + 1A21,/," ",16X,"CORRECT= " ,A21) 02760356 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02770356 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02780356 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02790356 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02800356 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02810356 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02820356 +80050 FORMAT (" ",48X,A31) 02830356 +CBE** ********************** BBCFMT0A **********************************02840356 +CBB** ********************** BBCFMT0B **********************************02850356 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02860356 +C**** 02870356 +90002 FORMAT ("1") 02880356 +90004 FORMAT (" ") 02890356 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02900356 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02910356 +90008 FORMAT (" ",21X,A13,A17) 02920356 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02930356 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02940356 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02950356 + 1 7X,"REMARKS",24X) 02960356 +90014 FORMAT (" ","----------------------------------------------" , 02970356 + 1 "---------------------------------" ) 02980356 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02990356 +C**** 03000356 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03010356 +C**** 03020356 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03030356 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03040356 + 1 A13) 03050356 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03060356 +C**** 03070356 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03080356 +C**** 03090356 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03100356 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03110356 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03120356 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03130356 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03140356 +CBE** ********************** BBCFMT0B **********************************03150356 +C***** 03160356 +C***** END OF TEST SEGMENT 156 03170356 + STOP 03180356 + END 03190356 + 03200356 diff --git a/Fortran/UnitTests/fcvs21_f95/FM356.reference_output b/Fortran/UnitTests/fcvs21_f95/FM356.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM356.reference_output @@ -0,0 +1,49 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM356BEGIN* TEST RESULTS - FM356 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + XABS - (156) INTRINSIC FUNCTIONS-- + + ABS, IABS (ABSOLUTE VALUE) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 10 TESTS + + + TEST OF ABS + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + + TEST OF IABS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + + ------------------------------------------------------------------------------- + + 10 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 10 OF 10 TESTS EXECUTED + + *FM356END* END OF TEST - FM356 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM357.f b/Fortran/UnitTests/fcvs21_f95/FM357.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM357.f @@ -0,0 +1,497 @@ + PROGRAM FM357 + +C***********************************************************************00010357 +C***** FORTRAN 77 00020357 +C***** FM357 XAMOD - (159) 00030357 +C***** 00040357 +C***********************************************************************00050357 +C***** GENERAL PURPOSE ANS REF 00060357 +C***** TEST INTRINSIC FUNCTIONS AMOD AND MOD - REMAINDERING, 15.3 00070357 +C***** WHICH IS DEFINED AS A1-(A1/A2)A2 WHERE (X) IS AN (TABLE 5)00080357 +C***** INTEGER WHOSE MAGNITUDE IS LE ABS(X) AND WHOSE SIGN 00090357 +C***** IS THE SAME AS X. 00100357 +C***** 00110357 +CBB** ********************** BBCCOMNT **********************************00120357 +C**** 00130357 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140357 +C**** VERSION 2.1 00150357 +C**** 00160357 +C**** 00170357 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180357 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00190357 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00200357 +C**** BUILDING 225 RM A266 00210357 +C**** GAITHERSBURG, MD 20899 00220357 +C**** 00230357 +C**** 00240357 +C**** 00250357 +CBE** ********************** BBCCOMNT **********************************00260357 +CBB** ********************** BBCINITA **********************************00270357 +C**** SPECIFICATION STATEMENTS 00280357 +C**** 00290357 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00300357 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00310357 +CBE** ********************** BBCINITA **********************************00320357 +CBB** ********************** BBCINITB **********************************00330357 +C**** INITIALIZE SECTION 00340357 + DATA ZVERS, ZVERSD, ZDATE 00350357 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00360357 + DATA ZCOMPL, ZNAME, ZTAPE 00370357 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00380357 + DATA ZPROJ, ZTAPED, ZPROG 00390357 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00400357 + DATA REMRKS /' '/ 00410357 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00420357 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00430357 +C**** 00440357 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00450357 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00460357 +CZ03 ZPROG = 'PROGRAM NAME' 00470357 +CZ04 ZDATE = 'DATE OF TEST' 00480357 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00490357 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00500357 +CZ07 ZNAME = 'NAME OF USER' 00510357 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00520357 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00530357 +C 00540357 + IVPASS = 0 00550357 + IVFAIL = 0 00560357 + IVDELE = 0 00570357 + IVINSP = 0 00580357 + IVTOTL = 0 00590357 + IVTOTN = 0 00600357 + ICZERO = 0 00610357 +C 00620357 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00630357 + I01 = 05 00640357 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00650357 + I02 = 06 00660357 +C 00670357 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00680357 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690357 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00700357 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00710357 +C 00720357 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00730357 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00740357 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00750357 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00760357 +C 00770357 +CBE** ********************** BBCINITB **********************************00780357 + NUVI = I02 00790357 + IVTOTL = 22 00800357 + ZPROG = 'FM357' 00810357 +CBB** ********************** BBCHED0A **********************************00820357 +C**** 00830357 +C**** WRITE REPORT TITLE 00840357 +C**** 00850357 + WRITE (I02, 90002) 00860357 + WRITE (I02, 90006) 00870357 + WRITE (I02, 90007) 00880357 + WRITE (I02, 90008) ZVERS, ZVERSD 00890357 + WRITE (I02, 90009) ZPROG, ZPROG 00900357 + WRITE (I02, 90010) ZDATE, ZCOMPL 00910357 +CBE** ********************** BBCHED0A **********************************00920357 +C***** 00930357 +C***** HEADER FOR SEGMENT 159 WRITTEN 00940357 + WRITE (NUVI,15901) 00950357 +15901 FORMAT (" ", //, 2X,"XAMOD - (159) INTRINSIC FUNCTION-- " //16X,00960357 + 1 "AMOD, MOD (REMAINDERING)" //" SUBSET REF. - 15.3" ) 00970357 +CBB** ********************** BBCHED0B **********************************00980357 +C**** WRITE DETAIL REPORT HEADERS 00990357 +C**** 01000357 + WRITE (I02,90004) 01010357 + WRITE (I02,90004) 01020357 + WRITE (I02,90013) 01030357 + WRITE (I02,90014) 01040357 + WRITE (I02,90015) IVTOTL 01050357 +CBE** ********************** BBCHED0B **********************************01060357 +C***** 01070357 +C***** TEST OF AMOD 01080357 +C***** 01090357 + WRITE(NUVI, 15902) 01100357 +15902 FORMAT (/ 8X, "TEST OF AMOD" ) 01110357 +C***** 01120357 +CT001* TEST 1 FIRST VALUE ZERO, SECOND NON-ZERO 01130357 + IVTNUM = 1 01140357 + REBVS = 0.0 01150357 + REDVS = 4.5 01160357 + REAVS = AMOD(REBVS, REDVS) 01170357 + IF (REAVS + 0.00005) 20010, 10010, 40010 01180357 +40010 IF (REAVS - 0.00005) 10010, 10010, 20010 01190357 +10010 IVPASS = IVPASS + 1 01200357 + WRITE (NUVI, 80002) IVTNUM 01210357 + GO TO 0011 01220357 +20010 IVFAIL = IVFAIL + 1 01230357 + RVCORR = 0.0 01240357 + WRITE (NUVI,80012) IVTNUM, REAVS, RVCORR 01250357 + 0011 CONTINUE 01260357 +CT002* TEST 2 BOTH VALUES EQUAL 01270357 + IVTNUM = 2 01280357 + REBVS = 3.5 01290357 + REDVS = 3.5 01300357 + REAVS = AMOD(REBVS, REDVS) 01310357 + IF (REAVS + 0.00005) 20020, 10020, 40020 01320357 +40020 IF (REAVS - 0.00005) 10020, 10020, 20020 01330357 +10020 IVPASS = IVPASS + 1 01340357 + WRITE (NUVI, 80002) IVTNUM 01350357 + GO TO 0021 01360357 +20020 IVFAIL = IVFAIL + 1 01370357 + RVCORR = 0.0 01380357 + WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR 01390357 + 0021 CONTINUE 01400357 +CT003* TEST 3 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 01410357 + IVTNUM = 3 01420357 + REBVS = -10.9 01430357 + REDVS = -3.3 01440357 + REAVS = AMOD(REBVS, REDVS) 01450357 + IF (REAVS + 1.0001) 20030, 10030, 40030 01460357 +40030 IF (REAVS + 0.99995) 10030, 10030, 20030 01470357 +10030 IVPASS = IVPASS + 1 01480357 + WRITE (NUVI, 80002) IVTNUM 01490357 + GO TO 0031 01500357 +20030 IVFAIL = IVFAIL + 1 01510357 + RVCORR = -1.0 01520357 + WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR 01530357 + 0031 CONTINUE 01540357 +CT004* TEST 4 FIRST MAGNITUDE LARGER, MULTIPLE OF SECOND 01550357 + IVTNUM = 4 01560357 + REDVS = 1.5 01570357 + REBVS = 1.5 + REDVS + 1.5 01580357 + REAVS = AMOD(REBVS, REDVS) 01590357 + IF (REAVS + 0.00005) 20040, 10040, 40040 01600357 +40040 IF (REAVS - 0.00005) 10040, 10040, 20040 01610357 +10040 IVPASS = IVPASS + 1 01620357 + WRITE (NUVI, 80002) IVTNUM 01630357 + GO TO 0041 01640357 +20040 IVFAIL = IVFAIL + 1 01650357 + RVCORR = 0.0 01660357 + WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR 01670357 + 0041 CONTINUE 01680357 +CT005* TEST 5 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 01690357 + IVTNUM = 5 01700357 + REBVS = 7.625 01710357 + REDVS = 2.125 01720357 + REAVS = AMOD(REBVS, REDVS) 01730357 + IF (REAVS - 1.2499) 20050, 10050, 40050 01740357 +40050 IF (REAVS - 1.2501) 10050, 10050, 20050 01750357 +10050 IVPASS = IVPASS + 1 01760357 + WRITE (NUVI, 80002) IVTNUM 01770357 + GO TO 0051 01780357 +20050 IVFAIL = IVFAIL + 1 01790357 + RVCORR = 1.25 01800357 + WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR 01810357 + 0051 CONTINUE 01820357 +CT006* TEST 6 FIRST VALUE ZERO, SECOND NEGATIVE 01830357 + IVTNUM = 6 01840357 + REBVS = 0.0 01850357 + REDVS = -4.5 01860357 + REAVS = AMOD(REBVS, REDVS) 01870357 + IF (REAVS + 0.00005) 20060, 10060, 40060 01880357 +40060 IF (REAVS - 0.00005) 10060, 10060, 20060 01890357 +10060 IVPASS = IVPASS + 1 01900357 + WRITE (NUVI, 80002) IVTNUM 01910357 + GO TO 0061 01920357 +20060 IVFAIL = IVFAIL + 1 01930357 + RVCORR = 0.0 01940357 + WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR 01950357 + 0061 CONTINUE 01960357 +CT007* TEST 7 BOTH VALUES EQUAL, BOTH NEGATIVE 01970357 + IVTNUM = 7 01980357 + REBVS = -3.5 01990357 + REDVS = -3.5 02000357 + REAVS = AMOD(REBVS, REDVS) 02010357 + IF (REAVS + 0.00005) 20070, 10070, 40070 02020357 +40070 IF (REAVS - 0.00005) 10070, 10070, 20070 02030357 +10070 IVPASS = IVPASS + 1 02040357 + WRITE (NUVI, 80002) IVTNUM 02050357 + GO TO 0071 02060357 +20070 IVFAIL = IVFAIL + 1 02070357 + RVCORR = 0.0 02080357 + WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR 02090357 + 0071 CONTINUE 02100357 +CT008* TEST 8 FIRST VALUE NEGATIVE, SECOND POSITIVE, MULTIPLE 02110357 + IVTNUM = 8 02120357 + REBVS = 1.5 02130357 + REDVS = -(1.5 + REDVS + 1.5) 02140357 + REAVS = AMOD(-REBVS, -REDVS) 02150357 + IF (REAVS + 0.00005) 20080, 10080, 40080 02160357 +40080 IF (REAVS - 0.00005) 10080, 10080, 20080 02170357 +10080 IVPASS = IVPASS + 1 02180357 + WRITE (NUVI, 80002) IVTNUM 02190357 + GO TO 0081 02200357 +20080 IVFAIL = IVFAIL + 1 02210357 + RVCORR = 0.0 02220357 + WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR 02230357 + 0081 CONTINUE 02240357 +CT009* TEST 9 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 02250357 + IVTNUM = 9 02260357 + REBVS = 10.5 02270357 + REDVS = -3.3 02280357 + REAVS = AMOD(REBVS, REDVS) 02290357 + IF (REAVS - 0.59997) 20090, 10090, 40090 02300357 +40090 IF (REAVS - 0.60003) 10090, 10090, 20090 02310357 +10090 IVPASS = IVPASS + 1 02320357 + WRITE (NUVI, 80002) IVTNUM 02330357 + GO TO 0091 02340357 +20090 IVFAIL = IVFAIL + 1 02350357 + RVCORR = 0.6 02360357 + WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR 02370357 + 0091 CONTINUE 02380357 +CT010* TEST 10 PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT 02390357 + IVTNUM = 10 02400357 + RECVS = 7.625 02410357 + REDVS = 2.125 02420357 + REFVS = 2.0 02430357 + REAVS = AMOD(RECVS - REFVS, REDVS + REFVS) 02440357 + IF (REAVS - 1.4999) 20100, 10100, 40100 02450357 +40100 IF (REAVS - 1.5001) 10100, 10100, 20100 02460357 +10100 IVPASS = IVPASS + 1 02470357 + WRITE (NUVI, 80002) IVTNUM 02480357 + GO TO 0101 02490357 +20100 IVFAIL = IVFAIL + 1 02500357 + RVCORR = 1.5 02510357 + WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR 02520357 + 0101 CONTINUE 02530357 +CT011* TEST 11 TEST LOW AND HIGH MAGNITUDE ARGUMENTS 02540357 + IVTNUM = 11 02550357 + RECVS = 1.0E-16 02560357 + REDVS = 1.0E+16 02570357 + REAVS = AMOD(RECVS, REDVS) 02580357 + IF (REAVS - 0.99995E-16) 20110, 10110, 40110 02590357 +40110 IF (REAVS - 1.0001E-16) 10110, 10110, 20110 02600357 +10110 IVPASS = IVPASS + 1 02610357 + WRITE (NUVI, 80002) IVTNUM 02620357 + GO TO 0111 02630357 +20110 IVFAIL = IVFAIL + 1 02640357 + RVCORR = 1.0E-16 02650357 + WRITE(NUVI, 80012) IVTNUM, REAVS, RVCORR 02660357 + 0111 CONTINUE 02670357 +C***** 02680357 +C***** TEST OF MOD 02690357 +C***** 02700357 + WRITE(NUVI, 15904) 02710357 +15904 FORMAT (/ 8X, "TEST OF MOD" ) 02720357 +C***** 02730357 +CT012* TEST 12 FIRST VALUE ZERO, SECOND NON-ZERO 02740357 + IVTNUM = 12 02750357 + IEBVI = 0 02760357 + IEDVI = 4 02770357 + IEAVI = MOD(IEBVI, IEDVI) 02780357 + IF (IEAVI - 0) 20120, 10120, 20120 02790357 +10120 IVPASS = IVPASS + 1 02800357 + WRITE (NUVI, 80002) IVTNUM 02810357 + GO TO 0121 02820357 +20120 IVFAIL = IVFAIL + 1 02830357 + IVCORR = 0 02840357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 02850357 + 0121 CONTINUE 02860357 +CT013* TEST 13 BOTH VALUES EQUAL 02870357 + IVTNUM = 13 02880357 + IEBVI = 3 02890357 + IEDVI = 3 02900357 + IEAVI = MOD(IEBVI, IEDVI) 02910357 + IF (IEAVI - 0) 20130, 10130, 20130 02920357 +10130 IVPASS = IVPASS + 1 02930357 + WRITE (NUVI, 80002) IVTNUM 02940357 + GO TO 0131 02950357 +20130 IVFAIL = IVFAIL + 1 02960357 + IVCORR = 0 02970357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 02980357 + 0131 CONTINUE 02990357 +CT014* TEST 14 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 03000357 + IVTNUM = 14 03010357 + IEBVI = -10 03020357 + IEDVI = -3 03030357 + IEAVI = MOD(IEBVI, IEDVI) 03040357 + IF (IEAVI + 1) 20140, 10140, 20140 03050357 +10140 IVPASS = IVPASS + 1 03060357 + WRITE (NUVI, 80002) IVTNUM 03070357 + GO TO 0141 03080357 +20140 IVFAIL = IVFAIL + 1 03090357 + IVCORR = -1 03100357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 03110357 + 0141 CONTINUE 03120357 +CT015* TEST 15 FIRST MAGNITUDE LARGER, MULTIPLE OF SECOND 03130357 + IVTNUM = 15 03140357 + IEBVI = 9 03150357 + IEDVI = 3 03160357 + IEAVI = MOD(IEBVI, IEDVI) 03170357 + IF (IEAVI - 0) 20150, 10150, 20150 03180357 +10150 IVPASS = IVPASS + 1 03190357 + WRITE (NUVI, 80002) IVTNUM 03200357 + GO TO 0151 03210357 +20150 IVFAIL = IVFAIL + 1 03220357 + IVCORR = 0 03230357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 03240357 + 0151 CONTINUE 03250357 +CT016* TEST 16 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 03260357 + IVTNUM = 16 03270357 + IEBVI = 7 03280357 + IEDVI = 2 03290357 + IEAVI = MOD(IEBVI, IEDVI) 03300357 + IF (IEAVI - 1) 20160, 10160, 20160 03310357 +10160 IVPASS = IVPASS + 1 03320357 + WRITE (NUVI, 80002) IVTNUM 03330357 + GO TO 0161 03340357 +20160 IVFAIL = IVFAIL + 1 03350357 + IVCORR = 1 03360357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 03370357 + 0161 CONTINUE 03380357 +CT017* TEST 17 FIRST VALUE ZERO, SECOND NEGATIVE 03390357 + IVTNUM = 17 03400357 + IEBVI = 0 03410357 + IEDVI = -4 03420357 + IEAVI = MOD(IEBVI, IEDVI) 03430357 + IF (IEAVI - 0) 20170, 10170, 20170 03440357 +10170 IVPASS = IVPASS + 1 03450357 + WRITE (NUVI, 80002) IVTNUM 03460357 + GO TO 0171 03470357 +20170 IVFAIL = IVFAIL + 1 03480357 + IVCORR = 0 03490357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 03500357 + 0171 CONTINUE 03510357 +CT018* TEST 18 BOTH VALUES EQUAL, BOTH NEGATIVE 03520357 + IVTNUM = 18 03530357 + IEBVI = -3 03540357 + IEDVI = -3 03550357 + IEAVI = MOD(IEBVI, IEDVI) 03560357 + IF (IEAVI - 0) 20180, 10180, 20180 03570357 +10180 IVPASS = IVPASS + 1 03580357 + WRITE (NUVI, 80002) IVTNUM 03590357 + GO TO 0181 03600357 +20180 IVFAIL = IVFAIL + 1 03610357 + IVCORR = 0 03620357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 03630357 + 0181 CONTINUE 03640357 +CT019* TEST 19 FIRST MAGNITUDE LARGER, MULTIPLE, BOTH NEGATIVE 03650357 + IVTNUM = 19 03660357 + IEBVI = -9 03670357 + IEDVI = -3 03680357 + IEAVI = MOD(IEBVI, IEDVI) 03690357 + IF (IEAVI - 0) 20190, 10190, 20190 03700357 +10190 IVPASS = IVPASS + 1 03710357 + WRITE (NUVI, 80002) IVTNUM 03720357 + GO TO 0191 03730357 +20190 IVFAIL = IVFAIL + 1 03740357 + IVCORR = 0 03750357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 03760357 + 0191 CONTINUE 03770357 +CT020* TEST 20 FIRST NUMBER NEGATIVE, SECOND POSITIVE, MULTIPLE 03780357 + IVTNUM = 20 03790357 + IEBVI = -9 03800357 + IEDVI = 3 03810357 + IEAVI = MOD(IEBVI, IEDVI) 03820357 + IF (IEAVI - 0) 20200, 10200, 20200 03830357 +10200 IVPASS = IVPASS + 1 03840357 + WRITE (NUVI, 80002) IVTNUM 03850357 + GO TO 0201 03860357 +20200 IVFAIL = IVFAIL + 1 03870357 + IVCORR = 0 03880357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 03890357 + 0201 CONTINUE 03900357 +CT021* TEST 21 FIRST VALUE ZERO PRECEDED BY MINUS SIGN 03910357 + IVTNUM = 21 03920357 + IEBVI = 0 03930357 + IEDVI = 4 03940357 + IEAVI = MOD(-IEBVI, IEDVI) 03950357 + IF (IEAVI - 0) 20210, 10210, 20210 03960357 +10210 IVPASS = IVPASS + 1 03970357 + WRITE (NUVI, 80002) IVTNUM 03980357 + GO TO 0211 03990357 +20210 IVFAIL = IVFAIL + 1 04000357 + IVCORR = 0 04010357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 04020357 + 0211 CONTINUE 04030357 +CT022* TEST 22 PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT 04040357 + IVTNUM = 22 04050357 + IEDVI = 10 04060357 + IEEVI = 3 04070357 + IEFVI = 2 04080357 + IEAVI = MOD(IEDVI - IEFVI, IEEVI + IEFVI) 04090357 + IF (IEAVI - 3) 20220, 10220, 20220 04100357 +10220 IVPASS = IVPASS + 1 04110357 + WRITE (NUVI, 80002) IVTNUM 04120357 + GO TO 0221 04130357 +20220 IVFAIL = IVFAIL + 1 04140357 + IVCORR = 3 04150357 + WRITE (NUVI, 80010) IVTNUM, IEAVI, IVCORR 04160357 + 0221 CONTINUE 04170357 +C***** 04180357 +CBB** ********************** BBCSUM0 **********************************04190357 +C**** WRITE OUT TEST SUMMARY 04200357 +C**** 04210357 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04220357 + WRITE (I02, 90004) 04230357 + WRITE (I02, 90014) 04240357 + WRITE (I02, 90004) 04250357 + WRITE (I02, 90020) IVPASS 04260357 + WRITE (I02, 90022) IVFAIL 04270357 + WRITE (I02, 90024) IVDELE 04280357 + WRITE (I02, 90026) IVINSP 04290357 + WRITE (I02, 90028) IVTOTN, IVTOTL 04300357 +CBE** ********************** BBCSUM0 **********************************04310357 +CBB** ********************** BBCFOOT0 **********************************04320357 +C**** WRITE OUT REPORT FOOTINGS 04330357 +C**** 04340357 + WRITE (I02,90016) ZPROG, ZPROG 04350357 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04360357 + WRITE (I02,90019) 04370357 +CBE** ********************** BBCFOOT0 **********************************04380357 +CBB** ********************** BBCFMT0A **********************************04390357 +C**** FORMATS FOR TEST DETAIL LINES 04400357 +C**** 04410357 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04420357 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04430357 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04440357 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04450357 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04460357 + 1I6,/," ",15X,"CORRECT= " ,I6) 04470357 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04480357 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04490357 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04500357 + 1A21,/," ",16X,"CORRECT= " ,A21) 04510357 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04520357 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04530357 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04540357 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04550357 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04560357 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04570357 +80050 FORMAT (" ",48X,A31) 04580357 +CBE** ********************** BBCFMT0A **********************************04590357 +CBB** ********************** BBCFMT0B **********************************04600357 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04610357 +C**** 04620357 +90002 FORMAT ("1") 04630357 +90004 FORMAT (" ") 04640357 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04650357 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04660357 +90008 FORMAT (" ",21X,A13,A17) 04670357 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04680357 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04690357 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04700357 + 1 7X,"REMARKS",24X) 04710357 +90014 FORMAT (" ","----------------------------------------------" , 04720357 + 1 "---------------------------------" ) 04730357 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04740357 +C**** 04750357 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04760357 +C**** 04770357 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04780357 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04790357 + 1 A13) 04800357 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04810357 +C**** 04820357 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04830357 +C**** 04840357 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04850357 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04860357 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04870357 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04880357 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04890357 +CBE** ********************** BBCFMT0B **********************************04900357 +C***** 04910357 +C***** END OF TEST SEGMENT 159 04920357 + STOP 04930357 + END 04940357 + 04950357 diff --git a/Fortran/UnitTests/fcvs21_f95/FM357.reference_output b/Fortran/UnitTests/fcvs21_f95/FM357.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM357.reference_output @@ -0,0 +1,61 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM357BEGIN* TEST RESULTS - FM357 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + XAMOD - (159) INTRINSIC FUNCTION-- + + AMOD, MOD (REMAINDERING) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 22 TESTS + + + TEST OF AMOD + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + + TEST OF MOD + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + + ------------------------------------------------------------------------------- + + 22 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 22 OF 22 TESTS EXECUTED + + *FM357END* END OF TEST - FM357 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM359.f b/Fortran/UnitTests/fcvs21_f95/FM359.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM359.f @@ -0,0 +1,492 @@ + PROGRAM FM359 + +C***********************************************************************00010359 +C***** FORTRAN 77 00020359 +C***** FM359 XSIGN - (161) 00030359 +C***** 00040359 +C***********************************************************************00050359 +C***** GENERAL PURPOSE SUBSET REF00060359 +C***** TEST INTRINSIC FUNCTION - SIGN, ISIGN - (TRANSFER 15.3 00070359 +C***** OF SIGN - SIGN OF A2 TIMES ABS(A1) ) (TABLE 5)00080359 +C***** 00090359 +CBB** ********************** BBCCOMNT **********************************00100359 +C**** 00110359 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120359 +C**** VERSION 2.1 00130359 +C**** 00140359 +C**** 00150359 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160359 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170359 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180359 +C**** BUILDING 225 RM A266 00190359 +C**** GAITHERSBURG, MD 20899 00200359 +C**** 00210359 +C**** 00220359 +C**** 00230359 +CBE** ********************** BBCCOMNT **********************************00240359 +CBB** ********************** BBCINITA **********************************00250359 +C**** SPECIFICATION STATEMENTS 00260359 +C**** 00270359 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00280359 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00290359 +CBE** ********************** BBCINITA **********************************00300359 +CBB** ********************** BBCINITB **********************************00310359 +C**** INITIALIZE SECTION 00320359 + DATA ZVERS, ZVERSD, ZDATE 00330359 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00340359 + DATA ZCOMPL, ZNAME, ZTAPE 00350359 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00360359 + DATA ZPROJ, ZTAPED, ZPROG 00370359 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00380359 + DATA REMRKS /' '/ 00390359 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00400359 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00410359 +C**** 00420359 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00430359 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00440359 +CZ03 ZPROG = 'PROGRAM NAME' 00450359 +CZ04 ZDATE = 'DATE OF TEST' 00460359 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00470359 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00480359 +CZ07 ZNAME = 'NAME OF USER' 00490359 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00500359 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00510359 +C 00520359 + IVPASS = 0 00530359 + IVFAIL = 0 00540359 + IVDELE = 0 00550359 + IVINSP = 0 00560359 + IVTOTL = 0 00570359 + IVTOTN = 0 00580359 + ICZERO = 0 00590359 +C 00600359 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00610359 + I01 = 05 00620359 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00630359 + I02 = 06 00640359 +C 00650359 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00660359 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670359 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00680359 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00690359 +C 00700359 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00710359 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00720359 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00730359 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00740359 +C 00750359 +CBE** ********************** BBCINITB **********************************00760359 + NUVI = I02 00770359 + IVTOTL = 22 00780359 + ZPROG = 'FM359' 00790359 +CBB** ********************** BBCHED0A **********************************00800359 +C**** 00810359 +C**** WRITE REPORT TITLE 00820359 +C**** 00830359 + WRITE (I02, 90002) 00840359 + WRITE (I02, 90006) 00850359 + WRITE (I02, 90007) 00860359 + WRITE (I02, 90008) ZVERS, ZVERSD 00870359 + WRITE (I02, 90009) ZPROG, ZPROG 00880359 + WRITE (I02, 90010) ZDATE, ZCOMPL 00890359 +CBE** ********************** BBCHED0A **********************************00900359 +C***** 00910359 +C***** HEADER FOR SEGMENT 161 00920359 + WRITE (NUVI,16101) 00930359 +16101 FORMAT(" ", // 2X,"XSIGN - (161) INTRINSIC FUNCTIONS-- " //12X,00940359 + 1 "SIGN, ISIGN (TRANSFER OF SIGN)" // 00950359 + 2 2X,"SUBSET REF. - 15.3 " ) 00960359 +CBB** ********************** BBCHED0B **********************************00970359 +C**** WRITE DETAIL REPORT HEADERS 00980359 +C**** 00990359 + WRITE (I02,90004) 01000359 + WRITE (I02,90004) 01010359 + WRITE (I02,90013) 01020359 + WRITE (I02,90014) 01030359 + WRITE (I02,90015) IVTOTL 01040359 +CBE** ********************** BBCHED0B **********************************01050359 +C***** 01060359 +C***** TEST OF SIGN 01070359 +C***** 01080359 + WRITE(NUVI, 16102) 01090359 +16102 FORMAT (/ 8X, "TEST OF SIGN" ) 01100359 +CT001* TEST 1 BOTH VALUES ZERO 01110359 + IVTNUM = 1 01120359 + RFBVS = 0.0 01130359 + RFAVS = SIGN(RFBVS, RFBVS) 01140359 + IF (RFAVS + 0.00005) 20010, 10010, 40010 01150359 +40010 IF (RFAVS - 0.00005) 10010, 10010, 20010 01160359 +10010 IVPASS = IVPASS + 1 01170359 + WRITE (NUVI, 80002) IVTNUM 01180359 + GO TO 0011 01190359 +20010 IVFAIL = IVFAIL + 1 01200359 + RVCORR = 0.0 01210359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 01220359 + 0011 CONTINUE 01230359 +CT002* TEST 2 FIRST VALUE POSITIVE, SECOND ZERO 01240359 + IVTNUM = 2 01250359 + RFBVS = 1.5 01260359 + RFDVS = 0.0 01270359 + RFAVS = SIGN(RFBVS, RFDVS) 01280359 + IF (RFAVS - 1.4999) 20020, 10020, 40020 01290359 +40020 IF (RFAVS - 1.5001) 10020, 10020, 20020 01300359 +10020 IVPASS = IVPASS + 1 01310359 + WRITE (NUVI, 80002) IVTNUM 01320359 + GO TO 0021 01330359 +20020 IVFAIL = IVFAIL + 1 01340359 + RVCORR = 1.5 01350359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 01360359 + 0021 CONTINUE 01370359 +CT003* TEST 3 FIRST VALUE NEGATIVE, SECOND ZERO 01380359 + IVTNUM = 3 01390359 + RFBVS = -1.5 01400359 + RFDVS = 0.0 01410359 + RFAVS = SIGN(RFBVS, RFDVS) 01420359 + IF (RFAVS - 1.4999) 20030, 10030, 40030 01430359 +40030 IF (RFAVS - 1.5001) 10030, 10030, 20030 01440359 +10030 IVPASS = IVPASS + 1 01450359 + WRITE (NUVI, 80002) IVTNUM 01460359 + GO TO 0031 01470359 +20030 IVFAIL = IVFAIL + 1 01480359 + RVCORR = 1.5 01490359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 01500359 + 0031 CONTINUE 01510359 +CT004* TEST 4 FIRST VALUE ZERO, SECOND POSITIVE 01520359 + IVTNUM = 4 01530359 + RFBVS = 0.0 01540359 + RFDVS = 2.5 01550359 + RFAVS = SIGN(RFBVS, RFDVS) 01560359 + IF (RFAVS + 0.00005) 20040, 10040, 40040 01570359 +40040 IF (RFAVS - 0.00005) 10040, 10040, 20040 01580359 +10040 IVPASS = IVPASS + 1 01590359 + WRITE (NUVI, 80002) IVTNUM 01600359 + GO TO 0041 01610359 +20040 IVFAIL = IVFAIL + 1 01620359 + RVCORR = 0.0 01630359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 01640359 + 0041 CONTINUE 01650359 +CT005* TEST 5 BOTH VALUES POSITIVE 01660359 + IVTNUM = 5 01670359 + RFBVS = 1.5 01680359 + RFDVS = 2.5 01690359 + RFAVS = SIGN(RFBVS, RFDVS) 01700359 + IF (RFAVS - 1.4999) 20050, 10050, 40050 01710359 +40050 IF (RFAVS - 1.5001) 10050, 10050, 20050 01720359 +10050 IVPASS = IVPASS + 1 01730359 + WRITE (NUVI, 80002) IVTNUM 01740359 + GO TO 0051 01750359 +20050 IVFAIL = IVFAIL + 1 01760359 + RVCORR = 1.5 01770359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 01780359 + 0051 CONTINUE 01790359 +CT006* TEST 6 FIRST VALUE NEGATIVE, SECOND POSITIVE 01800359 + IVTNUM = 6 01810359 + RFBVS = -1.5 01820359 + RFDVS = 2.5 01830359 + RFAVS = SIGN(RFBVS, RFDVS) 01840359 + IF (RFAVS - 1.4999) 20060, 10060, 40060 01850359 +40060 IF (RFAVS - 1.5001) 10060, 10060, 20060 01860359 +10060 IVPASS = IVPASS + 1 01870359 + WRITE (NUVI, 80002) IVTNUM 01880359 + GO TO 0061 01890359 +20060 IVFAIL = IVFAIL + 1 01900359 + RVCORR = 1.5 01910359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 01920359 + 0061 CONTINUE 01930359 +CT007* TEST 7 FIRST VALUE ZERO, SECOND NEGATIVE 01940359 + IVTNUM = 7 01950359 + RFBVS = 0.0 01960359 + RFDVS = -2.5 01970359 + RFAVS = SIGN(RFBVS, RFDVS) 01980359 + IF (RFAVS + 0.00005) 20070, 10070, 40070 01990359 +40070 IF (RFAVS - 0.00005) 10070, 10070, 20070 02000359 +10070 IVPASS = IVPASS + 1 02010359 + WRITE (NUVI, 80002) IVTNUM 02020359 + GO TO 0071 02030359 +20070 IVFAIL = IVFAIL + 1 02040359 + RVCORR = 0.0 02050359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 02060359 + 0071 CONTINUE 02070359 +CT008* TEST 8 BOTH VALUES NEGATIVE 02080359 + IVTNUM = 8 02090359 + RFBVS = -1.5 02100359 + RFDVS = -2.5 02110359 + RFAVS = SIGN(RFBVS, RFDVS) 02120359 + IF (RFAVS + 1.5001) 20080, 10080, 40080 02130359 +40080 IF (RFAVS + 1.4999) 10080, 10080, 20080 02140359 +10080 IVPASS = IVPASS + 1 02150359 + WRITE (NUVI, 80002) IVTNUM 02160359 + GO TO 0081 02170359 +20080 IVFAIL = IVFAIL + 1 02180359 + RVCORR = -1.5 02190359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 02200359 + 0081 CONTINUE 02210359 +CT009* TEST 9 FIRST VALUE POSITIVE, SECOND NEGATIVE 02220359 + IVTNUM = 9 02230359 + RFBVS = 1.5 02240359 + RFDVS = -2.5 02250359 + RFAVS = SIGN(RFBVS, RFDVS) 02260359 + IF (RFAVS + 1.5001) 20090, 10090, 40090 02270359 +40090 IF (RFAVS + 1.4999) 10090, 10090, 20090 02280359 +10090 IVPASS = IVPASS + 1 02290359 + WRITE (NUVI, 80002) IVTNUM 02300359 + GO TO 0091 02310359 +20090 IVFAIL = IVFAIL + 1 02320359 + RVCORR = -1.5 02330359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 02340359 + 0091 CONTINUE 02350359 +CT010* TEST 10 BOTH VALUES ZERO, 1ST ZERO PRECEDED BY A MINUS SIGN 02360359 + IVTNUM = 10 02370359 + RFDVS = 0.0 02380359 + RFEVS = 0.0 02390359 + RFAVS = SIGN(-RFDVS, RFEVS) 02400359 + IF (RFAVS + 0.0005) 20100, 10100, 40100 02410359 +40100 IF (RFAVS - 0.00005) 10100, 10100, 20100 02420359 +10100 IVPASS = IVPASS + 1 02430359 + WRITE (NUVI, 80002) IVTNUM 02440359 + GO TO 0101 02450359 +20100 IVFAIL = IVFAIL + 1 02460359 + RVCORR = 0.0 02470359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 02480359 + 0101 CONTINUE 02490359 +CT011* TEST 11 ARITHMETIC EXPRESSIONS PRESENTED TO SIGN 02500359 + IVTNUM = 11 02510359 + RFDVS = 1.5 02520359 + RFEVS = 2.0 02530359 + RFAVS = SIGN(RFDVS + RFEVS, RFDVS - RFEVS) 02540359 + IF (RFAVS + 3.5002) 20110, 10110, 40110 02550359 +40110 IF (RFAVS + 3.4998) 10110, 10110, 20110 02560359 +10110 IVPASS = IVPASS + 1 02570359 + WRITE (NUVI, 80002) IVTNUM 02580359 + GO TO 0111 02590359 +20110 IVFAIL = IVFAIL + 1 02600359 + RVCORR = -3.5 02610359 + WRITE (NUVI, 80012) IVTNUM, RFAVS, RVCORR 02620359 + 0111 CONTINUE 02630359 +C***** 02640359 +C***** TEST OF ISIGN 02650359 +C***** 02660359 + WRITE(NUVI, 16104) 02670359 +16104 FORMAT (/ 8X, "TEST OF ISIGN" ) 02680359 +C***** 02690359 +CT012* TEST 12 BOTH VALUES ZERO 02700359 + IVTNUM = 12 02710359 + IFBVI = 0 02720359 + IFDVI = 0 02730359 + IFAVI = ISIGN(IFBVI, IFDVI) 02740359 + IF (IFAVI - 0) 20120, 10120, 20120 02750359 +10120 IVPASS = IVPASS + 1 02760359 + WRITE (NUVI, 80002) IVTNUM 02770359 + GO TO 0121 02780359 +20120 IVFAIL = IVFAIL + 1 02790359 + IVCORR = 0 02800359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 02810359 + 0121 CONTINUE 02820359 +CT013* TEST 13 FIRST VALUE POSITIVE, SECOND ZERO 02830359 + IVTNUM = 13 02840359 + IFBVI = 2 02850359 + IFDVI = 0 02860359 + IFAVI = ISIGN(IFBVI, IFDVI) 02870359 + IF (IFAVI - 2) 20130, 10130, 20130 02880359 +10130 IVPASS = IVPASS + 1 02890359 + WRITE (NUVI, 80002) IVTNUM 02900359 + GO TO 0131 02910359 +20130 IVFAIL = IVFAIL + 1 02920359 + IVCORR = 2 02930359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 02940359 + 0131 CONTINUE 02950359 +CT014* TEST 14 FIRST VALUE NEGATIVE, SECOND ZERO 02960359 + IVTNUM = 14 02970359 + IFBVI = -2 02980359 + IFDVI = 0 02990359 + IFAVI = ISIGN(IFBVI, IFDVI) 03000359 + IF (IFAVI - 2) 20140, 10140, 20140 03010359 +10140 IVPASS = IVPASS + 1 03020359 + WRITE (NUVI, 80002) IVTNUM 03030359 + GO TO 0141 03040359 +20140 IVFAIL = IVFAIL + 1 03050359 + IVCORR = 2 03060359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 03070359 + 0141 CONTINUE 03080359 +CT015* TEST 15 FIRST VALUE ZERO, SECOND POSITIVE 03090359 + IVTNUM = 15 03100359 + IFBVI = 0 03110359 + IFDVI = 5 03120359 + IFAVI = ISIGN(IFBVI, IFDVI) 03130359 + IF (IFAVI - 0) 20150, 10150, 20150 03140359 +10150 IVPASS = IVPASS + 1 03150359 + WRITE (NUVI, 80002) IVTNUM 03160359 + GO TO 0151 03170359 +20150 IVFAIL = IVFAIL + 1 03180359 + IVCORR = 0 03190359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 03200359 + 0151 CONTINUE 03210359 +CT016* TEST 16 BOTH VALUES POSITIVE 03220359 + IVTNUM = 16 03230359 + IFBVI = 2 03240359 + IFDVI = 5 03250359 + IFAVI = ISIGN(IFBVI, IFDVI) 03260359 + IF (IFAVI - 2) 20160, 10160, 20160 03270359 +10160 IVPASS = IVPASS + 1 03280359 + WRITE (NUVI, 80002) IVTNUM 03290359 + GO TO 0161 03300359 +20160 IVFAIL = IVFAIL + 1 03310359 + IVCORR = 2 03320359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 03330359 + 0161 CONTINUE 03340359 +CT017* TEST 17 FIRST VALUE NEGATIVE, SECOND POSITIVE 03350359 + IVTNUM = 17 03360359 + IFBVI = -2 03370359 + IFDVI = 5 03380359 + IFAVI = ISIGN(IFBVI, IFDVI) 03390359 + IF (IFAVI - 2) 20170, 10170, 20170 03400359 +10170 IVPASS = IVPASS + 1 03410359 + WRITE (NUVI, 80002) IVTNUM 03420359 + GO TO 0171 03430359 +20170 IVFAIL = IVFAIL + 1 03440359 + IVCORR = 2 03450359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 03460359 + 0171 CONTINUE 03470359 +CT018* TEST 18 FIRST VALUE ZERO, SECOND NEGATIVE 03480359 + IVTNUM = 18 03490359 + IFBVI = 0 03500359 + IFDVI = -5 03510359 + IFAVI = ISIGN(IFBVI, IFDVI) 03520359 + IF (IFAVI - 0) 20180, 10180, 20180 03530359 +10180 IVPASS = IVPASS + 1 03540359 + WRITE (NUVI, 80002) IVTNUM 03550359 + GO TO 0181 03560359 +20180 IVFAIL = IVFAIL + 1 03570359 + IVCORR = 0 03580359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 03590359 + 0181 CONTINUE 03600359 +CT019* TEST 19 BOTH VALUES NEGATIVE 03610359 + IVTNUM = 19 03620359 + IFBVI = -2 03630359 + IFDVI = -5 03640359 + IFAVI = ISIGN(IFBVI, IFDVI) 03650359 + IF (IFAVI + 2) 20190, 10190, 20190 03660359 +10190 IVPASS = IVPASS + 1 03670359 + WRITE (NUVI, 80002) IVTNUM 03680359 + GO TO 0191 03690359 +20190 IVFAIL = IVFAIL + 1 03700359 + IVCORR = -2 03710359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 03720359 + 0191 CONTINUE 03730359 +CT020* TEST 20 FIRST VALUE POSITIVE, SECOND NEGATIVE 03740359 + IVTNUM = 20 03750359 + IFBVI = 2 03760359 + IFDVI = -5 03770359 + IFAVI = ISIGN(IFBVI, IFDVI) 03780359 + IF (IFAVI + 2) 20200, 10200, 20200 03790359 +10200 IVPASS = IVPASS + 1 03800359 + WRITE (NUVI, 80002) IVTNUM 03810359 + GO TO 0201 03820359 +20200 IVFAIL = IVFAIL + 1 03830359 + IVCORR = -2 03840359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 03850359 + 0201 CONTINUE 03860359 +CT021* TEST 21 BOTH VALUES ZERO, 1ST ZERO PRECEDED BY A MINUS SIGN 03870359 + IVTNUM = 21 03880359 + IFDVI = 0 03890359 + IFEVI = 0 03900359 + IFAVI = ISIGN(-IFDVI, IFEVI) 03910359 + IF (IFAVI - 0) 20210, 10210, 20210 03920359 +10210 IVPASS = IVPASS + 1 03930359 + WRITE (NUVI, 80002) IVTNUM 03940359 + GO TO 0211 03950359 +20210 IVFAIL = IVFAIL + 1 03960359 + IVCORR = 0 03970359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 03980359 + 0211 CONTINUE 03990359 +CT022* TEST 22 ARITHMETIC EXPRESSIONS PRESENTED TO ISIGN 04000359 + IVTNUM = 22 04010359 + IFDVI = 2 04020359 + IFEVI = 3 04030359 + IFAVI = ISIGN(IFDVI + IFEVI, IFDVI - IFEVI) 04040359 + IF (IFAVI + 5) 20220, 10220, 20220 04050359 +10220 IVPASS = IVPASS + 1 04060359 + WRITE (NUVI, 80002) IVTNUM 04070359 + GO TO 0221 04080359 +20220 IVFAIL = IVFAIL + 1 04090359 + IVCORR = -5 04100359 + WRITE (NUVI, 80010) IVTNUM, IFAVI, IVCORR 04110359 + 0221 CONTINUE 04120359 +C***** 04130359 +CBB** ********************** BBCSUM0 **********************************04140359 +C**** WRITE OUT TEST SUMMARY 04150359 +C**** 04160359 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04170359 + WRITE (I02, 90004) 04180359 + WRITE (I02, 90014) 04190359 + WRITE (I02, 90004) 04200359 + WRITE (I02, 90020) IVPASS 04210359 + WRITE (I02, 90022) IVFAIL 04220359 + WRITE (I02, 90024) IVDELE 04230359 + WRITE (I02, 90026) IVINSP 04240359 + WRITE (I02, 90028) IVTOTN, IVTOTL 04250359 +CBE** ********************** BBCSUM0 **********************************04260359 +CBB** ********************** BBCFOOT0 **********************************04270359 +C**** WRITE OUT REPORT FOOTINGS 04280359 +C**** 04290359 + WRITE (I02,90016) ZPROG, ZPROG 04300359 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04310359 + WRITE (I02,90019) 04320359 +CBE** ********************** BBCFOOT0 **********************************04330359 +CBB** ********************** BBCFMT0A **********************************04340359 +C**** FORMATS FOR TEST DETAIL LINES 04350359 +C**** 04360359 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04370359 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04380359 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04390359 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04400359 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04410359 + 1I6,/," ",15X,"CORRECT= " ,I6) 04420359 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04430359 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04440359 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04450359 + 1A21,/," ",16X,"CORRECT= " ,A21) 04460359 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04470359 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04480359 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04490359 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04500359 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04510359 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04520359 +80050 FORMAT (" ",48X,A31) 04530359 +CBE** ********************** BBCFMT0A **********************************04540359 +CBB** ********************** BBCFMT0B **********************************04550359 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04560359 +C**** 04570359 +90002 FORMAT ("1") 04580359 +90004 FORMAT (" ") 04590359 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04600359 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04610359 +90008 FORMAT (" ",21X,A13,A17) 04620359 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04630359 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04640359 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04650359 + 1 7X,"REMARKS",24X) 04660359 +90014 FORMAT (" ","----------------------------------------------" , 04670359 + 1 "---------------------------------" ) 04680359 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04690359 +C**** 04700359 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04710359 +C**** 04720359 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04730359 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04740359 + 1 A13) 04750359 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04760359 +C**** 04770359 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04780359 +C**** 04790359 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04800359 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04810359 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04820359 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04830359 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04840359 +CBE** ********************** BBCFMT0B **********************************04850359 +C***** 04860359 +C***** END OF TEST SEGMENT 161 04870359 + STOP 04880359 + END 04890359 + 04900359 diff --git a/Fortran/UnitTests/fcvs21_f95/FM359.reference_output b/Fortran/UnitTests/fcvs21_f95/FM359.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM359.reference_output @@ -0,0 +1,61 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM359BEGIN* TEST RESULTS - FM359 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + XSIGN - (161) INTRINSIC FUNCTIONS-- + + SIGN, ISIGN (TRANSFER OF SIGN) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 22 TESTS + + + TEST OF SIGN + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + + TEST OF ISIGN + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + + ------------------------------------------------------------------------------- + + 22 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 22 OF 22 TESTS EXECUTED + + *FM359END* END OF TEST - FM359 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM360.f b/Fortran/UnitTests/fcvs21_f95/FM360.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM360.f @@ -0,0 +1,387 @@ + PROGRAM FM360 + +C***********************************************************************00010360 +C***** FORTRAN 77 00020360 +C***** FM360 XDIM - (163) 00030360 +C***** 00040360 +C***********************************************************************00050360 +C***** GENERAL PURPOSE SUBSET REF00060360 +C***** TEST INTRINSIC FUNCTION DIM AND IDIM--POSITIVE 15.3 00070360 +C***** DIFFERENCE, WHICH IS DEFINED AS A1 - MIN(A1,A2) (TABLE 5)00080360 +C***** 00090360 +CBB** ********************** BBCCOMNT **********************************00100360 +C**** 00110360 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120360 +C**** VERSION 2.1 00130360 +C**** 00140360 +C**** 00150360 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160360 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170360 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180360 +C**** BUILDING 225 RM A266 00190360 +C**** GAITHERSBURG, MD 20899 00200360 +C**** 00210360 +C**** 00220360 +C**** 00230360 +CBE** ********************** BBCCOMNT **********************************00240360 +CBB** ********************** BBCINITA **********************************00250360 +C**** SPECIFICATION STATEMENTS 00260360 +C**** 00270360 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00280360 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00290360 +CBE** ********************** BBCINITA **********************************00300360 +CBB** ********************** BBCINITB **********************************00310360 +C**** INITIALIZE SECTION 00320360 + DATA ZVERS, ZVERSD, ZDATE 00330360 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00340360 + DATA ZCOMPL, ZNAME, ZTAPE 00350360 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00360360 + DATA ZPROJ, ZTAPED, ZPROG 00370360 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00380360 + DATA REMRKS /' '/ 00390360 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00400360 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00410360 +C**** 00420360 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00430360 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00440360 +CZ03 ZPROG = 'PROGRAM NAME' 00450360 +CZ04 ZDATE = 'DATE OF TEST' 00460360 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00470360 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00480360 +CZ07 ZNAME = 'NAME OF USER' 00490360 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00500360 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00510360 +C 00520360 + IVPASS = 0 00530360 + IVFAIL = 0 00540360 + IVDELE = 0 00550360 + IVINSP = 0 00560360 + IVTOTL = 0 00570360 + IVTOTN = 0 00580360 + ICZERO = 0 00590360 +C 00600360 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00610360 + I01 = 05 00620360 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00630360 + I02 = 06 00640360 +C 00650360 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00660360 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670360 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00680360 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00690360 +C 00700360 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00710360 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00720360 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00730360 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00740360 +C 00750360 +CBE** ********************** BBCINITB **********************************00760360 + NUVI = I02 00770360 + IVTOTL = 14 00780360 + ZPROG = 'FM360' 00790360 +CBB** ********************** BBCHED0A **********************************00800360 +C**** 00810360 +C**** WRITE REPORT TITLE 00820360 +C**** 00830360 + WRITE (I02, 90002) 00840360 + WRITE (I02, 90006) 00850360 + WRITE (I02, 90007) 00860360 + WRITE (I02, 90008) ZVERS, ZVERSD 00870360 + WRITE (I02, 90009) ZPROG, ZPROG 00880360 + WRITE (I02, 90010) ZDATE, ZCOMPL 00890360 +CBE** ********************** BBCHED0A **********************************00900360 +C***** 00910360 +C***** HEADER FOR SEGMENT 163 00920360 + WRITE (NUVI,16301) 00930360 +16301 FORMAT(" ", //,2X,"XDIM - (163) INTRINSIC FUNCTIONS-- " //12X, 00940360 + 1 "DIM, IDIM (POSITIVE DIFFERENCE)" // 00950360 + 2 2X,"SUBSET REF. - 15.3" ) 00960360 +CBB** ********************** BBCHED0B **********************************00970360 +C**** WRITE DETAIL REPORT HEADERS 00980360 +C**** 00990360 + WRITE (I02,90004) 01000360 + WRITE (I02,90004) 01010360 + WRITE (I02,90013) 01020360 + WRITE (I02,90014) 01030360 + WRITE (I02,90015) IVTOTL 01040360 +CBE** ********************** BBCHED0B **********************************01050360 +C***** 01060360 +C***** TEST OF DIM 01070360 +C***** 01080360 + WRITE(NUVI, 16304) 01090360 +16304 FORMAT (/ 8X, "TEST OF DIM" ) 01100360 +CT001* TEST 1 BOTH VALUES EQUAL 01110360 + IVTNUM = 1 01120360 + RGBVS = 2.5 01130360 + RGDVS = 2.5 01140360 + RGAVS = DIM(RGBVS, RGDVS) 01150360 + IF (RGAVS + .00005) 20010, 10010, 40010 01160360 +40010 IF (RGAVS - .00005) 10010, 10010, 20010 01170360 +10010 IVPASS = IVPASS + 1 01180360 + WRITE (NUVI, 80002) IVTNUM 01190360 + GO TO 0011 01200360 +20010 IVFAIL = IVFAIL + 1 01210360 + RVCORR = 0.0 01220360 + WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR 01230360 + 0011 CONTINUE 01240360 +CT002* TEST 2 FIRST VALUE LESS THAN SECOND 01250360 + IVTNUM = 2 01260360 + RGBVS = 2.5 01270360 + RGDVS = 5.5 01280360 + RGAVS = DIM(RGBVS, RGDVS) 01290360 + IF (RGAVS + .00005) 20020, 10020, 40020 01300360 +40020 IF (RGAVS - .00005) 10020, 10020, 20020 01310360 +10020 IVPASS = IVPASS + 1 01320360 + WRITE (NUVI, 80002) IVTNUM 01330360 + GO TO 0021 01340360 +20020 IVFAIL = IVFAIL + 1 01350360 + RVCORR = 0.0 01360360 + WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR 01370360 + 0021 CONTINUE 01380360 +CT003* TEST 3 FIRST VALUE GREATER THAN SECOND 01390360 + IVTNUM = 3 01400360 + RGBVS = 5.5 01410360 + RGDVS = 2.5 01420360 + RGAVS = DIM(RGBVS, RGDVS) 01430360 + IF (RGAVS - 2.9998) 20030, 10030, 40030 01440360 +40030 IF (RGAVS - 3.0002) 10030, 10030, 20030 01450360 +10030 IVPASS = IVPASS + 1 01460360 + WRITE (NUVI, 80002) IVTNUM 01470360 + GO TO 0031 01480360 +20030 IVFAIL = IVFAIL + 1 01490360 + RVCORR = 3.0 01500360 + WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR 01510360 + 0031 CONTINUE 01520360 +CT004* TEST 4 BOTH VALUES EQUAL, BOTH NEGATIVE 01530360 + IVTNUM = 4 01540360 + RGBVS = -2.5 01550360 + RGDVS = -2.5 01560360 + RGAVS = DIM(RGBVS, RGDVS) 01570360 + IF (RGAVS + .00005) 20040, 10040, 40040 01580360 +40040 IF (RGAVS - .00005) 10040, 10040, 20040 01590360 +10040 IVPASS = IVPASS + 1 01600360 + WRITE (NUVI, 80002) IVTNUM 01610360 + GO TO 0041 01620360 +20040 IVFAIL = IVFAIL + 1 01630360 + RVCORR = 0.0 01640360 + WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR 01650360 + 0041 CONTINUE 01660360 +CT005* TEST 5 FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE 01670360 + IVTNUM = 5 01680360 + RGBVS = -2.5 01690360 + RGDVS = -5.5 01700360 + RGAVS = DIM(RGBVS, RGDVS) 01710360 + IF (RGAVS - 2.9998) 20050, 10050, 40050 01720360 +40050 IF (RGAVS - 3.0002) 10050, 10050, 20050 01730360 +10050 IVPASS = IVPASS + 1 01740360 + WRITE (NUVI, 80002) IVTNUM 01750360 + GO TO 0051 01760360 +20050 IVFAIL = IVFAIL + 1 01770360 + RVCORR = 3.0 01780360 + WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR 01790360 + 0051 CONTINUE 01800360 +CT006* TEST 6 FIRST VALUE LESS THAN SECOND, BOTH NEGATIVE 01810360 + IVTNUM = 6 01820360 + RGBVS = -5.5 01830360 + RGDVS = -2.5 01840360 + RGAVS = DIM(RGBVS, RGDVS) 01850360 + IF (RGAVS + .00005) 20060, 10060, 40060 01860360 +40060 IF (RGAVS - .00005) 10060, 10060, 20060 01870360 +10060 IVPASS = IVPASS + 1 01880360 + WRITE (NUVI, 80002) IVTNUM 01890360 + GO TO 0061 01900360 +20060 IVFAIL = IVFAIL + 1 01910360 + RVCORR = 0.0 01920360 + WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR 01930360 + 0061 CONTINUE 01940360 +CT007* TEST 7 EXPRESSIONS PRESENTED TO DIM 01950360 + IVTNUM = 7 01960360 + RGDVS = 2.5 01970360 + RGEVS = 1.25 01980360 + RGAVS = DIM(RGDVS / RGEVS, RGDVS * RGEVS) 01990360 + IF (RGAVS + .00005) 20070, 10070, 40070 02000360 +40070 IF (RGAVS - .00005) 10070, 10070, 20070 02010360 +10070 IVPASS = IVPASS + 1 02020360 + WRITE (NUVI, 80002) IVTNUM 02030360 + GO TO 0071 02040360 +20070 IVFAIL = IVFAIL + 1 02050360 + RVCORR = 0.0 02060360 + WRITE (NUVI, 80012) IVTNUM, RGAVS, RVCORR 02070360 + 0071 CONTINUE 02080360 +C***** 02090360 +C***** TEST OF IDIM 02100360 +C***** 02110360 + WRITE(NUVI, 16302) 02120360 +16302 FORMAT (/ 08X, "TEST OF IDIM" ) 02130360 +CT008* TEST 8 BOTH VALUES EQUAL 02140360 + IVTNUM = 8 02150360 + IGBVI = 2 02160360 + IGDVI = 2 02170360 + IGAVI = IDIM(IGBVI, IGDVI) 02180360 + IF (IGAVI - 0) 20080, 10080, 20080 02190360 +10080 IVPASS = IVPASS + 1 02200360 + WRITE (NUVI, 80002) IVTNUM 02210360 + GO TO 0081 02220360 +20080 IVFAIL = IVFAIL + 1 02230360 + IVCORR = 0 02240360 + WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR 02250360 + 0081 CONTINUE 02260360 +CT009* TEST 9 FIRST VALUE LESS THAN SECOND 02270360 + IVTNUM = 9 02280360 + IGBVI = 2 02290360 + IGDVI = 5 02300360 + IGAVI = IDIM(IGBVI, IGDVI) 02310360 + IF (IGAVI - 0) 20090, 10090, 20090 02320360 +10090 IVPASS = IVPASS + 1 02330360 + WRITE (NUVI, 80002) IVTNUM 02340360 + GO TO 0091 02350360 +20090 IVFAIL = IVFAIL + 1 02360360 + IVCORR = 0 02370360 + WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR 02380360 + 0091 CONTINUE 02390360 +CT010* TEST 10 FIRST VALUE GREATER THAN SECOND 02400360 + IVTNUM = 10 02410360 + IGBVI = 5 02420360 + IGDVI = 2 02430360 + IGAVI = IDIM(IGBVI, IGDVI) 02440360 + IF (IGAVI - 3) 20100, 10100, 20100 02450360 +10100 IVPASS = IVPASS + 1 02460360 + WRITE (NUVI, 80002) IVTNUM 02470360 + GO TO 0101 02480360 +20100 IVFAIL = IVFAIL + 1 02490360 + IVCORR = 3 02500360 + WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR 02510360 + 0101 CONTINUE 02520360 +CT011* TEST 11 BOTH VALUES EQUAL, BOTH NEGATIVE 02530360 + IVTNUM = 11 02540360 + IGBVI = -2 02550360 + IGDVI = -2 02560360 + IGAVI = IDIM(IGBVI, IGDVI) 02570360 + IF (IGAVI - 0) 20110, 10110, 20110 02580360 +10110 IVPASS = IVPASS + 1 02590360 + WRITE (NUVI, 80002) IVTNUM 02600360 + GO TO 0111 02610360 +20110 IVFAIL = IVFAIL + 1 02620360 + IVCORR = 0 02630360 + WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR 02640360 + 0111 CONTINUE 02650360 +CT012* TEST 12 FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE 02660360 + IVTNUM = 12 02670360 + IGBVI = -2 02680360 + IGDVI = -5 02690360 + IGAVI = IDIM(IGBVI, IGDVI) 02700360 + IF (IGAVI - 3) 20120, 10120, 20120 02710360 +10120 IVPASS = IVPASS + 1 02720360 + WRITE (NUVI, 80002) IVTNUM 02730360 + GO TO 0121 02740360 +20120 IVFAIL = IVFAIL + 1 02750360 + IVCORR = 3 02760360 + WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR 02770360 + 0121 CONTINUE 02780360 +CT013* TEST 13 FIRST VALUE LESS THAN SECOND, BOTH NEGATIVE 02790360 + IVTNUM = 13 02800360 + IGBVI = -5 02810360 + IGDVI = -2 02820360 + IGAVI = IDIM(IGBVI, IGDVI) 02830360 + IF (IGAVI - 0) 20130, 10130, 20130 02840360 +10130 IVPASS = IVPASS + 1 02850360 + WRITE (NUVI, 80002) IVTNUM 02860360 + GO TO 0131 02870360 +20130 IVFAIL = IVFAIL + 1 02880360 + IVCORR = 0 02890360 + WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR 02900360 + 0131 CONTINUE 02910360 +CT014* TEST 14 ARITHMETIC EXPRESSIONS PRESENTED TO IDIM 02920360 + IVTNUM = 14 02930360 + IGDVI = 2 02940360 + IGEVI = 1.25 02950360 + IGAVI = IDIM(IGDVI / IGEVI, IGDVI * IGEVI) 02960360 + IF (IGAVI - 0) 20140, 10140, 20140 02970360 +10140 IVPASS = IVPASS + 1 02980360 + WRITE (NUVI, 80002) IVTNUM 02990360 + GO TO 0141 03000360 +20140 IVFAIL = IVFAIL + 1 03010360 + IVCORR = 0 03020360 + WRITE (NUVI, 80010) IVTNUM, IGAVI, IVCORR 03030360 + 0141 CONTINUE 03040360 +C***** 03050360 +CBB** ********************** BBCSUM0 **********************************03060360 +C**** WRITE OUT TEST SUMMARY 03070360 +C**** 03080360 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03090360 + WRITE (I02, 90004) 03100360 + WRITE (I02, 90014) 03110360 + WRITE (I02, 90004) 03120360 + WRITE (I02, 90020) IVPASS 03130360 + WRITE (I02, 90022) IVFAIL 03140360 + WRITE (I02, 90024) IVDELE 03150360 + WRITE (I02, 90026) IVINSP 03160360 + WRITE (I02, 90028) IVTOTN, IVTOTL 03170360 +CBE** ********************** BBCSUM0 **********************************03180360 +CBB** ********************** BBCFOOT0 **********************************03190360 +C**** WRITE OUT REPORT FOOTINGS 03200360 +C**** 03210360 + WRITE (I02,90016) ZPROG, ZPROG 03220360 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03230360 + WRITE (I02,90019) 03240360 +CBE** ********************** BBCFOOT0 **********************************03250360 +CBB** ********************** BBCFMT0A **********************************03260360 +C**** FORMATS FOR TEST DETAIL LINES 03270360 +C**** 03280360 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03290360 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03300360 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03310360 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03320360 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03330360 + 1I6,/," ",15X,"CORRECT= " ,I6) 03340360 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03350360 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03360360 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03370360 + 1A21,/," ",16X,"CORRECT= " ,A21) 03380360 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03390360 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03400360 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03410360 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03420360 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03430360 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03440360 +80050 FORMAT (" ",48X,A31) 03450360 +CBE** ********************** BBCFMT0A **********************************03460360 +CBB** ********************** BBCFMT0B **********************************03470360 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03480360 +C**** 03490360 +90002 FORMAT ("1") 03500360 +90004 FORMAT (" ") 03510360 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03520360 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03530360 +90008 FORMAT (" ",21X,A13,A17) 03540360 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03550360 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03560360 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03570360 + 1 7X,"REMARKS",24X) 03580360 +90014 FORMAT (" ","----------------------------------------------" , 03590360 + 1 "---------------------------------" ) 03600360 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03610360 +C**** 03620360 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03630360 +C**** 03640360 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03650360 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03660360 + 1 A13) 03670360 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03680360 +C**** 03690360 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03700360 +C**** 03710360 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03720360 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03730360 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03740360 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03750360 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03760360 +CBE** ********************** BBCFMT0B **********************************03770360 +C***** 03780360 +16303 FORMAT(2X, F7.2) 03790360 +16305 FORMAT(3X, I5) 03800360 +C***** 03810360 +C***** END OF TEST SEGMENT 163 03820360 + STOP 03830360 + END 03840360 + 03850360 diff --git a/Fortran/UnitTests/fcvs21_f95/FM360.reference_output b/Fortran/UnitTests/fcvs21_f95/FM360.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM360.reference_output @@ -0,0 +1,53 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM360BEGIN* TEST RESULTS - FM360 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + XDIM - (163) INTRINSIC FUNCTIONS-- + + DIM, IDIM (POSITIVE DIFFERENCE) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 14 TESTS + + + TEST OF DIM + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + + TEST OF IDIM + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + + ------------------------------------------------------------------------------- + + 14 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 14 OF 14 TESTS EXECUTED + + *FM360END* END OF TEST - FM360 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM361.f b/Fortran/UnitTests/fcvs21_f95/FM361.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM361.f @@ -0,0 +1,872 @@ + PROGRAM FM361 + +C***********************************************************************00010361 +C***** FORTRAN 77 00020361 +C***** FM361 XMAX - (165) 00030361 +C***** 00040361 +C***********************************************************************00050361 +C***** GENERAL PURPOSE SUBSET REF00060361 +C***** TEST OF INTRINSIC FUNCTIONS AMAX0,AMAX1,MAX0,MAX1 15.3 00070361 +C***** CHOOSING LARGEST VALUE (TABLE 5)00080361 +C***** 00090361 +CBB** ********************** BBCCOMNT **********************************00100361 +C**** 00110361 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120361 +C**** VERSION 2.1 00130361 +C**** 00140361 +C**** 00150361 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160361 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170361 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180361 +C**** BUILDING 225 RM A266 00190361 +C**** GAITHERSBURG, MD 20899 00200361 +C**** 00210361 +C**** 00220361 +C**** 00230361 +CBE** ********************** BBCCOMNT **********************************00240361 +CBB** ********************** BBCINITA **********************************00250361 +C**** SPECIFICATION STATEMENTS 00260361 +C**** 00270361 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00280361 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00290361 +CBE** ********************** BBCINITA **********************************00300361 +CBB** ********************** BBCINITB **********************************00310361 +C**** INITIALIZE SECTION 00320361 + DATA ZVERS, ZVERSD, ZDATE 00330361 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00340361 + DATA ZCOMPL, ZNAME, ZTAPE 00350361 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00360361 + DATA ZPROJ, ZTAPED, ZPROG 00370361 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00380361 + DATA REMRKS /' '/ 00390361 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00400361 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00410361 +C**** 00420361 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00430361 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00440361 +CZ03 ZPROG = 'PROGRAM NAME' 00450361 +CZ04 ZDATE = 'DATE OF TEST' 00460361 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00470361 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00480361 +CZ07 ZNAME = 'NAME OF USER' 00490361 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00500361 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00510361 +C 00520361 + IVPASS = 0 00530361 + IVFAIL = 0 00540361 + IVDELE = 0 00550361 + IVINSP = 0 00560361 + IVTOTL = 0 00570361 + IVTOTN = 0 00580361 + ICZERO = 0 00590361 +C 00600361 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00610361 + I01 = 05 00620361 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00630361 + I02 = 06 00640361 +C 00650361 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00660361 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670361 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00680361 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00690361 +C 00700361 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00710361 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00720361 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00730361 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00740361 +C 00750361 +CBE** ********************** BBCINITB **********************************00760361 + NUVI = I02 00770361 + IVTOTL = 48 00780361 + ZPROG = 'FM361' 00790361 +CBB** ********************** BBCHED0A **********************************00800361 +C**** 00810361 +C**** WRITE REPORT TITLE 00820361 +C**** 00830361 + WRITE (I02, 90002) 00840361 + WRITE (I02, 90006) 00850361 + WRITE (I02, 90007) 00860361 + WRITE (I02, 90008) ZVERS, ZVERSD 00870361 + WRITE (I02, 90009) ZPROG, ZPROG 00880361 + WRITE (I02, 90010) ZDATE, ZCOMPL 00890361 +CBE** ********************** BBCHED0A **********************************00900361 +C***** 00910361 +C***** HEADER FOR SEGMENT 165 00920361 + WRITE (NUVI,16501) 00930361 +16501 FORMAT (" ", // 2X,"XMAX - (165) INTRINSIC FUNCTIONS-- " //13X,00940361 + 1 "AMAX0, AMAX1, MAX0, MAX1 " /13X, 00950361 + 2 "(CHOOSING LARGEST VALUE)" //2X, 00960361 + 3 "SUBSET REF. - 15.3" ) 00970361 +CBB** ********************** BBCHED0B **********************************00980361 +C**** WRITE DETAIL REPORT HEADERS 00990361 +C**** 01000361 + WRITE (I02,90004) 01010361 + WRITE (I02,90004) 01020361 + WRITE (I02,90013) 01030361 + WRITE (I02,90014) 01040361 + WRITE (I02,90015) IVTOTL 01050361 +CBE** ********************** BBCHED0B **********************************01060361 +C***** 01070361 +C***** TEST OF AMAX0 01080361 +C***** 01090361 + WRITE(NUVI, 16502) 01100361 +16502 FORMAT (/ 8X, "TEST OF AMAX0" ) 01110361 +CT001* TEST 1 BOTH ZEROES 01120361 + IVTNUM = 1 01130361 + IHBVI = 0 01140361 + IHDVI = 0 01150361 + RHAVS = AMAX0(IHBVI,IHDVI) 01160361 + IF (RHAVS + 0.00005) 20010, 10010, 40010 01170361 +40010 IF (RHAVS - 0.00005) 10010, 10010, 20010 01180361 +10010 IVPASS = IVPASS + 1 01190361 + WRITE (NUVI, 80002) IVTNUM 01200361 + GO TO 0011 01210361 +20010 IVFAIL = IVFAIL + 1 01220361 + RVCORR = 0.0 01230361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 01240361 + 0011 CONTINUE 01250361 +CT002* TEST 2 ONE NON-ZERO, ONE ZERO 01260361 + IVTNUM = 2 01270361 + IHBVI = 6 01280361 + IHDVI = 0 01290361 + RHAVS = AMAX0(IHBVI,IHDVI) 01300361 + IF (RHAVS - 5.9997) 20020, 10020, 40020 01310361 +40020 IF (RHAVS - 6.0003) 10020, 10020, 20020 01320361 +10020 IVPASS = IVPASS + 1 01330361 + WRITE (NUVI, 80002) IVTNUM 01340361 + GO TO 0021 01350361 +20020 IVFAIL = IVFAIL + 1 01360361 + RVCORR = 6.0 01370361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 01380361 + 0021 CONTINUE 01390361 +CT003* TEST 3 BOTH VALUES EQUAL 01400361 + IVTNUM = 3 01410361 + IHBVI = 7 01420361 + IHDVI = 7 01430361 + RHAVS = AMAX0(IHBVI,IHDVI) 01440361 + IF (RHAVS - 6.9996) 20030, 10030, 40030 01450361 +40030 IF (RHAVS - 7.0004) 10030, 10030, 20030 01460361 +10030 IVPASS = IVPASS + 1 01470361 + WRITE (NUVI, 80002) IVTNUM 01480361 + GO TO 0031 01490361 +20030 IVFAIL = IVFAIL + 1 01500361 + RVCORR = 7.0 01510361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 01520361 + 0031 CONTINUE 01530361 +CT004* TEST 4 UNEQUAL VALUES, BOTH POSITIVE 01540361 + IVTNUM = 4 01550361 + IHBVI = 7 01560361 + IHDVI = 5 01570361 + RHAVS = AMAX0(IHBVI,IHDVI) 01580361 + IF (RHAVS - 6.9996) 20040, 10040, 40040 01590361 +40040 IF (RHAVS - 7.0004) 10040, 10040, 20040 01600361 +10040 IVPASS = IVPASS + 1 01610361 + WRITE (NUVI, 80002) IVTNUM 01620361 + GO TO 0041 01630361 +20040 IVFAIL = IVFAIL + 1 01640361 + RVCORR = 7.0 01650361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 01660361 + 0041 CONTINUE 01670361 +CT005* TEST 5 ONE NEGATIVE, ONE ZERO 01680361 + IVTNUM = 5 01690361 + IHBVI = -6 01700361 + IHDVI = 0 01710361 + RHAVS = AMAX0(IHBVI,IHDVI) 01720361 + IF (RHAVS + 0.00005) 20050, 10050, 40050 01730361 +40050 IF (RHAVS - 0.00005) 10050, 10050, 20050 01740361 +10050 IVPASS = IVPASS + 1 01750361 + WRITE (NUVI, 80002) IVTNUM 01760361 + GO TO 0051 01770361 +20050 IVFAIL = IVFAIL + 1 01780361 + RVCORR = 0.0 01790361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 01800361 + 0051 CONTINUE 01810361 +CT006* TEST 6 BOTH VALUES EQUAL, BOTH NEGATIVE 01820361 + IVTNUM = 6 01830361 + IHBVI = -7 01840361 + IHDVI = -7 01850361 + RHAVS = AMAX0(IHBVI,IHDVI) 01860361 + IF (RHAVS + 7.0004) 20060, 10060, 40060 01870361 +40060 IF (RHAVS + 6.9996) 10060, 10060, 20060 01880361 +10060 IVPASS = IVPASS + 1 01890361 + WRITE (NUVI, 80002) IVTNUM 01900361 + GO TO 0061 01910361 +20060 IVFAIL = IVFAIL + 1 01920361 + RVCORR = -7.0 01930361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 01940361 + 0061 CONTINUE 01950361 +CT007* TEST 7 BOTH VALUES NOT EQUAL, BOTH NEGATIVE 01960361 + IVTNUM = 7 01970361 + IHBVI = -7 01980361 + IHDVI = -5 01990361 + RHAVS = AMAX0(IHBVI,IHDVI) 02000361 + IF (RHAVS + 5.0003) 20070, 10070, 40070 02010361 +40070 IF (RHAVS + 4.9997) 10070, 10070, 20070 02020361 +10070 IVPASS = IVPASS + 1 02030361 + WRITE (NUVI, 80002) IVTNUM 02040361 + GO TO 0071 02050361 +20070 IVFAIL = IVFAIL + 1 02060361 + RVCORR = -5.0 02070361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 02080361 + 0071 CONTINUE 02090361 +CT008* TEST 8 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY A MINUS SIGN 02100361 + IVTNUM = 8 02110361 + IHDVI = 6 02120361 + IHEVI = 0 02130361 + RHAVS = AMAX0(IHDVI, -IHEVI) 02140361 + IF (RHAVS - 5.9997) 20080, 10080, 40080 02150361 +40080 IF (RHAVS - 6.0003) 10080, 10080, 20080 02160361 +10080 IVPASS = IVPASS + 1 02170361 + WRITE (NUVI, 80002) IVTNUM 02180361 + GO TO 0081 02190361 +20080 IVFAIL = IVFAIL + 1 02200361 + RVCORR = 6.0 02210361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 02220361 + 0081 CONTINUE 02230361 +CT009* TEST 9 EXPRESSIONS PRESENTED TO FUNCTION 02240361 + IVTNUM = 9 02250361 + IHDVI = 3 02260361 + IHEVI = 4 02270361 + RHAVS = AMAX0(IHDVI + IHEVI, -IHEVI - IHDVI) 02280361 + IF (RHAVS - 6.9996) 20090, 10090, 40090 02290361 +40090 IF (RHAVS - 7.0004) 10090, 10090, 20090 02300361 +10090 IVPASS = IVPASS + 1 02310361 + WRITE (NUVI, 80002) IVTNUM 02320361 + GO TO 0091 02330361 +20090 IVFAIL = IVFAIL + 1 02340361 + RVCORR = 7.0 02350361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 02360361 + 0091 CONTINUE 02370361 +CT010* TEST 10 3 ARGUMENTS 02380361 + IVTNUM = 10 02390361 + IHBVI = 0 02400361 + IHCVI = 1 02410361 + IHDVI = 3 02420361 + RHAVS = AMAX0(IHBVI, IHCVI, IHDVI) 02430361 + IF (RHAVS - 2.9998) 20100, 10100, 40100 02440361 +40100 IF (RHAVS - 3.0002) 10100, 10100, 20100 02450361 +10100 IVPASS = IVPASS + 1 02460361 + WRITE (NUVI, 80002) IVTNUM 02470361 + GO TO 0101 02480361 +20100 IVFAIL = IVFAIL + 1 02490361 + RVCORR = 3.0 02500361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 02510361 + 0101 CONTINUE 02520361 +CT011* TEST 11 4 ARGUMENTS 02530361 + IVTNUM = 11 02540361 + IHBVI = 0 02550361 + IHCVI = 1 02560361 + IHDVI = 4 02570361 + RHAVS = AMAX0(IHDVI, -IHBVI, IHCVI, IHBVI) 02580361 + IF (RHAVS - 3.9998) 20110, 10110, 40110 02590361 +40110 IF (RHAVS - 4.0002) 10110, 10110, 20110 02600361 +10110 IVPASS = IVPASS + 1 02610361 + WRITE (NUVI, 80002) IVTNUM 02620361 + GO TO 0111 02630361 +20110 IVFAIL = IVFAIL + 1 02640361 + RVCORR = 4.0 02650361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 02660361 + 0111 CONTINUE 02670361 +CT012* TEST 12 5 ARGUMENTS 02680361 + IVTNUM = 12 02690361 + IHDVI = 4.0 02700361 + IHEVI = 5.0 02710361 + RHAVS = AMAX0(IHDVI, -IHDVI, -IHEVI, +IHDVI, IHEVI) 02720361 + IF (RHAVS - 4.9997) 20120, 10120, 40120 02730361 +40120 IF (RHAVS - 5.0003) 10120, 10120, 20120 02740361 +10120 IVPASS = IVPASS + 1 02750361 + WRITE (NUVI, 80002) IVTNUM 02760361 + GO TO 0121 02770361 +20120 IVFAIL = IVFAIL + 1 02780361 + RVCORR = 5.0 02790361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 02800361 + 0121 CONTINUE 02810361 +C***** 02820361 + WRITE (NUVI, 90002) 02830361 + WRITE (NUVI, 90013) 02840361 + WRITE (NUVI, 90014) 02850361 +C***** TEST OF AMAX1 02860361 +C***** 02870361 + WRITE(NUVI, 16504) 02880361 +16504 FORMAT (/ 8X, "TEST OF AMAX1" ) 02890361 +CT013* TEST 13 BOTH VALUES ZERO 02900361 + IVTNUM = 13 02910361 + RHBVS = 0.0 02920361 + RHDVS = 0.0 02930361 + RHAVS = AMAX1(RHBVS, RHDVS) 02940361 + IF (RHAVS + 0.00005) 20130, 10130, 40130 02950361 +40130 IF (RHAVS - 0.00005) 10130, 10130, 20130 02960361 +10130 IVPASS = IVPASS + 1 02970361 + WRITE (NUVI, 80002) IVTNUM 02980361 + GO TO 0131 02990361 +20130 IVFAIL = IVFAIL + 1 03000361 + RVCORR = 0.0 03010361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 03020361 + 0131 CONTINUE 03030361 +CT014* TEST 14 FIRST VALUE NON-ZERO, SECOND ZERO 03040361 + IVTNUM = 14 03050361 + RHBVS = 5.625 03060361 + RHDVS = 0.0 03070361 + RHAVS = AMAX1(RHBVS, RHDVS) 03080361 + IF (RHAVS - 5.6247) 20140, 10140, 40140 03090361 +40140 IF (RHAVS - 5.6253) 10140, 10140, 20140 03100361 +10140 IVPASS = IVPASS + 1 03110361 + WRITE (NUVI, 80002) IVTNUM 03120361 + GO TO 0141 03130361 +20140 IVFAIL = IVFAIL + 1 03140361 + RVCORR = 5.625 03150361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 03160361 + 0141 CONTINUE 03170361 +CT015* TEST 15 BOTH VALUES EQUAL 03180361 + IVTNUM = 15 03190361 + RHBVS = 6.5 03200361 + RHDVS = 6.5 03210361 + RHAVS = AMAX1(RHBVS, RHDVS) 03220361 + IF (RHAVS - 6.4996) 20150, 10150, 40150 03230361 +40150 IF (RHAVS - 6.5004) 10150, 10150, 20150 03240361 +10150 IVPASS = IVPASS + 1 03250361 + WRITE (NUVI, 80002) IVTNUM 03260361 + GO TO 0151 03270361 +20150 IVFAIL = IVFAIL + 1 03280361 + RVCORR = 6.5 03290361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 03300361 + 0151 CONTINUE 03310361 +CT016* TEST 16 VALUES NOT EQUAL 03320361 + IVTNUM = 16 03330361 + RHBVS = 7.125 03340361 + RHDVS = 5.125 03350361 + RHAVS = AMAX1(RHBVS, RHDVS) 03360361 + IF (RHAVS - 7.1246) 20160, 10160, 40160 03370361 +40160 IF (RHAVS - 7.1254) 10160, 10160, 20160 03380361 +10160 IVPASS = IVPASS + 1 03390361 + WRITE (NUVI, 80002) IVTNUM 03400361 + GO TO 0161 03410361 +20160 IVFAIL = IVFAIL + 1 03420361 + RVCORR = 7.125 03430361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 03440361 + 0161 CONTINUE 03450361 +CT017* TEST 17 FIRST VALUE NEGATIVE, SECOND ZERO 03460361 + IVTNUM = 17 03470361 + RHBVS = -5.625 03480361 + RHDVS = 0.0 03490361 + RHAVS = AMAX1(RHBVS, RHDVS) 03500361 + IF (RHAVS + 0.00005) 20170, 10170, 40170 03510361 +40170 IF (RHAVS - 0.00005) 10170, 10170, 20170 03520361 +10170 IVPASS = IVPASS + 1 03530361 + WRITE (NUVI, 80002) IVTNUM 03540361 + GO TO 0171 03550361 +20170 IVFAIL = IVFAIL + 1 03560361 + RVCORR = 0.0 03570361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 03580361 + 0171 CONTINUE 03590361 +CT018* TEST 18 BOTH VALUES EQUAL, BOTH NEGATIVE 03600361 + IVTNUM = 18 03610361 + RHBVS = -6.5 03620361 + RHDVS = -6.5 03630361 + RHAVS = AMAX1(RHBVS, RHDVS) 03640361 + IF (RHAVS + 6.5004) 20180, 10180, 40180 03650361 +40180 IF (RHAVS + 6.4996) 10180, 10180, 20180 03660361 +10180 IVPASS = IVPASS + 1 03670361 + WRITE (NUVI, 80002) IVTNUM 03680361 + GO TO 0181 03690361 +20180 IVFAIL = IVFAIL + 1 03700361 + RVCORR = -6.5 03710361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 03720361 + 0181 CONTINUE 03730361 +CT019* TEST 19 VALUES NOT EQUAL, BOTH NEGATIVE 03740361 + IVTNUM = 19 03750361 + RHBVS = -7.125 03760361 + RHDVS = -5.125 03770361 + RHAVS = AMAX1(RHBVS, RHDVS) 03780361 + IF (RHAVS + 5.1253) 20190, 10190, 40190 03790361 +40190 IF (RHAVS + 5.1247) 10190, 10190, 20190 03800361 +10190 IVPASS = IVPASS + 1 03810361 + WRITE (NUVI, 80002) IVTNUM 03820361 + GO TO 0191 03830361 +20190 IVFAIL = IVFAIL + 1 03840361 + RVCORR = -5.125 03850361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 03860361 + 0191 CONTINUE 03870361 +CT020* TEST 20 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN 03880361 + IVTNUM = 20 03890361 + RHDVS = 5.625 03900361 + RHEVS = 0.0 03910361 + RHAVS = AMAX1(RHDVS, -RHEVS) 03920361 + IF (RHAVS - 5.6247) 20200, 10200, 40200 03930361 +40200 IF (RHAVS - 5.6253) 10200, 10200, 20200 03940361 +10200 IVPASS = IVPASS + 1 03950361 + WRITE (NUVI, 80002) IVTNUM 03960361 + GO TO 0201 03970361 +20200 IVFAIL = IVFAIL + 1 03980361 + RVCORR = 5.625 03990361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 04000361 + 0201 CONTINUE 04010361 +CT021* TEST 21 EXPRESSIONS PRESENTED TO FUNCTION 04020361 + IVTNUM = 21 04030361 + RHDVS = 3.5 04040361 + RHEVS = 4.0 04050361 + RHAVS = AMAX1(RHDVS + RHEVS, -RHEVS - RHDVS) 04060361 + IF (RHAVS - 7.4996) 20210, 10210, 40210 04070361 +40210 IF (RHAVS - 7.5004) 10210, 10210, 20210 04080361 +10210 IVPASS = IVPASS + 1 04090361 + WRITE (NUVI, 80002) IVTNUM 04100361 + GO TO 0211 04110361 +20210 IVFAIL = IVFAIL + 1 04120361 + RVCORR = 7.5 04130361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 04140361 + 0211 CONTINUE 04150361 +CT022* TEST 22 3 ARGUMENTS 04160361 + IVTNUM = 22 04170361 + RHBVS = 0.0 04180361 + RHCVS = 1.0 04190361 + RHDVS = 0.5 04200361 + RHAVS = AMAX1(RHBVS, RHCVS, RHDVS) 04210361 + IF (RHAVS - 0.99995) 20220, 10220, 40220 04220361 +40220 IF (RHAVS - 1.0001) 10220, 10220, 20220 04230361 +10220 IVPASS = IVPASS + 1 04240361 + WRITE (NUVI, 80002) IVTNUM 04250361 + GO TO 0221 04260361 +20220 IVFAIL = IVFAIL + 1 04270361 + RVCORR = 1.0 04280361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 04290361 + 0221 CONTINUE 04300361 +CT023* TEST 23 4 ARGUMENTS 04310361 + IVTNUM = 23 04320361 + RHBVS = 1.5 04330361 + RHCVS = 3.4 04340361 + RHDVS = 3.5 04350361 + RHAVS = AMAX1(-RHDVS, RHCVS, RHBVS, RHDVS) 04360361 + IF (RHAVS - 3.4998) 20230, 10230, 40230 04370361 +40230 IF (RHAVS - 3.5002) 10230, 10230, 20230 04380361 +10230 IVPASS = IVPASS + 1 04390361 + WRITE (NUVI, 80002) IVTNUM 04400361 + GO TO 0231 04410361 +20230 IVFAIL = IVFAIL + 1 04420361 + RVCORR = 3.5 04430361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 04440361 + 0231 CONTINUE 04450361 +CT024* TEST 24 5 ARGUMENTS 04460361 + IVTNUM = 24 04470361 + RHDVS = 3.5 04480361 + RHEVS = 4.5 04490361 + RHAVS = AMAX1(RHDVS, -RHDVS, -RHEVS, +RHDVS, RHEVS) 04500361 + IF (RHAVS - 4.4997) 20240, 10240, 40240 04510361 +40240 IF (RHAVS - 4.5003) 10240, 10240, 20240 04520361 +10240 IVPASS = IVPASS + 1 04530361 + WRITE (NUVI, 80002) IVTNUM 04540361 + GO TO 0241 04550361 +20240 IVFAIL = IVFAIL + 1 04560361 + RVCORR = 4.5 04570361 + WRITE (NUVI, 80012) IVTNUM, RHAVS, RVCORR 04580361 + 0241 CONTINUE 04590361 +C***** 04600361 + WRITE (NUVI, 90002) 04610361 + WRITE (NUVI, 90013) 04620361 + WRITE (NUVI, 90014) 04630361 +C***** TEST OF MAX0 04640361 +C***** 04650361 + WRITE(NUVI, 16505) 04660361 +16505 FORMAT (/ 8X, "TEST OF MAX0" ) 04670361 +C***** 04680361 +CT025* TEST 25 BOTH VALUES ZERO 04690361 + IVTNUM = 25 04700361 + IHBVI = 0 04710361 + IHDVI = 0 04720361 + IHAVI = MAX0(IHBVI, IHDVI) 04730361 + IF (IHAVI - 0) 20250, 10250, 20250 04740361 +10250 IVPASS = IVPASS + 1 04750361 + WRITE (NUVI, 80002) IVTNUM 04760361 + GO TO 0251 04770361 +20250 IVFAIL = IVFAIL + 1 04780361 + IVCORR = 0 04790361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 04800361 + 0251 CONTINUE 04810361 +CT026* TEST 26 FIRST VALUE NON-ZERO, SECOND ZERO 04820361 + IVTNUM = 26 04830361 + IHBVI = 6 04840361 + IHDVI = 0 04850361 + IHAVI = MAX0(IHBVI, IHDVI) 04860361 + IF (IHAVI - 6) 20260, 10260, 20260 04870361 +10260 IVPASS = IVPASS + 1 04880361 + WRITE (NUVI, 80002) IVTNUM 04890361 + GO TO 0261 04900361 +20260 IVFAIL = IVFAIL + 1 04910361 + IVCORR = 6 04920361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 04930361 + 0261 CONTINUE 04940361 +CT027* TEST 27 BOTH VALUES EQUAL 04950361 + IVTNUM = 27 04960361 + IHBVI = 7 04970361 + IHDVI = 7 04980361 + IHAVI = MAX0(IHBVI, IHDVI) 04990361 + IF (IHAVI - 7) 20270, 10270, 20270 05000361 +10270 IVPASS = IVPASS + 1 05010361 + WRITE (NUVI, 80002) IVTNUM 05020361 + GO TO 0271 05030361 +20270 IVFAIL = IVFAIL + 1 05040361 + IVCORR = 7 05050361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 05060361 + 0271 CONTINUE 05070361 +CT028* TEST 28 VALUES NOT EQUAL 05080361 + IVTNUM = 28 05090361 + IHBVI = 7 05100361 + IHDVI = 5 05110361 + IHAVI = MAX0(IHBVI, IHDVI) 05120361 + IF (IHAVI - 7) 20280, 10280, 20280 05130361 +10280 IVPASS = IVPASS + 1 05140361 + WRITE (NUVI, 80002) IVTNUM 05150361 + GO TO 0281 05160361 +20280 IVFAIL = IVFAIL + 1 05170361 + IVCORR = 7 05180361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 05190361 + 0281 CONTINUE 05200361 +CT029* TEST 29 FIRST VALUE NEGATIVE, SECOND ZERO 05210361 + IVTNUM = 29 05220361 + IHBVI = -6 05230361 + IHDVI = 0 05240361 + IHAVI = MAX0(IHBVI, IHDVI) 05250361 + IF (IHAVI - 0) 20290, 10290, 20290 05260361 +10290 IVPASS = IVPASS + 1 05270361 + WRITE (NUVI, 80002) IVTNUM 05280361 + GO TO 0291 05290361 +20290 IVFAIL = IVFAIL + 1 05300361 + IVCORR = 0 05310361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 05320361 + 0291 CONTINUE 05330361 +CT030* TEST 30 BOTH VALUES EQUAL, BOTH NEGATIVE 05340361 + IVTNUM = 30 05350361 + IHBVI = -7 05360361 + IHDVI = -7 05370361 + IHAVI = MAX0(IHBVI, IHDVI) 05380361 + IF (IHAVI + 7) 20300, 10300, 20300 05390361 +10300 IVPASS = IVPASS + 1 05400361 + WRITE (NUVI, 80002) IVTNUM 05410361 + GO TO 0301 05420361 +20300 IVFAIL = IVFAIL + 1 05430361 + IVCORR = -7 05440361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 05450361 + 0301 CONTINUE 05460361 +CT031* TEST 31 VALUES NOT EQUAL, BOTH NEGATIVE 05470361 + IVTNUM = 31 05480361 + IHBVI = -7 05490361 + IHDVI = -5 05500361 + IHAVI = MAX0(IHBVI, IHDVI) 05510361 + IF (IHAVI + 5) 20310, 10310, 20310 05520361 +10310 IVPASS = IVPASS + 1 05530361 + WRITE (NUVI, 80002) IVTNUM 05540361 + GO TO 0311 05550361 +20310 IVFAIL = IVFAIL + 1 05560361 + IVCORR = -5 05570361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 05580361 + 0311 CONTINUE 05590361 +CT032* TEST 32 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN 05600361 + IVTNUM = 32 05610361 + IHDVI = 6 05620361 + IHEVI = 0 05630361 + IHAVI = MAX0(IHDVI, -IHEVI) 05640361 + IF (IHAVI - 6) 20320, 10320, 20320 05650361 +10320 IVPASS = IVPASS + 1 05660361 + WRITE (NUVI, 80002) IVTNUM 05670361 + GO TO 0321 05680361 +20320 IVFAIL = IVFAIL + 1 05690361 + IVCORR = 6 05700361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 05710361 + 0321 CONTINUE 05720361 +CT033* TEST 33 EXPRESSIONS PRESENTED TO FUNCTION 05730361 + IVTNUM = 33 05740361 + IHDVI = 3 05750361 + IHEVI = 4 05760361 + IHAVI = MAX0(IHDVI + IHEVI, -IHEVI - IHDVI) 05770361 + IF (IHAVI - 7) 20330, 10330, 20330 05780361 +10330 IVPASS = IVPASS + 1 05790361 + WRITE (NUVI, 80002) IVTNUM 05800361 + GO TO 0331 05810361 +20330 IVFAIL = IVFAIL + 1 05820361 + IVCORR = 7 05830361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 05840361 + 0331 CONTINUE 05850361 +CT034* TEST 34 3 ARGUMENTS 05860361 + IVTNUM = 34 05870361 + IHBVI = 0 05880361 + IHCVI = 3 05890361 + IHDVI = -4 05900361 + IHAVI = MAX0(IHDVI, IHBVI, IHCVI) 05910361 + IF (IHAVI - 3) 20340, 10340, 20340 05920361 +10340 IVPASS = IVPASS + 1 05930361 + WRITE (NUVI, 80002) IVTNUM 05940361 + GO TO 0341 05950361 +20340 IVFAIL = IVFAIL + 1 05960361 + IVCORR = 3 05970361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 05980361 + 0341 CONTINUE 05990361 +CT035* TEST 35 4 ARGUMENTS 06000361 + IVTNUM = 35 06010361 + IHBVI = -1 06020361 + IHCVI = 0 06030361 + IHDVI = 4 06040361 + IHAVI = MAX0(IHDVI, IHCVI, IHBVI, IHDVI) 06050361 + IF (IHAVI - 4) 20350, 10350, 20350 06060361 +10350 IVPASS = IVPASS + 1 06070361 + WRITE (NUVI, 80002) IVTNUM 06080361 + GO TO 0351 06090361 +20350 IVFAIL = IVFAIL + 1 06100361 + IVCORR = 4 06110361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 06120361 + 0351 CONTINUE 06130361 +CT036* TEST 36 5 ARGUMENTS 06140361 + IVTNUM = 36 06150361 + IHDVI = 4 06160361 + IHEVI = 5 06170361 + IHAVI = MAX0(IHDVI, -IHDVI, -IHEVI, +IHDVI, IHEVI) 06180361 + IF (IHAVI - 5) 20360, 10360, 20360 06190361 +10360 IVPASS = IVPASS + 1 06200361 + WRITE (NUVI, 80002) IVTNUM 06210361 + GO TO 0361 06220361 +20360 IVFAIL = IVFAIL + 1 06230361 + IVCORR = 5 06240361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 06250361 + 0361 CONTINUE 06260361 +C***** 06270361 + WRITE (NUVI, 90002) 06280361 + WRITE (NUVI, 90013) 06290361 + WRITE (NUVI, 90014) 06300361 +C***** TEST OF MAX1 06310361 +C***** 06320361 + WRITE(NUVI, 16507) 06330361 +16507 FORMAT (/ 8X, "TEST OF MAX1" ) 06340361 +CT037* TEST 37 BOTH VALUES EQUAL 06350361 + IVTNUM = 37 06360361 + RHBVS = 0.0 06370361 + RHDVS = 0.0 06380361 + IHAVI = MAX1(RHBVS, RHDVS) 06390361 + IF (IHAVI - 0) 20370, 10370, 20370 06400361 +10370 IVPASS = IVPASS + 1 06410361 + WRITE (NUVI, 80002) IVTNUM 06420361 + GO TO 0371 06430361 +20370 IVFAIL = IVFAIL + 1 06440361 + IVCORR = 0 06450361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 06460361 + 0371 CONTINUE 06470361 +CT038* TEST 38 FIRST VALUE NON-ZERO, SECOND ZERO 06480361 + IVTNUM = 38 06490361 + RHBVS = 5.625 06500361 + RHDVS = 0.0 06510361 + IHAVI = MAX1(RHBVS, RHDVS) 06520361 + IF (IHAVI - 5) 20380, 10380, 20380 06530361 +10380 IVPASS = IVPASS + 1 06540361 + WRITE (NUVI, 80002) IVTNUM 06550361 + GO TO 0381 06560361 +20380 IVFAIL = IVFAIL + 1 06570361 + IVCORR = 5 06580361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 06590361 + 0381 CONTINUE 06600361 +CT039* TEST 39 BOTH VALUES EQUAL 06610361 + IVTNUM = 39 06620361 + RHBVS = 6.5 06630361 + RHDVS = 6.5 06640361 + IHAVI = MAX1(RHBVS, RHDVS) 06650361 + IF (IHAVI - 6) 20390, 10390, 20390 06660361 +10390 IVPASS = IVPASS + 1 06670361 + WRITE (NUVI, 80002) IVTNUM 06680361 + GO TO 0391 06690361 +20390 IVFAIL = IVFAIL + 1 06700361 + IVCORR = 6 06710361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 06720361 + 0391 CONTINUE 06730361 +CT040* TEST 40 VALUES NOT EQUAL 06740361 + IVTNUM = 40 06750361 + RHBVS = 7.125 06760361 + RHDVS = 5.125 06770361 + IHAVI = MAX1(RHBVS, RHDVS) 06780361 + IF (IHAVI - 7) 20400, 10400, 20400 06790361 +10400 IVPASS = IVPASS + 1 06800361 + WRITE (NUVI, 80002) IVTNUM 06810361 + GO TO 0401 06820361 +20400 IVFAIL = IVFAIL + 1 06830361 + IVCORR = 7 06840361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 06850361 + 0401 CONTINUE 06860361 +CT041* TEST 41 FIRST VALUE NEGATIVE, SECOND ZERO 06870361 + IVTNUM = 41 06880361 + RHBVS = -5.625 06890361 + RHDVS = 0.0 06900361 + IHAVI = MAX1(RHBVS, RHDVS) 06910361 + IF (IHAVI - 0) 20410, 10410, 20410 06920361 +10410 IVPASS = IVPASS + 1 06930361 + WRITE (NUVI, 80002) IVTNUM 06940361 + GO TO 0411 06950361 +20410 IVFAIL = IVFAIL + 1 06960361 + IVCORR = 0 06970361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 06980361 + 0411 CONTINUE 06990361 +CT042* TEST 42 BOTH VALUES EQUAL, BOTH NEGATIVE 07000361 + IVTNUM = 42 07010361 + RHBVS = - 6.5 07020361 + RHDVS = - 6.5 07030361 + IHAVI = MAX1(RHBVS, RHDVS) 07040361 + IF (IHAVI + 6) 20420, 10420, 20420 07050361 +10420 IVPASS = IVPASS + 1 07060361 + WRITE (NUVI, 80002) IVTNUM 07070361 + GO TO 0421 07080361 +20420 IVFAIL = IVFAIL + 1 07090361 + IVCORR = -6 07100361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 07110361 + 0421 CONTINUE 07120361 +CT043* TEST 43 VALUES NOT EQUAL, BOTH NEGATIVE 07130361 + IVTNUM = 43 07140361 + RHBVS = -7.125 07150361 + RHDVS = -5.125 07160361 + IHAVI = MAX1(RHBVS, RHDVS) 07170361 + IF (IHAVI + 5) 20430, 10430, 20430 07180361 +10430 IVPASS = IVPASS + 1 07190361 + WRITE (NUVI, 80002) IVTNUM 07200361 + GO TO 0431 07210361 +20430 IVFAIL = IVFAIL + 1 07220361 + IVCORR = -5 07230361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 07240361 + 0431 CONTINUE 07250361 +CT044* TEST 44 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY A MINUS SIGN 07260361 + IVTNUM = 44 07270361 + RHDVS = 5.625 07280361 + RHEVS = 0.0 07290361 + IHAVI = MAX1(RHDVS, -RHEVS) 07300361 + IF (IHAVI - 5) 20440, 10440, 20440 07310361 +10440 IVPASS = IVPASS + 1 07320361 + WRITE (NUVI, 80002) IVTNUM 07330361 + GO TO 0441 07340361 +20440 IVFAIL = IVFAIL + 1 07350361 + IVCORR = 5 07360361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 07370361 + 0441 CONTINUE 07380361 +CT045* TEST 45 EXPRESSIONS PRESENTED TO FUNCTION 07390361 + IVTNUM = 45 07400361 + RHDVS = 3.5 07410361 + RHEVS = 4.0 07420361 + IHAVI = MAX1(RHDVS + RHEVS, -RHEVS - RHDVS) 07430361 + IF (IHAVI - 7) 20450, 10450, 20450 07440361 +10450 IVPASS = IVPASS + 1 07450361 + WRITE (NUVI, 80002) IVTNUM 07460361 + GO TO 0451 07470361 +20450 IVFAIL = IVFAIL + 1 07480361 + IVCORR = 7 07490361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 07500361 + 0451 CONTINUE 07510361 +CT046* TEST 46 3 ARGUMENTS 07520361 + IVTNUM = 46 07530361 + RHBVS = 0.0 07540361 + RHCVS = 4.0 07550361 + RHDVS = 0.0 07560361 + IHAVI = MAX1(RHBVS, -RHCVS, RHDVS) 07570361 + IF (IHAVI - 0) 20460, 10460, 20460 07580361 +10460 IVPASS = IVPASS + 1 07590361 + WRITE (NUVI, 80002) IVTNUM 07600361 + GO TO 0461 07610361 +20460 IVFAIL = IVFAIL + 1 07620361 + IVCORR = 0 07630361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 07640361 + 0461 CONTINUE 07650361 +CT047* TEST 47 4 ARGUMENTS 07660361 + IVTNUM = 47 07670361 + RHBVS = 3.49 07680361 + RHCVS = 0.0 07690361 + RHDVS = 3.5 07700361 + IHAVI = MAX1(RHDVS, RHBVS, -RHBVS, RHCVS) 07710361 + IF (IHAVI - 3) 20470, 10470, 20470 07720361 +10470 IVPASS = IVPASS + 1 07730361 + WRITE (NUVI, 80002) IVTNUM 07740361 + GO TO 0471 07750361 +20470 IVFAIL = IVFAIL + 1 07760361 + IVCORR = 3 07770361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 07780361 + 0471 CONTINUE 07790361 +CT048* TEST 48 5 ARGUMENTS 07800361 + IVTNUM = 48 07810361 + RHDVS = 3.5 07820361 + RHEVS = 4.5 07830361 + IHAVI = MAX1(RHDVS, -RHDVS, -RHEVS, +RHDVS, RHEVS) 07840361 + IF (IHAVI - 4) 20480, 10480, 20480 07850361 +10480 IVPASS = IVPASS + 1 07860361 + WRITE (NUVI, 80002) IVTNUM 07870361 + GO TO 0481 07880361 +20480 IVFAIL = IVFAIL + 1 07890361 + IVCORR = 4 07900361 + WRITE (NUVI, 80010) IVTNUM, IHAVI, IVCORR 07910361 + 0481 CONTINUE 07920361 +C***** 07930361 +CBB** ********************** BBCSUM0 **********************************07940361 +C**** WRITE OUT TEST SUMMARY 07950361 +C**** 07960361 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 07970361 + WRITE (I02, 90004) 07980361 + WRITE (I02, 90014) 07990361 + WRITE (I02, 90004) 08000361 + WRITE (I02, 90020) IVPASS 08010361 + WRITE (I02, 90022) IVFAIL 08020361 + WRITE (I02, 90024) IVDELE 08030361 + WRITE (I02, 90026) IVINSP 08040361 + WRITE (I02, 90028) IVTOTN, IVTOTL 08050361 +CBE** ********************** BBCSUM0 **********************************08060361 +CBB** ********************** BBCFOOT0 **********************************08070361 +C**** WRITE OUT REPORT FOOTINGS 08080361 +C**** 08090361 + WRITE (I02,90016) ZPROG, ZPROG 08100361 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 08110361 + WRITE (I02,90019) 08120361 +CBE** ********************** BBCFOOT0 **********************************08130361 +CBB** ********************** BBCFMT0A **********************************08140361 +C**** FORMATS FOR TEST DETAIL LINES 08150361 +C**** 08160361 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 08170361 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 08180361 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 08190361 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 08200361 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 08210361 + 1I6,/," ",15X,"CORRECT= " ,I6) 08220361 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08230361 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 08240361 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08250361 + 1A21,/," ",16X,"CORRECT= " ,A21) 08260361 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 08270361 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 08280361 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 08290361 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 08300361 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 08310361 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 08320361 +80050 FORMAT (" ",48X,A31) 08330361 +CBE** ********************** BBCFMT0A **********************************08340361 +CBB** ********************** BBCFMT0B **********************************08350361 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 08360361 +C**** 08370361 +90002 FORMAT ("1") 08380361 +90004 FORMAT (" ") 08390361 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )08400361 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08410361 +90008 FORMAT (" ",21X,A13,A17) 08420361 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 08430361 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 08440361 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 08450361 + 1 7X,"REMARKS",24X) 08460361 +90014 FORMAT (" ","----------------------------------------------" , 08470361 + 1 "---------------------------------" ) 08480361 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 08490361 +C**** 08500361 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08510361 +C**** 08520361 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 08530361 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 08540361 + 1 A13) 08550361 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 08560361 +C**** 08570361 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 08580361 +C**** 08590361 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 08600361 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 08610361 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 08620361 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 08630361 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 08640361 +CBE** ********************** BBCFMT0B **********************************08650361 +C***** 08660361 +C***** END OF TEST SEGMENT 165 08670361 + STOP 08680361 + END 08690361 + 08700361 diff --git a/Fortran/UnitTests/fcvs21_f95/FM361.reference_output b/Fortran/UnitTests/fcvs21_f95/FM361.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM361.reference_output @@ -0,0 +1,101 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM361BEGIN* TEST RESULTS - FM361 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + XMAX - (165) INTRINSIC FUNCTIONS-- + + AMAX0, AMAX1, MAX0, MAX1 + (CHOOSING LARGEST VALUE) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 48 TESTS + + + TEST OF AMAX0 + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF AMAX1 + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF MAX0 + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + 36 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF MAX1 + 37 PASS + 38 PASS + 39 PASS + 40 PASS + 41 PASS + 42 PASS + 43 PASS + 44 PASS + 45 PASS + 46 PASS + 47 PASS + 48 PASS + + ------------------------------------------------------------------------------- + + 48 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 48 OF 48 TESTS EXECUTED + + *FM361END* END OF TEST - FM361 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM362.f b/Fortran/UnitTests/fcvs21_f95/FM362.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM362.f @@ -0,0 +1,859 @@ + PROGRAM FM362 + +C***********************************************************************00010362 +C***** FORTRAN 77 00020362 +C***** FM362 XMIN - (167) 00030362 +C***** 00040362 +C***********************************************************************00050362 +C***** GENERAL PURPOSE SUBSET REF00060362 +C***** TEST INTRINSIC FUNCTIONS AMIN0,AMIN1,MIN0,MIN1 15.3 00070362 +C***** CHOOSING SMALLEST VALUE. (TABLE 5)00080362 +C***** 00090362 +CBB** ********************** BBCCOMNT **********************************00100362 +C**** 00110362 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120362 +C**** VERSION 2.1 00130362 +C**** 00140362 +C**** 00150362 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160362 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170362 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180362 +C**** BUILDING 225 RM A266 00190362 +C**** GAITHERSBURG, MD 20899 00200362 +C**** 00210362 +C**** 00220362 +C**** 00230362 +CBE** ********************** BBCCOMNT **********************************00240362 +CBB** ********************** BBCINITA **********************************00250362 +C**** SPECIFICATION STATEMENTS 00260362 +C**** 00270362 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00280362 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00290362 +CBE** ********************** BBCINITA **********************************00300362 +CBB** ********************** BBCINITB **********************************00310362 +C**** INITIALIZE SECTION 00320362 + DATA ZVERS, ZVERSD, ZDATE 00330362 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00340362 + DATA ZCOMPL, ZNAME, ZTAPE 00350362 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00360362 + DATA ZPROJ, ZTAPED, ZPROG 00370362 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00380362 + DATA REMRKS /' '/ 00390362 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00400362 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00410362 +C**** 00420362 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00430362 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00440362 +CZ03 ZPROG = 'PROGRAM NAME' 00450362 +CZ04 ZDATE = 'DATE OF TEST' 00460362 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00470362 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00480362 +CZ07 ZNAME = 'NAME OF USER' 00490362 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00500362 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00510362 +C 00520362 + IVPASS = 0 00530362 + IVFAIL = 0 00540362 + IVDELE = 0 00550362 + IVINSP = 0 00560362 + IVTOTL = 0 00570362 + IVTOTN = 0 00580362 + ICZERO = 0 00590362 +C 00600362 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00610362 + I01 = 05 00620362 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00630362 + I02 = 06 00640362 +C 00650362 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00660362 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00670362 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00680362 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00690362 +C 00700362 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00710362 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00720362 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00730362 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00740362 +C 00750362 +CBE** ********************** BBCINITB **********************************00760362 + NUVI = I02 00770362 + IVTOTL = 47 00780362 + ZPROG = 'FM362' 00790362 +CBB** ********************** BBCHED0A **********************************00800362 +C**** 00810362 +C**** WRITE REPORT TITLE 00820362 +C**** 00830362 + WRITE (I02, 90002) 00840362 + WRITE (I02, 90006) 00850362 + WRITE (I02, 90007) 00860362 + WRITE (I02, 90008) ZVERS, ZVERSD 00870362 + WRITE (I02, 90009) ZPROG, ZPROG 00880362 + WRITE (I02, 90010) ZDATE, ZCOMPL 00890362 +CBE** ********************** BBCHED0A **********************************00900362 +C***** 00910362 +C***** HEADER FOR SEGMENT 167 00920362 + WRITE (NUVI,16700) 00930362 +16700 FORMAT (" ", // 2X,"XMIN - (167) INTRINSIC FUNCTIONS-- " //13X,00940362 + 1 "AMIN0, AMIN1, MIN0, MIN1" / 13X, 00950362 + 2 "(CHOOSING SMALLEST VALUE)" //2X, 00960362 + 3 "SUBSET REF. - 15.3" ) 00970362 +CBB** ********************** BBCHED0B **********************************00980362 +C**** WRITE DETAIL REPORT HEADERS 00990362 +C**** 01000362 + WRITE (I02,90004) 01010362 + WRITE (I02,90004) 01020362 + WRITE (I02,90013) 01030362 + WRITE (I02,90014) 01040362 + WRITE (I02,90015) IVTOTL 01050362 +CBE** ********************** BBCHED0B **********************************01060362 +C***** 01070362 +C***** TEST OF AMIN0 01080362 +C***** 01090362 + WRITE(NUVI, 16702) 01100362 +16702 FORMAT (/ 8X, "TEST OF AMIN0" ) 01110362 +CT001* TEST 1 BOTH VALUES ZERO 01120362 + IVTNUM = 1 01130362 + IIBVI = 0 01140362 + IIDVI = 0 01150362 + RIAVS = AMIN0(IIBVI, IIDVI) 01160362 + IF (RIAVS + 0.00005) 20010, 10010, 40010 01170362 +40010 IF (RIAVS - 0.00005) 10010, 10010, 20010 01180362 +10010 IVPASS = IVPASS + 1 01190362 + WRITE (NUVI, 80002) IVTNUM 01200362 + GO TO 0011 01210362 +20010 IVFAIL = IVFAIL + 1 01220362 + RVCORR = 0.0 01230362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 01240362 + 0011 CONTINUE 01250362 +CT002* TEST 2 FIRST VALUE NON-ZERO, SECOND ZERO 01260362 + IVTNUM = 2 01270362 + IIBVI = 6 01280362 + IIDVI = 0 01290362 + RIAVS = AMIN0(IIBVI, IIDVI) 01300362 + IF (RIAVS + 0.00005) 20020, 10020, 40020 01310362 +40020 IF (RIAVS - 0.00005) 10020, 10020, 20020 01320362 +10020 IVPASS = IVPASS + 1 01330362 + WRITE (NUVI, 80002) IVTNUM 01340362 + GO TO 0021 01350362 +20020 IVFAIL = IVFAIL + 1 01360362 + RVCORR = 0.0 01370362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 01380362 + 0021 CONTINUE 01390362 +CT003* TEST 3 BOTH VALUES EQUAL 01400362 + IVTNUM = 3 01410362 + IIBVI = 7 01420362 + IIDVI = 7 01430362 + RIAVS = AMIN0(IIBVI, IIDVI) 01440362 + IF (RIAVS - 6.9996) 20030, 10030, 40030 01450362 +40030 IF (RIAVS - 7.0004) 10030, 10030, 20030 01460362 +10030 IVPASS = IVPASS + 1 01470362 + WRITE (NUVI, 80002) IVTNUM 01480362 + GO TO 0031 01490362 +20030 IVFAIL = IVFAIL + 1 01500362 + RVCORR = 7.0 01510362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 01520362 + 0031 CONTINUE 01530362 +CT004* TEST 4 VALUES NOT EQUAL 01540362 + IVTNUM = 4 01550362 + IIBVI = 7 01560362 + IIDVI = 5 01570362 + RIAVS = AMIN0(IIBVI, IIDVI) 01580362 + IF (RIAVS - 4.9997) 20040, 10040, 40040 01590362 +40040 IF (RIAVS - 5.0003) 10040, 10040, 20040 01600362 +10040 IVPASS = IVPASS + 1 01610362 + WRITE (NUVI, 80002) IVTNUM 01620362 + GO TO 0041 01630362 +20040 IVFAIL = IVFAIL + 1 01640362 + RVCORR = 5.0 01650362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 01660362 + 0041 CONTINUE 01670362 +CT005* TEST 5 FIRST VALUE NEGATIVE, SECOND ZERO 01680362 + IVTNUM = 5 01690362 + IIBVI = -6 01700362 + IIDVI = 0 01710362 + RIAVS = AMIN0(IIBVI, IIDVI) 01720362 + IF (RIAVS + 6.0003) 20050, 10050, 40050 01730362 +40050 IF (RIAVS + 5.9997) 10050, 10050, 20050 01740362 +10050 IVPASS = IVPASS + 1 01750362 + WRITE (NUVI, 80002) IVTNUM 01760362 + GO TO 0051 01770362 +20050 IVFAIL = IVFAIL + 1 01780362 + RVCORR = -6.0 01790362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 01800362 + 0051 CONTINUE 01810362 +CT006* TEST 6 BOTH VALUES EQUAL, BOTH NEGATIVE 01820362 + IVTNUM = 6 01830362 + IIBVI = -7 01840362 + IIDVI = -7 01850362 + RIAVS = AMIN0(IIBVI, IIDVI) 01860362 + IF (RIAVS + 7.0004) 20060, 10060, 40060 01870362 +40060 IF (RIAVS + 6.9996) 10060, 10060, 20060 01880362 +10060 IVPASS = IVPASS + 1 01890362 + WRITE (NUVI, 80002) IVTNUM 01900362 + GO TO 0061 01910362 +20060 IVFAIL = IVFAIL + 1 01920362 + RVCORR = -7.0 01930362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 01940362 + 0061 CONTINUE 01950362 +CT007* TEST 7 VALUES NOT EQUAL, BOTH NEGATIVE 01960362 + IVTNUM = 7 01970362 + IIBVI = -7 01980362 + IIDVI = -5 01990362 + RIAVS = AMIN0(IIBVI, IIDVI) 02000362 + IF (RIAVS + 7.0004) 20070, 10070, 40070 02010362 +40070 IF (RIAVS + 6.9996) 10070, 10070, 20070 02020362 +10070 IVPASS = IVPASS + 1 02030362 + WRITE (NUVI, 80002) IVTNUM 02040362 + GO TO 0071 02050362 +20070 IVFAIL = IVFAIL + 1 02060362 + RVCORR = -7.0 02070362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 02080362 + 0071 CONTINUE 02090362 +CT008* TEST 8 FIRST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN 02100362 + IVTNUM = 8 02110362 + IIDVI = 6 02120362 + IIEVI = 0 02130362 + RIAVS = AMIN0(IIDVI, -IIEVI) 02140362 + IF (RIAVS + 0.00005) 20080, 10080, 40080 02150362 +40080 IF (RIAVS - 0.00005) 10080, 10080, 20080 02160362 +10080 IVPASS = IVPASS + 1 02170362 + WRITE (NUVI, 80002) IVTNUM 02180362 + GO TO 0081 02190362 +20080 IVFAIL = IVFAIL + 1 02200362 + RVCORR = 0.0 02210362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 02220362 + 0081 CONTINUE 02230362 +CT009* TEST 9 3 ARGUMENTS 02240362 + IVTNUM = 9 02250362 + IIBVI = 0 02260362 + IICVI = 9 02270362 + IIDVI = 8 02280362 + RIAVS = AMIN0(IIBVI, IICVI, IIDVI) 02290362 + IF (RIAVS + 0.00005) 20090, 10090, 40090 02300362 +40090 IF (RIAVS - 0.00005) 10090, 10090, 20090 02310362 +10090 IVPASS = IVPASS + 1 02320362 + WRITE (NUVI, 80002) IVTNUM 02330362 + GO TO 0091 02340362 +20090 IVFAIL = IVFAIL + 1 02350362 + RVCORR = 0.0 02360362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 02370362 + 0091 CONTINUE 02380362 +CT010* TEST 10 4 ARGUMENTS 02390362 + IVTNUM = 10 02400362 + IIBVI = 34 02410362 + IICVI = 8 02420362 + IIDVI = 4 02430362 + RIAVS = AMIN0(IIDVI, IIBVI, IICVI, IIDVI) 02440362 + IF (RIAVS - 3.9998) 20100, 10100, 40100 02450362 +40100 IF (RIAVS - 4.0002) 10100, 10100, 20100 02460362 +10100 IVPASS = IVPASS + 1 02470362 + WRITE (NUVI, 80002) IVTNUM 02480362 + GO TO 0101 02490362 +20100 IVFAIL = IVFAIL + 1 02500362 + RVCORR = 4.0 02510362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 02520362 + 0101 CONTINUE 02530362 +CT011* TEST 11 5 ARGUMENTS 02540362 + IVTNUM = 11 02550362 + IIDVI = 4.0 02560362 + IIEVI = 5.0 02570362 + RIAVS = AMIN0(IIDVI, -IIDVI, -IIEVI, +IIDVI, IIEVI) 02580362 + IF (RIAVS + 5.0003) 20110, 10110, 40110 02590362 +40110 IF (RIAVS + 4.9997) 10110, 10110, 20110 02600362 +10110 IVPASS = IVPASS + 1 02610362 + WRITE (NUVI, 80002) IVTNUM 02620362 + GO TO 0111 02630362 +20110 IVFAIL = IVFAIL + 1 02640362 + RVCORR = -5.0 02650362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 02660362 + 0111 CONTINUE 02670362 +C***** 02680362 + WRITE (NUVI, 90002) 02690362 + WRITE (NUVI, 90013) 02700362 + WRITE (NUVI, 90014) 02710362 +C***** TEST OF AMIN1 02720362 +C***** 02730362 + WRITE(NUVI, 16704) 02740362 +16704 FORMAT (/ 8X, "TEST OF AMIN1" ) 02750362 +CT012* TEST 12 BOTH VALUES ZERO 02760362 + IVTNUM = 12 02770362 + RIBVS = 0.0 02780362 + RIDVS = 0.0 02790362 + RIAVS = AMIN1(RIBVS, RIDVS) 02800362 + IF (RIAVS + 0.00005) 20120, 10120, 40120 02810362 +40120 IF (RIAVS - 0.00005) 10120, 10120, 20120 02820362 +10120 IVPASS = IVPASS + 1 02830362 + WRITE (NUVI, 80002) IVTNUM 02840362 + GO TO 0121 02850362 +20120 IVFAIL = IVFAIL + 1 02860362 + RVCORR = 0.0 02870362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 02880362 + 0121 CONTINUE 02890362 +CT013* TEST 13 FIRST VALUE NON-ZERO, SECOND ZERO 02900362 + IVTNUM = 13 02910362 + RIBVS = 5.625 02920362 + RIDVS = 0.0 02930362 + RIAVS = AMIN1(RIBVS, RIDVS) 02940362 + IF (RIAVS + 0.00005) 20130, 10130, 40130 02950362 +40130 IF (RIAVS - 0.00005) 10130, 10130, 20130 02960362 +10130 IVPASS = IVPASS + 1 02970362 + WRITE (NUVI, 80002) IVTNUM 02980362 + GO TO 0131 02990362 +20130 IVFAIL = IVFAIL + 1 03000362 + RVCORR = 0.0 03010362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 03020362 + 0131 CONTINUE 03030362 +CT014* TEST 14 BOTH VALUES EQUAL 03040362 + IVTNUM = 14 03050362 + RIBVS = 6.5 03060362 + RIDVS = 6.5 03070362 + RIAVS = AMIN1(RIBVS, RIDVS) 03080362 + IF (RIAVS - 6.4996) 20140, 10140, 40140 03090362 +40140 IF (RIAVS - 6.5004) 10140, 10140, 20140 03100362 +10140 IVPASS = IVPASS + 1 03110362 + WRITE (NUVI, 80002) IVTNUM 03120362 + GO TO 0141 03130362 +20140 IVFAIL = IVFAIL + 1 03140362 + RVCORR = 6.5 03150362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 03160362 + 0141 CONTINUE 03170362 +CT015* TEST 15 VALUES NOT EQUAL 03180362 + IVTNUM = 15 03190362 + RIBVS = 7.125 03200362 + RIDVS = 5.125 03210362 + RIAVS = AMIN1(RIBVS, RIDVS) 03220362 + IF (RIAVS - 5.1247) 20150, 10150, 40150 03230362 +40150 IF (RIAVS - 5.1253) 10150, 10150, 20150 03240362 +10150 IVPASS = IVPASS + 1 03250362 + WRITE (NUVI, 80002) IVTNUM 03260362 + GO TO 0151 03270362 +20150 IVFAIL = IVFAIL + 1 03280362 + RVCORR = 5.125 03290362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 03300362 + 0151 CONTINUE 03310362 +CT016* TEST 16 FIRST VALUE NEGATIVE, SECOND ZERO 03320362 + IVTNUM = 16 03330362 + RIBVS = -5.625 03340362 + RIDVS = 0.0 03350362 + RIAVS = AMIN1(RIBVS, RIDVS) 03360362 + IF (RIAVS + 5.6253) 20160, 10160, 40160 03370362 +40160 IF (RIAVS + 5.6247) 10160, 10160, 20160 03380362 +10160 IVPASS = IVPASS + 1 03390362 + WRITE (NUVI, 80002) IVTNUM 03400362 + GO TO 0161 03410362 +20160 IVFAIL = IVFAIL + 1 03420362 + RVCORR = -5.625 03430362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 03440362 + 0161 CONTINUE 03450362 +CT017* TEST 17 BOTH VALUES EQUAL, BOTH NEGATIVE 03460362 + IVTNUM = 17 03470362 + RIBVS = -6.5 03480362 + RIDVS = -6.5 03490362 + RIAVS = AMIN1(RIBVS, RIDVS) 03500362 + IF (RIAVS + 6.5004) 20170, 10170, 40170 03510362 +40170 IF (RIAVS + 6.4996) 10170, 10170, 20170 03520362 +10170 IVPASS = IVPASS + 1 03530362 + WRITE (NUVI, 80002) IVTNUM 03540362 + GO TO 0171 03550362 +20170 IVFAIL = IVFAIL + 1 03560362 + RVCORR = -6.5 03570362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 03580362 + 0171 CONTINUE 03590362 +CT018* TEST 18 VALUES NOT EQUAL, BOTH NEGATIVE 03600362 + IVTNUM = 18 03610362 + RIBVS = -7.125 03620362 + RIDVS = -5.125 03630362 + RIAVS = AMIN1(RIBVS, RIDVS) 03640362 + IF (RIAVS + 7.1254) 20180, 10180, 40180 03650362 +40180 IF (RIAVS + 7.1246) 10180, 10180, 20180 03660362 +10180 IVPASS = IVPASS + 1 03670362 + WRITE (NUVI, 80002) IVTNUM 03680362 + GO TO 0181 03690362 +20180 IVFAIL = IVFAIL + 1 03700362 + RVCORR = -7.125 03710362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 03720362 + 0181 CONTINUE 03730362 +CT019* TEST 19 FIRST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN 03740362 + IVTNUM = 19 03750362 + RIDVS = 5.625 03760362 + RIEVS = 0.0 03770362 + RIAVS = AMIN1(RIDVS, -RIEVS) 03780362 + IF (RIAVS + 0.00005) 20190, 10190, 40190 03790362 +40190 IF (RIAVS - 0.00005) 10190, 10190, 20190 03800362 +10190 IVPASS = IVPASS + 1 03810362 + WRITE (NUVI, 80002) IVTNUM 03820362 + GO TO 0191 03830362 +20190 IVFAIL = IVFAIL + 1 03840362 + RVCORR = 0.0 03850362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 03860362 + 0191 CONTINUE 03870362 +CT020* TEST 20 EXPRESSION AS ARGUMENT 03880362 + IVTNUM = 20 03890362 + RIDVS = 3.5 03900362 + RIEVS = 4.0 03910362 + RIAVS = AMIN1(RIDVS + RIEVS, -RIEVS - RIDVS) 03920362 + IF (RIAVS + 7.5004) 20200, 10200, 40200 03930362 +40200 IF (RIAVS + 7.4996) 10200, 10200, 20200 03940362 +10200 IVPASS = IVPASS + 1 03950362 + WRITE (NUVI, 80002) IVTNUM 03960362 + GO TO 0201 03970362 +20200 IVFAIL = IVFAIL + 1 03980362 + RVCORR = -7.5 03990362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 04000362 + 0201 CONTINUE 04010362 +CT021* TEST 21 3 ARGUMENTS 04020362 + IVTNUM = 21 04030362 + RIBVS = 0.0 04040362 + RICVS = 1.0 04050362 + RIDVS = 10.9 04060362 + RIAVS = AMIN1(RIDVS, RICVS, RIBVS) 04070362 + IF (RIAVS + 0.00005) 20210, 10210, 40210 04080362 +40210 IF (RIAVS - 0.00005) 10210, 10210, 20210 04090362 +10210 IVPASS = IVPASS + 1 04100362 + WRITE (NUVI, 80002) IVTNUM 04110362 + GO TO 0211 04120362 +20210 IVFAIL = IVFAIL + 1 04130362 + RVCORR = 0.0 04140362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 04150362 + 0211 CONTINUE 04160362 +CT022* TEST 22 4 ARGUMENTS 04170362 + IVTNUM = 22 04180362 + RIBVS = -9.0 04190362 + RICVS = 10.0 04200362 + RIDVS = 3.5 04210362 + RIAVS = AMIN1(RIDVS, RICVS, -RIBVS, RIDVS) 04220362 + IF (RIAVS - 3.4998) 20220, 10220, 40220 04230362 +40220 IF (RIAVS - 3.5002) 10220, 10220, 20220 04240362 +10220 IVPASS = IVPASS + 1 04250362 + WRITE (NUVI, 80002) IVTNUM 04260362 + GO TO 0221 04270362 +20220 IVFAIL = IVFAIL + 1 04280362 + RVCORR = 3.5 04290362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 04300362 + 0221 CONTINUE 04310362 +CT023* TEST 23 5 ARGUMENTS 04320362 + IVTNUM = 23 04330362 + RIDVS = 3.5 04340362 + RIEVS = 4.5 04350362 + RIAVS = AMIN1(RIDVS, -RIDVS, -RIEVS, +RIDVS, RIEVS) 04360362 + IF (RIAVS + 4.5003) 20230, 10230, 40230 04370362 +40230 IF (RIAVS + 4.4997) 10230, 10230, 20230 04380362 +10230 IVPASS = IVPASS + 1 04390362 + WRITE (NUVI, 80002) IVTNUM 04400362 + GO TO 0231 04410362 +20230 IVFAIL = IVFAIL + 1 04420362 + RVCORR = -4.5 04430362 + WRITE (NUVI, 80012) IVTNUM, RIAVS, RVCORR 04440362 + 0231 CONTINUE 04450362 +C***** 04460362 + WRITE (NUVI, 90002) 04470362 + WRITE (NUVI, 90013) 04480362 + WRITE (NUVI, 90014) 04490362 +C***** TEST OF MIN0 04500362 +C***** 04510362 + WRITE(NUVI, 16705) 04520362 +16705 FORMAT (/ 8X, "TEST OF MIN0" ) 04530362 +CT024* TEST 24 BOTH VALUES ZERO 04540362 + IVTNUM = 24 04550362 + IIBVI = 0 04560362 + IIDVI = 0 04570362 + IIAVI = MIN0(IIBVI, IIDVI) 04580362 + IF (IIAVI - 0) 20240, 10240, 20240 04590362 +10240 IVPASS = IVPASS + 1 04600362 + WRITE (NUVI, 80002) IVTNUM 04610362 + GO TO 0241 04620362 +20240 IVFAIL = IVFAIL + 1 04630362 + IVCORR = 0 04640362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 04650362 + 0241 CONTINUE 04660362 +CT025* TEST 25 FIRST VALUE NON-ZERO, SECOND ZERO 04670362 + IVTNUM = 25 04680362 + IIBVI = 6 04690362 + IIDVI = 0 04700362 + IIAVI = MIN0(IIBVI, IIDVI) 04710362 + IF (IIAVI - 0) 20250, 10250, 20250 04720362 +10250 IVPASS = IVPASS + 1 04730362 + WRITE (NUVI, 80002) IVTNUM 04740362 + GO TO 0251 04750362 +20250 IVFAIL = IVFAIL + 1 04760362 + IVCORR = 0 04770362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 04780362 + 0251 CONTINUE 04790362 +CT026* TEST 26 BOTH VALUES EQUAL 04800362 + IVTNUM = 26 04810362 + IIBVI = 7 04820362 + IIDVI = 7 04830362 + IIAVI = MIN0(IIBVI, IIDVI) 04840362 + IF (IIAVI - 7) 20260, 10260, 20260 04850362 +10260 IVPASS = IVPASS + 1 04860362 + WRITE (NUVI, 80002) IVTNUM 04870362 + GO TO 0261 04880362 +20260 IVFAIL = IVFAIL + 1 04890362 + IVCORR = 7 04900362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 04910362 + 0261 CONTINUE 04920362 +CT027* TEST 27 VALUES NOT EQUAL 04930362 + IVTNUM = 27 04940362 + IIBVI = 7 04950362 + IIDVI = 5 04960362 + IIAVI = MIN0(IIBVI, IIDVI) 04970362 + IF (IIAVI - 5) 20270, 10270, 20270 04980362 +10270 IVPASS = IVPASS + 1 04990362 + WRITE (NUVI, 80002) IVTNUM 05000362 + GO TO 0271 05010362 +20270 IVFAIL = IVFAIL + 1 05020362 + IVCORR = 5 05030362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 05040362 + 0271 CONTINUE 05050362 +CT028* TEST 28 FIRST VALUE NEGATIVE, SECOND ZERO 05060362 + IVTNUM = 28 05070362 + IIBVI = -6 05080362 + IIDVI = 0 05090362 + IIAVI = MIN0(IIBVI, IIDVI) 05100362 + IF (IIAVI + 6) 20280, 10280, 20280 05110362 +10280 IVPASS = IVPASS + 1 05120362 + WRITE (NUVI, 80002) IVTNUM 05130362 + GO TO 0281 05140362 +20280 IVFAIL = IVFAIL + 1 05150362 + IVCORR = -6 05160362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 05170362 + 0281 CONTINUE 05180362 +CT029* TEST 29 BOTH VALUES EQUAL, BOTH NEGATIVE 05190362 + IVTNUM = 29 05200362 + IIBVI = -7 05210362 + IIDVI = -7 05220362 + IIAVI = MIN0(IIBVI, IIDVI) 05230362 + IF (IIAVI + 7) 20290, 10290, 20290 05240362 +10290 IVPASS = IVPASS + 1 05250362 + WRITE (NUVI, 80002) IVTNUM 05260362 + GO TO 0291 05270362 +20290 IVFAIL = IVFAIL + 1 05280362 + IVCORR = -7 05290362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 05300362 + 0291 CONTINUE 05310362 +CT030* TEST 30 VALUES NOT EQUAL, BOTH NEGATIVE 05320362 + IVTNUM = 30 05330362 + IIBVI = -7 05340362 + IIDVI = -5 05350362 + IIAVI = MIN0(IIBVI, IIDVI) 05360362 + IF (IIAVI + 7) 20300, 10300, 20300 05370362 +10300 IVPASS = IVPASS + 1 05380362 + WRITE (NUVI, 80002) IVTNUM 05390362 + GO TO 0301 05400362 +20300 IVFAIL = IVFAIL + 1 05410362 + IVCORR = -7 05420362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 05430362 + 0301 CONTINUE 05440362 +CT031* TEST 31 FIRST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN 05450362 + IVTNUM = 31 05460362 + IIDVI = 6 05470362 + IIEVI = 0 05480362 + IIAVI = MIN0(IIDVI, -IIEVI) 05490362 + IF (IIAVI - 0) 20310, 10310, 20310 05500362 +10310 IVPASS = IVPASS + 1 05510362 + WRITE (NUVI, 80002) IVTNUM 05520362 + GO TO 0311 05530362 +20310 IVFAIL = IVFAIL + 1 05540362 + IVCORR = 0 05550362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 05560362 + 0311 CONTINUE 05570362 +CT032* TEST 32 EXPRESSION PRESENTED TO FUNCTION 05580362 + IVTNUM = 32 05590362 + IIDVI = 3 05600362 + IIEVI = 4 05610362 + IIAVI = MIN0(IIDVI + IIEVI, -IIEVI - IIDVI) 05620362 + IF (IIAVI + 7) 20320, 10320, 20320 05630362 +10320 IVPASS = IVPASS + 1 05640362 + WRITE (NUVI, 80002) IVTNUM 05650362 + GO TO 0321 05660362 +20320 IVFAIL = IVFAIL + 1 05670362 + IVCORR = -7 05680362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 05690362 + 0321 CONTINUE 05700362 +CT033* TEST 33 3 ARGUMENTS 05710362 + IVTNUM = 33 05720362 + IIBVI = 0 05730362 + IICVI = 10 05740362 + IIDVI = -11 05750362 + IIAVI = MIN0(IICVI, IIBVI, -IIDVI) 05760362 + IF (IIAVI - 0) 20330, 10330, 20330 05770362 +10330 IVPASS = IVPASS + 1 05780362 + WRITE (NUVI, 80002) IVTNUM 05790362 + GO TO 0331 05800362 +20330 IVFAIL = IVFAIL + 1 05810362 + IVCORR = 0 05820362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 05830362 + 0331 CONTINUE 05840362 +CT034* TEST 34 4 ARGUMENTS 05850362 + IVTNUM = 34 05860362 + IIAVI = 10 05870362 + IIBVI = -4 05880362 + IICVI = 8 05890362 + IIDVI = 4 05900362 + IIAVI = MIN0(IIAVI, -IIBVI, IICVI, IIDVI) 05910362 + IF (IIAVI - 4) 20340, 10340, 20340 05920362 +10340 IVPASS = IVPASS + 1 05930362 + WRITE (NUVI, 80002) IVTNUM 05940362 + GO TO 0341 05950362 +20340 IVFAIL = IVFAIL + 1 05960362 + IVCORR = 4 05970362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 05980362 + 0341 CONTINUE 05990362 +CT035* TEST 35 5 ARGUMENTS 06000362 + IVTNUM = 35 06010362 + IIDVI = 4 06020362 + IIEVI = 5 06030362 + IIAVI = MIN0(IIDVI, -IIDVI, -IIEVI, +IIDVI, IIEVI) 06040362 + IF (IIAVI + 5) 20350, 10350, 20350 06050362 +10350 IVPASS = IVPASS + 1 06060362 + WRITE (NUVI, 80002) IVTNUM 06070362 + GO TO 0351 06080362 +20350 IVFAIL = IVFAIL + 1 06090362 + IVCORR = -5 06100362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 06110362 + 0351 CONTINUE 06120362 +C***** 06130362 + WRITE (NUVI, 90002) 06140362 + WRITE (NUVI, 90013) 06150362 + WRITE (NUVI, 90014) 06160362 +C***** TEST OF MIN1 06170362 +C***** 06180362 + WRITE(NUVI, 16707) 06190362 +16707 FORMAT (/ 8X, "TEST OF MIN1" ) 06200362 +CT036* TEST 36 BOTH VALUES ZERO 06210362 + IVTNUM = 36 06220362 + RIBVS = 0.0 06230362 + RIDVS = 0.0 06240362 + IIAVI = MIN1(RIBVS, RIDVS) 06250362 + IF (IIAVI - 0) 20360, 10360, 20360 06260362 +10360 IVPASS = IVPASS + 1 06270362 + WRITE (NUVI, 80002) IVTNUM 06280362 + GO TO 0361 06290362 +20360 IVFAIL = IVFAIL + 1 06300362 + IVCORR = 0 06310362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 06320362 + 0361 CONTINUE 06330362 +CT037* TEST 37 FIRST VALUE NON-ZERO, SECOND ZERO 06340362 + IVTNUM = 37 06350362 + RIBVS = 5.625 06360362 + RIDVS = 0.0 06370362 + IIAVI = MIN1(RIBVS, RIDVS) 06380362 + IF (IIAVI - 0) 20370, 10370, 20370 06390362 +10370 IVPASS = IVPASS + 1 06400362 + WRITE (NUVI, 80002) IVTNUM 06410362 + GO TO 0371 06420362 +20370 IVFAIL = IVFAIL + 1 06430362 + IVCORR = 0 06440362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 06450362 + 0371 CONTINUE 06460362 +CT038* TEST 38 BOTH VALUES EQUAL 06470362 + IVTNUM = 38 06480362 + RIBVS = 6.5 06490362 + RIDVS = 6.5 06500362 + IIAVI = MIN1(RIBVS, RIDVS) 06510362 + IF (IIAVI - 6) 20380, 10380, 20380 06520362 +10380 IVPASS = IVPASS + 1 06530362 + WRITE (NUVI, 80002) IVTNUM 06540362 + GO TO 0381 06550362 +20380 IVFAIL = IVFAIL + 1 06560362 + IVCORR = 6 06570362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 06580362 + 0381 CONTINUE 06590362 +CT039* TEST 39 VALUES NOT EQUAL 06600362 + IVTNUM = 39 06610362 + RIBVS = 7.125 06620362 + RIDVS = 5.125 06630362 + IIAVI = MIN1(RIBVS, RIDVS) 06640362 + IF (IIAVI - 5) 20390, 10390, 20390 06650362 +10390 IVPASS = IVPASS + 1 06660362 + WRITE (NUVI, 80002) IVTNUM 06670362 + GO TO 0391 06680362 +20390 IVFAIL = IVFAIL + 1 06690362 + IVCORR = 5 06700362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 06710362 + 0391 CONTINUE 06720362 +CT040* TEST 40 FIRST VALUE NEGATIVE, SECOND ZERO 06730362 + IVTNUM = 40 06740362 + RIBVS = -5.625 06750362 + RIDVS = 0.0 06760362 + IIAVI = MIN1(RIBVS, RIDVS) 06770362 + IF (IIAVI + 5) 20400, 10400, 20400 06780362 +10400 IVPASS = IVPASS + 1 06790362 + WRITE (NUVI, 80002) IVTNUM 06800362 + GO TO 0401 06810362 +20400 IVFAIL = IVFAIL + 1 06820362 + IVCORR = -5 06830362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 06840362 + 0401 CONTINUE 06850362 +CT041* TEST 41 BOTH VALUES EQUAL, BOTH NEGATIVE 06860362 + IVTNUM = 41 06870362 + RIBVS = -6.5 06880362 + RIDVS = -6.5 06890362 + IIAVI = MIN1(RIBVS, RIDVS) 06900362 + IF (IIAVI + 6) 20410, 10410, 20410 06910362 +10410 IVPASS = IVPASS + 1 06920362 + WRITE (NUVI, 80002) IVTNUM 06930362 + GO TO 0411 06940362 +20410 IVFAIL = IVFAIL + 1 06950362 + IVCORR = -6 06960362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 06970362 + 0411 CONTINUE 06980362 +CT042* TEST 42 VALUES NOT EQUAL, BOTH NEGATIVE 06990362 + IVTNUM = 42 07000362 + RIBVS = -7.125 07010362 + RIDVS = -5.125 07020362 + IIAVI = MIN1(RIBVS, RIDVS) 07030362 + IF (IIAVI + 7) 20420, 10420, 20420 07040362 +10420 IVPASS = IVPASS + 1 07050362 + WRITE (NUVI, 80002) IVTNUM 07060362 + GO TO 0421 07070362 +20420 IVFAIL = IVFAIL + 1 07080362 + IVCORR = -7 07090362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 07100362 + 0421 CONTINUE 07110362 +CT043* TEST 43 FIRST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN 07120362 + IVTNUM = 43 07130362 + RIDVS = 5.625 07140362 + RIEVS = 0.0 07150362 + IIAVI = MIN1(RIDVS, -RIEVS) 07160362 + IF (IIAVI - 0) 20430, 10430, 20430 07170362 +10430 IVPASS = IVPASS + 1 07180362 + WRITE (NUVI, 80002) IVTNUM 07190362 + GO TO 0431 07200362 +20430 IVFAIL = IVFAIL + 1 07210362 + IVCORR = 0 07220362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 07230362 + 0431 CONTINUE 07240362 +CT044* TEST 44 EXPRESSION PRESENTED TO FUNCTION 07250362 + IVTNUM = 44 07260362 + RIDVS = 3.5 07270362 + RIEVS = 4.0 07280362 + IIAVI = MIN1(RIDVS + RIEVS, -RIEVS - RIDVS) 07290362 + IF (IIAVI + 7) 20440, 10440, 20440 07300362 +10440 IVPASS = IVPASS + 1 07310362 + WRITE (NUVI, 80002) IVTNUM 07320362 + GO TO 0441 07330362 +20440 IVFAIL = IVFAIL + 1 07340362 + IVCORR = -7 07350362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 07360362 + 0441 CONTINUE 07370362 +CT045* TEST 45 3 ARGUMENTS 07380362 + IVTNUM = 45 07390362 + RIBVS = 0.0 07400362 + RICVS = 1.0 07410362 + RIDVS = 2.0 07420362 + IIAVI = MIN1(RIBVS, RICVS, RIDVS) 07430362 + IF (IIAVI - 0) 20450, 10450, 20450 07440362 +10450 IVPASS = IVPASS + 1 07450362 + WRITE (NUVI, 80002) IVTNUM 07460362 + GO TO 0451 07470362 +20450 IVFAIL = IVFAIL + 1 07480362 + IVCORR = 0 07490362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 07500362 + 0451 CONTINUE 07510362 +CT046* TEST 46 4 ARGUMENTS 07520362 + IVTNUM = 46 07530362 + RIAVS = -3.5 07540362 + RIBVS = 12.0 07550362 + RICVS = 3.6 07560362 + RIDVS = 3.5 07570362 + IIAVI = MIN1(-RIAVS, RIBVS, RICVS, RIDVS) 07580362 + IF (IIAVI - 3) 20460, 10460, 20460 07590362 +10460 IVPASS = IVPASS + 1 07600362 + WRITE (NUVI, 80002) IVTNUM 07610362 + GO TO 0461 07620362 +20460 IVFAIL = IVFAIL + 1 07630362 + IVCORR = 3 07640362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 07650362 + 0461 CONTINUE 07660362 +CT047* TEST 47 5 ARGUMENTS 07670362 + IVTNUM = 47 07680362 + RIDVS = 3.5 07690362 + RIEVS = 4.5 07700362 + IIAVI = MIN1(RIDVS, -RIDVS, -RIEVS, +RIDVS, RIEVS) 07710362 + IF (IIAVI + 4) 20470, 10470, 20470 07720362 +10470 IVPASS = IVPASS + 1 07730362 + WRITE (NUVI, 80002) IVTNUM 07740362 + GO TO 0471 07750362 +20470 IVFAIL = IVFAIL + 1 07760362 + IVCORR = -4 07770362 + WRITE (NUVI, 80010) IVTNUM, IIAVI, IVCORR 07780362 + 0471 CONTINUE 07790362 +C***** 07800362 +CBB** ********************** BBCSUM0 **********************************07810362 +C**** WRITE OUT TEST SUMMARY 07820362 +C**** 07830362 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 07840362 + WRITE (I02, 90004) 07850362 + WRITE (I02, 90014) 07860362 + WRITE (I02, 90004) 07870362 + WRITE (I02, 90020) IVPASS 07880362 + WRITE (I02, 90022) IVFAIL 07890362 + WRITE (I02, 90024) IVDELE 07900362 + WRITE (I02, 90026) IVINSP 07910362 + WRITE (I02, 90028) IVTOTN, IVTOTL 07920362 +CBE** ********************** BBCSUM0 **********************************07930362 +CBB** ********************** BBCFOOT0 **********************************07940362 +C**** WRITE OUT REPORT FOOTINGS 07950362 +C**** 07960362 + WRITE (I02,90016) ZPROG, ZPROG 07970362 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 07980362 + WRITE (I02,90019) 07990362 +CBE** ********************** BBCFOOT0 **********************************08000362 +CBB** ********************** BBCFMT0A **********************************08010362 +C**** FORMATS FOR TEST DETAIL LINES 08020362 +C**** 08030362 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 08040362 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 08050362 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 08060362 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 08070362 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 08080362 + 1I6,/," ",15X,"CORRECT= " ,I6) 08090362 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08100362 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 08110362 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08120362 + 1A21,/," ",16X,"CORRECT= " ,A21) 08130362 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 08140362 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 08150362 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 08160362 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 08170362 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 08180362 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 08190362 +80050 FORMAT (" ",48X,A31) 08200362 +CBE** ********************** BBCFMT0A **********************************08210362 +CBB** ********************** BBCFMT0B **********************************08220362 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 08230362 +C**** 08240362 +90002 FORMAT ("1") 08250362 +90004 FORMAT (" ") 08260362 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )08270362 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08280362 +90008 FORMAT (" ",21X,A13,A17) 08290362 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 08300362 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 08310362 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 08320362 + 1 7X,"REMARKS",24X) 08330362 +90014 FORMAT (" ","----------------------------------------------" , 08340362 + 1 "---------------------------------" ) 08350362 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 08360362 +C**** 08370362 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08380362 +C**** 08390362 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 08400362 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 08410362 + 1 A13) 08420362 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 08430362 +C**** 08440362 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 08450362 +C**** 08460362 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 08470362 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 08480362 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 08490362 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 08500362 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 08510362 +CBE** ********************** BBCFMT0B **********************************08520362 +C***** 08530362 +C***** END OF TEST SEGMENT 167 08540362 + STOP 08550362 + END 08560362 + 08570362 diff --git a/Fortran/UnitTests/fcvs21_f95/FM362.reference_output b/Fortran/UnitTests/fcvs21_f95/FM362.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM362.reference_output @@ -0,0 +1,100 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM362BEGIN* TEST RESULTS - FM362 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + XMIN - (167) INTRINSIC FUNCTIONS-- + + AMIN0, AMIN1, MIN0, MIN1 + (CHOOSING SMALLEST VALUE) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 47 TESTS + + + TEST OF AMIN0 + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF AMIN1 + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF MIN0 + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF MIN1 + 36 PASS + 37 PASS + 38 PASS + 39 PASS + 40 PASS + 41 PASS + 42 PASS + 43 PASS + 44 PASS + 45 PASS + 46 PASS + 47 PASS + + ------------------------------------------------------------------------------- + + 47 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 47 OF 47 TESTS EXECUTED + + *FM362END* END OF TEST - FM362 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM363.f b/Fortran/UnitTests/fcvs21_f95/FM363.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM363.f @@ -0,0 +1,387 @@ + PROGRAM FM363 + +C***********************************************************************00010363 +C***** FORTRAN 77 00020363 +C***** FM363 X66MX - (171) 00030363 +C***** 00040363 +C***********************************************************************00050363 +C***** GENERAL PURPOSE SUBSET REF00060363 +C***** TEST THAT ALL INTRINSIC FUNCTIONS WOULD ACCEPT 15.3 00070363 +C***** ANY EXPRESSION OF THE TYPE SPECIFIED IN THE (TABLE 5)00080363 +C***** INTRINSIC FUNCTION TABLE - ANS REFS - 15.10 00090363 +C***** 00100363 +C***** GENERAL COMMENTS 00110363 +C***** SEGMENTS XINT, XREAL, XAINT, XABS, XAMOD, 00120363 +C***** XSIGN, XDIM, XMAX, XMIN ASSUMED WORKING 00130363 +C***** 00140363 +CBB** ********************** BBCCOMNT **********************************00150363 +C**** 00160363 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00170363 +C**** VERSION 2.1 00180363 +C**** 00190363 +C**** 00200363 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00210363 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00220363 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00230363 +C**** BUILDING 225 RM A266 00240363 +C**** GAITHERSBURG, MD 20899 00250363 +C**** 00260363 +C**** 00270363 +C**** 00280363 +CBE** ********************** BBCCOMNT **********************************00290363 +CBB** ********************** BBCINITA **********************************00300363 +C**** SPECIFICATION STATEMENTS 00310363 +C**** 00320363 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330363 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340363 +CBE** ********************** BBCINITA **********************************00350363 +CBB** ********************** BBCINITB **********************************00360363 +C**** INITIALIZE SECTION 00370363 + DATA ZVERS, ZVERSD, ZDATE 00380363 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390363 + DATA ZCOMPL, ZNAME, ZTAPE 00400363 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410363 + DATA ZPROJ, ZTAPED, ZPROG 00420363 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430363 + DATA REMRKS /' '/ 00440363 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450363 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460363 +C**** 00470363 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480363 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490363 +CZ03 ZPROG = 'PROGRAM NAME' 00500363 +CZ04 ZDATE = 'DATE OF TEST' 00510363 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520363 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530363 +CZ07 ZNAME = 'NAME OF USER' 00540363 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00550363 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00560363 +C 00570363 + IVPASS = 0 00580363 + IVFAIL = 0 00590363 + IVDELE = 0 00600363 + IVINSP = 0 00610363 + IVTOTL = 0 00620363 + IVTOTN = 0 00630363 + ICZERO = 0 00640363 +C 00650363 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660363 + I01 = 05 00670363 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680363 + I02 = 06 00690363 +C 00700363 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710363 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720363 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730363 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740363 +C 00750363 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760363 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770363 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780363 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790363 +C 00800363 +CBE** ********************** BBCINITB **********************************00810363 + NUVI = I02 00820363 + IVTOTL = 14 00830363 + ZPROG = 'FM363' 00840363 +CBB** ********************** BBCHED0A **********************************00850363 +C**** 00860363 +C**** WRITE REPORT TITLE 00870363 +C**** 00880363 + WRITE (I02, 90002) 00890363 + WRITE (I02, 90006) 00900363 + WRITE (I02, 90007) 00910363 + WRITE (I02, 90008) ZVERS, ZVERSD 00920363 + WRITE (I02, 90009) ZPROG, ZPROG 00930363 + WRITE (I02, 90010) ZDATE, ZCOMPL 00940363 +CBE** ********************** BBCHED0A **********************************00950363 +C***** 00960363 +C***** HEADER FOR SEGMENT 171 WRITTEN 00970363 + WRITE (NUVI,17101) 00980363 +17101 FORMAT(" ",// 2X,"X66MX - (171) SUBSET INTRINSIC FUNCTIONS--" //00990363 + 1 10X,"IN ARITHMETIC EXPRESSIONS" 01000363 + 2 //2X, " SUBSET REF. - 15.10, 6.1.4" ) 01010363 +CBB** ********************** BBCHED0B **********************************01020363 +C**** WRITE DETAIL REPORT HEADERS 01030363 +C**** 01040363 + WRITE (I02,90004) 01050363 + WRITE (I02,90004) 01060363 + WRITE (I02,90013) 01070363 + WRITE (I02,90014) 01080363 + WRITE (I02,90015) IVTOTL 01090363 +CBE** ********************** BBCHED0B **********************************01100363 +C***** 01110363 +C***** TEST OF INTRINSIC FUNCTIONS IN EXPRESSIONS 01120363 +C***** 01130363 +CT001* TEST 1 01140363 + IVTNUM = 1 01150363 + RJBVS = 5.2 01160363 + IJAVI = INT(RJBVS) + 3 01170363 + IF (IJAVI - 8) 20010, 10010, 20010 01180363 +10010 IVPASS = IVPASS + 1 01190363 + WRITE (NUVI, 80002) IVTNUM 01200363 + GO TO 0011 01210363 +20010 IVFAIL = IVFAIL + 1 01220363 + IVCORR = 8 01230363 + WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR 01240363 + 0011 CONTINUE 01250363 +CT002* TEST 2 01260363 + IVTNUM = 2 01270363 + RJBVS = 4.8 01280363 + IJAVI = IFIX(RJBVS) - 2 01290363 + IF (IJAVI - 2) 20020, 10020, 20020 01300363 +10020 IVPASS = IVPASS + 1 01310363 + WRITE (NUVI, 80002) IVTNUM 01320363 + GO TO 0021 01330363 +20020 IVFAIL = IVFAIL + 1 01340363 + IVCORR = 2 01350363 + WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR 01360363 + 0021 CONTINUE 01370363 +CT003* TEST 3 01380363 + IVTNUM = 3 01390363 + RJBVS = 2.8 01400363 + IJAVI = 50 * NINT(RJBVS) 01410363 + IF (IJAVI - 150) 20030, 10030, 20030 01420363 +10030 IVPASS = IVPASS + 1 01430363 + WRITE (NUVI, 80002) IVTNUM 01440363 + GO TO 0031 01450363 +20030 IVFAIL = IVFAIL + 1 01460363 + IVCORR = 150 01470363 + WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR 01480363 + 0031 CONTINUE 01490363 +CT004* TEST 4 01500363 + IVTNUM = 4 01510363 + IJBVI = -4 01520363 + IJAVI = IABS(IJBVI) / (-4) 01530363 + IF (IJAVI + 1) 20040, 10040, 20040 01540363 +10040 IVPASS = IVPASS + 1 01550363 + WRITE (NUVI, 80002) IVTNUM 01560363 + GO TO 0041 01570363 +20040 IVFAIL = IVFAIL + 1 01580363 + IVCORR = -1 01590363 + WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR 01600363 + 0041 CONTINUE 01610363 +CT005* TEST 5 01620363 + IVTNUM = 5 01630363 + IJBVI = 7 01640363 + IJDVI = 4 01650363 + IJAVI = MOD(IJBVI, IJDVI) ** 2 01660363 + IF (IJAVI - 9) 20050, 10050, 20050 01670363 +10050 IVPASS = IVPASS + 1 01680363 + WRITE (NUVI, 80002) IVTNUM 01690363 + GO TO 0051 01700363 +20050 IVFAIL = IVFAIL + 1 01710363 + IVCORR = 9 01720363 + WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR 01730363 + 0051 CONTINUE 01740363 +CT006* TEST 6 01750363 + IVTNUM = 6 01760363 + IJBVI = -3 01770363 + IJDVI = 1 01780363 + IJAVI = 2 ** ISIGN(IJBVI, IJDVI) 01790363 + IF (IJAVI - 8) 20060, 10060, 20060 01800363 +10060 IVPASS = IVPASS + 1 01810363 + WRITE (NUVI, 80002) IVTNUM 01820363 + GO TO 0061 01830363 +20060 IVFAIL = IVFAIL + 1 01840363 + IVCORR = 8 01850363 + WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR 01860363 + 0061 CONTINUE 01870363 +CT007* TEST 7 01880363 + IVTNUM = 7 01890363 + IJBVI = 5 01900363 + IJDVI = 2 01910363 + IJEVI = -2 01920363 + IJAVI = IDIM(IJBVI, IJDVI) * 2 + MAX0(IJEVI, IJDVI) - 7 01930363 + IF (IJAVI - 1) 20070, 10070, 20070 01940363 +10070 IVPASS = IVPASS + 1 01950363 + WRITE (NUVI, 80002) IVTNUM 01960363 + GO TO 0071 01970363 +20070 IVFAIL = IVFAIL + 1 01980363 + IVCORR = 1 01990363 + WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR 02000363 + 0071 CONTINUE 02010363 +CT008* TEST 8 02020363 + IVTNUM = 8 02030363 + IJBVI = 2 02040363 + IJDVI = 3 02050363 + RJBVS = 2.2 02060363 + RJDVS = 4.8 02070363 + RJEVS = -2.2 02080363 + RJFVS = -3.8 02090363 + IJAVI = MIN0(IJBVI, IJDVI) * 2 - MAX1(RJBVS, RJDVS) / 2 02100363 + 1 + MIN1(RJEVS, RJFVS) + 5 02110363 + IF (IJAVI - 4) 20080, 10080, 20080 02120363 +10080 IVPASS = IVPASS + 1 02130363 + WRITE (NUVI, 80002) IVTNUM 02140363 + GO TO 0081 02150363 +20080 IVFAIL = IVFAIL + 1 02160363 + IVCORR = 4 02170363 + WRITE (NUVI, 80010) IVTNUM, IJAVI, IVCORR 02180363 + 0081 CONTINUE 02190363 +CT009* TEST 9 02200363 + IVTNUM = 9 02210363 + IJBVI = 2 02220363 + RJAVS = FLOAT(IJBVI) + 3.5 02230363 + IF (RJAVS - 5.4997) 20090, 10090, 40090 02240363 +40090 IF (RJAVS - 5.5003) 10090, 10090, 20090 02250363 +10090 IVPASS = IVPASS + 1 02260363 + WRITE (NUVI, 80002) IVTNUM 02270363 + GO TO 0091 02280363 +20090 IVFAIL = IVFAIL + 1 02290363 + RVCORR = 5.5 02300363 + WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR 02310363 + 0091 CONTINUE 02320363 +CT010* TEST 10 02330363 + IVTNUM = 10 02340363 + IJBVI = 2 02350363 + RJAVS = REAL(IJBVI) * 3.0 02360363 + IF (RJAVS - 5.9997) 20100, 10100, 40100 02370363 +40100 IF (RJAVS - 6.0003) 10100, 10100, 20100 02380363 +10100 IVPASS = IVPASS + 1 02390363 + WRITE (NUVI, 80002) IVTNUM 02400363 + GO TO 0101 02410363 +20100 IVFAIL = IVFAIL + 1 02420363 + RVCORR = 6.0 02430363 + WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR 02440363 + 0101 CONTINUE 02450363 +CT011* TEST 11 02460363 + IVTNUM = 11 02470363 + RJBVS = 4.5 02480363 + RJAVS = AINT(RJBVS) ** 0.5 02490363 + IF (RJAVS - 1.9999) 20110, 10110, 40110 02500363 +40110 IF (RJAVS - 2.0001) 10110, 10110, 20110 02510363 +10110 IVPASS = IVPASS + 1 02520363 + WRITE (NUVI, 80002) IVTNUM 02530363 + GO TO 0111 02540363 +20110 IVFAIL = IVFAIL + 1 02550363 + RVCORR = 2.0 02560363 + WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR 02570363 + 0111 CONTINUE 02580363 +CT012* TEST 12 02590363 + IVTNUM = 12 02600363 + RJBVS = 2.8 02610363 + RJDVS = 2.2 02620363 + RJAVS = 1.5 * ANINT(RJBVS) + 6.6 / ABS(RJDVS) 02630363 + IF (RJAVS - 7.4996 ) 20120, 10120, 40120 02640363 +40120 IF (RJAVS - 7.5004 ) 10120, 10120, 20120 02650363 +10120 IVPASS = IVPASS + 1 02660363 + WRITE (NUVI, 80002) IVTNUM 02670363 + GO TO 0121 02680363 +20120 IVFAIL = IVFAIL + 1 02690363 + RVCORR = 7.5 02700363 + WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR 02710363 + 0121 CONTINUE 02720363 +CT013* TEST 13 02730363 + IVTNUM = 13 02740363 + RJBVS = 4.5 02750363 + RJDVS = 2.2 02760363 + IJBVI = -5 02770363 + IJDVI = 5 02780363 + RJAVS = (AMOD(RJBVS, RJDVS) + 1.4) * (ISIGN(IJBVI, IJDVI) - 3.0)02790363 + IF (RJAVS - 2.9998) 20130, 10130, 40130 02800363 +40130 IF (RJAVS - 3.0002) 10130, 10130, 20130 02810363 +10130 IVPASS = IVPASS + 1 02820363 + WRITE (NUVI, 80002) IVTNUM 02830363 + GO TO 0131 02840363 +20130 IVFAIL = IVFAIL + 1 02850363 + RVCORR = 3.0 02860363 + WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR 02870363 + 0131 CONTINUE 02880363 +CT014* TEST 14 02890363 + IVTNUM = 14 02900363 + RJBVS = 6.2 02910363 + RJDVS = 5.2 02920363 + IJBVI = 2 02930363 + IJDVI = 3 02940363 + RJEVS = 2.0 02950363 + RJFVS = 3.0 02960363 + RJAVS = (DIM(RJBVS, RJDVS) * AMAX0(IJBVI, IJDVI)) ** 02970363 + 1 (AMIN0(IJBVI, IJDVI) - AMIN1(RJEVS, RJFVS)) 02980363 + IF (RJAVS - 0.99995) 20140, 10140, 40140 02990363 +40140 IF (RJAVS - 1.0001) 10140, 10140, 20140 03000363 +10140 IVPASS = IVPASS + 1 03010363 + WRITE (NUVI, 80002) IVTNUM 03020363 + GO TO 0141 03030363 +20140 IVFAIL = IVFAIL + 1 03040363 + RVCORR = 1.0 03050363 + WRITE (NUVI, 80012) IVTNUM, RJAVS, RVCORR 03060363 + 0141 CONTINUE 03070363 +C***** 03080363 +CBB** ********************** BBCSUM0 **********************************03090363 +C**** WRITE OUT TEST SUMMARY 03100363 +C**** 03110363 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03120363 + WRITE (I02, 90004) 03130363 + WRITE (I02, 90014) 03140363 + WRITE (I02, 90004) 03150363 + WRITE (I02, 90020) IVPASS 03160363 + WRITE (I02, 90022) IVFAIL 03170363 + WRITE (I02, 90024) IVDELE 03180363 + WRITE (I02, 90026) IVINSP 03190363 + WRITE (I02, 90028) IVTOTN, IVTOTL 03200363 +CBE** ********************** BBCSUM0 **********************************03210363 +CBB** ********************** BBCFOOT0 **********************************03220363 +C**** WRITE OUT REPORT FOOTINGS 03230363 +C**** 03240363 + WRITE (I02,90016) ZPROG, ZPROG 03250363 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03260363 + WRITE (I02,90019) 03270363 +CBE** ********************** BBCFOOT0 **********************************03280363 +CBB** ********************** BBCFMT0A **********************************03290363 +C**** FORMATS FOR TEST DETAIL LINES 03300363 +C**** 03310363 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03320363 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03330363 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03340363 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03350363 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03360363 + 1I6,/," ",15X,"CORRECT= " ,I6) 03370363 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03380363 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03390363 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03400363 + 1A21,/," ",16X,"CORRECT= " ,A21) 03410363 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03420363 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03430363 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03440363 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03450363 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03460363 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03470363 +80050 FORMAT (" ",48X,A31) 03480363 +CBE** ********************** BBCFMT0A **********************************03490363 +CBB** ********************** BBCFMT0B **********************************03500363 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03510363 +C**** 03520363 +90002 FORMAT ("1") 03530363 +90004 FORMAT (" ") 03540363 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03550363 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03560363 +90008 FORMAT (" ",21X,A13,A17) 03570363 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03580363 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03590363 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03600363 + 1 7X,"REMARKS",24X) 03610363 +90014 FORMAT (" ","----------------------------------------------" , 03620363 + 1 "---------------------------------" ) 03630363 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03640363 +C**** 03650363 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03660363 +C**** 03670363 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03680363 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03690363 + 1 A13) 03700363 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03710363 +C**** 03720363 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03730363 +C**** 03740363 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03750363 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03760363 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03770363 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03780363 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03790363 +CBE** ********************** BBCFMT0B **********************************03800363 +C***** 03810363 +C***** END OF TEST SEGMENT 171 03820363 + STOP 03830363 + END 03840363 + 03850363 diff --git a/Fortran/UnitTests/fcvs21_f95/FM363.reference_output b/Fortran/UnitTests/fcvs21_f95/FM363.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM363.reference_output @@ -0,0 +1,49 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM363BEGIN* TEST RESULTS - FM363 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + X66MX - (171) SUBSET INTRINSIC FUNCTIONS-- + + IN ARITHMETIC EXPRESSIONS + + SUBSET REF. - 15.10, 6.1.4 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 14 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + + ------------------------------------------------------------------------------- + + 14 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 14 OF 14 TESTS EXECUTED + + *FM363END* END OF TEST - FM363 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM364.f b/Fortran/UnitTests/fcvs21_f95/FM364.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM364.f @@ -0,0 +1,417 @@ + PROGRAM FM364 + +C***********************************************************************00010364 +C***** FORTRAN 77 00020364 +C***** FM364 XRMNX - (172) 00030364 +C***** 00040364 +C***********************************************************************00050364 +C***** GENERAL PURPOSE SUBSET REF 00060364 +C***** TESTS THE USE OF MIXED MODE ARITHMETIC 15.10 00070364 +C***** EXPRESSIONS CONTAINING REFERENCES TO THE 15.3 00080364 +C***** INTRINSIC FUNCTIONS 6.1.4 00090364 +C***** 00100364 +C***** GENERAL COMMENTS 00110364 +C***** SEGMENTS TESTING XINT, XREAL, XAINT, XABS, XAMOD, 00120364 +C***** XSIGN, XDIM, XMAX, XMIN ASSUMED WORKING 00130364 +C***** 00140364 +CBB** ********************** BBCCOMNT **********************************00150364 +C**** 00160364 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00170364 +C**** VERSION 2.1 00180364 +C**** 00190364 +C**** 00200364 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00210364 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00220364 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00230364 +C**** BUILDING 225 RM A266 00240364 +C**** GAITHERSBURG, MD 20899 00250364 +C**** 00260364 +C**** 00270364 +C**** 00280364 +CBE** ********************** BBCCOMNT **********************************00290364 +CBB** ********************** BBCINITA **********************************00300364 +C**** SPECIFICATION STATEMENTS 00310364 +C**** 00320364 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330364 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340364 +CBE** ********************** BBCINITA **********************************00350364 +CBB** ********************** BBCINITB **********************************00360364 +C**** INITIALIZE SECTION 00370364 + DATA ZVERS, ZVERSD, ZDATE 00380364 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390364 + DATA ZCOMPL, ZNAME, ZTAPE 00400364 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410364 + DATA ZPROJ, ZTAPED, ZPROG 00420364 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430364 + DATA REMRKS /' '/ 00440364 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450364 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460364 +C**** 00470364 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480364 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490364 +CZ03 ZPROG = 'PROGRAM NAME' 00500364 +CZ04 ZDATE = 'DATE OF TEST' 00510364 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520364 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530364 +CZ07 ZNAME = 'NAME OF USER' 00540364 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00550364 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00560364 +C 00570364 + IVPASS = 0 00580364 + IVFAIL = 0 00590364 + IVDELE = 0 00600364 + IVINSP = 0 00610364 + IVTOTL = 0 00620364 + IVTOTN = 0 00630364 + ICZERO = 0 00640364 +C 00650364 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660364 + I01 = 05 00670364 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680364 + I02 = 06 00690364 +C 00700364 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710364 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720364 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730364 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740364 +C 00750364 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760364 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770364 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780364 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790364 +C 00800364 +CBE** ********************** BBCINITB **********************************00810364 +C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. 00820364 + NUVI = I02 00830364 + IVTOTL = 14 00840364 + ZPROG = 'FM364' 00850364 +C***** 00860364 +CBB** ********************** BBCHED0A **********************************00870364 +C**** 00880364 +C**** WRITE REPORT TITLE 00890364 +C**** 00900364 + WRITE (I02, 90002) 00910364 + WRITE (I02, 90006) 00920364 + WRITE (I02, 90007) 00930364 + WRITE (I02, 90008) ZVERS, ZVERSD 00940364 + WRITE (I02, 90009) ZPROG, ZPROG 00950364 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960364 +CBE** ********************** BBCHED0A **********************************00970364 +C***** HEADER FOR SEGMENT 172 WRITTEN 00980364 + WRITE (NUVI,17201) 00990364 +17201 FORMAT(/" XRMNX - (172) SUBSET INTRINSIC FUNCTIONS" / 01000364 + 1 15X,"IN MIXED MODE EXPRESSIONS" //, 01010364 + 2 " SUBSET REF. - 15.10, 15.3, 6.1.4" ) 01020364 +C***** 01030364 +CBB** ********************** BBCHED0B **********************************01040364 +C**** WRITE DETAIL REPORT HEADERS 01050364 +C**** 01060364 + WRITE (I02,90004) 01070364 + WRITE (I02,90004) 01080364 + WRITE (I02,90013) 01090364 + WRITE (I02,90014) 01100364 + WRITE (I02,90015) IVTOTL 01110364 +CBE** ********************** BBCHED0B **********************************01120364 +CT001* TEST 1 01130364 + IVTNUM = 1 01140364 + RKBVS = 3.2 01150364 + RKDVS = 3.8 01160364 + RKAVS = 3.5 + INT(RKBVS) + IFIX(RKDVS) 01170364 + RKCVS = RKAVS - 9.5 01180364 + IF (RKCVS + .00005) 20010, 10010, 40010 01190364 +40010 IF (RKCVS - .00005) 10010, 10010, 20010 01200364 +10010 IVPASS = IVPASS + 1 01210364 + WRITE (NUVI, 80002) IVTNUM 01220364 + GO TO 0011 01230364 +20010 IVFAIL = IVFAIL + 1 01240364 + RVCORR = 0.0 01250364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 01260364 + 0011 CONTINUE 01270364 +CT002* TEST 2 01280364 + IVTNUM = 2 01290364 + IKBVI = 3 01300364 + IKDVI = 6 01310364 + RKAVS = FLOAT(IKBVI) - 3 + REAL(IKDVI) 01320364 + RKCVS = RKAVS - 6.0 01330364 + IF (RKCVS + .00005) 20020, 10020, 40020 01340364 +40020 IF (RKCVS - .00005) 10020, 10020, 20020 01350364 +10020 IVPASS = IVPASS + 1 01360364 + WRITE (NUVI, 80002) IVTNUM 01370364 + GO TO 0021 01380364 +20020 IVFAIL = IVFAIL + 1 01390364 + RVCORR = 0.0 01400364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 01410364 + 0021 CONTINUE 01420364 +CT003* TEST 3 01430364 + IVTNUM = 3 01440364 + IKAVI = 3 01450364 + RKBVS = 5.25 01460364 + RKAVS = ANINT(RKBVS) * IKAVI 01470364 + RKCVS = RKAVS - 15.0 01480364 + IF (RKCVS + .00005) 20030, 10030, 40030 01490364 +40030 IF (RKCVS - .00005) 10030, 10030, 20030 01500364 +10030 IVPASS = IVPASS + 1 01510364 + WRITE (NUVI, 80002) IVTNUM 01520364 + GO TO 0031 01530364 +20030 IVFAIL = IVFAIL + 1 01540364 + RVCORR = 0.0 01550364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 01560364 + 0031 CONTINUE 01570364 +CT004* TEST 4 01580364 + IVTNUM = 4 01590364 + RKBVS = 5.25 01600364 + RKAVS = AINT(RKBVS) * IKAVI 01610364 + RKCVS = RKAVS - 15.0 01620364 + IF (RKCVS + .00005) 20040, 10040, 40040 01630364 +40040 IF (RKCVS - .00005) 10040, 10040, 20040 01640364 +10040 IVPASS = IVPASS + 1 01650364 + WRITE (NUVI, 80002) IVTNUM 01660364 + GO TO 0041 01670364 +20040 IVFAIL = IVFAIL + 1 01680364 + RVCORR = 0.0 01690364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 01700364 + 0041 CONTINUE 01710364 +CT005* TEST 5 01720364 + IVTNUM = 5 01730364 + RKBVS = -5.5 01740364 + RKAVS = ABS(RKBVS) / 2 01750364 + RKCVS = RKAVS - 2.75 01760364 + IF (RKCVS + .00005) 20050, 10050, 40050 01770364 +40050 IF (RKCVS - .00005) 10050, 10050, 20050 01780364 +10050 IVPASS = IVPASS + 1 01790364 + WRITE (NUVI, 80002) IVTNUM 01800364 + GO TO 0051 01810364 +20050 IVFAIL = IVFAIL + 1 01820364 + RVCORR = 0.0 01830364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 01840364 + 0051 CONTINUE 01850364 +CT006* TEST 6 01860364 + IVTNUM = 6 01870364 + RKDVS = 5.0 01880364 + IKBVI = -5 01890364 + RKAVS = RKDVS / IABS(IKBVI) 01900364 + RKCVS = RKAVS - 1.0 01910364 + IF (RKCVS + .00005) 20060, 10060, 40060 01920364 +40060 IF (RKCVS - .00005) 10060, 10060, 20060 01930364 +10060 IVPASS = IVPASS + 1 01940364 + WRITE (NUVI, 80002) IVTNUM 01950364 + GO TO 0061 01960364 +20060 IVFAIL = IVFAIL + 1 01970364 + RVCORR = 0.0 01980364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 01990364 + 0061 CONTINUE 02000364 +CT007* TEST 7 02010364 + IVTNUM = 7 02020364 + RKDVS = -2.0 02030364 + IKAVI = -2 02040364 + IKBVI = 5 02050364 + IKCVI = 2 02060364 + RKAVS = RKDVS / (IABS(IKAVI) * MOD(IKBVI, IKCVI)) 02070364 + RKCVS = RKAVS + 1.0 02080364 + IF (RKCVS + .00005) 20070, 10070, 40070 02090364 +40070 IF (RKCVS - .00005) 10070, 10070, 20070 02100364 +10070 IVPASS = IVPASS + 1 02110364 + WRITE (NUVI, 80002) IVTNUM 02120364 + GO TO 0071 02130364 +20070 IVFAIL = IVFAIL + 1 02140364 + RVCORR = 0.0 02150364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 02160364 + 0071 CONTINUE 02170364 +CT008* TEST 8 02180364 + IVTNUM = 8 02190364 + IKAVI = -2 02200364 + IKBVI = 2 02210364 + RKAVS = 3 * ISIGN(IKAVI, IKBVI) 02220364 + RKCVS = RKAVS - 6.0 02230364 + IF (RKCVS + .00005) 20080, 10080, 40080 02240364 +40080 IF (RKCVS - .00005) 10080, 10080, 20080 02250364 +10080 IVPASS = IVPASS + 1 02260364 + WRITE (NUVI, 80002) IVTNUM 02270364 + GO TO 0081 02280364 +20080 IVFAIL = IVFAIL + 1 02290364 + RVCORR = 0.0 02300364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 02310364 + 0081 CONTINUE 02320364 +CT009* TEST 9 02330364 + IVTNUM = 9 02340364 + RKBVS = 5.25 02350364 + RKDVS = 3.25 02360364 + RKEVS = 2.25 02370364 + RKAVS = AMOD(RKBVS, RKDVS) * NINT(RKEVS) 02380364 + RKCVS = RKAVS - 4.0 02390364 + IF (RKCVS + .00005) 20090, 10090, 40090 02400364 +40090 IF (RKCVS - .00005) 10090, 10090, 20090 02410364 +10090 IVPASS = IVPASS + 1 02420364 + WRITE (NUVI, 80002) IVTNUM 02430364 + GO TO 0091 02440364 +20090 IVFAIL = IVFAIL + 1 02450364 + RVCORR = 0.0 02460364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 02470364 + 0091 CONTINUE 02480364 +CT010* TEST 10 02490364 + IVTNUM = 10 02500364 + IKAVI = 2 02510364 + RKDVS = -4.5 02520364 + RKBVS = 1.0 02530364 + RKAVS = (IKAVI + SIGN(RKDVS, RKBVS)) * 1.5 02540364 + RKCVS = RKAVS - 9.75 02550364 + IF (RKCVS + .00005) 20100, 10100, 40100 02560364 +40100 IF (RKCVS - .00005) 10100, 10100, 20100 02570364 +10100 IVPASS = IVPASS + 1 02580364 + WRITE (NUVI, 80002) IVTNUM 02590364 + GO TO 0101 02600364 +20100 IVFAIL = IVFAIL + 1 02610364 + RVCORR = 0.0 02620364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 02630364 + 0101 CONTINUE 02640364 +CT011* TEST 11 02650364 + RKDVS = 6.0 02660364 + IKAVI = 5 02670364 + IKBVI = 2 02680364 + IKCVI = 1 02690364 + RKAVS = (IDIM(IKAVI, IKBVI) / RKDVS) ** MAX0(IKCVI, IKBVI) 02700364 + RKCVS = RKAVS - 0.25 02710364 + IF (RKCVS + .00005) 20110, 10110, 40110 02720364 +40110 IF (RKCVS - .00005) 10110, 10110, 20110 02730364 +10110 IVPASS = IVPASS + 1 02740364 + WRITE (NUVI, 80002) IVTNUM 02750364 + GO TO 0111 02760364 +20110 IVFAIL = IVFAIL + 1 02770364 + RVCORR = 0.0 02780364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 02790364 + 0111 CONTINUE 02800364 +CT012* TEST 12 02810364 + IVTNUM = 12 02820364 + IKAVI = 12 02830364 + RKBVS = 5.5 02840364 + RKDVS = 3.25 02850364 + IKBVI = 2 02860364 + IKCVI = 3 02870364 + RKAVS = 2 * DIM(RKBVS, RKDVS) + AMAX0(IKBVI, IKCVI) / IKAVI 02880364 + RKCVS = RKAVS - 4.75 02890364 + IF (RKCVS + .00005) 20120, 10120, 40120 02900364 +40120 IF (RKCVS - .00005) 10120, 10120, 20120 02910364 +10120 IVPASS = IVPASS + 1 02920364 + WRITE (NUVI, 80002) IVTNUM 02930364 + GO TO 0121 02940364 +20120 IVFAIL = IVFAIL + 1 02950364 + RVCORR = 0.0 02960364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 02970364 + 0121 CONTINUE 02980364 +CT013* TEST 13 02990364 + IVTNUM = 13 03000364 + IKAVI = 5 03010364 + RKBVS = 4.5 03020364 + RKDVS = 3.5 03030364 + IKBVI = 2 03040364 + IKCVI = 3 03050364 + RKAVS = (AMAX1(RKBVS, RKDVS) * MIN0(IKBVI, IKCVI)) + (IKAVI - 03060364 + 1 ANINT(RKDVS)) 03070364 + RKCVS = RKAVS - 10.0 03080364 + IF (RKCVS + .00005) 20130, 10130, 40130 03090364 +40130 IF (RKCVS - .00005) 10130, 10130, 20130 03100364 +10130 IVPASS = IVPASS + 1 03110364 + WRITE (NUVI, 80002) IVTNUM 03120364 + GO TO 0131 03130364 +20130 IVFAIL = IVFAIL + 1 03140364 + RVCORR = 0.0 03150364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 03160364 + 0131 CONTINUE 03170364 +CT014* TEST 14 03180364 + IVTNUM = 14 03190364 + IKAVI = 2 03200364 + RKBVS = 4.5 03210364 + RKDVS = 3.5 03220364 + RKEVS = 2.5 03230364 + RKFVS = 1.5 03240364 + IKBVI = 5 03250364 + IKCVI = 2 03260364 + RKAVS = (FLOAT(MAX1(RKBVS, RKDVS)) ** (AMIN1(RKEVS, RKDVS) - 03270364 + 1 IKAVI) + AMIN0(IKBVI, IKCVI)) / MIN1(RKFVS, RKEVS) 03280364 + RKCVS = RKAVS - 4.0 03290364 + IF (RKCVS + .00005) 20140, 10140, 40140 03300364 +40140 IF (RKCVS - .00005) 10140, 10140, 20140 03310364 +10140 IVPASS = IVPASS + 1 03320364 + WRITE (NUVI, 80002) IVTNUM 03330364 + GO TO 0141 03340364 +20140 IVFAIL = IVFAIL + 1 03350364 + RVCORR = 0.0 03360364 + WRITE (NUVI, 80012) IVTNUM, RKCVS, RVCORR 03370364 + 0141 CONTINUE 03380364 +C***** 03390364 +CBB** ********************** BBCSUM0 **********************************03400364 +C**** WRITE OUT TEST SUMMARY 03410364 +C**** 03420364 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03430364 + WRITE (I02, 90004) 03440364 + WRITE (I02, 90014) 03450364 + WRITE (I02, 90004) 03460364 + WRITE (I02, 90020) IVPASS 03470364 + WRITE (I02, 90022) IVFAIL 03480364 + WRITE (I02, 90024) IVDELE 03490364 + WRITE (I02, 90026) IVINSP 03500364 + WRITE (I02, 90028) IVTOTN, IVTOTL 03510364 +CBE** ********************** BBCSUM0 **********************************03520364 +CBB** ********************** BBCFOOT0 **********************************03530364 +C**** WRITE OUT REPORT FOOTINGS 03540364 +C**** 03550364 + WRITE (I02,90016) ZPROG, ZPROG 03560364 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03570364 + WRITE (I02,90019) 03580364 +CBE** ********************** BBCFOOT0 **********************************03590364 +CBB** ********************** BBCFMT0A **********************************03600364 +C**** FORMATS FOR TEST DETAIL LINES 03610364 +C**** 03620364 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03630364 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03640364 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03650364 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03660364 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03670364 + 1I6,/," ",15X,"CORRECT= " ,I6) 03680364 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03690364 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03700364 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03710364 + 1A21,/," ",16X,"CORRECT= " ,A21) 03720364 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03730364 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03740364 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03750364 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03760364 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03770364 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03780364 +80050 FORMAT (" ",48X,A31) 03790364 +CBE** ********************** BBCFMT0A **********************************03800364 +CBB** ********************** BBCFMT0B **********************************03810364 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03820364 +C**** 03830364 +90002 FORMAT ("1") 03840364 +90004 FORMAT (" ") 03850364 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03860364 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03870364 +90008 FORMAT (" ",21X,A13,A17) 03880364 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03890364 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03900364 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03910364 + 1 7X,"REMARKS",24X) 03920364 +90014 FORMAT (" ","----------------------------------------------" , 03930364 + 1 "---------------------------------" ) 03940364 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03950364 +C**** 03960364 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03970364 +C**** 03980364 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03990364 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04000364 + 1 A13) 04010364 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04020364 +C**** 04030364 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04040364 +C**** 04050364 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04060364 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04070364 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04080364 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04090364 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04100364 +CBE** ********************** BBCFMT0B **********************************04110364 +C***** 04120364 +C***** END OF TEST SEGMENT 172 04130364 + STOP 04140364 + END 04150364 diff --git a/Fortran/UnitTests/fcvs21_f95/FM364.reference_output b/Fortran/UnitTests/fcvs21_f95/FM364.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM364.reference_output @@ -0,0 +1,47 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM364BEGIN* TEST RESULTS - FM364 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XRMNX - (172) SUBSET INTRINSIC FUNCTIONS + IN MIXED MODE EXPRESSIONS + + SUBSET REF. - 15.10, 15.3, 6.1.4 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 14 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 10 PASS + 12 PASS + 13 PASS + 14 PASS + + ------------------------------------------------------------------------------- + + 14 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 14 OF 14 TESTS EXECUTED + + *FM364END* END OF TEST - FM364 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM368.f b/Fortran/UnitTests/fcvs21_f95/FM368.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM368.f @@ -0,0 +1,348 @@ + PROGRAM FM368 + +C***********************************************************************00010368 +C***** FORTRAN 77 00020368 +C***** FM368 00030368 +C***** XSQRT - (175) 00040368 +C***** 00050368 +C***********************************************************************00060368 +C***** GENERAL PURPOSE SUBSET REF 00070368 +C***** TEST INTRINSIC FUNCTION SQRT 15.3 00080368 +C***** TABLE 5 00090368 +C***** 00100368 +CBB** ********************** BBCCOMNT **********************************00110368 +C**** 00120368 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130368 +C**** VERSION 2.1 00140368 +C**** 00150368 +C**** 00160368 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170368 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180368 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190368 +C**** BUILDING 225 RM A266 00200368 +C**** GAITHERSBURG, MD 20899 00210368 +C**** 00220368 +C**** 00230368 +C**** 00240368 +CBE** ********************** BBCCOMNT **********************************00250368 +CBB** ********************** BBCINITA **********************************00260368 +C**** SPECIFICATION STATEMENTS 00270368 +C**** 00280368 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290368 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300368 +CBE** ********************** BBCINITA **********************************00310368 +CBB** ********************** BBCINITB **********************************00320368 +C**** INITIALIZE SECTION 00330368 + DATA ZVERS, ZVERSD, ZDATE 00340368 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350368 + DATA ZCOMPL, ZNAME, ZTAPE 00360368 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370368 + DATA ZPROJ, ZTAPED, ZPROG 00380368 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390368 + DATA REMRKS /' '/ 00400368 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410368 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420368 +C**** 00430368 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440368 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450368 +CZ03 ZPROG = 'PROGRAM NAME' 00460368 +CZ04 ZDATE = 'DATE OF TEST' 00470368 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480368 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490368 +CZ07 ZNAME = 'NAME OF USER' 00500368 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510368 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520368 +C 00530368 + IVPASS = 0 00540368 + IVFAIL = 0 00550368 + IVDELE = 0 00560368 + IVINSP = 0 00570368 + IVTOTL = 0 00580368 + IVTOTN = 0 00590368 + ICZERO = 0 00600368 +C 00610368 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620368 + I01 = 05 00630368 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640368 + I02 = 06 00650368 +C 00660368 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670368 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680368 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690368 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700368 +C 00710368 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720368 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730368 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740368 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750368 +C 00760368 +CBE** ********************** BBCINITB **********************************00770368 + NUVI = I02 00780368 + IVTOTL = 13 00790368 + ZPROG = 'FM368' 00800368 +CBB** ********************** BBCHED0A **********************************00810368 +C**** 00820368 +C**** WRITE REPORT TITLE 00830368 +C**** 00840368 + WRITE (I02, 90002) 00850368 + WRITE (I02, 90006) 00860368 + WRITE (I02, 90007) 00870368 + WRITE (I02, 90008) ZVERS, ZVERSD 00880368 + WRITE (I02, 90009) ZPROG, ZPROG 00890368 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900368 +CBE** ********************** BBCHED0A **********************************00910368 +C***** 00920368 +C***** HEADER FOR SEGMENT 175 00930368 + WRITE(NUVI,17500) 00940368 +17500 FORMAT(" ", / " XSQRT - (175) INTRINSIC FUNCTIONS" // 00950368 + 1 " SQRT (SQUARE ROOT)" // 00960368 + 2 " SUBSET REF. - 15.3" ) 00970368 +CBB** ********************** BBCHED0B **********************************00980368 +C**** WRITE DETAIL REPORT HEADERS 00990368 +C**** 01000368 + WRITE (I02,90004) 01010368 + WRITE (I02,90004) 01020368 + WRITE (I02,90013) 01030368 + WRITE (I02,90014) 01040368 + WRITE (I02,90015) IVTOTL 01050368 +CBE** ********************** BBCHED0B **********************************01060368 +C***** 01070368 +CT001* TEST 1 FIXED POINT OF FUNCTION 01080368 + IVTNUM = 1 01090368 + BVS = 0.0 01100368 + AVS = SQRT(BVS) 01110368 + IF (AVS + 0.50000E-04) 20010, 10010, 40010 01120368 +40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010 01130368 +10010 IVPASS = IVPASS + 1 01140368 + WRITE (NUVI, 80002) IVTNUM 01150368 + GO TO 0011 01160368 +20010 IVFAIL = IVFAIL + 1 01170368 + RVCORR = 0.00000000000000 01180368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01190368 + 0011 CONTINUE 01200368 +CT002* TEST 2 FIXED POINT OF FUNCTION 01210368 + IVTNUM = 2 01220368 + AVS = SQRT(1.0) 01230368 + IF (AVS - 0.99995E+00) 20020, 10020, 40020 01240368 +40020 IF (AVS - 0.10001E+01) 10020, 10020, 20020 01250368 +10020 IVPASS = IVPASS + 1 01260368 + WRITE (NUVI, 80002) IVTNUM 01270368 + GO TO 0021 01280368 +20020 IVFAIL = IVFAIL + 1 01290368 + RVCORR = 1.00000000000000 01300368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01310368 + 0021 CONTINUE 01320368 +CT003* TEST 3 01330368 + IVTNUM = 3 01340368 + AVS = SQRT(2.0) 01350368 + IF (AVS - 0.14141E+01) 20030, 10030, 40030 01360368 +40030 IF (AVS - 0.14143E+01) 10030, 10030, 20030 01370368 +10030 IVPASS = IVPASS + 1 01380368 + WRITE (NUVI, 80002) IVTNUM 01390368 + GO TO 0031 01400368 +20030 IVFAIL = IVFAIL + 1 01410368 + RVCORR = 1.41421356237310 01420368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01430368 + 0031 CONTINUE 01440368 +CT004* TEST 4 01450368 + IVTNUM = 4 01460368 + AVS = SQRT(4.0) 01470368 + IF (AVS - 0.19999E+01) 20040, 10040, 40040 01480368 +40040 IF (AVS - 0.20001E+01) 10040, 10040, 20040 01490368 +10040 IVPASS = IVPASS + 1 01500368 + WRITE (NUVI, 80002) IVTNUM 01510368 + GO TO 0041 01520368 +20040 IVFAIL = IVFAIL + 1 01530368 + RVCORR = 2.00000000000000 01540368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01550368 + 0041 CONTINUE 01560368 +CT005* TEST 5 01570368 + IVTNUM = 5 01580368 + AVS = SQRT(15.0) 01590368 + IF (AVS - 0.38727E+01) 20050, 10050, 40050 01600368 +40050 IF (AVS - 0.38732E+01) 10050, 10050, 20050 01610368 +10050 IVPASS = IVPASS + 1 01620368 + WRITE (NUVI, 80002) IVTNUM 01630368 + GO TO 0051 01640368 +20050 IVFAIL = IVFAIL + 1 01650368 + RVCORR = 3.87298334620742 01660368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01670368 + 0051 CONTINUE 01680368 +CT006* TEST 6 01690368 + IVTNUM = 6 01700368 + AVS = SQRT(31.0) 01710368 + IF (AVS - 0.55674E+01) 20060, 10060, 40060 01720368 +40060 IF (AVS - 0.55681E+01) 10060, 10060, 20060 01730368 +10060 IVPASS = IVPASS + 1 01740368 + WRITE (NUVI, 80002) IVTNUM 01750368 + GO TO 0061 01760368 +20060 IVFAIL = IVFAIL + 1 01770368 + RVCORR = 5.56776436283002 01780368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01790368 + 0061 CONTINUE 01800368 +CT007* TEST 7 01810368 + IVTNUM = 7 01820368 + BVS = 2.0/4.0 01830368 + AVS = SQRT(BVS) 01840368 + IF (AVS - 0.70707E+00) 20070, 10070, 40070 01850368 +40070 IF (AVS - 0.70715E+00) 10070, 10070, 20070 01860368 +10070 IVPASS = IVPASS + 1 01870368 + WRITE (NUVI, 80002) IVTNUM 01880368 + GO TO 0071 01890368 +20070 IVFAIL = IVFAIL + 1 01900368 + RVCORR = 0.70710678118655 01910368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01920368 + 0071 CONTINUE 01930368 +CT008* TEST 8 01940368 + IVTNUM = 8 01950368 + BVS = 25.0 01960368 + AVS = SQRT(BVS/100.0) 01970368 + IF (AVS - 0.49997E+00) 20080, 10080, 40080 01980368 +40080 IF (AVS - 0.50003E+00) 10080, 10080, 20080 01990368 +10080 IVPASS = IVPASS + 1 02000368 + WRITE (NUVI, 80002) IVTNUM 02010368 + GO TO 0081 02020368 +20080 IVFAIL = IVFAIL + 1 02030368 + RVCORR = 0.50000000000000 02040368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02050368 + 0081 CONTINUE 02060368 +CT009* TEST 9 02070368 + IVTNUM = 9 02080368 + BVS = 0.0875 02090368 + AVS = SQRT(BVS * 10.0) 02100368 + IF (AVS - 0.93536E+00) 20090, 10090, 40090 02110368 +40090 IF (AVS - 0.93546E+00) 10090, 10090, 20090 02120368 +10090 IVPASS = IVPASS + 1 02130368 + WRITE (NUVI, 80002) IVTNUM 02140368 + GO TO 0091 02150368 +20090 IVFAIL = IVFAIL + 1 02160368 + RVCORR = 0.93541434669349 02170368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02180368 + 0091 CONTINUE 02190368 +CT010* TEST 10 02200368 + IVTNUM = 10 02210368 + AVS = SQRT(31.0/32.0) 02220368 + IF (AVS - 0.98420E+00) 20100, 10100, 40100 02230368 +40100 IF (AVS - 0.98430E+00) 10100, 10100, 20100 02240368 +10100 IVPASS = IVPASS + 1 02250368 + WRITE (NUVI, 80002) IVTNUM 02260368 + GO TO 0101 02270368 +20100 IVFAIL = IVFAIL + 1 02280368 + RVCORR = 0.98425098425148 02290368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02300368 + 0101 CONTINUE 02310368 +CT011* TEST 11 AN ARGUMENT OF LOW MAGNITUDE 02320368 + IVTNUM = 11 02330368 + AVS = SQRT(1.6E-35) 02340368 + IF (AVS - 0.39998E-17) 20110, 10110, 40110 02350368 +40110 IF (AVS - 0.40002E-17) 10110, 10110, 20110 02360368 +10110 IVPASS = IVPASS + 1 02370368 + WRITE (NUVI, 80002) IVTNUM 02380368 + GO TO 0111 02390368 +20110 IVFAIL = IVFAIL + 1 02400368 + RVCORR = 0.40000000000000E-17 02410368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02420368 + 0111 CONTINUE 02430368 +CT012* TEST 12 AN ARGUMENT OF HIGH MAGNITUDE 02440368 + IVTNUM = 12 02450368 + AVS = SQRT(1.0E+35) 02460368 + IF (AVS - 0.31621E+18) 20120, 10120, 40120 02470368 +40120 IF (AVS - 0.31625E+18) 10120, 10120, 20120 02480368 +10120 IVPASS = IVPASS + 1 02490368 + WRITE (NUVI, 80002) IVTNUM 02500368 + GO TO 0121 02510368 +20120 IVFAIL = IVFAIL + 1 02520368 + RVCORR = 0.31622776601684E+18 02530368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02540368 + 0121 CONTINUE 02550368 +CT013* TEST 13 02560368 + IVTNUM = 13 02570368 + BVS = SQRT(1.6) 02580368 + AVS = SQRT(0.625) * BVS 02590368 + IF (AVS - 0.99995E+00) 20130, 10130, 40130 02600368 +40130 IF (AVS - 0.10001E+01) 10130, 10130, 20130 02610368 +10130 IVPASS = IVPASS + 1 02620368 + WRITE (NUVI, 80002) IVTNUM 02630368 + GO TO 0131 02640368 +20130 IVFAIL = IVFAIL + 1 02650368 + RVCORR = 1.0000000 02660368 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02670368 + 0131 CONTINUE 02680368 +C***** 02690368 +CBB** ********************** BBCSUM0 **********************************02700368 +C**** WRITE OUT TEST SUMMARY 02710368 +C**** 02720368 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02730368 + WRITE (I02, 90004) 02740368 + WRITE (I02, 90014) 02750368 + WRITE (I02, 90004) 02760368 + WRITE (I02, 90020) IVPASS 02770368 + WRITE (I02, 90022) IVFAIL 02780368 + WRITE (I02, 90024) IVDELE 02790368 + WRITE (I02, 90026) IVINSP 02800368 + WRITE (I02, 90028) IVTOTN, IVTOTL 02810368 +CBE** ********************** BBCSUM0 **********************************02820368 +CBB** ********************** BBCFOOT0 **********************************02830368 +C**** WRITE OUT REPORT FOOTINGS 02840368 +C**** 02850368 + WRITE (I02,90016) ZPROG, ZPROG 02860368 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02870368 + WRITE (I02,90019) 02880368 +CBE** ********************** BBCFOOT0 **********************************02890368 +CBB** ********************** BBCFMT0A **********************************02900368 +C**** FORMATS FOR TEST DETAIL LINES 02910368 +C**** 02920368 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02930368 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02940368 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02950368 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02960368 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02970368 + 1I6,/," ",15X,"CORRECT= " ,I6) 02980368 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02990368 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03000368 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03010368 + 1A21,/," ",16X,"CORRECT= " ,A21) 03020368 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03030368 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03040368 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03050368 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03060368 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03070368 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03080368 +80050 FORMAT (" ",48X,A31) 03090368 +CBE** ********************** BBCFMT0A **********************************03100368 +CBB** ********************** BBCFMT0B **********************************03110368 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03120368 +C**** 03130368 +90002 FORMAT ("1") 03140368 +90004 FORMAT (" ") 03150368 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03160368 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03170368 +90008 FORMAT (" ",21X,A13,A17) 03180368 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03190368 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03200368 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03210368 + 1 7X,"REMARKS",24X) 03220368 +90014 FORMAT (" ","----------------------------------------------" , 03230368 + 1 "---------------------------------" ) 03240368 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03250368 +C**** 03260368 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03270368 +C**** 03280368 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03290368 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03300368 + 1 A13) 03310368 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03320368 +C**** 03330368 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03340368 +C**** 03350368 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03360368 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03370368 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03380368 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03390368 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03400368 +CBE** ********************** BBCFMT0B **********************************03410368 +C***** 03420368 +C***** END OF TEST SEGMENT 175 03430368 + STOP 03440368 + END 03450368 + 03460368 diff --git a/Fortran/UnitTests/fcvs21_f95/FM368.reference_output b/Fortran/UnitTests/fcvs21_f95/FM368.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM368.reference_output @@ -0,0 +1,47 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM368BEGIN* TEST RESULTS - FM368 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XSQRT - (175) INTRINSIC FUNCTIONS + + SQRT (SQUARE ROOT) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 13 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + + ------------------------------------------------------------------------------- + + 13 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 13 OF 13 TESTS EXECUTED + + *FM368END* END OF TEST - FM368 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM369.f b/Fortran/UnitTests/fcvs21_f95/FM369.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM369.f @@ -0,0 +1,435 @@ + PROGRAM FM369 + +C***********************************************************************00010369 +C***** FORTRAN 77 00020369 +C***** FM369 00030369 +C***** XEXP - (178) 00040369 +C***** 00050369 +C***********************************************************************00060369 +C***** GENERAL PURPOSE SUBSET REF 00070369 +C***** TEST INTRINSIC FUNCTION EXP 15.3 00080369 +C***** TABLE 5 00090369 +C***** 00100369 +CBB** ********************** BBCCOMNT **********************************00110369 +C**** 00120369 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130369 +C**** VERSION 2.1 00140369 +C**** 00150369 +C**** 00160369 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170369 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180369 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190369 +C**** BUILDING 225 RM A266 00200369 +C**** GAITHERSBURG, MD 20899 00210369 +C**** 00220369 +C**** 00230369 +C**** 00240369 +CBE** ********************** BBCCOMNT **********************************00250369 +CBB** ********************** BBCINITA **********************************00260369 +C**** SPECIFICATION STATEMENTS 00270369 +C**** 00280369 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290369 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300369 +CBE** ********************** BBCINITA **********************************00310369 +CBB** ********************** BBCINITB **********************************00320369 +C**** INITIALIZE SECTION 00330369 + DATA ZVERS, ZVERSD, ZDATE 00340369 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350369 + DATA ZCOMPL, ZNAME, ZTAPE 00360369 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370369 + DATA ZPROJ, ZTAPED, ZPROG 00380369 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390369 + DATA REMRKS /' '/ 00400369 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410369 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420369 +C**** 00430369 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440369 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450369 +CZ03 ZPROG = 'PROGRAM NAME' 00460369 +CZ04 ZDATE = 'DATE OF TEST' 00470369 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480369 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490369 +CZ07 ZNAME = 'NAME OF USER' 00500369 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510369 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520369 +C 00530369 + IVPASS = 0 00540369 + IVFAIL = 0 00550369 + IVDELE = 0 00560369 + IVINSP = 0 00570369 + IVTOTL = 0 00580369 + IVTOTN = 0 00590369 + ICZERO = 0 00600369 +C 00610369 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620369 + I01 = 05 00630369 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640369 + I02 = 06 00650369 +C 00660369 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670369 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680369 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690369 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700369 +C 00710369 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720369 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730369 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740369 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750369 +C 00760369 +CBE** ********************** BBCINITB **********************************00770369 + NUVI = I02 00780369 + IVTOTL = 19 00790369 + ZPROG = 'FM369' 00800369 +CBB** ********************** BBCHED0A **********************************00810369 +C**** 00820369 +C**** WRITE REPORT TITLE 00830369 +C**** 00840369 + WRITE (I02, 90002) 00850369 + WRITE (I02, 90006) 00860369 + WRITE (I02, 90007) 00870369 + WRITE (I02, 90008) ZVERS, ZVERSD 00880369 + WRITE (I02, 90009) ZPROG, ZPROG 00890369 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900369 +CBE** ********************** BBCHED0A **********************************00910369 +C***** 00920369 +C***** HEADER FOR SEGMENT 178 00930369 + WRITE(NUVI,17800) 00940369 +17800 FORMAT(" ", / " XEXP - (178) INTRINSIC FUNCTIONS" // 00950369 + 1 " EXP (EXPONENTIAL)" // 00960369 + 2 " SUBSET REF. - 15.3" ) 00970369 +CBB** ********************** BBCHED0B **********************************00980369 +C**** WRITE DETAIL REPORT HEADERS 00990369 +C**** 01000369 + WRITE (I02,90004) 01010369 + WRITE (I02,90004) 01020369 + WRITE (I02,90013) 01030369 + WRITE (I02,90014) 01040369 + WRITE (I02,90015) IVTOTL 01050369 +CBE** ********************** BBCHED0B **********************************01060369 +C***** 01070369 +CT001* TEST 1 ZERO SINCE EXP(0.0) = 1 01080369 + IVTNUM = 1 01090369 + BVS = 0.0 01100369 + AVS = EXP(BVS) 01110369 + IF (AVS - 0.99995E+00) 20010, 10010, 40010 01120369 +40010 IF (AVS - 0.10001E+01) 10010, 10010, 20010 01130369 +10010 IVPASS = IVPASS + 1 01140369 + WRITE (NUVI, 80002) IVTNUM 01150369 + GO TO 0011 01160369 +20010 IVFAIL = IVFAIL + 1 01170369 + RVCORR = 0.10000000000000E+01 01180369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01190369 + 0011 CONTINUE 01200369 +CT002* TEST 2 ONE SINCE EXP(1.0) = E 01210369 + IVTNUM = 2 01220369 + AVS = EXP(1.0) 01230369 + IF (AVS - 0.27181E+01) 20020, 10020, 40020 01240369 +40020 IF (AVS - 0.27185E+01) 10020, 10020, 20020 01250369 +10020 IVPASS = IVPASS + 1 01260369 + WRITE (NUVI, 80002) IVTNUM 01270369 + GO TO 0021 01280369 +20020 IVFAIL = IVFAIL + 1 01290369 + RVCORR = 0.27182818284590E+01 01300369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01310369 + 0021 CONTINUE 01320369 +C***** TESTS 3 THRU 5 - POSITIVE VALUES 01330369 +CT003* TEST 3 01340369 + IVTNUM = 3 01350369 + AVS = EXP(2.0) 01360369 + IF (AVS - 0.73886E+01) 20030, 10030, 40030 01370369 +40030 IF (AVS - 0.73895E+01) 10030, 10030, 20030 01380369 +10030 IVPASS = IVPASS + 1 01390369 + WRITE (NUVI, 80002) IVTNUM 01400369 + GO TO 0031 01410369 +20030 IVFAIL = IVFAIL + 1 01420369 + RVCORR = 0.73890560989307E+01 01430369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01440369 + 0031 CONTINUE 01450369 +CT004* TEST 4 01460369 + IVTNUM = 4 01470369 + AVS = EXP(5.125) 01480369 + IF (AVS - 0.16816E+03) 20040, 10040, 40040 01490369 +40040 IF (AVS - 0.16819E+03) 10040, 10040, 20040 01500369 +10040 IVPASS = IVPASS + 1 01510369 + WRITE (NUVI, 80002) IVTNUM 01520369 + GO TO 0041 01530369 +20040 IVFAIL = IVFAIL + 1 01540369 + RVCORR = 0.16817414165185E+03 01550369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01560369 + 0041 CONTINUE 01570369 +CT005* TEST 5 01580369 + IVTNUM = 5 01590369 + AVS = EXP(15.0) 01600369 + IF (AVS - 0.32688E+07) 20050, 10050, 40050 01610369 +40050 IF (AVS - 0.32692E+07) 10050, 10050, 20050 01620369 +10050 IVPASS = IVPASS + 1 01630369 + WRITE (NUVI, 80002) IVTNUM 01640369 + GO TO 0051 01650369 +20050 IVFAIL = IVFAIL + 1 01660369 + RVCORR = 0.32690173724721E+07 01670369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01680369 + 0051 CONTINUE 01690369 +CT006* TEST 6 01700369 + IVTNUM = 6 01710369 + BVS = 20.5 01720369 + AVS = EXP(BVS) 01730369 + IF (AVS - 0.79986E+09) 20060, 10060, 40060 01740369 +40060 IF (AVS - 0.79995E+09) 10060, 10060, 20060 01750369 +10060 IVPASS = IVPASS + 1 01760369 + WRITE (NUVI, 80002) IVTNUM 01770369 + GO TO 0061 01780369 +20060 IVFAIL = IVFAIL + 1 01790369 + RVCORR = 0.79990217747551E+09 01800369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01810369 + 0061 CONTINUE 01820369 +C***** TESTS 7 THRU 10 - EXPRESSION PRESENTED TO EXP 01830369 +CT007* TEST 7 01840369 + IVTNUM = 7 01850369 + BVS = 4.5 01860369 + AVS = EXP(BVS - 7.5) 01870369 + IF (AVS - 0.49784E-01) 20070, 10070, 40070 01880369 +40070 IF (AVS - 0.49790E-01) 10070, 10070, 20070 01890369 +10070 IVPASS = IVPASS + 1 01900369 + WRITE (NUVI, 80002) IVTNUM 01910369 + GO TO 0071 01920369 +20070 IVFAIL = IVFAIL + 1 01930369 + RVCORR = 0.49787068367864E-01 01940369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01950369 + 0071 CONTINUE 01960369 +CT008* TEST 8 01970369 + IVTNUM = 8 01980369 + BVS = 0.25 01990369 + AVS = EXP(BVS - 5.0) 02000369 + IF (AVS - 0.86512E-02) 20080, 10080, 40080 02010369 +40080 IF (AVS - 0.86522E-02) 10080, 10080, 20080 02020369 +10080 IVPASS = IVPASS + 1 02030369 + WRITE (NUVI, 80002) IVTNUM 02040369 + GO TO 0081 02050369 +20080 IVFAIL = IVFAIL + 1 02060369 + RVCORR = 0.86516952031206E-02 02070369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02080369 + 0081 CONTINUE 02090369 +CT009* TEST 9 02100369 + IVTNUM = 9 02110369 + AVS = EXP(0.5 * (-20.0)) 02120369 + IF (AVS - 0.45397E-04) 20090, 10090, 40090 02130369 +40090 IF (AVS - 0.45403E-04) 10090, 10090, 20090 02140369 +10090 IVPASS = IVPASS + 1 02150369 + WRITE (NUVI, 80002) IVTNUM 02160369 + GO TO 0091 02170369 +20090 IVFAIL = IVFAIL + 1 02180369 + RVCORR = 0.45399929762485E-04 02190369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02200369 + 0091 CONTINUE 02210369 +CT010* TEST 10 02220369 + IVTNUM = 10 02230369 + BVS = 30.5 02240369 + AVS = EXP(BVS * (-0.5)) 02250369 + IF (AVS - 0.23822E-06) 20100, 10100, 40100 02260369 +40100 IF (AVS - 0.23825E-06) 10100, 10100, 20100 02270369 +10100 IVPASS = IVPASS + 1 02280369 + WRITE (NUVI, 80002) IVTNUM 02290369 + GO TO 0101 02300369 +20100 IVFAIL = IVFAIL + 1 02310369 + RVCORR = 0.23823696675018E-06 02320369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02330369 + 0101 CONTINUE 02340369 +C***** TESTS 11 THRU 14 - VALUES CLOSE TO ONE 02350369 +CT011* TEST 11 02360369 + IVTNUM = 11 02370369 + AVS = EXP(0.9921875) 02380369 + IF (AVS - 0.26970E+01) 20110, 10110, 40110 02390369 +40110 IF (AVS - 0.26973E+01) 10110, 10110, 20110 02400369 +10110 IVPASS = IVPASS + 1 02410369 + WRITE (NUVI, 80002) IVTNUM 02420369 + GO TO 0111 02430369 +20110 IVFAIL = IVFAIL + 1 02440369 + RVCORR = 0.26971279914439E+01 02450369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02460369 + 0111 CONTINUE 02470369 +CT012* TEST 12 02480369 + IVTNUM = 12 02490369 + BVS = 0.9990234375 02500369 + AVS = EXP(BVS) 02510369 + IF (AVS - 0.27155E+01) 20120, 10120, 40120 02520369 +40120 IF (AVS - 0.27158E+01) 10120, 10120, 20120 02530369 +10120 IVPASS = IVPASS + 1 02540369 + WRITE (NUVI, 80002) IVTNUM 02550369 + GO TO 0121 02560369 +20120 IVFAIL = IVFAIL + 1 02570369 + RVCORR = 0.27156285521169E+01 02580369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02590369 + 0121 CONTINUE 02600369 +C***** 02610369 +C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS 02620369 + WRITE (NUVI, 90002) 02630369 + WRITE (NUVI, 90013) 02640369 + WRITE (NUVI, 90014) 02650369 +C***** 02660369 +CT013* TEST 13 02670369 + IVTNUM = 13 02680369 + AVS = EXP(1.00390625) 02690369 + IF (AVS - 0.27287E+01) 20130, 10130, 40130 02700369 +40130 IF (AVS - 0.27291E+01) 10130, 10130, 20130 02710369 +10130 IVPASS = IVPASS + 1 02720369 + WRITE (NUVI, 80002) IVTNUM 02730369 + GO TO 0131 02740369 +20130 IVFAIL = IVFAIL + 1 02750369 + RVCORR = 0.27289208827261E+01 02760369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02770369 + 0131 CONTINUE 02780369 +CT014* TEST 14 02790369 + IVTNUM = 14 02800369 + BVS = 1.001953125 02810369 + AVS = EXP(BVS) 02820369 + IF (AVS - 0.27234E+01) 20140, 10140, 40140 02830369 +40140 IF (AVS - 0.27238E+01) 10140, 10140, 20140 02840369 +10140 IVPASS = IVPASS + 1 02850369 + WRITE (NUVI, 80002) IVTNUM 02860369 + GO TO 0141 02870369 +20140 IVFAIL = IVFAIL + 1 02880369 + RVCORR = 0.27235961607435E+01 02890369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02900369 + 0141 CONTINUE 02910369 +C***** TESTS 15 THRU 19 - VALUES CLOSE TO 1/E 02920369 +CT015* TEST 15 02930369 + IVTNUM = 15 02940369 + BVS = 128.0 02950369 + AVS = EXP(44. / BVS) 02960369 + IF (AVS - 0.14101E+01) 20150, 10150, 40150 02970369 +40150 IF (AVS - 0.14103E+01) 10150, 10150, 20150 02980369 +10150 IVPASS = IVPASS + 1 02990369 + WRITE (NUVI, 80002) IVTNUM 03000369 + GO TO 0151 03010369 +20150 IVFAIL = IVFAIL + 1 03020369 + RVCORR = 0.14102260349257E+01 03030369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03040369 + 0151 CONTINUE 03050369 +CT016* TEST 16 03060369 + IVTNUM = 16 03070369 + BVS = 128. 03080369 + AVS = EXP(45. / BVS) 03090369 + IF (AVS - 0.14212E+01) 20160, 10160, 40160 03100369 +40160 IF (AVS - 0.14214E+01) 10160, 10160, 20160 03110369 +10160 IVPASS = IVPASS + 1 03120369 + WRITE (NUVI, 80002) IVTNUM 03130369 + GO TO 0161 03140369 +20160 IVFAIL = IVFAIL + 1 03150369 + RVCORR = 0.14212865748007E+01 03160369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03170369 + 0161 CONTINUE 03180369 +CT017* TEST 17 03190369 + IVTNUM = 17 03200369 + BVS = 128. 03210369 + AVS = EXP(46. / BVS) 03220369 + IF (AVS - 0.14323E+01) 20170, 10170, 40170 03230369 +40170 IF (AVS - 0.14325E+01) 10170, 10170, 20170 03240369 +10170 IVPASS = IVPASS + 1 03250369 + WRITE (NUVI, 80002) IVTNUM 03260369 + GO TO 0171 03270369 +20170 IVFAIL = IVFAIL + 1 03280369 + RVCORR = 0.14324338635651E+01 03290369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03300369 + 0171 CONTINUE 03310369 +CT018* TEST 18 03320369 + IVTNUM = 18 03330369 + BVS = 128. 03340369 + AVS = EXP(47. / BVS) 03350369 + IF (AVS - 0.14436E+01) 20180, 10180, 40180 03360369 +40180 IF (AVS - 0.14438E+01) 10180, 10180, 20180 03370369 +10180 IVPASS = IVPASS + 1 03380369 + WRITE (NUVI, 80002) IVTNUM 03390369 + GO TO 0181 03400369 +20180 IVFAIL = IVFAIL + 1 03410369 + RVCORR = 0.14436685815988E+01 03420369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03430369 + 0181 CONTINUE 03440369 +CT019* TEST 19 03450369 + IVTNUM = 19 03460369 + BVS = 128. 03470369 + AVS = EXP(48. / BVS) 03480369 + IF (AVS - 0.14549E+01) 20190, 10190, 40190 03490369 +40190 IF (AVS - 0.14551E+01) 10190, 10190, 20190 03500369 +10190 IVPASS = IVPASS + 1 03510369 + WRITE (NUVI, 80002) IVTNUM 03520369 + GO TO 0191 03530369 +20190 IVFAIL = IVFAIL + 1 03540369 + RVCORR = 0.14549914146182E+01 03550369 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03560369 + 0191 CONTINUE 03570369 +CBB** ********************** BBCSUM0 **********************************03580369 +C**** WRITE OUT TEST SUMMARY 03590369 +C**** 03600369 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03610369 + WRITE (I02, 90004) 03620369 + WRITE (I02, 90014) 03630369 + WRITE (I02, 90004) 03640369 + WRITE (I02, 90020) IVPASS 03650369 + WRITE (I02, 90022) IVFAIL 03660369 + WRITE (I02, 90024) IVDELE 03670369 + WRITE (I02, 90026) IVINSP 03680369 + WRITE (I02, 90028) IVTOTN, IVTOTL 03690369 +CBE** ********************** BBCSUM0 **********************************03700369 +CBB** ********************** BBCFOOT0 **********************************03710369 +C**** WRITE OUT REPORT FOOTINGS 03720369 +C**** 03730369 + WRITE (I02,90016) ZPROG, ZPROG 03740369 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03750369 + WRITE (I02,90019) 03760369 +CBE** ********************** BBCFOOT0 **********************************03770369 +CBB** ********************** BBCFMT0A **********************************03780369 +C**** FORMATS FOR TEST DETAIL LINES 03790369 +C**** 03800369 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03810369 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03820369 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03830369 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03840369 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03850369 + 1I6,/," ",15X,"CORRECT= " ,I6) 03860369 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03870369 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03880369 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03890369 + 1A21,/," ",16X,"CORRECT= " ,A21) 03900369 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03910369 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03920369 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03930369 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03940369 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03950369 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03960369 +80050 FORMAT (" ",48X,A31) 03970369 +CBE** ********************** BBCFMT0A **********************************03980369 +CBB** ********************** BBCFMT0B **********************************03990369 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04000369 +C**** 04010369 +90002 FORMAT ("1") 04020369 +90004 FORMAT (" ") 04030369 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04040369 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04050369 +90008 FORMAT (" ",21X,A13,A17) 04060369 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04070369 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04080369 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04090369 + 1 7X,"REMARKS",24X) 04100369 +90014 FORMAT (" ","----------------------------------------------" , 04110369 + 1 "---------------------------------" ) 04120369 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04130369 +C**** 04140369 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04150369 +C**** 04160369 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04170369 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04180369 + 1 A13) 04190369 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04200369 +C**** 04210369 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04220369 +C**** 04230369 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04240369 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04250369 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04260369 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04270369 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04280369 +CBE** ********************** BBCFMT0B **********************************04290369 +C***** 04300369 +C***** END OF TEST SEGMENT 178 04310369 + STOP 04320369 + END 04330369 diff --git a/Fortran/UnitTests/fcvs21_f95/FM369.reference_output b/Fortran/UnitTests/fcvs21_f95/FM369.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM369.reference_output @@ -0,0 +1,56 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM369BEGIN* TEST RESULTS - FM369 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XEXP - (178) INTRINSIC FUNCTIONS + + EXP (EXPONENTIAL) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 19 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + + ------------------------------------------------------------------------------- + + 19 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 19 OF 19 TESTS EXECUTED + + *FM369END* END OF TEST - FM369 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM370.f b/Fortran/UnitTests/fcvs21_f95/FM370.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM370.f @@ -0,0 +1,389 @@ + PROGRAM FM370 + +C***********************************************************************00010370 +C***** FORTRAN 77 00020370 +C***** FM370 00030370 +C***** XALOG - (181) 00040370 +C***** 00050370 +C***********************************************************************00060370 +C***** GENERAL PURPOSE SUBSET REF 00070370 +C***** TEST INTRINSIC FUNCTION ALOG 15.3 00080370 +C***** TABLE 5 00090370 +C***** 00100370 +C***** 00110370 +CBB** ********************** BBCCOMNT **********************************00120370 +C**** 00130370 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140370 +C**** VERSION 2.1 00150370 +C**** 00160370 +C**** 00170370 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180370 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00190370 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00200370 +C**** BUILDING 225 RM A266 00210370 +C**** GAITHERSBURG, MD 20899 00220370 +C**** 00230370 +C**** 00240370 +C**** 00250370 +CBE** ********************** BBCCOMNT **********************************00260370 +CBB** ********************** BBCINITA **********************************00270370 +C**** SPECIFICATION STATEMENTS 00280370 +C**** 00290370 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00300370 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00310370 +CBE** ********************** BBCINITA **********************************00320370 +CBB** ********************** BBCINITB **********************************00330370 +C**** INITIALIZE SECTION 00340370 + DATA ZVERS, ZVERSD, ZDATE 00350370 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00360370 + DATA ZCOMPL, ZNAME, ZTAPE 00370370 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00380370 + DATA ZPROJ, ZTAPED, ZPROG 00390370 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00400370 + DATA REMRKS /' '/ 00410370 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00420370 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00430370 +C**** 00440370 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00450370 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00460370 +CZ03 ZPROG = 'PROGRAM NAME' 00470370 +CZ04 ZDATE = 'DATE OF TEST' 00480370 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00490370 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00500370 +CZ07 ZNAME = 'NAME OF USER' 00510370 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00520370 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00530370 +C 00540370 + IVPASS = 0 00550370 + IVFAIL = 0 00560370 + IVDELE = 0 00570370 + IVINSP = 0 00580370 + IVTOTL = 0 00590370 + IVTOTN = 0 00600370 + ICZERO = 0 00610370 +C 00620370 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00630370 + I01 = 05 00640370 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00650370 + I02 = 06 00660370 +C 00670370 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00680370 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690370 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00700370 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00710370 +C 00720370 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00730370 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00740370 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00750370 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00760370 +C 00770370 +CBE** ********************** BBCINITB **********************************00780370 + NUVI = I02 00790370 + IVTOTL = 16 00800370 + ZPROG = 'FM370' 00810370 +CBB** ********************** BBCHED0A **********************************00820370 +C**** 00830370 +C**** WRITE REPORT TITLE 00840370 +C**** 00850370 + WRITE (I02, 90002) 00860370 + WRITE (I02, 90006) 00870370 + WRITE (I02, 90007) 00880370 + WRITE (I02, 90008) ZVERS, ZVERSD 00890370 + WRITE (I02, 90009) ZPROG, ZPROG 00900370 + WRITE (I02, 90010) ZDATE, ZCOMPL 00910370 +CBE** ********************** BBCHED0A **********************************00920370 +C***** HEADER FOR SEGMENT 181 00930370 + WRITE(NUVI,18100) 00940370 +18100 FORMAT(" ", / " XALOG - (181) INTRINSIC FUNCTIONS" // 00950370 + 1 " ALOG (NATURAL LOGARITHM)" // 00960370 + 2 " SUBSET REF. - 15.3" ) 00970370 +CBB** ********************** BBCHED0B **********************************00980370 +C**** WRITE DETAIL REPORT HEADERS 00990370 +C**** 01000370 + WRITE (I02,90004) 01010370 + WRITE (I02,90004) 01020370 + WRITE (I02,90013) 01030370 + WRITE (I02,90014) 01040370 + WRITE (I02,90015) IVTOTL 01050370 +CBE** ********************** BBCHED0B **********************************01060370 +C***** 01070370 +CT001* TEST 1 ONE, SINCE LN(1.0) = 0.0 01080370 + IVTNUM = 1 01090370 + BVS = 1.0 01100370 + AVS = ALOG(BVS) 01110370 + IF (AVS + 0.50000E-04) 20010, 10010, 40010 01120370 +40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010 01130370 +10010 IVPASS = IVPASS + 1 01140370 + WRITE (NUVI, 80002) IVTNUM 01150370 + GO TO 0011 01160370 +20010 IVFAIL = IVFAIL + 1 01170370 + RVCORR = 0.00000000000000 01180370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01190370 + 0011 CONTINUE 01200370 +CT002* TEST 2 VALUES CLOSE TO E 01210370 + IVTNUM = 2 01220370 + AVS = ALOG(2.6875) 01230370 + IF (AVS - 0.98856E+00) 20020, 10020, 40020 01240370 +40020 IF (AVS - 0.98866E+00) 10020, 10020, 20020 01250370 +10020 IVPASS = IVPASS + 1 01260370 + WRITE (NUVI, 80002) IVTNUM 01270370 + GO TO 0021 01280370 +20020 IVFAIL = IVFAIL + 1 01290370 + RVCORR = 0.98861139345378 01300370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01310370 + 0021 CONTINUE 01320370 +CT003* TEST 3 01330370 + IVTNUM = 3 01340370 + AVS = ALOG(5.125) 01350370 + IF (AVS - 0.16340E+01) 20030, 10030, 40030 01360370 +40030 IF (AVS - 0.16342E+01) 10030, 10030, 20030 01370370 +10030 IVPASS = IVPASS + 1 01380370 + WRITE (NUVI, 80002) IVTNUM 01390370 + GO TO 0031 01400370 +20030 IVFAIL = IVFAIL + 1 01410370 + RVCORR = 1.63413052502447 01420370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01430370 + 0031 CONTINUE 01440370 +CT004* TEST 4 01450370 + IVTNUM = 4 01460370 + AVS = ALOG(10.0) 01470370 + IF (AVS - 0.23025E+01) 20040, 10040, 40040 01480370 +40040 IF (AVS - 0.23027E+01) 10040, 10040, 20040 01490370 +10040 IVPASS = IVPASS + 1 01500370 + WRITE (NUVI, 80002) IVTNUM 01510370 + GO TO 0041 01520370 +20040 IVFAIL = IVFAIL + 1 01530370 + RVCORR = 2.30258509299405 01540370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01550370 + 0041 CONTINUE 01560370 +CT005* TEST 5 01570370 + IVTNUM = 5 01580370 + AVS = ALOG(100.0) 01590370 + IF (AVS - 0.46049E+01) 20050, 10050, 40050 01600370 +40050 IF (AVS - 0.46054E+01) 10050, 10050, 20050 01610370 +10050 IVPASS = IVPASS + 1 01620370 + WRITE (NUVI, 80002) IVTNUM 01630370 + GO TO 0051 01640370 +20050 IVFAIL = IVFAIL + 1 01650370 + RVCORR = 4.60517018598809 01660370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01670370 + 0051 CONTINUE 01680370 +CT006* TEST 6 01690370 + IVTNUM = 6 01700370 + BVS = 1.0 01710370 + AVS = ALOG(BVS / 4.0) 01720370 + IF (AVS + 0.13864E+01) 20060, 10060, 40060 01730370 +40060 IF (AVS + 0.13862E+01) 10060, 10060, 20060 01740370 +10060 IVPASS = IVPASS + 1 01750370 + WRITE (NUVI, 80002) IVTNUM 01760370 + GO TO 0061 01770370 +20060 IVFAIL = IVFAIL + 1 01780370 + RVCORR = -1.38629436111989 01790370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01800370 + 0061 CONTINUE 01810370 +CT007* TEST 7 01820370 + IVTNUM = 7 01830370 + BVS = 1.0 01840370 + CVS = 8.0 01850370 + AVS = ALOG(3.0 * BVS / CVS) 01860370 + IF (AVS + 0.98088E+00) 20070, 10070, 40070 01870370 +40070 IF (AVS + 0.98078E+00) 10070, 10070, 20070 01880370 +10070 IVPASS = IVPASS + 1 01890370 + WRITE (NUVI, 80002) IVTNUM 01900370 + GO TO 0071 01910370 +20070 IVFAIL = IVFAIL + 1 01920370 + RVCORR = -0.98082925301173 01930370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01940370 + 0071 CONTINUE 01950370 +CT008* TEST 8 01960370 + IVTNUM = 8 01970370 + AVS = ALOG(50.0 / 100.0) 01980370 + IF (AVS + 0.69318E+00) 20080, 10080, 40080 01990370 +40080 IF (AVS + 0.69311E+00) 10080, 10080, 20080 02000370 +10080 IVPASS = IVPASS + 1 02010370 + WRITE (NUVI, 80002) IVTNUM 02020370 + GO TO 0081 02030370 +20080 IVFAIL = IVFAIL + 1 02040370 + RVCORR = -0.69314718055995 02050370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02060370 + 0081 CONTINUE 02070370 +CT009* TEST 9 02080370 + IVTNUM = 9 02090370 + BVS = 68.75 02100370 + AVS = ALOG(BVS * 0.01) 02110370 + IF (AVS + 0.37471E+00) 20090, 10090, 40090 02120370 +40090 IF (AVS + 0.37467E+00) 10090, 10090, 20090 02130370 +10090 IVPASS = IVPASS + 1 02140370 + WRITE (NUVI, 80002) IVTNUM 02150370 + GO TO 0091 02160370 +20090 IVFAIL = IVFAIL + 1 02170370 + RVCORR = -0.37469344944141 02180370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02190370 + 0091 CONTINUE 02200370 +CT010* TEST 10 VALUES CLOSE TO ONE 02210370 + IVTNUM = 10 02220370 + AVS = ALOG(0.96875) 02230370 + IF (AVS + 0.31750E-01) 20100, 10100, 40100 02240370 +40100 IF (AVS + 0.31747E-01) 10100, 10100, 20100 02250370 +10100 IVPASS = IVPASS + 1 02260370 + WRITE (NUVI, 80002) IVTNUM 02270370 + GO TO 0101 02280370 +20100 IVFAIL = IVFAIL + 1 02290370 + RVCORR = -0.03174869831458 02300370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02310370 + 0101 CONTINUE 02320370 +CT011* TEST 11 02330370 + IVTNUM = 11 02340370 + BVS = 1.015625 02350370 + AVS = ALOG(BVS) 02360370 + IF (AVS - 0.15503E-01) 20110, 10110, 40110 02370370 +40110 IF (AVS - 0.15505E-01) 10110, 10110, 20110 02380370 +10110 IVPASS = IVPASS + 1 02390370 + WRITE (NUVI, 80002) IVTNUM 02400370 + GO TO 0111 02410370 +20110 IVFAIL = IVFAIL + 1 02420370 + RVCORR = 0.01550418653597 02430370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02440370 + 0111 CONTINUE 02450370 +CT012* TEST 12 VALUES CLOSE TO ZERO 02460370 + IVTNUM = 12 02470370 + BVS = 128.0 02480370 + AVS = ALOG(1.0 / BVS) 02490370 + IF (AVS + 0.48523E+01) 20120, 10120, 40120 02500370 +40120 IF (AVS + 0.48518E+01) 10120, 10120, 20120 02510370 +10120 IVPASS = IVPASS + 1 02520370 + WRITE (NUVI, 80002) IVTNUM 02530370 + GO TO 0121 02540370 +20120 IVFAIL = IVFAIL + 1 02550370 + RVCORR = -4.85203026391962 02560370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02570370 + 0121 CONTINUE 02580370 +CT013* TEST 13 02590370 + IVTNUM = 13 02600370 + BVS = 128.0 02610370 + AVS = ALOG(1.0 / (BVS * 4.0)) 02620370 + IF (AVS + 0.62386E+01) 20130, 10130, 40130 02630370 +40130 IF (AVS + 0.62380E+01) 10130, 10130, 20130 02640370 +10130 IVPASS = IVPASS + 1 02650370 + WRITE (NUVI, 80002) IVTNUM 02660370 + GO TO 0131 02670370 +20130 IVFAIL = IVFAIL + 1 02680370 + RVCORR = -6.23832462503951 02690370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02700370 + 0131 CONTINUE 02710370 +CT014* TEST 14 AN ARGUMENT OF HIGH MAGNITUDE 02720370 + IVTNUM = 14 02730370 + BVS = 1.0E+37 02740370 + AVS = ALOG(BVS) 02750370 + IF (AVS - 0.85191E+01) 20140, 10140, 40140 02760370 +40140 IF (AVS - 0.85200E+02) 10140, 10140, 20140 02770370 +10140 IVPASS = IVPASS + 1 02780370 + WRITE (NUVI, 80002) IVTNUM 02790370 + GO TO 0141 02800370 +20140 IVFAIL = IVFAIL + 1 02810370 + RVCORR = 85.19564844077969 02820370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02830370 + 0141 CONTINUE 02840370 +CT015* TEST 15 AN ARGUMENT OF LOW MAGNITUDE 02850370 + IVTNUM = 15 02860370 + BVS = 1.0E-37 02870370 + AVS = ALOG(BVS) 02880370 + IF (AVS + 0.85200E+02) 20150, 10150, 40150 02890370 +40150 IF (AVS + 0.85191E+02) 10150, 10150, 20150 02900370 +10150 IVPASS = IVPASS + 1 02910370 + WRITE (NUVI, 80002) IVTNUM 02920370 + GO TO 0151 02930370 +20150 IVFAIL = IVFAIL + 1 02940370 + RVCORR = -85.19564844077969 02950370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02960370 + 0151 CONTINUE 02970370 +CT016* TEST 16 02980370 + IVTNUM = 16 02990370 + AVS = ALOG(8.0) + ALOG(0.125) 03000370 + IF (AVS + 0.50000E-04) 20160, 10160, 40160 03010370 +40160 IF (AVS - 0.50000E-04) 10160, 10160, 20160 03020370 +10160 IVPASS = IVPASS + 1 03030370 + WRITE (NUVI, 80002) IVTNUM 03040370 + GO TO 0161 03050370 +20160 IVFAIL = IVFAIL + 1 03060370 + RVCORR = 0.0000000 03070370 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03080370 + 0161 CONTINUE 03090370 +C***** 03100370 +CBB** ********************** BBCSUM0 **********************************03110370 +C**** WRITE OUT TEST SUMMARY 03120370 +C**** 03130370 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03140370 + WRITE (I02, 90004) 03150370 + WRITE (I02, 90014) 03160370 + WRITE (I02, 90004) 03170370 + WRITE (I02, 90020) IVPASS 03180370 + WRITE (I02, 90022) IVFAIL 03190370 + WRITE (I02, 90024) IVDELE 03200370 + WRITE (I02, 90026) IVINSP 03210370 + WRITE (I02, 90028) IVTOTN, IVTOTL 03220370 +CBE** ********************** BBCSUM0 **********************************03230370 +CBB** ********************** BBCFOOT0 **********************************03240370 +C**** WRITE OUT REPORT FOOTINGS 03250370 +C**** 03260370 + WRITE (I02,90016) ZPROG, ZPROG 03270370 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03280370 + WRITE (I02,90019) 03290370 +CBE** ********************** BBCFOOT0 **********************************03300370 +CBB** ********************** BBCFMT0A **********************************03310370 +C**** FORMATS FOR TEST DETAIL LINES 03320370 +C**** 03330370 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03340370 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03350370 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03360370 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03370370 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03380370 + 1I6,/," ",15X,"CORRECT= " ,I6) 03390370 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03400370 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03410370 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03420370 + 1A21,/," ",16X,"CORRECT= " ,A21) 03430370 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03440370 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03450370 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03460370 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03470370 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03480370 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03490370 +80050 FORMAT (" ",48X,A31) 03500370 +CBE** ********************** BBCFMT0A **********************************03510370 +CBB** ********************** BBCFMT0B **********************************03520370 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03530370 +C**** 03540370 +90002 FORMAT ("1") 03550370 +90004 FORMAT (" ") 03560370 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03570370 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03580370 +90008 FORMAT (" ",21X,A13,A17) 03590370 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03600370 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03610370 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03620370 + 1 7X,"REMARKS",24X) 03630370 +90014 FORMAT (" ","----------------------------------------------" , 03640370 + 1 "---------------------------------" ) 03650370 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03660370 +C**** 03670370 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03680370 +C**** 03690370 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03700370 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03710370 + 1 A13) 03720370 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03730370 +C**** 03740370 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03750370 +C**** 03760370 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03770370 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03780370 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03790370 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03800370 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03810370 +CBE** ********************** BBCFMT0B **********************************03820370 +C***** 03830370 +C***** END OF TEST SEGMENT 181 03840370 + STOP 03850370 + END 03860370 + 03870370 diff --git a/Fortran/UnitTests/fcvs21_f95/FM370.reference_output b/Fortran/UnitTests/fcvs21_f95/FM370.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM370.reference_output @@ -0,0 +1,50 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM370BEGIN* TEST RESULTS - FM370 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XALOG - (181) INTRINSIC FUNCTIONS + + ALOG (NATURAL LOGARITHM) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 16 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + + ------------------------------------------------------------------------------- + + 16 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 16 OF 16 TESTS EXECUTED + + *FM370END* END OF TEST - FM370 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM371.f b/Fortran/UnitTests/fcvs21_f95/FM371.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM371.f @@ -0,0 +1,378 @@ + PROGRAM FM371 + +C***********************************************************************00010371 +C***** FORTRAN 77 00020371 +C***** FM371 00030371 +C***** XALG10 - (184) 00040371 +C***** 00050371 +C***********************************************************************00060371 +C***** GENERAL PURPOSE SUBSET REF 00070371 +C***** TEST INTRINSIC FUNCTION ALOG10 15.3 00080371 +C***** TABLE 5 00090371 +C***** 00100371 +CBB** ********************** BBCCOMNT **********************************00110371 +C**** 00120371 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130371 +C**** VERSION 2.1 00140371 +C**** 00150371 +C**** 00160371 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170371 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180371 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190371 +C**** BUILDING 225 RM A266 00200371 +C**** GAITHERSBURG, MD 20899 00210371 +C**** 00220371 +C**** 00230371 +C**** 00240371 +CBE** ********************** BBCCOMNT **********************************00250371 +CBB** ********************** BBCINITA **********************************00260371 +C**** SPECIFICATION STATEMENTS 00270371 +C**** 00280371 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290371 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300371 +CBE** ********************** BBCINITA **********************************00310371 +CBB** ********************** BBCINITB **********************************00320371 +C**** INITIALIZE SECTION 00330371 + DATA ZVERS, ZVERSD, ZDATE 00340371 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350371 + DATA ZCOMPL, ZNAME, ZTAPE 00360371 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370371 + DATA ZPROJ, ZTAPED, ZPROG 00380371 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390371 + DATA REMRKS /' '/ 00400371 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410371 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420371 +C**** 00430371 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440371 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450371 +CZ03 ZPROG = 'PROGRAM NAME' 00460371 +CZ04 ZDATE = 'DATE OF TEST' 00470371 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480371 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490371 +CZ07 ZNAME = 'NAME OF USER' 00500371 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510371 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520371 +C 00530371 + IVPASS = 0 00540371 + IVFAIL = 0 00550371 + IVDELE = 0 00560371 + IVINSP = 0 00570371 + IVTOTL = 0 00580371 + IVTOTN = 0 00590371 + ICZERO = 0 00600371 +C 00610371 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620371 + I01 = 05 00630371 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640371 + I02 = 06 00650371 +C 00660371 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670371 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680371 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690371 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700371 +C 00710371 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720371 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730371 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740371 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750371 +C 00760371 +CBE** ********************** BBCINITB **********************************00770371 + NUVI = I02 00780371 + IVTOTL = 15 00790371 + ZPROG = 'FM371' 00800371 +CBB** ********************** BBCHED0A **********************************00810371 +C**** 00820371 +C**** WRITE REPORT TITLE 00830371 +C**** 00840371 + WRITE (I02, 90002) 00850371 + WRITE (I02, 90006) 00860371 + WRITE (I02, 90007) 00870371 + WRITE (I02, 90008) ZVERS, ZVERSD 00880371 + WRITE (I02, 90009) ZPROG, ZPROG 00890371 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900371 +CBE** ********************** BBCHED0A **********************************00910371 +C***** 00920371 +C***** HEADER FOR SEGMENT 184 00930371 + WRITE(NUVI,18400) 00940371 +18400 FORMAT(" ", / " XALG10 - (184) INTRINSIC FUNCTIONS" // 00950371 + 1 " ALOG10 (COMMON LOGARITHM)" // 00960371 + 2 " SUBSET REF. - 15.3" ) 00970371 +CBB** ********************** BBCHED0B **********************************00980371 +C**** WRITE DETAIL REPORT HEADERS 00990371 +C**** 01000371 + WRITE (I02,90004) 01010371 + WRITE (I02,90004) 01020371 + WRITE (I02,90013) 01030371 + WRITE (I02,90014) 01040371 + WRITE (I02,90015) IVTOTL 01050371 +CBE** ********************** BBCHED0B **********************************01060371 +C***** 01070371 +CT001* TEST 1 ONE, SINCE LN(1.0) = 0.0 01080371 + IVTNUM = 1 01090371 + BVS = 1.0 01100371 + AVS = ALOG10(BVS) 01110371 + IF (AVS + 0.50000E-04) 20010, 10010, 40010 01120371 +40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010 01130371 +10010 IVPASS = IVPASS + 1 01140371 + WRITE (NUVI, 80002) IVTNUM 01150371 + GO TO 0011 01160371 +20010 IVFAIL = IVFAIL + 1 01170371 + RVCORR = 0.00000000000000 01180371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01190371 + 0011 CONTINUE 01200371 +CT002* TEST 2 A VALUE CLOSE TO TEN 01210371 + IVTNUM = 2 01220371 + AVS = ALOG10(9.875) 01230371 + IF (AVS - 0.99448E+00) 20020, 10020, 40020 01240371 +40020 IF (AVS - 0.99459E+00) 10020, 10020, 20020 01250371 +10020 IVPASS = IVPASS + 1 01260371 + WRITE (NUVI, 80002) IVTNUM 01270371 + GO TO 0021 01280371 +20020 IVFAIL = IVFAIL + 1 01290371 + RVCORR = 0.99453710429850 01300371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01310371 + 0021 CONTINUE 01320371 +CT003* TEST 3 THE VALUE 10.0 01330371 + IVTNUM = 3 01340371 + AVS = ALOG10(10.0) 01350371 + IF (AVS - 0.99995E+00) 20030, 10030, 40030 01360371 +40030 IF (AVS - 0.10001E+01) 10030, 10030, 20030 01370371 +10030 IVPASS = IVPASS + 1 01380371 + WRITE (NUVI, 80002) IVTNUM 01390371 + GO TO 0031 01400371 +20030 IVFAIL = IVFAIL + 1 01410371 + RVCORR = 1.00000000000000 01420371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01430371 + 0031 CONTINUE 01440371 +CT004* TEST 4 THE VALUE 20.5 01450371 + IVTNUM = 4 01460371 + AVS = ALOG10(20.5) 01470371 + IF (AVS - 0.13116E+01) 20040, 10040, 40040 01480371 +40040 IF (AVS - 0.13119E+01) 10040, 10040, 20040 01490371 +10040 IVPASS = IVPASS + 1 01500371 + WRITE (NUVI, 80002) IVTNUM 01510371 + GO TO 0041 01520371 +20040 IVFAIL = IVFAIL + 1 01530371 + RVCORR = 1.31175386105575 01540371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01550371 + 0041 CONTINUE 01560371 +CT005* TEST 5 THE VALUE 99.0 01570371 + IVTNUM = 5 01580371 + AVS = ALOG10(99.0) 01590371 + IF (AVS - 0.19955E+01) 20050, 10050, 40050 01600371 +40050 IF (AVS - 0.19958E+01) 10050, 10050, 20050 01610371 +10050 IVPASS = IVPASS + 1 01620371 + WRITE (NUVI, 80002) IVTNUM 01630371 + GO TO 0051 01640371 +20050 IVFAIL = IVFAIL + 1 01650371 + RVCORR = 1.99563519459755 01660371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01670371 + 0051 CONTINUE 01680371 +CT006* TEST 6 VARIABLES WITHIN AN EXPRESSION 01690371 + IVTNUM = 6 01700371 + BVS = 1.0 01710371 + CVS = 8.0 01720371 + AVS = ALOG10(3.0 * BVS / CVS) 01730371 + IF (AVS + 0.42599E+00) 20060, 10060, 40060 01740371 +40060 IF (AVS + 0.42594E+00) 10060, 10060, 20060 01750371 +10060 IVPASS = IVPASS + 1 01760371 + WRITE (NUVI, 80002) IVTNUM 01770371 + GO TO 0061 01780371 +20060 IVFAIL = IVFAIL + 1 01790371 + RVCORR = -0.42596873227228 01800371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01810371 + 0061 CONTINUE 01820371 +CT007* TEST 7 VARIABLES WITHIN AN EXPRESSION 01830371 + IVTNUM = 7 01840371 + BVS = 1.0 01850371 + CVS = 8.0 01860371 + AVS = ALOG10(5.0 * BVS / CVS) 01870371 + IF (AVS + 0.20413E+00) 20070, 10070, 40070 01880371 +40070 IF (AVS + 0.20411E+00) 10070, 10070, 20070 01890371 +10070 IVPASS = IVPASS + 1 01900371 + WRITE (NUVI, 80002) IVTNUM 01910371 + GO TO 0071 01920371 +20070 IVFAIL = IVFAIL + 1 01930371 + RVCORR = -0.20411998265592 01940371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01950371 + 0071 CONTINUE 01960371 +CT008* TEST 8 AN EXPRESSION SUPPLIED TO ALOG10 01970371 + IVTNUM = 8 01980371 + AVS = ALOG10(75.0 / 100.0) 01990371 + IF (AVS + 0.12495E+00) 20080, 10080, 40080 02000371 +40080 IF (AVS + 0.12493E+00) 10080, 10080, 20080 02010371 +10080 IVPASS = IVPASS + 1 02020371 + WRITE (NUVI, 80002) IVTNUM 02030371 + GO TO 0081 02040371 +20080 IVFAIL = IVFAIL + 1 02050371 + RVCORR = -0.12493873660830 02060371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02070371 + 0081 CONTINUE 02080371 +CT009* TEST 9 VARIABLES WITHIN AN EXPRESSION 02090371 + IVTNUM = 9 02100371 + BVS = 1.0 02110371 + CVS = 8.0 02120371 + AVS = ALOG10(7.0 * BVS / CVS) 02130371 + IF (AVS + 0.57995E-01) 20090, 10090, 40090 02140371 +40090 IF (AVS + 0.57989E-01) 10090, 10090, 20090 02150371 +10090 IVPASS = IVPASS + 1 02160371 + WRITE (NUVI, 80002) IVTNUM 02170371 + GO TO 0091 02180371 +20090 IVFAIL = IVFAIL + 1 02190371 + RVCORR = -0.05799194697769 02200371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02210371 + 0091 CONTINUE 02220371 +CT010* TEST 10 A VALUE CLOSE TO ONE 02230371 + IVTNUM = 10 02240371 + AVS = ALOG10(0.9921875) 02250371 + IF (AVS + 0.34065E-02) 20100, 10100, 40100 02260371 +40100 IF (AVS + 0.34060E-02) 10100, 10100, 20100 02270371 +10100 IVPASS = IVPASS + 1 02280371 + WRITE (NUVI, 80002) IVTNUM 02290371 + GO TO 0101 02300371 +20100 IVFAIL = IVFAIL + 1 02310371 + RVCORR = -0.0034062486919115 02320371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02330371 + 0101 CONTINUE 02340371 +CT012* TEST 11 A VALUE CLOSE TO ZERO 02480371 + IVTNUM = 11 02490371 + BVS = 256.0 02500371 + AVS = ALOG10(1.0 / BVS) 02510371 + IF (AVS + 0.24084E+01) 20120, 10120, 40120 02520371 +40120 IF (AVS + 0.24081E+01) 10120, 10120, 20120 02530371 +10120 IVPASS = IVPASS + 1 02540371 + WRITE (NUVI, 80002) IVTNUM 02550371 + GO TO 0121 02560371 +20120 IVFAIL = IVFAIL + 1 02570371 + RVCORR = -2.40823996531185 02580371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02590371 + 0121 CONTINUE 02600371 +CT013* TEST 12 A VALUE CLOSE TO ZERO 02610371 + IVTNUM = 12 02620371 + BVS = 128.0 02630371 + AVS = ALOG10(1.0 / (BVS * 8.0)) 02640371 + IF (AVS + 0.30105E+01) 20130, 10130, 40130 02650371 +40130 IF (AVS + 0.30101E+01) 10130, 10130, 20130 02660371 +10130 IVPASS = IVPASS + 1 02670371 + WRITE (NUVI, 80002) IVTNUM 02680371 + GO TO 0131 02690371 +20130 IVFAIL = IVFAIL + 1 02700371 + RVCORR = -3.01029995663981 02710371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02720371 + 0131 CONTINUE 02730371 +CT014* TEST 13 AN ARGUMENT OF HIGH MAGNITUDE 02740371 + IVTNUM = 13 02750371 + BVS = 2.0E+35 02760371 + AVS = ALOG10(BVS) 02770371 + IF (AVS - 0.35299E+02) 20140, 10140, 40140 02780371 +40140 IF (AVS - 0.35303E+02) 10140, 10140, 20140 02790371 +10140 IVPASS = IVPASS + 1 02800371 + WRITE (NUVI, 80002) IVTNUM 02810371 + GO TO 0141 02820371 +20140 IVFAIL = IVFAIL + 1 02830371 + RVCORR = 35.30102999566398 02840371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02850371 + 0141 CONTINUE 02860371 +CT015* TEST 14 AN ARGUMENT OF LOW MAGNITUDE 02870371 + IVTNUM = 14 02880371 + BVS = 2.0E-35 02890371 + AVS = ALOG10(BVS) 02900371 + IF (AVS + 0.34701E+02) 20150, 10150, 40150 02910371 +40150 IF (AVS + 0.34697E+02) 10150, 10150, 20150 02920371 +10150 IVPASS = IVPASS + 1 02930371 + WRITE (NUVI, 80002) IVTNUM 02940371 + GO TO 0151 02950371 +20150 IVFAIL = IVFAIL + 1 02960371 + RVCORR = -34.69897000433602 02970371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02980371 + 0151 CONTINUE 02990371 +CT016* TEST 15 THE FUNCTION APPLIED TWICE 03000371 + IVTNUM = 15 03010371 + AVS = ALOG10(20.0) - ALOG10(2.0) 03020371 + IF (AVS - 0.99995E+00) 20160, 10160, 40160 03030371 +40160 IF (AVS - 0.10001E+01) 10160, 10160, 20160 03040371 +10160 IVPASS = IVPASS + 1 03050371 + WRITE (NUVI, 80002) IVTNUM 03060371 + GO TO 0161 03070371 +20160 IVFAIL = IVFAIL + 1 03080371 + RVCORR = 1.0000000 03090371 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03100371 + 0161 CONTINUE 03110371 +C***** 03120371 +CBB** ********************** BBCSUM0 **********************************03130371 +C**** WRITE OUT TEST SUMMARY 03140371 +C**** 03150371 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03160371 + WRITE (I02, 90004) 03170371 + WRITE (I02, 90014) 03180371 + WRITE (I02, 90004) 03190371 + WRITE (I02, 90020) IVPASS 03200371 + WRITE (I02, 90022) IVFAIL 03210371 + WRITE (I02, 90024) IVDELE 03220371 + WRITE (I02, 90026) IVINSP 03230371 + WRITE (I02, 90028) IVTOTN, IVTOTL 03240371 +CBE** ********************** BBCSUM0 **********************************03250371 +CBB** ********************** BBCFOOT0 **********************************03260371 +C**** WRITE OUT REPORT FOOTINGS 03270371 +C**** 03280371 + WRITE (I02,90016) ZPROG, ZPROG 03290371 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03300371 + WRITE (I02,90019) 03310371 +CBE** ********************** BBCFOOT0 **********************************03320371 +CBB** ********************** BBCFMT0A **********************************03330371 +C**** FORMATS FOR TEST DETAIL LINES 03340371 +C**** 03350371 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03360371 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03370371 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03380371 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03390371 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03400371 + 1I6,/," ",15X,"CORRECT= " ,I6) 03410371 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03420371 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03430371 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03440371 + 1A21,/," ",16X,"CORRECT= " ,A21) 03450371 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03460371 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03470371 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03480371 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03490371 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03500371 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03510371 +80050 FORMAT (" ",48X,A31) 03520371 +CBE** ********************** BBCFMT0A **********************************03530371 +CBB** ********************** BBCFMT0B **********************************03540371 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03550371 +C**** 03560371 +90002 FORMAT ("1") 03570371 +90004 FORMAT (" ") 03580371 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03590371 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03600371 +90008 FORMAT (" ",21X,A13,A17) 03610371 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03620371 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03630371 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03640371 + 1 7X,"REMARKS",24X) 03650371 +90014 FORMAT (" ","----------------------------------------------" , 03660371 + 1 "---------------------------------" ) 03670371 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03680371 +C**** 03690371 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03700371 +C**** 03710371 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03720371 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03730371 + 1 A13) 03740371 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03750371 +C**** 03760371 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03770371 +C**** 03780371 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03790371 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03800371 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03810371 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03820371 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03830371 +CBE** ********************** BBCFMT0B **********************************03840371 +C***** 03850371 +C***** END OF TEST SEGMENT 184 03860371 + STOP 03870371 + END 03880371 + 03890371 diff --git a/Fortran/UnitTests/fcvs21_f95/FM371.reference_output b/Fortran/UnitTests/fcvs21_f95/FM371.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM371.reference_output @@ -0,0 +1,49 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM371BEGIN* TEST RESULTS - FM371 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XALG10 - (184) INTRINSIC FUNCTIONS + + ALOG10 (COMMON LOGARITHM) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 15 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + + ------------------------------------------------------------------------------- + + 15 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 15 OF 15 TESTS EXECUTED + + *FM371END* END OF TEST - FM371 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM372.f b/Fortran/UnitTests/fcvs21_f95/FM372.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM372.f @@ -0,0 +1,403 @@ + PROGRAM FM372 + +C***********************************************************************00010372 +C***** FORTRAN 77 00020372 +C***** FM372 00030372 +C***** XSIN - (186) 00040372 +C***** 00050372 +C***********************************************************************00060372 +C***** GENERAL PURPOSE SUBSET REF 00070372 +C***** TEST INTRINSIC FUNCTION SIN 15.3 00080372 +C***** TABLE 5 00090372 +C***** 00100372 +CBB** ********************** BBCCOMNT **********************************00110372 +C**** 00120372 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130372 +C**** VERSION 2.1 00140372 +C**** 00150372 +C**** 00160372 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170372 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180372 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190372 +C**** BUILDING 225 RM A266 00200372 +C**** GAITHERSBURG, MD 20899 00210372 +C**** 00220372 +C**** 00230372 +C**** 00240372 +CBE** ********************** BBCCOMNT **********************************00250372 +CBB** ********************** BBCINITA **********************************00260372 +C**** SPECIFICATION STATEMENTS 00270372 +C**** 00280372 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290372 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300372 +CBE** ********************** BBCINITA **********************************00310372 +CBB** ********************** BBCINITB **********************************00320372 +C**** INITIALIZE SECTION 00330372 + DATA ZVERS, ZVERSD, ZDATE 00340372 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350372 + DATA ZCOMPL, ZNAME, ZTAPE 00360372 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370372 + DATA ZPROJ, ZTAPED, ZPROG 00380372 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390372 + DATA REMRKS /' '/ 00400372 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410372 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420372 +C**** 00430372 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440372 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450372 +CZ03 ZPROG = 'PROGRAM NAME' 00460372 +CZ04 ZDATE = 'DATE OF TEST' 00470372 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480372 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490372 +CZ07 ZNAME = 'NAME OF USER' 00500372 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510372 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520372 +C 00530372 + IVPASS = 0 00540372 + IVFAIL = 0 00550372 + IVDELE = 0 00560372 + IVINSP = 0 00570372 + IVTOTL = 0 00580372 + IVTOTN = 0 00590372 + ICZERO = 0 00600372 +C 00610372 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620372 + I01 = 05 00630372 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640372 + I02 = 06 00650372 +C 00660372 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670372 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680372 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690372 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700372 +C 00710372 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720372 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730372 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740372 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750372 +C 00760372 +CBE** ********************** BBCINITB **********************************00770372 + NUVI = I02 00780372 + IVTOTL = 17 00790372 + ZPROG = 'FM372' 00800372 +CBB** ********************** BBCHED0A **********************************00810372 +C**** 00820372 +C**** WRITE REPORT TITLE 00830372 +C**** 00840372 + WRITE (I02, 90002) 00850372 + WRITE (I02, 90006) 00860372 + WRITE (I02, 90007) 00870372 + WRITE (I02, 90008) ZVERS, ZVERSD 00880372 + WRITE (I02, 90009) ZPROG, ZPROG 00890372 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900372 +CBE** ********************** BBCHED0A **********************************00910372 +C***** 00920372 +C***** HEADER FOR SEGMENT 186 00930372 + WRITE(NUVI,18600) 00940372 +18600 FORMAT(" "," XSIN - (186) INTRINSIC FUNCTIONS" // 00950372 + 1 " SIN (SINE)" // 00960372 + 2 " SUBSET REF. - 15.3" ) 00970372 +CBB** ********************** BBCHED0B **********************************00980372 +C**** WRITE DETAIL REPORT HEADERS 00990372 +C**** 01000372 + WRITE (I02,90004) 01010372 + WRITE (I02,90004) 01020372 + WRITE (I02,90013) 01030372 + WRITE (I02,90014) 01040372 + WRITE (I02,90015) IVTOTL 01050372 +CBE** ********************** BBCHED0B **********************************01060372 +C***** 01070372 + PIVS = 3.1415926535897932384626434 01080372 +C***** 01090372 +CT001* TEST 1 ZERO (0.0), SINCE SIN(0)=0 01100372 + IVTNUM = 1 01110372 + BVS = 0.0 01120372 + AVS = SIN(BVS) 01130372 + IF (AVS + 0.50000E-04) 20010, 10010, 40010 01140372 +40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010 01150372 +10010 IVPASS = IVPASS + 1 01160372 + WRITE (NUVI, 80002) IVTNUM 01170372 + GO TO 0011 01180372 +20010 IVFAIL = IVFAIL + 1 01190372 + RVCORR = 0.00000000000000 01200372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01210372 + 0011 CONTINUE 01220372 +CT002* TEST 2 PI 01230372 + IVTNUM = 2 01240372 + AVS = SIN(PIVS) 01250372 + IF (AVS + 0.50000E-04) 20020, 10020, 40020 01260372 +40020 IF (AVS - 0.50000E-04) 10020, 10020, 20020 01270372 +10020 IVPASS = IVPASS + 1 01280372 + WRITE (NUVI, 80002) IVTNUM 01290372 + GO TO 0021 01300372 +20020 IVFAIL = IVFAIL + 1 01310372 + RVCORR = 0.00000000000000 01320372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01330372 + 0021 CONTINUE 01340372 +CT003* TEST 3 PI - 1/8 01350372 + IVTNUM = 3 01360372 + BVS = 3.0165926535 01370372 + AVS = SIN(BVS) 01380372 + IF (AVS - 0.12466E+00) 20030, 10030, 40030 01390372 +40030 IF (AVS - 0.12468E+00) 10030, 10030, 20030 01400372 +10030 IVPASS = IVPASS + 1 01410372 + WRITE (NUVI, 80002) IVTNUM 01420372 + GO TO 0031 01430372 +20030 IVFAIL = IVFAIL + 1 01440372 + RVCORR = 0.12467473338523 01450372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01460372 + 0031 CONTINUE 01470372 +CT004* TEST 4 PI - 1/16 01480372 + IVTNUM = 4 01490372 + AVS = SIN(3.2040926535) 01500372 + IF (AVS + 0.62463E-01) 20040, 10040, 40040 01510372 +40040 IF (AVS + 0.62456E-01) 10040, 10040, 20040 01520372 +10040 IVPASS = IVPASS + 1 01530372 + WRITE (NUVI, 80002) IVTNUM 01540372 + GO TO 0041 01550372 +20040 IVFAIL = IVFAIL + 1 01560372 + RVCORR = -0.06245931784238 01570372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01580372 + 0041 CONTINUE 01590372 +CT005* TEST 5 2*PI 01600372 + IVTNUM = 5 01610372 + BVS = PIVS * 2.0 01620372 + AVS = SIN(BVS) 01630372 + IF (AVS + 0.50000E-04) 20050, 10050, 40050 01640372 +40050 IF (AVS - 0.50000E-04) 10050, 10050, 20050 01650372 +10050 IVPASS = IVPASS + 1 01660372 + WRITE (NUVI, 80002) IVTNUM 01670372 + GO TO 0051 01680372 +20050 IVFAIL = IVFAIL + 1 01690372 + RVCORR = 0.00000000000000 01700372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01710372 + 0051 CONTINUE 01720372 +CT007* TEST 6 THE VALUE 2.0 01860372 + IVTNUM = 6 01870372 + BVS = 2.0 01880372 + AVS = SIN(BVS) 01890372 + IF (AVS - 0.90925E+00) 20070, 10070, 40070 01900372 +40070 IF (AVS - 0.90935E+00) 10070, 10070, 20070 01910372 +10070 IVPASS = IVPASS + 1 01920372 + WRITE (NUVI, 80002) IVTNUM 01930372 + GO TO 0071 01940372 +20070 IVFAIL = IVFAIL + 1 01950372 + RVCORR = 0.90929742682568 01960372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01970372 + 0071 CONTINUE 01980372 +CT008* TEST 7 THE VALUE -2.0 01990372 + IVTNUM = 7 02000372 + BVS = -2.0 02010372 + AVS = SIN(BVS) 02020372 + IF (AVS + 0.90935E+00) 20080, 10080, 40080 02030372 +40080 IF (AVS + 0.90925E+00) 10080, 10080, 20080 02040372 +10080 IVPASS = IVPASS + 1 02050372 + WRITE (NUVI, 80002) IVTNUM 02060372 + GO TO 0081 02070372 +20080 IVFAIL = IVFAIL + 1 02080372 + RVCORR = -0.90929742682568 02090372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02100372 + 0081 CONTINUE 02110372 +CT009* TEST 08 A LARGE VALUE TO TEST ARGUMENT REDUCTION 02120372 + IVTNUM = 08 02130372 + AVS = SIN(100.0) 02140372 + IF (AVS + 0.50639E+00) 20090, 10090, 40090 02150372 +40090 IF (AVS + 0.50634E+00) 10090, 10090, 20090 02160372 +10090 IVPASS = IVPASS + 1 02170372 + WRITE (NUVI, 80002) IVTNUM 02180372 + GO TO 0091 02190372 +20090 IVFAIL = IVFAIL + 1 02200372 + RVCORR = -0.50636564110976 02210372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02220372 + 0091 CONTINUE 02230372 +CT010* TEST 09 A VERY LARGE VALUE 02240372 + IVTNUM = 09 02250372 + AVS = SIN(-1000.0) 02260372 + IF (AVS + 0.82692E+00) 20100, 10100, 40100 02270372 +40100 IF (AVS + 0.82683E+00) 10100, 10100, 20100 02280372 +10100 IVPASS = IVPASS + 1 02290372 + WRITE (NUVI, 80002) IVTNUM 02300372 + GO TO 0101 02310372 +20100 IVFAIL = IVFAIL + 1 02320372 + RVCORR = -0.82687954053200 02330372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02340372 + 0101 CONTINUE 02350372 +CT011* TEST 10 PI/2 02360372 + IVTNUM = 10 02370372 + AVS = SIN(1.5707963268) 02380372 + IF (AVS - 0.99995E+00) 20110, 10110, 40110 02390372 +40110 IF (AVS - 0.10001E+01) 10110, 10110, 20110 02400372 +10110 IVPASS = IVPASS + 1 02410372 + WRITE (NUVI, 80002) IVTNUM 02420372 + GO TO 0111 02430372 +20110 IVFAIL = IVFAIL + 1 02440372 + RVCORR = 1.00000000000000 02450372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02460372 + 0111 CONTINUE 02470372 +CT012* TEST 11 PI/2 - 1/32 02480372 + IVTNUM = 11 02490372 + BVS = 1.5395463268 02500372 + AVS = SIN(BVS) 02510372 + IF (AVS - 0.99946E+00) 20120, 10120, 40120 02520372 +40120 IF (AVS - 0.99957E+00) 10120, 10120, 20120 02530372 +10120 IVPASS = IVPASS + 1 02540372 + WRITE (NUVI, 80002) IVTNUM 02550372 + GO TO 0121 02560372 +20120 IVFAIL = IVFAIL + 1 02570372 + RVCORR = 0.99951175848514 02580372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02590372 + 0121 CONTINUE 02600372 +CT013* TEST 12 PI/2 - 1/64 02610372 + IVTNUM = 12 02620372 + AVS = SIN(1.5864213268) 02630372 + IF (AVS - 0.99982E+00) 20130, 10130, 40130 02640372 +40130 IF (AVS - 0.99993E+00) 10130, 10130, 20130 02650372 +10130 IVPASS = IVPASS + 1 02660372 + WRITE (NUVI, 80002) IVTNUM 02670372 + GO TO 0131 02680372 +20130 IVFAIL = IVFAIL + 1 02690372 + RVCORR = 0.99987793217101 02700372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02710372 + 0131 CONTINUE 02720372 +CT014* TEST 13 3*PI/2 02730372 + IVTNUM = 13 02740372 + BVS = 3.0 * PIVS / 2.0 02750372 + AVS = SIN(BVS) 02760372 + IF (AVS + 0.10001E+01) 20140, 10140, 40140 02770372 +40140 IF (AVS + 0.99995E+00) 10140, 10140, 20140 02780372 +10140 IVPASS = IVPASS + 1 02790372 + WRITE (NUVI, 80002) IVTNUM 02800372 + GO TO 0141 02810372 +20140 IVFAIL = IVFAIL + 1 02820372 + RVCORR = -1.00000000000000 02830372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02840372 + 0141 CONTINUE 02850372 +CT015* TEST 14 3*PI/2 - 1/16 02860372 + IVTNUM = 14 02870372 + BVS = (3.0 * PIVS / 2.0) - 1.0 / 16.0 02880372 + AVS = SIN(BVS) 02890372 + IF (AVS + 0.99810E+00) 20150, 10150, 40150 02900372 +40150 IF (AVS + 0.99799E+00) 10150, 10150, 20150 02910372 +10150 IVPASS = IVPASS + 1 02920372 + WRITE (NUVI, 80002) IVTNUM 02930372 + GO TO 0151 02940372 +20150 IVFAIL = IVFAIL + 1 02950372 + RVCORR = -0.99804751070010 02960372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02970372 + 0151 CONTINUE 02980372 +CT016* TEST 15 3*PI/2 - 1/512 02990372 + IVTNUM = 15 03000372 + BVS = (3.0 * PIVS / 2.0) + 1.0 / 512.0 03010372 + AVS = SIN(BVS) 03020372 + IF (AVS + 0.10001E+01) 20160, 10160, 40160 03030372 +40160 IF (AVS + 0.99994E+00) 10160, 10160, 20160 03040372 +10160 IVPASS = IVPASS + 1 03050372 + WRITE (NUVI, 80002) IVTNUM 03060372 + GO TO 0161 03070372 +20160 IVFAIL = IVFAIL + 1 03080372 + RVCORR = -0.99999809265197 03090372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03100372 + 0161 CONTINUE 03110372 +CT017* TEST 16 ARGUMENT OF LOW MAGNITUDE 03120372 + IVTNUM = 16 03130372 + BVS = PIVS * 1.0E-37 03140372 + AVS = SIN(BVS) 03150372 + IF (AVS + 0.50000E-04) 20170, 10170, 40170 03160372 +40170 IF (AVS - 0.50000E-04) 10170, 10170, 20170 03170372 +10170 IVPASS = IVPASS + 1 03180372 + WRITE (NUVI, 80002) IVTNUM 03190372 + GO TO 0171 03200372 +20170 IVFAIL = IVFAIL + 1 03210372 + RVCORR = 3.14159265358979E-37 03220372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03230372 + 0171 CONTINUE 03240372 +CT018* TEST 17 THE FUNCTION APPLIED TWICE 03250372 + IVTNUM = 17 03260372 + AVS = SIN(PIVS / 4.0) * SIN(3.0 * PIVS / 4.0) 03270372 + IF (AVS - 0.49997E+00) 20180, 10180, 40180 03280372 +40180 IF (AVS - 0.50003E+00) 10180, 10180, 20180 03290372 +10180 IVPASS = IVPASS + 1 03300372 + WRITE (NUVI, 80002) IVTNUM 03310372 + GO TO 0181 03320372 +20180 IVFAIL = IVFAIL + 1 03330372 + RVCORR = 0.50000000000000 03340372 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03350372 + 0181 CONTINUE 03360372 +C***** 03370372 +CBB** ********************** BBCSUM0 **********************************03380372 +C**** WRITE OUT TEST SUMMARY 03390372 +C**** 03400372 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03410372 + WRITE (I02, 90004) 03420372 + WRITE (I02, 90014) 03430372 + WRITE (I02, 90004) 03440372 + WRITE (I02, 90020) IVPASS 03450372 + WRITE (I02, 90022) IVFAIL 03460372 + WRITE (I02, 90024) IVDELE 03470372 + WRITE (I02, 90026) IVINSP 03480372 + WRITE (I02, 90028) IVTOTN, IVTOTL 03490372 +CBE** ********************** BBCSUM0 **********************************03500372 +CBB** ********************** BBCFOOT0 **********************************03510372 +C**** WRITE OUT REPORT FOOTINGS 03520372 +C**** 03530372 + WRITE (I02,90016) ZPROG, ZPROG 03540372 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03550372 + WRITE (I02,90019) 03560372 +CBE** ********************** BBCFOOT0 **********************************03570372 +CBB** ********************** BBCFMT0A **********************************03580372 +C**** FORMATS FOR TEST DETAIL LINES 03590372 +C**** 03600372 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03610372 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03620372 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03630372 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03640372 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03650372 + 1I6,/," ",15X,"CORRECT= " ,I6) 03660372 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03670372 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03680372 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03690372 + 1A21,/," ",16X,"CORRECT= " ,A21) 03700372 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03710372 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03720372 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03730372 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03740372 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03750372 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03760372 +80050 FORMAT (" ",48X,A31) 03770372 +CBE** ********************** BBCFMT0A **********************************03780372 +CBB** ********************** BBCFMT0B **********************************03790372 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03800372 +C**** 03810372 +90002 FORMAT ("1") 03820372 +90004 FORMAT (" ") 03830372 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03840372 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03850372 +90008 FORMAT (" ",21X,A13,A17) 03860372 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03870372 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03880372 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03890372 + 1 7X,"REMARKS",24X) 03900372 +90014 FORMAT (" ","----------------------------------------------" , 03910372 + 1 "---------------------------------" ) 03920372 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03930372 +C**** 03940372 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03950372 +C**** 03960372 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03970372 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03980372 + 1 A13) 03990372 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04000372 +C**** 04010372 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04020372 +C**** 04030372 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04040372 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04050372 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04060372 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04070372 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04080372 +CBE** ********************** BBCFMT0B **********************************04090372 +C***** 04100372 +C***** END OF TEST SEGMENT 186 04110372 + STOP 04120372 + END 04130372 + 04140372 diff --git a/Fortran/UnitTests/fcvs21_f95/FM372.reference_output b/Fortran/UnitTests/fcvs21_f95/FM372.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM372.reference_output @@ -0,0 +1,50 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM372BEGIN* TEST RESULTS - FM372 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + XSIN - (186) INTRINSIC FUNCTIONS + + SIN (SINE) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 17 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + + ------------------------------------------------------------------------------- + + 17 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 17 OF 17 TESTS EXECUTED + + *FM372END* END OF TEST - FM372 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM373.f b/Fortran/UnitTests/fcvs21_f95/FM373.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM373.f @@ -0,0 +1,416 @@ + PROGRAM FM373 + +C***********************************************************************00010373 +C***** FORTRAN 77 00020373 +C***** FM373 00030373 +C***** XCOS - (189) 00040373 +C***** 00050373 +C***********************************************************************00060373 +C***** GENERAL PURPOSE SUBSET REF 00070373 +C***** TEST INTRINSIC FUNCTION COS 15.3 00080373 +C***** TABLE 5 00090373 +C***** 00100373 +CBB** ********************** BBCCOMNT **********************************00110373 +C**** 00120373 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130373 +C**** VERSION 2.1 00140373 +C**** 00150373 +C**** 00160373 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170373 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180373 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190373 +C**** BUILDING 225 RM A266 00200373 +C**** GAITHERSBURG, MD 20899 00210373 +C**** 00220373 +C**** 00230373 +C**** 00240373 +CBE** ********************** BBCCOMNT **********************************00250373 +CBB** ********************** BBCINITA **********************************00260373 +C**** SPECIFICATION STATEMENTS 00270373 +C**** 00280373 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290373 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300373 +CBE** ********************** BBCINITA **********************************00310373 +CBB** ********************** BBCINITB **********************************00320373 +C**** INITIALIZE SECTION 00330373 + DATA ZVERS, ZVERSD, ZDATE 00340373 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350373 + DATA ZCOMPL, ZNAME, ZTAPE 00360373 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370373 + DATA ZPROJ, ZTAPED, ZPROG 00380373 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390373 + DATA REMRKS /' '/ 00400373 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410373 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420373 +C**** 00430373 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440373 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450373 +CZ03 ZPROG = 'PROGRAM NAME' 00460373 +CZ04 ZDATE = 'DATE OF TEST' 00470373 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480373 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490373 +CZ07 ZNAME = 'NAME OF USER' 00500373 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510373 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520373 +C 00530373 + IVPASS = 0 00540373 + IVFAIL = 0 00550373 + IVDELE = 0 00560373 + IVINSP = 0 00570373 + IVTOTL = 0 00580373 + IVTOTN = 0 00590373 + ICZERO = 0 00600373 +C 00610373 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620373 + I01 = 05 00630373 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640373 + I02 = 06 00650373 +C 00660373 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670373 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680373 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690373 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700373 +C 00710373 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720373 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730373 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740373 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750373 +C 00760373 +CBE** ********************** BBCINITB **********************************00770373 + NUVI = I02 00780373 + IVTOTL = 18 00790373 + ZPROG = 'FM373' 00800373 +CBB** ********************** BBCHED0A **********************************00810373 +C**** 00820373 +C**** WRITE REPORT TITLE 00830373 +C**** 00840373 + WRITE (I02, 90002) 00850373 + WRITE (I02, 90006) 00860373 + WRITE (I02, 90007) 00870373 + WRITE (I02, 90008) ZVERS, ZVERSD 00880373 + WRITE (I02, 90009) ZPROG, ZPROG 00890373 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900373 +CBE** ********************** BBCHED0A **********************************00910373 +C***** 00920373 +C***** HEADER FOR SEGMENT 189 00930373 + WRITE(NUVI,18900) 00940373 +18900 FORMAT(" "/" XCOS - (189) INTRINSIC FUNCTIONS" // 00950373 + 1 " COS (COSINE)" // 00960373 + 2 " SUBSET REF. - 15.3" ) 00970373 +CBB** ********************** BBCHED0B **********************************00980373 +C**** WRITE DETAIL REPORT HEADERS 00990373 +C**** 01000373 + WRITE (I02,90004) 01010373 + WRITE (I02,90004) 01020373 + WRITE (I02,90013) 01030373 + WRITE (I02,90014) 01040373 + WRITE (I02,90015) IVTOTL 01050373 +CBE** ********************** BBCHED0B **********************************01060373 +C***** 01070373 + PIVS = 3.1415926535897932384626434 01080373 +C***** 01090373 +CT001* TEST 1 ZERO (0.0), SINCE COS(0)=1 01100373 + IVTNUM = 1 01110373 + BVS = 0.0 01120373 + AVS = COS(BVS) 01130373 + IF (AVS - 0.99995E+00) 20010, 10010, 40010 01140373 +40010 IF (AVS - 0.10001E+01) 10010, 10010, 20010 01150373 +10010 IVPASS = IVPASS + 1 01160373 + WRITE (NUVI, 80002) IVTNUM 01170373 + GO TO 0011 01180373 +20010 IVFAIL = IVFAIL + 1 01190373 + RVCORR = 1.00000000000000 01200373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01210373 + 0011 CONTINUE 01220373 +CT002* TEST 2 VALUES NEAR PI 01230373 + IVTNUM = 2 01240373 + AVS = COS(PIVS) 01250373 + IF (AVS + 0.10001E+01) 20020, 10020, 40020 01260373 +40020 IF (AVS + 0.99995E+00) 10020, 10020, 20020 01270373 +10020 IVPASS = IVPASS + 1 01280373 + WRITE (NUVI, 80002) IVTNUM 01290373 + GO TO 0021 01300373 +20020 IVFAIL = IVFAIL + 1 01310373 + RVCORR = -1.00000000000000 01320373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01330373 + 0021 CONTINUE 01340373 +CT003* TEST 3 PI - 1/16 01350373 + IVTNUM = 3 01360373 + BVS = 3.0790926536 01370373 + AVS = COS(BVS) 01380373 + IF (AVS + 0.99810E+00) 20030, 10030, 40030 01390373 +40030 IF (AVS + 0.99799E+00) 10030, 10030, 20030 01400373 +10030 IVPASS = IVPASS + 1 01410373 + WRITE (NUVI, 80002) IVTNUM 01420373 + GO TO 0031 01430373 +20030 IVFAIL = IVFAIL + 1 01440373 + RVCORR = -0.99804751070010 01450373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01460373 + 0031 CONTINUE 01470373 +CT004* TEST 4 PI + 1/32 01480373 + IVTNUM = 4 01490373 + AVS = COS(3.1728426535) 01500373 + IF (AVS + 0.99957E+00) 20040, 10040, 40040 01510373 +40040 IF (AVS + 0.99946E+00) 10040, 10040, 20040 01520373 +10040 IVPASS = IVPASS + 1 01530373 + WRITE (NUVI, 80002) IVTNUM 01540373 + GO TO 0041 01550373 +20040 IVFAIL = IVFAIL + 1 01560373 + RVCORR = -0.99951175848514 01570373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01580373 + 0041 CONTINUE 01590373 +CT005* TEST 5 VALUES NEAR 2*PI 01600373 + IVTNUM = 5 01610373 + BVS = PIVS * 2.0 01620373 + AVS = COS(BVS) 01630373 + IF (AVS - 0.99995E+00) 20050, 10050, 40050 01640373 +40050 IF (AVS - 0.10001E+01) 10050, 10050, 20050 01650373 +10050 IVPASS = IVPASS + 1 01660373 + WRITE (NUVI, 80002) IVTNUM 01670373 + GO TO 0051 01680373 +20050 IVFAIL = IVFAIL + 1 01690373 + RVCORR = 1.00000000000000 01700373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01710373 + 0051 CONTINUE 01720373 +CT006* TEST 6 VALUES NEAR 2*PI 01730373 + IVTNUM = 6 01740373 + BVS = (2.0 * PIVS) - 1.0 / 64.0 01750373 + AVS = COS(BVS) 01760373 + IF (AVS - 0.99982E+00) 20060, 10060, 40060 01770373 +40060 IF (AVS - 0.99993E+00) 10060, 10060, 20060 01780373 +10060 IVPASS = IVPASS + 1 01790373 + WRITE (NUVI, 80002) IVTNUM 01800373 + GO TO 0061 01810373 +20060 IVFAIL = IVFAIL + 1 01820373 + RVCORR = 0.99987793217101 01830373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01840373 + 0061 CONTINUE 01850373 +CT007* TEST 7 VALUES NEAR 2*PI 01860373 + IVTNUM = 7 01870373 + BVS = (2.0 * PIVS) + 1.0 / 128.0 01880373 + AVS = COS(BVS) 01890373 + IF (AVS - 0.99992E+00) 20070, 10070, 40070 01900373 +40070 IF (AVS - 0.10001E+01) 10070, 10070, 20070 01910373 +10070 IVPASS = IVPASS + 1 01920373 + WRITE (NUVI, 80002) IVTNUM 01930373 + GO TO 0071 01940373 +20070 IVFAIL = IVFAIL + 1 01950373 + RVCORR = 0.99996948257710 01960373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01970373 + 0071 CONTINUE 01980373 +CT008* TEST 8 AN EXPRESSION PRESENTED TO COS 01990373 + IVTNUM = 8 02000373 + BVS = 350.0 02010373 + AVS = COS(BVS / 100.0) 02020373 + IF (AVS + 0.93651E+00) 20080, 10080, 40080 02030373 +40080 IF (AVS + 0.93641E+00) 10080, 10080, 20080 02040373 +10080 IVPASS = IVPASS + 1 02050373 + WRITE (NUVI, 80002) IVTNUM 02060373 + GO TO 0081 02070373 +20080 IVFAIL = IVFAIL + 1 02080373 + RVCORR = -0.93645668729080 02090373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02100373 + 0081 CONTINUE 02110373 +CT009* TEST 9 A NEGATIVE ARGUMENT 02120373 + IVTNUM = 9 02130373 + BVS = -1.5 02140373 + AVS = COS(BVS) 02150373 + IF (AVS - 0.70733E-01) 20090, 10090, 40090 02160373 +40090 IF (AVS - 0.70741E-01) 10090, 10090, 20090 02170373 +10090 IVPASS = IVPASS + 1 02180373 + WRITE (NUVI, 80002) IVTNUM 02190373 + GO TO 0091 02200373 +20090 IVFAIL = IVFAIL + 1 02210373 + RVCORR = 0.07073720166770 02220373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02230373 + 0091 CONTINUE 02240373 +CT010* TEST 10 TEST LARGE VALUES FOR ARGUMENT REDUCTION 02250373 + IVTNUM = 10 02260373 + AVS = COS(200.0) 02270373 + IF (AVS - 0.48716E+00) 20100, 10100, 40100 02280373 +40100 IF (AVS - 0.48722E+00) 10100, 10100, 20100 02290373 +10100 IVPASS = IVPASS + 1 02300373 + WRITE (NUVI, 80002) IVTNUM 02310373 + GO TO 0101 02320373 +20100 IVFAIL = IVFAIL + 1 02330373 + RVCORR = 0.48718767500701 02340373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02350373 + 0101 CONTINUE 02360373 +CT011* TEST 11 TEST LARGE VALUES FOR ARGUMENT REDUCTION 02370373 + IVTNUM = 11 02380373 + AVS = COS(-31416.0) 02390373 + IF (AVS - 0.99725E+00) 20110, 10110, 40110 02400373 +40110 IF (AVS - 0.99736E+00) 10110, 10110, 20110 02410373 +10110 IVPASS = IVPASS + 1 02420373 + WRITE (NUVI, 80002) IVTNUM 02430373 + GO TO 0111 02440373 +20110 IVFAIL = IVFAIL + 1 02450373 + RVCORR = 0.99730272627420 02460373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02470373 + 0111 CONTINUE 02480373 +CT012* TEST 12 TEST VALUES NEAR PI/2 02490373 + IVTNUM = 12 02500373 + AVS = COS(1.5707963268) 02510373 + IF (AVS + 0.50000E-04) 20120, 10120, 40120 02520373 +40120 IF (AVS - 0.50000E-04) 10120, 10120, 20120 02530373 +10120 IVPASS = IVPASS + 1 02540373 + WRITE (NUVI, 80002) IVTNUM 02550373 + GO TO 0121 02560373 +20120 IVFAIL = IVFAIL + 1 02570373 + RVCORR = 0.00000000000000 02580373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02590373 + 0121 CONTINUE 02600373 +CT013* TEST 13 (PI / 2) - 1/32 02610373 + IVTNUM = 13 02620373 + BVS = (1.5395463267) 02630373 + AVS = COS(BVS) 02640373 + IF (AVS - 0.31243E-01) 20130, 10130, 40130 02650373 +40130 IF (AVS - 0.31247E-01) 10130, 10130, 20130 02660373 +10130 IVPASS = IVPASS + 1 02670373 + WRITE (NUVI, 80002) IVTNUM 02680373 + GO TO 0131 02690373 +20130 IVFAIL = IVFAIL + 1 02700373 + RVCORR = 0.03124491398533 02710373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02720373 + 0131 CONTINUE 02730373 +CT014* TEST 14 (PI / 2) + 1/16 02740373 + IVTNUM = 14 02750373 + AVS = COS(1.6332963267) 02760373 + IF (AVS + 0.62463E-01) 20140, 10140, 40140 02770373 +40140 IF (AVS + 0.62456E-01) 10140, 10140, 20140 02780373 +10140 IVPASS = IVPASS + 1 02790373 + WRITE (NUVI, 80002) IVTNUM 02800373 + GO TO 0141 02810373 +20140 IVFAIL = IVFAIL + 1 02820373 + RVCORR = -0.06245931784238 02830373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02840373 + 0141 CONTINUE 02850373 +CT015* TEST 15 TEST VALUES NEAR 3*PI/2 02860373 + IVTNUM = 15 02870373 + BVS = 3.0 * PIVS / 2.0 02880373 + AVS = COS(BVS) 02890373 + IF (AVS + 0.50000E-04) 20150, 10150, 40150 02900373 +40150 IF (AVS - 0.50000E-04) 10150, 10150, 20150 02910373 +10150 IVPASS = IVPASS + 1 02920373 + WRITE (NUVI, 80002) IVTNUM 02930373 + GO TO 0151 02940373 +20150 IVFAIL = IVFAIL + 1 02950373 + RVCORR = 0.00000000000000 02960373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02970373 + 0151 CONTINUE 02980373 +CT016* TEST 16 TEST VALUES NEAR 3*PI/2 02990373 + IVTNUM = 16 03000373 + BVS = (3.0 * PIVS / 2.0) - 1.0 / 16.0 03010373 + AVS = COS(BVS) 03020373 + IF (AVS + 0.62463E-01) 20160, 10160, 40160 03030373 +40160 IF (AVS + 0.62456E-01) 10160, 10160, 20160 03040373 +10160 IVPASS = IVPASS + 1 03050373 + WRITE (NUVI, 80002) IVTNUM 03060373 + GO TO 0161 03070373 +20160 IVFAIL = IVFAIL + 1 03080373 + RVCORR = -0.06245931784238 03090373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03100373 + 0161 CONTINUE 03110373 +CT018* TEST 17 ARGUMENT OF LOW MAGNITUDE 03250373 + IVTNUM = 17 03260373 + BVS = -3.141593E-35 03270373 + AVS = COS(BVS) 03280373 + IF (AVS - 0.99995E+00) 20180, 10180, 40180 03290373 +40180 IF (AVS - 0.10001E+01) 10180, 10180, 20180 03300373 +10180 IVPASS = IVPASS + 1 03310373 + WRITE (NUVI, 80002) IVTNUM 03320373 + GO TO 0181 03330373 +20180 IVFAIL = IVFAIL + 1 03340373 + RVCORR = 1.00000000000000 03350373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03360373 + 0181 CONTINUE 03370373 +CT019* TEST 18 THE FUNCTION APPLIED TWICE 03380373 + IVTNUM = 18 03390373 + AVS = COS(PIVS / 4.0) * COS(3.0 * PIVS / 4.0) 03400373 + IF (AVS + 0.50003E+00) 20190, 10190, 40190 03410373 +40190 IF (AVS + 0.49997E+00) 10190, 10190, 20190 03420373 +10190 IVPASS = IVPASS + 1 03430373 + WRITE (NUVI, 80002) IVTNUM 03440373 + GO TO 0191 03450373 +20190 IVFAIL = IVFAIL + 1 03460373 + RVCORR = -0.50000000000000 03470373 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03480373 + 0191 CONTINUE 03490373 +C***** 03500373 +CBB** ********************** BBCSUM0 **********************************03510373 +C**** WRITE OUT TEST SUMMARY 03520373 +C**** 03530373 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03540373 + WRITE (I02, 90004) 03550373 + WRITE (I02, 90014) 03560373 + WRITE (I02, 90004) 03570373 + WRITE (I02, 90020) IVPASS 03580373 + WRITE (I02, 90022) IVFAIL 03590373 + WRITE (I02, 90024) IVDELE 03600373 + WRITE (I02, 90026) IVINSP 03610373 + WRITE (I02, 90028) IVTOTN, IVTOTL 03620373 +CBE** ********************** BBCSUM0 **********************************03630373 +CBB** ********************** BBCFOOT0 **********************************03640373 +C**** WRITE OUT REPORT FOOTINGS 03650373 +C**** 03660373 + WRITE (I02,90016) ZPROG, ZPROG 03670373 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03680373 + WRITE (I02,90019) 03690373 +CBE** ********************** BBCFOOT0 **********************************03700373 +CBB** ********************** BBCFMT0A **********************************03710373 +C**** FORMATS FOR TEST DETAIL LINES 03720373 +C**** 03730373 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03740373 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03750373 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03760373 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03770373 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03780373 + 1I6,/," ",15X,"CORRECT= " ,I6) 03790373 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03800373 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03810373 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03820373 + 1A21,/," ",16X,"CORRECT= " ,A21) 03830373 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03840373 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03850373 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03860373 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03870373 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03880373 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03890373 +80050 FORMAT (" ",48X,A31) 03900373 +CBE** ********************** BBCFMT0A **********************************03910373 +CBB** ********************** BBCFMT0B **********************************03920373 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03930373 +C**** 03940373 +90002 FORMAT ("1") 03950373 +90004 FORMAT (" ") 03960373 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03970373 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03980373 +90008 FORMAT (" ",21X,A13,A17) 03990373 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04000373 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04010373 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04020373 + 1 7X,"REMARKS",24X) 04030373 +90014 FORMAT (" ","----------------------------------------------" , 04040373 + 1 "---------------------------------" ) 04050373 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04060373 +C**** 04070373 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04080373 +C**** 04090373 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04100373 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04110373 + 1 A13) 04120373 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04130373 +C**** 04140373 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04150373 +C**** 04160373 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04170373 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04180373 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04190373 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04200373 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04210373 +CBE** ********************** BBCFMT0B **********************************04220373 +C***** 04230373 +C***** END OF TEST SEGMENT 189 04240373 + STOP 04250373 + END 04260373 + 04270373 diff --git a/Fortran/UnitTests/fcvs21_f95/FM373.reference_output b/Fortran/UnitTests/fcvs21_f95/FM373.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM373.reference_output @@ -0,0 +1,52 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM373BEGIN* TEST RESULTS - FM373 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XCOS - (189) INTRINSIC FUNCTIONS + + COS (COSINE) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 18 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + + ------------------------------------------------------------------------------- + + 18 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 18 OF 18 TESTS EXECUTED + + *FM373END* END OF TEST - FM373 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM374.f b/Fortran/UnitTests/fcvs21_f95/FM374.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM374.f @@ -0,0 +1,342 @@ + PROGRAM FM374 + +C***********************************************************************00010374 +C***** FORTRAN 77 00020374 +C***** FM374 00030374 +C***** XTAN - (191) 00040374 +C***** 00050374 +C***********************************************************************00060374 +C***** GENERAL PURPOSE SUBSET REF 00070374 +C***** TEST INTRINSIC FUNCTION TAN 15.3 00080374 +C***** TABLE 5 00090374 +C***** 00100374 +CBB** ********************** BBCCOMNT **********************************00110374 +C**** 00120374 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130374 +C**** VERSION 2.1 00140374 +C**** 00150374 +C**** 00160374 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170374 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180374 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190374 +C**** BUILDING 225 RM A266 00200374 +C**** GAITHERSBURG, MD 20899 00210374 +C**** 00220374 +C**** 00230374 +C**** 00240374 +CBE** ********************** BBCCOMNT **********************************00250374 +CBB** ********************** BBCINITA **********************************00260374 +C**** SPECIFICATION STATEMENTS 00270374 +C**** 00280374 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290374 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300374 +CBE** ********************** BBCINITA **********************************00310374 +CBB** ********************** BBCINITB **********************************00320374 +C**** INITIALIZE SECTION 00330374 + DATA ZVERS, ZVERSD, ZDATE 00340374 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350374 + DATA ZCOMPL, ZNAME, ZTAPE 00360374 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370374 + DATA ZPROJ, ZTAPED, ZPROG 00380374 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390374 + DATA REMRKS /' '/ 00400374 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410374 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420374 +C**** 00430374 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440374 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450374 +CZ03 ZPROG = 'PROGRAM NAME' 00460374 +CZ04 ZDATE = 'DATE OF TEST' 00470374 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480374 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490374 +CZ07 ZNAME = 'NAME OF USER' 00500374 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510374 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520374 +C 00530374 + IVPASS = 0 00540374 + IVFAIL = 0 00550374 + IVDELE = 0 00560374 + IVINSP = 0 00570374 + IVTOTL = 0 00580374 + IVTOTN = 0 00590374 + ICZERO = 0 00600374 +C 00610374 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620374 + I01 = 05 00630374 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640374 + I02 = 06 00650374 +C 00660374 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670374 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680374 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690374 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700374 +C 00710374 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720374 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730374 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740374 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750374 +C 00760374 +CBE** ********************** BBCINITB **********************************00770374 + NUVI = I02 00780374 + IVTOTL = 12 00790374 + ZPROG = 'FM374' 00800374 +CBB** ********************** BBCHED0A **********************************00810374 +C**** 00820374 +C**** WRITE REPORT TITLE 00830374 +C**** 00840374 + WRITE (I02, 90002) 00850374 + WRITE (I02, 90006) 00860374 + WRITE (I02, 90007) 00870374 + WRITE (I02, 90008) ZVERS, ZVERSD 00880374 + WRITE (I02, 90009) ZPROG, ZPROG 00890374 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900374 +CBE** ********************** BBCHED0A **********************************00910374 +C***** 00920374 +C***** HEADER FOR SEGMENT 191 00930374 + WRITE(NUVI,19100) 00940374 +19100 FORMAT(" ", / " XTAN - (191) INTRINSIC FUNCTIONS" // 00950374 + 1 " TAN (TANGENT)" // 00960374 + 2 " SUBSET REF. - 15.3" ) 00970374 +CBB** ********************** BBCHED0B **********************************00980374 +C**** WRITE DETAIL REPORT HEADERS 00990374 +C**** 01000374 + WRITE (I02,90004) 01010374 + WRITE (I02,90004) 01020374 + WRITE (I02,90013) 01030374 + WRITE (I02,90014) 01040374 + WRITE (I02,90015) IVTOTL 01050374 +CBE** ********************** BBCHED0B **********************************01060374 +C***** 01070374 + PIVS = 3.1415926535897932384626434 01080374 +C***** 01090374 +CT001* TEST 1 ZERO (0.0), SINCE TAN(0) = 0 01100374 + IVTNUM = 1 01110374 + BVS = 0.0 01120374 + AVS = TAN(BVS) 01130374 + IF (AVS + 0.00005) 20010, 10010, 40010 01140374 +40010 IF (AVS - 0.00005) 10010, 10010, 20010 01150374 +10010 IVPASS = IVPASS + 1 01160374 + WRITE (NUVI, 80002) IVTNUM 01170374 + GO TO 0011 01180374 +20010 IVFAIL = IVFAIL + 1 01190374 + RVCORR = 0.0 01200374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01210374 + 0011 CONTINUE 01220374 +CT002* TEST 2 2*PI 01230374 + IVTNUM = 2 01240374 + BVS = 6.2831853071 01250374 + AVS = TAN(BVS) 01260374 + IF (AVS + 0.00005) 20020, 10020, 40020 01270374 +40020 IF (AVS - 0.00005) 10020, 10020, 20020 01280374 +10020 IVPASS = IVPASS + 1 01290374 + WRITE (NUVI, 80002) IVTNUM 01300374 + GO TO 0021 01310374 +20020 IVFAIL = IVFAIL + 1 01320374 + RVCORR = 0.0 01330374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01340374 + 0021 CONTINUE 01350374 +CT003* TEST 3 3*PI 01360374 + IVTNUM = 3 01370374 + BVS = 9.424777960 01380374 + AVS = TAN(BVS) 01390374 + IF (AVS + 0.00005) 20030, 10030, 40030 01400374 +40030 IF (AVS - 0.00005) 10030, 10030, 20030 01410374 +10030 IVPASS = IVPASS + 1 01420374 + WRITE (NUVI, 80002) IVTNUM 01430374 + GO TO 0031 01440374 +20030 IVFAIL = IVFAIL + 1 01450374 + RVCORR = 0.0 01460374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01470374 + 0031 CONTINUE 01480374 +CT004* TEST 4 PI/4 01490374 + IVTNUM = 4 01500374 + AVS = TAN(PIVS / 4.0) 01510374 + IF (AVS - 0.99995) 20040, 10040, 40040 01520374 +40040 IF (AVS - 1.0001) 10040, 10040, 20040 01530374 +10040 IVPASS = IVPASS + 1 01540374 + WRITE (NUVI, 80002) IVTNUM 01550374 + GO TO 0041 01560374 +20040 IVFAIL = IVFAIL + 1 01570374 + RVCORR = 1.0 01580374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01590374 + 0041 CONTINUE 01600374 +CT005* TEST 5 5*PI/4 01610374 + IVTNUM = 5 01620374 + BVS = 5.0 * PIVS / 4.0 01630374 + AVS = TAN(BVS) 01640374 + IF (AVS - 0.99995) 20050, 10050, 40050 01650374 +40050 IF (AVS - 1.0001) 10050, 10050, 20050 01660374 +10050 IVPASS = IVPASS + 1 01670374 + WRITE (NUVI, 80002) IVTNUM 01680374 + GO TO 0051 01690374 +20050 IVFAIL = IVFAIL + 1 01700374 + RVCORR = 1.0 01710374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01720374 + 0051 CONTINUE 01730374 +CT006* TEST 6 A NEGATIVE VALUE 01740374 + IVTNUM = 6 01750374 + BVS = -2.0 / 1.0 01760374 + AVS = TAN(BVS) 01770374 + IF (AVS - 2.1849) 20060, 10060, 40060 01780374 +40060 IF (AVS - 2.1852) 10060, 10060, 20060 01790374 +10060 IVPASS = IVPASS + 1 01800374 + WRITE (NUVI, 80002) IVTNUM 01810374 + GO TO 0061 01820374 +20060 IVFAIL = IVFAIL + 1 01830374 + RVCORR = 2.18503986326151 01840374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01850374 + 0061 CONTINUE 01860374 +CT007* TEST 7 A POSITIVE VALUE 01870374 + IVTNUM = 7 01880374 + BVS = 350.0 / 100.0 01890374 + AVS = TAN(BVS) 01900374 + IF (AVS - 0.37456) 20070, 10070, 40070 01910374 +40070 IF (AVS - 0.37461) 10070, 10070, 20070 01920374 +10070 IVPASS = IVPASS + 1 01930374 + WRITE (NUVI, 80002) IVTNUM 01940374 + GO TO 0071 01950374 +20070 IVFAIL = IVFAIL + 1 01960374 + RVCORR = 0.37458564015859 01970374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01980374 + 0071 CONTINUE 01990374 +CT008* TEST 8 (PI / 2) - 1/8 02000374 + IVTNUM = 8 02010374 + BVS = 1.4457963267 02020374 + AVS = TAN(BVS) 02030374 + IF (AVS - 7.9578) 20080, 10080, 40080 02040374 +40080 IF (AVS - 7.9587) 10080, 10080, 20080 02050374 +10080 IVPASS = IVPASS + 1 02060374 + WRITE (NUVI, 80002) IVTNUM 02070374 + GO TO 0081 02080374 +20080 IVFAIL = IVFAIL + 1 02090374 + RVCORR = 7.95828986586701 02100374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02110374 + 0081 CONTINUE 02120374 +CT009* TEST 9 (PI / 2) + 1/256 02130374 + IVTNUM = 9 02140374 + BVS = 1.5747025767 02150374 + AVS = TAN(BVS) 02160374 + IF (AVS + 256.02) 20090, 10090, 40090 02170374 +40090 IF (AVS + 255.98) 10090, 10090, 20090 02180374 +10090 IVPASS = IVPASS + 1 02190374 + WRITE (NUVI, 80002) IVTNUM 02200374 + GO TO 0091 02210374 +20090 IVFAIL = IVFAIL + 1 02220374 + RVCORR = -255.99869791534212 02230374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02240374 + 0091 CONTINUE 02250374 +CT012* TEST 10 LARGE ARGUMENT TO TEST ARGUMENT REDUCTION 02510374 + IVTNUM = 10 02520374 + AVS = TAN(2000.0) 02530374 + IF (AVS + 2.5312) 20120, 10120, 40120 02540374 +40120 IF (AVS + 2.5308) 10120, 10120, 20120 02550374 +10120 IVPASS = IVPASS + 1 02560374 + WRITE (NUVI, 80002) IVTNUM 02570374 + GO TO 0121 02580374 +20120 IVFAIL = IVFAIL + 1 02590374 + RVCORR = -2.53099832809334 02600374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02610374 + 0121 CONTINUE 02620374 +CT013* TEST 11 ARGUMENT OF LOW MAGNITUDE 02630374 + IVTNUM = 11 02640374 + BVS = PIVS * 1.0E-35 02650374 + AVS = TAN(BVS) 02660374 + IF (AVS - 3.1414E-35) 20130, 10130, 40130 02670374 +40130 IF (AVS - 3.1418E-35) 10130, 10130, 20130 02680374 +10130 IVPASS = IVPASS + 1 02690374 + WRITE (NUVI, 80002) IVTNUM 02700374 + GO TO 0131 02710374 +20130 IVFAIL = IVFAIL + 1 02720374 + RVCORR = 3.14159265358979E-35 02730374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02740374 + 0131 CONTINUE 02750374 +CT014* TEST 12 THE FUNCTION APPLIED TWICE 02760374 + IVTNUM = 12 02770374 + AVS = TAN(PIVS / 6.0) * TAN(PIVS / 6.0) 02780374 + IF (AVS - 0.33331) 20140, 10140, 40140 02790374 +40140 IF (AVS - 0.33335) 10140, 10140, 20140 02800374 +10140 IVPASS = IVPASS + 1 02810374 + WRITE (NUVI, 80002) IVTNUM 02820374 + GO TO 0141 02830374 +20140 IVFAIL = IVFAIL + 1 02840374 + RVCORR = 0.33333333333333 02850374 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02860374 + 0141 CONTINUE 02870374 +C***** 02880374 +CBB** ********************** BBCSUM0 **********************************02890374 +C**** WRITE OUT TEST SUMMARY 02900374 +C**** 02910374 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02920374 + WRITE (I02, 90004) 02930374 + WRITE (I02, 90014) 02940374 + WRITE (I02, 90004) 02950374 + WRITE (I02, 90020) IVPASS 02960374 + WRITE (I02, 90022) IVFAIL 02970374 + WRITE (I02, 90024) IVDELE 02980374 + WRITE (I02, 90026) IVINSP 02990374 + WRITE (I02, 90028) IVTOTN, IVTOTL 03000374 +CBE** ********************** BBCSUM0 **********************************03010374 +CBB** ********************** BBCFOOT0 **********************************03020374 +C**** WRITE OUT REPORT FOOTINGS 03030374 +C**** 03040374 + WRITE (I02,90016) ZPROG, ZPROG 03050374 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03060374 + WRITE (I02,90019) 03070374 +CBE** ********************** BBCFOOT0 **********************************03080374 +CBB** ********************** BBCFMT0A **********************************03090374 +C**** FORMATS FOR TEST DETAIL LINES 03100374 +C**** 03110374 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03120374 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03130374 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03140374 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03150374 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03160374 + 1I6,/," ",15X,"CORRECT= " ,I6) 03170374 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03180374 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03190374 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03200374 + 1A21,/," ",16X,"CORRECT= " ,A21) 03210374 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03220374 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03230374 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03240374 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03250374 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03260374 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03270374 +80050 FORMAT (" ",48X,A31) 03280374 +CBE** ********************** BBCFMT0A **********************************03290374 +CBB** ********************** BBCFMT0B **********************************03300374 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03310374 +C**** 03320374 +90002 FORMAT ("1") 03330374 +90004 FORMAT (" ") 03340374 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03350374 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03360374 +90008 FORMAT (" ",21X,A13,A17) 03370374 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03380374 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03390374 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03400374 + 1 7X,"REMARKS",24X) 03410374 +90014 FORMAT (" ","----------------------------------------------" , 03420374 + 1 "---------------------------------" ) 03430374 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03440374 +C**** 03450374 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03460374 +C**** 03470374 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03480374 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03490374 + 1 A13) 03500374 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03510374 +C**** 03520374 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03530374 +C**** 03540374 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03550374 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03560374 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03570374 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03580374 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03590374 +CBE** ********************** BBCFMT0B **********************************03600374 +C***** 03610374 +C***** END OF TEST SEGMENT 191 03620374 + STOP 03630374 + END 03640374 + 03650374 diff --git a/Fortran/UnitTests/fcvs21_f95/FM374.reference_output b/Fortran/UnitTests/fcvs21_f95/FM374.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM374.reference_output @@ -0,0 +1,46 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM374BEGIN* TEST RESULTS - FM374 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XTAN - (191) INTRINSIC FUNCTIONS + + TAN (TANGENT) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 12 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ------------------------------------------------------------------------------- + + 12 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 12 OF 12 TESTS EXECUTED + + *FM374END* END OF TEST - FM374 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM375.f b/Fortran/UnitTests/fcvs21_f95/FM375.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM375.f @@ -0,0 +1,343 @@ + PROGRAM FM375 + +C***********************************************************************00010375 +C***** FORTRAN 77 00020375 +C***** FM375 00030375 +C***** XASIN - (193) 00040375 +C***** 00050375 +C***********************************************************************00060375 +C***** GENERAL PURPOSE SUBSET REF 00070375 +C***** TEST INTRINSIC FUNCTION ASIN, ACOS 15.3 00080375 +C***** TABLE 5 00090375 +C***** 00100375 +CBB** ********************** BBCCOMNT **********************************00110375 +C**** 00120375 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130375 +C**** VERSION 2.1 00140375 +C**** 00150375 +C**** 00160375 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170375 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180375 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190375 +C**** BUILDING 225 RM A266 00200375 +C**** GAITHERSBURG, MD 20899 00210375 +C**** 00220375 +C**** 00230375 +C**** 00240375 +CBE** ********************** BBCCOMNT **********************************00250375 +CBB** ********************** BBCINITA **********************************00260375 +C**** SPECIFICATION STATEMENTS 00270375 +C**** 00280375 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290375 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300375 +CBE** ********************** BBCINITA **********************************00310375 +CBB** ********************** BBCINITB **********************************00320375 +C**** INITIALIZE SECTION 00330375 + DATA ZVERS, ZVERSD, ZDATE 00340375 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350375 + DATA ZCOMPL, ZNAME, ZTAPE 00360375 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370375 + DATA ZPROJ, ZTAPED, ZPROG 00380375 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390375 + DATA REMRKS /' '/ 00400375 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410375 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420375 +C**** 00430375 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440375 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450375 +CZ03 ZPROG = 'PROGRAM NAME' 00460375 +CZ04 ZDATE = 'DATE OF TEST' 00470375 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480375 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490375 +CZ07 ZNAME = 'NAME OF USER' 00500375 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510375 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520375 +C 00530375 + IVPASS = 0 00540375 + IVFAIL = 0 00550375 + IVDELE = 0 00560375 + IVINSP = 0 00570375 + IVTOTL = 0 00580375 + IVTOTN = 0 00590375 + ICZERO = 0 00600375 +C 00610375 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620375 + I01 = 05 00630375 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640375 + I02 = 06 00650375 +C 00660375 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670375 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680375 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690375 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700375 +C 00710375 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720375 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730375 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740375 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750375 +C 00760375 +CBE** ********************** BBCINITB **********************************00770375 + NUVI = I02 00780375 + IVTOTL = 12 00790375 + ZPROG = 'FM375' 00800375 +CBB** ********************** BBCHED0A **********************************00810375 +C**** 00820375 +C**** WRITE REPORT TITLE 00830375 +C**** 00840375 + WRITE (I02, 90002) 00850375 + WRITE (I02, 90006) 00860375 + WRITE (I02, 90007) 00870375 + WRITE (I02, 90008) ZVERS, ZVERSD 00880375 + WRITE (I02, 90009) ZPROG, ZPROG 00890375 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900375 +CBE** ********************** BBCHED0A **********************************00910375 +C***** 00920375 +C***** HEADER FOR SEGMENT 193 00930375 + WRITE(NUVI,19300) 00940375 +19300 FORMAT(" ", / " XASIN - (193) INTRINSIC FUNCTIONS" // 00950375 + 1 " ASIN, ACOS (ARCSIN, ARCCOSINE) " // 00960375 + 2 " SUBSET REF. - 15.3" ) 00970375 +CBB** ********************** BBCHED0B **********************************00980375 +C**** WRITE DETAIL REPORT HEADERS 00990375 +C**** 01000375 + WRITE (I02,90004) 01010375 + WRITE (I02,90004) 01020375 + WRITE (I02,90013) 01030375 + WRITE (I02,90014) 01040375 + WRITE (I02,90015) IVTOTL 01050375 +CBE** ********************** BBCHED0B **********************************01060375 +C***** 01070375 + WRITE(NUVI,19301) 01080375 +19301 FORMAT("0",8X,"TEST OF ASIN" ) 01090375 +C***** 01100375 +CT001* TEST 1 -1 TO CHECK PRINCIPAL VALUE AT ENDPOINTS 01110375 + IVTNUM = 1 01120375 + BVS = -1.0 01130375 + AVS = ASIN(BVS) 01140375 + IF (AVS + 0.15709E+01) 20010, 10010, 40010 01150375 +40010 IF (AVS + 0.15707E+01) 10010, 10010, 20010 01160375 +10010 IVPASS = IVPASS + 1 01170375 + WRITE (NUVI, 80002) IVTNUM 01180375 + GO TO 0011 01190375 +20010 IVFAIL = IVFAIL + 1 01200375 + RVCORR = -1.57079632679490 01210375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01220375 + 0011 CONTINUE 01230375 +CT002* TEST 2 +1 TO CHECK PRINCIPAL VALUE AT ENDPOINTS 01240375 + IVTNUM = 2 01250375 + AVS = ASIN(1.0) 01260375 + IF (AVS - 0.15707E+01) 20020, 10020, 40020 01270375 +40020 IF (AVS - 0.15709E+01) 10020, 10020, 20020 01280375 +10020 IVPASS = IVPASS + 1 01290375 + WRITE (NUVI, 80002) IVTNUM 01300375 + GO TO 0021 01310375 +20020 IVFAIL = IVFAIL + 1 01320375 + RVCORR = 1.57079632679490 01330375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01340375 + 0021 CONTINUE 01350375 +CT003* TEST 3 THE VALUE -SQRT(0.5) 01360375 + IVTNUM = 3 01370375 + BVS = -SQRT(2.0) / 2.0 01380375 + AVS = ASIN(BVS) 01390375 + IF (AVS + 0.78544E+00) 20030, 10030, 40030 01400375 +40030 IF (AVS + 0.78535E+00) 10030, 10030, 20030 01410375 +10030 IVPASS = IVPASS + 1 01420375 + WRITE (NUVI, 80002) IVTNUM 01430375 + GO TO 0031 01440375 +20030 IVFAIL = IVFAIL + 1 01450375 + RVCORR = -0.78539816339745 01460375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01470375 + 0031 CONTINUE 01480375 +CT004* TEST 4 THE VALUE 0.5 01490375 + IVTNUM = 4 01500375 + AVS = ASIN(1.0 / 2.0) 01510375 + IF (AVS - 0.52357E+00) 20040, 10040, 40040 01520375 +40040 IF (AVS - 0.52363E+00) 10040, 10040, 20040 01530375 +10040 IVPASS = IVPASS + 1 01540375 + WRITE (NUVI, 80002) IVTNUM 01550375 + GO TO 0041 01560375 +20040 IVFAIL = IVFAIL + 1 01570375 + RVCORR = 0.52359877559830 01580375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01590375 + 0041 CONTINUE 01600375 +CT005* TEST 5 AN ARGUMENT OF LOW MAGNITUDE 01610375 + IVTNUM = 5 01620375 + AVS = ASIN(-1.0E-33) 01630375 + IF (AVS + 0.10001E-32) 20050, 10050, 40050 01640375 +40050 IF (AVS + 0.99995E-33) 10050, 10050, 20050 01650375 +10050 IVPASS = IVPASS + 1 01660375 + WRITE (NUVI, 80002) IVTNUM 01670375 + GO TO 0051 01680375 +20050 IVFAIL = IVFAIL + 1 01690375 + RVCORR = -1.00000000000000E-33 01700375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01710375 + 0051 CONTINUE 01720375 +C***** 01730375 + WRITE(NUVI,19307) 01740375 +19307 FORMAT("0",8X,"TEST OF ACOS" ) 01750375 +C***** 01760375 +CT006* TEST 6 -1 TO TEST PRINCIPAL VALUE AT ENDPOINTS 01770375 + IVTNUM = 6 01780375 + BVS = -1.0 01790375 + AVS = ACOS(BVS) 01800375 + IF (AVS - 0.31414E+01) 20060, 10060, 40060 01810375 +40060 IF (AVS - 0.31418E+01) 10060, 10060, 20060 01820375 +10060 IVPASS = IVPASS + 1 01830375 + WRITE (NUVI, 80002) IVTNUM 01840375 + GO TO 0061 01850375 +20060 IVFAIL = IVFAIL + 1 01860375 + RVCORR = 3.14159265358980 01870375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01880375 + 0061 CONTINUE 01890375 +CT007* TEST 7 01900375 + IVTNUM = 7 01910375 + AVS = ACOS(1.0) 01920375 + IF (AVS + 0.50000E-04) 20070, 10070, 40070 01930375 +40070 IF (AVS - 0.50000E-04) 10070, 10070, 20070 01940375 +10070 IVPASS = IVPASS + 1 01950375 + WRITE (NUVI, 80002) IVTNUM 01960375 + GO TO 0071 01970375 +20070 IVFAIL = IVFAIL + 1 01980375 + RVCORR = 0.00000000000000 01990375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02000375 + 0071 CONTINUE 02010375 +CT008* TEST 8 02020375 + IVTNUM = 8 02030375 + BVS = -SQRT(2.0) / 2.0 02040375 + AVS = ACOS(BVS) 02050375 + IF (AVS - 0.23560E+01) 20080, 10080, 40080 02060375 +40080 IF (AVS - 0.23564E+01) 10080, 10080, 20080 02070375 +10080 IVPASS = IVPASS + 1 02080375 + WRITE (NUVI, 80002) IVTNUM 02090375 + GO TO 0081 02100375 +20080 IVFAIL = IVFAIL + 1 02110375 + RVCORR = 2.35619449019234 02120375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02130375 + 0081 CONTINUE 02140375 +CT009* TEST 9 02150375 + IVTNUM = 9 02160375 + AVS = ACOS(1.0 / 2.0) 02170375 + IF (AVS - 0.10471E+01) 20090, 10090, 40090 02180375 +40090 IF (AVS - 0.10473E+01) 10090, 10090, 20090 02190375 +10090 IVPASS = IVPASS + 1 02200375 + WRITE (NUVI, 80002) IVTNUM 02210375 + GO TO 0091 02220375 +20090 IVFAIL = IVFAIL + 1 02230375 + RVCORR = 1.04719755119660 02240375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02250375 + 0091 CONTINUE 02260375 +CT010* TEST 10 AN ARGUMENT OF LOW MAGNITUDE 02270375 + IVTNUM = 10 02280375 + AVS = ACOS(-1.0E-33) 02290375 + IF (AVS - 0.15707E+01) 20100, 10100, 40100 02300375 +40100 IF (AVS - 0.15709E+01) 10100, 10100, 20100 02310375 +10100 IVPASS = IVPASS + 1 02320375 + WRITE (NUVI, 80002) IVTNUM 02330375 + GO TO 0101 02340375 +20100 IVFAIL = IVFAIL + 1 02350375 + RVCORR = 1.57079632679490 02360375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02370375 + 0101 CONTINUE 02380375 +CT011* TEST 11 COMPARISON OF ASIN AND ACOS TO TEST RELATIONSHIP 02390375 + IVTNUM = 11 02400375 + BVS = ASIN(SQRT(3.0) / 3.0) 02410375 + CVS = ACOS(SQRT(3.0) / 3.0) 02420375 + AVS = (BVS + CVS) * 2.0 02430375 + IF (AVS - 0.31414E+01) 20110, 10110, 40110 02440375 +40110 IF (AVS - 0.31418E+01) 10110, 10110, 20110 02450375 +10110 IVPASS = IVPASS + 1 02460375 + WRITE (NUVI, 80002) IVTNUM 02470375 + GO TO 0111 02480375 +20110 IVFAIL = IVFAIL + 1 02490375 + RVCORR = 3.14159265358979 02500375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02510375 + 0111 CONTINUE 02520375 +CT012* TEST 12 COMPARISON OF ASIN AND ACOS TO TEST RELATIONSHIP 02530375 + IVTNUM = 12 02540375 + AVS = (ASIN(+0.25) + ACOS(+0.25)) * 2.0 02550375 + IF (AVS - 0.31414E+01) 20120, 10120, 40120 02560375 +40120 IF (AVS - 0.31418E+01) 10120, 10120, 20120 02570375 +10120 IVPASS = IVPASS + 1 02580375 + WRITE (NUVI, 80002) IVTNUM 02590375 + GO TO 0121 02600375 +20120 IVFAIL = IVFAIL + 1 02610375 + RVCORR = 3.14159265358979 02620375 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02630375 + 0121 CONTINUE 02640375 +C***** 02650375 +CBB** ********************** BBCSUM0 **********************************02660375 +C**** WRITE OUT TEST SUMMARY 02670375 +C**** 02680375 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02690375 + WRITE (I02, 90004) 02700375 + WRITE (I02, 90014) 02710375 + WRITE (I02, 90004) 02720375 + WRITE (I02, 90020) IVPASS 02730375 + WRITE (I02, 90022) IVFAIL 02740375 + WRITE (I02, 90024) IVDELE 02750375 + WRITE (I02, 90026) IVINSP 02760375 + WRITE (I02, 90028) IVTOTN, IVTOTL 02770375 +CBE** ********************** BBCSUM0 **********************************02780375 +CBB** ********************** BBCFOOT0 **********************************02790375 +C**** WRITE OUT REPORT FOOTINGS 02800375 +C**** 02810375 + WRITE (I02,90016) ZPROG, ZPROG 02820375 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02830375 + WRITE (I02,90019) 02840375 +CBE** ********************** BBCFOOT0 **********************************02850375 +CBB** ********************** BBCFMT0A **********************************02860375 +C**** FORMATS FOR TEST DETAIL LINES 02870375 +C**** 02880375 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02890375 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02900375 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02910375 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02920375 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02930375 + 1I6,/," ",15X,"CORRECT= " ,I6) 02940375 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02950375 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02960375 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02970375 + 1A21,/," ",16X,"CORRECT= " ,A21) 02980375 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02990375 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03000375 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03010375 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03020375 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03030375 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03040375 +80050 FORMAT (" ",48X,A31) 03050375 +CBE** ********************** BBCFMT0A **********************************03060375 +CBB** ********************** BBCFMT0B **********************************03070375 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03080375 +C**** 03090375 +90002 FORMAT ("1") 03100375 +90004 FORMAT (" ") 03110375 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03120375 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03130375 +90008 FORMAT (" ",21X,A13,A17) 03140375 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03150375 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03160375 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03170375 + 1 7X,"REMARKS",24X) 03180375 +90014 FORMAT (" ","----------------------------------------------" , 03190375 + 1 "---------------------------------" ) 03200375 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03210375 +C**** 03220375 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03230375 +C**** 03240375 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03250375 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03260375 + 1 A13) 03270375 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03280375 +C**** 03290375 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03300375 +C**** 03310375 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03320375 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03330375 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03340375 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03350375 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03360375 +CBE** ********************** BBCFMT0B **********************************03370375 +C***** 03380375 +C***** END OF TEST SEGMENT 193 03390375 + STOP 03400375 + END 03410375 diff --git a/Fortran/UnitTests/fcvs21_f95/FM375.reference_output b/Fortran/UnitTests/fcvs21_f95/FM375.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM375.reference_output @@ -0,0 +1,48 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM375BEGIN* TEST RESULTS - FM375 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XASIN - (193) INTRINSIC FUNCTIONS + + ASIN, ACOS (ARCSIN, ARCCOSINE) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 12 TESTS + +0 TEST OF ASIN + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS +0 TEST OF ACOS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ------------------------------------------------------------------------------- + + 12 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 12 OF 12 TESTS EXECUTED + + *FM375END* END OF TEST - FM375 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM376.f b/Fortran/UnitTests/fcvs21_f95/FM376.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM376.f @@ -0,0 +1,363 @@ + PROGRAM FM376 + +C***********************************************************************00010376 +C***** FORTRAN 77 00020376 +C***** FM376 00030376 +C***** XATAN - (195) 00040376 +C***** 00050376 +C***********************************************************************00060376 +C***** GENERAL PURPOSE SUBSET REF 00070376 +C***** TEST INTRINSIC FUNCTION ATAN, ATAN2 15.3 00080376 +C***** INTRINSIC FUNCTION SQRT ASSUMED WORKING TABLE 5 00090376 +C***** 00100376 +CBB** ********************** BBCCOMNT **********************************00110376 +C**** 00120376 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130376 +C**** VERSION 2.1 00140376 +C**** 00150376 +C**** 00160376 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170376 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180376 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190376 +C**** BUILDING 225 RM A266 00200376 +C**** GAITHERSBURG, MD 20899 00210376 +C**** 00220376 +C**** 00230376 +C**** 00240376 +CBE** ********************** BBCCOMNT **********************************00250376 +CBB** ********************** BBCINITA **********************************00260376 +C**** SPECIFICATION STATEMENTS 00270376 +C**** 00280376 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290376 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300376 +CBE** ********************** BBCINITA **********************************00310376 +CBB** ********************** BBCINITB **********************************00320376 +C**** INITIALIZE SECTION 00330376 + DATA ZVERS, ZVERSD, ZDATE 00340376 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350376 + DATA ZCOMPL, ZNAME, ZTAPE 00360376 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370376 + DATA ZPROJ, ZTAPED, ZPROG 00380376 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390376 + DATA REMRKS /' '/ 00400376 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410376 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420376 +C**** 00430376 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440376 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450376 +CZ03 ZPROG = 'PROGRAM NAME' 00460376 +CZ04 ZDATE = 'DATE OF TEST' 00470376 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480376 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490376 +CZ07 ZNAME = 'NAME OF USER' 00500376 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510376 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520376 +C 00530376 + IVPASS = 0 00540376 + IVFAIL = 0 00550376 + IVDELE = 0 00560376 + IVINSP = 0 00570376 + IVTOTL = 0 00580376 + IVTOTN = 0 00590376 + ICZERO = 0 00600376 +C 00610376 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620376 + I01 = 05 00630376 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640376 + I02 = 06 00650376 +C 00660376 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670376 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680376 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690376 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700376 +C 00710376 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720376 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730376 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740376 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750376 +C 00760376 +CBE** ********************** BBCINITB **********************************00770376 + NUVI = I02 00780376 + IVTOTL = 13 00790376 + ZPROG = 'FM376' 00800376 +CBB** ********************** BBCHED0A **********************************00810376 +C**** 00820376 +C**** WRITE REPORT TITLE 00830376 +C**** 00840376 + WRITE (I02, 90002) 00850376 + WRITE (I02, 90006) 00860376 + WRITE (I02, 90007) 00870376 + WRITE (I02, 90008) ZVERS, ZVERSD 00880376 + WRITE (I02, 90009) ZPROG, ZPROG 00890376 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900376 +CBE** ********************** BBCHED0A **********************************00910376 +C***** 00920376 +C***** HEADER FOR SEGMENT 195 00930376 + WRITE(NUVI,19500) 00940376 +19500 FORMAT(" ", / " XATAN - (195) INTRINSIC FUNCTIONS" // 00950376 + 1 " ATAN, ATAN2 (ARCTANGENT)" // 00960376 + 2 " SUBSET REF. - 15.3" ) 00970376 +CBB** ********************** BBCHED0B **********************************00980376 +C**** WRITE DETAIL REPORT HEADERS 00990376 +C**** 01000376 + WRITE (I02,90004) 01010376 + WRITE (I02,90004) 01020376 + WRITE (I02,90013) 01030376 + WRITE (I02,90014) 01040376 + WRITE (I02,90015) IVTOTL 01050376 +CBE** ********************** BBCHED0B **********************************01060376 +C***** 01070376 + WRITE(NUVI,19501) 01080376 +C***** 01090376 +19501 FORMAT(/ 8X, "TEST OF ATAN" ) 01100376 +C***** 01110376 +CT001* TEST 1 TEST LARGE VALUES TO TEST SINGULARITY 01120376 + IVTNUM = 1 01130376 + BVS = 500.0 01140376 + AVS = ATAN(BVS) 01150376 + IF (AVS - 0.15687E+01) 20010, 10010, 40010 01160376 +40010 IF (AVS - 0.15689E+01) 10010, 10010, 20010 01170376 +10010 IVPASS = IVPASS + 1 01180376 + WRITE (NUVI, 80002) IVTNUM 01190376 + GO TO 0011 01200376 +20010 IVFAIL = IVFAIL + 1 01210376 + RVCORR = 1.56879632946156 01220376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01230376 + 0011 CONTINUE 01240376 +CT002* TEST 2 TEST LARGE VALUES TO TEST SINGULARITY 01250376 + IVTNUM = 2 01260376 + AVS = ATAN(-1000.0) 01270376 + IF (AVS + 0.15699E+01) 20020, 10020, 40020 01280376 +40020 IF (AVS + 0.15697E+01) 10020, 10020, 20020 01290376 +10020 IVPASS = IVPASS + 1 01300376 + WRITE (NUVI, 80002) IVTNUM 01310376 + GO TO 0021 01320376 +20020 IVFAIL = IVFAIL + 1 01330376 + RVCORR = -1.56979632712823 01340376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01350376 + 0021 CONTINUE 01360376 +CT003* TEST 3 AN EXPRESSION PRESENTED TO ATAN 01370376 + IVTNUM = 3 01380376 + AVS = ATAN(100.0 / 100.0) 01390376 + IF (AVS - 0.78535E+00) 20030, 10030, 40030 01400376 +40030 IF (AVS - 0.78544E+00) 10030, 10030, 20030 01410376 +10030 IVPASS = IVPASS + 1 01420376 + WRITE (NUVI, 80002) IVTNUM 01430376 + GO TO 0031 01440376 +20030 IVFAIL = IVFAIL + 1 01450376 + RVCORR = 0.78539816339745 01460376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01470376 + 0031 CONTINUE 01480376 +CT004* TEST 4 A VARIABLE PRESENTED TO ATAN 01490376 + IVTNUM = 4 01500376 + BVS = -SQRT(3.0) 01510376 + AVS = ATAN(BVS) 01520376 + IF (AVS + 0.10473E+01) 20040, 10040, 40040 01530376 +40040 IF (AVS + 0.10471E+01) 10040, 10040, 20040 01540376 +10040 IVPASS = IVPASS + 1 01550376 + WRITE (NUVI, 80002) IVTNUM 01560376 + GO TO 0041 01570376 +20040 IVFAIL = IVFAIL + 1 01580376 + RVCORR = -1.04719755119660 01590376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01600376 + 0041 CONTINUE 01610376 +CT005* TEST 5 AN ARGUMENT OF LOW MAGNITUDE 01620376 + IVTNUM = 5 01630376 + AVS = ATAN(1.0E-16) 01640376 + IF (AVS - 0.99995E-16) 20050, 10050, 40050 01650376 +40050 IF (AVS - 0.10001E-15) 10050, 10050, 20050 01660376 +10050 IVPASS = IVPASS + 1 01670376 + WRITE (NUVI, 80002) IVTNUM 01680376 + GO TO 0051 01690376 +20050 IVFAIL = IVFAIL + 1 01700376 + RVCORR = 1.00000000000000E-16 01710376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01720376 + 0051 CONTINUE 01730376 +CT006* TEST 6 AN ARGUMENT OF HIGH MAGNITUDE 01740376 + IVTNUM = 6 01750376 + AVS = ATAN(-2.0E+34) 01760376 + IF (AVS + 0.15709E+01) 20060, 10060, 40060 01770376 +40060 IF (AVS + 0.15707E+01) 10060, 10060, 20060 01780376 +10060 IVPASS = IVPASS + 1 01790376 + WRITE (NUVI, 80002) IVTNUM 01800376 + GO TO 0061 01810376 +20060 IVFAIL = IVFAIL + 1 01820376 + RVCORR = -1.57079632679490 01830376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01840376 + 0061 CONTINUE 01850376 +C***** 01860376 + WRITE(NUVI,19508) 01870376 +19508 FORMAT(/ 08X, "TEST OF ATAN2" ) 01880376 +CT007* TEST 7 TEST ATAN2 FOR (0,POSITIVE) 01890376 + IVTNUM = 7 01900376 + BVS = 10.0 / 10.0 01910376 + CVS = 0.0 01920376 + AVS = ATAN2(CVS, BVS) 01930376 + IF (AVS + 0.50000E-04) 20070, 10070, 40070 01940376 +40070 IF (AVS - 0.50000E-04) 10070, 10070, 20070 01950376 +10070 IVPASS = IVPASS + 1 01960376 + WRITE (NUVI, 80002) IVTNUM 01970376 + GO TO 0071 01980376 +20070 IVFAIL = IVFAIL + 1 01990376 + RVCORR = 0.00000000000000 02000376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02010376 + 0071 CONTINUE 02020376 +CT008* TEST 8 TEST ATAN2 FOR (0, NEGATIVE) 02030376 + IVTNUM = 8 02040376 + BVS = 0.0 02050376 + CVS = -25.0 / 2.0 02060376 + AVS = ATAN2(BVS, CVS) 02070376 + IF (AVS - 0.31414E+01) 20080, 10080, 40080 02080376 +40080 IF (AVS - 0.31418E+01) 10080, 10080, 20080 02090376 +10080 IVPASS = IVPASS + 1 02100376 + WRITE (NUVI, 80002) IVTNUM 02110376 + GO TO 0081 02120376 +20080 IVFAIL = IVFAIL + 1 02130376 + RVCORR = 3.14159265358979 02140376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02150376 + 0081 CONTINUE 02160376 +CT009* TEST 9 AN EXPRESSION PRESENTED TO ATAN2 02170376 + IVTNUM = 9 02180376 + BVS = 1.0 02190376 + CVS = BVS + BVS 02200376 + AVS = ATAN2(BVS * 2.0, CVS) 02210376 + IF (AVS - 0.78535E+00) 20090, 10090, 40090 02220376 +40090 IF (AVS - 0.78544E+00) 10090, 10090, 20090 02230376 +10090 IVPASS = IVPASS + 1 02240376 + WRITE (NUVI, 80002) IVTNUM 02250376 + GO TO 0091 02260376 +20090 IVFAIL = IVFAIL + 1 02270376 + RVCORR = 0.78539816339745 02280376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02290376 + 0091 CONTINUE 02300376 +CT010* TEST 10 TEST ATAN2(X,Y) FOR X NEAR ZERO 02310376 + IVTNUM = 10 02320376 + BVS = ASIN(0.6) 02330376 + CVS = ACOS(0.8) 02340376 + AVS = ATAN2(BVS, CVS) 02350376 + IF (AVS - 0.78535E+00) 20100, 10100, 40100 02360376 +40100 IF (AVS - 0.78544E+00) 10100, 10100, 20100 02370376 +10100 IVPASS = IVPASS + 1 02380376 + WRITE (NUVI, 80002) IVTNUM 02390376 + GO TO 0101 02400376 +20100 IVFAIL = IVFAIL + 1 02410376 + RVCORR = 0.78539816339745 02420376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02430376 + 0101 CONTINUE 02440376 +CT011* TEST 11 WHERE ATAN2(X,Y) IS ZERO FOR Y 02450376 + IVTNUM = 11 02460376 + AVS = ATAN2(1.2, 0.0) 02470376 + IF (AVS - 0.15707E+01) 20110, 10110, 40110 02480376 +40110 IF (AVS - 0.15709E+01) 10110, 10110, 20110 02490376 +10110 IVPASS = IVPASS + 1 02500376 + WRITE (NUVI, 80002) IVTNUM 02510376 + GO TO 0111 02520376 +20110 IVFAIL = IVFAIL + 1 02530376 + RVCORR = 1.57079632679490 02540376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02550376 + 0111 CONTINUE 02560376 +CT012* TEST 12 WHERE ATAN2(X,Y) IS ZERO FOR Y 02570376 + IVTNUM = 12 02580376 + BVS = -2.5 02590376 + CVS = 0.0 02600376 + AVS = ATAN2(BVS, CVS) 02610376 + IF (AVS + 0.15709E+01) 20120, 10120, 40120 02620376 +40120 IF (AVS + 0.15707E+01) 10120, 10120, 20120 02630376 +10120 IVPASS = IVPASS + 1 02640376 + WRITE (NUVI, 80002) IVTNUM 02650376 + GO TO 0121 02660376 +20120 IVFAIL = IVFAIL + 1 02670376 + RVCORR = -1.57079632679490 02680376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02690376 + 0121 CONTINUE 02700376 +CT013* TEST 13 COMPARISON OF ATAN WITH ATAN2 02710376 + IVTNUM = 13 02720376 + AVS = (ATAN(SQRT(3.0) / 3.0) * 2.0) 02730376 + 1 + ATAN2(-SQRT(3.0) / 2.0, 1.0 / 2.0) 02740376 + IF (AVS + 0.50000E-04) 20130, 10130, 40130 02750376 +40130 IF (AVS - 0.50000E-04) 10130, 10130, 20130 02760376 +10130 IVPASS = IVPASS + 1 02770376 + WRITE (NUVI, 80002) IVTNUM 02780376 + GO TO 0131 02790376 +20130 IVFAIL = IVFAIL + 1 02800376 + RVCORR = 0.00000000000000 02810376 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02820376 + 0131 CONTINUE 02830376 +C***** 02840376 +CBB** ********************** BBCSUM0 **********************************02850376 +C**** WRITE OUT TEST SUMMARY 02860376 +C**** 02870376 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02880376 + WRITE (I02, 90004) 02890376 + WRITE (I02, 90014) 02900376 + WRITE (I02, 90004) 02910376 + WRITE (I02, 90020) IVPASS 02920376 + WRITE (I02, 90022) IVFAIL 02930376 + WRITE (I02, 90024) IVDELE 02940376 + WRITE (I02, 90026) IVINSP 02950376 + WRITE (I02, 90028) IVTOTN, IVTOTL 02960376 +CBE** ********************** BBCSUM0 **********************************02970376 +CBB** ********************** BBCFOOT0 **********************************02980376 +C**** WRITE OUT REPORT FOOTINGS 02990376 +C**** 03000376 + WRITE (I02,90016) ZPROG, ZPROG 03010376 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03020376 + WRITE (I02,90019) 03030376 +CBE** ********************** BBCFOOT0 **********************************03040376 +CBB** ********************** BBCFMT0A **********************************03050376 +C**** FORMATS FOR TEST DETAIL LINES 03060376 +C**** 03070376 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03080376 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03090376 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03100376 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03110376 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03120376 + 1I6,/," ",15X,"CORRECT= " ,I6) 03130376 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03140376 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03150376 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03160376 + 1A21,/," ",16X,"CORRECT= " ,A21) 03170376 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03180376 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03190376 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03200376 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03210376 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03220376 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03230376 +80050 FORMAT (" ",48X,A31) 03240376 +CBE** ********************** BBCFMT0A **********************************03250376 +CBB** ********************** BBCFMT0B **********************************03260376 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03270376 +C**** 03280376 +90002 FORMAT ("1") 03290376 +90004 FORMAT (" ") 03300376 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03310376 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03320376 +90008 FORMAT (" ",21X,A13,A17) 03330376 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03340376 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03350376 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03360376 + 1 7X,"REMARKS",24X) 03370376 +90014 FORMAT (" ","----------------------------------------------" , 03380376 + 1 "---------------------------------" ) 03390376 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03400376 +C**** 03410376 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03420376 +C**** 03430376 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03440376 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03450376 + 1 A13) 03460376 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03470376 +C**** 03480376 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03490376 +C**** 03500376 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03510376 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03520376 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03530376 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03540376 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03550376 +CBE** ********************** BBCFMT0B **********************************03560376 +C***** 03570376 +C***** END OF TEST SEGMENT 195 03580376 + STOP 03590376 + END 03600376 + 03610376 diff --git a/Fortran/UnitTests/fcvs21_f95/FM376.reference_output b/Fortran/UnitTests/fcvs21_f95/FM376.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM376.reference_output @@ -0,0 +1,51 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM376BEGIN* TEST RESULTS - FM376 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XATAN - (195) INTRINSIC FUNCTIONS + + ATAN, ATAN2 (ARCTANGENT) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 13 TESTS + + + TEST OF ATAN + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + + TEST OF ATAN2 + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + + ------------------------------------------------------------------------------- + + 13 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 13 OF 13 TESTS EXECUTED + + *FM376END* END OF TEST - FM376 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM377.f b/Fortran/UnitTests/fcvs21_f95/FM377.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM377.f @@ -0,0 +1,384 @@ + PROGRAM FM377 + +C***********************************************************************00010377 +C***** FORTRAN 77 00020377 +C***** FM377 00030377 +C***** XSINH - (197) 00040377 +C***** 00050377 +C***********************************************************************00060377 +C***** GENERAL PURPOSE SUBSET REF 00070377 +C***** TEST INTRINSIC FUNCTION SINH, COSH 15.3 00080377 +C***** TABLE 5 00090377 +C***** 00100377 +CBB** ********************** BBCCOMNT **********************************00110377 +C**** 00120377 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130377 +C**** VERSION 2.1 00140377 +C**** 00150377 +C**** 00160377 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170377 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180377 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190377 +C**** BUILDING 225 RM A266 00200377 +C**** GAITHERSBURG, MD 20899 00210377 +C**** 00220377 +C**** 00230377 +C**** 00240377 +CBE** ********************** BBCCOMNT **********************************00250377 +CBB** ********************** BBCINITA **********************************00260377 +C**** SPECIFICATION STATEMENTS 00270377 +C**** 00280377 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290377 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300377 +CBE** ********************** BBCINITA **********************************00310377 +CBB** ********************** BBCINITB **********************************00320377 +C**** INITIALIZE SECTION 00330377 + DATA ZVERS, ZVERSD, ZDATE 00340377 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350377 + DATA ZCOMPL, ZNAME, ZTAPE 00360377 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370377 + DATA ZPROJ, ZTAPED, ZPROG 00380377 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390377 + DATA REMRKS /' '/ 00400377 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410377 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420377 +C**** 00430377 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440377 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450377 +CZ03 ZPROG = 'PROGRAM NAME' 00460377 +CZ04 ZDATE = 'DATE OF TEST' 00470377 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480377 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490377 +CZ07 ZNAME = 'NAME OF USER' 00500377 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510377 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520377 +C 00530377 + IVPASS = 0 00540377 + IVFAIL = 0 00550377 + IVDELE = 0 00560377 + IVINSP = 0 00570377 + IVTOTL = 0 00580377 + IVTOTN = 0 00590377 + ICZERO = 0 00600377 +C 00610377 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620377 + I01 = 05 00630377 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640377 + I02 = 06 00650377 +C 00660377 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670377 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680377 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690377 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700377 +C 00710377 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720377 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730377 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740377 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750377 +C 00760377 +CBE** ********************** BBCINITB **********************************00770377 + NUVI = I02 00780377 + IVTOTL = 15 00790377 + ZPROG = 'FM377' 00800377 +CBB** ********************** BBCHED0A **********************************00810377 +C**** 00820377 +C**** WRITE REPORT TITLE 00830377 +C**** 00840377 + WRITE (I02, 90002) 00850377 + WRITE (I02, 90006) 00860377 + WRITE (I02, 90007) 00870377 + WRITE (I02, 90008) ZVERS, ZVERSD 00880377 + WRITE (I02, 90009) ZPROG, ZPROG 00890377 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900377 +CBE** ********************** BBCHED0A **********************************00910377 +C***** 00920377 +C***** HEADER FOR SEGMENT 197 00930377 + WRITE(NUVI,19700) 00940377 +19700 FORMAT(" ", / " XSINH - (197) INTRINSIC FUNCTIONS" // 00950377 + 1 " SINH, COSH (HYPERBOLIC SINE, COSINE)" // 00960377 + 2 " SUBSET REF. - 15.3" ) 00970377 +CBB** ********************** BBCHED0B **********************************00980377 +C**** WRITE DETAIL REPORT HEADERS 00990377 +C**** 01000377 + WRITE (I02,90004) 01010377 + WRITE (I02,90004) 01020377 + WRITE (I02,90013) 01030377 + WRITE (I02,90014) 01040377 + WRITE (I02,90015) IVTOTL 01050377 +CBE** ********************** BBCHED0B **********************************01060377 +C***** 01070377 + WRITE(NUVI,19701) 01080377 +19701 FORMAT(/ 8X, "TEST OF SINH" ) 01090377 +C***** 01100377 +CT001* TEST 1 TEST AT ZERO (0.0) 01110377 + IVTNUM = 1 01120377 + BVS = 0.0 01130377 + AVS = SINH(BVS) 01140377 + IF (AVS + 0.50000E-04) 20010, 10010, 40010 01150377 +40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010 01160377 +10010 IVPASS = IVPASS + 1 01170377 + WRITE (NUVI, 80002) IVTNUM 01180377 + GO TO 0011 01190377 +20010 IVFAIL = IVFAIL + 1 01200377 + RVCORR = 0.00000000000000 01210377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01220377 + 0011 CONTINUE 01230377 +CT002* TEST 2 TEST ARGUMENTS CLOSE TO 1.0 01240377 + IVTNUM = 2 01250377 + AVS = SINH(15.0 / 16.0) 01260377 + IF (AVS - 0.10809E+01) 20020, 10020, 40020 01270377 +40020 IF (AVS - 0.10811E+01) 10020, 10020, 20020 01280377 +10020 IVPASS = IVPASS + 1 01290377 + WRITE (NUVI, 80002) IVTNUM 01300377 + GO TO 0021 01310377 +20020 IVFAIL = IVFAIL + 1 01320377 + RVCORR = 1.08099191569306 01330377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01340377 + 0021 CONTINUE 01350377 +CT003* TEST 3 TEST AT 1.0 01360377 + IVTNUM = 3 01370377 + BVS = 1.0 01380377 + AVS = SINH(BVS) 01390377 + IF (AVS - 0.11751E+01) 20030, 10030, 40030 01400377 +40030 IF (AVS - 0.11753E+01) 10030, 10030, 20030 01410377 +10030 IVPASS = IVPASS + 1 01420377 + WRITE (NUVI, 80002) IVTNUM 01430377 + GO TO 0031 01440377 +20030 IVFAIL = IVFAIL + 1 01450377 + RVCORR = 1.17520119364380 01460377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01470377 + 0031 CONTINUE 01480377 +CT004* TEST 4 TEST ARGUMENTS CLOSE TO 1.0 01490377 + IVTNUM = 4 01500377 + AVS = SINH(33.0 / 32.0) 01510377 + IF (AVS - 0.12239E+01) 20040, 10040, 40040 01520377 +40040 IF (AVS - 0.12241E+01) 10040, 10040, 20040 01530377 +10040 IVPASS = IVPASS + 1 01540377 + WRITE (NUVI, 80002) IVTNUM 01550377 + GO TO 0041 01560377 +20040 IVFAIL = IVFAIL + 1 01570377 + RVCORR = 1.22400418778664 01580377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01590377 + 0041 CONTINUE 01600377 +CT005* TEST 5 TEST AT 2.0 01610377 + IVTNUM = 5 01620377 + BVS = 2.0 01630377 + AVS = SINH(BVS) 01640377 + IF (AVS - 0.36266E+01) 20050, 10050, 40050 01650377 +40050 IF (AVS - 0.36271E+01) 10050, 10050, 20050 01660377 +10050 IVPASS = IVPASS + 1 01670377 + WRITE (NUVI, 80002) IVTNUM 01680377 + GO TO 0051 01690377 +20050 IVFAIL = IVFAIL + 1 01700377 + RVCORR = 3.62686040784702 01710377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01720377 + 0051 CONTINUE 01730377 +CT006* TEST 6 A NEGATIVE ARGUMENT 01740377 + IVTNUM = 6 01750377 + AVS = SINH(-2.0) 01760377 + IF (AVS + 0.36271E+01) 20060, 10060, 40060 01770377 +40060 IF (AVS + 0.36266E+01) 10060, 10060, 20060 01780377 +10060 IVPASS = IVPASS + 1 01790377 + WRITE (NUVI, 80002) IVTNUM 01800377 + GO TO 0061 01810377 +20060 IVFAIL = IVFAIL + 1 01820377 + RVCORR = -3.62686040784702 01830377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01840377 + 0061 CONTINUE 01850377 +CT007* TEST 7 AN ARGUMENT OF LOW MAGNITUDE 01860377 + IVTNUM = 7 01870377 + AVS = SINH(1.0E-34) 01880377 + IF (AVS - 0.99995E-34) 20070, 10070, 40070 01890377 +40070 IF (AVS - 0.10001E-33) 10070, 10070, 20070 01900377 +10070 IVPASS = IVPASS + 1 01910377 + WRITE (NUVI, 80002) IVTNUM 01920377 + GO TO 0071 01930377 +20070 IVFAIL = IVFAIL + 1 01940377 + RVCORR = 1.00000000000000E-34 01950377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01960377 + 0071 CONTINUE 01970377 +C***** 01980377 + WRITE (NUVI, 90002) 01990377 + WRITE (NUVI, 90013) 02000377 + WRITE (NUVI, 90014) 02010377 +C***** 02020377 + WRITE(NUVI,19709) 02030377 +19709 FORMAT(/ 8X, "TEST OF COSH" ) 02040377 +C***** 02050377 +CT008* TEST 8 ZERO (0.0) 02060377 + IVTNUM = 8 02070377 + BVS = 0.0 02080377 + AVS = COSH(BVS) 02090377 + IF (AVS - 0.99995E+00) 20080, 10080, 40080 02100377 +40080 IF (AVS - 0.10001E+01) 10080, 10080, 20080 02110377 +10080 IVPASS = IVPASS + 1 02120377 + WRITE (NUVI, 80002) IVTNUM 02130377 + GO TO 0081 02140377 +20080 IVFAIL = IVFAIL + 1 02150377 + RVCORR = 1.00000000000000 02160377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02170377 + 0081 CONTINUE 02180377 +CT009* TEST 9 VALUES CLOSE TO 1.0 02190377 + IVTNUM = 9 02200377 + AVS = COSH(15.0 / 16.0) 02210377 + IF (AVS - 0.14725E+01) 20090, 10090, 40090 02220377 +40090 IF (AVS - 0.14727E+01) 10090, 10090, 20090 02230377 +10090 IVPASS = IVPASS + 1 02240377 + WRITE (NUVI, 80002) IVTNUM 02250377 + GO TO 0091 02260377 +20090 IVFAIL = IVFAIL + 1 02270377 + RVCORR = 1.47259754236986 02280377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02290377 + 0091 CONTINUE 02300377 +CT010* TEST 10 TEST AT 1.0 02310377 + IVTNUM = 10 02320377 + BVS = 1.0 02330377 + AVS = COSH(BVS) 02340377 + IF (AVS - 0.15430E+01) 20100, 10100, 40100 02350377 +40100 IF (AVS - 0.15432E+01) 10100, 10100, 20100 02360377 +10100 IVPASS = IVPASS + 1 02370377 + WRITE (NUVI, 80002) IVTNUM 02380377 + GO TO 0101 02390377 +20100 IVFAIL = IVFAIL + 1 02400377 + RVCORR = 1.54308063481524 02410377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02420377 + 0101 CONTINUE 02430377 +CT011* TEST 11 TEST ARGUMENTS CLOSE TO 1.0 02440377 + IVTNUM = 11 02450377 + AVS = COSH(33.0 / 32.0) 02460377 + IF (AVS - 0.15804E+01) 20110, 10110, 40110 02470377 +40110 IF (AVS - 0.15807E+01) 10110, 10110, 20110 02480377 +10110 IVPASS = IVPASS + 1 02490377 + WRITE (NUVI, 80002) IVTNUM 02500377 + GO TO 0111 02510377 +20110 IVFAIL = IVFAIL + 1 02520377 + RVCORR = 1.58056516845059 02530377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02540377 + 0111 CONTINUE 02550377 +CT012* TEST 12 TEST AT 2.0 02560377 + IVTNUM = 12 02570377 + BVS = 2.0 02580377 + AVS = COSH(BVS) 02590377 + IF (AVS - 0.37620E+01) 20120, 10120, 40120 02600377 +40120 IF (AVS - 0.37624E+01) 10120, 10120, 20120 02610377 +10120 IVPASS = IVPASS + 1 02620377 + WRITE (NUVI, 80002) IVTNUM 02630377 + GO TO 0121 02640377 +20120 IVFAIL = IVFAIL + 1 02650377 + RVCORR = 3.76219569108363 02660377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02670377 + 0121 CONTINUE 02680377 +CT013* TEST 13 A NEGATIVE ARGUMENT 02690377 + IVTNUM = 13 02700377 + AVS = COSH(-2.0) 02710377 + IF (AVS - 0.37620E+01) 20130, 10130, 40130 02720377 +40130 IF (AVS - 0.37624E+01) 10130, 10130, 20130 02730377 +10130 IVPASS = IVPASS + 1 02740377 + WRITE (NUVI, 80002) IVTNUM 02750377 + GO TO 0131 02760377 +20130 IVFAIL = IVFAIL + 1 02770377 + RVCORR = 3.76219569108363 02780377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02790377 + 0131 CONTINUE 02800377 +CT014* TEST 14 AN ARGUMENT OF LOW MAGNITUDE 02810377 + IVTNUM = 14 02820377 + AVS = COSH(-1.0E-34) 02830377 + IF (AVS - 0.99995E+00) 20140, 10140, 40140 02840377 +40140 IF (AVS - 0.10001E+01) 10140, 10140, 20140 02850377 +10140 IVPASS = IVPASS + 1 02860377 + WRITE (NUVI, 80002) IVTNUM 02870377 + GO TO 0141 02880377 +20140 IVFAIL = IVFAIL + 1 02890377 + RVCORR = 1.00000000000000E+00 02900377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02910377 + 0141 CONTINUE 02920377 +CT015* TEST 15 POSITIVE VALUES SUPPLIED AS ARGUMENTS 02930377 +C***** TO BOTH FUNCTIONS IN AN EXPRESSION 02940377 + IVTNUM = 15 02950377 + AVS = SINH(3.25) + COSH(3.25) 02960377 + IF (AVS - 0.25789E+02) 20150, 10150, 40150 02970377 +40150 IF (AVS - 0.25792E+02) 10150, 10150, 20150 02980377 +10150 IVPASS = IVPASS + 1 02990377 + WRITE (NUVI, 80002) IVTNUM 03000377 + GO TO 0151 03010377 +20150 IVFAIL = IVFAIL + 1 03020377 + RVCORR = 25.79033991719306 03030377 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03040377 + 0151 CONTINUE 03050377 +C***** 03060377 +CBB** ********************** BBCSUM0 **********************************03070377 +C**** WRITE OUT TEST SUMMARY 03080377 +C**** 03090377 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03100377 + WRITE (I02, 90004) 03110377 + WRITE (I02, 90014) 03120377 + WRITE (I02, 90004) 03130377 + WRITE (I02, 90020) IVPASS 03140377 + WRITE (I02, 90022) IVFAIL 03150377 + WRITE (I02, 90024) IVDELE 03160377 + WRITE (I02, 90026) IVINSP 03170377 + WRITE (I02, 90028) IVTOTN, IVTOTL 03180377 +CBE** ********************** BBCSUM0 **********************************03190377 +CBB** ********************** BBCFOOT0 **********************************03200377 +C**** WRITE OUT REPORT FOOTINGS 03210377 +C**** 03220377 + WRITE (I02,90016) ZPROG, ZPROG 03230377 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03240377 + WRITE (I02,90019) 03250377 +CBE** ********************** BBCFOOT0 **********************************03260377 +CBB** ********************** BBCFMT0A **********************************03270377 +C**** FORMATS FOR TEST DETAIL LINES 03280377 +C**** 03290377 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03300377 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03310377 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03320377 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03330377 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03340377 + 1I6,/," ",15X,"CORRECT= " ,I6) 03350377 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03360377 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03370377 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03380377 + 1A21,/," ",16X,"CORRECT= " ,A21) 03390377 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03400377 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03410377 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03420377 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03430377 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03440377 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03450377 +80050 FORMAT (" ",48X,A31) 03460377 +CBE** ********************** BBCFMT0A **********************************03470377 +CBB** ********************** BBCFMT0B **********************************03480377 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03490377 +C**** 03500377 +90002 FORMAT ("1") 03510377 +90004 FORMAT (" ") 03520377 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03530377 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03540377 +90008 FORMAT (" ",21X,A13,A17) 03550377 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03560377 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03570377 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03580377 + 1 7X,"REMARKS",24X) 03590377 +90014 FORMAT (" ","----------------------------------------------" , 03600377 + 1 "---------------------------------" ) 03610377 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03620377 +C**** 03630377 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03640377 +C**** 03650377 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03660377 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03670377 + 1 A13) 03680377 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03690377 +C**** 03700377 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03710377 +C**** 03720377 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03730377 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03740377 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03750377 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03760377 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03770377 +CBE** ********************** BBCFMT0B **********************************03780377 +C***** 03790377 +C***** END OF TEST SEGMENT 197 03800377 + STOP 03810377 + END 03820377 diff --git a/Fortran/UnitTests/fcvs21_f95/FM377.reference_output b/Fortran/UnitTests/fcvs21_f95/FM377.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM377.reference_output @@ -0,0 +1,56 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM377BEGIN* TEST RESULTS - FM377 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XSINH - (197) INTRINSIC FUNCTIONS + + SINH, COSH (HYPERBOLIC SINE, COSINE) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 15 TESTS + + + TEST OF SINH + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF COSH + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + + ------------------------------------------------------------------------------- + + 15 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 15 OF 15 TESTS EXECUTED + + *FM377END* END OF TEST - FM377 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM378.f b/Fortran/UnitTests/fcvs21_f95/FM378.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM378.f @@ -0,0 +1,301 @@ + PROGRAM FM378 + +C***********************************************************************00010378 +C***** FORTRAN 77 00020378 +C***** FM378 00030378 +C***** XTANH - (199) 00040378 +C***** 00050378 +C***********************************************************************00060378 +C***** GENERAL PURPOSE SUBSET REF 00070378 +C***** TEST INTRINSIC FUNCTION TANH 15.3 00080378 +C***** TABLE 5 00090378 +C***** 00100378 +CBB** ********************** BBCCOMNT **********************************00110378 +C**** 00120378 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130378 +C**** VERSION 2.1 00140378 +C**** 00150378 +C**** 00160378 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170378 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180378 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190378 +C**** BUILDING 225 RM A266 00200378 +C**** GAITHERSBURG, MD 20899 00210378 +C**** 00220378 +C**** 00230378 +C**** 00240378 +CBE** ********************** BBCCOMNT **********************************00250378 +CBB** ********************** BBCINITA **********************************00260378 +C**** SPECIFICATION STATEMENTS 00270378 +C**** 00280378 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290378 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300378 +CBE** ********************** BBCINITA **********************************00310378 +CBB** ********************** BBCINITB **********************************00320378 +C**** INITIALIZE SECTION 00330378 + DATA ZVERS, ZVERSD, ZDATE 00340378 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350378 + DATA ZCOMPL, ZNAME, ZTAPE 00360378 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370378 + DATA ZPROJ, ZTAPED, ZPROG 00380378 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390378 + DATA REMRKS /' '/ 00400378 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410378 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420378 +C**** 00430378 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440378 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450378 +CZ03 ZPROG = 'PROGRAM NAME' 00460378 +CZ04 ZDATE = 'DATE OF TEST' 00470378 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480378 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490378 +CZ07 ZNAME = 'NAME OF USER' 00500378 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510378 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520378 +C 00530378 + IVPASS = 0 00540378 + IVFAIL = 0 00550378 + IVDELE = 0 00560378 + IVINSP = 0 00570378 + IVTOTL = 0 00580378 + IVTOTN = 0 00590378 + ICZERO = 0 00600378 +C 00610378 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620378 + I01 = 05 00630378 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640378 + I02 = 06 00650378 +C 00660378 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670378 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680378 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690378 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700378 +C 00710378 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720378 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730378 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740378 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750378 +C 00760378 +CBE** ********************** BBCINITB **********************************00770378 + NUVI = I02 00780378 + IVTOTL = 9 00790378 + ZPROG = 'FM378' 00800378 +CBB** ********************** BBCHED0A **********************************00810378 +C**** 00820378 +C**** WRITE REPORT TITLE 00830378 +C**** 00840378 + WRITE (I02, 90002) 00850378 + WRITE (I02, 90006) 00860378 + WRITE (I02, 90007) 00870378 + WRITE (I02, 90008) ZVERS, ZVERSD 00880378 + WRITE (I02, 90009) ZPROG, ZPROG 00890378 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900378 +CBE** ********************** BBCHED0A **********************************00910378 +C***** 00920378 +C***** HEADER FOR SEGMENT 199 00930378 + WRITE(NUVI,19900) 00940378 +19900 FORMAT(" ", / " XTANH - (199) INTRINSIC FUNCTIONS" // 00950378 + 1 " TANH (HYPERBOLIC TANGENT)" // 00960378 + 2 " SUBSET REF. - 15.3" ) 00970378 +CBB** ********************** BBCHED0B **********************************00980378 +C**** WRITE DETAIL REPORT HEADERS 00990378 +C**** 01000378 + WRITE (I02,90004) 01010378 + WRITE (I02,90004) 01020378 + WRITE (I02,90013) 01030378 + WRITE (I02,90014) 01040378 + WRITE (I02,90015) IVTOTL 01050378 +CBE** ********************** BBCHED0B **********************************01060378 +C***** 01070378 +CT001* TEST 1 TEST AT ZERO (0.0) 01080378 + IVTNUM = 1 01090378 + BVS = 0.0 01100378 + AVS = TANH(BVS) 01110378 + IF (AVS + 0.50000E-04) 20010, 10010, 40010 01120378 +40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010 01130378 +10010 IVPASS = IVPASS + 1 01140378 + WRITE (NUVI, 80002) IVTNUM 01150378 + GO TO 0011 01160378 +20010 IVFAIL = IVFAIL + 1 01170378 + RVCORR = 0.00000000000000 01180378 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01190378 + 0011 CONTINUE 01200378 +CT002* TEST 2 A NEGATIVE ARGUMENT 01210378 + IVTNUM = 2 01220378 + AVS = TANH(-2.5) 01230378 + IF (AVS + 0.98667E+00) 20020, 10020, 40020 01240378 +40020 IF (AVS + 0.98656E+00) 10020, 10020, 20020 01250378 +10020 IVPASS = IVPASS + 1 01260378 + WRITE (NUVI, 80002) IVTNUM 01270378 + GO TO 0021 01280378 +20020 IVFAIL = IVFAIL + 1 01290378 + RVCORR = -0.98661429815143 01300378 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01310378 + 0021 CONTINUE 01320378 +CT003* TEST 3 A VARIABLE SUPPLIED AS AN ARGUMENT 01330378 + IVTNUM = 3 01340378 + BVS = 4.75 01350378 + AVS = TANH(BVS) 01360378 + IF (AVS - 0.99980E+00) 20030, 10030, 40030 01370378 +40030 IF (AVS - 0.99990E+00) 10030, 10030, 20030 01380378 +10030 IVPASS = IVPASS + 1 01390378 + WRITE (NUVI, 80002) IVTNUM 01400378 + GO TO 0031 01410378 +20030 IVFAIL = IVFAIL + 1 01420378 + RVCORR = 0.99985030754498 01430378 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01440378 + 0031 CONTINUE 01450378 +CT004* TEST 4 A POSITIVE REAL NUMBER SUPPLIED AS AN ARGUMENT 01460378 + IVTNUM = 4 01470378 + AVS = TANH(15.125) 01480378 + IF (AVS - 0.99995E+00) 20040, 10040, 40040 01490378 +40040 IF (AVS - 0.10001E+01) 10040, 10040, 20040 01500378 +10040 IVPASS = IVPASS + 1 01510378 + WRITE (NUVI, 80002) IVTNUM 01520378 + GO TO 0041 01530378 +20040 IVFAIL = IVFAIL + 1 01540378 + RVCORR = 0.99999999999985 01550378 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01560378 + 0041 CONTINUE 01570378 +CT005* TEST 5 TEST WITH LARGE VALUES 01580378 + IVTNUM = 5 01590378 + BVS = 10.0 ** 2 01600378 + AVS = TANH(BVS) 01610378 + IF (AVS - 0.99995E+00) 20050, 10050, 40050 01620378 +40050 IF (AVS - 0.10001E+01) 10050, 10050, 20050 01630378 +10050 IVPASS = IVPASS + 1 01640378 + WRITE (NUVI, 80002) IVTNUM 01650378 + GO TO 0051 01660378 +20050 IVFAIL = IVFAIL + 1 01670378 + RVCORR = 1.00000000000000 01680378 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01690378 + 0051 CONTINUE 01700378 +CT006* TEST 6 TEST WITH LARGE VALUES 01710378 + IVTNUM = 6 01720378 + BVS = -100.0 * 10.0 01730378 + AVS = TANH(BVS) 01740378 + IF (AVS + 0.10001E+01) 20060, 10060, 40060 01750378 +40060 IF (AVS + 0.99995E+00) 10060, 10060, 20060 01760378 +10060 IVPASS = IVPASS + 1 01770378 + WRITE (NUVI, 80002) IVTNUM 01780378 + GO TO 0061 01790378 +20060 IVFAIL = IVFAIL + 1 01800378 + RVCORR = -1.00000000000000 01810378 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01820378 + 0061 CONTINUE 01830378 +CT007* TEST 7 AN ARGUMENT OF HIGH MAGNITUDE 01840378 + IVTNUM = 7 01850378 + BVS = 3.0E+36 01860378 + AVS = TANH(BVS) 01870378 + IF (AVS - 0.99995E+00) 20070, 10070, 40070 01880378 +40070 IF (AVS - 0.10001E+01) 10070, 10070, 20070 01890378 +10070 IVPASS = IVPASS + 1 01900378 + WRITE (NUVI, 80002) IVTNUM 01910378 + GO TO 0071 01920378 +20070 IVFAIL = IVFAIL + 1 01930378 + RVCORR = 1.00000000000000 01940378 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01950378 + 0071 CONTINUE 01960378 +CT008* TEST 8 AN ARGUMENT OF LOW MAGNITUDE 01970378 + IVTNUM = 8 01980378 + BVS = -1.0E-15 01990378 + AVS = TANH(BVS) 02000378 + IF (AVS + 0.10001E-14) 20080, 10080, 40080 02010378 +40080 IF (AVS + 0.99995E-15) 10080, 10080, 20080 02020378 +10080 IVPASS = IVPASS + 1 02030378 + WRITE (NUVI, 80002) IVTNUM 02040378 + GO TO 0081 02050378 +20080 IVFAIL = IVFAIL + 1 02060378 + RVCORR = -1.00000000000000E-15 02070378 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02080378 + 0081 CONTINUE 02090378 +CT009* TEST 9 THE FUNCTION APPLIED TWICE 02100378 + IVTNUM = 9 02110378 + AVS = TANH(0.5) * TANH(0.75) 02120378 + IF (AVS - 0.29349E+00) 20090, 10090, 40090 02130378 +40090 IF (AVS - 0.29353E+00) 10090, 10090, 20090 02140378 +10090 IVPASS = IVPASS + 1 02150378 + WRITE (NUVI, 80002) IVTNUM 02160378 + GO TO 0091 02170378 +20090 IVFAIL = IVFAIL + 1 02180378 + RVCORR = 0.293513228313886 02190378 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02200378 + 0091 CONTINUE 02210378 +C***** 02220378 +CBB** ********************** BBCSUM0 **********************************02230378 +C**** WRITE OUT TEST SUMMARY 02240378 +C**** 02250378 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02260378 + WRITE (I02, 90004) 02270378 + WRITE (I02, 90014) 02280378 + WRITE (I02, 90004) 02290378 + WRITE (I02, 90020) IVPASS 02300378 + WRITE (I02, 90022) IVFAIL 02310378 + WRITE (I02, 90024) IVDELE 02320378 + WRITE (I02, 90026) IVINSP 02330378 + WRITE (I02, 90028) IVTOTN, IVTOTL 02340378 +CBE** ********************** BBCSUM0 **********************************02350378 +CBB** ********************** BBCFOOT0 **********************************02360378 +C**** WRITE OUT REPORT FOOTINGS 02370378 +C**** 02380378 + WRITE (I02,90016) ZPROG, ZPROG 02390378 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02400378 + WRITE (I02,90019) 02410378 +CBE** ********************** BBCFOOT0 **********************************02420378 +CBB** ********************** BBCFMT0A **********************************02430378 +C**** FORMATS FOR TEST DETAIL LINES 02440378 +C**** 02450378 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02460378 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02470378 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02480378 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02490378 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02500378 + 1I6,/," ",15X,"CORRECT= " ,I6) 02510378 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02520378 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02530378 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02540378 + 1A21,/," ",16X,"CORRECT= " ,A21) 02550378 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02560378 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02570378 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02580378 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02590378 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02600378 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02610378 +80050 FORMAT (" ",48X,A31) 02620378 +CBE** ********************** BBCFMT0A **********************************02630378 +CBB** ********************** BBCFMT0B **********************************02640378 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02650378 +C**** 02660378 +90002 FORMAT ("1") 02670378 +90004 FORMAT (" ") 02680378 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02690378 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02700378 +90008 FORMAT (" ",21X,A13,A17) 02710378 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02720378 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02730378 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02740378 + 1 7X,"REMARKS",24X) 02750378 +90014 FORMAT (" ","----------------------------------------------" , 02760378 + 1 "---------------------------------" ) 02770378 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02780378 +C**** 02790378 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02800378 +C**** 02810378 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02820378 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02830378 + 1 A13) 02840378 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02850378 +C**** 02860378 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02870378 +C**** 02880378 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02890378 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02900378 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02910378 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02920378 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02930378 +CBE** ********************** BBCFMT0B **********************************02940378 +C***** 02950378 +C***** END OF TEST SEGMENT 199 02960378 + STOP 02970378 + END 02980378 + 02990378 diff --git a/Fortran/UnitTests/fcvs21_f95/FM378.reference_output b/Fortran/UnitTests/fcvs21_f95/FM378.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM378.reference_output @@ -0,0 +1,43 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM378BEGIN* TEST RESULTS - FM378 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XTANH - (199) INTRINSIC FUNCTIONS + + TANH (HYPERBOLIC TANGENT) + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 9 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + + ------------------------------------------------------------------------------- + + 9 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 9 OF 9 TESTS EXECUTED + + *FM378END* END OF TEST - FM378 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM379.f b/Fortran/UnitTests/fcvs21_f95/FM379.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM379.f @@ -0,0 +1,327 @@ + PROGRAM FM379 + +C***********************************************************************00010379 +C***** FORTRAN 77 00020379 +C***** FM379 00030379 +C***** XRFOR - (201) 00040379 +C***** 00050379 +C***********************************************************************00060379 +C***** GENERAL PURPOSE SUBSET REF 00070379 +C***** TEST TRIGONOMETRIC FORMULAE 15.3 00080379 +C***** TABLE 5 00090379 +C***** 00100379 +CBB** ********************** BBCCOMNT **********************************00110379 +C**** 00120379 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130379 +C**** VERSION 2.1 00140379 +C**** 00150379 +C**** 00160379 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170379 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180379 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190379 +C**** BUILDING 225 RM A266 00200379 +C**** GAITHERSBURG, MD 20899 00210379 +C**** 00220379 +C**** 00230379 +C**** 00240379 +CBE** ********************** BBCCOMNT **********************************00250379 +CBB** ********************** BBCINITA **********************************00260379 +C**** SPECIFICATION STATEMENTS 00270379 +C**** 00280379 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290379 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300379 +CBE** ********************** BBCINITA **********************************00310379 +CBB** ********************** BBCINITB **********************************00320379 +C**** INITIALIZE SECTION 00330379 + DATA ZVERS, ZVERSD, ZDATE 00340379 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00350379 + DATA ZCOMPL, ZNAME, ZTAPE 00360379 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00370379 + DATA ZPROJ, ZTAPED, ZPROG 00380379 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00390379 + DATA REMRKS /' '/ 00400379 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00410379 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00420379 +C**** 00430379 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00440379 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00450379 +CZ03 ZPROG = 'PROGRAM NAME' 00460379 +CZ04 ZDATE = 'DATE OF TEST' 00470379 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00480379 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00490379 +CZ07 ZNAME = 'NAME OF USER' 00500379 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00510379 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00520379 +C 00530379 + IVPASS = 0 00540379 + IVFAIL = 0 00550379 + IVDELE = 0 00560379 + IVINSP = 0 00570379 + IVTOTL = 0 00580379 + IVTOTN = 0 00590379 + ICZERO = 0 00600379 +C 00610379 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00620379 + I01 = 05 00630379 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00640379 + I02 = 06 00650379 +C 00660379 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00670379 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00680379 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00690379 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00700379 +C 00710379 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00720379 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00730379 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00740379 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00750379 +C 00760379 +CBE** ********************** BBCINITB **********************************00770379 + NUVI = I02 00780379 + IVTOTL = 10 00790379 + ZPROG = 'FM379' 00800379 +CBB** ********************** BBCHED0A **********************************00810379 +C**** 00820379 +C**** WRITE REPORT TITLE 00830379 +C**** 00840379 + WRITE (I02, 90002) 00850379 + WRITE (I02, 90006) 00860379 + WRITE (I02, 90007) 00870379 + WRITE (I02, 90008) ZVERS, ZVERSD 00880379 + WRITE (I02, 90009) ZPROG, ZPROG 00890379 + WRITE (I02, 90010) ZDATE, ZCOMPL 00900379 +CBE** ********************** BBCHED0A **********************************00910379 +C***** 00920379 +C***** HEADER FOR SEGMENT 201 00930379 + WRITE(NUVI,20101) 00940379 +20101 FORMAT(" ", / " XRFOR - (201) INTRINSIC FUNCTIONS" // 00950379 + 1 " TRIGONOMETRIC FORMULAE" // 00960379 + 2 " SUBSET REF. - 15.3" ) 00970379 +CBB** ********************** BBCHED0B **********************************00980379 +C**** WRITE DETAIL REPORT HEADERS 00990379 +C**** 01000379 + WRITE (I02,90004) 01010379 + WRITE (I02,90004) 01020379 + WRITE (I02,90013) 01030379 + WRITE (I02,90014) 01040379 + WRITE (I02,90015) IVTOTL 01050379 +CBE** ********************** BBCHED0B **********************************01060379 +C***** 01070379 + PIVS = 3.1415926535897932384626434 01080379 +C***** 01090379 +CT001* TEST 1 LN(EXP(X)) = 1 01100379 + IVTNUM = 1 01110379 + BVS = 17.5 01120379 + AVS = ALOG(EXP(1.75)) - BVS / 10.0 01130379 + IF (AVS + 0.50000E-04) 20010, 10010, 40010 01140379 +40010 IF (AVS - 0.50000E-04) 10010, 10010, 20010 01150379 +10010 IVPASS = IVPASS + 1 01160379 + WRITE (NUVI, 80002) IVTNUM 01170379 + GO TO 0011 01180379 +20010 IVFAIL = IVFAIL + 1 01190379 + RVCORR = 0.0000 01200379 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01210379 + 0011 CONTINUE 01220379 +CT002* TEST 2 SIN**2 + COS**2 = 1 01230379 + IVTNUM = 2 01240379 + BVS = 10.0 / 4.0 01250379 + CVS = SIN(BVS) ** 2 01260379 + DVS = COS(BVS) ** 2 01270379 + AVS = CVS + DVS - 1.0 01280379 + IF (AVS + 0.50000E-04) 20020, 10020, 40020 01290379 +40020 IF (AVS - 0.50000E-04) 10020, 10020, 20020 01300379 +10020 IVPASS = IVPASS + 1 01310379 + WRITE (NUVI, 80002) IVTNUM 01320379 + GO TO 0021 01330379 +20020 IVFAIL = IVFAIL + 1 01340379 + RVCORR = 0.0000 01350379 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01360379 + 0021 CONTINUE 01370379 +CT003* TEST 3 SIN(2X) = 2*SIN(X)*COS(X) 01380379 + IVTNUM = 3 01390379 + BVS = 8.5 01400379 + CVS = BVS * (-0.5) 01410379 + AVS = (SIN(-4.25) * COS(CVS)) * 2.0 - SIN(-8.5) 01420379 + IF (AVS + 0.50000E-04) 20030, 10030, 40030 01430379 +40030 IF (AVS - 0.50000E-04) 10030, 10030, 20030 01440379 +10030 IVPASS = IVPASS + 1 01450379 + WRITE (NUVI, 80002) IVTNUM 01460379 + GO TO 0031 01470379 +20030 IVFAIL = IVFAIL + 1 01480379 + RVCORR = 0.0000 01490379 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01500379 + 0031 CONTINUE 01510379 +CT004* TEST 4 ARCSIN(X) = ARCCOS(1-X**2) 01520379 + IVTNUM = 4 01530379 + AVS = ASIN(-0.875) + ACOS(SQRT(1.0 - (0.875) ** 2)) 01540379 + IF (AVS + 0.50000E-04) 20040, 10040, 40040 01550379 +40040 IF (AVS - 0.50000E-04) 10040, 10040, 20040 01560379 +10040 IVPASS = IVPASS + 1 01570379 + WRITE (NUVI, 80002) IVTNUM 01580379 + GO TO 0041 01590379 +20040 IVFAIL = IVFAIL + 1 01600379 + RVCORR = 0.0000 01610379 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01620379 + 0041 CONTINUE 01630379 +CT005* TEST 5 TAN(X)**2 - 1 = -COS(2X)/COS(X)**2 01640379 + IVTNUM = 5 01650379 + BVS = 7.0 01660379 + AVS = COS(1.75) / COS(BVS / 8.0) ** 2 + TAN(0.875) ** 2 - 01670379 + 1 1 01680379 + IF (AVS + 0.50000E-04) 20050, 10050, 40050 01690379 +40050 IF (AVS - 0.50000E-04) 10050, 10050, 20050 01700379 +10050 IVPASS = IVPASS + 1 01710379 + WRITE (NUVI, 80002) IVTNUM 01720379 + GO TO 0051 01730379 +20050 IVFAIL = IVFAIL + 1 01740379 + RVCORR = 0.0000 01750379 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01760379 + 0051 CONTINUE 01770379 +CT006* TEST 6 ATAN(X/Y) = ATAN2(X,Y), Y > 0 01780379 + IVTNUM = 6 01790379 + BVS = 12.0 01800379 + CVS = ATAN2(BVS / 4.0, BVS / 3.0) 01810379 + AVS = CVS - ATAN(0.75) 01820379 + IF (AVS + 0.50000E-04) 20060, 10060, 40060 01830379 +40060 IF (AVS - 0.50000E-04) 10060, 10060, 20060 01840379 +10060 IVPASS = IVPASS + 1 01850379 + WRITE (NUVI, 80002) IVTNUM 01860379 + GO TO 0061 01870379 +20060 IVFAIL = IVFAIL + 1 01880379 + RVCORR = 0.0000 01890379 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01900379 + 0061 CONTINUE 01910379 +CT007* TEST 7 SQRT(X)**2 = X 01920379 + IVTNUM = 7 01930379 + AVS = SQRT(9.125) ** 2 - 9.125 01940379 + IF (AVS + 0.50000E-04) 20070, 10070, 40070 01950379 +40070 IF (AVS - 0.50000E-04) 10070, 10070, 20070 01960379 +10070 IVPASS = IVPASS + 1 01970379 + WRITE (NUVI, 80002) IVTNUM 01980379 + GO TO 0071 01990379 +20070 IVFAIL = IVFAIL + 1 02000379 + RVCORR = 0.0000 02010379 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02020379 + 0071 CONTINUE 02030379 +CT008* TEST 8 LN(X) = LN(10) * LOG10(X) 02040379 + IVTNUM = 8 02050379 + BVS = 62.5 / 1000.0 02060379 + AVS = ALOG10(BVS) * ALOG(10.0) - ALOG(0.0625) 02070379 + IF (AVS + 0.50000E-04) 20080, 10080, 40080 02080379 +40080 IF (AVS - 0.50000E-04) 10080, 10080, 20080 02090379 +10080 IVPASS = IVPASS + 1 02100379 + WRITE (NUVI, 80002) IVTNUM 02110379 + GO TO 0081 02120379 +20080 IVFAIL = IVFAIL + 1 02130379 + RVCORR = 0.0000 02140379 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02150379 + 0081 CONTINUE 02160379 +CT009* TEST 9 COSH**2 - SINH**2 = 1 02170379 + IVTNUM = 9 02180379 + BVS = 0.125 02190379 + CVS = SINH(2.125) 02200379 + DVS = COSH(2.0 + BVS) 02210379 + AVS = DVS ** 2 - CVS ** 2 - COSH(0.0) 02220379 + IF (AVS + 0.50000E-04) 20090, 10090, 40090 02230379 +40090 IF (AVS - 0.50000E-04) 10090, 10090, 20090 02240379 +10090 IVPASS = IVPASS + 1 02250379 + WRITE (NUVI, 80002) IVTNUM 02260379 + GO TO 0091 02270379 +20090 IVFAIL = IVFAIL + 1 02280379 + RVCORR = 0.0000 02290379 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02300379 + 0091 CONTINUE 02310379 +CT010* TEST 10 TANH(X) = 1 - 2/(EXP(2X)+1) 02320379 + IVTNUM = 10 02330379 + BVS = 5.0 02340379 + CVS = 2.0 02350379 + DVS = ALOG10(BVS * CVS) - SQRT(4.0) / 02360379 + 1 (EXP(2.0 * (BVS - CVS)) + COS(0.0)) 02370379 + AVS = DVS - TANH(3.0) 02380379 + IF (AVS + 0.50000E-04) 20100, 10100, 40100 02390379 +40100 IF (AVS - 0.50000E-04) 10100, 10100, 20100 02400379 +10100 IVPASS = IVPASS + 1 02410379 + WRITE (NUVI, 80002) IVTNUM 02420379 + GO TO 0101 02430379 +20100 IVFAIL = IVFAIL + 1 02440379 + RVCORR = 0.0000 02450379 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02460379 + 0101 CONTINUE 02470379 +C***** 02480379 +CBB** ********************** BBCSUM0 **********************************02490379 +C**** WRITE OUT TEST SUMMARY 02500379 +C**** 02510379 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02520379 + WRITE (I02, 90004) 02530379 + WRITE (I02, 90014) 02540379 + WRITE (I02, 90004) 02550379 + WRITE (I02, 90020) IVPASS 02560379 + WRITE (I02, 90022) IVFAIL 02570379 + WRITE (I02, 90024) IVDELE 02580379 + WRITE (I02, 90026) IVINSP 02590379 + WRITE (I02, 90028) IVTOTN, IVTOTL 02600379 +CBE** ********************** BBCSUM0 **********************************02610379 +CBB** ********************** BBCFOOT0 **********************************02620379 +C**** WRITE OUT REPORT FOOTINGS 02630379 +C**** 02640379 + WRITE (I02,90016) ZPROG, ZPROG 02650379 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02660379 + WRITE (I02,90019) 02670379 +CBE** ********************** BBCFOOT0 **********************************02680379 +CBB** ********************** BBCFMT0A **********************************02690379 +C**** FORMATS FOR TEST DETAIL LINES 02700379 +C**** 02710379 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02720379 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02730379 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02740379 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02750379 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02760379 + 1I6,/," ",15X,"CORRECT= " ,I6) 02770379 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02780379 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02790379 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02800379 + 1A21,/," ",16X,"CORRECT= " ,A21) 02810379 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02820379 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02830379 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02840379 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02850379 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02860379 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02870379 +80050 FORMAT (" ",48X,A31) 02880379 +CBE** ********************** BBCFMT0A **********************************02890379 +CBB** ********************** BBCFMT0B **********************************02900379 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02910379 +C**** 02920379 +90002 FORMAT ("1") 02930379 +90004 FORMAT (" ") 02940379 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02950379 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02960379 +90008 FORMAT (" ",21X,A13,A17) 02970379 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02980379 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02990379 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03000379 + 1 7X,"REMARKS",24X) 03010379 +90014 FORMAT (" ","----------------------------------------------" , 03020379 + 1 "---------------------------------" ) 03030379 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03040379 +C**** 03050379 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03060379 +C**** 03070379 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03080379 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03090379 + 1 A13) 03100379 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03110379 +C**** 03120379 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03130379 +C**** 03140379 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03150379 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03160379 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03170379 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03180379 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03190379 +CBE** ********************** BBCFMT0B **********************************03200379 +C***** 03210379 +C***** END OF TEST SEGMENT 201 03220379 + STOP 03230379 + END 03240379 + 03250379 diff --git a/Fortran/UnitTests/fcvs21_f95/FM379.reference_output b/Fortran/UnitTests/fcvs21_f95/FM379.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM379.reference_output @@ -0,0 +1,44 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM379BEGIN* TEST RESULTS - FM379 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + XRFOR - (201) INTRINSIC FUNCTIONS + + TRIGONOMETRIC FORMULAE + + SUBSET REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 10 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + + ------------------------------------------------------------------------------- + + 10 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 10 OF 10 TESTS EXECUTED + + *FM379END* END OF TEST - FM379 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM401.f b/Fortran/UnitTests/fcvs21_f95/FM401.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM401.f @@ -0,0 +1,1151 @@ + PROGRAM FM401 00010401 +C 00020401 +C 00030401 +C THIS ROUTINE TESTS FOR PROPER EDITING OF LOGICAL DATA BY 00040401 +C THE L EDIT DESCRIPTOR OF THE FORMAT SPECIFICATION. THE L EDIT 00050401 +C DESCRIPTOR IS FIRST TESTED FOR PROPER EDITING ON OUTPUT BY 00060401 +C DIRECTING THE EDITED RESULT TO A PRINT FILE. THE RESULTS MUST 00070401 +C BE VISUALLY CHECKED FOR CORRECTNESS BY EXAMINING THE EXECUTION 00080401 +C REPORT PRODUCED BY THIS ROUTINE. NEXT A NONPRINTER FILE WHICH 00090401 +C IS CONNECTED FOR SEQUENTIAL ACCESS IS CREATED WITH LOGICAL DATA 00100401 +C FIELDS AND THEN REPOSITIONED TO THE FIRST RECORD IN THE FILE. 00110401 +C THE FILE IS THEN READ USING THE SAME EDIT DESCRIPTORS AS WERE 00120401 +C USED TO CREATE THE FILE AND THE INTERNAL DATA REPRESENTATION AS A 00130401 +C RESULT OF READING THE LOGICAL DATA IS CHECKED. 00140401 +C THE FOLLOWING L EDITING TESTS ARE MADE TO SEE THAT 00150401 +C 00160401 +C (1) THE VALUE T OR F IS PRODUCED ON OUTPUT WHEN THE INTERNAL 00170401 +C DATUM IS TRUE AND FALSE RESPECTIVELY, 00180401 +C (2) THE VALUE OF THE INPUT LIST ITEM IS TRUE OR FALSE 00190401 +C WHEN THE INPUT FIELD IS T AND F RESPECTIVELY, 00200401 +C (3) THE VALUES .T, .F, T, F, .TRUE., .FALSE., .T, AND 00210401 +C .F ARE ACCEPTABLE FORMS FOR INPUT DATA FIELDS 00220401 +C (4) THE INPUT VALUES T OR F MAY BE FOLLOWED BY 00230401 +C ADDITIONAL CHARACTERS IN THE FIELD, 00240401 +C (5) THE REPEATABLE EDIT DESCRIPTOR FOR L EDITING FUNCTIONS 00250401 +C CORRECTLY, 00260401 +C (6) THE FIELDS CONTAINING LOGICAL DATA CAN BE WRITTEN 00270401 +C USING ONE L EDIT DESCRIPTOR AND READ USING A DIFFERENT 00280401 +C FORM OF THE L EDIT DESCRIPTOR. 00290401 +C 00300401 +C REFERENCES - 00310401 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00320401 +C X3.9-1978 00330401 +C 00340401 +C SECTION 4.7, LOGICAL TYPE 00350401 +C SECTION 13.1.1, FORMAT STATEMENT 00360401 +C SECTION 13.5.10, L EDITING 00370401 +C 00380401 +C 00390401 +C 00400401 +C ******************************************************************00410401 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00420401 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00430401 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00440401 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00450401 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00460401 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00470401 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00480401 +C THE RESULT OF EXECUTING THESE TESTS. 00490401 +C 00500401 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00510401 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00520401 +C 00530401 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00540401 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00550401 +C SOFTWARE STANDARDS VALIDATION GROUP 00560401 +C BUILDING 225 RM A266 00570401 +C GAITHERSBURG, MD 20899 00580401 +C ******************************************************************00590401 +C 00600401 +C 00610401 + IMPLICIT LOGICAL (L) 00620401 + IMPLICIT CHARACTER*14 (C) 00630401 +C 00640401 + DIMENSION LAON15(5), LAON12(2) 00650401 + DIMENSION IDUMP(132) 00660401 +C 00670401 +C 00680401 +C 00690401 +C INITIALIZATION SECTION. 00700401 +C 00710401 +C INITIALIZE CONSTANTS 00720401 +C ******************** 00730401 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00740401 + I01 = 5 00750401 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00760401 + I02 = 6 00770401 +C SYSTEM ENVIRONMENT SECTION 00780401 +C 00790401 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00800401 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00810401 +C (UNIT NUMBER FOR CARD READER). 00820401 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD00830401 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00840401 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 00850401 +C 00860401 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.00870401 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 00880401 +C (UNIT NUMBER FOR PRINTER). 00890401 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.00900401 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 00910401 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 00920401 +C 00930401 + IVPASS = 0 00940401 + IVFAIL = 0 00950401 + IVDELE = 0 00960401 + ICZERO = 0 00970401 +C 00980401 +C WRITE OUT PAGE HEADERS 00990401 +C 01000401 + WRITE (I02,90002) 01010401 + WRITE (I02,90006) 01020401 + WRITE (I02,90008) 01030401 + WRITE (I02,90004) 01040401 + WRITE (I02,90010) 01050401 + WRITE (I02,90004) 01060401 + WRITE (I02,90016) 01070401 + WRITE (I02,90001) 01080401 + WRITE (I02,90004) 01090401 + WRITE (I02,90012) 01100401 + WRITE (I02,90014) 01110401 + WRITE (I02,90004) 01120401 +C 01130401 +C 01140401 +C 01150401 +C TEST 001 THROUGH 007 TESTS THE L EDIT DESCRIPTOR FOR PROPER 01160401 +C EDITING OF LOGICAL DATUM ON OUTPUT. TO VALIDATE THESE TESTS 01170401 +C THE EDITED DATUM IS SENT TO A PRINT FILE AND THEREFORE MUST BE 01180401 +C VISUALLY CHECKED FOR CORRECTNESS. ON OUTPUT THE EDITED FIELD 01190401 +C CONSISTS OF W-1 (W IS NUMBER OF POSITIONS IN THE FIELD) BLANKS 01200401 +C FOLLOWED BY A T OR F AS THE VALUE OF THE DATUM IS TRUE OR FALSE 01210401 +C RESPECTIVELY. SEE SECTION 13.5.10 L EDITING. 01220401 +C 01230401 +C 01240401 +80052 FORMAT (" ",4X, "TESTS 001 THROUGH 007 MUST BE VISUALLY VERIFIED.01250401 + 1") 01260401 +80054 FORMAT (" ", "IMMEDIATELY FOLLOWING THIS NARRATIVE IS A REFERENCE01270401 + 1 LINE") 01280401 +80056 FORMAT (" ", "OF THE FORM '123456 ...'. THE REFERENCE LINE IS T01290401 + 1O") 01300401 +80058 FORMAT (" ","AID IN THE VISUAL VERIFICATION OF THE TESTS. FOR" ) 01310401 +80062 FORMAT (" ","THE OUTPUT TO BE CORRECT THE DATA VALUES DISPLAYED" )01320401 +80064 FORMAT (" ", "IN THE COMPUTED COLUMN MUST MATCH THAT IN THE CORRE01330401 + 1CT ") 01340401 +80066 FORMAT (" ","COLUMN IN BOTH VALUE AND CHARACTER POSITION." ) 01350401 +80072 FORMAT (" ","REFERENCE LINE - " ,"1234567890" ,5X, "123401360401 + 1567890") 01370401 + WRITE (I02,80052) 01380401 + WRITE (I02,80054) 01390401 + WRITE (I02,80056) 01400401 + WRITE (I02,80058) 01410401 + WRITE (I02,80062) 01420401 + WRITE (I02,80064) 01430401 + WRITE (I02,80066) 01440401 + WRITE (I02,90004) 01450401 + WRITE (I02,80072) 01460401 +C 01470401 +C **** FCVS PROGRAM 401 - TEST 001 **** 01480401 +C 01490401 +C TEST 001 TESTS FOR PROPER EDITING OF THE L EDIT DESCRIPTOR 01500401 +C ON OUTPUT WHERE THE FIELD IS 1 POSITION IN LENGTH, THE 01510401 +C VALUE OF THE DATUM IS TRUE AND THE OUTPUT LIST ITEM IS A 01520401 +C VARIABLE. 01530401 +C 01540401 + IVTNUM = 001 01550401 + IF (ICZERO) 30010, 0010, 30010 01560401 + 0010 CONTINUE 01570401 + LCON01 = .TRUE. 01580401 + 0012 FORMAT (" ",4X,I5,26X,L1,14X,"T") 01590401 + WRITE (I02, 0012) IVTNUM, LCON01 01600401 + GO TO 0021 01610401 +30010 IVDELE = IVDELE + 1 01620401 + WRITE (I02,80000) IVTNUM 01630401 + 0021 CONTINUE 01640401 +C 01650401 +C **** FCVS PROGRAM 401 - TEST 002 **** 01660401 +C 01670401 +C TEST 002 IS SIMILAR TO TEST 001 EXCEPT THAT THE OUTPUT LIST 01680401 +C ITEM IS AN ARRAY ELEMENT. 01690401 +C 01700401 + IVTNUM = 002 01710401 + IF (ICZERO) 30020, 0020, 30020 01720401 + 0020 CONTINUE 01730401 + LAON12(2) = .TRUE. 01740401 + 0022 FORMAT (" ",4X,I5,26X,L1,14X,"T") 01750401 + WRITE (I02, 0022) IVTNUM, LAON12(2) 01760401 + GO TO 0031 01770401 +30020 IVDELE = IVDELE + 1 01780401 + WRITE (I02,80000) IVTNUM 01790401 + 0031 CONTINUE 01800401 +C 01810401 +C **** FCVS PROGRAM 401 - TEST 003 **** 01820401 +C 01830401 +C TEST 003 TESTS TO SEE THAT ON OUTPUT 9 BLANKS PRECEDE THE VALUE01840401 +C T WHERE THE L EDIT DESCRIPTOR INDICATES THAT THE FIELD OCCUPIES 01850401 +C 10 POSITIONS. THE VALUE OF THE INTERNAL DATUM IS TRUE. 01860401 +C 01870401 + IVTNUM = 003 01880401 + IF (ICZERO) 30030, 0030, 30030 01890401 + 0030 CONTINUE 01900401 + LCON01 = .TRUE. 01910401 + 0032 FORMAT (" ",4X,I5,17X,L10,5X," T" ) 01920401 + WRITE (I02, 0032) IVTNUM, LCON01 01930401 + GO TO 0041 01940401 +30030 IVDELE = IVDELE + 1 01950401 + WRITE (I02, 80000) IVTNUM 01960401 + 0041 CONTINUE 01970401 +C 01980401 +C **** FCVS PROGRAM 401 - TEST 004 **** 01990401 +C 02000401 +C TEST 004 TESTS TO SEE THAT THE VALUE F IS PRODUCED ON OUTPUT 02010401 +C WHEN THE VALUE OF THE INTERNAL DATUM IS FALSE AND THE L EDITING 02020401 +C FIELD IS 1 POSITION IN LENGTH. 02030401 +C 02040401 + IVTNUM = 004 02050401 + IF (ICZERO) 30040, 0040, 30040 02060401 + 0040 CONTINUE 02070401 + LCON02 = .FALSE. 02080401 + 0042 FORMAT (" ",4X,I5,26X,L1,14X,"F") 02090401 + WRITE (I02, 0042) IVTNUM, LCON02 02100401 + GO TO 0051 02110401 +30040 IVDELE = IVDELE + 1 02120401 + WRITE (I02,80000) IVTNUM 02130401 + 0051 CONTINUE 02140401 +C 02150401 +C **** FCVS PROGRAM 401 - TEST 005 **** 02160401 +C 02170401 +C TEST 005 VERIFIES THAT ON OUTPUT 9 BLANKS PRECEDE THE VALUE F 02180401 +C WHERE THE L EDIT DESCRIPTOR IS L10 (FIELD OCCUPIES 10 POSITIONS). 02190401 +C THE VALUE OF THE INTERNAL DATUM IS FALSE. 02200401 +C 02210401 + IVTNUM = 005 02220401 + IF (ICZERO) 30050, 0050, 30050 02230401 + 0050 CONTINUE 02240401 + LCON02 = .FALSE. 02250401 + 0052 FORMAT (" ",4X,I5,17X,L10,5X," F" ) 02260401 + WRITE (I02, 0052) IVTNUM, LCON02 02270401 + GO TO 0061 02280401 +30050 IVDELE = IVDELE + 1 02290401 + WRITE (I02, 80000) IVTNUM 02300401 + 0061 CONTINUE 02310401 +C 02320401 +C **** FCVS PROGRAM 401 - TEST 006 **** 02330401 +C 02340401 +C TEST 006 TESTS THE OPTIONAL REPEAT SPECIFICATION OF THE L 02350401 +C EDIT DESCRIPTOR WHERE THE FIELD OCCUPIES 1 POSITION (EDIT 02360401 +C DESCRIPTOR IS 5L1). 02370401 +C 02380401 + IVTNUM = 006 02390401 + IF (ICZERO) 30060, 0060, 30060 02400401 + 0060 CONTINUE 02410401 + LCON01 = .TRUE. 02420401 + LCON02 = .FALSE. 02430401 + LCON03 = .FALSE. 02440401 + LAON12(1) = .FALSE. 02450401 + LAON12(2) = .TRUE. 02460401 + 0062 FORMAT (" ",4X,I5,17X," ",5L1,5X," TFFFT" ) 02470401 + WRITE (I02, 0062) IVTNUM, LCON01, LCON02, LCON03, LAON12(1), 02480401 + 1LAON12(2) 02490401 + GO TO 0071 02500401 +30060 IVDELE = IVDELE + 1 02510401 + WRITE (I02, 80000) IVTNUM 02520401 + 0071 CONTINUE 02530401 +C 02540401 +C *** FCVS PROGRAM 401 - TEST 007 **** 02550401 +C 02560401 +C TEST 007 TESTS THE OPTIONAL REPEAT SPECIFICATION OF THE L 02570401 +C EDIT DESCRIPTOR WHERE THE FIELD OCCUPIES 3 POSITIONS (EDIT 02580401 +C DESCRIPTOR IS 3L3). 02590401 +C 02600401 + IVTNUM = 007 02610401 + IF (ICZERO) 30070, 0070, 30070 02620401 + 0070 CONTINUE 02630401 + LCON01 = .TRUE. 02640401 + LCON02 = .FALSE. 02650401 + LAON12(2) = .TRUE. 02660401 + 0072 FORMAT (" ",4X,I5,17X," ",3L3,5X," T F T" ) 02670401 + WRITE (I02, 0072) IVTNUM, LCON01, LCON02, LAON12(2) 02680401 + GO TO 0081 02690401 +30070 IVDELE = IVDELE + 1 02700401 + WRITE (I02, 80000) IVTNUM 02710401 + 0081 CONTINUE 02720401 +C 02730401 +C THE FOLLOWING BLOCK OF SOURCE CODE BEGINNING WITH COMMENT LINE 02740401 +C **** CREATE-FILE SECTION AND ENDING WITH THE COMMENT LINE 02750401 +C **** END-OF-CREATE-FILE SECTION BUILDS A FILE WHICH IS USED IN 02760401 +C TESTING THE L EDIT DESCRIPTOR. THE FILE PROPERTIES ARE 02770401 +C 02780401 +C FILE IDENTIFIER - I08 (X-NUMBER 08) 02790401 +C RECORD SIZE - 80 CHARACTERS 02800401 +C ACCESS METHOD - SEQUENTIAL 02810401 +C RECORD TYPE - FORMATTED 02820401 +C DESIGNATED DEVICE - DISK 02830401 +C TYPE OF DATA - LOGICAL (L FORMAT) 02840401 +C RECORDS IN FILE - 141 02850401 +C 02860401 +C THE FIRST 20 POSITIONS OF EACH RECORD IN THE FILE UNIQUELY 02870401 +C IDENTIFY THAT RECORD. THE REMAINING POSITONS OF THE RECORD 02880401 +C CONTAIN DATA WHICH IS USED IN TESTING THE L EDIT DESCRIPTOR. 02890401 +C A DESCRIPTION OF EACH FIELD OF THE 20-CHARACTER PREAMBLE FOLLOWS. 02900401 +C 02910401 +C VARIABLE NAME IN PROGRAM CHARACTER POSITIONS 02920401 +C ----------------------- ------------------- 02930401 +C 02940401 +C IPROG (ROUTINE NAME) - 1 THRU 3 02950401 +C IFILE (LOGICAL/ X-NUMBER) - 4 THRU 5 02960401 +C ITOTR (RECORDS IN FILE) - 6 THRU 9 02970401 +C IRLGN (CHARACTERS IN RECORD) - 10 THRU 12 02980401 +C IRECN (RECORD NUMBER) - 13 THRU 16 02990401 +C IEOF (9999 IF LAST RECORD) - 17 THRU 20 03000401 +C 03010401 +C DEFAULT ASSIGNMENT FOR FILE IS I08 = 07 03020401 + I08 = 408 03030401 +CX080 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-080 03040401 +CX081 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-081 03050401 + IPROG = 401 03060401 + IFILE = I08 03070401 + ITOTR = 141 03080401 + IRLGN = 80 03090401 + IRECN = 0 03100401 + IEOF = 0 03110401 +C 03120401 +C THERE ARE 10 SETS OF 14 RECORDS PER SET PLUS ONE 03130401 +C TRAILER RECORD FOR A TOTAL OF 141 DATA RECORDS IN THE FILE. 03140401 +C ALTHOUGH ONLY 12 RECORDS ARE USED IN TESTING, THE FILE IS MADE 03150401 +C LARGER TO PRECLUDE THE FILE FROM BEING TOTALY STORED IN MEMORY 03160401 +C DURING EXECUTION OF THIS ROUTINE. 03170401 +C 03180401 +C 03190401 +C 03200401 +C **** CREATE-FILE SECTION 03210401 + LCON01 = .TRUE. 03220401 + LCON02 = .FALSE. 03230401 +70001 FORMAT (I3,I2,I4,I3,2I4,58X,"T","F") 03240401 +70002 FORMAT (I3,I2,I4,I3,2I4,40X," T" ," F" ) 03250401 +70003 FORMAT (I3,I2,I4,I3,2I4,47X,".TRUE.",".FALSE.") 03260401 +70004 FORMAT (I3,I2,I4,I3,2I4,56X,".T",".F") 03270401 +70005 FORMAT (I3,I2,I4,I3,2I4,48X," .T"," .F") 03280401 +70006 FORMAT (I3,I2,I4,I3,2I4,38X,"THIS IS ALLOWED" ,"FINALLY") 03290401 +70007 FORMAT (I3,I2,I4,I3,2I4,48X,"TRUE ","FALSE ") 03300401 +70008 FORMAT (I3,I2,I4,I3,2I4,40X," .TIME. " ," .FIELD. " ) 03310401 +70009 FORMAT (I3,I2,I4,I3,2I4,07X, "THIS IS VERY LARGE FIELD FOR INPUT 03320401 + 1OF LOGICAL VALUES.") 03330401 +70010 FORMAT (I3,I2,I4,I3,2I4,55X,"TFTFT") 03340401 +70011 FORMAT (I3,I2,I4,I3,2I4,44X," T T F F" ) 03350401 +70012 FORMAT (I3,I2,I4,I3,2I4,55X,L5) 03360401 +70013 FORMAT (I3,I2,I4,I3,2I4,55X,4X,L1) 03370401 +70014 FORMAT (I3,I2,I4,I3,2I4,59X," ") 03380401 + DO 4012 I=1,10 03390401 + IRECN = IRECN + 1 03400401 + WRITE (I08, 70001) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03410401 + IRECN = IRECN + 1 03420401 + WRITE (I08, 70002) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03430401 + IRECN = IRECN + 1 03440401 + WRITE (I08, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03450401 + IRECN = IRECN + 1 03460401 + WRITE (I08, 70004) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03470401 + IRECN = IRECN + 1 03480401 + WRITE (I08, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03490401 + IRECN = IRECN + 1 03500401 + WRITE (I08, 70006) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03510401 + IRECN = IRECN + 1 03520401 + WRITE (I08, 70007) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03530401 + IRECN = IRECN + 1 03540401 + WRITE (I08, 70008) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03550401 + IRECN = IRECN + 1 03560401 + WRITE (I08, 70009) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03570401 + IRECN = IRECN + 1 03580401 + WRITE (I08, 70010) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03590401 + IRECN = IRECN + 1 03600401 + WRITE (I08, 70011) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03610401 + IRECN = IRECN + 1 03620401 + WRITE (I08, 70012) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, LCON0103630401 + IRECN = IRECN + 1 03640401 + WRITE (I08, 70012) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, LCON0203650401 + IRECN = IRECN + 1 03660401 + WRITE (I08, 70013) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, LCON0103670401 + 4012 CONTINUE 03680401 + IRECN = IRECN + 1 03690401 + IEOF = 9999 03700401 + WRITE (I08, 70014) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 03710401 + ENDFILE I08 03720401 + REWIND I08 03730401 + WRITE (I02, 90004) 03740401 +70015 FORMAT (" FILE I08 HAS BEEN CREATED AND CONTAINS 141 RECORDS" ) 03750401 +70016 FORMAT (" ","INCORRECT NUMBER OF RECORDS IN FILE - " , I4 , " RE03760401 + 1CORDS") 03770401 +70017 FORMAT (" ","WRITTEN BUT 141 RECORDS SHOULD HAVE BEEN WRITTEN." ) 03780401 + IF (IRECN - 141) 4013, 4014, 4013 03790401 + 4013 WRITE (I02, 70016) IRECN 03800401 + WRITE (I02, 70017) 03810401 + GO TO 4015 03820401 + 4014 WRITE (I02, 70015) 03830401 + WRITE (I02, 90004) 03840401 + 4015 CONTINUE 03850401 +C 03860401 +C **** END-OF-CREATE-FILE SECTION 03870401 +C 03880401 +C 03890401 +C 03900401 +C TEST 8 AND 9 VERIFY THAT ON INPUT THE VALUE T AND F IS TRUE 03910401 +C AND FALSE RESPECTIVELY. THE FIELD IS ONE POSITION IN LENGTH AND 03920401 +C USES THE EDIT DESCRIPTOR L1. 03930401 +C 03940401 +C 03950401 + LVON01 = .FALSE. 03960401 + LVON02 = .TRUE. 03970401 + 0082 FORMAT (78X,L1,L1) 03980401 + READ (I08, 0082) LVON01, LVON02 03990401 +C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT IS FOR TESTS 8 04000401 +C AND 9 04010401 +C 04020401 +C 04030401 +C **** FCVS PROGRAM 401 - TEST 008 **** 04040401 +C 04050401 +C 04060401 +C TEST 8 TESTS THE FIELD VALUE T FOR A TRUE CONDITION. 04070401 +C 04080401 +C 04090401 + IVTNUM = 8 04100401 + IF (ICZERO) 30080, 0080, 30080 04110401 + 0080 CONTINUE 04120401 + IVCOMP = 0 04130401 + IF (LVON01) IVCOMP = 1 04140401 + IVCORR = 1 04150401 +40080 IF (IVCOMP - 1) 20080, 10080, 20080 04160401 +30080 IVDELE = IVDELE + 1 04170401 + WRITE (I02,80000) IVTNUM 04180401 + IF (ICZERO) 10080, 0091, 20080 04190401 +10080 IVPASS = IVPASS + 1 04200401 + WRITE (I02,80002) IVTNUM 04210401 + GO TO 0091 04220401 +20080 IVFAIL = IVFAIL + 1 04230401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04240401 + 0091 CONTINUE 04250401 +C 04260401 +C **** FCVS PROGRAM 401 - TEST 009 **** 04270401 +C 04280401 +C 04290401 +C TEST 9 TESTS THE VALUE F FOR A FALSE CONDITION 04300401 +C 04310401 +C 04320401 + IVTNUM = 9 04330401 + IF (ICZERO) 30090, 0090, 30090 04340401 + 0090 CONTINUE 04350401 + IVCOMP = 1 04360401 + IF (.NOT. LVON02) IVCOMP = 0 04370401 + IVCORR = 0 04380401 +40090 IF (IVCOMP - 0) 20090, 10090, 20090 04390401 +30090 IVDELE = IVDELE + 1 04400401 + WRITE (I02,80000) IVTNUM 04410401 + IF (ICZERO) 10090, 0101, 20090 04420401 +10090 IVPASS = IVPASS + 1 04430401 + WRITE (I02,80002) IVTNUM 04440401 + GO TO 0101 04450401 +20090 IVFAIL = IVFAIL + 1 04460401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04470401 + 0101 CONTINUE 04480401 +C 04490401 +C 04500401 +C THE INPUT FIELD MAY CONSIST OF OPTIONAL BLANKS FOLLOWED BY T OR04510401 +C F. TEST 10 AND 11 VERIFY THAT THE VALUE T OR F PRECEDED BY BLANKS 04520401 +C ON INPUT IS TRUE OR FALSE RESPECTIVELY. THE EDIT DESCRIPTOR BEING04530401 +C TESTED IS L10 (INPUT FIELD HAS 10 POSITIONS). 04540401 +C 04550401 +C 04560401 + LVON01 = .FALSE. 04570401 + LVON02 = .TRUE. 04580401 + 0102 FORMAT (60X,L10,L10) 04590401 + READ (I08, 0102) LVON01, LVON02 04600401 +C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT IS FOR TESTS 1004610401 +C AND 11 04620401 +C 04630401 +C **** FCVS PROGRAM 401 - TEST 010 **** 04640401 +C 04650401 +C 04660401 +C TEST 10 TESTS A FIELD OF BLANKS FOLLOWED BY A T FOR A TRUE 04670401 +C CONDITION. 04680401 +C 04690401 +C 04700401 + IVTNUM = 10 04710401 + IF (ICZERO) 30100, 0100, 30100 04720401 + 0100 CONTINUE 04730401 + IVCOMP = 0 04740401 + IF (LVON01) IVCOMP = 1 04750401 + IVCORR = 1 04760401 +40100 IF (IVCOMP - 1) 20100, 10100, 20100 04770401 +30100 IVDELE = IVDELE + 1 04780401 + WRITE (I02,80000) IVTNUM 04790401 + IF (ICZERO) 10100, 0111, 20100 04800401 +10100 IVPASS = IVPASS + 1 04810401 + WRITE (I02,80002) IVTNUM 04820401 + GO TO 0111 04830401 +20100 IVFAIL = IVFAIL + 1 04840401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04850401 + 0111 CONTINUE 04860401 +C 04870401 +C **** FCVS PROGRAM 401 - TEST 011 **** 04880401 +C 04890401 +C 04900401 +C TEST 11 TESTS A FIELD OF BLANKS FOLLOWED BY A F FOR A FALSE 04910401 +C CONDITION 04920401 +C 04930401 +C 04940401 + IVTNUM = 11 04950401 + IF (ICZERO) 30110, 0110, 30110 04960401 + 0110 CONTINUE 04970401 + IVCOMP = 1 04980401 + IF (.NOT. LVON02) IVCOMP = 0 04990401 + IVCORR = 0 05000401 +40110 IF (IVCOMP - 0) 20110, 10110, 20110 05010401 +30110 IVDELE = IVDELE + 1 05020401 + WRITE (I02,80000) IVTNUM 05030401 + IF (ICZERO) 10110, 0121, 20110 05040401 +10110 IVPASS = IVPASS + 1 05050401 + WRITE (I02,80002) IVTNUM 05060401 + GO TO 0121 05070401 +20110 IVFAIL = IVFAIL + 1 05080401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05090401 + 0121 CONTINUE 05100401 +C 05110401 +C 05120401 +C TESTS 12 AND 13 VERIFY THAT THE FIELD CONTENTS .TRUE . OR 05130401 +C .FALSE. ARE ACCEPTABLE INPUT FORMS AND THE VALUE OF THE INTERNAL 05140401 +C DATUM IS TRUE OR FALSE RESPECTIVELY. 05150401 +C 05160401 +C 05170401 + LVON01 = .FALSE. 05180401 + LVON02 = .TRUE. 05190401 + 0122 FORMAT (67X,L6,L7) 05200401 + READ (I08, 0122) LVON01, LVON02 05210401 +C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT IS FOR TESTS 12 05220401 +C AND 13 05230401 +C 05240401 +C **** FCVS PROGRAM 401 - TEST 012 **** 05250401 +C 05260401 +C 05270401 +C TEST 12 TESTS THE INPUT FIELD CONTENTS .TRUE. FOR A TRUE 05280401 +C CONDITION. 05290401 +C 05300401 +C 05310401 + IVTNUM = 12 05320401 + IF (ICZERO) 30120, 0120, 30120 05330401 + 0120 CONTINUE 05340401 + IVCOMP = 0 05350401 + IF (LVON01) IVCOMP = 1 05360401 + IVCORR = 1 05370401 +40120 IF (IVCOMP - 1) 20120, 10120, 20120 05380401 +30120 IVDELE = IVDELE + 1 05390401 + WRITE (I02,80000) IVTNUM 05400401 + IF (ICZERO) 10120, 0131, 20120 05410401 +10120 IVPASS = IVPASS + 1 05420401 + WRITE (I02,80002) IVTNUM 05430401 + GO TO 0131 05440401 +20120 IVFAIL = IVFAIL + 1 05450401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05460401 + 0131 CONTINUE 05470401 +C 05480401 +C **** FCVS PROGRAM 401 - TEST 013 **** 05490401 +C 05500401 +C 05510401 +C TEST 13 TESTS THE INPUT FIELD CONTENTS .FALSE. FOR A FALSE 05520401 +C CONDITION. 05530401 +C 05540401 +C 05550401 + IVTNUM = 13 05560401 + IF (ICZERO) 30130, 0130, 30130 05570401 + 0130 CONTINUE 05580401 + IVCOMP = 1 05590401 + IF (.NOT. LVON02) IVCOMP = 0 05600401 + IVCORR = 0 05610401 +40130 IF (IVCOMP - 0) 20130, 10130, 20130 05620401 +30130 IVDELE = IVDELE + 1 05630401 + WRITE (I02,80000) IVTNUM 05640401 + IF (ICZERO) 10130, 0141, 20130 05650401 +10130 IVPASS = IVPASS + 1 05660401 + WRITE (I02,80002) IVTNUM 05670401 + GO TO 0141 05680401 +20130 IVFAIL = IVFAIL + 1 05690401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05700401 + 0141 CONTINUE 05710401 +C 05720401 +C 05730401 +C TESTS 14 AND 15 VERIFY THAT VALUE .T OR .F ARE ACCEPTABLE INPUT05740401 +C FORMS AND THAT THE VALUE OF THE INTERNAL DATUM IS TRUE OR FALSE 05750401 +C RESPECTIVELY. 05760401 +C 05770401 +C 05780401 + LVON01 = .FALSE. 05790401 + LVON02 = .TRUE. 05800401 + 0142 FORMAT (76X,L2,L2) 05810401 + READ (I08, 0142) LVON01, LVON02 05820401 +C THE ABOVE READ STATEMENT AND ASSOCIATED FORMAT IS FOR TESTS 05830401 +C 14 AND 15 05840401 +C 05850401 +C 05860401 +C **** FCVS PROGRAM 401 - TEST 014 **** 05870401 +C 05880401 +C TEST 14 TESTS THE INPUT FIELD CONTENTS .T FOR A TRUE CONDITION 05890401 +C 05900401 +C 05910401 + IVTNUM = 14 05920401 + IF (ICZERO) 30140, 0140, 30140 05930401 + 0140 CONTINUE 05940401 + IVCOMP = 0 05950401 + IF (LVON01) IVCOMP = 1 05960401 + IVCORR = 1 05970401 +40140 IF (IVCOMP - 1) 20140, 10140, 20140 05980401 +30140 IVDELE = IVDELE + 1 05990401 + WRITE (I02,80000) IVTNUM 06000401 + IF (ICZERO) 10140, 0151, 20140 06010401 +10140 IVPASS = IVPASS + 1 06020401 + WRITE (I02,80002) IVTNUM 06030401 + GO TO 0151 06040401 +20140 IVFAIL = IVFAIL + 1 06050401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06060401 + 0151 CONTINUE 06070401 +C 06080401 +C **** FCVS PROGRAM 401 - TEST 015 **** 06090401 +C 06100401 +C 06110401 +C TEST 15 TESTS THE INPUT FIELD CONTENTS .F FOR A FALSE CONDITION06120401 +C 06130401 +C 06140401 + IVTNUM = 15 06150401 + IF (ICZERO) 30150, 0150, 30150 06160401 + 0150 CONTINUE 06170401 + IVCOMP = 1 06180401 + IF (.NOT. LVON02) IVCOMP = 0 06190401 + IVCORR = 0 06200401 +40150 IF (IVCOMP - 0) 20150, 10150, 20150 06210401 +30150 IVDELE = IVDELE + 1 06220401 + WRITE (I02,80000) IVTNUM 06230401 + IF (ICZERO) 10150, 0161, 20150 06240401 +10150 IVPASS = IVPASS + 1 06250401 + WRITE (I02,80002) IVTNUM 06260401 + GO TO 0161 06270401 +20150 IVFAIL = IVFAIL + 1 06280401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06290401 + 0161 CONTINUE 06300401 +C 06310401 +C 06320401 +C TEST 16 AND 17 VERIFY THAT VALUE .T OR .F PRECEDED BY BLANKS 06330401 +C ARE ACCEPTABLE INPUT FORMS AND THE VALUE OF THE INTERNAL DATA 06340401 +C AS A RESULT OF THE READ ARE TRUE AND FALSE RESPECTIVELY. 06350401 +C 06360401 +C 06370401 + LVON01 = .FALSE. 06380401 + LVON02 = .TRUE. 06390401 + 0162 FORMAT (68X,L6,L6) 06400401 + READ (I08, 0162) LVON01, LVON02 06410401 +C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT ARE FOR TESTS 06420401 +C 16 AND 17. 06430401 +C 06440401 +C 06450401 +C **** FCVS PROGRAM 401 - TEST 016 **** 06460401 +C 06470401 +C TEST 16 TESTS THE INPUT FIELD CONTENTS .T PRECEDED BY 4 BLANKS 06480401 +C FOR A TRUE CONDITION. 06490401 +C 06500401 +C 06510401 + IVTNUM = 16 06520401 + IF (ICZERO) 30160, 0160, 30160 06530401 + 0160 CONTINUE 06540401 + IVCOMP = 0 06550401 + IF (LVON01) IVCOMP = 1 06560401 + IVCORR = 1 06570401 +40160 IF (IVCOMP - 1) 20160, 10160, 20160 06580401 +30160 IVDELE = IVDELE + 1 06590401 + WRITE (I02,80000) IVTNUM 06600401 + IF (ICZERO) 10160, 0171, 20160 06610401 +10160 IVPASS = IVPASS + 1 06620401 + WRITE (I02,80002) IVTNUM 06630401 + GO TO 0171 06640401 +20160 IVFAIL = IVFAIL + 1 06650401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06660401 + 0171 CONTINUE 06670401 +C 06680401 +C **** FCVS PROGRAM 401 - TEST 017 **** 06690401 +C 06700401 +C 06710401 +C TEST 17 TESTS THE INPUT FIELD CONTENTS .F PRECEDED BY 4 BLANKS 06720401 +C FOR A FALSE CONDITION. 06730401 +C 06740401 +C 06750401 + IVTNUM = 17 06760401 + IF (ICZERO) 30170, 0170, 30170 06770401 + 0170 CONTINUE 06780401 + IVCOMP = 1 06790401 + IF (.NOT. LVON02) IVCOMP = 0 06800401 + IVCORR = 0 06810401 +40170 IF (IVCOMP - 0) 20170, 10170, 20170 06820401 +30170 IVDELE = IVDELE + 1 06830401 + WRITE (I02,80000) IVTNUM 06840401 + IF (ICZERO) 10170, 0181, 20170 06850401 +10170 IVPASS = IVPASS + 1 06860401 + WRITE (I02,80002) IVTNUM 06870401 + GO TO 0181 06880401 +20170 IVFAIL = IVFAIL + 1 06890401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06900401 + 0181 CONTINUE 06910401 +C 06920401 +C 06930401 +C THE INPUT FIELD MAY HAVE T OR F FOLLOWED BY ADDITIONAL 06940401 +C CHARACTERS IN THE FIELD. TESTS 18 THROUGH 24 VERIFY THAT T OR F 06950401 +C FOLLOWED BY ADDITIONAL CHARACTERS ARE ACCEPTABLE INPUT FORMS AND 06960401 +C THE VALUE OF THE LOGICAL ENTITIES AS A RESULT OF THE READ ARE TRUE06970401 +C AND FALSE RESPECTIVELY. 06980401 +C 06990401 +C 07000401 + LVON01 = .FALSE. 07010401 + LVON02 = .TRUE. 07020401 + 0182 FORMAT (58X,L15,L7) 07030401 + READ (I08, 0182) LVON01, LVON02 07040401 +C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT ARE FOR TESTS 07050401 +C 18 AND 19. 07060401 +C 07070401 +C **** FCVS PROGRAM 401 - TEST 018 **** 07080401 +C 07090401 +C 07100401 +C TEST 18 TESTS THE INPUT FIELD CONTENTS OF 'THIS IS ALLOWED' 07110401 +C FOR A TRUE CONDITION. 07120401 +C 07130401 +C 07140401 + IVTNUM = 18 07150401 + IF (ICZERO) 30180, 0180, 30180 07160401 + 0180 CONTINUE 07170401 + IVCOMP = 0 07180401 + IF (LVON01) IVCOMP = 1 07190401 + IVCORR = 1 07200401 +40180 IF (IVCOMP - 1) 20180, 10180, 20180 07210401 +30180 IVDELE = IVDELE + 1 07220401 + WRITE (I02,80000) IVTNUM 07230401 + IF (ICZERO) 10180, 0191, 20180 07240401 +10180 IVPASS = IVPASS + 1 07250401 + WRITE (I02,80002) IVTNUM 07260401 + GO TO 0191 07270401 +20180 IVFAIL = IVFAIL + 1 07280401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07290401 + 0191 CONTINUE 07300401 +C 07310401 +C **** FCVS PROGRAM 401 - TEST 019 **** 07320401 +C 07330401 +C 07340401 +C TEST 19 TEST THE INPUT FIELD CONTENTS 'FINALLY' FOR A 07350401 +C FALSE CONDITION. 07360401 +C 07370401 +C 07380401 + IVTNUM = 19 07390401 + IF (ICZERO) 30190, 0190, 30190 07400401 + 0190 CONTINUE 07410401 + IVCOMP = 1 07420401 + IF (.NOT. LVON02) IVCOMP = 0 07430401 + IVCORR = 0 07440401 +40190 IF (IVCOMP - 0) 20190, 10190, 20190 07450401 +30190 IVDELE = IVDELE + 1 07460401 + WRITE (I02,80000) IVTNUM 07470401 + IF (ICZERO) 10190, 0201, 20190 07480401 +10190 IVPASS = IVPASS + 1 07490401 + WRITE (I02,80002) IVTNUM 07500401 + GO TO 0201 07510401 +20190 IVFAIL = IVFAIL + 1 07520401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07530401 + 0201 CONTINUE 07540401 +C 07550401 +C **** FCVS PROGRAM 401 - TEST 020 **** 07560401 +C 07570401 +C 07580401 + IVTNUM = 20 07590401 + IF (ICZERO) 30200, 0200, 30200 07600401 + 0200 CONTINUE 07610401 + LVON01 = .FALSE. 07620401 + LVON02 = .TRUE. 07630401 + 0202 FORMAT (68X,L6,L6) 07640401 + READ (I08, 0202) LVON01, LVON02 07650401 +C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENTS ARE FOR TESTS 07660401 +C 20 AND 21. 07670401 +C 07680401 +C TEST 20 TESTS THE INPUT FIELD CONTENTS OF 'TRUE ' (T FOLLOWED 07690401 +C BY CHARACTERS WHICH INCLUDE SPACES) FOR A TRUE CONDITION. 07700401 +C 07710401 + IVCOMP = 0 07720401 + IF (LVON01) IVCOMP = 1 07730401 + IVCORR = 1 07740401 +40200 IF (IVCOMP - 1) 20200, 10200, 20200 07750401 +30200 IVDELE = IVDELE + 1 07760401 + WRITE (I02,80000) IVTNUM 07770401 + IF (ICZERO) 10200, 0211, 20200 07780401 +10200 IVPASS = IVPASS + 1 07790401 + WRITE (I02,80002) IVTNUM 07800401 + GO TO 0211 07810401 +20200 IVFAIL = IVFAIL + 1 07820401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07830401 + 0211 CONTINUE 07840401 +C 07850401 +C **** FCVS PROGRAM 401 - TEST 021 **** 07860401 +C 07870401 +C 07880401 +C TEST 21 TESTS THE INPUT FIELD CONTENTS OF 'FALSE ' 07890401 +C (F FOLLOWED BY CHARACTERS WHICH INCLUDE SPACES) FOR A FALSE 07900401 +C CONDITION. 07910401 +C 07920401 +C 07930401 + IVTNUM = 21 07940401 + IF (ICZERO) 30210, 0210, 30210 07950401 + 0210 CONTINUE 07960401 + IVCOMP = 1 07970401 + IF (.NOT. LVON02) IVCOMP = 0 07980401 + IVCORR = 0 07990401 +40210 IF (IVCOMP - 0) 20210, 10210, 20210 08000401 +30210 IVDELE = IVDELE + 1 08010401 + WRITE (I02,80000) IVTNUM 08020401 + IF (ICZERO) 10210, 0221, 20210 08030401 +10210 IVPASS = IVPASS + 1 08040401 + WRITE (I02,80002) IVTNUM 08050401 + GO TO 0221 08060401 +20210 IVFAIL = IVFAIL + 1 08070401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08080401 + 0221 CONTINUE 08090401 +C 08100401 +C **** FCVS PROGRAM 401 - TEST 022 **** 08110401 +C 08120401 +C 08130401 +C 08140401 + IVTNUM = 22 08150401 + IF (ICZERO) 30220, 0220, 30220 08160401 + 0220 CONTINUE 08170401 + LVON01 = .FALSE. 08180401 + LVON02 = .TRUE. 08190401 + 0222 FORMAT (60X,L10,L10) 08200401 + READ (I08, 0222) LVON01, LVON02 08210401 +C THE ABOVE READ AND ASSOCIATED FORMAT STATEMENT ARE FOR TESTS 08220401 +C 22 AND 23. 08230401 +C 08240401 +C TEST 22 TESTS THE INPUT FIELD CONTENTS OF ' .TIME. ' (.T 08250401 +C FOLLOWED BY CHARACTERS WHICH INCLUDE SPACES AND PERIODS) FOR A 08260401 +C TRUE CONDITION. 08270401 +C 08280401 + IVCOMP = 0 08290401 + IF (LVON01) IVCOMP = 1 08300401 + IVCORR = 1 08310401 +40220 IF (IVCOMP - 1) 20220, 10220, 20220 08320401 +30220 IVDELE = IVDELE + 1 08330401 + WRITE (I02,80000) IVTNUM 08340401 + IF (ICZERO) 10220, 0231, 20220 08350401 +10220 IVPASS = IVPASS + 1 08360401 + WRITE (I02,80002) IVTNUM 08370401 + GO TO 0231 08380401 +20220 IVFAIL = IVFAIL + 1 08390401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08400401 + 0231 CONTINUE 08410401 +C 08420401 +C **** FCVS PROGRAM 401 - TEST 023 **** 08430401 +C 08440401 +C 08450401 +C TEST 23 TESTS THE INPUT FIELD CONTENTS OF ' .FIELD. ' (.F 08460401 +C FOLLOWED BY CHARACTERS WHICH INCLUDE SPACES AND PERIODS) FOR A 08470401 +C FALSE CONDITION. 08480401 +C 08490401 +C 08500401 + IVTNUM = 23 08510401 + IF (ICZERO) 30230, 0230, 30230 08520401 + 0230 CONTINUE 08530401 + IVCOMP = 1 08540401 + IF (.NOT. LVON02) IVCOMP = 0 08550401 + IVCORR = 0 08560401 +40230 IF (IVCOMP - 0) 20230, 10230, 20230 08570401 +30230 IVDELE = IVDELE + 1 08580401 + WRITE (I02,80000) IVTNUM 08590401 + IF (ICZERO) 10230, 0241, 20230 08600401 +10230 IVPASS = IVPASS + 1 08610401 + WRITE (I02,80002) IVTNUM 08620401 + GO TO 0241 08630401 +20230 IVFAIL = IVFAIL + 1 08640401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08650401 + 0241 CONTINUE 08660401 +C 08670401 +C **** FCVS PROGRAM 401 - TEST 024 **** 08680401 +C 08690401 +C 08700401 +C 08710401 + IVTNUM = 24 08720401 + IF (ICZERO) 30240, 0240, 30240 08730401 + 0240 CONTINUE 08740401 + LVON01 = .FALSE. 08750401 + 0242 FORMAT (27X,L53) 08760401 + READ (I08, 0242) LVON01 08770401 +C 08780401 +C TEST 24 TESTS USE OF A LARGE INPUT FIELD WITH THE CONTENTS 08790401 +C 'THIS IS A VERY LARGE FIELD FOR INPUT OF LOGICAL VALUES. '. THE 08800401 +C EDIT DESCRIPTOR IS L53 AND THE VALUE OF THE INTERNAL DATUM AS A 08810401 +C RESULT OF THE READ SHOULD GIVE A TRUE CONDITION. 08820401 +C 08830401 + IVCOMP = 0 08840401 + IF (LVON01) IVCOMP = 1 08850401 + IVCORR = 1 08860401 +40240 IF (IVCOMP - 1) 20240, 10240, 20240 08870401 +30240 IVDELE = IVDELE + 1 08880401 + WRITE (I02,80000) IVTNUM 08890401 + IF (ICZERO) 10240, 0251, 20240 08900401 +10240 IVPASS = IVPASS + 1 08910401 + WRITE (I02,80002) IVTNUM 08920401 + GO TO 0251 08930401 +20240 IVFAIL = IVFAIL + 1 08940401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08950401 + 0251 CONTINUE 08960401 +C 08970401 +C **** FCVS PROGRAM 401 - TEST 025 **** 08980401 +C 08990401 +C 09000401 +C TEST 25 TESTS USE OF THE OPTIONAL REPEAT SPECIFICATION WITH 09010401 +C THE L EDIT DESCRIPTOR. THE INPUT FIELD IS 1 POSITION IN LENGTH. 09020401 +C 09030401 +C 09040401 + IVTNUM = 25 09050401 + IF (ICZERO) 30250, 0250, 30250 09060401 + 0250 CONTINUE 09070401 + LAON15(1) = .FALSE. 09080401 + LAON15(2) = .TRUE. 09090401 + LAON15(3) = .FALSE. 09100401 + LAON15(4) = .TRUE. 09110401 + LAON15(5) = .FALSE. 09120401 + 0252 FORMAT (75X,5L1) 09130401 + READ (I08, 0252) (LAON15(I), I = 1, 5) 09140401 + IVCOMP = 1 09150401 + IVCORR = 2310 09160401 + IF (LAON15(1)) IVCOMP = IVCOMP * 2 09170401 + IF (.NOT. LAON15(2)) IVCOMP = IVCOMP * 3 09180401 + IF (LAON15(3)) IVCOMP = IVCOMP * 5 09190401 + IF (.NOT. LAON15(4)) IVCOMP = IVCOMP * 7 09200401 + IF (LAON15(5)) IVCOMP = IVCOMP * 11 09210401 +40250 IF (IVCOMP - 2310) 20250, 10250, 20250 09220401 +30250 IVDELE = IVDELE + 1 09230401 + WRITE (I02,80000) IVTNUM 09240401 + IF (ICZERO) 10250, 0261, 20250 09250401 +10250 IVPASS = IVPASS + 1 09260401 + WRITE (I02,80002) IVTNUM 09270401 + GO TO 0261 09280401 +20250 IVFAIL = IVFAIL + 1 09290401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09300401 + 0261 CONTINUE 09310401 +C 09320401 +C **** FCVS PROGRAM 401 - TEST 026 **** 09330401 +C 09340401 +C 09350401 +C TEST 26 IS SIMILAR TO TEST 25 EXCEPT THAT EACH INPUT FIELD 09360401 +C CONTAINING LOGICAL DATA IS 4 CHARACTERS IN LENGTH. THE EDIT 09370401 +C DESCRIPTOR IS 4L4. 09380401 +C 09390401 +C 09400401 + IVTNUM = 26 09410401 + IF (ICZERO) 30260, 0260, 30260 09420401 + 0260 CONTINUE 09430401 + LAON15(1) = .FALSE. 09440401 + LAON15(2) = .FALSE. 09450401 + LAON15(3) = .TRUE. 09460401 + LAON15(4) = .TRUE. 09470401 + 0262 FORMAT (64X,4L4) 09480401 + READ (I08, 0262) (LAON15(I), I = 1, 4) 09490401 + IVCOMP = 1 09500401 + IVCORR = 210 09510401 + IF (LAON15 (1)) IVCOMP = IVCOMP * 2 09520401 + IF (LAON15(2)) IVCOMP = IVCOMP * 3 09530401 + IF (.NOT. LAON15(3)) IVCOMP = IVCOMP * 5 09540401 + IF (.NOT. LAON15(4)) IVCOMP = IVCOMP * 7 09550401 +40260 IF (IVCOMP - 210) 20260, 10260, 20260 09560401 +30260 IVDELE = IVDELE + 1 09570401 + WRITE (I02,80000) IVTNUM 09580401 + IF (ICZERO) 10260, 0271, 20260 09590401 +10260 IVPASS = IVPASS + 1 09600401 + WRITE (I02,80002) IVTNUM 09610401 + GO TO 0271 09620401 +20260 IVFAIL = IVFAIL + 1 09630401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09640401 + 0271 CONTINUE 09650401 +C 09660401 +C 09670401 +C THE PURPOSE OF TESTS 27 THROUGH 29 IS TO VERIFY THAT RECORDS 09680401 +C CAN BE WRITTEN USING ONE EDIT DESCRIPTOR FORM AND READ USING 09690401 +C ANOTHER FORM. 09700401 +C 09710401 +C 09720401 +C 09730401 +C **** FCVS PROGRAM 401 - TEST 027 **** 09740401 +C 09750401 +C 09760401 +C TEST 27 READS A RECORD WITH THE EDIT DESCRIPTORS 4X,L1. THE 09770401 +C RECORD WAS WRITTEN USING THE DESCRIPTOR L5. THE VALUE OF THE 09780401 +C LOGICAL ENTITIES AS A RESULT OF THE READ SHOULD BE TRUE. 09790401 +C 09800401 +C 09810401 + IVTNUM = 27 09820401 + IF (ICZERO) 30270, 0270, 30270 09830401 + 0270 CONTINUE 09840401 + LVON01 = .FALSE. 09850401 + 0272 FORMAT (55X,20X,4X,L1) 09860401 + READ (I08, 0272) LVON01 09870401 + IVCOMP = 0 09880401 + IVCORR = 1 09890401 + IF (LVON01) IVCOMP = 1 09900401 +40270 IF (IVCOMP - 1) 20270, 10270, 20270 09910401 +30270 IVDELE = IVDELE + 1 09920401 + WRITE (I02,80000) IVTNUM 09930401 + IF (ICZERO) 10270, 0281, 20270 09940401 +10270 IVPASS = IVPASS + 1 09950401 + WRITE (I02,80002) IVTNUM 09960401 + GO TO 0281 09970401 +20270 IVFAIL = IVFAIL + 1 09980401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09990401 + 0281 CONTINUE 10000401 +C 10010401 +C **** FCVS PROGRAM 401 - TEST 028 **** 10020401 +C 10030401 +C TEST 28 READS A RECORD WITH THE EDIT DESCRIPTOR 4X,L1. THE 10040401 +C RECORD WAS WRITTEN USING THE EDIT DESCRIPTOR L5. THIS TEST IS 10050401 +C SIMILAR TO TEST 27 EXCEPT THE VALUE OF THE LOGICAL ENTITIES AS A 10060401 +C RESULT OF THE READ SHOULD BE FALSE. 10070401 +C 10080401 +C 10090401 + IVTNUM = 28 10100401 + IF (ICZERO) 30280, 0280, 30280 10110401 + 0280 CONTINUE 10120401 + LVON02 = .TRUE. 10130401 + 0282 FORMAT (55X,20X,4X,L1) 10140401 + READ (I08, 0282) LVON02 10150401 + IVCOMP = 1 10160401 + IVCORR = 0 10170401 + IF (.NOT. LVON02) IVCOMP = 0 10180401 +40280 IF (IVCOMP - 0) 20280, 10280, 20280 10190401 +30280 IVDELE = IVDELE + 1 10200401 + WRITE (I02,80000) IVTNUM 10210401 + IF (ICZERO) 10280, 0291, 20280 10220401 +10280 IVPASS = IVPASS + 1 10230401 + WRITE (I02,80002) IVTNUM 10240401 + GO TO 0291 10250401 +20280 IVFAIL = IVFAIL + 1 10260401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10270401 + 0291 CONTINUE 10280401 +C 10290401 +C **** FCVS PROGRAM 401 - TEST 029 **** 10300401 +C 10310401 +C 10320401 +C TEST 29 READS A RECORD WITH THE EDIT DESCRIPTOR L5. THE 10330401 +C RECORD WAS WRITTEN USING THE EDIT DESCRIPTORS 4X,L1. THE VALUE 10340401 +C OF INTERNAL DATUM AS A RESULT OF THE READ SHOULD BE TRUE. 10350401 +C 10360401 +C 10370401 + IVTNUM = 29 10380401 + IF (ICZERO) 30290, 0290, 30290 10390401 + 0290 CONTINUE 10400401 + LVON01 = .FALSE. 10410401 + 0292 FORMAT (55X,20X,L5) 10420401 + READ (I08, 0292) LVON01 10430401 + IVCOMP = 0 10440401 + IVCORR = 1 10450401 + IF (LVON01) IVCOMP = 1 10460401 +40290 IF (IVCOMP - 1) 20290, 10290, 20290 10470401 +30290 IVDELE = IVDELE + 1 10480401 + WRITE (I02,80000) IVTNUM 10490401 + IF (ICZERO) 10290, 0301, 20290 10500401 +10290 IVPASS = IVPASS + 1 10510401 + WRITE (I02,80002) IVTNUM 10520401 + GO TO 0301 10530401 +20290 IVFAIL = IVFAIL + 1 10540401 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10550401 + 0301 CONTINUE 10560401 +C 10570401 +C 10580401 +C 10590401 +C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES 10600401 +C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION 10610401 +C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. 10620401 +C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED10630401 +C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS 10640401 +C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL 10650401 +C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP 10660401 +C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST 10670401 +C REPORT AND BEFORE THE TEST REPORT SUMMARY. 10680401 +C 10690401 +C ***** BEGIN-FILE-DUMP SECTION ***** 10700401 +C 10710401 +C 10720401 +CDB** 10730401 +C REWIND I08 10740401 +C ITOTR = 141 10750401 +C IRNUM = 1 10760401 +C ILUN = I08 10770401 +C7701 FORMAT (I3,I2,I4,I3,2I4,60A1) 10780401 +C7702 FORMAT (" ",I3,I2,I4,I3,2I4,60A1) 10790401 +C7703 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - OK" ) 10800401 +C7704 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - THERE SHOULD BE " , 10810401 +C 1I3,9H RECORDS.) 10820401 +C DO 7771 IRNUM = 1, ITOTR 10830401 +C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10840401 +C 1 (IDUMP(ICH), ICH = 1,60) 10850401 +C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10860401 +C 1 (IDUMP(ICH), ICH = 1,60) 10870401 +C IF (IEOF .EQ. 9999) GO TO 7772 10880401 +C7771 CONTINUE 10890401 +C GO TO 7775 10900401 +C7772 IF (IRNUM - ITOTR) 7774, 7773, 7775 10910401 +C7773 WRITE (I02, 7703) ILUN, IRNUM 10920401 +C GO TO 7779 10930401 +C7774 WRITE (I02, 7704) ILUN, IRNUM, ITOTR 10940401 +C GO TO 7779 10950401 +C7775 DO 7776 I = 1,20 10960401 +C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10970401 +C 1 (IDUMP(ICH), ICH = 1,60) 10980401 +C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10990401 +C 1 (IDUMP(ICH), ICH = 1,60) 11000401 +C IRNUM = IRNUM + 1 11010401 +C IF (IEOF .EQ. 9999) GO TO 7777 11020401 +C7776 CONTINUE 11030401 +C7777 WRITE (I02 , 7704) ILUN, IRNUM, ITOTR 11040401 +C7779 CONTINUE 11050401 +CDE** * END-FILE-DUMP SECTION * 11060401 +C TEST 029 IS THE LAST TEST IN THIS PROGRAM. THE ROUTINE SHOULD11070401 +C HAVE MADE 29 EXPLICIT TESTS AND PROCESSED ONE FILE CONNECTED FOR 11080401 +C SEQUENTIAL ACCESS 11090401 +C 11100401 +C 11110401 +C 11120401 +C WRITE OUT TEST SUMMARY 11130401 +C 11140401 + WRITE (I02,90004) 11150401 + WRITE (I02,90014) 11160401 + WRITE (I02,90004) 11170401 + WRITE (I02,90000) 11180401 + WRITE (I02,90004) 11190401 + WRITE (I02,90020) IVFAIL 11200401 + WRITE (I02,90022) IVPASS 11210401 + WRITE (I02,90024) IVDELE 11220401 + STOP 11230401 +90001 FORMAT (" ",24X,"FM401") 11240401 +90000 FORMAT (" ",20X,"END OF PROGRAM FM401" ) 11250401 +C 11260401 +C FORMATS FOR TEST DETAIL LINES 11270401 +C 11280401 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 11290401 +80002 FORMAT (" ",4X,I5,7X,"PASS") 11300401 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 11310401 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 11320401 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 11330401 +C 11340401 +C FORMAT STATEMENTS FOR PAGE HEADERS 11350401 +C 11360401 +90002 FORMAT ("1") 11370401 +90004 FORMAT (" ") 11380401 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 11390401 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 11400401 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 11410401 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 11420401 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 11430401 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 11440401 +C 11450401 +C FORMAT STATEMENTS FOR RUN SUMMARY 11460401 +C 11470401 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 11480401 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 11490401 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 11500401 + END 11510401 diff --git a/Fortran/UnitTests/fcvs21_f95/FM401.reference_output b/Fortran/UnitTests/fcvs21_f95/FM401.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM401.reference_output @@ -0,0 +1,62 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM401 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + TESTS 001 THROUGH 007 MUST BE VISUALLY VERIFIED. + IMMEDIATELY FOLLOWING THIS NARRATIVE IS A REFERENCE LINE + OF THE FORM '123456 ...'. THE REFERENCE LINE IS TO + AID IN THE VISUAL VERIFICATION OF THE TESTS. FOR + THE OUTPUT TO BE CORRECT THE DATA VALUES DISPLAYED + IN THE COMPUTED COLUMN MUST MATCH THAT IN THE CORRECT + COLUMN IN BOTH VALUE AND CHARACTER POSITION. + + REFERENCE LINE - 1234567890 1234567890 + 1 T T + 2 T T + 3 T T + 4 F F + 5 F F + 6 TFFFT TFFFT + 7 T F T T F T + + FILE I08 HAS BEEN CREATED AND CONTAINS 141 RECORDS + + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + + ---------------------------------------------- + + END OF PROGRAM FM401 + + 0 TESTS FAILED + 22 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM402.f b/Fortran/UnitTests/fcvs21_f95/FM402.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM402.f @@ -0,0 +1,1308 @@ + PROGRAM FM402 00010402 +C 00020402 +C 00030402 +C 00040402 +C THIS ROUTINE TESTS THE A(W) (W IS SIZE OF FIELD IN CHARACTERS)00050402 +C EDIT DESCRIPTOR OF THE FORMAT SPECIFICATION BOTH WITH AND WITHOUT 00060402 +C THE OPTIONAL W. THE A EDIT DESCRIPTOR IS USED WITH AN INPUT/ 00070402 +C OUTPUT LIST ITEM OF TYPE CHARACTER. IF A FIELD WIDTH W IS SPECI- 00080402 +C FIED WITH THE A EDIT DESCRIPTOR THE FIELD CONSISTS OF W CHARAC- 00090402 +C TERS. IF A FIELD WIDTH W IS NOT SPECIFIED WITH THE A EDIT DES- 00100402 +C CRIPTOR, THE NUMBER OF CHARACTERS IN THE FIELD IS THE LENGTH OF 00110402 +C THE CHARACTER INPUT/OUTPUT LIST ITEM. THIS ROUTINE FIRST 00120402 +C TESTS FOR PROPER EDITING OF CHARACTER DATA ON OUTPUT BY DIRECTING00130402 +C THE EDITED RESULT TO A PRINT FILE. RESULTS OF THIS SET OF 00140402 +C TESTS MUST BE VISUALLY CHECKED FOR CORRECTNESS. NEXT AN EXTERNAL 00150402 +C FILE CONNECTED FOR SEQUENTIAL ACCESS IS CREATED WITH CHARACTER 00160402 +C DATA. FINALLY THE FILE IS REWOUND AND READ WITH THE A(W) EDIT 00170402 +C DESCRIPTOR AND CHECKED FOR PROPER EDITING ON INPUT. 00180402 +C 00190402 +C THIS ROUTINE TESTS FOR PROPER EDITING BY 00200402 +C 00210402 +C (1) THE A EDIT DESCRIPTOR WITHOUT THE OPTIONAL W ON BOTH INPUT00220402 +C AND OUTPUT, 00230402 +C 00240402 +C (2) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT00250402 +C LIST ITEM IS LESS THAN THE WIDTH W, 00260402 +C 00270402 +C (3) THE AW EDIT DESCRIPTOR WHEN THE LENGTH OF THE INPUT/OUTPUT00280402 +C LIST ITEM IS BOTH EQUAL TO AND GREATER THAN THE WIDTH W, 00290402 +C 00300402 +C (4) THE A EDIT DESCRIPTOR WHEN USED WITH THE OPTIONAL REPEAT 00310402 +C SPECIFICATION. 00320402 +C 00330402 +C REFERENCES - 00340402 +C 00350402 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00360402 +C X3.9-1978 00370402 +C 00380402 +C SECTION 3.1, FORTRAN CHARACTER SET 00390402 +C SECTION 4.8, CHARACTER TYPE 00400402 +C SECTION 8.4.2, CHARACTER TYPE-STATEMENT 00410402 +C SECTION 10.4, CHARACTER ASSIGNMENT STATEMENT 00420402 +C SECTION 13.5.11, A EDITING 00430402 +C 00440402 +C 00450402 +C 00460402 +C 00470402 +C ******************************************************************00480402 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00490402 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00500402 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00510402 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00520402 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00530402 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00540402 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00550402 +C THE RESULT OF EXECUTING THESE TESTS. 00560402 +C 00570402 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00580402 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00590402 +C 00600402 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00610402 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00620402 +C SOFTWARE STANDARDS VALIDATION GROUP 00630402 +C BUILDING 225 RM A266 00640402 +C GAITHERSBURG, MD 20899 00650402 +C ******************************************************************00660402 +C 00670402 +C 00680402 + IMPLICIT LOGICAL (L) 00690402 + IMPLICIT CHARACTER*14 (C) 00700402 +C 00710402 + DIMENSION IDUMP (80) 00720402 + DIMENSION CATN11(46), CATN12(5), CATN31(2,3,2), CATN14(46) 00730402 + CHARACTER CATN11*1, CVTN11*1, CATN12*5, CATN31*1 00740402 + CHARACTER CVTN12*10, CVTN13*2, CATN14*1, CCTN15*50, CVTN15*50 00750402 + CHARACTER CVTN01*1 00760402 + 00770402 + DATA CATN14 /46*' '/ 00780402 + DATA CCTN15 /'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789'/00790402 + DATA CATN11 / '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', 00800402 + 1'=', '+', '-','*', '/', '(', ')', ',', '.', '''','A', 'B', 'C', 00810402 + 2'D', 'E', 'F','G', 'H', 'I', 'J', 'K', 'L', 'M', 'N', 'O', 'P', 00820402 + 3'Q', 'R', 'S','T', 'U', 'V', 'W', 'X', 'Y', 'Z'/ 00830402 + DATA CATN12 /'ABMYZ', '01589', '=+-()','A5+Z.' ,'1''A,4'/ 00840402 + 00850402 +C 00860402 +C 00870402 +C 00880402 +C INITIALIZATION SECTION. 00890402 +C 00900402 +C INITIALIZE CONSTANTS 00910402 +C ******************** 00920402 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 00930402 + I01 = 5 00940402 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 00950402 + I02 = 6 00960402 +C SYSTEM ENVIRONMENT SECTION 00970402 +C 00980402 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.00990402 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01000402 +C (UNIT NUMBER FOR CARD READER). 01010402 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01020402 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01030402 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01040402 +C 01050402 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01060402 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01070402 +C (UNIT NUMBER FOR PRINTER). 01080402 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01090402 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01100402 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01110402 +C 01120402 + IVPASS = 0 01130402 + IVFAIL = 0 01140402 + IVDELE = 0 01150402 + ICZERO = 0 01160402 +C 01170402 +C WRITE OUT PAGE HEADERS 01180402 +C 01190402 + WRITE (I02,90002) 01200402 + WRITE (I02,90006) 01210402 + WRITE (I02,90008) 01220402 + WRITE (I02,90004) 01230402 + WRITE (I02,90010) 01240402 + WRITE (I02,90004) 01250402 + WRITE (I02,90016) 01260402 + WRITE (I02,90001) 01270402 + WRITE (I02,90004) 01280402 + WRITE (I02,90012) 01290402 + WRITE (I02,90014) 01300402 + WRITE (I02,90004) 01310402 +C 01320402 +C 01330402 +C 01340402 +C TEST 001 THROUGH 014 TESTS THE EDIT DESCRIPTOR FOR PROPER 01350402 +C EDITING OF CHARACTER DATA ON OUTPUT. TO VALIDATE THESE TESTS 01360402 +C THE EDITED DATA IS SENT TO A PRINT FILE AND THEREFORE MUST BE 01370402 +C VISUALLY CHECKED FOR CORRECTNESS. ON OUTPUT THE EDITED FIELD 01380402 +C SIZE IS AW WHERE W IS NUMBER OF POSITIONS IN THE FIELD OR 01390402 +C IS THE SIZE OF THE OUTPUT DATUM ITEM. SEE SECTION 13.5.11 A 01400402 +C EDITING 01410402 +C 01420402 +C 01430402 +80052 FORMAT (" ",4X, "TESTS 001 THROUGH 014 MUST BE VISUALLY VERIFIED.01440402 + 1") 01450402 +80054 FORMAT (" ", "IMMEDIATELY FOLLOWING THIS NARRATIVE IS A REFERENCE01460402 + 1 LINE") 01470402 +80056 FORMAT (" ", "OF THE FORM '123456 ...'. THE REFERENCE LINE IS T01480402 + 1O") 01490402 +80058 FORMAT (" ","AID IN THE VISUAL VERIFICATION OF THE TESTS. FOR" ) 01500402 +80062 FORMAT (" ","THE OUTPUT TO BE CORRECT THE DATA VALUES DISPLAYED" 01510402 + 1) 01520402 +80064 FORMAT (" ", "IN THE COMPUTED COLUMN MUST MATCH THAT IN THE CORRE01530402 + 1CT ") 01540402 +80066 FORMAT (" ","COLUMN IN BOTH VALUE AND CHARACTER POSITION." ) 01550402 +80072 FORMAT (" ","REFERENCE LINE - " ,"1234567890" ,5X, "123401560402 + 1567890") 01570402 + WRITE (I02,80052) 01580402 + WRITE (I02,80054) 01590402 + WRITE (I02,80056) 01600402 + WRITE (I02,80058) 01610402 + WRITE (I02,80062) 01620402 + WRITE (I02,80064) 01630402 + WRITE (I02,80066) 01640402 + WRITE (I02,90004) 01650402 + WRITE (I02,80072) 01660402 +C 01670402 +C **** FCVS PROGRAM 402 - TEST 001 **** 01680402 +C 01690402 +C TEST 001 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 01700402 +C ON OUTPUT WHERE THE FIELD IS 1 POSITION IN LENGTH, THE 01710402 +C VALUE OF THE DATUM IS LETTERS AND THE OUTPUT LIST ITEM IS A 01720402 +C VARIABLE. 01730402 +C 01740402 + IVTNUM = 001 01750402 + IF (ICZERO) 30010, 0010, 30010 01760402 + 0010 CONTINUE 01770402 + CVTN01 = 'A' 01780402 + 0012 FORMAT (" ",4X,I5,26X,A,14X,"A") 01790402 + WRITE (I02, 0012) IVTNUM, CVTN01 01800402 + GO TO 0021 01810402 +30010 IVDELE = IVDELE + 1 01820402 + WRITE (I02,80000) IVTNUM 01830402 + 0021 CONTINUE 01840402 +C 01850402 +C **** FCVS PROGRAM 402 - TEST 002 **** 01860402 +C 01870402 +C TEST 002 IS SIMILAR TO TEST 001 EXCEPT THAT THE OUTPUT LIST 01880402 +C ITEM IS AN ARRAY ELEMENT. 01890402 +C 01900402 + IVTNUM = 002 01910402 + IF (ICZERO) 30020, 0020, 30020 01920402 + 0020 CONTINUE 01930402 + CATN31 (1,2,1) = 'Z' 01940402 + 0022 FORMAT (" ",4X,I5,26X,A,14X,"Z") 01950402 + WRITE (I02, 0022) IVTNUM, CATN31 (1,2,1) 01960402 + GO TO 0031 01970402 +30020 IVDELE = IVDELE + 1 01980402 + WRITE (I02,80000) IVTNUM 01990402 + 0031 CONTINUE 02000402 +C 02010402 +C *** FCVS PROGRAM 402 - TEST 003 **** 02020402 +C 02030402 +C TEST 003 VERIFIES THAT THE A EDIT DESCRIPTOR (WITHOUT THE 02040402 +C W OPTION) CAN PROPERLY EDIT SPECIAL CHARACTERS ON OUTPUT. THE 02050402 +C SPECIAL CHARACTER / (SLASH) IS USED FOR THIS TEST AND IS STORED 02060402 +C IN AN OUTPUT LIST ITEM 1 POSITION IN LENGTH. 02070402 +C 02080402 + IVTNUM = 003 02090402 + IF (ICZERO) 30030, 0030, 30030 02100402 + 0030 CONTINUE 02110402 + CVTN11 = '/' 02120402 + 0032 FORMAT (" ",4X,I5,26X,A,14X,"/") 02130402 + WRITE (I02, 0032) IVTNUM, CVTN11 02140402 + GO TO 0041 02150402 +30030 IVDELE = IVDELE + 1 02160402 + WRITE (I02, 80000) IVTNUM 02170402 + 0041 CONTINUE 02180402 +C 02190402 +C *** FCVS PROGRAM 402 - TEST 004 *** 02200402 +C 02210402 +C TEST 004 IS SIMILAR TO TEST 003 EXCEPT THAT THE DATA BEING 02220402 +C EDITED IS NUMERIC. 02230402 +C 02240402 + IVTNUM = 004 02250402 + IF (ICZERO) 30040, 0040, 30040 02260402 + 0040 CONTINUE 02270402 + CVTN11 = '9' 02280402 + 0042 FORMAT (" ",4X,I5,26X,A,14X,"9") 02290402 + WRITE (I02, 0042) IVTNUM, CVTN11 02300402 + GO TO 0051 02310402 +30040 IVDELE = IVDELE + 1 02320402 + WRITE (I02, 80000) IVTNUM 02330402 + 0051 CONTINUE 02340402 +C 02350402 +C *** FCVS PROGRAM 402 - TEST 005 *** 02360402 +C 02370402 +C TEST 005 IS SIMILAR TO TEST 003 EXCEPT THAT IT USES THE SPECIAL02380402 +C CHARACTER QUOTE. 02390402 +C 02400402 + IVTNUM = 005 02410402 + IF (ICZERO) 30050, 0050, 30050 02420402 + 0050 CONTINUE 02430402 + CVTN11 = '''' 02440402 + 0052 FORMAT (" ",4X,I5,26X,A,14X,"'") 02450402 + WRITE (I02, 0052) IVTNUM, CVTN11 02460402 + GO TO 0061 02470402 +30050 IVDELE = IVDELE + 1 02480402 + WRITE (I02, 80000) IVTNUM 02490402 +C 02500402 +C 02510402 +C TESTS 006 THROUGH TEST 011 TESTS THE A EDIT DESCRIPTOR 02520402 +C WITHOUT THE FIELD WIDTH SPECIFICATION (W OPTION) WHERE THE SIZE 02530402 +C OF THE OUTPUT DATA ITEM IS 05 CHARACTERS IN LENGTH. 02540402 +C 02550402 +C 02560402 + 0061 CONTINUE 02570402 +C 02580402 +C **** FCVS PROGRAM 402 - TEST 006 **** 02590402 +C 02600402 +C TEST 006 TESTS USE OF THE A EDIT DESCRIPTOR WITH LETTERS 02610402 +C 02620402 + IVTNUM = 006 02630402 + IF (ICZERO) 30060, 0060, 30060 02640402 + 0060 CONTINUE 02650402 + CATN12(1) = 'ABMYZ' 02660402 + 0062 FORMAT(" ",4X,I5,17X," ",A,5X," ABMYZ" ) 02670402 + WRITE (I02, 0062) IVTNUM, CATN12(1) 02680402 + GO TO 0071 02690402 +30060 IVDELE = IVDELE + 1 02700402 + WRITE (I02, 80000) IVTNUM 02710402 + 0071 CONTINUE 02720402 +C 02730402 +C **** FCVS PROGRAM 402 - TEST 007 **** 02740402 +C 02750402 +C TEST 007 TESTS USE OF THE A EDIT DESCRIPTOR WITH DIGITS 02760402 +C 02770402 + IVTNUM = 007 02780402 + IF (ICZERO) 30070, 0070, 30070 02790402 + 0070 CONTINUE 02800402 + CATN12(2) = '01589' 02810402 + 0072 FORMAT(" ",4X,I5,17X," ",A,5X," 01589" ) 02820402 + WRITE (I02, 0072) IVTNUM, CATN12(2) 02830402 + GO TO 0081 02840402 +30070 IVDELE = IVDELE + 1 02850402 + WRITE (I02, 80000) IVTNUM 02860402 + 0081 CONTINUE 02870402 +C 02880402 +C **** FCVS PROGRAM 402 - TEST 008 **** 02890402 +C 02900402 +C TEST 008 TESTS USE OF THE A EDIT DESCRIPTOR WITH SPECIAL 02910402 +C CHARACTERS. 02920402 +C 02930402 + IVTNUM = 008 02940402 + IF (ICZERO) 30080, 0080, 30080 02950402 + 0080 CONTINUE 02960402 + CATN12(3) = '=+-()' 02970402 + 0082 FORMAT(" ",4X,I5,17X," ",A,5X," =+-()" ) 02980402 + WRITE (I02, 0082) IVTNUM, CATN12(3) 02990402 + GO TO 0091 03000402 +30080 IVDELE = IVDELE + 1 03010402 + WRITE (I02, 80000) IVTNUM 03020402 + 0091 CONTINUE 03030402 +C 03040402 +C **** FCVS PROGRAM FM402 - TEST 009 **** 03050402 +C 03060402 +C TEST 009 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX 03070402 +C OF LETTERS, DIGITS AND SPECIAL CHARACTERS 03080402 +C 03090402 + IVTNUM = 009 03100402 + IF (ICZERO) 30090, 0090, 30090 03110402 + 0090 CONTINUE 03120402 + CATN12(4) = 'A5+.Z' 03130402 + 0092 FORMAT(" ",4X,I5,17X," ",A,5X," A5+.Z" ) 03140402 + WRITE (I02, 0092) IVTNUM, CATN12(4) 03150402 + GO TO 0101 03160402 +30090 IVDELE = IVDELE + 1 03170402 + WRITE (I02, 80000) IVTNUM 03180402 + 0101 CONTINUE 03190402 +C 03200402 +C **** FCVS PROGRAM FM402 - TEST 010 **** 03210402 +C 03220402 +C TEST 010 TESTS USE OF THE A EDIT DESCRIPTOR WITH A MIX 03230402 +C OF LETTERS, DIGITS AND SPECIAL CHARACTERS INCLUDING APOSTROPES 03240402 +C 03250402 + IVTNUM = 010 03260402 + IF (ICZERO) 30100, 0100, 30100 03270402 + 0100 CONTINUE 03280402 + CATN12(5) = '1''A,4' 03290402 + 0102 FORMAT(" ",4X,I5,17X," ",A,5X," 1'A,4" ) 03300402 + WRITE (I02, 0102) IVTNUM, CATN12(5) 03310402 + GO TO 0111 03320402 +30100 IVDELE = IVDELE + 1 03330402 + WRITE (I02, 80000) IVTNUM 03340402 +C 03350402 + 0111 CONTINUE 03360402 +C **** FCVS PROGRAM FM402 - TEST 11 **** 03370402 +C 03380402 +C TEST 011 USES THE A EDIT DESCRIPTOR (WITHOUT THE OPTIONAL 03390402 +C FIELD WIDTH SPECIFIED) WITH THE OPTIONAL REPEAT SPECIFICATION. 03400402 +C EACH OUTPUT LIST ITEM WILL BE ONE CHARACTER IN LENGTH. 03410402 +C 03420402 + IVTNUM = 011 03430402 + IF (ICZERO) 30110, 0110, 30110 03440402 + 0110 CONTINUE 03450402 + 0112 FORMAT (" ",4X,I5,17X,10A,5X,"059=+PQUVY" ) 03460402 + WRITE (I02, 0112) IVTNUM, CATN11(1), CATN11(6), CATN11(10), 03470402 + 1CATN11(11), CATN11(12), CATN11(36), CATN11(37), CATN11(41), 03480402 + 2CATN11(42), CATN11(45) 03490402 + GO TO 0121 03500402 +30110 IVDELE = IVDELE + 1 03510402 + WRITE (I02, 80000) IVTNUM 03520402 + 0121 CONTINUE 03530402 +C 03540402 +C **** FCVS PROGRAM FM402 - TEST 12 **** 03550402 +C 03560402 +C TEST 012 IS SIMILAR TO 011 IN THAT THE A DESCRIPTOR IS USED 03570402 +C WITH THE OPTIONAL REPEAT SPECIFICATION E. G., 3A HOWEVER, EACH 03580402 +C OUTPUT LIST ITEM HAS A DIFFERENT NUMBER OF CHARACTERS IN THE ITEM 03590402 +C E. G., THE FIRST I/O LIST ITEM HAS 5 CHARACTERS, THE SECOND 03600402 +C ITEM HAS 2 CHARACTERS AND THE THIRD ITEM HAS 1 CHARACTER. 03610402 +C 03620402 + IVTNUM = 012 03630402 + IF (ICZERO) 30120, 0120, 30120 03640402 + 0120 CONTINUE 03650402 + CVTN13 = 'YZ' 03660402 + CVTN11 = ')' 03670402 + CATN12(2) = '(12AB' 03680402 + 0122 FORMAT (" ",4X,I5,17X,"*",3A,"*",5X,"*(12ABYZ)*" ) 03690402 + WRITE (I02, 0122) IVTNUM, CATN12(2), CVTN13, CVTN11 03700402 + GO TO 0131 03710402 +30120 IVDELE = IVDELE + 1 03720402 + WRITE (I02, 80000) IVTNUM 03730402 + 0131 CONTINUE 03740402 +C 03750402 +C **** FCVS PROGRAM FM402 - TEST 13 *** 03760402 +C 03770402 +C TEST 013 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 03780402 +C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM 03790402 +C HAS FEWER CHARACTERS THAN SPECIFIED BY THE EDIT DESCRIPTOR. THE 03800402 +C OUTPUT FIELD SHOULD CONSISTS OF BLANKS FOLLOWED BY CHARACTERS 03810402 +C FROM THE INTERNAL REPRESENTATION. 03820402 +C 03830402 + IVTNUM = 013 03840402 + IF (ICZERO) 30130, 0130, 30130 03850402 + 0130 CONTINUE 03860402 + CATN12(1) = 'ABMYZ' 03870402 + 0132 FORMAT (" ",4X,I5,17X,A10,5X," ABMYZ" ) 03880402 + WRITE (I02, 0132) IVTNUM, CATN12(1) 03890402 + GO TO 0141 03900402 +30130 IVDELE = IVDELE + 1 03910402 + WRITE (I02, 80000) IVTNUM 03920402 + 0141 CONTINUE 03930402 +C 03940402 +C **** FCVS PROGRAM FM402 - TEST 14 **** 03950402 +C 03960402 +C TEST 014 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR 03970402 +C (WITH THE FIELD WIDTH SPECIFIED) WHEN THE OUTPUT LIST ITEM 03980402 +C IS GREATER THAN THAT SPECIFIED BY THE EDIT DESCRIPTOR. THE OUTPUT03990402 +C FIELD SHOULD CONSIST OF THE LEFTMOST CHARACTERS FROM THE INTERNAL 04000402 +C REPRESENTATION. 04010402 +C 04020402 + IVTNUM = 014 04030402 + IF (ICZERO) 30140, 0140, 30140 04040402 + 0140 CONTINUE 04050402 + CVTN12 = '12345ABCDE' 04060402 + 0142 FORMAT (" ",4X,I5,17X," ",A5,5X," 12345" ) 04070402 + WRITE (I02, 0142) IVTNUM, CVTN12 04080402 + GO TO 0151 04090402 +30140 IVDELE = IVDELE + 1 04100402 + WRITE (I02, 80000) IVTNUM 04110402 + 0151 CONTINUE 04120402 +C 04130402 +C THE FOLLOWING BLOCK OF SOURCE CODE BEGINNING WITH COMMENT LINE 04140402 +C **** CREATE-FILE SECTION AND ENDING WITH THE COMMENT LINE 04150402 +C **** END-OF-CREATE-FILE SECTION BUILDS A FILE WHICH IS USED IN 04160402 +C TESTING THE A EDIT DESCRIPTOR. THE FILE PROPERTIES ARE: 04170402 +C 04180402 +C FILE IDENTIFIER - I09 (X-NUMBER 09) 04190402 +C RECORD SIZE - 80 CHARACTERS 04200402 +C ACCESS METHOD - SEQUENTIAL 04210402 +C RECORD TYPE - FORMATTED 04220402 +C DESIGNATED DEVICE - DISK 04230402 +C TYPE OF DATA - CHARACTER (A FORMAT) 04240402 +C RECORDS IN FILE - 143 PLUS THE ENDFILE RECORD 04250402 +C 04260402 +C THE FIRST 20 POSITIONS OF EACH RECORD IN THE FILE UNIQUELY 04270402 +C IDENTIFIES THAT RECORD. THE REMAINING POSITONS OF THE RECORD 04280402 +C CONTAIN DATA WHICH IS USED IN TESTING THE A EDIT DESCRIPTOR. 04290402 +C A DESCRIPTION OF EACH FIELD OF THE 20-CHARACTER PREAMBLE FOLLOWS. 04300402 +C 04310402 +C VARIABLE NAME IN PROGRAM CHARACTER POSITIONS 04320402 +C -------- ---- -- ------- --------- --------- 04330402 +C 04340402 +C IPROG (ROUTINE NAME) - 1 THRU 3 04350402 +C IFILE (LOGICAL/ X-NUMBER) - 4 THRU 5 04360402 +C ITOTR (RECORDS IN FILE) - 6 THRU 9 04370402 +C IRLGN (CHARACTERS IN RECORD) - 10 THRU 12 04380402 +C IRECN (RECORD NUMBER) - 13 THRU 16 04390402 +C IEOF (9999 IF LAST RECORD) - 17 THRU 20 04400402 +C 04410402 +C DEFAULT ASSIGNMENT FOR FILE IS I09 = 07 04420402 + I09 = 409 04430402 +CX090 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-090 04440402 +CX091 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-091 04450402 + IPROG = 402 04460402 + IFILE = I09 04470402 + ITOTR = 143 04480402 + IRLGN = 80 04490402 + IRECN = 0 04500402 + IEOF = 0 04510402 +C 04520402 +C 04530402 +C ***** CREATE-FILE SECTION ***** 04540402 +C 04550402 +C 04560402 +C **** FCVS PROGRAM 402 - TEST 015 **** 04570402 +C 04580402 +C 04590402 +C TEST 15 WRITES RECORDS USING THE A EDIT DESCRIPTOR WITHOUT THE04600402 +C OPTIONAL FIELD WIDTH SPECIFICATION. EACH CHARACTER OF THE 04610402 +C FORTRAN SET IS WRITTEN WITH AN A EDIT DESCRIPTOR FROM 04620402 +C THE INTERNAL REPRESENTATION WHICH IS ONE CHARACTER IN LENGTH. 04630402 +C TEN DIFFERENT CHARACTERS ARE WRITTEN IN EACH RECORD UNTIL THE 04640402 +C FULL CHARACTER SET IS EXHAUSTED. THIS SEQUENCE IS REPEATED UNTIL04650402 +C 50 RECORDS HAVE BEEN WRITTEN (5 RECORDS PER SET AND 10 SETS). 04660402 +C THE RECORDS ARE WRITTEN TO A MASS STORAGE FILE. 04670402 +C 04680402 +C 04690402 + IVTNUM = 15 04700402 + IF (ICZERO) 30150, 0150, 30150 04710402 + 0150 CONTINUE 04720402 +70003 FORMAT (I3,I2,I4,I3,2I4,50X,10A) 04730402 +70004 FORMAT (I3,I2,I4,I3,2I4,54X,6A) 04740402 + IRECN = 0 04750402 + DO 4023 I=1,10 04760402 + IRECN = IRECN + 1 04770402 + WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04780402 + 1 (CATN11 (J), J = 1,10) 04790402 +C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD 04800402 + IRECN = IRECN + 1 04810402 + WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04820402 + 1 (CATN11(J), J = 11,20) 04830402 +C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD. 04840402 + IRECN = IRECN + 1 04850402 + WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04860402 + 1 (CATN11(J), J = 21,30) 04870402 +C CHARACTERS A THROUGH J ARE IN THIS RECORD 04880402 + IRECN = IRECN + 1 04890402 + WRITE (I09, 70003) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04900402 + 1 (CATN11(J), J = 31,40) 04910402 +C CHARACTERS K THROUGH T ARE IN THIS RECORD 04920402 + IRECN = IRECN + 1 04930402 + WRITE (I09, 70004) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04940402 + 1 (CATN11(J), J = 41,46) 04950402 +C CHARACTERS U THROUGH Z ARE IN THIS RECORD 04960402 + 4023 CONTINUE 04970402 + IVCOMP = IRECN 04980402 + IVCORR = 050 04990402 + IVON01 = 50 05000402 +40150 IF (IVON01 - IRECN ) 20150, 10150, 20150 05010402 +C VALUE IN IVCOMP IS THE NUMBER OF RECORDS WRITTEN 05020402 +30150 IVDELE = IVDELE + 1 05030402 + WRITE (I02,80000) IVTNUM 05040402 + IF (ICZERO) 10150, 0161, 20150 05050402 +10150 IVPASS = IVPASS + 1 05060402 + WRITE (I02,80002) IVTNUM 05070402 + GO TO 0161 05080402 +20150 IVFAIL = IVFAIL + 1 05090402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05100402 + 0161 CONTINUE 05110402 +C 05120402 +C **** FCVS PROGRAM 402 - TEST 016 **** 05130402 +C 05140402 +C 05150402 +C TEST 16 IS THE SAME AS TEST 15 EXCEPT THAT THE 50 RECORDS 05160402 +C WRITTEN USE THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH05170402 +C SPECIFIED. 05180402 +C 05190402 +C 05200402 + IVTNUM = 16 05210402 + IF (ICZERO) 30160, 0160, 30160 05220402 + 0160 CONTINUE 05230402 +70005 FORMAT (I3,I2,I4,I3,2I4,50X,10A1) 05240402 +70006 FORMAT (I3,I2,I4,I3,2I4,54X,6A1) 05250402 + IRECN = 50 05260402 + DO 4024 I=1,10 05270402 + IRECN = IRECN + 1 05280402 + WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05290402 + 1 (CATN11(J), J = 1,10) 05300402 +C CHARACTERS 0 THROUGH 9 ARE CONTAINED IN THIS RECORD 05310402 + IRECN = IRECN + 1 05320402 + WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05330402 + 1 (CATN11(J), J = 11,20) 05340402 +C CHARACTERS =,+,-,*,/,(,),,,. AND ' ARE IN THIS RECORD 05350402 + IRECN = IRECN + 1 05360402 + WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05370402 + 1 (CATN11(J), J = 21,30) 05380402 +C CHARACTERS A THROUGH J ARE IN THIS RECORD 05390402 + IRECN = IRECN + 1 05400402 + WRITE (I09, 70005) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05410402 + 1 (CATN11(J), J = 31,40) 05420402 +C CHARACTERS K THROUGH T ARE IN THIS RECORD 05430402 + IRECN = IRECN + 1 05440402 + WRITE (I09, 70006) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05450402 + 1 (CATN11(J), J = 41,46) 05460402 +C CHARACTERS U THROUGH Z ARE IN THIS RECORD 05470402 + 4024 CONTINUE 05480402 + IVCOMP = IRECN - 50 05490402 + IVCORR = 50 05500402 + IVON01 = 100 05510402 +40160 IF (IVON01 - IRECN) 20160, 10160, 20160 05520402 +30160 IVDELE = IVDELE + 1 05530402 + WRITE (I02,80000) IVTNUM 05540402 + IF (ICZERO) 10160, 0171, 20160 05550402 +10160 IVPASS = IVPASS + 1 05560402 + WRITE (I02,80002) IVTNUM 05570402 + GO TO 0171 05580402 +20160 IVFAIL = IVFAIL + 1 05590402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05600402 + 0171 CONTINUE 05610402 +C 05620402 +C **** FCVS PROGRAM 402 - TEST 017 **** 05630402 +C 05640402 +C 05650402 +C TEST 17 WRITES 40 RECORDS CONTAINING CHARACTER DATA WHICH IS 05660402 +C USED FOR LATER TESTS. THE FILE SHOULD CONTAIN 140 RECORDS 05670402 +C FOLLOWING EXECUTION OF THIS TEST. 05680402 +C 05690402 +C 05700402 + IVTNUM = 17 05710402 + IF (ICZERO) 30170, 0170, 30170 05720402 + 0170 CONTINUE 05730402 +70007 FORMAT (I3,I2,I4,I3,2I4, "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 05740402 + 1 ") 05750402 +70008 FORMAT (I3,I2,I4,I3,2I4, "=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4 05760402 + 1 ") 05770402 + IRECN = 100 05780402 + DO 4025 I = 1,20 05790402 + IRECN = IRECN + 1 05800402 + WRITE (I09, 70007) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 05810402 +C CHARACTERS 0 THROUGH 9 AND A THROUGH Z ARE IN THIS RECORD 05820402 + IRECN = IRECN + 1 05830402 + WRITE (I09, 70008) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 05840402 +C SPECIAL CHARACTERS ARE IN THIS RECORD 05850402 + 4025 CONTINUE 05860402 + IVCOMP = IRECN - 100 05870402 + IVCORR = 40 05880402 + IVON01 = 140 05890402 +40170 IF (IVON01 - IRECN) 20170, 10170, 20170 05900402 +30170 IVDELE = IVDELE + 1 05910402 + WRITE (I02,80000) IVTNUM 05920402 + IF (ICZERO) 10170, 0181, 20170 05930402 +10170 IVPASS = IVPASS + 1 05940402 + WRITE (I02,80002) IVTNUM 05950402 + GO TO 0181 05960402 +20170 IVFAIL = IVFAIL + 1 05970402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05980402 + 0181 CONTINUE 05990402 +C 06000402 +C **** FCVS PROGRAM 402 - TEST 018 **** 06010402 +C 06020402 +C 06030402 +C TEST 18 WRITES A RECORD WHICH CONTAINS A LONG FIELD (50 CHAR- 06040402 +C ACTERS) USING AN A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD 06050402 +C WIDTH SPECIFICATION. 06060402 +C 06070402 +C 06080402 + IVTNUM = 18 06090402 + IF (ICZERO) 30180, 0180, 30180 06100402 + 0180 CONTINUE 06110402 + IRECN = 141 06120402 +70009 FORMAT (I3,I2,I4,I3,2I4,10X,A) 06130402 + WRITE (I09, 70009) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN1506140402 + IVCOMP = IRECN - 140 06150402 + IVCORR = 1 06160402 + IVON01 = 141 06170402 +40180 IF (IVON01 - IRECN) 20180, 10180, 20180 06180402 +30180 IVDELE = IVDELE + 1 06190402 + WRITE (I02,80000) IVTNUM 06200402 + IF (ICZERO) 10180, 0191, 20180 06210402 +10180 IVPASS = IVPASS + 1 06220402 + WRITE (I02,80002) IVTNUM 06230402 + GO TO 0191 06240402 +20180 IVFAIL = IVFAIL + 1 06250402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06260402 + 0191 CONTINUE 06270402 +C 06280402 +C **** FCVS PROGRAM 402 - TEST 019 **** 06290402 +C 06300402 +C 06310402 +C TEST 19 WRITES A LONG FIELD (50 CHARACTERS) 06320402 +C USING AN A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH 06330402 +C SPECIFICATION. 06340402 +C 06350402 +C 06360402 + IVTNUM = 19 06370402 + IF (ICZERO) 30190, 0190, 30190 06380402 + 0190 CONTINUE 06390402 + IRECN = 142 06400402 +70010 FORMAT (I3,I2,I4,I3,2I4,10X,A50) 06410402 + WRITE (I09, 70010) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, CCTN1506420402 + IVCOMP = IRECN - 141 06430402 + IVCORR = 1 06440402 + IVON01 = 142 06450402 +40190 IF (IVON01 - IRECN) 20190, 10190, 20190 06460402 +30190 IVDELE = IVDELE + 1 06470402 + WRITE (I02,80000) IVTNUM 06480402 + IF (ICZERO) 10190, 0201, 20190 06490402 +10190 IVPASS = IVPASS + 1 06500402 + WRITE (I02,80002) IVTNUM 06510402 + GO TO 0201 06520402 +20190 IVFAIL = IVFAIL + 1 06530402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06540402 + 0201 CONTINUE 06550402 +C 06560402 +C **** FCVS PROGRAM 402 - TEST 020 **** 06570402 +C 06580402 +C 06590402 + IVTNUM = 20 06600402 + IF (ICZERO) 30200, 0200, 30200 06610402 + 0200 CONTINUE 06620402 + IRECN = IRECN + 1 06630402 + IEOF = 9999 06640402 +70011 FORMAT (I3,I2,I4,I3,2I4,59X," ") 06650402 + WRITE (I09, 70011) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 06660402 + ENDFILE I09 06670402 + REWIND I09 06680402 + WRITE (I02, 90004) 06690402 +70012 FORMAT (" FILE I09 HAS BEEN CREATED AND CONTAINS 143 RECORDS" ) 06700402 +70013 FORMAT (" INCORRECT NUMBER OF RECORDS IN FILE - " , I5 , " RECO06710402 + 1RDS") 06720402 +70014 FORMAT (" WRITTEN BUT 143 RECORDS SHOULD HAVE BEEN WRITTEN." ) 06730402 + IF (IRECN - 143) 4020, 4021, 4020 06740402 + 4020 WRITE (I02, 70013) IRECN 06750402 + WRITE (I02, 70014) 06760402 + GO TO 4022 06770402 + 4021 WRITE (I02, 70012) 06780402 + WRITE (I02, 90004) 06790402 +C 06800402 +C **** END-OF-CREATE-FILE SECTION **** 06810402 +C 06820402 + 4022 CONTINUE 06830402 +C 06840402 +C TESTS 20 THROUGH 24 READ 5 OF THE FIRST 50 RECORDS USING THE 06850402 +C A EDIT DESCRIPTOR WITHOUT THE OPTIONAL FIELD WIDTH SPECIFICATION. 06860402 +C EACH CHARACTER IS CHECKED FOR PROPER EDITING. THE FIELDS ARE 06870402 +C WRITTEN AND READ WITH THE SAME A EDIT DESCRIPTOR FORM. THE 06880402 +C RESULTING NUMBER FROM EACH TEST IN IVCOMP AND IVCORR IS 06890402 +C THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ. 06900402 +C 06910402 +C 06920402 +C TEST 20 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. THE 06930402 +C VALUE RESULTING FROM THE TEST IN IVCOMP AND IVCORR REFLECTS THE 06940402 +C NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF THE READ. 06950402 +C 06960402 + IVCOMP = 0 06970402 + IVCORR = 10 06980402 + 0202 FORMAT (70X,10A) 06990402 + READ (I09, 0202) (CATN14(J), J = 1,10) 07000402 + DO 0203 I=1,10 07010402 + IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07020402 + 0203 CONTINUE 07030402 +40200 IF (IVCOMP - 10) 20200, 10200, 20200 07040402 +30200 IVDELE = IVDELE + 1 07050402 + WRITE (I02,80000) IVTNUM 07060402 + IF (ICZERO) 10200, 0211, 20200 07070402 +10200 IVPASS = IVPASS + 1 07080402 + WRITE (I02,80002) IVTNUM 07090402 + GO TO 0211 07100402 +20200 IVFAIL = IVFAIL + 1 07110402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07120402 + 0211 CONTINUE 07130402 +C 07140402 +C **** FCVS PROGRAM 402 - TEST 021 **** 07150402 +C 07160402 +C 07170402 +C TEST 21 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND07180402 +C '. THE NUMBER RESULTING FROM THE TEST IN IVCOMP AND IVCORR 07190402 +C REFLECTS THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT OF 07200402 +C THE READ. 07210402 +C 07220402 +C 07230402 + IVTNUM = 21 07240402 + IF (ICZERO) 30210, 0210, 30210 07250402 + 0210 CONTINUE 07260402 + IVCOMP = 0 07270402 + IVCORR = 10 07280402 + 0212 FORMAT (70X,10A) 07290402 + READ (I09, 0212) (CATN14(J), J = 11,20) 07300402 + DO 0213 I = 11,20 07310402 + IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07320402 + 0213 CONTINUE 07330402 +40210 IF (IVCOMP - 10) 20210, 10210, 20210 07340402 +30210 IVDELE = IVDELE + 1 07350402 + WRITE (I02,80000) IVTNUM 07360402 + IF (ICZERO) 10210, 0221, 20210 07370402 +10210 IVPASS = IVPASS + 1 07380402 + WRITE (I02,80002) IVTNUM 07390402 + GO TO 0221 07400402 +20210 IVFAIL = IVFAIL + 1 07410402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07420402 + 0221 CONTINUE 07430402 +C 07440402 +C **** FCVS PROGRAM 402 - TEST 022 **** 07450402 +C 07460402 +C 07470402 +C TEST 22 READS AND CHECKS THE CHARACTERS A THROUGH J. 07480402 +C 07490402 +C 07500402 + IVTNUM = 22 07510402 + IF (ICZERO) 30220, 0220, 30220 07520402 + 0220 CONTINUE 07530402 + IVCOMP = 0 07540402 + IVCORR = 10 07550402 + 0222 FORMAT (70X,10A) 07560402 + READ (I09, 0222) (CATN14(J), J = 21,30) 07570402 + DO 0223 I = 21,30 07580402 + IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07590402 + 0223 CONTINUE 07600402 +40220 IF (IVCOMP - 10) 20220, 10220, 20220 07610402 +30220 IVDELE = IVDELE + 1 07620402 + WRITE (I02,80000) IVTNUM 07630402 + IF (ICZERO) 10220, 0231, 20220 07640402 +10220 IVPASS = IVPASS + 1 07650402 + WRITE (I02,80002) IVTNUM 07660402 + GO TO 0231 07670402 +20220 IVFAIL = IVFAIL + 1 07680402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07690402 + 0231 CONTINUE 07700402 +C 07710402 +C **** FCVS PROGRAM 402 - TEST 023 **** 07720402 +C 07730402 +C 07740402 +C TEST 23 READS AND CHECKS THE CHARACTERS K THROUGH T. 07750402 +C 07760402 +C 07770402 + IVTNUM = 23 07780402 + IF (ICZERO) 30230, 0230, 30230 07790402 + 0230 CONTINUE 07800402 + IVCOMP = 0 07810402 + IVCORR = 10 07820402 + 0232 FORMAT (70X,10A) 07830402 + READ (I09, 0232) (CATN14(J), J = 31,40) 07840402 + DO 0233 I = 31,40 07850402 + IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 07860402 + 0233 CONTINUE 07870402 +40230 IF (IVCOMP - 10) 20230, 10230, 20230 07880402 +30230 IVDELE = IVDELE + 1 07890402 + WRITE (I02,80000) IVTNUM 07900402 + IF (ICZERO) 10230, 0241, 20230 07910402 +10230 IVPASS = IVPASS + 1 07920402 + WRITE (I02,80002) IVTNUM 07930402 + GO TO 0241 07940402 +20230 IVFAIL = IVFAIL + 1 07950402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07960402 + 0241 CONTINUE 07970402 +C 07980402 +C **** FCVS PROGRAM 402 - TEST 024 **** 07990402 +C 08000402 +C 08010402 +C TEST 24 READS AND CHECKS THE CHARACTERS U THROUGH Z. 08020402 +C 08030402 +C 08040402 + IVTNUM = 24 08050402 + IF (ICZERO) 30240, 0240, 30240 08060402 + 0240 CONTINUE 08070402 + IVCOMP = 0 08080402 + IVCORR = 06 08090402 + 0242 FORMAT (74X,6A) 08100402 + READ (I09, 0242) (CATN14(J), J = 41,46) 08110402 + DO 0243 I = 41,46 08120402 + IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 08130402 + 0243 CONTINUE 08140402 +40240 IF (IVCOMP - 6) 20240, 10240, 20240 08150402 +30240 IVDELE = IVDELE + 1 08160402 + WRITE (I02,80000) IVTNUM 08170402 + IF (ICZERO) 10240, 0251, 20240 08180402 +10240 IVPASS = IVPASS + 1 08190402 + WRITE (I02,80002) IVTNUM 08200402 + GO TO 0251 08210402 +20240 IVFAIL = IVFAIL + 1 08220402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08230402 + 0251 CONTINUE 08240402 +C 08250402 +C 08260402 +C TESTS 25 THROUGH 29 READ RECORD NUMBERS 56 THROUGH 60 USING 08270402 +C THE A EDIT DESCRIPTOR WITH THE OPTIONAL FIELD WIDTH SPECIFIED. 08280402 +C EACH FIELD IS 1 CHARACTER IN LENGTH AND IS CHECKED FOR PROPER 08290402 +C EDITING. THE FIELDS ARE WRITTEN AND READ WITH THE SAME EDIT 08300402 +C DESCRIPTOR. THE NUMBER RESULTING FROM EACH TEST IN IVCOMP AND 08310402 +C IVCORR IS THE THE NUMBER OF CORRECT CHARACTERS FOUND AS A RESULT 08320402 +C OF THE READ. 08330402 +C 08340402 +C 08350402 +70020 FORMAT (12X,2I4,59X,A1) 08360402 + REWIND I09 08370402 + DO 4026 I = 1, 150 08380402 + READ (I09, 70020, END = 4027) IRECN, IEOF 08390402 + IF (IRECN .EQ. 55) GO TO 4027 08400402 + 4026 CONTINUE 08410402 + 4027 IF (IRECN - 55) 4028, 4029, 4028 08420402 +C 08430402 +C THE CODE IMMEDIATELY PRECEDING POSITIONS THE FILE TO RECORD 08440402 +C NUMBER 55 FOR TESTS 25 THROUGH 29. 08450402 +C 08460402 +70021 FORMAT ( " THE INITIAL RECORD FOR TESTS 25 THROUGH 29 COULD NOT 08470402 + 1BE FOUND,") 08480402 +70022 FORMAT (" THEREFORE TESTS 25 THROUGH 29 ARE DELETED." ) 08490402 + 4028 WRITE (I02, 70021) 08500402 + WRITE (I02, 70022) 08510402 + GO TO 301 08520402 + 4029 CONTINUE 08530402 + DO 4030 I = 1,46 08540402 + CATN14(I) = ' ' 08550402 + 4030 CONTINUE 08560402 +C 08570402 +C THE ABOVE DO LOOP INITIALIZES THE ARRAY CATN14 TO BLANKS. 08580402 +C 08590402 +C 08600402 +C **** FCVS PROGRAM 402 - TEST 025 **** 08610402 +C 08620402 +C 08630402 +C TEST 25 READS AND CHECKS THE CHARACTERS 0 THROUGH 9. 08640402 +C 08650402 +C 08660402 + IVTNUM = 25 08670402 + IF (ICZERO) 30250, 0250, 30250 08680402 + 0250 CONTINUE 08690402 + IVCOMP = 0 08700402 + IVCORR = 10 08710402 + 0252 FORMAT (70X,10A1) 08720402 + READ (I09, 0252) (CATN14(J), J = 1, 10) 08730402 + DO 0253 I = 1,10 08740402 + IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 08750402 + 0253 CONTINUE 08760402 +40250 IF (IVCOMP - 10) 20250, 10250, 20250 08770402 +30250 IVDELE = IVDELE + 1 08780402 + WRITE (I02,80000) IVTNUM 08790402 + IF (ICZERO) 10250, 0261, 20250 08800402 +10250 IVPASS = IVPASS + 1 08810402 + WRITE (I02,80002) IVTNUM 08820402 + GO TO 0261 08830402 +20250 IVFAIL = IVFAIL + 1 08840402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08850402 + 0261 CONTINUE 08860402 +C 08870402 +C **** FCVS PROGRAM 402 - TEST 026 **** 08880402 +C 08890402 +C 08900402 +C TEST 26 READS AND CHECKS THE CHARACTERS =,+,-,*,/,(,),,,., AND08910402 +C '. 08920402 +C 08930402 +C 08940402 + IVTNUM = 26 08950402 + IF (ICZERO) 30260, 0260, 30260 08960402 + 0260 CONTINUE 08970402 + IVCOMP = 0 08980402 + IVCORR = 10 08990402 + 0262 FORMAT (70X,10A1) 09000402 + READ (I09, 0262) (CATN14(J), J = 11, 20) 09010402 + DO 0263 I = 11,20 09020402 + IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09030402 + 0263 CONTINUE 09040402 +40260 IF (IVCOMP -10) 20260, 10260, 20260 09050402 +30260 IVDELE = IVDELE + 1 09060402 + WRITE (I02,80000) IVTNUM 09070402 + IF (ICZERO) 10260, 0271, 20260 09080402 +10260 IVPASS = IVPASS + 1 09090402 + WRITE (I02,80002) IVTNUM 09100402 + GO TO 0271 09110402 +20260 IVFAIL = IVFAIL + 1 09120402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09130402 + 0271 CONTINUE 09140402 +C 09150402 +C **** FCVS PROGRAM 402 - TEST 027 **** 09160402 +C 09170402 +C 09180402 +C TEST 27 READS AND CHECKS THE CHARACTERS A THROUGH J. 09190402 +C 09200402 +C 09210402 + IVTNUM = 27 09220402 + IF (ICZERO) 30270, 0270, 30270 09230402 + 0270 CONTINUE 09240402 + IVCOMP = 0 09250402 + IVCORR = 10 09260402 + 0272 FORMAT (70X,10A1) 09270402 + READ (I09, 0272) (CATN14(J), J = 21,30) 09280402 + DO 0273 I = 21,30 09290402 + IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09300402 + 0273 CONTINUE 09310402 +40270 IF (IVCOMP - 10) 20270, 10270, 20270 09320402 +30270 IVDELE = IVDELE + 1 09330402 + WRITE (I02,80000) IVTNUM 09340402 + IF (ICZERO) 10270, 0281, 20270 09350402 +10270 IVPASS = IVPASS + 1 09360402 + WRITE (I02,80002) IVTNUM 09370402 + GO TO 0281 09380402 +20270 IVFAIL = IVFAIL + 1 09390402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09400402 + 0281 CONTINUE 09410402 +C 09420402 +C **** FCVS PROGRAM 402 - TEST 028 **** 09430402 +C 09440402 +C 09450402 +C TEST 28 READS AND CHECKS THE CHARACTERS K THROUGH T. 09460402 +C 09470402 +C 09480402 + IVTNUM = 28 09490402 + IF (ICZERO) 30280, 0280, 30280 09500402 + 0280 CONTINUE 09510402 + IVCOMP = 0 09520402 + IVCORR = 10 09530402 + 0282 FORMAT (70X,10A1) 09540402 + READ (I09, 0282) (CATN14(J), J = 31,40) 09550402 + DO 0283 I = 31, 40 09560402 + IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09570402 + 0283 CONTINUE 09580402 +40280 IF (IVCOMP - 10) 20280, 10280, 20280 09590402 +30280 IVDELE = IVDELE + 1 09600402 + WRITE (I02,80000) IVTNUM 09610402 + IF (ICZERO) 10280, 0291, 20280 09620402 +10280 IVPASS = IVPASS + 1 09630402 + WRITE (I02,80002) IVTNUM 09640402 + GO TO 0291 09650402 +20280 IVFAIL = IVFAIL + 1 09660402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09670402 + 0291 CONTINUE 09680402 +C 09690402 +C **** FCVS PROGRAM 402 - TEST 029 **** 09700402 +C 09710402 +C 09720402 +C TEST 29 READS AND CHECKS THE CHARACTERS U THROUGH Z. 09730402 +C 09740402 +C 09750402 + IVTNUM = 29 09760402 + IF (ICZERO) 30290, 0290, 30290 09770402 + 0290 CONTINUE 09780402 + IVCOMP = 0 09790402 + IVCORR = 6 09800402 + 0292 FORMAT (74X,6A1) 09810402 + READ (I09, 0292) (CATN14(J), J = 41,46) 09820402 + DO 0293 I = 41,46 09830402 + IF (CATN14(I) .EQ. CATN11(I)) IVCOMP = IVCOMP + 1 09840402 + 0293 CONTINUE 09850402 +40290 IF (IVCOMP - 6) 20290, 10290, 20290 09860402 +30290 IVDELE = IVDELE + 1 09870402 + WRITE (I02,80000) IVTNUM 09880402 + IF (ICZERO) 10290, 0301, 20290 09890402 +10290 IVPASS = IVPASS + 1 09900402 + WRITE (I02,80002) IVTNUM 09910402 + GO TO 0301 09920402 +20290 IVFAIL = IVFAIL + 1 09930402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09940402 + 0301 CONTINUE 09950402 +C 09960402 +C 09970402 +C TESTS 30 THROUGH 32 READ RECORD NUMBERS 101 THROUGH 103. THESE09980402 +C TESTS TEST FOR PROPER EDITING ON INPUT WHERE THE INPUT FIELD 09990402 +C AND THE INPUT LIST ITEM ARE OF DIFFERENT SIZES. 10000402 +C 10010402 +C 10020402 +70031 FORMAT (12X,2I4,59X,A1) 10030402 + REWIND I09 10040402 + DO 4031 I = 1,150 10050402 + READ (I09, 70031, END = 4032) IRECN, IEOF 10060402 + IF (IRECN .EQ. 100) GO TO 4032 10070402 + 4031 CONTINUE 10080402 + 4032 IF (IRECN - 100) 4033, 4034, 4033 10090402 +70032 FORMAT ( " THE START RECORD FOR TESTS 30 THROUGH 32 COULD NOT 10100402 + 1BE FOUND,") 10110402 +70033 FORMAT (" THEREFORE TESTS 30 THROUGH 32 ARE DELETED." ) 10120402 + 4033 WRITE (I02, 70032) 10130402 + WRITE (I02, 70033) 10140402 + GO TO 331 10150402 + 4034 CONTINUE 10160402 +C 10170402 +C **** FCVS PROGRAM 402 - TEST 030 **** 10180402 +C 10190402 +C 10200402 +C TEST 30 TESTS THE A EDIT DESCRIPTOR WITH THE OPTIONAL REPEAT 10210402 +C SPECIFICATION. THE A EDIT DESCRIPTOR DOES NOT HAVE THE OPTIONAL 10220402 +C FIELD WIDTH SPECIFICATION AND THE INPUT LIST ITEMS VARY IN SIZE 10230402 +C FROM 1 TO 10 CHARACTERS. RECORD NUMBER 101 IS READ AND WAS 10240402 +C CREATED IN TEST 17 WITH THE FORMAT STATEMENT 10250402 +C 10260402 +C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 10270402 +C 1 ) 10280402 +C 10290402 +C 10300402 + IVTNUM = 30 10310402 + IF (ICZERO) 30300, 0300, 30300 10320402 + 0300 CONTINUE 10330402 + IVCOMP = 1 10340402 + IVCORR = 210 10350402 + CATN14(1) = ' ' 10360402 + CVTN13 = ' ' 10370402 + CATN12(3) = ' ' 10380402 + CVTN12 = ' ' 10390402 + 0302 FORMAT (20X,4A,42X,A1) 10400402 + READ (I09, 0302, END = 0303) CATN14(1), CVTN13, CATN12(3), CVTN1210410402 + 0303 IF (CATN14(1) .EQ. 'A') IVCOMP = IVCOMP * 2 10420402 + IF (CVTN13 .EQ. 'BC') IVCOMP = IVCOMP * 3 10430402 + IF (CATN12(3) .EQ. 'DEFGH') IVCOMP = IVCOMP * 5 10440402 + IF (CVTN12 .EQ. 'IJKLMNOPQR') IVCOMP = IVCOMP * 7 10450402 +40300 IF (IVCOMP - 210) 20300, 10300, 20300 10460402 +30300 IVDELE = IVDELE + 1 10470402 + WRITE (I02,80000) IVTNUM 10480402 + IF (ICZERO) 10300, 0311, 20300 10490402 +10300 IVPASS = IVPASS + 1 10500402 + WRITE (I02,80002) IVTNUM 10510402 + GO TO 0311 10520402 +20300 IVFAIL = IVFAIL + 1 10530402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10540402 + 0311 CONTINUE 10550402 +C 10560402 +C **** FCVS PROGRAM 402 - TEST 031 **** 10570402 +C 10580402 +C 10590402 +C TEST 31 TESTS FOR PROPER EDITING OF THE A EDIT DESCRIPTOR WHEN10600402 +C THE SPECIFIED WIDTH OF THE DESCRIPTOR IS LESS THAN THE INTERNAL 10610402 +C REPRESENTATION OF THE INPUT LIST ITEM. THE CHARACTERS SHOULD 10620402 +C APPEAR LEFT-JUSTIFIED WITH TRAILING BLANKS IN THE INTERNAL 10630402 +C REPRESENTATION. RECORD NUMBER 102 IS READ AND WAS CREATED 10640402 +C IN TEST 17 WITH THE FORMAT STATEMENT 10650402 +C 10660402 +C FORMAT (I3,I2,I4,I3,2I4,60H=+-*/(),'.ABMYZ01589=+-()A5+Z.1'A,4 10670402 +C 1 ) 10680402 +C 10690402 +C 10700402 +C 10710402 + IVTNUM = 31 10720402 + IF (ICZERO) 30310, 0310, 30310 10730402 + 0310 CONTINUE 10740402 + CVTN12 = '9999999999' 10750402 + IVCOMP = 0 10760402 + IVCORR = 1 10770402 + 0312 FORMAT (20X,10X,A5,40X) 10780402 + READ (I09, 0312, END = 0313) CVTN12 10790402 + 0313 IF (CVTN12 .EQ. 'ABMYZ ') IVCOMP = 1 10800402 +40310 IF (IVCOMP - 1) 20310, 10310, 20310 10810402 +30310 IVDELE = IVDELE + 1 10820402 + WRITE (I02,80000) IVTNUM 10830402 + IF (ICZERO) 10310, 0321, 20310 10840402 +10310 IVPASS = IVPASS + 1 10850402 + WRITE (I02,80002) IVTNUM 10860402 + GO TO 0321 10870402 +20310 IVFAIL = IVFAIL + 1 10880402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10890402 + 0321 CONTINUE 10900402 +C 10910402 +C **** FCVS PROGRAM 402 - TEST 032 **** 10920402 +C 10930402 +C 10940402 +C TEST 32 TESTS FOR PROPER EDITING OF THE A EDIT 10950402 +C DESCRIPTOR WHEN THE WIDTH OF THE DESCRIPTOR IS GREATER THAN THE 10960402 +C INTERNAL REPRESENTATION OF THE INPUT LIST ITEM. THE RIGHTMOST 10970402 +C CHARACTERS SHOULD BE TAKEN FROM THE INPUT FIELD. RECORD NUMBER 10980402 +C 103 IS EXPECTED TO BE READ. THE RECORD WAS CREATED IN TEST 17 10990402 +C WITH THE FORMAT STATEMENT 11000402 +C 11010402 +C FORMAT (I3,I2,I4,I3,2I4,60HABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789 11020402 +C 1 ) 11030402 +C 11040402 +C 11050402 +C 11060402 + IVTNUM = 32 11070402 + IF (ICZERO) 30320, 0320, 30320 11080402 + 0320 CONTINUE 11090402 + CATN12 (5) = 'AAAAA' 11100402 + IVCOMP = 0 11110402 + IVCORR = 1 11120402 + 0322 FORMAT (20X,10X,A10,35X) 11130402 + READ (I09, 0322, END = 0323) CATN12 (5) 11140402 + 0323 IF (CATN12(5) .EQ. 'PQRST') IVCOMP = 1 11150402 +40320 IF (IVCOMP - 1) 20320, 10320, 20320 11160402 +30320 IVDELE = IVDELE + 1 11170402 + WRITE (I02,80000) IVTNUM 11180402 + IF (ICZERO) 10320, 0331, 20320 11190402 +10320 IVPASS = IVPASS + 1 11200402 + WRITE (I02,80002) IVTNUM 11210402 + GO TO 0331 11220402 +20320 IVFAIL = IVFAIL + 1 11230402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11240402 + 0331 CONTINUE 11250402 +C 11260402 +C 11270402 +C TESTS 33 AND 34 READ A LONG INPUT FIELD (50 CHARACTERS) AND 11280402 +C CHECK RESULTING INTERNAL REPRESENTATION. THE RECORD IS READ 11290402 +C WITH THE SAME A EDIT DESCRIPTOR AS WAS USED TO WRITE THE RECORD. 11300402 +C 11310402 +C 11320402 +70034 FORMAT (12X,2I4,60X) 11330402 + REWIND I09 11340402 + DO 4035 I = 1,150 11350402 + READ (I09, 70034, END = 4036) IRECN, IEOF 11360402 + IF (IRECN .EQ. 140) GO TO 4036 11370402 + 4035 CONTINUE 11380402 + 4036 IF (IRECN - 140) 4037, 4038, 4037 11390402 +C THE ABOVE CODE POSITIONS THE FILE TO RECORD NUMBER 140 FOR 11400402 +C TESTS 33 AND 34. 11410402 +C 11420402 +70035 FORMAT ( " THE START RECORD FOR TESTS 33 AND 34 COULD NOT BE 11430402 + 1FOUND,") 11440402 +70036 FORMAT (" THEREFORE TESTS 33 AND 34 ARE DELETED." ) 11450402 + 4037 WRITE (I02, 70035) 11460402 + WRITE (I02, 70036) 11470402 + GO TO 351 11480402 + 4038 CONTINUE 11490402 +C 11500402 +C **** FCVS PROGRAM 402 - TEST 033 **** 11510402 +C 11520402 +C 11530402 +C TEST 33 READS A LONG FIELD WITH THE WIDTH SPECIFIED ON THE A 11540402 +C EDIT DESCRIPTOR. RECORD NUMBER 141 IS READ. THE RECORD WAS 11550402 +C CREATED IN TEST 18 AND CONTAINS FIELD DATA OF 11560402 +C 11570402 +C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789' 11580402 +C 11590402 +C WITHOUT THE SURROUNDING APOSTROPHES. 11600402 +C 11610402 +C 11620402 +C 11630402 + IVTNUM = 33 11640402 + IF (ICZERO) 30330, 0330, 30330 11650402 + 0330 CONTINUE 11660402 + CVTN15 = ' ' 11670402 + IVCOMP = 0 11680402 + IVCORR = 1 11690402 + 0332 FORMAT (20X,10X,A50) 11700402 + READ (I09, 0332) CVTN15 11710402 + IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 01234567811720402 + 19') IVCOMP = 1 11730402 +40330 IF (IVCOMP -1 ) 20330, 10330, 20330 11740402 +30330 IVDELE = IVDELE + 1 11750402 + WRITE (I02,80000) IVTNUM 11760402 + IF (ICZERO) 10330, 0341, 20330 11770402 +10330 IVPASS = IVPASS + 1 11780402 + WRITE (I02,80002) IVTNUM 11790402 + GO TO 0341 11800402 +20330 IVFAIL = IVFAIL + 1 11810402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11820402 + 0341 CONTINUE 11830402 +C 11840402 +C **** FCVS PROGRAM 402 - TEST 034 **** 11850402 +C 11860402 +C 11870402 +C TEST 34 READS A LONG FIELD USING THE A EDIT DESCRIPTOR 11880402 +C WITHOUT THE OPTIONAL WIDTH SPECIFIED. RECORD NUMBER 142 IS READ. 11890402 +C THE RECORD WAS CREATED IN TEST 19 AND CONTAINS THE FIELD DATA 11900402 +C 11910402 +C 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 0123456789' 11920402 +C 11930402 +C WITHOUT THE SURROUNDING APOSTROPHES. 11940402 +C 11950402 +C 11960402 + IVTNUM = 34 11970402 + IF (ICZERO) 30340, 0340, 30340 11980402 + 0340 CONTINUE 11990402 + CVTN15 = ' ' 12000402 + IVCOMP = 0 12010402 + IVCORR = 1 12020402 + 0342 FORMAT (20X,10X,A) 12030402 + READ (I09, 0342) CVTN15 12040402 + IF (CVTN15 .EQ. 'ABCDEFG HIJKLMN OPQRSTUVWXYZ 01234567812050402 + 19') IVCOMP = 1 12060402 +40340 IF (IVCOMP - 1) 20340, 10340, 20340 12070402 +30340 IVDELE = IVDELE + 1 12080402 + WRITE (I02,80000) IVTNUM 12090402 + IF (ICZERO) 10340, 0351, 20340 12100402 +10340 IVPASS = IVPASS + 1 12110402 + WRITE (I02,80002) IVTNUM 12120402 + GO TO 0351 12130402 +20340 IVFAIL = IVFAIL + 1 12140402 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12150402 + 0351 CONTINUE 12160402 +C 12170402 +C 12180402 +C 12190402 +C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES 12200402 +C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION 12210402 +C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. 12220402 +C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED12230402 +C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS 12240402 +C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL 12250402 +C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP 12260402 +C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST 12270402 +C REPORT AND BEFORE THE TEST REPORT SUMMARY. 12280402 +C 12290402 +CDB** BEGIN FILE DUMP CODE 12300402 +C REWIND I09 12310402 +C IRNUM = 1 12320402 +C IRLGN = 80 12330402 +C ILUN = I09 12340402 +C7701 FORMAT (I3,I2,I4,I3,2I4,60A1) 12350402 +C7702 FORMAT (" ",I3,I2,I4,I3,2I4,60A1) 12360402 +C7703 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - OK" ) 12370402 +C7704 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - THERE SHOULD BE " , 12380402 +C 1I3,9H RECORDS.) 12390402 +C DO 7771 IRNUM = 1, ITOTR 12400402 +C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12410402 +C 1 (IDUMP(ICH), ICH = 1,60) 12420402 +C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12430402 +C 1 (IDUMP(ICH), ICH = 1,60) 12440402 +C IF (IEOF .EQ. 9999) GO TO 7772 12450402 +C7771 CONTINUE 12460402 +C GO TO 7775 12470402 +C7772 IF (IRNUM - ITOTR) 7774, 7773, 7775 12480402 +C7773 WRITE (I02, 7703) ILUN, IRNUM 12490402 +C GO TO 7779 12500402 +C7774 WRITE (I02, 7704) ILUN, IRNUM, ITOTR 12510402 +C GO TO 7779 12520402 +C7775 DO 7776 I = 1,20 12530402 +C READ (ILUN, 7701) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12540402 +C 1 (IDUMP(ICH), ICH = 1,60) 12550402 +C WRITE (I02, 7702) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12560402 +C 1 (IDUMP(ICH), ICH = 1,60) 12570402 +C IRNUM = IRNUM + 1 12580402 +C IF (IEOF .EQ. 9999) GO TO 7777 12590402 +C7776 CONTINUE 12600402 +C7777 WRITE (I02, 7704) ILUN, IRNUM, ITOTR 12610402 +C7779 CONTINUE 12620402 +CDE** END OF DUMP CODE 12630402 +C 12640402 +C THERE SHOULD BE 34 TESTS IN THIS ROUTINE 12650402 +C 12660402 +C 12670402 +C 12680402 +C 12690402 +C WRITE OUT TEST SUMMARY 12700402 +C 12710402 + WRITE (I02,90004) 12720402 + WRITE (I02,90014) 12730402 + WRITE (I02,90004) 12740402 + WRITE (I02,90000) 12750402 + WRITE (I02,90004) 12760402 + WRITE (I02,90020) IVFAIL 12770402 + WRITE (I02,90022) IVPASS 12780402 + WRITE (I02,90024) IVDELE 12790402 + STOP 12800402 +90001 FORMAT (" ",24X,"FM402") 12810402 +90000 FORMAT (" ",20X,"END OF PROGRAM FM402" ) 12820402 +C 12830402 +C FORMATS FOR TEST DETAIL LINES 12840402 +C 12850402 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 12860402 +80002 FORMAT (" ",4X,I5,7X,"PASS") 12870402 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 12880402 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 12890402 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 12900402 +C 12910402 +C FORMAT STATEMENTS FOR PAGE HEADERS 12920402 +C 12930402 +90002 FORMAT ("1") 12940402 +90004 FORMAT (" ") 12950402 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 12960402 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 12970402 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 12980402 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 12990402 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 13000402 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 13010402 +C 13020402 +C FORMAT STATEMENTS FOR RUN SUMMARY 13030402 +C 13040402 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 13050402 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 13060402 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 13070402 + END 13080402 diff --git a/Fortran/UnitTests/fcvs21_f95/FM402.reference_output b/Fortran/UnitTests/fcvs21_f95/FM402.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM402.reference_output @@ -0,0 +1,67 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM402 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + TESTS 001 THROUGH 014 MUST BE VISUALLY VERIFIED. + IMMEDIATELY FOLLOWING THIS NARRATIVE IS A REFERENCE LINE + OF THE FORM '123456 ...'. THE REFERENCE LINE IS TO + AID IN THE VISUAL VERIFICATION OF THE TESTS. FOR + THE OUTPUT TO BE CORRECT THE DATA VALUES DISPLAYED + IN THE COMPUTED COLUMN MUST MATCH THAT IN THE CORRECT + COLUMN IN BOTH VALUE AND CHARACTER POSITION. + + REFERENCE LINE - 1234567890 1234567890 + 1 A A + 2 Z Z + 3 / / + 4 9 9 + 5 ' ' + 6 ABMYZ ABMYZ + 7 01589 01589 + 8 =+-() =+-() + 9 A5+.Z A5+.Z + 10 1'A,4 1'A,4 + 11 059=+PQUVY 059=+PQUVY + 12 *(12ABYZ)* *(12ABYZ)* + 13 ABMYZ ABMYZ + 14 12345 12345 + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + + FILE I09 HAS BEEN CREATED AND CONTAINS 143 RECORDS + + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + + ---------------------------------------------- + + END OF PROGRAM FM402 + + 0 TESTS FAILED + 20 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM403.f b/Fortran/UnitTests/fcvs21_f95/FM403.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM403.f @@ -0,0 +1,1032 @@ + PROGRAM FM403 + +C***********************************************************************00010403 +C***** FORTRAN 77 00020403 +C***** FM403 FMTRW - (020) 00030403 +C***** 00040403 +C***********************************************************************00050403 +C***** GENERAL PURPOSE SUBSET REFS00060403 +C***** TO TEST SIMPLE FORMAT AND FORMATTED DATA 12.9.5.200070403 +C***** TRANSFER STATEMENTS IN EXTERNAL SEQUENTIAL I/O SO 13.1.1 00080403 +C***** THAT THESE FEATURES MAY BE USED IN OTHER TEST 12.8.1 00090403 +C***** PROGRAM SEGMENTS FOR INTEGER, REAL, AND LOGICAL 00100403 +C***** DATA TYPES. 00110403 +C***** RESTRICTIONS OBSERVED 12.8.2 00120403 +C***** * ALL FORMAT STATEMENTS ARE LABELED 13.1.1 00130403 +C***** * H DESCRIPTOR ARE NEVER REPEATED 13.2.1 00140403 +C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND 00150403 +C***** W IS EQUAL TO OR GREATER THAN D 00160403 +C***** * FIELD WIDTH IS NEVER ZERO 13.2.1 00170403 +C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE LIST ITEM 13.3 00180403 +C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST 00190403 +C***** IN THE FORMAT SPECIFICATION 00200403 +C***** * ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS 13.3 00210403 +C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 13.5.9 00220403 +C***** * FIELD WIDTH NEVER EXCEEDED BY OUTPUT 13.5.9 00230403 +C***** * FOR I EDITING, EXTERNAL INPUT FIELDS ARE 13.5.9.100240403 +C***** INTEGER CONSTANTS 00250403 +C***** GENERAL COMMENTS 00260403 +C***** PLUS SIGNS FOR INPUT FIELDS ARE USUALLY OMITTED 13.5.9 00270403 +C***** FORMATTED WRITES WITHOUT AN I/O LIST (FORMAT 13.5.2 00280403 +C***** STATEMENTS TEST H AND X DESCRIPTORS AND SLASH 13.5.3 00290403 +C***** RECORD DIVIDERS) 13.5.4 00300403 +C***** 00310403 +CBB** ********************** BBCCOMNT **********************************00320403 +C**** 00330403 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00340403 +C**** VERSION 2.1 00350403 +C**** 00360403 +C**** 00370403 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00380403 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00390403 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00400403 +C**** BUILDING 225 RM A266 00410403 +C**** GAITHERSBURG, MD 20899 00420403 +C**** 00430403 +C**** 00440403 +C**** 00450403 +CBE** ********************** BBCCOMNT **********************************00460403 +C INPUT DATA TO THIS SEGMENT CONSISTS OF 27 CARD IMAGES IN COL. 1 - 80 00470403 +COL. 1----------------------------------------------------------61 00480403 +CARD 1 999 00490403 +CARD 2 555554444 00500403 +CARD 3 666 777777 8 00510403 +CARD 4 333333111112222222255555444444444444 00520403 +CARD 5 7.7123456.7 00530403 +CARD 6 8.889.9997.123456 00540403 +CARD 7 5.44446.5555533.133.133.133.1444.1 00550403 +CARD 8 5555.15555.1 66666.166666.1 44.22 00560403 +CARD 9 2.12.12.12.12.1666.3334.3334.3334.333 00570403 +CARD 10 -0.1E+01+0.22E-01 0.333E+02 0.4444E+03-0.55555E-03+0.666666E+ 00580403 +COL. 62------------77 00590403 +CARD 10 00+0.9876543E+12 00600403 +COL. 1----------------------------------------------------------61 00610403 +CARD 11 TABC 00620403 +CARD 12 FDEFFGHIT*+T1F/).TRUE..FALSE. 00630403 +CARD 13 -9.9-9.9-9.9-9.9 00640403 +CARD 14 9999999999 00650403 +CARD 15 .9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9 00660403 +CARD 16 TFTFTFTFTF 00670403 +CARD 17 99999999 00680403 +CARD 18 9999999999999999TFFT9.99.99.99.99.9 00690403 +CARD 19 T F T F 00700403 +CARD 20 3334444.555550 00710403 +CARD 21 9876.5498.7654E2 9876.54 987.654 86.4786E286.4786 00720403 +CARD 22 9.8765698.7654E2 9876.54 987.654 86.4786E286.4786 00730403 +CARD 23 122333544888611222 00740403 +CARD 24 455666233444966111 00750403 +CARD 25 788999377555899777 00760403 +CARD 26 11112 334 559 880 11 00770403 +CARD 27 6 778 995 441 222 00 00780403 +C***** 00790403 +C***** S P E C I F I C A T I O N S SEGMENT 020 00800403 +C***** 00810403 + DIMENSION EP1S(33),CMA1S(5),IAC1I(5),IAC2I(2,7),MCA1I(5) 00820403 + REAL A1S(5),A2S(2,2),A3S(3,3,3),AC1S(25),AC2S(5,6) 00830403 + INTEGER I2I(2,2),I3I(2,2,2),MCA3I(2,3,3) 00840403 + LOGICAL MCA1B(7),A1B(2),A2B(2,2),A3B(2,2,2),AVB,CVB,DVB ,MCBVB 00850403 +C***** 00860403 +CBB** ********************** BBCINITA **********************************00870403 +C**** SPECIFICATION STATEMENTS 00880403 +C**** 00890403 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00900403 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00910403 +CBE** ********************** BBCINITA **********************************00920403 +CBB** ********************** BBCINITB **********************************00930403 +C**** INITIALIZE SECTION 00940403 + DATA ZVERS, ZVERSD, ZDATE 00950403 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00960403 + DATA ZCOMPL, ZNAME, ZTAPE 00970403 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00980403 + DATA ZPROJ, ZTAPED, ZPROG 00990403 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 01000403 + DATA REMRKS /' '/ 01010403 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 01020403 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 01030403 +C**** 01040403 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 01050403 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 01060403 +CZ03 ZPROG = 'PROGRAM NAME' 01070403 +CZ04 ZDATE = 'DATE OF TEST' 01080403 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 01090403 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 01100403 +CZ07 ZNAME = 'NAME OF USER' 01110403 +CZ08 ZTAPE = 'TAPE OWNER/ID' 01120403 +CZ09 ZTAPED = 'DATE TAPE COPIED' 01130403 +C 01140403 + IVPASS = 0 01150403 + IVFAIL = 0 01160403 + IVDELE = 0 01170403 + IVINSP = 0 01180403 + IVTOTL = 0 01190403 + IVTOTN = 0 01200403 + ICZERO = 0 01210403 +C 01220403 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01230403 + I01 = 05 01240403 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01250403 + I02 = 06 01260403 +C 01270403 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01280403 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01290403 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01300403 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01310403 +C 01320403 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01330403 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01340403 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01350403 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01360403 +C 01370403 +CBE** ********************** BBCINITB **********************************01380403 +C***** I N P U T - O U T P U T ASSIGNMENT STATEMENTS 01390403 + IRVI = I01 01400403 + NUVI = I02 01410403 + IVTOTL = 59 01420403 + ZPROG = 'FM403' 01430403 +CBB** ********************** BBCHED0A **********************************01440403 +C**** 01450403 +C**** WRITE REPORT TITLE 01460403 +C**** 01470403 + WRITE (I02, 90002) 01480403 + WRITE (I02, 90006) 01490403 + WRITE (I02, 90007) 01500403 + WRITE (I02, 90008) ZVERS, ZVERSD 01510403 + WRITE (I02, 90009) ZPROG, ZPROG 01520403 + WRITE (I02, 90010) ZDATE, ZCOMPL 01530403 +CBE** ********************** BBCHED0A **********************************01540403 +C***** HEADER FORMAT STATEMENT 01550403 +2000 FORMAT ( // 2X,"FMTRW - (020) FORMATTED DATA TRANSFER" //2X, 01560403 + 1"SUBSET REFS - 12.9.5.2 13.3 13.5.9 " ) 01570403 + WRITE (NUVI,2000) 01580403 +CBB** ********************** BBCHED0B **********************************01590403 +C**** WRITE DETAIL REPORT HEADERS 01600403 +C**** 01610403 + WRITE (I02,90004) 01620403 + WRITE (I02,90004) 01630403 + WRITE (I02,90013) 01640403 + WRITE (I02,90014) 01650403 + WRITE (I02,90015) IVTOTL 01660403 +CBE** ********************** BBCHED0B **********************************01670403 +CT001* TEST 1 - FORMAT WITH DIGITS 0-9 IN H FIELDS 01680403 + IVTNUM = 1 01690403 + REMRKS = '2 COMPUTED LINES EXPECTED' 01700403 + WRITE (I02,80004) IVTNUM, REMRKS 01710403 + WRITE (I02,80020) 01720403 + WRITE (I02,70010) 01730403 +70010 FORMAT (25X," 10101010101010101010" ,"999999999","88888888"/27X, 01740403 + 1"7777777","666666","55555","4444","333","22","1") 01750403 + IVINSP = IVINSP + 1 01760403 + WRITE (I02,70011) 01770403 +70011 FORMAT(" ",16X,"CORRECT: " ,22X,"CORRESPONDING LINE MUST MATCH" )01780403 + WRITE (I02,70012) 01790403 +70012 FORMAT (25X,' 1010101010101010101099999999988888888', 01800403 + 1 /25X,' 7777777666666555554444333221 ') 01810403 +CT002* TEST 2 - FORMAT CONTAINING ALL LETTERS (A-Z) IN H FIELDS AND 01820403 +C***** A VARIABLE NUMBER OF BLANKS IN H AND X FIELDS 01830403 + IVTNUM = 2 01840403 + REMRKS = '9 COMPUTED LINES EXPECTED' 01850403 + WRITE (I02,80004) IVTNUM, REMRKS 01860403 + WRITE (I02,80020) 01870403 + WRITE (I02,70020) 01880403 +70020 FORMAT(27X,"AAA",5X," ","BBB",10X,"CCC"/28X,"DDD",9X,"EEE" 01890403 + 1," ","FFF"/29X,"GGG",8X,"HHH"," ","III"/27X," " 01900403 + 2,"JJJ"," ","KKK",7X,"LLL"/31X,"MMM",6X,"NNN"," ","OOO"/01910403 + 3 32X,"PPP"," ","QQQ",5X,"RRR"/33X,"SSS",4X,"TTT"," ","UUU"/01920403 + 4 27X, 01930403 + 5 " VVV ","WWW",3X,"XXX"/37X,"YYY",3X,"ZZZ") 01940403 + IVINSP = IVINSP + 1 01950403 + WRITE (I02,70011) 01960403 + WRITE (I02,70021) 01970403 +70021 FORMAT (27X,'AAA BBB CCC', 01980403 + 1 /27X,' DDD EEE FFF ', 01990403 + 2 /27X,' GGG HHH III ', 02000403 + 3 /27X,' JJJ KKK LLL ', 02010403 + 4 /27X,' MMM NNN OOO ', 02020403 + 5 /27X,' PPP QQQ RRR ', 02030403 + 6 /27X,' SSS TTT UUU ', 02040403 + 7 /27X,' VVV WWW XXX ', 02050403 + 8 /27X,' YYY ZZZ ') 02060403 +CT003* TEST 3 - FORMAT CONTAINING H FIELD WITH ALL POSSIBLE 02070403 +C***** SPECIAL CHARACTERS 02080403 + IVTNUM = 3 02090403 + WRITE (I02,80004) IVTNUM 02100403 + WRITE (I02,80020) 02110403 + WRITE (I02,70030) 02120403 +70030 FORMAT (25X," = + - * / ( ) , . '" ) 02130403 + IVINSP = IVINSP + 1 02140403 + WRITE (I02,80022) 02150403 + WRITE (I02,70031) 02160403 +70031 FORMAT (25X, ' = + - * / ( ) , . ''') 02170403 +C***** FORMAT TO TEST VERTICAL SPACING 02180403 +C***** 12.9.5.2.3 02190403 +CT004* TEST 4 - FORMAT STATEMENT ENDING WITH ONE SLASH DESCRIPTOR 02200403 + IVTNUM = 4 02210403 + REMRKS = 'SLASH DESCRIPTOR' 02220403 + WRITE (I02,80004) IVTNUM, REMRKS 02230403 + WRITE (I02,70040) 02240403 +70040 FORMAT(15X, " FORMAT( ' SKIP 1 LINE'02250403 + 1 /)" /) 02260403 + IVINSP = IVINSP + 1 02270403 + WRITE (I02,70041) 02280403 +70041 FORMAT(17X,"ONE BLANK LINE SHOULD APPEAR ABOVE" ) 02290403 +C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS 02300403 + WRITE (I02,90002) 02310403 + WRITE (I02,90013) 02320403 + WRITE (I02,90014) 02330403 +CT005* TEST 5 - FORMAT STATEMENT ENDING WITH TWO SLASH DESCRIPTORS 02340403 + IVTNUM = 5 02350403 + WRITE (I02,80004) IVTNUM 02360403 + WRITE (I02,70050) 02370403 +70050 FORMAT(15X," FORMAT(' SKIP 2 LINES' //)" //) 02380403 + IVINSP = IVINSP + 1 02390403 + WRITE (I02,70051) 02400403 +70051 FORMAT(17X,"TWO BLANK LINES SHOULD APPEAR ABOVE" ) 02410403 +CT006* TEST 6 - FORMAT STATEMENT ENDING WITH THREE SLASH DESCRIPTORS 02420403 + IVTNUM = 6 02430403 + WRITE (I02,80004) IVTNUM 02440403 + WRITE (I02,70060) 02450403 +70060 FORMAT(15X," FORMAT(' SKIP 3 LINES ' ///)" ///) 02460403 + IVINSP = IVINSP + 1 02470403 + WRITE (I02,70061) 02480403 +70061 FORMAT(17X,"THREE BLANK LINES SHOULD APPEAR ABOVE" ) 02490403 +CT007* TEST 7 - FORMAT STATEMENT CONTAINING IMBEDDED SLASH DESCRIPTORS 02500403 + IVTNUM = 7 02510403 + REMRKS = 'IMBEDDED SLASHES' 02520403 + WRITE (I02,80004) IVTNUM, REMRKS 02530403 + WRITE (I02,70070) 02540403 +70070 FORMAT( 17X,"1 BLANK LINE SHOULD APPEAR BELOW" // 02550403 + 1 17X,"2 BLANK LINES SHOULD APPEAR BELOW" /// 02560403 + 2 17X,"3 BLANK LINES SHOULD APPEAR BELOW" / 3(/), 02570403 + 3 17X,"0 BLANK LINES SHOULD APPEAR BELOW" / 02580403 + 4 17X,"END IMBEDDED SLASHES TEST " ) 02590403 + IVINSP = IVINSP + 1 02600403 +CT008* TEST 8 - FORMS CONTROL USING '0' FOR DOUBLE SPACING 02610403 + IVTNUM = 8 02620403 + REMRKS = 'DOUBLE SPACE' 02630403 + WRITE (I02,80004) IVTNUM, REMRKS 02640403 + WRITE (I02,70080) 02650403 +70080 FORMAT( 17X,"1 BLANK LINE SHOULD APPEAR BELOW " / "0", 02660403 + 1 17X,"END DOUBLE SPACE TEST " ) 02670403 + IVINSP = IVINSP + 1 02680403 +CT009* TEST 9 - FORMS CONTROL USING '+' FOR OVERPRINTING 02690403 + IVTNUM = 9 02700403 + REMRKS = 'OVERPRINT' 02710403 + WRITE (I02,80004) IVTNUM, REMRKS 02720403 + WRITE (I02,70090) 02730403 +70090 FORMAT(/17X,"!FIRST PRINT LINE! OVER" ,/"+", 02740403 + 1 17X," P R I N T !SECOND PRINT LINE!" )02750403 + IVINSP = IVINSP + 1 02760403 +CT010* TEST 10 - FORMS CONTROL USING '1' FOR PAGE EJECTION 02770403 + IVTNUM = 10 02780403 + REMRKS = 'PAGE ADVANCE' 02790403 + WRITE (I02,80004) IVTNUM, REMRKS 02800403 + WRITE (I02,70100) 02810403 +70100 FORMAT(/17X,"THIS SHOULD BE THE LAST LINE ON THIS PAGE" /, 02820403 + 1"1 NEW PAGE: END OF VERTICAL SPACING TESTS" ) 02830403 + IVINSP = IVINSP + 1 02840403 +C WRITE PAGE HEADERS 02850403 + WRITE (I02,90004) 02860403 + WRITE (I02,90013) 02870403 + WRITE (I02,90014) 02880403 +C***** FORMATTED DATA TRANSFER I/O STATEMENTS WITH INTEGER 12.8.1 02890403 +C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST. (THE 12.8.2 02900403 +C***** NUMBER OF ITEMS IN THE LIST IS VARIABLE.) SOME 13.2.1 02910403 +C***** FORMAT STATEMENTS CONTAIN REPEATED FIELDS. 02920403 +C***** FORMATS CONTAIN I EDIT DESCRIPTORS. 13.5.9.1 02930403 +C***** FIELD WIDTHS ARE FROM 1 TO 5 DIGITS. 13.3 02940403 +C***** INPUT CARD 1 02950403 +2009 FORMAT (2X,I3) 02960403 + READ (IRVI,2009) JACVI 02970403 +C***** INPUT CARD 2 02980403 +2010 FORMAT (1X,I5,1X,I4) 02990403 + READ (IRVI,2010) KBCVI, IAC1I(1) 03000403 +C***** INPUT CARD 3 03010403 +2011 FORMAT (2X,I3,2X,3I2,2X,I1) 03020403 + READ (IRVI,2011) IAC2I(1,2), LCCVI, IAC1I(5), IHDVI, MCA3I(1,2,3) 03030403 +C***** INPUT CARD 4 03040403 +2012 FORMAT (2X,2(I3),1(I5), 4I2 ,5I1,3 I4 ) 03050403 + READ (IRVI,2012) MDCVI, IAC2I(2,2), IAC1I(4), NECVI, IAC1I(3), 03060403 + 1 IAC2I(2,3), IAC2I(2,1), MRRVI, IGDVI, KGVI, IEDVI, IAC2I(1,1)03070403 + 2 ,IAC1I(2), IAC2I(2,7), MCA3I(2,1,3) 03080403 +CT011* TEST 11 - I CONVERSION 03090403 + IVTNUM = 11 03100403 + WRITE (I02,80004) IVTNUM 03110403 + WRITE (I02,80020) 03120403 + WRITE (I02,70110) JACVI 03130403 +70110 FORMAT (25X,I5) 03140403 + IVINSP = IVINSP + 1 03150403 + WRITE (I02,80022) 03160403 + WRITE (I02,70111) 03170403 +70111 FORMAT (25X," 999") 03180403 +CT012* TEST 12 - I CONVERSION 03190403 + IVTNUM = 12 03200403 + WRITE (I02,80004) IVTNUM 03210403 + WRITE (I02,80020) 03220403 + WRITE (I02,70120) KBCVI, IAC1I(1) 03230403 +70120 FORMAT (26X,I5,1X,I4) 03240403 + IVINSP = IVINSP + 1 03250403 + WRITE (I02,80022) 03260403 + WRITE (I02,70121) 03270403 +70121 FORMAT (26X," 5555 4444" ) 03280403 +CT013* TEST 13 - I CONVERSION 03290403 + IVTNUM = 13 03300403 + WRITE (I02,80004) IVTNUM 03310403 + WRITE (I02,80020) 03320403 + WRITE (I02,70130) IAC2I(1,2),LCCVI, IAC1I(5), IHDVI, MCA3I(1,2,3) 03330403 +70130 FORMAT (27X,I3,2X,3I2,2X,I1) 03340403 + IVINSP = IVINSP + 1 03350403 + WRITE (I02,80022) 03360403 + WRITE (I02,70131) 03370403 +70131 FORMAT (27X,"666 777777 8" ) 03380403 +CT014* TEST 14 - I CONVERSION 03390403 + IVTNUM = 14 03400403 + WRITE (I02,80004) IVTNUM 03410403 + WRITE (I02,80020) 03420403 + WRITE (I02,70140) 03430403 + WRITE (I02,70140) MDCVI, IAC2I(2,2), IAC1I(4), NECVI, IAC1I(3), 03440403 + 1 IAC2I(2,3), IAC2I(2,1), MRRVI, IGDVI, KGVI, IEDVI, IAC2I(1,1)03450403 + 2 ,IAC1I(2), IAC2I(2,7), MCA3I(2,1,3) 03460403 +70140 FORMAT (27X,2(I3),1(I5), 4I2 ,5I1,3 I4 ) 03470403 + IVINSP = IVINSP + 1 03480403 + WRITE (I02,80022) 03490403 + WRITE (I02,70141) 03500403 +70141 FORMAT (27X,"333333111112222222255555444444444444" ) 03510403 +C***** FORMATTED DATA TRANSFER I/O STATEMENTS WITH REAL 12.8.1 03520403 +C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST.(THE 12.8.2 03530403 +C***** NUMBER OF ITEMS IN THE LIST IS VARIABLE.) ONLY F 13.5.9.2 03540403 +C***** EDIT DESCRIPTORS ARE USED IN THE FORMAT 13.5.9.2.1 03550403 +C***** STATEMENTS. SOME F EDIT DESCRIPTORS ARE REPEATED. 13.3 03560403 +C***** FIELD WIDTH ALWAYS CONTAINS 1 POSITION FOR DECIMAL PT. 03570403 +C***** FIELD WIDTH IS FROM 1 TO 7 DIGITS. PLACEMENT OF 03580403 +C***** DECIMAL POINT IS VARIABLE. SOME F FIELDS ARE 03590403 +C***** REPEATED 03600403 +C***** INPUT CARD 5 03610403 +2018 FORMAT (2X,F3.1,F8.1) 03620403 + READ (IRVI,2018) ACVS, CMAVS 03630403 +C***** INPUT CARD 6 03640403 +2019 FORMAT(2X,F4.2,F5.3,F8.6) 03650403 + READ (IRVI,2019) A1S(2), BCVS, CMBVS 03660403 +C***** INPUT CARD 7 03670403 +2020 FORMAT (2X,F6.4,F7.5,4F4.1,F5.1) 03680403 + READ (IRVI,2020) HHCVS, CMCVS, GGCVS, FFCVS, A1S(1), AC1S(25), 03690403 + 1 AC2S(4,1) 03700403 +C***** INPUT CARD 8 03710403 +2021 FORMAT (2X,2(F6.1),2X,2F7.1 ,2X,F5.2) 03720403 + READ (IRVI,2021) AC1S(18), AC1S(7), AC2S(4,4) , AC1S(8), AC1S(10) 03730403 +C***** INPUT CARD 9 03740403 +2022 FORMAT (2X,5(F3.1),F7.3,3F5.3 ) 03750403 + READ (IRVI,2022) AC2S(3,3) , AC2S(5,1), CCVS, AC1S(12), DCVS, 03760403 + 1 AC1S(13), AC1S(5), A3S(1,1,2), AC2S(3,5) 03770403 +CT015* TEST 15 - F CONVERSION 03780403 + IVTNUM = 15 03790403 + WRITE (I02,80004) IVTNUM 03800403 + WRITE (I02,80020) 03810403 + WRITE (I02,70150) ACVS, CMAVS 03820403 +70150 FORMAT (27X,F3.1,F8.1) 03830403 + IVINSP = IVINSP + 1 03840403 + WRITE (I02,80022) 03850403 + WRITE (I02,70151) 03860403 +70151 FORMAT (27X,"7.7123456.7" ) 03870403 +CT016* TEST 16 - F CONVERSION 03880403 + IVTNUM = 16 03890403 + WRITE (I02,80004) IVTNUM 03900403 + WRITE (I02,80020) 03910403 + WRITE (I02,70160) A1S(2), BCVS, CMBVS 03920403 +70160 FORMAT(27X,F4.2,F5.3,F8.6) 03930403 + IVINSP = IVINSP + 1 03940403 + WRITE (I02,80022) 03950403 + WRITE (I02,70161) 03960403 +70161 FORMAT (27X,"8.889.9997.123456" ) 03970403 +CT017* TEST 17 - F CONVERSION 03980403 + IVTNUM = 17 03990403 + WRITE (I02,80004) IVTNUM 04000403 + WRITE (I02,80020) 04010403 + WRITE (I02,70170) HHCVS,CMCVS, GGCVS, FFCVS, A1S(1), AC1S(25) 04020403 + 1 ,AC2S(4,1) 04030403 +70170 FORMAT (27X,F6.4,F7.5,4F4.1,F5.1) 04040403 + IVINSP = IVINSP + 1 04050403 + WRITE (I02,80022) 04060403 + WRITE (I02,70171) 04070403 +70171 FORMAT (27X,"5.44446.5555533.133.133.133.1444.1" ) 04080403 +CT018* TEST 18 - F CONVERSION 04090403 + IVTNUM = 18 04100403 + WRITE (I02,80004) IVTNUM 04110403 + WRITE (I02,80020) 04120403 + WRITE (I02,70180) AC1S(18),AC1S(7), AC2S(4,4) , AC1S(8), AC1S(10) 04130403 +70180 FORMAT (27X,2(F6.1),2X,2F7.1 ,2X,F5.2) 04140403 + IVINSP = IVINSP + 1 04150403 + WRITE (I02,80022) 04160403 + WRITE (I02,70181) 04170403 +70181 FORMAT (27X,"5555.15555.1 66666.166666.1 44.22" ) 04180403 +CT019* TEST 19 - F CONVERSION 04190403 + IVTNUM = 19 04200403 + WRITE (I02,80004) IVTNUM 04210403 + WRITE (I02,80020) 04220403 + WRITE (I02,70190) AC2S(3,3) , AC2S(5,1), CCVS, AC1S(12), DCVS, 04230403 + 1 AC1S(13), AC1S(5), A3S(1,1,2), AC2S(3,5) 04240403 +70190 FORMAT (27X,5(F3.1),F7.3,3F5.3 ) 04250403 + IVINSP = IVINSP + 1 04260403 + WRITE (I02,80022) 04270403 + WRITE (I02,70191) 04280403 +70191 FORMAT (27X,"2.12.12.12.12.1666.3334.3334.3334.333" ) 04290403 +C***** FORMATTED DATA TRANSFER I/O STATEMENTS WITH REAL 12.8.1 04300403 +C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST. 12.8.2 04310403 +C***** E EDIT DESCRIPTORS ARE USED IN THE FORMAT 13.5.9.2 04320403 +C***** STATEMENTS. SOME E EDIT DESCRIPTORS ARE REPEATED 13.5.9.2.2 04330403 +C***** (FIELD WIDTH ALWAYS INCLUDES 6 EXTRA POSITIONS 04340403 +C***** TO PROVIDE FOR SIGN, DECIMAL POINT AND EXPONENT. 13.5.9 04350403 +C***** PROVISION IS ALWAYS MADE FOR THE DIGIT ZERO 13.5.9.2.1 04360403 +C***** BEFORE THE DECIMAL POINT) 04370403 +C***** THE NUMBER OF DECIMAL PLACES VARIES FROM 1 04380403 +C***** TO 7 DIGITS. 04390403 +C***** INPUT CARD 10 04400403 +2029 FORMAT (E8.1,E9.2,E10.3,E11.4,E12.5,E13.6,E14.7) 04410403 + READ (IRVI,2029) AVS, BVS, EP1S(5), AC2S(1,5), CVS, AC2S(5,4), 04420403 + 1 A3S(2,1,2) 04430403 +CT020* TEST 20 - E CONVERSION 04440403 + IVTNUM = 20 04450403 + REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL' 04460403 + WRITE (I02,80004) IVTNUM, REMRKS 04470403 + WRITE (I02,80020) 04480403 + WRITE (I02,70200) AVS, BVS 04490403 +70200 FORMAT (27X,E8.1,2X,E9.2) 04500403 + IVINSP = IVINSP + 1 04510403 + WRITE (I02,70201) 04520403 +70201 FORMAT (" ",16X,"CORRECT: " ,22X,"2 CORRECT ANSWERS POSSIBLE" ) 04530403 + WRITE (I02,70202) 04540403 +70202 FORMAT (27X,"-0.1E+01 +0.22E-01" / 04550403 + 1 27X,"-0.1+001 +0.22-001" ) 04560403 +C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS 04570403 + WRITE (I02,90002) 04580403 + WRITE (I02,90013) 04590403 + WRITE (I02,90014) 04600403 +CT021* TEST 21 - E CONVERSION 04610403 + IVTNUM = 21 04620403 + WRITE (I02,80004) IVTNUM, REMRKS 04630403 + WRITE (I02,80020) 04640403 + WRITE (I02,70210) EP1S(5), AC2S(1,5) 04650403 +70210 FORMAT (27X,E10.3,2X,E11.4) 04660403 + IVINSP = IVINSP + 1 04670403 + WRITE (I02,70201) 04680403 + WRITE (I02,70211) 04690403 +70211 FORMAT (27X,"+0.333E+02 +0.4444E+03" / 04700403 + 1 27X,"+0.333+002 +0.4444+003" ) 04710403 +CT022* TEST 22 - E CONVERSION 04720403 + IVTNUM = 22 04730403 + WRITE (I02,80004) IVTNUM, REMRKS 04740403 + WRITE (I02,80020) 04750403 + WRITE (I02,70220) CVS, AC2S(5,4) 04760403 +70220 FORMAT (27X,E12.5,2X,E13.6) 04770403 + IVINSP = IVINSP + 1 04780403 + WRITE (I02,70201) 04790403 + WRITE (I02,70221) 04800403 +70221 FORMAT (27X,"-0.55555E-03 +0.666666E+00" / 04810403 + 1 27X,"-0.55555-003 +0.666666+000" ) 04820403 +CT023* TEST 23 - E CONVERSION 04830403 + IVTNUM = 23 04840403 + WRITE (I02,80004) IVTNUM, REMRKS 04850403 + WRITE (I02,80020) 04860403 + WRITE (I02,70230) A3S(2,1,2) 04870403 +70230 FORMAT (27X,E14.7) 04880403 + IVINSP = IVINSP + 1 04890403 + WRITE (I02,70201) 04900403 + WRITE (I02,70231) 04910403 +70231 FORMAT (27X,"+0.9876543E+12" / 04920403 + 1 27X,"+0.9876543+012" ) 04930403 +C***** FORMATTED DATA TRANSFER I/O STATEMENTS WITH LOGICAL 12.8.2 04940403 +C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST 13.5.10 04950403 +C***** SOME L EDIT DESCRIPTORS ARE REPEATED. 04960403 +C***** L EDIT DESCRIPTORS ARE USED IN THE FORMAT STATEMENTS 13.2.1 04970403 +C***** INPUT CARD 11 04980403 +2033 FORMAT (L4) 04990403 + READ (IRVI,2033) A2B(2,1) 05000403 +C***** INPUT CARD 12 05010403 +2034 FORMAT ( 2L4, L3, L2, L3, L6, L7) 05020403 + READ (IRVI,2034) MCA1B(1), MCBVB, A2B(1,1), A3B(1,1,1), CVB, 05030403 + 1 DVB, A3B(1,2,1) 05040403 +CT024* TEST 24 - L CONVERSION 05050403 + IVTNUM = 24 05060403 + WRITE (I02,80004) IVTNUM 05070403 + WRITE (I02,80020) 05080403 + WRITE (I02,70240) A2B(2,1), MCA1B(1), MCBVB, A2B(1,1), A3B(1,1,1),05090403 + 1 CVB, DVB, A3B(1,2,1) 05100403 +70240 FORMAT (24X, 3(L4), L3, L2, L3, 05110403 + 1 2(L1)) 05120403 + IVINSP = IVINSP + 1 05130403 + WRITE (I02,80022) 05140403 + WRITE (I02,70241) 05150403 +70241 FORMAT (27X,"T F F T T FTF" ) 05160403 +C***** FORMATTED DATA TRANSFER STATEMENTS WITH ARRAY 12.8.2 05170403 +C***** NAMES OF SEVERAL TYPES IN AN I/O LIST. THE 12.9.5.2 05180403 +C***** NUMBER OF ITEMS IN THE LIST IS VARIABLE. SOME 13.2.1 05190403 +C***** EDIT DESCRIPTORS ARE REPEATED. 05200403 +C***** OPTIONAL COMMA BEFORE AND AFTER A SLASH 05210403 +C***** INPUT CARDS 13, 14 05220403 +2037 FORMAT(2X,4(F4.1)/5(I2)) 05230403 + READ (IRVI,2037) A2S, MCA1I 05240403 +C***** INPUT CARDS 15, 16 05250403 +2038 FORMAT(27(F2.1)/5(L1),5L1) 05260403 + READ (IRVI,2038) A3S, A1B, A3B 05270403 +C***** INPUT CARDS 17, 18 05280403 +2039 FORMAT (2X,2(I2,I2),/,2(2(I2,I2)),2(L1,L1),2(F3.1,F3.1),F3.1) 05290403 + READ (IRVI,2039) I2I, I3I, A2B, CMA1S 05300403 +CT025* TEST 25 THRU 28 - UNSUBSCRIPTED ARRAY NAME IN I/O LISTS 05310403 + WRITE (I02,70250) A2S, MCA1I, A3S, A1B 05320403 +70250 FORMAT (" 25 INSPECT" /" ",16X,"COMPUTED: " /27X,4(F4.1)/ 05330403 + 1" ",16X,"CORRECT: " /27X,"-9.9-9.9-9.9-9.9" / " 26 INSPECT"05340403 + 2/" ",16X,"COMPUTED: " /27X,5(I2)/" ",16X,"CORRECT: " /27X, 05350403 + 3"9999999999" /" 27 INSPECT" ,32X,"LEADING PLUS SIGN/ZERO " ,05360403 + 4"OPTIONAL"/" ",16X,"COMPUTED: " ,22X,"3 COMPUTED LINES EXPECTED" 05370403 + 5/27X,3(3(F4.1))/27X,2(2(F4.1,F4.1)),F4.1/27X,9F4.1/" ",16X, 05380403 + 6"CORRECT: " ,22X,"EACH RESULT LINE SHOULD EQUAL" / 05390403 + 7 27X," 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9" / 05400403 + 8 " 28 INSPECT" /" ",16X,"COMPUTED: " /27X,2L1/ 05410403 + 9 " ",16X,"CORRECT: " /27X,"TF") 05420403 + IVINSP = IVINSP + 4 05430403 +C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS 05440403 + WRITE (I02,90002) 05450403 + WRITE (I02,90013) 05460403 + WRITE (I02,90014) 05470403 +CT029* TEST 29 THRU 33 - UNSUBSCRIPTED ARRAY NAMES IN I/O LISTS 05480403 + WRITE (I02,70290) A3B, I2I, I3I, A2B, CMA1S 05490403 +70290 FORMAT (" 29 INSPECT" /" ",16X,"COMPUTED: " /27X,8(L1)/" ", 05500403 + 116X,"CORRECT: " /27X,"TFTFTFTF"/" 30 INSPECT" /" ",16X, 05510403 + 2"COMPUTED: " /27X,4(I2)/" ",16X,"CORRECT: " /27X,"99999999"/ 05520403 + 3 " 31 INSPECT"/" ",16X,"COMPUTED: " /27X,8(I2)/" ",16X, 05530403 + 4"CORRECT: " /27X,"9999999999999999" /" 32 INSPECT" /" ", 05540403 + 516X,"COMPUTED: " /27X,4(L1)/" ",16X,"CORRECT: " /27X,"TFFT"/ 05550403 + 6 " 33 INSPECT"/" ",16X,"COMPUTED: " /27X,5(F3.1)/ 05560403 + 7 " ",16X,"CORRECT: " ,/, 05570403 + 8 27X,"9.99.99.99.99.9" ) 05580403 + IVINSP = IVINSP + 5 05590403 +CT034* TEST 34 - FORMATTED DATA TRANSFER STATEMENT TO TEST 13.5.10 05600403 +C***** THAT OPTIONAL BLANKS MAY PRECEDE A LOGICAL INPUT FIELD05610403 +C***** INPUT CARD 19 05620403 +70340 FORMAT ( L6, L4, L10, L5) 05630403 + READ (IRVI,70340) AVB, MCA1B(2), A2B(1,2), A3B(2,1,2) 05640403 + IVTNUM = 34 05650403 + REMRKS = 'LEADING BLANKS ARE REQUIRED' 05660403 + WRITE (I02,80004) IVTNUM, REMRKS 05670403 + WRITE (I02,80020) 05680403 + WRITE (I02,70341) AVB, MCA1B(2), A2B(1,2), A3B(2,1,2) 05690403 +70341 FORMAT (27X,L6, L4, L10, L5) 05700403 + IVINSP = IVINSP + 1 05710403 + WRITE (I02,80022) 05720403 + WRITE (I02,70342) 05730403 +70342 FORMAT (27X," T F T F" ) 05740403 +CT035* TEST 35 05750403 +C***** FORMATTED DATA TRANSFER TO TEST F EDIT DESCRIPTORS 13.5.9.2.1 05760403 +C***** WHERE D IS EQUAL TO ZERO 05770403 +C***** INPUT CARD 20 05780403 +70350 FORMAT (2X, F3.0, F5.0, F5.5, F1.0) 05790403 + READ (IRVI,70350) AVS, BVS, CVS, DVS 05800403 + IVTNUM = 35 05810403 + WRITE (I02,80004) IVTNUM 05820403 + WRITE (I02,80020) 05830403 + WRITE (I02,70351) AVS, BVS 05840403 +70351 FORMAT (27X,F4.0,4X,F5.0) 05850403 + IVINSP = IVINSP + 1 05860403 + WRITE (I02,80022) 05870403 + WRITE (I02,70352) 05880403 +70352 FORMAT (27X,"333.",4X,"4444.") 05890403 +CT036* TEST 36 05900403 +C***** FORMATTED DATA TRANSFER TO TEST F EDIT DESCRIPTORS 13.5.9.2.1 05910403 +C***** WHERE W EQUALS D+1 AND WHERE D IS EQUAL TO ZERO 13.2.1 05920403 + IVTNUM = 36 05930403 + WRITE (I02,80004) IVTNUM 05940403 + WRITE (I02,80020) 05950403 + WRITE (I02,70360) CVS, DVS 05960403 +70360 FORMAT (27X,F6.5,2X,F2.0) 05970403 + IVINSP = IVINSP + 1 05980403 + WRITE (I02,80022) 05990403 + WRITE (I02,70361) 06000403 +70361 FORMAT (27X,".55555 0." ) 06010403 +CT037* TEST 37 06020403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 06030403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 06040403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 06050403 +C***** I EDIT DESCRIPTORS 06060403 + IVTNUM = 37 06070403 + WRITE (I02,80004) IVTNUM, REMRKS 06080403 + WRITE (I02,80020) 06090403 + WRITE (I02,70370) MCA3I(1,2,3) 06100403 +70370 FORMAT (27X,I3) 06110403 + IVINSP = IVINSP + 1 06120403 + WRITE (I02,80022) 06130403 + WRITE (I02,70371) 06140403 +70371 FORMAT (27X," 8") 06150403 +CT038* TEST 38 06160403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 06170403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 06180403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 06190403 +C***** I EDIT DESCRIPTORS 06200403 + IVTNUM = 38 06210403 + WRITE (I02,80004) IVTNUM, REMRKS 06220403 + WRITE (I02,80020) 06230403 + WRITE (I02,70380) IAC1I(3) 06240403 +70380 FORMAT (27X,I4) 06250403 + IVINSP = IVINSP + 1 06260403 + WRITE (I02,80022) 06270403 + WRITE (I02,70381) 06280403 +70381 FORMAT (27X," 22") 06290403 +CT039* TEST 39 06300403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 06310403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 06320403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 06330403 +C***** I EDIT DESCRIPTORS 06340403 + IVTNUM = 39 06350403 + WRITE (I02,80004) IVTNUM, REMRKS 06360403 + WRITE (I02,80020) 06370403 + WRITE (I02,70390) NECVI 06380403 +70390 FORMAT (27X,I5) 06390403 + IVINSP = IVINSP + 1 06400403 + WRITE (I02,80022) 06410403 + WRITE (I02,70391) 06420403 +70391 FORMAT (27X," 22") 06430403 +C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS 06440403 + WRITE (I02,90002) 06450403 + WRITE (I02,90013) 06460403 + WRITE (I02,90014) 06470403 +CT040* TEST 40 06480403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 06490403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 06500403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 06510403 +C***** I EDIT DESCRIPTORS 06520403 + IVTNUM = 40 06530403 + WRITE (I02,80004) IVTNUM, REMRKS 06540403 + WRITE (I02,80020) 06550403 + WRITE (I02,70400) IAC1I(3) 06560403 +70400 FORMAT (27X,I6) 06570403 + IVINSP = IVINSP + 1 06580403 + WRITE (I02,80022) 06590403 + WRITE (I02,70401) 06600403 +70401 FORMAT (27X," 22") 06610403 +CT041* TEST 41 06620403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 06630403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 06640403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 06650403 +C***** I EDIT DESCRIPTORS 06660403 + IVTNUM = 41 06670403 + WRITE (I02,80004) IVTNUM, REMRKS 06680403 + WRITE (I02,80020) 06690403 + WRITE (I02,70410) IAC2I(2,3) 06700403 +70410 FORMAT (27X,I7) 06710403 + IVINSP = IVINSP + 1 06720403 + WRITE (I02,80022) 06730403 + WRITE (I02,70411) 06740403 +70411 FORMAT (27X," 22") 06750403 +CT042* TEST 42 06760403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 06770403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 06780403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 06790403 +C***** F EDIT DESCRIPTORS 06800403 + IVTNUM = 42 06810403 + WRITE (I02,80004) IVTNUM, REMRKS 06820403 + WRITE (I02,80020) 06830403 + WRITE (I02,70420) ACVS 06840403 +70420 FORMAT (27X,F5.1) 06850403 + IVINSP = IVINSP + 1 06860403 + WRITE (I02,80022) 06870403 + WRITE (I02,70421) 06880403 +70421 FORMAT (27X," 7.7") 06890403 +CT043* TEST 43 06900403 +CT043* TEST 43 - FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 06910403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 06920403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 06930403 +C***** F EDIT DESCRIPTORS 06940403 + IVTNUM = 43 06950403 + WRITE (I02,80004) IVTNUM, REMRKS 06960403 + WRITE (I02,80020) 06970403 + WRITE (I02,70430) A1S(2) 06980403 +70430 FORMAT (27X,F7.2) 06990403 + IVINSP = IVINSP + 1 07000403 + WRITE (I02,80022) 07010403 + WRITE (I02,70431) 07020403 +70431 FORMAT (27X," 8.88") 07030403 +CT044* TEST 44 - FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 07040403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 07050403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 07060403 +C***** F EDIT DESCRIPTORS 07070403 + IVTNUM = 44 07080403 + WRITE (I02,80004) IVTNUM, REMRKS 07090403 + WRITE (I02,80020) 07100403 + WRITE (I02,70440) BCVS 07110403 +70440 FORMAT (27X,F9.3) 07120403 + IVINSP = IVINSP + 1 07130403 + WRITE (I02,80022) 07140403 + WRITE (I02,70441) 07150403 +70441 FORMAT (27X," 9.999") 07160403 +CT045* TEST 45 07170403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 07180403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 07190403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 07200403 +C***** F EDIT DESCRIPTORS 07210403 + IVTNUM = 45 07220403 + WRITE (I02,80004) IVTNUM, REMRKS 07230403 + WRITE (I02,80020) 07240403 + WRITE (I02,70450) HHCVS 07250403 +70450 FORMAT (27X,F11.4) 07260403 + IVINSP = IVINSP + 1 07270403 + WRITE (I02,80022) 07280403 + WRITE (I02,70451) 07290403 +70451 FORMAT (27X," 5.4444" ) 07300403 +CT046* TEST 46 07310403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 07320403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 07330403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 07340403 +C***** F EDIT DESCRIPTORS 07350403 + IVTNUM = 46 07360403 + WRITE (I02,80004) IVTNUM, REMRKS 07370403 + WRITE (I02,80020) 07380403 + WRITE (I02,70460) CMCVS 07390403 +70460 FORMAT (27X,F13.5) 07400403 + IVINSP = IVINSP + 1 07410403 + WRITE (I02,80022) 07420403 + WRITE (I02,70461) 07430403 +70461 FORMAT (27X," 6.55555" ) 07440403 +CT047* TEST 47 07450403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 07460403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 07470403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 07480403 +C***** F EDIT DESCRIPTORS 07490403 + IVTNUM = 47 07500403 + WRITE (I02,80004) IVTNUM, REMRKS 07510403 + WRITE (I02,80020) 07520403 + WRITE (I02,70470) CMBVS 07530403 +70470 FORMAT (27X,F15.6) 07540403 + IVINSP = IVINSP + 1 07550403 + WRITE (I02,80022) 07560403 + WRITE (I02,70471) 07570403 +70471 FORMAT (27X," 7.123456" ) 07580403 +CT048* TEST 48 07590403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 07600403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 07610403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 07620403 +C***** E EDIT DESCRIPTORS 07630403 + IVTNUM = 48 07640403 + WRITE (I02,80004) IVTNUM, REMRKS 07650403 + WRITE (I02,80020) 07660403 + WRITE (I02,70480) DCVS 07670403 +70480 FORMAT (27X,E10.2) 07680403 + IVINSP = IVINSP + 1 07690403 + WRITE (I02,70201) 07700403 + WRITE (I02,70481) 07710403 +70481 FORMAT (27X," 0.21E+01" / 07720403 + 1 27X," 0.21+001" ) 07730403 +CT049* TEST 49 07740403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 07750403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 07760403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 07770403 +C***** E EDIT DESCRIPTORS 07780403 + IVTNUM = 49 07790403 + WRITE (I02,80004) IVTNUM, REMRKS 07800403 + WRITE (I02,80020) 07810403 + WRITE (I02,70490) AC1S(25) 07820403 +70490 FORMAT (27X,E12.3) 07830403 + IVINSP = IVINSP + 1 07840403 + WRITE (I02,70201) 07850403 + WRITE (I02,70491) 07860403 +70491 FORMAT (27X," 0.331E+02" / 07870403 + 1 27X," 0.331+002" ) 07880403 +C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS 07890403 + WRITE (I02,90002) 07900403 + WRITE (I02,90013) 07910403 + WRITE (I02,90014) 07920403 +CT050* TEST 50 07930403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 07940403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 07950403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 07960403 +C***** E EDIT DESCRIPTORS 07970403 + IVTNUM = 50 07980403 + WRITE (I02,80004) IVTNUM, REMRKS 07990403 + WRITE (I02,80020) 08000403 + WRITE (I02,70500) AC2S(4,1) 08010403 +70500 FORMAT (27X,E14.4) 08020403 + IVINSP = IVINSP + 1 08030403 + WRITE (I02,70201) 08040403 + WRITE (I02,70501) 08050403 +70501 FORMAT (27X," 0.4441E+03" / 08060403 + 1 27X," 0.4441+003" ) 08070403 +CT051* TEST 51 08080403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 08090403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 08100403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 08110403 +C***** E EDIT DESCRIPTORS 08120403 + IVTNUM = 51 08130403 + WRITE (I02,80004) IVTNUM, REMRKS 08140403 + WRITE (I02,80020) 08150403 + WRITE (I02,70510) AC1S(7) 08160403 +70510 FORMAT (27X,E16.5) 08170403 + IVINSP = IVINSP + 1 08180403 + WRITE (I02,70201) 08190403 + WRITE (I02,70511) 08200403 +70511 FORMAT (27X," 0.55551E+04" / 08210403 + 1 27X," 0.55551+004" ) 08220403 +CT052* TEST 52 08230403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 08240403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 08250403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 08260403 +C***** E EDIT DESCRIPTORS 08270403 + IVTNUM = 52 08280403 + WRITE (I02,80004) IVTNUM, REMRKS 08290403 + WRITE (I02,80020) 08300403 + WRITE (I02,70520) AC1S(8) 08310403 +70520 FORMAT (27X,E18.6) 08320403 + IVINSP = IVINSP + 1 08330403 + WRITE (I02,70201) 08340403 + WRITE (I02,70521) 08350403 +70521 FORMAT (27X," 0.666661E+05" / 08360403 + 1 27X," 0.666661+005" ) 08370403 +CT053* TEST 53 08380403 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.9 08390403 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 08400403 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH FOR THE 08410403 +C***** E EDIT DESCRIPTORS 08420403 + IVTNUM = 53 08430403 + WRITE (I02,80004) IVTNUM, REMRKS 08440403 + WRITE (I02,80020) 08450403 + WRITE (I02,70530) CMAVS 08460403 +70530 FORMAT (27X,E20.7) 08470403 + IVINSP = IVINSP + 1 08480403 + WRITE (I02,70201) 08490403 + WRITE (I02,70531) 08500403 +70531 FORMAT (27X," 0.1234567E+06" / 08510403 + 1 27X," 0.1234567+006" ) 08520403 +CT054* TEST 54 08530403 +C***** SCALE FACTOR APPLIED TO F AND E EDIT DESCRIPTORS 08540403 +C***** ON READ, BUT NOT ON WRITE 08550403 +C***** INPUT CARD 21 08560403 +2050 FORMAT(2PF8.3,-2PE9.4,F9.4,0PF9.4,9X,-2PE9.4,F9.4) 08570403 + READ(IRVI,2050)EP1S(16),EP1S(17),EP1S(18), EP1S(19), 08580403 + 1 EP1S(20),EP1S(22) 08590403 + IVTNUM = 54 08600403 + WRITE (I02,80004) IVTNUM, REMRKS 08610403 + WRITE (I02,80020) 08620403 + WRITE (I02,70540) EP1S(16),EP1S(17),EP1S(18) 08630403 +70540 FORMAT (27X,F12.4, E12.4, F12.2) 08640403 + IVINSP = IVINSP + 1 08650403 + WRITE (I02,70201) 08660403 + WRITE (I02,70541) 08670403 +70541 FORMAT (27X," 98.7654 0.9877E+04 987654.00" / 08680403 + 1 27X," 0.9877+004 " ) 08690403 +CT055* TEST 55 08700403 +C***** SCALE FACTOR APPLIED TO F AND E EDIT DESCRIPTORS 08710403 +C***** ON READ, BUT NOT ON WRITE 08720403 + IVTNUM = 55 08730403 + WRITE (I02,80004) IVTNUM, REMRKS 08740403 + WRITE (I02,80020) 08750403 + WRITE (I02,70550) EP1S(19),EP1S(20),EP1S(22) 08760403 +70550 FORMAT( 27X,F12.3, E12.4,F12.3 ) 08770403 + IVINSP = IVINSP + 1 08780403 + WRITE (I02,70201) 08790403 + WRITE (I02,70551) 08800403 +70552 FORMAT (" ",48X," OR") 08800403 + WRITE (I02,70552) 08800403 +70553 FORMAT (27X," 987.654 0.8648E+04 8647.859" / 08800403 + 1 27X," 0.8648+004 " ) 08800403 + WRITE (I02,70553) 08800403 + WRITE (I02,90004) 08800403 +70551 FORMAT (27X," 987.654 0.8648E+04 8647.860" / 08810403 + 1 27X," 0.8648+004 " ) 08820403 +CT056* TEST 56 08830403 +C***** SCALE FACTOR APPLIED TO F AND E EDIT DESCRIPTORS 08840403 +C***** ON WRITE, BUT, NOT ON READ 08850403 +C***** INPUT CARD 22 08860403 +2053 FORMAT(F8.2,E9.4,F9.2,F9.3,9X,E9.4,F9.4) 08870403 + READ(IRVI,2053) AC1S(1),AC1S(2),AC1S(3),AC1S(4), 08880403 + 1 AC1S(20),AC1S(23) 08890403 + IVTNUM = 56 08900403 + WRITE (I02,80004) IVTNUM, REMRKS 08910403 + WRITE (I02,80020) 08920403 + WRITE (I02,70560) AC1S(1),AC1S(2),AC1S(3) 08930403 +70560 FORMAT (27X,2PF12.2, -2PE12.4,F12.4) 08940403 + IVINSP = IVINSP + 1 08950403 + WRITE (I02,70201) 08960403 + WRITE (I02,70561) 08970403 +70561 FORMAT (27X," 987.66 0.0099E+06 98.7654" / 08980403 + 1 27X," 0.0099+006 " ) 08990403 +CT057* TEST 57 - SCALE FACTOR APPLIED TO F AND E EDIT DESCRIPTORS 09000403 +C***** ON WRITE, BUT, NOT ON READ 09010403 + IVTNUM = 57 09020403 + WRITE (I02,80004) IVTNUM, REMRKS 09030403 + WRITE (I02,80020) 09040403 + WRITE (I02,70570) AC1S(4), AC1S(20),AC1S(23) 09050403 +70570 FORMAT (27X,1PE12.2, -2PE12.4, 2PF12.2 ) 09060403 + IVINSP = IVINSP + 1 09070403 + WRITE (I02,70201) 09080403 + WRITE (I02,70571) 09090403 +70571 FORMAT (27X," 9.88E+02 0.0086E+06 8647.86" / 09100403 + 1 27X," 9.88+002 0.0086+006 " ) 09110403 +CT058* TEST 58 - I/O FORMAT RESCAN 09120403 +C***** INPUT CARDS 23, 24, 25 09130403 +2055 FORMAT( I1,I2,I3) 09140403 + READ(IRVI,2055) I2I,IAC1I 09150403 + IVTNUM = 58 09160403 + REMRKS = '3 COMPUTED LINES EXPECTED' 09170403 + WRITE (I02,80004) IVTNUM, REMRKS 09180403 + WRITE (I02,80020) 09190403 + WRITE(I02,70580) I2I(1,1),I2I(2,1),I2I(1,2),I2I(2,2),IAC1I 09200403 +70580 FORMAT (27X,I4,I5,I6) 09210403 + IVINSP = IVINSP + 1 09220403 + WRITE (I02,70011) 09230403 + WRITE (I02,70581) 09240403 +70581 FORMAT (27X," 1 22 333" / 09250403 + 1 27X," 4 55 666" / 09260403 + 2 27X," 7 88 999" ) 09270403 +C ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS 09280403 + WRITE (I02,90002) 09290403 + WRITE (I02,90013) 09300403 + WRITE (I02,90014) 09310403 +C***** INPUT CARDS 26, 27 09320403 +2058 FORMAT(I4, 2(I1,1X,I2)) 09330403 + READ( IRVI,2058) I2I, IAC1I 09340403 +CT059* TEST 59 - I/O FORMAT RESCAN 09350403 + IVTNUM = 59 09360403 + REMRKS = '2 COMPUTED LINES EXPECTED' 09370403 + WRITE (I02,80004) IVTNUM, REMRKS 09380403 + WRITE (I02,80020) 09390403 + WRITE( I02,70590) I2I(2,1),I2I(2,2),IAC1I(2),IAC1I(4) 09400403 +70590 FORMAT (27X,I4," **",1(27X,I4," ''",(I4," (("))) 09410403 + IVINSP = IVINSP + 1 09420403 + WRITE (I02,70011) 09430403 + WRITE (I02,70591) 09440403 +70591 FORMAT(27X," 2 **",30X,"4 '' 6 ((" ,/ 09450403 + 1 27X," 8 ''") 09460403 +CBB** ********************** BBCSUM0 **********************************09470403 +C**** WRITE OUT TEST SUMMARY 09480403 +C**** 09490403 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 09500403 + WRITE (I02, 90004) 09510403 + WRITE (I02, 90014) 09520403 + WRITE (I02, 90004) 09530403 + WRITE (I02, 90020) IVPASS 09540403 + WRITE (I02, 90022) IVFAIL 09550403 + WRITE (I02, 90024) IVDELE 09560403 + WRITE (I02, 90026) IVINSP 09570403 + WRITE (I02, 90028) IVTOTN, IVTOTL 09580403 +CBE** ********************** BBCSUM0 **********************************09590403 +CBB** ********************** BBCFOOT0 **********************************09600403 +C**** WRITE OUT REPORT FOOTINGS 09610403 +C**** 09620403 + WRITE (I02,90016) ZPROG, ZPROG 09630403 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 09640403 + WRITE (I02,90019) 09650403 +CBE** ********************** BBCFOOT0 **********************************09660403 +CBB** ********************** BBCFMT0A **********************************09670403 +C**** FORMATS FOR TEST DETAIL LINES 09680403 +C**** 09690403 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 09700403 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 09710403 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 09720403 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 09730403 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 09740403 + 1I6,/," ",15X,"CORRECT= " ,I6) 09750403 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 09760403 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 09770403 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 09780403 + 1A21,/," ",16X,"CORRECT= " ,A21) 09790403 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 09800403 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 09810403 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 09820403 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 09830403 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 09840403 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 09850403 +80050 FORMAT (" ",48X,A31) 09860403 +CBE** ********************** BBCFMT0A **********************************09870403 +CBB** ********************** BBCFMT0B **********************************09880403 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 09890403 +C**** 09900403 +90002 FORMAT ("1") 09910403 +90004 FORMAT (" ") 09920403 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )09930403 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 09940403 +90008 FORMAT (" ",21X,A13,A17) 09950403 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 09960403 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 09970403 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 09980403 + 1 7X,"REMARKS",24X) 09990403 +90014 FORMAT (" ","----------------------------------------------" , 10000403 + 1 "---------------------------------" ) 10010403 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 10020403 +C**** 10030403 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 10040403 +C**** 10050403 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 10060403 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 10070403 + 1 A13) 10080403 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 10090403 +C**** 10100403 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 10110403 +C**** 10120403 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 10130403 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 10140403 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 10150403 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 10160403 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 10170403 +CBE** ********************** BBCFMT0B **********************************10180403 +C***** 10190403 +C***** END OF TEST SEGMENT 020 10200403 + STOP 10210403 + END 10220403 + 10230403 + 10240403 diff --git a/Fortran/UnitTests/fcvs21_f95/FM403.reference_input b/Fortran/UnitTests/fcvs21_f95/FM403.reference_input new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM403.reference_input @@ -0,0 +1,28 @@ + 999 + 555554444 + 666 777777 8 + 333333111112222222255555444444444444 + 7.7123456.7 + 8.889.9997.123456 + 5.44446.5555533.133.133.133.1444.1 + 5555.15555.1 66666.166666.1 44.22 + 2.12.12.12.12.1666.3334.3334.3334.333 +-0.1E+01+0.22E-01 0.333E+02 0.4444E+03-0.55555E-03+0.666666E+00+0.9876543E+12 +TABC +FDEFFGHIT*+T1F/).TRUE..FALSE. + -9.9-9.9-9.9-9.9 +9999999999 +.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9 +TFTFTFTFTF + 99999999 +9999999999999999TFFT9.99.99.99.99.9 + T F T F + 3334444.555550 + 9876.5498.7654E2 9876.54 987.654 86.4786E286.4786 + 9.8765698.7654E2 9876.54 987.654 86.4786E286.4786 +122333544888611222 +455666233444966111 +788999377555899777 +11112 334 559 880 11 +6 778 995 441 222 00 + diff --git a/Fortran/UnitTests/fcvs21_f95/FM403.reference_output b/Fortran/UnitTests/fcvs21_f95/FM403.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM403.reference_output @@ -0,0 +1,397 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM403BEGIN* TEST RESULTS - FM403 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + FMTRW - (020) FORMATTED DATA TRANSFER + + SUBSET REFS - 12.9.5.2 13.3 13.5.9 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 59 TESTS + + 1 INSPECT 2 COMPUTED LINES EXPECTED + COMPUTED= + 1010101010101010101099999999988888888 + 7777777666666555554444333221 + CORRECT: CORRESPONDING LINE MUST MATCH + 1010101010101010101099999999988888888 + 7777777666666555554444333221 + 2 INSPECT 9 COMPUTED LINES EXPECTED + COMPUTED= + AAA BBB CCC + DDD EEE FFF + GGG HHH III + JJJ KKK LLL + MMM NNN OOO + PPP QQQ RRR + SSS TTT UUU + VVV WWW XXX + YYY ZZZ + CORRECT: CORRESPONDING LINE MUST MATCH + AAA BBB CCC + DDD EEE FFF + GGG HHH III + JJJ KKK LLL + MMM NNN OOO + PPP QQQ RRR + SSS TTT UUU + VVV WWW XXX + YYY ZZZ + 3 INSPECT + COMPUTED= + = + - * / ( ) , . ' + CORRECT= + = + - * / ( ) , . ' + 4 INSPECT SLASH DESCRIPTOR + FORMAT( ' SKIP 1 LINE' /) + + ONE BLANK LINE SHOULD APPEAR ABOVE +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 5 INSPECT + FORMAT(' SKIP 2 LINES' //) + + + TWO BLANK LINES SHOULD APPEAR ABOVE + 6 INSPECT + FORMAT(' SKIP 3 LINES ' ///) + + + + THREE BLANK LINES SHOULD APPEAR ABOVE + 7 INSPECT IMBEDDED SLASHES + 1 BLANK LINE SHOULD APPEAR BELOW + + 2 BLANK LINES SHOULD APPEAR BELOW + + + 3 BLANK LINES SHOULD APPEAR BELOW + + + + 0 BLANK LINES SHOULD APPEAR BELOW + END IMBEDDED SLASHES TEST + 8 INSPECT DOUBLE SPACE + 1 BLANK LINE SHOULD APPEAR BELOW +0 END DOUBLE SPACE TEST + 9 INSPECT OVERPRINT + + !FIRST PRINT LINE! OVER ++ P R I N T !SECOND PRINT LINE! + 10 INSPECT PAGE ADVANCE + + THIS SHOULD BE THE LAST LINE ON THIS PAGE +1 NEW PAGE: END OF VERTICAL SPACING TESTS + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 11 INSPECT + COMPUTED= + 999 + CORRECT= + 999 + 12 INSPECT + COMPUTED= + 5555 4444 + CORRECT= + 5555 4444 + 13 INSPECT + COMPUTED= + 666 777777 8 + CORRECT= + 666 777777 8 + 14 INSPECT + COMPUTED= + + 333333111112222222255555444444444444 + CORRECT= + 333333111112222222255555444444444444 + 15 INSPECT + COMPUTED= + 7.7123456.7 + CORRECT= + 7.7123456.7 + 16 INSPECT + COMPUTED= + 8.889.9997.123456 + CORRECT= + 8.889.9997.123456 + 17 INSPECT + COMPUTED= + 5.44446.5555533.133.133.133.1444.1 + CORRECT= + 5.44446.5555533.133.133.133.1444.1 + 18 INSPECT + COMPUTED= + 5555.15555.1 66666.166666.1 44.22 + CORRECT= + 5555.15555.1 66666.166666.1 44.22 + 19 INSPECT + COMPUTED= + 2.12.12.12.12.1666.3334.3334.3334.333 + CORRECT= + 2.12.12.12.12.1666.3334.3334.3334.333 + 20 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + -0.1E+01 0.22E-01 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + -0.1E+01 +0.22E-01 + -0.1+001 +0.22-001 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 21 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.333E+02 0.4444E+03 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + +0.333E+02 +0.4444E+03 + +0.333+002 +0.4444+003 + 22 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + -0.55555E-03 0.666666E+00 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + -0.55555E-03 +0.666666E+00 + -0.55555-003 +0.666666+000 + 23 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.9876543E+12 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + +0.9876543E+12 + +0.9876543+012 + 24 INSPECT + COMPUTED= + T F F T T FTF + CORRECT= + T F F T T FTF + 25 INSPECT + COMPUTED: + -9.9-9.9-9.9-9.9 + CORRECT: + -9.9-9.9-9.9-9.9 + 26 INSPECT + COMPUTED: + 9999999999 + CORRECT: + 9999999999 + 27 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED: 3 COMPUTED LINES EXPECTED + 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 + 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 + 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 + CORRECT: EACH RESULT LINE SHOULD EQUAL + 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 + 28 INSPECT + COMPUTED: + TF + CORRECT: + TF +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 29 INSPECT + COMPUTED: + TFTFTFTF + CORRECT: + TFTFTFTF + 30 INSPECT + COMPUTED: + 99999999 + CORRECT: + 99999999 + 31 INSPECT + COMPUTED: + 9999999999999999 + CORRECT: + 9999999999999999 + 32 INSPECT + COMPUTED: + TFFT + CORRECT: + TFFT + 33 INSPECT + COMPUTED: + 9.99.99.99.99.9 + CORRECT: + 9.99.99.99.99.9 + 34 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + T F T F + CORRECT= + T F T F + 35 INSPECT + COMPUTED= + 333. 4444. + CORRECT= + 333. 4444. + 36 INSPECT + COMPUTED= + .55555 0. + CORRECT= + .55555 0. + 37 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 8 + CORRECT= + 8 + 38 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 22 + CORRECT= + 22 + 39 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 22 + CORRECT= + 22 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 40 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 22 + CORRECT= + 22 + 41 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 22 + CORRECT= + 22 + 42 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 7.7 + CORRECT= + 7.7 + 43 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 8.88 + CORRECT= + 8.88 + 44 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 9.999 + CORRECT= + 9.999 + 45 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 5.4444 + CORRECT= + 5.4444 + 46 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 6.55555 + CORRECT= + 6.55555 + 47 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 7.123456 + CORRECT= + 7.123456 + 48 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 0.21E+01 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 0.21E+01 + 0.21+001 + 49 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 0.331E+02 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 0.331E+02 + 0.331+002 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 50 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 0.4441E+03 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 0.4441E+03 + 0.4441+003 + 51 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 0.55551E+04 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 0.55551E+04 + 0.55551+004 + 52 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 0.666661E+05 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 0.666661E+05 + 0.666661+005 + 53 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 0.1234567E+06 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 0.1234567E+06 + 0.1234567+006 + 54 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 98.7654 0.9877E+04 987654.00 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 98.7654 0.9877E+04 987654.00 + 0.9877+004 + 55 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 987.654 0.8648E+04 8647.860 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 987.654 0.8648E+04 8647.860 + 0.8648+004 + OR + 987.654 0.8648E+04 8647.859 + 0.8648+004 + + 56 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 987.66 0.0099E+06 98.7654 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 987.66 0.0099E+06 98.7654 + 0.0099+006 + 57 INSPECT LEADING BLANKS ARE REQUIRED + COMPUTED= + 9.88E+02 0.0086E+06 8647.86 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 9.88E+02 0.0086E+06 8647.86 + 9.88+002 0.0086+006 + 58 INSPECT 3 COMPUTED LINES EXPECTED + COMPUTED= + 1 22 333 + 4 55 666 + 7 88 999 + CORRECT: CORRESPONDING LINE MUST MATCH + 1 22 333 + 4 55 666 + 7 88 999 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 59 INSPECT 2 COMPUTED LINES EXPECTED + COMPUTED= + 2 ** 4 '' 6 (( + 8 '' + CORRECT: CORRESPONDING LINE MUST MATCH + 2 ** 4 '' 6 (( + 8 '' + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 59 TESTS REQUIRE INSPECTION + 59 OF 59 TESTS EXECUTED + + *FM403END* END OF TEST - FM403 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM404.f b/Fortran/UnitTests/fcvs21_f95/FM404.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM404.f @@ -0,0 +1,323 @@ + PROGRAM FM404 + +C***********************************************************************00010404 +C***** FORTRAN 77 00020404 +C***** FM404 AFMTS - (022) 00030404 +C***** 00040404 +C***********************************************************************00050404 +C***** GENERAL PURPOSE SUBSET REFS00060404 +C***** TO TEST SIMPLE FORMAT AND FORMATTED DATA 12.9.5.200070404 +C***** TRANSFER STATEMENTS IN EXTERNAL SEQUENTIAL I/O SO 13.1.1 00080404 +C***** THAT THESE FEATURES MAY BE USED IN OTHER TEST 12.8.1 00090404 +C***** PROGRAM SEGMENTS FOR CHARACTER DATA TYPES. 4.8 00100404 +C***** 00110404 +C***** RESTRICTIONS OBSERVED 00120404 +C***** * ALL FORMAT STATEMENTS ARE LABELED 12.8.2 00130404 +C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.1.1 00140404 +C***** * FIELD WIDTH IS NEVER ZERO 13.5.11 00150404 +C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE LIST ITEM 13.3 00160404 +C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST 00170404 +C***** IN THE FORMAT SPECIFICATION. 00180404 +C***** * ITEMS IN I/O LIST CORRESPOND TO FORMAT DESCRIPTORS 13.3 00190404 +C***** 00200404 +CBB** ********************** BBCCOMNT **********************************00210404 +C**** 00220404 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00230404 +C**** VERSION 2.1 00240404 +C**** 00250404 +C**** 00260404 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00270404 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00280404 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00290404 +C**** BUILDING 225 RM A266 00300404 +C**** GAITHERSBURG, MD 20899 00310404 +C**** 00320404 +C**** 00330404 +C**** 00340404 +CBE** ********************** BBCCOMNT **********************************00350404 +C***** 00360404 +C INPUT DATA TO THIS SEG. CONSISTS OF 6 DATA CARD IMAGES IN COLS. 1 - 5500370404 +COL. 1--------------------------------------------47 00380404 +CARD 1 QRSTMNOPIJKLYZ127890ABCD3456EFGHUVWX/(),.' =+-* 00390404 +CARD 2 AABABCABCDABCDEABCDEFWXYZWXYZWXYZWXYZWXYZWXYZ 00400404 +CARD 3 112123123412345123456 00410404 +CARD 4 GGGGHHHHIIIIJJJJ 00420404 +CARD 5 ----LLLL 00430404 +CARD 6 ....NNNN 00440404 +C***** 00450404 +C***** S P E C I F I C A T I O N S SEGMENT 022 00460404 +C***** 00470404 + CHARACTER*1 A1VK 00480404 + CHARACTER*2 A2VK 00490404 + CHARACTER*3 A3VK 00500404 + CHARACTER*4 A4VK, A41K(6), A43K(2,2,3) 00510404 + CHARACTER*5 A5VK 00520404 + CHARACTER*6 A6VK 00530404 +C***** 00540404 +CBB** ********************** BBCINITA **********************************00550404 +C**** SPECIFICATION STATEMENTS 00560404 +C**** 00570404 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00580404 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00590404 +CBE** ********************** BBCINITA **********************************00600404 +CBB** ********************** BBCINITB **********************************00610404 +C**** INITIALIZE SECTION 00620404 + DATA ZVERS, ZVERSD, ZDATE 00630404 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00640404 + DATA ZCOMPL, ZNAME, ZTAPE 00650404 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00660404 + DATA ZPROJ, ZTAPED, ZPROG 00670404 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00680404 + DATA REMRKS /' '/ 00690404 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00700404 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00710404 +C**** 00720404 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00730404 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00740404 +CZ03 ZPROG = 'PROGRAM NAME' 00750404 +CZ04 ZDATE = 'DATE OF TEST' 00760404 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00770404 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00780404 +CZ07 ZNAME = 'NAME OF USER' 00790404 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00800404 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00810404 +C 00820404 + IVPASS = 0 00830404 + IVFAIL = 0 00840404 + IVDELE = 0 00850404 + IVINSP = 0 00860404 + IVTOTL = 0 00870404 + IVTOTN = 0 00880404 + ICZERO = 0 00890404 +C 00900404 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00910404 + I01 = 05 00920404 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00930404 + I02 = 06 00940404 +C 00950404 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00960404 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00970404 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00980404 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00990404 +C 01000404 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01010404 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01020404 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01030404 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01040404 +C 01050404 +CBE** ********************** BBCINITB **********************************01060404 + IRVI = I01 01070404 + NUVI = I02 01080404 + IVTOTL = 5 01090404 + ZPROG = 'FM404' 01100404 +CBB** ********************** BBCHED0A **********************************01110404 +C**** 01120404 +C**** WRITE REPORT TITLE 01130404 +C**** 01140404 + WRITE (I02, 90002) 01150404 + WRITE (I02, 90006) 01160404 + WRITE (I02, 90007) 01170404 + WRITE (I02, 90008) ZVERS, ZVERSD 01180404 + WRITE (I02, 90009) ZPROG, ZPROG 01190404 + WRITE (I02, 90010) ZDATE, ZCOMPL 01200404 +CBE** ********************** BBCHED0A **********************************01210404 +C***** 01220404 +C***** HEADER FOR SEGMENT 22 01230404 + WRITE (NUVI,02200) 01240404 +02200 FORMAT(" ", /1X," AFMTS - (022) FORMATTED DATA TRANSFER" // 01250404 + 1 1X," USING A-CONVERSION" //1X, 01260404 + 2 " SUBSET REFS - 12.9.5.2 13.3 13.5.11" ) 01270404 +CBB** ********************** BBCHED0B **********************************01280404 +C**** WRITE DETAIL REPORT HEADERS 01290404 +C**** 01300404 + WRITE (I02,90004) 01310404 + WRITE (I02,90004) 01320404 + WRITE (I02,90013) 01330404 + WRITE (I02,90014) 01340404 + WRITE (I02,90015) IVTOTL 01350404 +CBE** ********************** BBCHED0B **********************************01360404 +C***** 01370404 +C***** TESTS THAT ALL FORTRAN (SUBSET) CHARACTERS MAY BE READ. 3.101380404 +C***** 01390404 +C***** INPUT CARD 1 01400404 + READ(IRVI, 02201) A43K(1,1,1), A43K(1,1,2), A43K(1,1,3), 01410404 + 1 A43K(1,2,1), A43K(1,2,2), A43K(1,2,3), A43K(2,1,1), 01420404 + 2 A43K(2,1,2), A43K(2,1,3), A6VK, A5VK 01430404 +02201 FORMAT(9A4, A6, A5) 01440404 +CT001* TEST 1 01450404 + IVTNUM = 1 01460404 + REMRKS = '2 COMPUTED LINES EXPECTED' 01470404 + WRITE (NUVI, 80004) IVTNUM, REMRKS 01480404 + WRITE (NUVI, 80020) 01490404 + WRITE(NUVI, 70010) A43K(1,2,3), A43K(2,1,2), A43K(1,1,3), 01500404 + 1 A43K(1,1,2), A43K(1,1,1), A43K(2,1,3), A43K(1,2,1), 01510404 + 2 A43K(2,1,1), A43K(1,2,2), A5VK, A6VK 01520404 +70010 FORMAT(26X,9A4/25X,A5,A6) 01530404 + IVINSP = IVINSP + 1 01540404 + WRITE (NUVI, 70011) 01550404 +70011 FORMAT(" ",16X,"CORRECT: " ,22X, "CORRESPONDING LINE(S) MUST M01560404 + 1ATCH") 01570404 + WRITE (NUVI, 70012) 01580404 +70012 FORMAT(26X, "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" / 01590404 + 1 26X,"=+-*/(),.'" ) 01600404 +C***** 01610404 +C***** AW CONVERSION IS USED IN THE FORMAT STATEMENTS. 3.5.1101620404 +C***** SOME FORMAT DESCRIPTORS ARE REPEATED. 01630404 +C***** THE FOLLOWING THREE CASES ARE USED FOR BOTH INPUT AND OUTPUT. 01640404 +C***** INPUT FIELD WIDTH = CHARACTER VARIABLE LENGTH 01650404 +C***** INPUT FIELD WIDTH < CHARACTER VARIABLE LENGTH 01660404 +C***** INPUT FIELD WIDTH > CHARACTER VARIABLE LENGTH 01670404 +C***** 01680404 +C***** INPUT CARD 2 01690404 + READ(IRVI, 02203) A41K(1), A41K(2), A41K(3), A41K(4), A41K(5), 01700404 + 1 A41K(6), A1VK, A2VK, A3VK, A4VK, A5VK, A6VK 01710404 +02203 FORMAT(A1, A2, 1A3, A4, A5, 1(A6), A4, 2A4, 3(A4)) 01720404 +CT002* TEST 2 01730404 + IVTNUM = 2 01740404 + REMRKS = '2 COMPUTED LINES EXPECTED' 01750404 + WRITE (NUVI, 80004) IVTNUM, REMRKS 01760404 + WRITE (NUVI, 80020) 01770404 + WRITE(NUVI, 70020) A41K(1), A41K(2), A41K(3), A41K(4), A41K(5), 01780404 + 1 A41K(6), A6VK, A5VK, A4VK, A3VK, A2VK, A1VK 01790404 +70020 FORMAT(26X,A4,A4,4A4/26X,A6,A5,A4,A3,A2,A1) 01800404 + IVINSP = IVINSP + 1 01810404 + WRITE (NUVI, 70011) 01820404 + WRITE (NUVI, 70022) 01830404 +70022 FORMAT(26X,"A AB ABC ABCDBCDECDEF" / 01840404 + 1 26X,"WXYZ WXYZ WXYZXYZYZZ" ) 01850404 +C***** 01860404 +CT003* TEST 3 01870404 + IVTNUM = 3 01880404 + REMRKS = '2 COMPUTED LINES EXPECTED' 01890404 + WRITE (NUVI, 80004) IVTNUM, REMRKS 01900404 + WRITE (NUVI, 80020) 01910404 + WRITE(NUVI, 70030) A41K(1), A41K(2), A41K(3), A41K(4), A41K(5), 01920404 + 1 A41K(6), A1VK, A2VK, A3VK, A4VK, A5VK, A6VK 01930404 +70030 FORMAT(26X,A1,A2,A3,A4,A5,A6/23X,4(A4),A4,A4) 01940404 + IVINSP = IVINSP + 1 01950404 + WRITE (NUVI, 70011) 01960404 + WRITE (NUVI, 70032) 01970404 +70032 FORMAT(26X,"AABABCABCD BCDE CDEF" / 01980404 + 1 26X,"Z YZ XYZWXYZWXYZWXYZ" ) 01990404 +C***** 02000404 +C***** A CONVERSION IS USED IN THE FORMAT STATEMENTS. 3.5.1102010404 +C***** SOME FORMAT DESCRIPTORS ARE REPEATED. 02020404 +C***** READ WITH A-EDIT DESCRIPTOR, A STRING, FOLLOWED BY ANOTHER 02030404 +C***** FIELD TO SHOW THAT THE POINTER PICKS UP THE NEXT FIELD 02040404 +C***** FOLLOWING THE COUNT OF THE LENGTH OF THE DECLARED VARIABLE. 02050404 +C***** 02060404 +C***** INPUT CARD 3 02070404 + READ(IRVI, 02206) A1VK, A2VK, A3VK, A4VK, A5VK, A6VK 02080404 +02206 FORMAT(A, 2A, 3(A)) 02090404 +CT004* TEST 4 02100404 + IVTNUM = 4 02110404 + WRITE (NUVI, 80004) IVTNUM 02120404 + WRITE (NUVI, 80020) 02130404 + WRITE(NUVI, 70040) A1VK, A2VK, A3VK, A4VK, A5VK, A6VK 02140404 +70040 FORMAT(26X,6A) 02150404 + IVINSP = IVINSP + 1 02160404 + WRITE (NUVI, 80022) 02170404 + WRITE (NUVI, 70042) 02180404 +70042 FORMAT(26X,"112123123412345123456" ) 02190404 +C***** 02200404 +C***** TEST THAT A SLASH ON INPUT CAUSES THE UNPROCESSED CHARACTERS 02210404 +C***** TO BE SKIPPED. 13.5.402220404 +C***** ALSO TEST THAT AN APOSTROPHE MAY BE USED INSTEAD OF AN 13.5.102230404 +C***** H-EDIT DESCRIPTOR. 13.5.202240404 +C***** 02250404 +C***** INPUT CARD 4 02260404 + READ(IRVI, 02208) A41K(2), A41K(1), A41K(4), A41K(3) 02270404 +02208 FORMAT(4A4) 02280404 +C***** INPUT CARDS 5-6 02290404 + READ(IRVI, 02209) A41K(2), A41K(4), A41K(3) 02300404 +02209 FORMAT(A4 / 2A4) 02310404 +CT005* TEST 5 02320404 + IVTNUM = 5 02330404 + REMRKS = '2 IDENTICAL COMPUTED LINES ' 02340404 + WRITE (NUVI, 80004) IVTNUM, REMRKS 02350404 + REMRKS = 'EXPECTED ' 02360404 + WRITE (NUVI, 80050) REMRKS 02370404 + WRITE (NUVI, 80020) 02380404 + WRITE(NUVI, 70050) A41K(2), A41K(1), A41K(4), A41K(3) 02390404 +70050 FORMAT(26X,'----HHHH....NNNN'/26X,3(A4),A4) 02400404 + IVINSP = IVINSP + 1 02410404 + WRITE (NUVI, 70011) 02420404 + WRITE (NUVI, 70052) 02430404 +70052 FORMAT (26X,"----HHHH....NNNN" ) 02440404 +C***** 02450404 +CBB** ********************** BBCSUM0 **********************************02460404 +C**** WRITE OUT TEST SUMMARY 02470404 +C**** 02480404 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02490404 + WRITE (I02, 90004) 02500404 + WRITE (I02, 90014) 02510404 + WRITE (I02, 90004) 02520404 + WRITE (I02, 90020) IVPASS 02530404 + WRITE (I02, 90022) IVFAIL 02540404 + WRITE (I02, 90024) IVDELE 02550404 + WRITE (I02, 90026) IVINSP 02560404 + WRITE (I02, 90028) IVTOTN, IVTOTL 02570404 +CBE** ********************** BBCSUM0 **********************************02580404 +CBB** ********************** BBCFOOT0 **********************************02590404 +C**** WRITE OUT REPORT FOOTINGS 02600404 +C**** 02610404 + WRITE (I02,90016) ZPROG, ZPROG 02620404 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02630404 + WRITE (I02,90019) 02640404 +CBE** ********************** BBCFOOT0 **********************************02650404 +CBB** ********************** BBCFMT0A **********************************02660404 +C**** FORMATS FOR TEST DETAIL LINES 02670404 +C**** 02680404 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02690404 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02700404 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02710404 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02720404 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02730404 + 1I6,/," ",15X,"CORRECT= " ,I6) 02740404 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02750404 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02760404 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02770404 + 1A21,/," ",16X,"CORRECT= " ,A21) 02780404 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02790404 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02800404 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02810404 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02820404 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02830404 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02840404 +80050 FORMAT (" ",48X,A31) 02850404 +CBE** ********************** BBCFMT0A **********************************02860404 +CBB** ********************** BBCFMT0B **********************************02870404 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02880404 +C**** 02890404 +90002 FORMAT ("1") 02900404 +90004 FORMAT (" ") 02910404 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02920404 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02930404 +90008 FORMAT (" ",21X,A13,A17) 02940404 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02950404 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02960404 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02970404 + 1 7X,"REMARKS",24X) 02980404 +90014 FORMAT (" ","----------------------------------------------" , 02990404 + 1 "---------------------------------" ) 03000404 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03010404 +C**** 03020404 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03030404 +C**** 03040404 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03050404 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03060404 + 1 A13) 03070404 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03080404 +C**** 03090404 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03100404 +C**** 03110404 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03120404 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03130404 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03140404 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03150404 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03160404 +CBE** ********************** BBCFMT0B **********************************03170404 +C***** 03180404 +C***** END OF TEST SEGMENT 022 03190404 + STOP 03200404 + END 03210404 diff --git a/Fortran/UnitTests/fcvs21_f95/FM404.reference_input b/Fortran/UnitTests/fcvs21_f95/FM404.reference_input new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM404.reference_input @@ -0,0 +1,7 @@ +QRSTMNOPIJKLYZ127890ABCD3456EFGHUVWX/(),.' =+-* +AABABCABCDABCDEABCDEFWXYZWXYZWXYZWXYZWXYZWXYZ +112123123412345123456 +GGGGHHHHIIIIJJJJ +----LLLL +....NNNN + diff --git a/Fortran/UnitTests/fcvs21_f95/FM404.reference_output b/Fortran/UnitTests/fcvs21_f95/FM404.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM404.reference_output @@ -0,0 +1,67 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM404BEGIN* TEST RESULTS - FM404 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + AFMTS - (022) FORMATTED DATA TRANSFER + + USING A-CONVERSION + + SUBSET REFS - 12.9.5.2 13.3 13.5.11 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 5 TESTS + + 1 INSPECT 2 COMPUTED LINES EXPECTED + COMPUTED= + ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 + =+-*/(),.' + CORRECT: CORRESPONDING LINE(S) MUST MATCH + ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 + =+-*/(),.' + 2 INSPECT 2 COMPUTED LINES EXPECTED + COMPUTED= + A AB ABC ABCDBCDECDEF + WXYZ WXYZ WXYZXYZYZZ + CORRECT: CORRESPONDING LINE(S) MUST MATCH + A AB ABC ABCDBCDECDEF + WXYZ WXYZ WXYZXYZYZZ + 3 INSPECT 2 COMPUTED LINES EXPECTED + COMPUTED= + AABABCABCD BCDE CDEF + Z YZ XYZWXYZWXYZWXYZ + CORRECT: CORRESPONDING LINE(S) MUST MATCH + AABABCABCD BCDE CDEF + Z YZ XYZWXYZWXYZWXYZ + 4 INSPECT + COMPUTED= + 112123123412345123456 + CORRECT= + 112123123412345123456 + 5 INSPECT 2 IDENTICAL COMPUTED LINES + EXPECTED + COMPUTED= + ----HHHH....NNNN + ----HHHH....NNNN + CORRECT: CORRESPONDING LINE(S) MUST MATCH + ----HHHH....NNNN + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 5 TESTS REQUIRE INSPECTION + 5 OF 5 TESTS EXECUTED + + *FM404END* END OF TEST - FM404 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM405.f b/Fortran/UnitTests/fcvs21_f95/FM405.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM405.f @@ -0,0 +1,483 @@ + PROGRAM FM405 + +C***********************************************************************00010405 +C***** FORTRAN 77 00020405 +C***** FM405 00030405 +C***** INTER1 - (390) 00040405 +C***** 00050405 +C***********************************************************************00060405 +C***** TESTING OF INTERNAL FILES - SUBSET REF00070405 +C***** USING READ 12.2.5 00080405 +C***** 00090405 +CBB** ********************** BBCCOMNT **********************************00100405 +C**** 00110405 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120405 +C**** VERSION 2.1 00130405 +C**** 00140405 +C**** 00150405 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160405 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170405 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180405 +C**** BUILDING 225 RM A266 00190405 +C**** GAITHERSBURG, MD 20899 00200405 +C**** 00210405 +C**** 00220405 +C**** 00230405 +CBE** ********************** BBCCOMNT **********************************00240405 +C***** 00250405 +C***** S P E C I F I C A T I O N S SEGMENT 390 00260405 +C***** 00270405 + LOGICAL AVB, BVB, CVB 00280405 + CHARACTER A1VK*1, A4VK*4, B1VK*1, B4VK*4, A38VK*38, B381K(4)*38 00290405 + CHARACTER A5VK*5, A8VK*8, B5VK*5, B8VK*8 00300405 +CBB** ********************** BBCINITA **********************************00310405 +C**** SPECIFICATION STATEMENTS 00320405 +C**** 00330405 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00340405 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00350405 +CBE** ********************** BBCINITA **********************************00360405 +CBB** ********************** BBCINITB **********************************00370405 +C**** INITIALIZE SECTION 00380405 + DATA ZVERS, ZVERSD, ZDATE 00390405 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00400405 + DATA ZCOMPL, ZNAME, ZTAPE 00410405 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00420405 + DATA ZPROJ, ZTAPED, ZPROG 00430405 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00440405 + DATA REMRKS /' '/ 00450405 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00460405 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00470405 +C**** 00480405 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00490405 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00500405 +CZ03 ZPROG = 'PROGRAM NAME' 00510405 +CZ04 ZDATE = 'DATE OF TEST' 00520405 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00530405 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00540405 +CZ07 ZNAME = 'NAME OF USER' 00550405 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00560405 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00570405 +C 00580405 + IVPASS = 0 00590405 + IVFAIL = 0 00600405 + IVDELE = 0 00610405 + IVINSP = 0 00620405 + IVTOTL = 0 00630405 + IVTOTN = 0 00640405 + ICZERO = 0 00650405 +C 00660405 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00670405 + I01 = 05 00680405 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00690405 + I02 = 06 00700405 +C 00710405 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00720405 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00730405 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00740405 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00750405 +C 00760405 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00770405 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00780405 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00790405 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00800405 +C 00810405 +CBE** ********************** BBCINITB **********************************00820405 +C***** 00830405 + EVS = 0.001 00840405 +C***** 00850405 + NUVI = I02 00860405 + IVTOTL=15 00870405 + ZPROG='FM405' 00880405 +CBB** ********************** BBCHED0A **********************************00890405 +C**** 00900405 +C**** WRITE REPORT TITLE 00910405 +C**** 00920405 + WRITE (I02, 90002) 00930405 + WRITE (I02, 90006) 00940405 + WRITE (I02, 90007) 00950405 + WRITE (I02, 90008) ZVERS, ZVERSD 00960405 + WRITE (I02, 90009) ZPROG, ZPROG 00970405 + WRITE (I02, 90010) ZDATE, ZCOMPL 00980405 +CBE** ********************** BBCHED0A **********************************00990405 +C***** 01000405 + A38VK = '2.1 TEST 3 23.45E2 .TRUE. F ' 01010405 + B381K(1) = ' 23 23.345 T ENDS ' 01020405 + B381K(2) = ' 23.456 F 98 YOURS PROGRAMS ' 01030405 + B381K(3) = ' 13.1234 13.1234E0 1312.34 ' 01040405 + B381K(4) = ' 5.2345 56 5.2345 T TRUE 5.2345' 01050405 +C***** 01060405 +C***** HEADER FOR SEGMENT 390 01070405 +C***** 01080405 + WRITE(NUVI,39000) 01090405 +39000 FORMAT(/2X," INTER1 - (390) INTERNAL FILES -- USING READ" 01100405 + 1 //" SUBSET REF. - 12.2.5" ) 01110405 +CBB** ********************** BBCHED0B **********************************01120405 +C**** WRITE DETAIL REPORT HEADERS 01130405 +C**** 01140405 + WRITE (I02,90004) 01150405 + WRITE (I02,90004) 01160405 + WRITE (I02,90013) 01170405 + WRITE (I02,90014) 01180405 + WRITE (I02,90015) IVTOTL 01190405 +CBE** ********************** BBCHED0B **********************************01200405 +C****** 01210405 +C************************************************************* 01220405 +CT001* TEST 1 CHARACTER VARIABLE, INTEGER 01230405 + IVTNUM=1 01240405 + READ(A38VK,39001) IVI 01250405 +39001 FORMAT(8X,I2) 01260405 + KVI = 3 01270405 + IVCOMP=0 01280405 + IF (IVI .EQ. KVI) IVCOMP=1 01290405 + IF (IVCOMP-1) 20010,10010,20010 01300405 +10010 IVPASS=IVPASS + 1 01310405 + WRITE (NUVI,80002) IVTNUM 01320405 + GO TO 0011 01330405 +20010 IVFAIL=IVFAIL+1 01340405 + WRITE (NUVI,80008) IVTNUM 01350405 + WRITE (NUVI,80024) IVI 01360405 + WRITE (NUVI,80026) KVI 01370405 + 0011 CONTINUE 01380405 +C***** 01390405 +CT002* TEST 2 REAL, FW.D 01400405 + IVTNUM=2 01410405 + READ(A38VK,39004) AVS 01420405 +39004 FORMAT(F3.1) 01430405 + BVS = 2.1 01440405 + IVCOMP=0 01450405 + IF (AVS .LT. BVS + EVS .AND. AVS .GT. BVS - EVS) IVCOMP=1 01460405 + IF (IVCOMP-1) 20020,10020,20020 01470405 +10020 IVPASS=IVPASS + 1 01480405 + WRITE(NUVI,80002)IVTNUM 01490405 + GO TO 0021 01500405 +20020 IVFAIL=IVFAIL+1 01510405 + WRITE(NUVI,80008) IVTNUM 01520405 + WRITE (NUVI,80028) AVS 01530405 + WRITE (NUVI,80030) BVS 01540405 + 0021 CONTINUE 01550405 +CT003* TEST 3 REAL, EW.D 01560405 + IVTNUM=3 01570405 + READ(A38VK,39006) AVS 01580405 +39006 FORMAT(11X,E7.2) 01590405 + BVS = 23.45E2 01600405 + IVCOMP=0 01610405 + IF (AVS .LT. BVS + EVS .AND. AVS .GT. BVS - EVS) IVCOMP=1 01620405 + IF (IVCOMP-1) 20030,10030,20030 01630405 +10030 IVPASS=IVPASS + 1 01640405 + WRITE(NUVI,80002)IVTNUM 01650405 + GO TO 0031 01660405 +20030 IVFAIL=IVFAIL + 1 01670405 + WRITE(NUVI,80008)IVTNUM 01680405 + WRITE (NUVI,80028) AVS 01690405 + WRITE (NUVI,80030) BVS 01700405 + 0031 CONTINUE 01710405 +CT004* TEST 4 SAME REAL, EW.DEN 01720405 + IVTNUM=4 01730405 + IVCOMP=0 01740405 + READ(A38VK,39008) CVS 01750405 +39008 FORMAT(10X,E8.2E2) 01760405 + IF (CVS .LT. BVS + EVS .AND. CVS .GT. BVS - EVS) IVCOMP=1 01770405 + IF (IVCOMP-1) 20040,10040,20040 01780405 +10040 IVPASS=IVPASS+1 01790405 + WRITE(NUVI,80002) IVTNUM 01800405 + GO TO 0041 01810405 +20040 IVFAIL=IVFAIL + 1 01820405 + WRITE(NUVI,80008)IVTNUM 01830405 + WRITE (NUVI,80028) CVS 01840405 + WRITE (NUVI,80030) BVS 01850405 + 0041 CONTINUE 01860405 +CT005* TEST 5 LOGICAL, WITH PERIODS 01870405 + IVTNUM=5 01880405 + READ(A38VK,39010) AVB 01890405 +39010 FORMAT(19X,L6) 01900405 + IVCOMP=0 01910405 + IF (AVB) IVCOMP=1 01920405 + IF (IVCOMP-1) 20050,10050,20050 01930405 +10050 IVPASS=IVPASS+1 01940405 + WRITE (NUVI,80002) IVTNUM 01950405 + GO TO 0051 01960405 +20050 IVFAIL=IVFAIL + 1 01970405 + WRITE (NUVI,80008) IVTNUM 01980405 +70050 FORMAT (" ",16X,"COMPUTED: " ,L1, 01990405 + 1 /17X,"CORRECT: " ,"T") 02000405 + WRITE (NUVI,70050) AVB 02010405 + 0051 CONTINUE 02020405 +CT006* TEST 6 LOGICAL, WITHOUT PERIODS 02030405 + IVTNUM=6 02040405 + READ(A38VK,39012) CVB 02050405 +39012 FORMAT(25X,L3) 02060405 + IVCOMP=0 02070405 + IF (.NOT. CVB) IVCOMP=1 02080405 + IF (IVCOMP-1) 20060,10060,20060 02090405 +10060 IVPASS=IVPASS+1 02100405 + WRITE (NUVI,80002) IVTNUM 02110405 + GO TO 0061 02120405 +20060 IVFAIL=IVFAIL+1 02130405 + WRITE (NUVI,80008) IVTNUM 02140405 +70060 FORMAT (" ",16X,"COMPUTED: " ,L1) 02150405 + WRITE (NUVI,70060) CVB 02160405 +70061 FORMAT (" ",16X,"CORRECT: " ,"F") 02170405 + WRITE (NUVI,70061) 02180405 + 0061 CONTINUE 02190405 +CT007* TEST 7 CHARACTER, A 02200405 + IVTNUM=7 02210405 + READ(A38VK,39014) A1VK 02220405 +39014 FORMAT(9X,A1) 02230405 + B1VK = '3' 02240405 + IVCOMP=0 02250405 + IF (A1VK .EQ. B1VK) IVCOMP=1 02260405 + IF (IVCOMP-1) 20070,10070,20070 02270405 +10070 IVPASS=IVPASS+1 02280405 + WRITE (NUVI,80002) IVTNUM 02290405 + GO TO 0071 02300405 +20070 IVFAIL=IVFAIL+1 02310405 + WRITE (NUVI,80008) IVTNUM 02320405 + WRITE (NUVI,80020) A1VK 02330405 + WRITE (NUVI,80022) B1VK 02340405 + 0071 CONTINUE 02350405 +CT008* TEST 8 CHARACTER, AW 02360405 + IVTNUM=8 02370405 + READ(A38VK,39016) A4VK 02380405 +39016 FORMAT(4X,A4) 02390405 + B4VK = 'TEST' 02400405 + IVCOMP=0 02410405 + IF (A4VK .EQ. B4VK) IVCOMP=1 02420405 + IF (IVCOMP-1) 20080,10080,20080 02430405 +10080 IVPASS=IVPASS+1 02440405 + WRITE (NUVI,80002) IVTNUM 02450405 + GO TO 0081 02460405 +20080 IVFAIL=IVFAIL + 1 02470405 + WRITE (NUVI,80008) IVTNUM 02480405 + WRITE (NUVI,80020) A4VK 02490405 + WRITE (NUVI,80022) B4VK 02500405 + 0081 CONTINUE 02510405 +CT009* TEST 9 CHARACTER, EXTRA BLANKS 02520405 + IVTNUM = 9 02530405 + READ(A38VK,39018) A4VK 02540405 +39018 FORMAT(11X,A7) 02550405 + B4VK = '45E2' 02560405 + IVCOMP=0 02570405 + IF (A4VK .EQ. B4VK) IVCOMP=1 02580405 + IF (IVCOMP-1) 20090,10090,20090 02590405 +10090 IVPASS=IVPASS+1 02600405 + WRITE (NUVI,80002) IVTNUM 02610405 + GO TO 0091 02620405 +20090 IVFAIL=IVFAIL+1 02630405 + WRITE (NUVI,80008) IVTNUM 02640405 + WRITE (NUVI,80020) A4VK 02650405 + WRITE (NUVI,80022) B4VK 02660405 + 0091 CONTINUE 02670405 +CT010* TEST 10 CHARACTER, NO PADDING 02680405 + IVTNUM = 10 02690405 + READ(A38VK,39020) A4VK 02700405 +39020 FORMAT(A3) 02710405 + IVCOMP=0 02720405 + B4VK = '2.1 ' 02730405 + IF (A4VK .EQ. B4VK) IVCOMP=1 02740405 + IF (IVCOMP-1) 20100,10100,20100 02750405 +10100 IVPASS=IVPASS+1 02760405 + WRITE (NUVI,80002) IVTNUM 02770405 + GO TO 0101 02780405 +20100 IVFAIL=IVFAIL + 1 02790405 + WRITE (NUVI,80008) IVTNUM 02800405 + WRITE (NUVI,80020) A4VK 02810405 + WRITE (NUVI,80022) B4VK 02820405 + 0101 CONTINUE 02830405 +CT011* TEST 11 CHECK TO SEE IF SECOND VARIABLE 02840405 +C***** START READING JUST AFTER FIRST VARIABLE 02850405 + IVTNUM = 11 02860405 + READ(A38VK,39022) A4VK, A1VK 02870405 +39022 FORMAT(1X,A,A) 02880405 + B4VK = '.1 T' 02890405 + B1VK = 'E' 02900405 + IVCOMP=0 02910405 + IF (A4VK .EQ. B4VK .AND. A1VK .EQ. B1VK) IVCOMP=1 02920405 + IF (IVCOMP-1) 20110,10110,20110 02930405 +10110 IVPASS=IVPASS+1 02940405 + WRITE (NUVI,80002) IVTNUM 02950405 + GO TO 0111 02960405 +20110 IVFAIL=IVFAIL + 1 02970405 + WRITE (NUVI,80008) IVTNUM 02980405 + WRITE (NUVI,80020) A4VK,A1VK 02990405 + WRITE (NUVI,80022) B4VK,B1VK 03000405 +0111 CONTINUE 03010405 +CT012* TEST 12 MIXED TYPES, ARRAY ELEMENT 03020405 + IVTNUM = 12 03030405 + READ(B381K(1),39024) IVI, AVS, AVB, A4VK 03040405 +39024 FORMAT(I5,1X,F8.3,1X,L5,1X,A4) 03050405 + KVI = 23 03060405 + BVS = 23.345 03070405 + B4VK = 'ENDS' 03080405 + IF (IVI .EQ. KVI .AND. 03090405 + 1 AVS .LT. BVS + EVS .AND. AVS .GT. BVS - EVS .AND. 03100405 + 2 AVB .AND. 03110405 + 3 A4VK .EQ. B4VK) GOTO 39026 03120405 + IVFAIL=IVFAIL + 1 03130405 +70120 FORMAT (" ",2X,I3,4X," FAIL ","MIXED DATA TYPES" ,16X, 03140405 + 1 "COMPLEX IF - SEE SOURCE CODE" ) 03150405 + WRITE(NUVI,70120)IVTNUM 03160405 +70121 FORMAT (" ",16X,"COMPUTED: " ,I5,2X,F10.5,2X,L1,2X,A4) 03170405 + WRITE (NUVI,70121) IVI,AVS,AVB,A4VK 03180405 +70122 FORMAT (" ",16X,"CORRECT: " , 03190405 + 1 " 23",2X," 23.34500" ,2X,"T",2X,"ENDS") 03200405 + WRITE (NUVI,70122) 03210405 + GOTO 39027 03220405 +39026 IVPASS=IVPASS+1 03230405 + WRITE(NUVI,80002) IVTNUM 03240405 +39027 CONTINUE 03250405 +CT013* TEST 13 MIXED TYPES, ARRAY ELEMENT 03260405 +C***** WITH RUN TIME EXPRESSION AS SUBSCRIPT03270405 + IVTNUM = 13 03280405 + KVI = 1 03290405 + READ(B381K(KVI*2),39028) AVS, AVB, IVI, A5VK, A8VK 03300405 +39028 FORMAT(F7.3,1X,L5,1X,I5,1X,A5,1X,A8) 03310405 + BVS = 23.456 03320405 + KVI = 98 03330405 + B5VK = 'YOURS' 03340405 + B8VK = 'PROGRAMS' 03350405 + IF (AVS .LT. BVS + EVS .AND. AVS .GT. BVS - EVS .AND. 03360405 + 1 .NOT. AVB .AND. 03370405 + 2 IVI .EQ. KVI .AND. 03380405 + 3 A5VK .EQ. B5VK .AND. 03390405 + 4 A8VK .EQ. B8VK) GOTO 39030 03400405 + IVFAIL=IVFAIL+1 03410405 +70130 FORMAT (" ",2X,I3,4X," FAIL ","MIXED DATA TYPES" ,16X, 03420405 + 1 "COMPLEX IF - SEE SOURCE CODE" ) 03430405 + WRITE (NUVI,70130) IVTNUM 03440405 +70131 FORMAT (" ",16X,"COMPUTED: " , 03450405 + 1 F7.3,2X,L1,2X,I5,2X,A5,2X,A8) 03460405 + WRITE (NUVI,70131) AVS,AVB,IVI,A5VK,A8VK 03470405 +70132 FORMAT (" ",16X,"CORRECT: " , 03480405 + 1 " 23.456",2X,"F",2X," 98",2X,"YOURS",2X,"PROGRAMS") 03490405 + WRITE (NUVI,70132) 03500405 + GOTO 39031 03510405 +39030 IVPASS=IVPASS + 1 03520405 + WRITE(NUVI,80002) IVTNUM 03530405 +39031 CONTINUE 03540405 +CT014* TEST 14 MIXED TYPES, ALSO BN AND BZ 03550405 +C***** 03560405 + IVTNUM = 14 03570405 + READ(B381K(4),39032) AVS, IVI, BVS, AVB, A4VK, CVS 03580405 +39032 FORMAT(F9.4,1X,I4,1X,BN,F9.4,1X,L1,1X,A4,1X,BZ,F6.4) 03590405 + DVS = 5.2345 03600405 + KVI = 56 03610405 + BVB = .TRUE. 03620405 + B4VK = 'TRUE' 03630405 + IF (AVS .LT. DVS + EVS .AND. AVS .GT. DVS - EVS .AND. 03640405 + 1 IVI .EQ. KVI .AND. 03650405 + 2 BVS .LT. DVS + EVS .AND. BVS .GT. DVS - EVS .AND. 03660405 + 3 AVB .AND. 03670405 + 4 A4VK .EQ. B4VK .AND. 03680405 + 5 CVS .LT. DVS + EVS .AND. CVS .GT. DVS - EVS) GOTO 39034 03690405 + IVFAIL=IVFAIL + 1 03700405 +70140 FORMAT (" ",2X,I3,4X," FAIL ","MIXED DATA TYPES" ,16X, 03710405 + 1 "COMPLEX IF - SEE SOURCE CODE" ) 03720405 + WRITE(NUVI,70140) IVTNUM 03730405 +70141 FORMAT (" ",16X,"COMPUTED: " , 03740405 + 1 F9.4,2X,I4,2X,F9.4,2X,L1,2X,A4,2X,F9.4) 03750405 + WRITE (NUVI,70141) AVS,IVI,BVS,AVB,A4VK,CVS 03760405 +70142 FORMAT (" ",16X,"CORRECT: " , 03770405 + 2 " 5.2345",2X," 56",2X," 5.2345",2X,"T",2X,"TRUE", 03780405 + 3 2X," 5.2345") 03790405 + WRITE (NUVI,70142) 03800405 + GOTO 39035 03810405 +39034 IVPASS=IVPASS+1 03820405 + WRITE(NUVI,80002) IVTNUM 03830405 +39035 CONTINUE 03840405 +CT015* TEST 15 REAL VARIABLES WITH SCALING FACTOR 03850405 + IVTNUM = 15 03860405 + READ(B381K(3),39036) AVS, BVS, CVS 03870405 +39036 FORMAT(F9.5, 1X, E9.3, 1X, 2PF7.4) 03880405 + DVS = 13.1234 03890405 + IF (AVS .LT. DVS + EVS .AND. AVS .GT. DVS - EVS .AND. 03900405 + 1 BVS .LT. DVS + EVS .AND. BVS .GT. DVS - EVS .AND. 03910405 + 2 CVS .LT. DVS + EVS .AND. CVS .GT. DVS - EVS) GOTO 39038 03920405 + IVFAIL=IVFAIL + 1 03930405 +70150 FORMAT (" ",2X,I3,4X," FAIL ","REAL DATA TYPES" ,16X, 03940405 + 1 "COMPLEX IF - SEE SOURCE CODE" ) 03950405 + WRITE(NUVI,70150) IVTNUM 03960405 +70151 FORMAT (" ",16X,"COMPUTED: " ,F9.4,2X,F9.3,2X,F7.4) 03970405 + WRITE (NUVI,70151) AVS,BVS,CVS 03980405 +70152 FORMAT (" ",16X,"CORRECT: " , 03990405 + 1 " 13.1234",2X," 13.123",2X,"13.1234") 04000405 + WRITE (NUVI,70152) 04010405 + GOTO 39039 04020405 +39038 IVPASS=IVPASS+1 04030405 + WRITE(NUVI,80002) IVTNUM 04040405 +39039 CONTINUE 04050405 +C***** 04060405 +C***** END OF TEST SEGMENT 390 04070405 +CBB** ********************** BBCSUM0 **********************************04080405 +C**** WRITE OUT TEST SUMMARY 04090405 +C**** 04100405 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04110405 + WRITE (I02, 90004) 04120405 + WRITE (I02, 90014) 04130405 + WRITE (I02, 90004) 04140405 + WRITE (I02, 90020) IVPASS 04150405 + WRITE (I02, 90022) IVFAIL 04160405 + WRITE (I02, 90024) IVDELE 04170405 + WRITE (I02, 90026) IVINSP 04180405 + WRITE (I02, 90028) IVTOTN, IVTOTL 04190405 +CBE** ********************** BBCSUM0 **********************************04200405 +CBB** ********************** BBCFOOT0 **********************************04210405 +C**** WRITE OUT REPORT FOOTINGS 04220405 +C**** 04230405 + WRITE (I02,90016) ZPROG, ZPROG 04240405 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04250405 + WRITE (I02,90019) 04260405 +CBE** ********************** BBCFOOT0 **********************************04270405 +CBB** ********************** BBCFMT0A **********************************04280405 +C**** FORMATS FOR TEST DETAIL LINES 04290405 +C**** 04300405 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04310405 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04320405 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04330405 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04340405 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04350405 + 1I6,/," ",15X,"CORRECT= " ,I6) 04360405 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04370405 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04380405 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04390405 + 1A21,/," ",16X,"CORRECT= " ,A21) 04400405 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04410405 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04420405 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04430405 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04440405 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04450405 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04460405 +80050 FORMAT (" ",48X,A31) 04470405 +CBE** ********************** BBCFMT0A **********************************04480405 +CBB** ********************** BBCFMT0B **********************************04490405 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04500405 +C**** 04510405 +90002 FORMAT ("1") 04520405 +90004 FORMAT (" ") 04530405 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04540405 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04550405 +90008 FORMAT (" ",21X,A13,A17) 04560405 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04570405 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04580405 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04590405 + 1 7X,"REMARKS",24X) 04600405 +90014 FORMAT (" ","----------------------------------------------" , 04610405 + 1 "---------------------------------" ) 04620405 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04630405 +C**** 04640405 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04650405 +C**** 04660405 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04670405 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04680405 + 1 A13) 04690405 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04700405 +C**** 04710405 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04720405 +C**** 04730405 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04740405 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04750405 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04760405 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04770405 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04780405 +CBE** ********************** BBCFMT0B **********************************04790405 + STOP 04800405 + END 04810405 diff --git a/Fortran/UnitTests/fcvs21_f95/FM405.reference_output b/Fortran/UnitTests/fcvs21_f95/FM405.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM405.reference_output @@ -0,0 +1,47 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM405BEGIN* TEST RESULTS - FM405 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INTER1 - (390) INTERNAL FILES -- USING READ + + SUBSET REF. - 12.2.5 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 15 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + + ------------------------------------------------------------------------------- + + 15 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 15 OF 15 TESTS EXECUTED + + *FM405END* END OF TEST - FM405 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM407.f b/Fortran/UnitTests/fcvs21_f95/FM407.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM407.f @@ -0,0 +1,367 @@ + PROGRAM FM407 + +C***********************************************************************00010407 +C***** FORTRAN 77 00020407 +C***** FM407 00030407 +C***** DIRAF1 - (410) 00040407 +C***** THIS PROGRAM CALLS SUBROUTINE SN408 00050407 +C***********************************************************************00060407 +C***** TESTING OF DIRECT ACCESS FILES SUBSET REF00070407 +C***** UNFORMATED RECORDS ONLY 12.10.1 00080407 +C***** 00090407 +C***** 00100407 +CBB** ********************** BBCCOMNT **********************************00110407 +C**** 00120407 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130407 +C**** VERSION 2.1 00140407 +C**** 00150407 +C**** 00160407 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170407 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180407 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190407 +C**** BUILDING 225 RM A266 00200407 +C**** GAITHERSBURG, MD 20899 00210407 +C**** 00220407 +C**** 00230407 +C**** 00240407 +CBE** ********************** BBCCOMNT **********************************00250407 +C***** 00260407 +C***** S P E C I F I C A T I O N S SEGMENT 410 00270407 + DIMENSION L1I(10), K1I(10), M1I(10), F1S(10), G1S(10) 00280407 + CHARACTER*4 A4VK, B4VK, A41K(10), B41K(10) 00290407 + LOGICAL AVB, BVB, C1B(10), D1B(10) 00300407 +C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00310407 +CBB** ********************** BBCINITA **********************************00320407 +C**** SPECIFICATION STATEMENTS 00330407 +C**** 00340407 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350407 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360407 +CBE** ********************** BBCINITA **********************************00370407 +CBB** ********************** BBCINITB **********************************00380407 +C**** INITIALIZE SECTION 00390407 + DATA ZVERS, ZVERSD, ZDATE 00400407 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410407 + DATA ZCOMPL, ZNAME, ZTAPE 00420407 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430407 + DATA ZPROJ, ZTAPED, ZPROG 00440407 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450407 + DATA REMRKS /' '/ 00460407 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470407 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480407 +C**** 00490407 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500407 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510407 +CZ03 ZPROG = 'PROGRAM NAME' 00520407 +CZ04 ZDATE = 'DATE OF TEST' 00530407 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540407 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550407 +CZ07 ZNAME = 'NAME OF USER' 00560407 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570407 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580407 +C 00590407 + IVPASS = 0 00600407 + IVFAIL = 0 00610407 + IVDELE = 0 00620407 + IVINSP = 0 00630407 + IVTOTL = 0 00640407 + IVTOTN = 0 00650407 + ICZERO = 0 00660407 +C 00670407 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680407 + I01 = 05 00690407 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700407 + I02 = 06 00710407 +C 00720407 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730407 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740407 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750407 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760407 +C 00770407 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780407 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790407 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800407 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810407 +C 00820407 +CBE** ********************** BBCINITB **********************************00830407 +C***** 00840407 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 00850407 +C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 00860407 +C***** DIRECT, UNFORMATTED FILE. 00870407 +C***** 00880407 +C I10 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE. 00890407 + I10 = 431 00900407 +CX100 REPLACED BY FEXEC X-100 CONTROL CARD (DIR. FILE UNIT NUMBER). 00910407 +C SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24. 00920407 +C***** 00930407 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 00940407 +C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 00950407 +C***** UNFORMATTED FILE. 00960407 +C***** 00970407 +C***** 00980407 + NUVI = I02 00990407 + IVTOTL = 4 01000407 + ZPROG = 'FM407' 01010407 +CBB** ********************** BBCHED0A **********************************01020407 +C**** 01030407 +C**** WRITE REPORT TITLE 01040407 +C**** 01050407 + WRITE (I02, 90002) 01060407 + WRITE (I02, 90006) 01070407 + WRITE (I02, 90007) 01080407 + WRITE (I02, 90008) ZVERS, ZVERSD 01090407 + WRITE (I02, 90009) ZPROG, ZPROG 01100407 + WRITE (I02, 90010) ZDATE, ZCOMPL 01110407 +CBE** ********************** BBCHED0A **********************************01120407 +C***** FILE NUMBER ASSIGNMENT 01130407 + IUVI = I10 01140407 +C***** 01150407 +C***** HEADER FOR SEGMENT 410 01160407 + WRITE(NUVI,41000) 01170407 +41000 FORMAT(" ",/ " DIRAF1 - (410) DIRECT ACCESS UNFORMATTED FILE" // 01180407 + 1 " SUBSET REF. - 12.10.1" ) 01190407 +CBB** ********************** BBCHED0B **********************************01200407 +C**** WRITE DETAIL REPORT HEADERS 01210407 +C**** 01220407 + WRITE (I02,90004) 01230407 + WRITE (I02,90004) 01240407 + WRITE (I02,90013) 01250407 + WRITE (I02,90014) 01260407 + WRITE (I02,90015) IVTOTL 01270407 +CBE** ********************** BBCHED0B **********************************01280407 +C***** 01290407 + WRITE (NUVI, 41099) 01300407 +41099 FORMAT (" ",48X,"EACH TEST READS 10 RECORDS AND " / 01310407 + 1 " ",48X,"EACH RECORD IS CHECKED, I.E., " / 01320407 + 2 " ",48X,"THERE ARE 10 SUBTESTS MADE FOR " / 01330407 + 3 " ",48X,"EACH TEST " ) 01340407 +C***** 01350407 + CALL SN408(L1I,K1I,M1I,F1S,G1S,C1B,D1B,A41K,B41K) 01360407 +C***** 01370407 + OPEN(IUVI, ACCESS='DIRECT',RECL=132) 01380407 +C***** WRITE 10 RECORDS IN SEQUENCE, REC = 1 TO 10 01390407 + DO 41001 IVI = 1, 10 01400407 + AVS = F1S (IVI) 01410407 + A4VK = A41K (IVI) 01420407 + AVB = C1B (IVI) 01430407 + WRITE(IUVI, REC= IVI) IVI, AVS, A4VK, AVB 01440407 +41001 CONTINUE 01450407 +CT001* TEST 1 READ RECORDS 1 TO 10 IN SEQUENCE 01460407 + IVTNUM = 1 01470407 + IVCOMP = 0 01480407 + DO 41002 IVI = 1, 10 01490407 + READ(IUVI, REC = IVI) KVI, BVS, B4VK, BVB 01500407 + IF (IVI .NE. KVI) GOTO 20010 01510407 + IF (B4VK .NE. A41K(IVI)) GOTO 20010 01520407 + IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 01530407 + 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20010 01540407 + IF (BVS .NE. F1S(IVI)) GO TO 20010 01550407 + GO TO 41002 01560407 +20010 IVCOMP = IVCOMP + 1 01570407 + IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 01580407 + WRITE (NUVI, 70010) IVTNUM, IVI 01590407 + WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, IVI, F1S(IVI), 01600407 + 1 A41K(IVI), C1B(IVI) 01610407 +70010 FORMAT (" ",2X,I3,4X," FAIL ON REC " ,I2) 01620407 +70020 FORMAT (" ",16X,"COMPUTED: " ,I2,1X,F5.2,1X,A4,1X,L1/ 01630407 + 1 " ",16X,"CORRECT: " ,I2,1X,F5.2,1X,A4,1X,L1) 01640407 +41002 CONTINUE 01650407 + IF (IVCOMP - 0) 0011, 10010, 0011 01660407 +10010 IVPASS = IVPASS + 1 01670407 + WRITE (NUVI, 80002) IVTNUM 01680407 + 0011 CONTINUE 01690407 +CT002* TEST 2 READ RECORDS NOT IN SEQUENCE OF RECORD NUMBER 01700407 + IVTNUM = 2 01710407 + IVCOMP = 0 01720407 + DO 41013 IVI = 1, 10 01730407 + JVI = L1I(IVI) 01740407 + READ(IUVI, REC = JVI) KVI, BVS, B4VK, BVB 01750407 + IF (KVI .NE. JVI) GOTO 20020 01760407 + IF (B4VK .NE. A41K(JVI)) GOTO 20020 01770407 + IF ((BVB .AND. .NOT. C1B(JVI)) .OR. 01780407 + 1 (.NOT. BVB .AND. C1B(JVI))) GOTO 20020 01790407 + IF (BVS .NE. F1S(JVI)) GOTO 20020 01800407 + GO TO 41013 01810407 +20020 IVCOMP = IVCOMP + 1 01820407 + IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 01830407 + WRITE (NUVI, 70010) IVTNUM, JVI 01840407 + WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, JVI, F1S(JVI), 01850407 + 1 A41K(JVI), C1B(JVI) 01860407 +41013 CONTINUE 01870407 + IF (IVCOMP - 0) 0021, 10020, 0021 01880407 +10020 IVPASS = IVPASS + 1 01890407 + WRITE (NUVI, 80002) IVTNUM 01900407 + 0021 CONTINUE 01910407 +C***** WRITE RECORDS NOT IN SEQUENCE OF RECORD NUMBER 01920407 +41014 DO 41015 IVI = 1, 10 01930407 + JVI = K1I (IVI) 01940407 + AVS = G1S (JVI) 01950407 + A4VK = B41K (JVI) 01960407 + AVB = D1B (JVI) 01970407 + WRITE(IUVI, REC= JVI) AVB, A4VK, JVI, AVS 01980407 +41015 CONTINUE 01990407 +CT003* TEST 3 READ RECORDS IN SEQUENCE OF RECORD NUMBER 02000407 + IVTNUM = 3 02010407 + IVCOMP = 0 02020407 + DO 41016 IVI = 1, 10 02030407 + READ(IUVI, REC = IVI) BVB, B4VK, JVI, BVS 02040407 + IF (JVI .NE. IVI) GOTO 20030 02050407 + IF (B4VK .NE. B41K(IVI)) GOTO 20030 02060407 + IF ((BVB .AND. .NOT. D1B(IVI)) .OR. 02070407 + 1 (.NOT. BVB .AND. D1B(IVI))) GOTO 20030 02080407 + IF (BVS .NE. G1S(JVI)) GOTO 20030 02090407 + GO TO 41016 02100407 +20030 IVCOMP = IVCOMP + 1 02110407 + IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 02120407 + WRITE (NUVI, 70010) IVTNUM, IVI 02130407 + WRITE (NUVI, 70020) JVI, BVS, B4VK, BVB, IVI, G1S(IVI), 02140407 + 1 B41K(IVI), D1B(IVI) 02150407 +41016 CONTINUE 02160407 + IF (IVCOMP -0) 0031, 10030, 0031 02170407 +10030 IVPASS = IVPASS + 1 02180407 + WRITE (NUVI, 80002) IVTNUM 02190407 + 0031 CONTINUE 02200407 +CT004* TEST 4 READ RECORDS IN A DIFFERENT ORDER SEQUENCE 02210407 + IVTNUM = 4 02220407 + IVCOMP = 0 02230407 + DO 41018 IVI = 1, 10 02240407 + JVI = M1I(IVI) 02250407 + READ(IUVI, REC = JVI) BVB, B4VK, KVI, BVS 02260407 + IF (KVI .NE. JVI) GOTO 20040 02270407 + IF (B4VK .NE. B41K(JVI)) GOTO 20040 02280407 + IF ((BVB .AND. .NOT. D1B(JVI)) .OR. 02290407 + 1 (.NOT. BVB .AND. D1B(JVI))) GOTO 20040 02300407 + IF (BVS .NE. G1S(JVI)) GOTO 20040 02310407 + GO TO 41018 02320407 +20040 IVCOMP = IVCOMP + 1 02330407 + IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 02340407 + WRITE (NUVI, 70010) IVTNUM, JVI 02350407 + WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, JVI, G1S(JVI), 02360407 + 1 B41K(JVI), D1B(JVI) 02370407 +41018 CONTINUE 02380407 + IF (IVCOMP - 0) 0041, 10040, 0041 02390407 +10040 IVPASS = IVPASS + 1 02400407 + WRITE (NUVI, 80002) IVTNUM 02410407 + 0041 CONTINUE 02420407 +C***** 02430407 +CBB** ********************** BBCSUM0 **********************************02710407 +C**** WRITE OUT TEST SUMMARY 02720407 +C**** 02730407 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02740407 + WRITE (I02, 90004) 02750407 + WRITE (I02, 90014) 02760407 + WRITE (I02, 90004) 02770407 + WRITE (I02, 90020) IVPASS 02780407 + WRITE (I02, 90022) IVFAIL 02790407 + WRITE (I02, 90024) IVDELE 02800407 + WRITE (I02, 90026) IVINSP 02810407 + WRITE (I02, 90028) IVTOTN, IVTOTL 02820407 +CBE** ********************** BBCSUM0 **********************************02830407 +CBB** ********************** BBCFOOT0 **********************************02840407 +C**** WRITE OUT REPORT FOOTINGS 02850407 +C**** 02860407 + WRITE (I02,90016) ZPROG, ZPROG 02870407 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02880407 + WRITE (I02,90019) 02890407 +CBE** ********************** BBCFOOT0 **********************************02900407 +CBB** ********************** BBCFMT0A **********************************02910407 +C**** FORMATS FOR TEST DETAIL LINES 02920407 +C**** 02930407 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02940407 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02950407 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02960407 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02970407 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02980407 + 1I6,/," ",15X,"CORRECT= " ,I6) 02990407 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03000407 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03010407 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03020407 + 1A21,/," ",16X,"CORRECT= " ,A21) 03030407 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03040407 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03050407 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03060407 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03070407 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03080407 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03090407 +80050 FORMAT (" ",48X,A31) 03100407 +CBE** ********************** BBCFMT0A **********************************03110407 +CBB** ********************** BBCFMT0B **********************************03120407 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03130407 +C**** 03140407 +90002 FORMAT ("1") 03150407 +90004 FORMAT (" ") 03160407 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03170407 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03180407 +90008 FORMAT (" ",21X,A13,A17) 03190407 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03200407 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03210407 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03220407 + 1 7X,"REMARKS",24X) 03230407 +90014 FORMAT (" ","----------------------------------------------" , 03240407 + 1 "---------------------------------" ) 03250407 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03260407 +C**** 03270407 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03280407 +C**** 03290407 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03300407 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03310407 + 1 A13) 03320407 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03330407 +C**** 03340407 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03350407 +C**** 03360407 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03370407 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03380407 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03390407 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03400407 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03410407 +CBE** ********************** BBCFMT0B **********************************03420407 +C***** 03430407 +C***** END OF TEST SEGMENT 410 03440407 + STOP 03450407 + END 03460407 + +C********************************************************************** 00010408 +C***** FORTRAN 77 00020408 +C***** FM408 00030408 +C***** SN408 DAQ - (805) 00040408 +C***** THIS SUBROUTINE IS CALLED BY FM407 00050408 +C********************************************************************** 00060408 + SUBROUTINE SN408(LW1I, KW1I, MW1I, FW1S, GW1S, CW1B, DW1B, 00070408 + 1 A4W1K, B4W1K) 00080408 +C***** 00090408 +C***** SUBROUTINE USED WITH SEGMENT FM408 TO SUPPLY VALUES 00100408 +C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST 00110408 +C***** 00120408 + DIMENSION LT1I(10),LW1I(10),KT1I(10),KW1I(10),MT1I(10),MW1I(10) 00130408 + REAL FT1S(10),FW1S(10),GT1S(10),GW1S(10) 00140408 + LOGICAL CT1B(10),CW1B(10),DT1B(10),DW1B(10) 00150408 + CHARACTER*4 A4T1K(10),A4W1K(10),B4T1K(10),B4W1K(10) 00160408 +C***** 00170408 + DATA LT1I /2, 4, 1, 3, 10, 8, 9, 6, 7 ,5/ 00180408 + DATA KT1I /9, 10, 1, 3, 2, 5, 8, 4, 7, 6/ 00190408 + DATA MT1I /10, 1, 3, 4, 7, 6, 8, 5, 2, 9/ 00200408 + DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0, 6.5, 7.1, 8.2, 9.9, 10.0/ 00210408 + DATA GT1S /2.34, 2.3,1.9, 2.3, 9.9, 1.1, 8.8, 7.6, 2.3, 10.1/ 00220408 + DATA A4T1K / 'AAAA', 'BBBB', 'CCCC', 'DDDD', 'EDFG', 'JLKD'00230408 + 1 , 'CDFE', 'LKJH', 'JHGF', 'LLLL'/ 00240408 + DATA B4T1K / 'HDFK', 'LKJH', 'ASDF', 'LKJH', 'XMNC', 'ALXM'00250408 + 1 , 'IEOW', 'IERU', 'DJNC', 'DJAL'/ 00260408 + DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .TRUE., .FALSE., 00270408 + 1 .FALSE., .TRUE., .TRUE., .FALSE./ 00280408 + DATA DT1B /.FALSE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE., 00290408 + 1 .TRUE., .TRUE., .FALSE., .TRUE./ 00300408 +C***** 00310408 + DO 1 IVI = 1, 10 00320408 + LW1I(IVI) = LT1I(IVI) 00330408 + KW1I(IVI) = KT1I(IVI) 00340408 + MW1I(IVI) = MT1I(IVI) 00350408 + FW1S(IVI) = FT1S(IVI) 00360408 + GW1S(IVI) = GT1S(IVI) 00370408 + CW1B(IVI) = CT1B(IVI) 00380408 + DW1B(IVI) = DT1B(IVI) 00390408 + A4W1K(IVI) = A4T1K(IVI) 00400408 + B4W1K(IVI) = B4T1K(IVI) 00410408 +1 CONTINUE 00420408 +C***** 00430408 + RETURN 00440408 + END 00450408 diff --git a/Fortran/UnitTests/fcvs21_f95/FM407.reference_output b/Fortran/UnitTests/fcvs21_f95/FM407.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM407.reference_output @@ -0,0 +1,40 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM407BEGIN* TEST RESULTS - FM407 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + DIRAF1 - (410) DIRECT ACCESS UNFORMATTED FILE + + SUBSET REF. - 12.10.1 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 4 TESTS + + EACH TEST READS 10 RECORDS AND + EACH RECORD IS CHECKED, I.E., + THERE ARE 10 SUBTESTS MADE FOR + EACH TEST + 1 PASS + 2 PASS + 3 PASS + 4 PASS + + ------------------------------------------------------------------------------- + + 4 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 4 OF 4 TESTS EXECUTED + + *FM407END* END OF TEST - FM407 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM411.f b/Fortran/UnitTests/fcvs21_f95/FM411.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM411.f @@ -0,0 +1,1456 @@ + PROGRAM FM411 00010411 +C 00020411 +C 00030411 +C 00040411 +C THIS ROUTINE TESTS FOR PROPER PROCESSING OF UNFORMATTED RECORDS00050411 +C WITH A FILE CONNECTED FOR SEQUENTIAL ACCESS. UNFORMATTED RECORDS00060411 +C MAY BE READ OR WRITTEN ONLY BY UNFORMATTED INPUT/OUTPUT STATE- 00070411 +C MENTS. THIS ROUTINE TESTS SEVERAL SYNTACTICAL VARIATIONS OF THE 00080411 +C UNFORMATTED READ AND WRITE STATEMENTS AS WELL AS THE FILE 00090411 +C POSITIONING STATEMENTS BACKSPACE, ENDFILE AND REWIND. IN 00100411 +C ADDITION UNFORMATTED RECORDS MAY HAVE BOTH CHARACTER AND 00110411 +C NONCHARACTER DATA. THIS DATA IS TRANSFERRED WITHOUT EDITING 00120411 +C BETWEEN THE CURRENT RECORD AND ENTITIES SPECIFIED BY THE INPUT/ 00130411 +C OUTPUT LIST ITEMS. THIS ROUTINE BOTH READS AND WRITES 00140411 +C RECORDS CONTAINING DATA OF LOGICAL, REAL AND INTEGER TYPE WITH 00150411 +C I/O LIST ITEMS REPRESENTED AS VARIABLE NAMES, ARRAY ELEMENT 00160411 +C NAMES AND ARRAY NAMES. THIS ROUTINE DOES NOT TEST DATA OF TYPE 00170411 +C CHARACTER. 00180411 +C ROUTINE FM413 TESTS USE OF UNFORMATTED RECORDS WITH A FILE 00190411 +C CONNECTED FOR DIRECT ACCESS. 00200411 +C 00210411 +C THIS ROUTINE TESTS 00220411 +C 00230411 +C (1) THE STATEMENT CONSTRUCTS 00240411 +C 00250411 +C A. WRITE (U) VARIABLE-NAME,... 00260411 +C B. WRITE (U) ARRAY-ELEMENT-NAME,... 00270411 +C C. WRITE (U) ARRAY-NAME,... 00280411 +C D. WRITE (U) - NO OUTPUT LIST 00290411 +C E. WRITE (U) IMPLIED-DO-LIST 00300411 +C F. READ (U) VARIABLE-NAME,... 00310411 +C G. READ (U) ARRAY-ELEMENT-NAME,... 00320411 +C H. READ (U) ARRAY-NAME,... 00330411 +C I. READ (U,END=S) - NO INPUT LIST 00340411 +C J. READ (U,END=S) VARIABLE-NAME 00350411 +C K. READ (U) IMPLIED-DO-LIST 00360411 +C 00370411 +C (2) USE OF A READ STATEMENT WHERE THE NUMBER OF VALUES 00380411 +C IN THE INPUT LIST IS LESS THAN OR EQUAL TO THE 00390411 +C NUMBER OF VALUES IN THE RECORD. 00400411 +C 00410411 +C (3) USE OF THE BACKSPACE, REWIND AND ENDFILE STATEMENT 00420411 +C ON A FILE CONTAINING UNFORMATTED RECORDS. 00430411 +C 00440411 +C (4) USE OF A REWIND STATEMENT ON A FILE THAT IS CONNECTED 00450411 +C BUT DOES NOT EXIST. 00460411 +C 00470411 +C (5) USE OF AN ENDFILE STATEMENT TO CREATE A FILE THAT 00480411 +C DOES NOT EXIST 00490411 +C 00500411 +C REFERENCES - 00510411 +C 00520411 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00530411 +C X3.9-1977 00540411 +C 00550411 +C SECTION 4.1, DATA TYPES 00560411 +C SECTION 12.1.2, UNFORMATTED RECORDS 00570411 +C SECTION 12.2.1, FILE EXISTENCE 00580411 +C SECTION 12.2.4, FILE ACCESS 00590411 +C SECTION 12.2.4.1, SEQUENTIAL ACCESS 00600411 +C SECTION 12.3.3, UNIT SPECIFIER AND IDENTIFIER 00610411 +C SECTION 12.7.2, END-OF-FILE SPECIFIER 00620411 +C SECTION 12.8, READ, WRITE AND PRINT STATEMENTS 00630411 +C SECTION 12.8.1, CONTROL INFORMATION LIST 00640411 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00650411 +C SECTION 12.8.2.1, INPUT LIST ITEMS 00660411 +C SECTION 12.8.2.2, OUTPUT LIST ITEMS 00670411 +C SECTION 12.8.2.3, IMPLIED-DO LIST 00680411 +C SECTION 12.9.5.1, UNFORMATTED DATA TRANSFER 00690411 +C SECTION 12.10.4, FILE POSITIONING STATEMENTS 00700411 +C SECTION 12.10.4.1 BACKSPACE STATEMENT 00710411 +C SECTION 12.10.4.2, ENDFILE STATEMENT 00720411 +C SECTION 12.10.4.3, REWIND STATEMENT 00730411 +C 00740411 +C 00750411 +C 00760411 +C ******************************************************************00770411 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00780411 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00790411 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00800411 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00810411 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00820411 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00830411 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00840411 +C THE RESULT OF EXECUTING THESE TESTS. 00850411 +C 00860411 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00870411 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00880411 +C 00890411 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00900411 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00910411 +C SOFTWARE STANDARDS VALIDATION GROUP 00920411 +C BUILDING 225 RM A266 00930411 +C GAITHERSBURG, MD 20899 00940411 +C ******************************************************************00950411 +C 00960411 +C 00970411 + IMPLICIT LOGICAL (L) 00980411 + IMPLICIT CHARACTER*14 (C) 00990411 +C 01000411 + LOGICAL LAON11, LAON21, LAON31, LCONT1, LCONF2, LVONT1, LVONF2 01010411 + LOGICAL LAON12, LAON22, LAON32, LCONT3, LCONF4, LVONT3, LVONF4 01020411 + LOGICAL LCONT5, LCONF6, LCONT7, LCONF8, LVONT5, LVONF6, LVONT7 01030411 + LOGICAL LVONF8 01040411 + DIMENSION IDUMP(80) 01050411 + DIMENSION IAON11(8), IAON21(2,4), IAON31(2,2,2) 01060411 + DIMENSION IAON12(8), IAON22(2,4), IAON32(2,2,2) 01070411 + DIMENSION RAON11(8), RAON21(2,4), RAON31(2,2,2) 01080411 + DIMENSION RAON12(8), RAON22(2,4), RAON32(2,2,2) 01090411 + DIMENSION LAON11(8), LAON21(2,4), LAON31(2,2,2) 01100411 + DIMENSION LAON12(8), LAON22(2,4), LAON32(2,2,2) 01110411 + DATA IAON11 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01120411 + DATA IAON21 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01130411 + DATA IAON31 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01140411 + DATA LAON11 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01150411 + 1 .TRUE., .FALSE./ 01160411 + DATA LAON21 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01170411 + 1 .TRUE., .FALSE./ 01180411 + DATA LAON31 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01190411 + 1 .TRUE., .FALSE./ 01200411 + DATA RAON11 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01210411 + DATA RAON21 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01220411 + DATA RAON31 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01230411 + ICON21 = 11 01240411 + ICON22 = -11 01250411 + ICON31 = +777 01260411 + ICON32 = -777 01270411 + ICON33 = 512 01280411 + ICON34 = -512 01290411 + ICON55 = -32767 01300411 + ICON56 = 32767 01310411 + RCON21 = 11. 01320411 + RCON22 = -11. 01330411 + RCON31 = +7.77 01340411 + RCON32 = -7.77 01350411 + RCON33 = .512 01360411 + RCON34 = -.512 01370411 + RCON55 = -32767. 01380411 + RCON56 = 32767. 01390411 + LCONT1 = .TRUE. 01400411 + LCONF2 = .FALSE. 01410411 + LCONT3 = .TRUE. 01420411 + LCONF4 = .FALSE. 01430411 + LCONT5 = .TRUE. 01440411 + LCONF6 = .FALSE. 01450411 + LCONT7 = .TRUE. 01460411 + LCONF8 = .FALSE. 01470411 +C 01480411 +C THE FILE USED IN THIS ROUTINE HAS THE FOLLOWING PROPERTIES 01490411 +C 01500411 +C FILE IDENTIFIER - I04 (X-NUMBER 04) 01510411 +C RECORD SIZE - 80 01520411 +C ACCESS METHOD - SEQUENTIAL 01530411 +C RECORD TYPE - UNFORMATTED 01540411 +C DESIGNATED DEVICE - DISK 01550411 +C TYPE OF DATA - INTEGER, REAL AND LOGICAL 01560411 +C RECORDS IN FILE - 142 PLUS ENDFILE RECORD 01570411 +C 01580411 +C THE FIRST 6 FIELDS OF EACH RECORD IN THE FILE UNIQUELY IDENT-01590411 +C IFIES THAT RECORD. THE REMAINING FIELDS OF THE RECORD CONTAIN 01600411 +C DATA WHICH ARE USED IN TESTING. A DESCRIPTION OF EACH FIELD 01610411 +C OF THE PREAMBLE FOLLOWS. 01620411 +C 01630411 +C VARIABLE NAME IN PROGRAM FIELD NUMBER 01640411 +C ------------------------ ------------ 01650411 +C 01660411 +C IPROG (ROUTINE NAME) - 1 01670411 +C IFILE (LOGICAL/X-NUMBER) - 2 01680411 +C ITOTR (RECORDS IN FILE) - 3 01690411 +C IRLGN (LENGTH OF RECORD) - 4 01700411 +C IRECN (RECORD NUMBER) - 5 01710411 +C IEOF (9999 IF LAST RECORD) - 6 01720411 +C 01730411 +C 01740411 +C 01750411 +C 01760411 +C INITIALIZATION SECTION. 01770411 +C 01780411 +C INITIALIZE CONSTANTS 01790411 +C ******************** 01800411 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01810411 + I01 = 5 01820411 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01830411 + I02 = 6 01840411 +C SYSTEM ENVIRONMENT SECTION 01850411 +C 01860411 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01870411 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01880411 +C (UNIT NUMBER FOR CARD READER). 01890411 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01900411 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01910411 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01920411 +C 01930411 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01940411 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01950411 +C (UNIT NUMBER FOR PRINTER). 01960411 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01970411 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01980411 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01990411 +C 02000411 + IVPASS = 0 02010411 + IVFAIL = 0 02020411 + IVDELE = 0 02030411 + ICZERO = 0 02040411 +C 02050411 +C WRITE OUT PAGE HEADERS 02060411 +C 02070411 + WRITE (I02,90002) 02080411 + WRITE (I02,90006) 02090411 + WRITE (I02,90008) 02100411 + WRITE (I02,90004) 02110411 + WRITE (I02,90010) 02120411 + WRITE (I02,90004) 02130411 + WRITE (I02,90016) 02140411 + WRITE (I02,90001) 02150411 + WRITE (I02,90004) 02160411 + WRITE (I02,90012) 02170411 + WRITE (I02,90014) 02180411 + WRITE (I02,90004) 02190411 +C 02200411 + I04 = 8 02210411 +C I04 CONTAINS THE LOGICAL UNIT NUMBER FOR A SEQUENTIAL ACCESS FILE02220411 +CX040 THIS CARD IS REPLACED BY CONTENTS OF X-040 CARD 02230411 +CX041 THIS CARD IS REPLACED BY CONTENTS OF X-041 CARD 02240411 + IPROG = 411 02250411 + IFILE = I04 02260411 + ITOTR = 142 02270411 + IRLGN = 80 02280411 + IRECN = 0 02290411 + IEOF = 0 02300411 +C 02310411 +C **** FCVS PROGRAM 411 - TEST 001 **** 02320411 +C 02330411 +C 02340411 +C TEST 001 USES THE REWIND STATEMENT ON A FILE THAT IS CONNECTED 02350411 +C BUT DOES NOT EXIST. THERE SHOULD BE NO EFFECT ON THE FILE WHEN 02360411 +C THIS STATEMENT IS EXECUTED. CONNECTION OF THE FILE TO A UNIT 02370411 +C IS ASSUMED TO BE DONE BY PRECONNECTION. 02380411 +C 02390411 +C SEE SECTION 12.10.4.3, REWIND STATEMENT 02400411 +C 02410411 +C 02420411 + IVTNUM = 1 02430411 + IF (ICZERO) 30010, 0010, 30010 02440411 + 0010 CONTINUE 02450411 + IVCORR = 1 02460411 + IVCOMP = 0 02470411 + REWIND I04 02480411 + IVCOMP = 1 02490411 +40010 IF (IVCOMP - 1) 20010, 10010, 20010 02500411 +30010 IVDELE = IVDELE + 1 02510411 + WRITE (I02,80000) IVTNUM 02520411 + IF (ICZERO) 10010, 0021, 20010 02530411 +10010 IVPASS = IVPASS + 1 02540411 + WRITE (I02,80002) IVTNUM 02550411 + GO TO 0021 02560411 +20010 IVFAIL = IVFAIL + 1 02570411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02580411 + 0021 CONTINUE 02590411 +C 02600411 +C **** FCVS PROGRAM 411 - TEST 002 **** 02610411 +C 02620411 +C 02630411 +C TEST 002 USES THE ENDFILE STATEMENT TO CREATE A FILE THAT IS 02640411 +C CONNECTED BUT DOES NOT EXIST. NO RECORDS HAVE BEEN WRITTEN TO 02650411 +C THE FILE BEFORE THE ENDFILE STATEMENT IS EXECUTED. AS IN THE 02660411 +C PRECEDING TEST, IT IS ASSUMED THAT CONNECTION OF THE FILE TO A 02670411 +C UNIT IS DONE BY PRECONNECTION. 02680411 +C 02690411 +C SEE SECTIONS 12.2.1, FILE EXISTENCE 02700411 +C 12.10.4.2, ENDFILE STATEMENT 02710411 +C 02720411 +C 02730411 + IVTNUM = 2 02740411 + IF (ICZERO) 30020, 0020, 30020 02750411 + 0020 CONTINUE 02760411 + IVCORR = 1 02770411 + IVCOMP = 0 02780411 + ENDFILE I04 02790411 + REWIND I04 02800411 + READ (I04, END = 0023) IVON01 02810411 +C 02820411 +C TO TEST CREATION OF A FILE VIA A ENDFILE STATEMENT THE FILE 02830411 +C IS REWOUND AND READ. AN END-OF-FILE CONDITION IS EXPECTED TO 02840411 +C OCCUR ON THE FIRST READ SINCE THE ONLY RECORD WRITTEN TO THE 02850411 +C FILE WAS THE ENDFILE RECORD. 02860411 +C 02870411 + IVCOMP = 0 02880411 + GO TO 40020 02890411 + 0023 IVCOMP = 1 02900411 +40020 IF (IVCOMP - 1) 20020, 10020, 20020 02910411 +30020 IVDELE = IVDELE + 1 02920411 + WRITE (I02,80000) IVTNUM 02930411 + IF (ICZERO) 10020, 0031, 20020 02940411 +10020 IVPASS = IVPASS + 1 02950411 + WRITE (I02,80002) IVTNUM 02960411 + GO TO 0031 02970411 +20020 IVFAIL = IVFAIL + 1 02980411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02990411 + 0031 CONTINUE 03000411 +C 03010411 +C 03020411 +C TESTS 003 THROUGH 019 USE A PRECONNECTED FILE FOR SEQUENTIAL 03030411 +C ACCESS TO WRITE 141 RECORDS TO THE FILE. THESE TESTS TEST USE OF 03040411 +C THE ALLOWABLE FORMS OF THE WRITE STATEMENT ON A FILE CONNECTED 03050411 +C FOR SEQUENTIAL ACCESS. THE WRITE STATEMENT IS USED WITH 03060411 +C THE I/O LIST ITEM AS A VARIABLE, ARRAY ELEMENT AND AN ARRAY. 03070411 +C THE PURPOSE OF TESTS 003 THROUGH 019 IS TO CHECK THE COMPILER'S03080411 +C ABILITY TO HANDLE THE VARIOUS STATEMENT CONSTRUCTS OF THE 03090411 +C WRITE STATEMENT. LATER TESTS WITHIN THIS ROUINE READ AND 03100411 +C CHECK THE RECORDS WHICH ARE CREATED. 03110411 +C THE VALUE IN IVCORR FOR TESTS 002 THROUGH 013 IS THE RECORD 03120411 +C NUMBER FOR THE RECORD. 03130411 +C 03140411 +C 03150411 +C 03160411 +C **** FCVS PROGRAM 411 - TEST 003 **** 03170411 +C 03180411 +C 03190411 + IVTNUM = 3 03200411 + IF (ICZERO) 30030, 0030, 30030 03210411 + 0030 CONTINUE 03220411 + REWIND I04 03230411 +C REPOSITION TO BEGINNING OF FILE 03240411 +C 03250411 +C TEST 003 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03260411 +C IS A VARIABLE OF INTEGER TYPE. 03270411 +C 03280411 + IRECN = 01 03290411 + IVCORR = 01 03300411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03310411 + 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 03320411 + IVCOMP = IRECN 03330411 +40030 IF (IVCOMP - 01) 20030, 10030, 20030 03340411 +30030 IVDELE = IVDELE + 1 03350411 + WRITE (I02,80000) IVTNUM 03360411 + IF (ICZERO) 10030, 0041, 20030 03370411 +10030 IVPASS = IVPASS + 1 03380411 + WRITE (I02,80002) IVTNUM 03390411 + GO TO 0041 03400411 +20030 IVFAIL = IVFAIL + 1 03410411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03420411 + 0041 CONTINUE 03430411 +C 03440411 +C **** FCVS PROGRAM 411 - TEST 004 **** 03450411 +C 03460411 +C 03470411 +C TEST 004 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03480411 +C IS A VARIABLE OF REAL TYPE. 03490411 +C 03500411 +C 03510411 + IVTNUM = 4 03520411 + IF (ICZERO) 30040, 0040, 30040 03530411 + 0040 CONTINUE 03540411 + IRECN = 02 03550411 + IVCORR = 02 03560411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03570411 + 1 RCON21, RCON22, RCON31, RCON32, RCON33, RCON34, RCON55, RCON56 03580411 + IVCOMP = IRECN 03590411 +40040 IF (IVCOMP - 02) 20040, 10040, 20040 03600411 +30040 IVDELE = IVDELE + 1 03610411 + WRITE (I02,80000) IVTNUM 03620411 + IF (ICZERO) 10040, 0051, 20040 03630411 +10040 IVPASS = IVPASS + 1 03640411 + WRITE (I02,80002) IVTNUM 03650411 + GO TO 0051 03660411 +20040 IVFAIL = IVFAIL + 1 03670411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03680411 + 0051 CONTINUE 03690411 +C 03700411 +C **** FCVS PROGRAM 411 - TEST 005 **** 03710411 +C 03720411 +C 03730411 +C TEST 005 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03740411 +C IS A VARIABLE OF LOGICAL TYPE. 03750411 +C 03760411 +C 03770411 + IVTNUM = 5 03780411 + IF (ICZERO) 30050, 0050, 30050 03790411 + 0050 CONTINUE 03800411 + IRECN = 03 03810411 + IVCORR = 03 03820411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03830411 + 1 LCONT1, LCONF2, LCONT3, LCONF4, LCONT5, LCONF6, LCONT7, LCONF803840411 + IVCOMP = IRECN 03850411 +40050 IF (IVCOMP - 03) 20050, 10050, 20050 03860411 +30050 IVDELE = IVDELE + 1 03870411 + WRITE (I02,80000) IVTNUM 03880411 + IF (ICZERO) 10050, 0061, 20050 03890411 +10050 IVPASS = IVPASS + 1 03900411 + WRITE (I02,80002) IVTNUM 03910411 + GO TO 0061 03920411 +20050 IVFAIL = IVFAIL + 1 03930411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03940411 + 0061 CONTINUE 03950411 +C 03960411 +C **** FCVS PROGRAM 411 - TEST 006 **** 03970411 +C 03980411 +C 03990411 +C TEST 006 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04000411 +C IS AN ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO AND THREE 04010411 +C DIMENSION ARRAYS ARE USED. 04020411 +C 04030411 +C 04040411 + IVTNUM = 6 04050411 + IF (ICZERO) 30060, 0060, 30060 04060411 + 0060 CONTINUE 04070411 + IRECN = 04 04080411 + IVCORR = 04 04090411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04100411 + 1 IAON11(1), IAON11(2), IAON21(1,2), IAON21(2,2), IAON31(1,1,2), 04110411 + 2 IAON31(2,1,2), IAON11(7), IAON11(8) 04120411 + IVCOMP = IRECN 04130411 +40060 IF (IVCOMP - 04) 20060, 10060, 20060 04140411 +30060 IVDELE = IVDELE + 1 04150411 + WRITE (I02,80000) IVTNUM 04160411 + IF (ICZERO) 10060, 0071, 20060 04170411 +10060 IVPASS = IVPASS + 1 04180411 + WRITE (I02,80002) IVTNUM 04190411 + GO TO 0071 04200411 +20060 IVFAIL = IVFAIL + 1 04210411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04220411 + 0071 CONTINUE 04230411 +C 04240411 +C **** FCVS PROGRAM 411 - TEST 007 **** 04250411 +C 04260411 +C 04270411 +C TEST 007 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04280411 +C IS AN ARRAY ELEMENT OF REAL TYPE. ONE, TWO AND THREE 04290411 +C DIMENSION ARRAYS ARE USED. 04300411 +C 04310411 +C 04320411 + IVTNUM = 7 04330411 + IF (ICZERO) 30070, 0070, 30070 04340411 + 0070 CONTINUE 04350411 + IRECN = 05 04360411 + IVCORR = 05 04370411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04380411 + 1 RAON11(1), RAON11(2), RAON21(1,2), RAON21(2,2), RAON31(1,1,2), 04390411 + 2RAON31(2,1,2), RAON11(7), RAON11 (8) 04400411 + IVCOMP = IRECN 04410411 +40070 IF (IVCOMP - 05) 20070, 10070, 20070 04420411 +30070 IVDELE = IVDELE + 1 04430411 + WRITE (I02,80000) IVTNUM 04440411 + IF (ICZERO) 10070, 0081, 20070 04450411 +10070 IVPASS = IVPASS + 1 04460411 + WRITE (I02,80002) IVTNUM 04470411 + GO TO 0081 04480411 +20070 IVFAIL = IVFAIL + 1 04490411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04500411 + 0081 CONTINUE 04510411 +C 04520411 +C **** FCVS PROGRAM 411 - TEST 008 **** 04530411 +C 04540411 +C 04550411 +C 04560411 + IVTNUM = 8 04570411 + IF (ICZERO) 30080, 0080, 30080 04580411 + 0080 CONTINUE 04590411 + IRECN = 06 04600411 + IVCORR = 06 04610411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04620411 + 1 LAON11(1), LAON11(2), LAON21(1,2), LAON21(2,2), LAON31(1,1,2), 04630411 + 2 LAON31(2,1,2), LAON11(7), LAON11(8) 04640411 + IVCOMP = IRECN 04650411 +40080 IF (IVCOMP - 06) 20080, 10080, 20080 04660411 +30080 IVDELE = IVDELE + 1 04670411 + WRITE (I02,80000) IVTNUM 04680411 + IF (ICZERO) 10080, 0091, 20080 04690411 +10080 IVPASS = IVPASS + 1 04700411 + WRITE (I02,80002) IVTNUM 04710411 + GO TO 0091 04720411 +20080 IVFAIL = IVFAIL + 1 04730411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04740411 + 0091 CONTINUE 04750411 +C 04760411 +C **** FCVS PROGRAM 411 - TEST 009 **** 04770411 +C 04780411 +C 04790411 +C TEST 009 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04800411 +C IS AN ARRAY OF INTEGER TYPE. 04810411 +C 04820411 +C 04830411 + IVTNUM = 9 04840411 + IF (ICZERO) 30090, 0090, 30090 04850411 + 0090 CONTINUE 04860411 + IRECN = 07 04870411 + IVCORR = 07 04880411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04890411 + 1 IAON31 04900411 + IVCOMP = IRECN 04910411 +40090 IF (IVCOMP - 07) 20090, 10090, 20090 04920411 +30090 IVDELE = IVDELE + 1 04930411 + WRITE (I02,80000) IVTNUM 04940411 + IF (ICZERO) 10090, 0101, 20090 04950411 +10090 IVPASS = IVPASS + 1 04960411 + WRITE (I02,80002) IVTNUM 04970411 + GO TO 0101 04980411 +20090 IVFAIL = IVFAIL + 1 04990411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05000411 + 0101 CONTINUE 05010411 +C 05020411 +C **** FCVS PROGRAM 411 - TEST 010 **** 05030411 +C 05040411 +C 05050411 +C TEST 010 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05060411 +C IS AN ARRAY OF REAL TYPE. 05070411 +C 05080411 +C 05090411 + IVTNUM = 10 05100411 + IF (ICZERO) 30100, 0100, 30100 05110411 + 0100 CONTINUE 05120411 + IRECN = 08 05130411 + IVCORR = 08 05140411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05150411 + 1 RAON31 05160411 + IVCOMP = IRECN 05170411 +40100 IF (IVCOMP - 08) 20100, 10100, 20100 05180411 +30100 IVDELE = IVDELE + 1 05190411 + WRITE (I02,80000) IVTNUM 05200411 + IF (ICZERO) 10100, 0111, 20100 05210411 +10100 IVPASS = IVPASS + 1 05220411 + WRITE (I02,80002) IVTNUM 05230411 + GO TO 0111 05240411 +20100 IVFAIL = IVFAIL + 1 05250411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05260411 + 0111 CONTINUE 05270411 +C 05280411 +C **** FCVS PROGRAM 411 - TEST 011 **** 05290411 +C 05300411 +C 05310411 +C TEST 011 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05320411 +C IS AN ARRAY OF LOGICAL TYPE. 05330411 +C 05340411 +C 05350411 + IVTNUM = 11 05360411 + IF (ICZERO) 30110, 0110, 30110 05370411 + 0110 CONTINUE 05380411 + IRECN = 09 05390411 + IVCORR = 09 05400411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05410411 + 1 LAON31 05420411 + IVCOMP = IRECN 05430411 +40110 IF (IVCOMP - 09) 20110, 10110, 20110 05440411 +30110 IVDELE = IVDELE + 1 05450411 + WRITE (I02,80000) IVTNUM 05460411 + IF (ICZERO) 10110, 0121, 20110 05470411 +10110 IVPASS = IVPASS + 1 05480411 + WRITE (I02,80002) IVTNUM 05490411 + GO TO 0121 05500411 +20110 IVFAIL = IVFAIL + 1 05510411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05520411 + 0121 CONTINUE 05530411 +C 05540411 +C **** FCVS PROGRAM 411 - TEST 012 **** 05550411 +C 05560411 +C 05570411 +C TEST 012 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05580411 +C IS AN IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. 05590411 +C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE 05600411 +C ELEMENT SEQUENCE OF ARRAY IAON31. THE SEQUENCE OF VALUES WRITTEN 05610411 +C IN THE RECORD ARE 11, 512, 777, -32767, -11, -512, -777, 32767. 05620411 +C 05630411 +C 05640411 + IVTNUM = 12 05650411 + IF (ICZERO) 30120, 0120, 30120 05660411 + 0120 CONTINUE 05670411 + IRECN = 10 05680411 + IVCORR = 10 05690411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05700411 + 1 (((IAON31 (J,K,I), I=1,2), K=1,2), J=1,2) 05710411 + IVCOMP = IRECN 05720411 +40120 IF (IVCOMP - 10) 20120, 10120, 20120 05730411 +30120 IVDELE = IVDELE + 1 05740411 + WRITE (I02,80000) IVTNUM 05750411 + IF (ICZERO) 10120, 0131, 20120 05760411 +10120 IVPASS = IVPASS + 1 05770411 + WRITE (I02,80002) IVTNUM 05780411 + GO TO 0131 05790411 +20120 IVFAIL = IVFAIL + 1 05800411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05810411 + 0131 CONTINUE 05820411 +C 05830411 +C **** FCVS PROGRAM 411 - TEST 013 **** 05840411 +C 05850411 +C 05860411 +C TEST 013 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05870411 +C IS AN IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE FIELD VALUES 05880411 +C (IN FIELD POSITION ORDER) WRITTEN IN THE RECORD ARE 11., -11., 05890411 +C 7.77, -7.77, .512, -.512, -32767., 32767. 05900411 +C 05910411 +C 05920411 + IVTNUM = 13 05930411 + IF (ICZERO) 30130, 0130, 30130 05940411 + 0130 CONTINUE 05950411 + IRECN = 11 05960411 + IVCORR = 11 05970411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05980411 + 1 (((RAON31 (J,K,I), J=1,2), K=1,2), I=1,2) 05990411 + IVCOMP = IRECN 06000411 +40130 IF (IVCOMP - 11) 20130, 10130, 20130 06010411 +30130 IVDELE = IVDELE + 1 06020411 + WRITE (I02,80000) IVTNUM 06030411 + IF (ICZERO) 10130, 0141, 20130 06040411 +10130 IVPASS = IVPASS + 1 06050411 + WRITE (I02,80002) IVTNUM 06060411 + GO TO 0141 06070411 +20130 IVFAIL = IVFAIL + 1 06080411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06090411 + 0141 CONTINUE 06100411 +C 06110411 +C **** FCVS PROGRAM 411 - TEST 014 **** 06120411 +C 06130411 +C 06140411 +C TEST 014 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 06150411 +C IS AN IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. 06160411 +C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER (AN ORDER 06170411 +C DIFFERENT THAN TEST 012 ABOVE) VIS-A-VIS THE 06180411 +C ELEMENT SEQUENCE OF ARRAY LAON31. THE SEQUENCE OF VALUES WRITTEN 06190411 +C IN THE RECORD ARE .TRUE., .TRUE., .FALSE., .FALSE., .TRUE., .TRUE.06200411 +C .FALSE, .FALSE. 06210411 +C 06220411 +C 06230411 + IVTNUM = 14 06240411 + IF (ICZERO) 30140, 0140, 30140 06250411 + 0140 CONTINUE 06260411 + IRECN = 12 06270411 + IVCORR = 12 06280411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 06290411 + 1 (((LAON31 (J,K,I), K=1,2), J=1,2), I=1,2) 06300411 + IVCOMP = IRECN 06310411 +40140 IF (IVCOMP - 12) 20140, 10140, 20140 06320411 +30140 IVDELE = IVDELE + 1 06330411 + WRITE (I02,80000) IVTNUM 06340411 + IF (ICZERO) 10140, 0151, 20140 06350411 +10140 IVPASS = IVPASS + 1 06360411 + WRITE (I02,80002) IVTNUM 06370411 + GO TO 0151 06380411 +20140 IVFAIL = IVFAIL + 1 06390411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06400411 + 0151 CONTINUE 06410411 +C 06420411 +C **** FCVS PROGRAM 411 - TEST 015 **** 06430411 +C 06440411 +C 06450411 +C TEST 015 USES A WRITE STATEMENT WITHOUT ANY OUTPUT LIST ITEMS. 06460411 +C THE OUTPUT LIST ITEMS ARE OPTIONAL. 06470411 +C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. 06480411 +C 06490411 +C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS 06500411 +C 12.8, READ, WRITE AND PRINT STATEMENTS 06510411 +C 06520411 +C 06530411 + IVTNUM = 15 06540411 + IF (ICZERO) 30150, 0150, 30150 06550411 + 0150 CONTINUE 06560411 + IRECN = 13 06570411 + IVCORR = 13 06580411 + WRITE (I04) 06590411 + IVCOMP = IRECN 06600411 +40150 IF (IVCOMP - 13) 20150, 10150, 20150 06610411 +30150 IVDELE = IVDELE + 1 06620411 + WRITE (I02,80000) IVTNUM 06630411 + IF (ICZERO) 10150, 0161, 20150 06640411 +10150 IVPASS = IVPASS + 1 06650411 + WRITE (I02,80002) IVTNUM 06660411 + GO TO 0161 06670411 +20150 IVFAIL = IVFAIL + 1 06680411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06690411 + 0161 CONTINUE 06700411 +C 06710411 +C **** FCVS PROGRAM 411 - TEST 016 **** 06720411 +C 06730411 +C 06740411 +C TEST 016 IS SIMILAR TO THE PREVIOUS TEST EXCEPT THE WRITE 06750411 +C STATEMENT CONTAINS OUTPUT LIST ITEMS. ONE HUNDRED RECORDS ARE 06760411 +C WRITTEN. 06770411 +C 06780411 +C 06790411 + IVTNUM = 16 06800411 + IF (ICZERO) 30160, 0160, 30160 06810411 + 0160 CONTINUE 06820411 + IRECN = 13 06830411 + DO 4132 I = 1,100 06840411 + IRECN = IRECN + 1 06850411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 06860411 + 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 06870411 + 4132 CONTINUE 06880411 + IVCORR = 100 06890411 + IVCOMP = IRECN - 13 06900411 +40160 IF (IVCOMP - 100) 20160, 10160, 20160 06910411 +30160 IVDELE = IVDELE + 1 06920411 + WRITE (I02,80000) IVTNUM 06930411 + IF (ICZERO) 10160, 0171, 20160 06940411 +10160 IVPASS = IVPASS + 1 06950411 + WRITE (I02,80002) IVTNUM 06960411 + GO TO 0171 06970411 +20160 IVFAIL = IVFAIL + 1 06980411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06990411 + 0171 CONTINUE 07000411 +C 07010411 +C 07020411 +C THE NEXT THREE TESTS TEST USE OF THE BACKSPACE AND ENDFILE 07030411 +C STATEMENTS 07040411 +C 07050411 +C 07060411 +C 07070411 +C **** FCVS PROGRAM 411 - TEST 017 **** 07080411 +C 07090411 +C TEST 017 USES AN ENDFILE STATEMENT TO WRITE AN ENDFILE 07100411 +C RECORD TO A FILE WITH UNFORMATTED RECORDS. AFTER EXECUTION 07110411 +C OF THIS STATEMENT THE FILE SHOULD BE POSITION AFTER THE ENDFILE 07120411 +C RECORD. 07130411 +C 07140411 +C 07150411 + IVTNUM = 17 07160411 + IF (ICZERO) 30170, 0170, 30170 07170411 + 0170 CONTINUE 07180411 + IVCORR = 1 07190411 + IVCOMP = 0 07200411 + 0172 ENDFILE I04 07210411 + IVCOMP = 1 07220411 +40170 IF (IVCOMP - 1) 20170, 10170, 20170 07230411 +C 07240411 +30170 IVDELE = IVDELE + 1 07250411 + WRITE (I02,80000) IVTNUM 07260411 + IF (ICZERO) 10170, 0181, 20170 07270411 +10170 IVPASS = IVPASS + 1 07280411 + WRITE (I02,80002) IVTNUM 07290411 + GO TO 0181 07300411 +20170 IVFAIL = IVFAIL + 1 07310411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07320411 + 0181 CONTINUE 07330411 +C 07340411 +C **** FCVS PROGRAM 411 - TEST 018 **** 07350411 +C 07360411 +C 07370411 +C TEST 018 USES THE BACKSPACE STATEMENT TO REPOSITION THE FILE 07380411 +C BEFORE THE ENDFILE RECORD. 07390411 +C 07400411 +C SEE SECTIONS 12.10.4.1, BACKSPACE STATEMENT 07410411 +C 12.10.4.2, ENDFILE STATEMENT 07420411 +C 07430411 +C 07440411 + IVTNUM = 18 07450411 + IF (ICZERO) 30180, 0180, 30180 07460411 + 0180 CONTINUE 07470411 + IVCORR = 1 07480411 + IVCOMP = 0 07490411 + BACKSPACE I04 07500411 + IVCOMP = 1 07510411 +40180 IF (IVCOMP - 1) 20180, 10180, 20180 07520411 +30180 IVDELE = IVDELE + 1 07530411 + WRITE (I02,80000) IVTNUM 07540411 + IF (ICZERO) 10180, 0191, 20180 07550411 +10180 IVPASS = IVPASS + 1 07560411 + WRITE (I02,80002) IVTNUM 07570411 + GO TO 0191 07580411 +20180 IVFAIL = IVFAIL + 1 07590411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07600411 + 0191 CONTINUE 07610411 +C 07620411 +C **** FCVS PROGRAM 411 - TEST 019 **** 07630411 +C 07640411 +C 07650411 +C TEST 019 IS A CONTINUATION OF THE ENDFILE AND BACKSPACE TESTS 07660411 +C (TWO PREVIOUS TESTS). THIS TEST CONTINUES WRITTING RECORDS TO THE07670411 +C FILE OVER THE ENDFILE RECORD PREVIOUSLY WRITTEN IN TEST 017. 07680411 +C TWENTY EIGHT RECORDS ARE WRITTEN TO THE FILE FOLLOWED BY AN 07690411 +C ENDFILE. 07700411 +C 07710411 +C 07720411 + IVTNUM = 19 07730411 + IF (ICZERO) 30190, 0190, 30190 07740411 + 0190 CONTINUE 07750411 + IVCOMP = 0 07760411 + IRECN = 113 07770411 + DO 4112 I = 1,28 07780411 + IRECN = IRECN + 1 07790411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 07800411 + 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 07810411 + IVCOMP = IVCOMP + 1 07820411 + 4112 CONTINUE 07830411 + IVCORR = 29 07840411 + IEOF = 9999 07850411 + IRECN = IRECN + 1 07860411 + WRITE (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF 07870411 + IVCOMP = IVCOMP + 1 07880411 + ENDFILE I04 07890411 +C 07900411 +C THERE SHOULD BE A TOTAL OF 142 RECORDS PLUS AN ENDFILE RECORD 07910411 +C IN THE FILE AFTER EXECUTION OF THIS TEST. 07920411 +C 07930411 +40190 IF (IVCOMP - 29) 20190, 10190, 20190 07940411 +30190 IVDELE = IVDELE + 1 07950411 + WRITE (I02,80000) IVTNUM 07960411 + IF (ICZERO) 10190, 0201, 20190 07970411 +10190 IVPASS = IVPASS + 1 07980411 + WRITE (I02,80002) IVTNUM 07990411 + GO TO 0201 08000411 +20190 IVFAIL = IVFAIL + 1 08010411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08020411 + 0201 CONTINUE 08030411 +C 08040411 +C 08050411 +C THE NEXT SERIES OF TESTS READ AND CHECK THE RECORDS CREATED IN 08060411 +C TESTS 03 THROUGH 019. EACH OF THE TESTS IN THIS SET IS CHECKING 08070411 +C TWO THINGS. FIRST, THAT THE READ STATEMENT CONSTRUCT IS ACCEPTED 08080411 +C BY THE COMPILER AND SECOND THAT THE RECORDS CREATED IN TESTS 003 08090411 +C THROUGH 019 AND READ IN THESE TESTS CAN GIVE PREDICTIBLE VALUES. 08100411 +C THE READ STATEMENT IS USED WITH THE I/O LIST ITEMS AS A VARIABLE, 08110411 +C AN ARRAY ELEMENT AND AN ARRAY. 08120411 +C 08130411 +C 08140411 +C 08150411 +C **** FCVS PROGRAM 411 - TEST 020 **** 08160411 +C 08170411 +C 08180411 +C TEST 020 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08190411 +C VARIABLE OF INTEGER TYPE. 08200411 +C 08210411 +C 08220411 + IVTNUM = 20 08230411 + IF (ICZERO) 30200, 0200, 30200 08240411 + 0200 CONTINUE 08250411 + REWIND I04 08260411 +C REPOSITION THE FILE TO THE FIRST RECORD 08270411 + IVON22 = 0 08280411 + IVON56 = 0 08290411 + IVCORR = 30 08300411 + IVCOMP = 1 08310411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08320411 + 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 08330411 + IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 08340411 + IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 3 08350411 + IF (IVON56 .EQ. 32767) IVCOMP = IVCOMP * 5 08360411 +40200 IF (IVCOMP - 30) 20200, 10200, 20200 08370411 +30200 IVDELE = IVDELE + 1 08380411 + WRITE (I02,80000) IVTNUM 08390411 + IF (ICZERO) 10200, 0211, 20200 08400411 +10200 IVPASS = IVPASS + 1 08410411 + WRITE (I02,80002) IVTNUM 08420411 + GO TO 0211 08430411 +20200 IVFAIL = IVFAIL + 1 08440411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08450411 + 0211 CONTINUE 08460411 +C 08470411 +C **** FCVS PROGRAM 411 - TEST 021 **** 08480411 +C 08490411 +C 08500411 +C TEST 021 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08510411 +C VARIABLE OF REAL TYPE. 08520411 +C 08530411 +C 08540411 + IVTNUM = 21 08550411 + IF (ICZERO) 30210, 0210, 30210 08560411 + 0210 CONTINUE 08570411 + RVON22 = 0.0 08580411 + RVON31 = 0.0 08590411 + IVCORR = 30 08600411 + IVCOMP = 1 08610411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08620411 + 1 RVON21, RVON22, RVON31, RVON32, RVON33, RVON34, RVON55, RVON56 08630411 + IF (IRECN .EQ. 02) IVCOMP = IVCOMP * 2 08640411 + IF (RVON22 .EQ. -11.) IVCOMP = IVCOMP * 3 08650411 + IF (RVON31 .EQ. 7.77) IVCOMP = IVCOMP * 5 08660411 +40210 IF (IVCOMP - 30) 20210, 10210, 20210 08670411 +30210 IVDELE = IVDELE + 1 08680411 + WRITE (I02,80000) IVTNUM 08690411 + IF (ICZERO) 10210, 0221, 20210 08700411 +10210 IVPASS = IVPASS + 1 08710411 + WRITE (I02,80002) IVTNUM 08720411 + GO TO 0221 08730411 +20210 IVFAIL = IVFAIL + 1 08740411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08750411 + 0221 CONTINUE 08760411 +C 08770411 +C **** FCVS PROGRAM 411 - TEST 022 **** 08780411 +C 08790411 +C 08800411 +C TEST 022 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08810411 +C VARIABLE OF LOGICAL TYPE. 08820411 +C 08830411 +C 08840411 + IVTNUM = 22 08850411 + IF (ICZERO) 30220, 0220, 30220 08860411 + 0220 CONTINUE 08870411 + LVONT1 = .FALSE. 08880411 + LVONF6 = .TRUE. 08890411 + IVCORR = 30 08900411 + IVCOMP = 1 08910411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08920411 + 1 LVONT1, LVONF2, LVONT3, LVONF4, LVONT5, LVONF6, LVONT7, LVONF808930411 + IF (IRECN .EQ. 03) IVCOMP = IVCOMP * 2 08940411 + IF (.NOT. LVONF6) IVCOMP = IVCOMP * 3 08950411 + IF (LVONT1) IVCOMP = IVCOMP * 5 08960411 +40220 IF (IVCOMP - 30) 20220, 10220, 20220 08970411 +30220 IVDELE = IVDELE + 1 08980411 + WRITE (I02,80000) IVTNUM 08990411 + IF (ICZERO) 10220, 0231, 20220 09000411 +10220 IVPASS = IVPASS + 1 09010411 + WRITE (I02,80002) IVTNUM 09020411 + GO TO 0231 09030411 +20220 IVFAIL = IVFAIL + 1 09040411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09050411 + 0231 CONTINUE 09060411 +C 09070411 +C **** FCVS PROGRAM 411 - TEST 023 **** 09080411 +C 09090411 +C 09100411 +C TEST 023 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09110411 +C ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO, AND THREE 09120411 +C DIMENSION ARRAYS ARE USED. 09130411 +C 09140411 +C 09150411 + IVTNUM = 23 09160411 + IF (ICZERO) 30230, 0230, 30230 09170411 + 0230 CONTINUE 09180411 + IAON12(2) = 0 09190411 + IAON12(8) = 0 09200411 + IVCORR = 30 09210411 + IVCOMP = 1 09220411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09230411 + 1 IAON12(1), IAON12(2), IAON22(1,2), IAON22(2,2), IAON32(1,1,2), 09240411 + 2 IAON32(2,1,2), IAON12(7), IAON12(8) 09250411 + IF (IRECN .EQ. 04) IVCOMP = IVCOMP * 2 09260411 + IF (IAON12(2) .EQ. -11) IVCOMP = IVCOMP * 3 09270411 + IF (IAON12(8) .EQ. 32767) IVCOMP = IVCOMP * 5 09280411 +C 09290411 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 09300411 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 09310411 +C 09320411 +40230 IF (IVCOMP - 30) 20230, 10230, 20230 09330411 +30230 IVDELE = IVDELE + 1 09340411 + WRITE (I02,80000) IVTNUM 09350411 + IF (ICZERO) 10230, 0241, 20230 09360411 +10230 IVPASS = IVPASS + 1 09370411 + WRITE (I02,80002) IVTNUM 09380411 + GO TO 0241 09390411 +20230 IVFAIL = IVFAIL + 1 09400411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09410411 + 0241 CONTINUE 09420411 +C 09430411 +C **** FCVS PROGRAM 411 - TEST 024 **** 09440411 +C 09450411 +C 09460411 +C TEST 024 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09470411 +C ARRAY ELEMENT OF REAL TYPE. ONE, TWO, AND THREE 09480411 +C DIMENSION ARRAYS ARE USED. 09490411 +C 09500411 +C 09510411 + IVTNUM = 24 09520411 + IF (ICZERO) 30240, 0240, 30240 09530411 + 0240 CONTINUE 09540411 + RAON22(2,2) = 0.0 09550411 + RAON32(1,1,2) = 0.0 09560411 + IVCORR = 30 09570411 + IVCOMP = 1 09580411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09590411 + 1 RAON12(1), RAON12(2), RAON22(1,2), RAON22(2,2), RAON32(1,1,2), 09600411 + 2 RAON32(2,1,2), RAON12(7), RAON12(8) 09610411 + IF (IRECN .EQ. 05) IVCOMP = IVCOMP * 2 09620411 + IF (RAON22(2,2) .EQ. -7.77) IVCOMP = IVCOMP * 3 09630411 + IF (RAON32(1,1,2) .EQ. .512 ) IVCOMP = IVCOMP * 5 09640411 +C 09650411 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 09660411 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 09670411 +C 09680411 +40240 IF (IVCOMP - 30) 20240, 10240, 20240 09690411 +30240 IVDELE = IVDELE + 1 09700411 + WRITE (I02,80000) IVTNUM 09710411 + IF (ICZERO) 10240, 0251, 20240 09720411 +10240 IVPASS = IVPASS + 1 09730411 + WRITE (I02,80002) IVTNUM 09740411 + GO TO 0251 09750411 +20240 IVFAIL = IVFAIL + 1 09760411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09770411 + 0251 CONTINUE 09780411 +C 09790411 +C **** FCVS PROGRAM 411 - TEST 025 **** 09800411 +C 09810411 +C 09820411 +C TEST 025 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09830411 +C ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO, AND THREE 09840411 +C DIMENSION ARRAYS ARE USED. 09850411 +C 09860411 +C 09870411 +C 09880411 + IVTNUM = 25 09890411 + IF (ICZERO) 30250, 0250, 30250 09900411 + 0250 CONTINUE 09910411 + LAON12(1) = .FALSE. 09920411 + LAON32(2,1,2) = .TRUE. 09930411 + IVCORR = 30 09940411 + IVCOMP = 1 09950411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09960411 + 1 LAON12(1), LAON12(2), LAON22(1,2), LAON22(2,2), LAON32(1,1,2), 09970411 + 2 LAON32(2,1,2), LAON12(7), LAON12(8) 09980411 + IF (IRECN .EQ. 06) IVCOMP = IVCOMP * 2 09990411 + IF (LAON12(1)) IVCOMP = IVCOMP * 3 10000411 + IF (.NOT. LAON32(2,1,2)) IVCOMP = IVCOMP * 5 10010411 +40250 IF (IVCOMP - 30) 20250, 10250, 20250 10020411 +30250 IVDELE = IVDELE + 1 10030411 + WRITE (I02,80000) IVTNUM 10040411 + IF (ICZERO) 10250, 0261, 20250 10050411 +10250 IVPASS = IVPASS + 1 10060411 + WRITE (I02,80002) IVTNUM 10070411 + GO TO 0261 10080411 +20250 IVFAIL = IVFAIL + 1 10090411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10100411 + 0261 CONTINUE 10110411 +C 10120411 +C **** FCVS PROGRAM 411 - TEST 026 **** 10130411 +C 10140411 +C 10150411 +C TEST 026 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10160411 +C ARRAY OF INTEGER TYPE. 10170411 +C 10180411 +C 10190411 + IVTNUM = 26 10200411 + IF (ICZERO) 30260, 0260, 30260 10210411 + 0260 CONTINUE 10220411 + IAON32(2,1,1) = 0 10230411 + IAON32(2,2,2) = 0 10240411 + IVCORR = 30 10250411 + IVCOMP = 1 10260411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10270411 + 1 IAON32 10280411 + IF (IRECN .EQ. 07) IVCOMP = IVCOMP * 2 10290411 + IF (IAON32(2,1,1) .EQ. -11) IVCOMP = IVCOMP * 3 10300411 + IF (IAON32(2,2,2) .EQ. 32767) IVCOMP = IVCOMP * 5 10310411 +C 10320411 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 10330411 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 10340411 +C 10350411 +40260 IF (IVCOMP - 30) 20260, 10260, 20260 10360411 +30260 IVDELE = IVDELE + 1 10370411 + WRITE (I02,80000) IVTNUM 10380411 + IF (ICZERO) 10260, 0271, 20260 10390411 +10260 IVPASS = IVPASS + 1 10400411 + WRITE (I02,80002) IVTNUM 10410411 + GO TO 0271 10420411 +20260 IVFAIL = IVFAIL + 1 10430411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10440411 + 0271 CONTINUE 10450411 +C 10460411 +C **** FCVS PROGRAM 411 - TEST 027 **** 10470411 +C 10480411 +C 10490411 +C TEST 027 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10500411 +C ARRAY OF REAL TYPE. 10510411 +C 10520411 +C 10530411 + IVTNUM = 27 10540411 + IF (ICZERO) 30270, 0270, 30270 10550411 + 0270 CONTINUE 10560411 + RAON32(2,1,1) = 0.0 10570411 + RAON32(2,2,2) = 0.0 10580411 + IVCORR = 30 10590411 + IVCOMP = 1 10600411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10610411 + 1 RAON32 10620411 + IF (IRECN .EQ. 08) IVCOMP = IVCOMP * 2 10630411 + IF (RAON32(2,1,1) .EQ. -11.) IVCOMP = IVCOMP * 3 10640411 + IF (RAON32(2,2,2) .EQ. 32767.) IVCOMP = IVCOMP * 5 10650411 +C 10660411 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 10670411 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 10680411 +C 10690411 +40270 IF (IVCOMP - 30) 20270, 10270, 20270 10700411 +30270 IVDELE = IVDELE + 1 10710411 + WRITE (I02,80000) IVTNUM 10720411 + IF (ICZERO) 10270, 0281, 20270 10730411 +10270 IVPASS = IVPASS + 1 10740411 + WRITE (I02,80002) IVTNUM 10750411 + GO TO 0281 10760411 +20270 IVFAIL = IVFAIL + 1 10770411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10780411 + 0281 CONTINUE 10790411 +C 10800411 +C **** FCVS PROGRAM 411 - TEST 028 **** 10810411 +C 10820411 +C 10830411 +C TEST 028 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10840411 +C ARRAY OF LOGICAL TYPE. 10850411 +C 10860411 +C 10870411 + IVTNUM = 28 10880411 + IF (ICZERO) 30280, 0280, 30280 10890411 + 0280 CONTINUE 10900411 + LAON32(1,1,1) = .FALSE. 10910411 + LAON32(2,2,2) = .TRUE. 10920411 + IVCORR = 30 10930411 + IVCOMP = 1 10940411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10950411 + 1 LAON32 10960411 + IF (IRECN .EQ. 09) IVCOMP = IVCOMP * 2 10970411 + IF (LAON32(1,1,1)) IVCOMP = IVCOMP * 3 10980411 + IF (.NOT. LAON32(2,2,2)) IVCOMP = IVCOMP * 5 10990411 +40280 IF (IVCOMP - 30) 20280, 10280, 20280 11000411 +30280 IVDELE = IVDELE + 1 11010411 + WRITE (I02,80000) IVTNUM 11020411 + IF (ICZERO) 10280, 0291, 20280 11030411 +10280 IVPASS = IVPASS + 1 11040411 + WRITE (I02,80002) IVTNUM 11050411 + GO TO 0291 11060411 +20280 IVFAIL = IVFAIL + 1 11070411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11080411 + 0291 CONTINUE 11090411 +C 11100411 +C **** FCVS PROGRAM 411 - TEST 029 **** 11110411 +C 11120411 +C 11130411 +C TEST 029 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 11140411 +C IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. THE STORAGE VALUES IN 11150411 +C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 11160411 +C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD 11170411 +C OF THE FILE. THIS RECORD IS RECORD NUMBER 10 AND WAS CREATED IN 11180411 +C TEST 012 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN 11190411 +C ARRAY IAON32 AND SUBSCRIPT VALUE AFTER THE READ IS 11200411 +C 11210411 +C VALUE 11 777 512 -32767 -11 -777 -512 32767 11220411 +C FIELD POS 1 3 2 4 5 7 6 8 11230411 +C IAON32 1 2 3 4 5 6 7 8 11240411 +C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,211250411 +C 11260411 +C 11270411 + IVTNUM = 29 11280411 + IF (ICZERO) 30290, 0290, 30290 11290411 + 0290 CONTINUE 11300411 + IAON32(2,1,1) = 0 11310411 + IAON32(2,2,1) = 0 11320411 + IVCORR = 30 11330411 + IVCOMP = 1 11340411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 11350411 + 1 (((IAON32 (J,K,I), K=1,2), J=1,2), I=1,2) 11360411 + IF (IRECN .EQ. 10) IVCOMP = IVCOMP * 2 11370411 + IF (IAON32(2,1,1) .EQ. 777) IVCOMP = IVCOMP * 3 11380411 + IF (IAON32(2,2,1) .EQ. -32767) IVCOMP = IVCOMP * 5 11390411 +C 11400411 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 11410411 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 11420411 +C 11430411 +40290 IF (IVCOMP - 30) 20290, 10290, 20290 11440411 +30290 IVDELE = IVDELE + 1 11450411 + WRITE (I02,80000) IVTNUM 11460411 + IF (ICZERO) 10290, 0301, 20290 11470411 +10290 IVPASS = IVPASS + 1 11480411 + WRITE (I02,80002) IVTNUM 11490411 + GO TO 0301 11500411 +20290 IVFAIL = IVFAIL + 1 11510411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11520411 + 0301 CONTINUE 11530411 +C 11540411 +C **** FCVS PROGRAM 411 - TEST 030 **** 11550411 +C 11560411 +C 11570411 +C TEST 030 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 11580411 +C IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE STORAGE VALUES IN 11590411 +C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 11600411 +C SEQUENCE THE SAME AS FOUND IN THE RECORD OF THE FILE. THIS REC- 11610411 +C ORD IS RECORD NUMBER 011 AND WAS CREATED IN TEST 013 ABOVE. 11620411 +C THE FIELD VALUE, FIELD POSITION, POSITION WITHIN ARRAY RAON32 AND11630411 +C SUBSCRIPT VALUE AFTER THE THE READ IS 11640411 +C 11650411 +C VALUE 11. -11. 7.77 -7.77 .512 -.512 -32767. 32767.11660411 +C FIELD POS 1 2 3 4 5 6 7 8 11670411 +C RAON32 1 2 3 4 5 6 7 8 11680411 +C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,211690411 +C 11700411 +C 11710411 + IVTNUM = 30 11720411 + IF (ICZERO) 30300, 0300, 30300 11730411 + 0300 CONTINUE 11740411 + RAON32(1,2,1) = 0.0 11750411 + RAON32(1,2,2) = 0.0 11760411 + IVCORR = 30 11770411 + IVCOMP = 1 11780411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 11790411 + 1 (((RAON32 (J,K,I), J=1,2), K=1,2), I=1,2) 11800411 + IF (IRECN .EQ. 11) IVCOMP = IVCOMP * 2 11810411 + IF (RAON32(1,2,1) .EQ. 7.77) IVCOMP = IVCOMP * 3 11820411 + IF (RAON32(1,2,2) .EQ. -32767.) IVCOMP = IVCOMP * 5 11830411 +C 11840411 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 11850411 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 11860411 +C 11870411 +40300 IF (IVCOMP - 30) 20300, 10300, 20300 11880411 +30300 IVDELE = IVDELE + 1 11890411 + WRITE (I02,80000) IVTNUM 11900411 + IF (ICZERO) 10300, 0311, 20300 11910411 +10300 IVPASS = IVPASS + 1 11920411 + WRITE (I02,80002) IVTNUM 11930411 + GO TO 0311 11940411 +20300 IVFAIL = IVFAIL + 1 11950411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11960411 + 0311 CONTINUE 11970411 +C 11980411 +C **** FCVS PROGRAM 411 - TEST 031 **** 11990411 +C 12000411 +C 12010411 +C TEST 031 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 12020411 +C IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. THE STORAGE VALUES IN 12030411 +C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 12040411 +C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD 12050411 +C OF THE FILE. THIS RECORD IS RECORD NUMBER 12 AND WAS CREATED IN 12060411 +C TEST 014 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN 12070411 +C ARRAY LAON32 AND SUBSCRIPT VALUE AFTER THE READ IS 12080411 +C 12090411 +C VALUE T T F F T T F F 12100411 +C FIELD POS 1 5 3 7 2 6 4 8 12110411 +C LAON32 1 2 3 4 5 6 7 8 12120411 +C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,212130411 +C 12140411 +C 12150411 + IVTNUM = 31 12160411 + IF (ICZERO) 30310, 0310, 30310 12170411 + 0310 CONTINUE 12180411 + LAON32(1,2,1) = .TRUE. 12190411 + LAON32(2,1,1) = .FALSE. 12200411 + IVCORR = 30 12210411 + IVCOMP = 1 12220411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12230411 + 1 (((LAON32 (J,K,I), I=1,2), K=1,2), J=1,2) 12240411 + IF (IRECN .EQ. 12) IVCOMP = IVCOMP * 2 12250411 + IF ( .NOT. LAON32(1,2,1)) IVCOMP = IVCOMP * 3 12260411 + IF (LAON32(2,1,1)) IVCOMP = IVCOMP * 5 12270411 +40310 IF (IVCOMP - 30) 20310, 10310, 20310 12280411 +30310 IVDELE = IVDELE + 1 12290411 + WRITE (I02,80000) IVTNUM 12300411 + IF (ICZERO) 10310, 0321, 20310 12310411 +10310 IVPASS = IVPASS + 1 12320411 + WRITE (I02,80002) IVTNUM 12330411 + GO TO 0321 12340411 +20310 IVFAIL = IVFAIL + 1 12350411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12360411 + 0321 CONTINUE 12370411 +C 12380411 +C **** FCVS PROGRAM 411 - TEST 032 **** 12390411 +C 12400411 +C 12410411 +C TEST 032 USES A READ STATEMENT WITHOUT ANY INPUT LIST ITEMS 12420411 +C (INPUT LIST ITEMS ARE OPTIONAL FOR THE READ STATEMENT). THIS 12430411 +C RECORD WAS WRITTEN IN TEST 15 AND SHOULD BE RECORD NUMBER 13. 12440411 +C THE PURPOSE OF THIS TEST IS TO SEE THAT THE STATEMENT CONSTRUCT 12450411 +C IS ACCEPTABLE TO THE COMPILER. 12460411 +C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. 12470411 +C 12480411 +C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS 12490411 +C 12.8, READ, WRITE AND PRINT STATEMENTS12500411 +C 12510411 +C 12520411 + IVTNUM = 32 12530411 + IF (ICZERO) 30320, 0320, 30320 12540411 + 0320 CONTINUE 12550411 + IRECN = 13 12560411 + IVCORR = 13 12570411 + READ (I04) 12580411 + IVCOMP = IRECN 12590411 +40320 IF (IVCOMP - 13) 20320, 10320, 20320 12600411 +30320 IVDELE = IVDELE + 1 12610411 + WRITE (I02,80000) IVTNUM 12620411 + IF (ICZERO) 10320, 0331, 20320 12630411 +10320 IVPASS = IVPASS + 1 12640411 + WRITE (I02,80002) IVTNUM 12650411 + GO TO 0331 12660411 +20320 IVFAIL = IVFAIL + 1 12670411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12680411 + 0331 CONTINUE 12690411 +C 12700411 +C **** FCVS PROGRAM 411 - TEST 033 **** 12710411 +C 12720411 +C 12730411 +C TEST 033 USES A READ STATEMENT IN WHICH THE NUMBER OF VALUES 12740411 +C REQUIRED BY THE INPUT LIST IS LESS THAN THE NUMBER OF VALUES IN 12750411 +C THE RECORD. THIS TEST READS RECORD NUMBER 14 WHICH WAS CREATED 12760411 +C IN TEST 016. 12770411 +C 12780411 +C SEE SECTION 12.9.5.1, UNFORMATED DATA TRANSFER 12790411 +C 12800411 +C 12810411 + IVTNUM = 33 12820411 + IF (ICZERO) 30330, 0330, 30330 12830411 + 0330 CONTINUE 12840411 + IVON21 = 0 12850411 + IVON22 = 0 12860411 + IVON31 = 0 12870411 + IVCORR = 0 12880411 + IVCOMP = 1 12890411 + READ (I04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12900411 + 1 IVON21, IVON22, IVON31 12910411 + IF (IRECN .EQ. 14) IVCOMP = IVCOMP * 2 12920411 + IF (IVON21 .EQ. 11) IVCOMP = IVCOMP * 3 12930411 + IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 5 12940411 +40330 IF (IVCOMP - 30) 20330, 10330, 20330 12950411 +30330 IVDELE = IVDELE + 1 12960411 + WRITE (I02,80000) IVTNUM 12970411 + IF (ICZERO) 10330, 0341, 20330 12980411 +10330 IVPASS = IVPASS + 1 12990411 + WRITE (I02,80002) IVTNUM 13000411 + GO TO 0341 13010411 +20330 IVFAIL = IVFAIL + 1 13020411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 13030411 + 0341 CONTINUE 13040411 +C 13050411 +C 13060411 +C THE FOLLOWING TWO TESTS USE THE READ STATEMENT WITH THE 13070411 +C END SPECIFIER. 13080411 +C 13090411 +C 13100411 +C 13110411 +C **** FCVS PROGRAM 411 - TEST 034 **** 13120411 +C 13130411 +C 13140411 +C TEST 034 USES THE READ STATEMENT WITHOUT ANY I/O LIST ITEMS. 13150411 +C THE FILE IS READ UNTIL AN END-OF-FILE CONDITION OCCURS. 13160411 +C 13170411 + IVTNUM = 34 13180411 + IF (ICZERO) 30340, 0340, 30340 13190411 + 0340 CONTINUE 13200411 + REWIND I04 13210411 +C 13220411 + IVCOMP = 1 13230411 + IVON01 = 0 13240411 + IVCORR = 6 13250411 + DO 0342 I=1,150 13260411 + READ (I04, END = 0343) 13270411 + IVON01 = IVON01 + 1 13280411 + IF (IVON01 .GT. 150) GO TO 40340 13290411 + 0342 CONTINUE 13300411 + GO TO 40340 13310411 + 0343 IVCOMP = IVCOMP * 2 13320411 + IF (IVON01 .EQ. 142) IVCOMP = IVCOMP * 3 13330411 +40340 IF (IVCOMP - 6) 20340, 10340, 20340 13340411 +30340 IVDELE = IVDELE + 1 13350411 + WRITE (I02,80000) IVTNUM 13360411 + IF (ICZERO) 10340, 0351, 20340 13370411 +10340 IVPASS = IVPASS + 1 13380411 + WRITE (I02,80002) IVTNUM 13390411 + GO TO 0351 13400411 +20340 IVFAIL = IVFAIL + 1 13410411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 13420411 + 0351 CONTINUE 13430411 +C 13440411 +C **** FCVS PROGRAM 411 - TEST 035 **** 13450411 +C 13460411 +C 13470411 +C TEST 035 USES THE READ STATEMENT WITH INPUT LIST ITEMS. 13480411 +C THE FILE IS READ UNTIL AN END-OF-FILE CONDITION OCCURS. 13490411 +C 13500411 +C 13510411 + IVTNUM = 35 13520411 + IF (ICZERO) 30350, 0350, 30350 13530411 + 0350 CONTINUE 13540411 + REWIND I04 13550411 + IVCOMP = 1 13560411 + IVCORR = 6 13570411 + IVON01 = 0 13580411 + IRECCK = 0 13590411 + DO 0352 I = 1,150 13600411 + IRECCK = IRECCK + 1 13610411 + IF (IRECCK .EQ. 13) GO TO 0353 13620411 +C TEST 015 WROTE A RECORD WITHOUT ANY I/O LIST ITEMS THEREFORE 13630411 +C THE RECORD IS READ WITHOUT ANY I/O LIST ITEMS. 13640411 + READ (I04, END = 0354) IPROG, IFILE, ITOTR, IRLGN, IRECN,IEOF 13650411 + GO TO 0355 13660411 + 0353 READ (I04) 13670411 + IVON01 = IVON01 + 1 13680411 + 0355 IF (IRECN .EQ. IRECCK) IVON01 = IVON01 + 1 13690411 + 0352 CONTINUE 13700411 + GO TO 40350 13710411 + 0354 IVCOMP = IVCOMP * 2 13720411 + IF (IVON01 .EQ. 142) IVCOMP = IVCOMP * 3 13730411 +40350 IF (IVCOMP - 6) 20350, 10350, 20350 13740411 +30350 IVDELE = IVDELE + 1 13750411 + WRITE (I02,80000) IVTNUM 13760411 + IF (ICZERO) 10350, 0361, 20350 13770411 +10350 IVPASS = IVPASS + 1 13780411 + WRITE (I02,80002) IVTNUM 13790411 + GO TO 0361 13800411 +20350 IVFAIL = IVFAIL + 1 13810411 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 13820411 + 0361 CONTINUE 13830411 +C 13840411 +C 13850411 +C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES 13860411 +C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION 13870411 +C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. 13880411 +C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED13890411 +C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS 13900411 +C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL 13910411 +C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP 13920411 +C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST 13930411 +C REPORT AND BEFORE THE TEST REPORT SUMMARY. 13940411 +CDB** BEGIN FILE DUMP CODE 13950411 +C REWIND I04 13960411 +C ITOTR = 142 13970411 +C ILUN = I04 13980411 +C IRLGN = 80 13990411 +C IRNUM = 1 14000411 +C7701 FORMAT (80A1) 14010411 +C7702 FORMAT (1X,80A1) 14020411 +C7703 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - OK" ) 14030411 +C7704 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - THERE SHOULD BE " ,I14040411 +C 13,9H RECORDS.) 14050411 +C DO 7771 IRNUM = 1, ITOTR 14060411 +C READ (ILUN, END = 7772) (IDUMP(ICH), ICH = 1, IRLGN) 14070411 +C WRITE (I02,7702) (IDUMP(ICH), ICH = 1, IRLGN) 14080411 +C7771 CONTINUE 14090411 +C7772 CONTINUE 14100411 +CDE** END OF DUMP CODE 14110411 +C TEST 035 IS THE LAST TEST IN THIS PROGRAM. THE ROUTINE SHOULD14120411 +C HAVE MADE 35 EXPLICIT TESTS AND PROCESSED ONE FILE CONNECTED FOR 14130411 +C SEQUENTIAL ACCESS 14140411 +C 14150411 +C 14160411 +C 14170411 +C WRITE OUT TEST SUMMARY 14180411 +C 14190411 + WRITE (I02,90004) 14200411 + WRITE (I02,90014) 14210411 + WRITE (I02,90004) 14220411 + WRITE (I02,90000) 14230411 + WRITE (I02,90004) 14240411 + WRITE (I02,90020) IVFAIL 14250411 + WRITE (I02,90022) IVPASS 14260411 + WRITE (I02,90024) IVDELE 14270411 + STOP 14280411 +90001 FORMAT (" ",24X,"FM411") 14290411 +90000 FORMAT (" ",20X,"END OF PROGRAM FM411" ) 14300411 +C 14310411 +C FORMATS FOR TEST DETAIL LINES 14320411 +C 14330411 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 14340411 +80002 FORMAT (" ",4X,I5,7X,"PASS") 14350411 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 14360411 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 14370411 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 14380411 +C 14390411 +C FORMAT STATEMENTS FOR PAGE HEADERS 14400411 +C 14410411 +90002 FORMAT ("1") 14420411 +90004 FORMAT (" ") 14430411 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 14440411 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 14450411 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 14460411 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 14470411 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 14480411 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 14490411 +C 14500411 +C FORMAT STATEMENTS FOR RUN SUMMARY 14510411 +C 14520411 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 14530411 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 14540411 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 14550411 + END 14560411 diff --git a/Fortran/UnitTests/fcvs21_f95/FM411.reference_output b/Fortran/UnitTests/fcvs21_f95/FM411.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM411.reference_output @@ -0,0 +1,56 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM411 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + + ---------------------------------------------- + + END OF PROGRAM FM411 + + 0 TESTS FAILED + 35 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM413.f b/Fortran/UnitTests/fcvs21_f95/FM413.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM413.f @@ -0,0 +1,1419 @@ + PROGRAM FM413 00010413 +C 00020413 +C 00030413 +C 00040413 +C THIS ROUTINE TESTS FOR PROPER PROCESSING OF UNFORMATTED RECORDS00050413 +C IN FILES CONNECTED FOR DIRECT ACCESS. FOR THE SUBSET LANGUAGE A 00060413 +C FILE CONNECTED FOR DIRECT ACCESS MUST HAVE UNFORMATTED RECORDS 00070413 +C THIS ROUTINE FIRST TESTS SEVERAL SYNTACTICAL VARIATIONS OF THE 00080413 +C READ AND WRITE STATEMENTS USED IN CREATING AND ACCESSING 00090413 +C RECORDS OF THE FILE. THE OPEN STATEMENT IS USED TO CONNECT 00100413 +C THE FILE TO A UNIT AND ESTABLISH ITS CONNECTION FOR DIRECT 00110413 +C ACCESS. THE FIRST SERIES OF TESTS CREATE AND ACCESS THE 00120413 +C RECORDS OF THE FILE IN RECORD NUMBER SEQUENCE AND THE LAST 00130413 +C SERIES OF TESTS CREATE AND ACCESS RECORDS OF THE FILE IN RANDOM 00140413 +C ORDER. 00150413 +C 00160413 +C UNFORMATTED RECORDS MAY HAVE BOTH CHARACTER AND NONCHARACTER 00170413 +C DATA AND THIS DATA IS TRANSFERRED WITHOUT EDITING BETWEEN THE 00180413 +C CURRENT RECORD AND THE ENTITIES SPECIFIED BY THE INPUT/OUTPUT 00190413 +C LIST. THIS ROUTINE BOTH READS AND WRITES RECORDS CONTAINING 00200413 +C THE DATA TYPES OF INTEGER ,REAL AND LOGICAL WITH I/O LIST ITEMS 00210413 +C REPRESENTED AS VARIABLE NAMES, ARRAY ELEMENT NAMES AND ARRAY 00220413 +C NAMES. THIS ROUTINE DOES NOT TEST DATA OF TYPE CHARACTER. 00230413 +C 00240413 +C ROUTINE FM411 TESTS USE OF UNFORMATTED RECORDS 00250413 +C WITH A FILE CONNECTED FOR SEQUENTIAL ACCESS. 00260413 +C 00270413 +C THIS ROUTINE TESTS 00280413 +C 00290413 +C (1) THE STATEMENT CONSTRUCTS 00300413 +C 00310413 +C A. WRITE (U,REC=RN) VARIABLE-NAME,... 00320413 +C B. WRITE (U,REC=RN) ARRAY-ELEMENT-NAME,... 00330413 +C C. WRITE (U,REC=RN) ARRAY-NAME,... 00340413 +C D. WRITE (U,REC=RN) - NO OUTPUT LIST 00350413 +C E. WRITE (U,REC=RN) IMPLIED-DO-LIST 00360413 +C F. READ (U,REC=RN) VARIABLE-NAME,... 00370413 +C G. READ (U,REC=RN) ARRAY-ELEMENT-NAME,... 00380413 +C H. READ (U,REC=RN) ARRAY-NAME,... 00390413 +C I. READ (U,REC=RN) - NO INPUT LIST 00400413 +C J. READ (U,REC=RN) IMPLIED-DO-LIST 00410413 +C 00420413 +C (2) USE OF A READ STATEMENT WHERE THE NUMBER OF VALUES 00430413 +C IN THE INPUT LIST IS LESS THAN OR EQUAL TO THE 00440413 +C NUMBER OF VALUES IN THE RECORD. 00450413 +C (3) USE OF THE STATEMENT 00460413 +C OPEN (U,ACCESS='DIRECT',RECL=RL) 00470413 +C FOR CONNECTING A FILE TO THE UNIT. 00480413 +C 00490413 +C (4) THAT THE RECORDS OF A DIRECT ACCESS FILE NEED NOT BE 00500413 +C BE CREATED AND READ IN ORDER OF THEIR RECORD NUMBERS. 00510413 +C 00520413 +C (5) THAT THE VALUES OF THE RECORD MAY BE CHANGED WHEN 00530413 +C THE RECORD IS REWRITTEN. 00540413 +C REFERENCES - 00550413 +C 00560413 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00570413 +C X3.9-1977 00580413 +C 00590413 +C SECTION 4.1, DATA TYPES 00600413 +C SECTION 12.1.2, UNFORMATTED RECORD 00610413 +C SECTION 12.2.4, FILE ACCESS 00620413 +C SECTION 12.2.4.2, DIRECT ACCESS 00630413 +C SECTION 12.3.3, UNIT SPECIFIER AND IDENTIFIER 00640413 +C SECTION 12.7.2, END-OF-FILE SPECIFIER 00650413 +C SECTION 12.8, READ, WRITE AND PRINT STATEMENTS 00660413 +C SECTION 12.8.1, CONTROL INFORMATION LIST 00670413 +C SECTION 12.8.2, INPUT/OUTPUT LIST 00680413 +C SECTION 12.8.2.1, INPUT LIST ITEMS 00690413 +C SECTION 12.8.2.2, OUTPUT LIST ITEMS 00700413 +C SECTION 12.8.2.3, IMPLIED-DO LIST 00710413 +C SECTION 12.9.5.1, UNFORMATTED DATA TRANSFER 00720413 +C SECTION 12.10.1, OPEN STATEMENT 00730413 +C 00740413 +C 00750413 +C 00760413 +C ******************************************************************00770413 +C A COMPILER VALIDATION SYSTEM FOR THE FORTRAN LANGUAGE 00780413 +C BASED ON SPECIFICATIONS AS DEFINED IN AMERICAN STANDARD FORTRAN 00790413 +C X3.9-1978, HAS BEEN DEVELOPED BY THE DEPARTMENT OF THE NAVY. THE 00800413 +C FORTRAN COMPILER VALIDATION SYSTEM (FCVS) CONSISTS OF AUDIT 00810413 +C ROUTINES, THEIR RELATED DATA, AND AN EXECUTIVE SYSTEM. EACH AUDIT00820413 +C ROUTINE IS A FORTRAN PROGRAM OR SUBPROGRAM WHICH INCLUDES TESTS 00830413 +C OF SPECIFIC LANGUAGE ELEMENTS AND SUPPORTING PROCEDURES INDICATING00840413 +C THE RESULT OF EXECUTING THESE TESTS. 00850413 +C 00860413 +C THIS PARTICULAR PROGRAM OR SUBPROGRAM CONTAINS ONLY FEATURES 00870413 +C FOUND IN THE SUBSET LEVEL OF THE STANDARD. 00880413 +C 00890413 +C SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00900413 +C NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00910413 +C SOFTWARE STANDARDS VALIDATION GROUP 00920413 +C BUILDING 225 RM A266 00930413 +C GAITHERSBURG, MD 20899 00940413 +C ******************************************************************00950413 +C 00960413 +C 00970413 + IMPLICIT LOGICAL (L) 00980413 + IMPLICIT CHARACTER*14 (C) 00990413 +C 01000413 + LOGICAL LAON11, LAON21, LAON31, LCONT1, LCONF2, LVONT1, LVONF2 01010413 + LOGICAL LAON12, LAON22, LAON32, LCONT3, LCONF4, LVONT3, LVONF4 01020413 + LOGICAL LCONT5, LCONF6, LCONT7, LCONF8, LVONT5, LVONF6, LVONT7 01030413 + LOGICAL LVONF8 01040413 + DIMENSION IDUMP(80) 01050413 + DIMENSION IAON11(8), IAON21(2,4), IAON31(2,2,2) 01060413 + DIMENSION IAON12(8), IAON22(2,4), IAON32(2,2,2) 01070413 + DIMENSION RAON11(8), RAON21(2,4), RAON31(2,2,2) 01080413 + DIMENSION RAON12(8), RAON22(2,4), RAON32(2,2,2) 01090413 + DIMENSION LAON11(8), LAON21(2,4), LAON31(2,2,2) 01100413 + DIMENSION LAON12(8), LAON22(2,4), LAON32(2,2,2) 01110413 + DATA IAON11 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01120413 + DATA IAON21 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01130413 + DATA IAON31 /11, -11, 777, -777, 512, -512, -32767, 32767/ 01140413 + DATA LAON11 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01150413 + 1 .TRUE., .FALSE./ 01160413 + DATA LAON21 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01170413 + 1 .TRUE., .FALSE./ 01180413 + DATA LAON31 /.TRUE., .FALSE., .TRUE., .FALSE., .TRUE., .FALSE., 01190413 + 1 .TRUE., .FALSE./ 01200413 + DATA RAON11 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01210413 + DATA RAON21 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01220413 + DATA RAON31 /11., -11., 7.77, -7.77,.512, -.512, -32767., 32767./01230413 + ICON21 = 11 01240413 + ICON22 = -11 01250413 + ICON31 = +777 01260413 + ICON32 = -777 01270413 + ICON33 = 512 01280413 + ICON34 = -512 01290413 + ICON55 = -32767 01300413 + ICON56 = 32767 01310413 + RCON21 = 11. 01320413 + RCON22 = -11. 01330413 + RCON31 = +7.77 01340413 + RCON32 = -7.77 01350413 + RCON33 = .512 01360413 + RCON34 = -.512 01370413 + RCON55 = -32767. 01380413 + RCON56 = 32767. 01390413 + LCONT1 = .TRUE. 01400413 + LCONF2 = .FALSE. 01410413 + LCONT3 = .TRUE. 01420413 + LCONF4 = .FALSE. 01430413 + LCONT5 = .TRUE. 01440413 + LCONF6 = .FALSE. 01450413 + LCONT7 = .TRUE. 01460413 + LCONF8 = .FALSE. 01470413 +C 01480413 +C THE FILE USED IN THIS ROUTINE HAS THE FOLLOWING PROPERTIES 01490413 +C 01500413 +C FILE IDENTIFIER - I10 (X-NUMBER 10) 01510413 +C RECORD SIZE - 80 01520413 +C ACCESS METHOD - DIRECT 01530413 +C RECORD TYPE - UNFORMATTED 01540413 +C DESIGNATED DEVICE - DISK 01550413 +C TYPE OF DATA - INTEGER, REAL AND LOGICAL 01560413 +C RECORDS IN FILE - 214 01570413 +C 01580413 +C THE FIRST 6 FIELDS OF EACH RECORD IN THE FILE UNIQUELY IDENT-01590413 +C IFIES THAT RECORD. THE REMAINING FIELDS OF THE RECORD CONTAIN 01600413 +C DATA WHICH ARE USED IN TESTING. A DESCRIPTION OF EACH FIELD 01610413 +C OF THE PREAMBLE FOLLOWS. 01620413 +C 01630413 +C VARIABLE NAME IN PROGRAM FIELD NUMBER 01640413 +C ------------------------ ------------ 01650413 +C 01660413 +C IPROG (ROUTINE NAME) - 1 01670413 +C IFILE (LOGICAL/X-NUMBER) - 2 01680413 +C ITOTR (RECORDS IN FILE) - 3 01690413 +C IRLGN (LENGTH OF RECORD) - 4 01700413 +C IRECN (RECORD NUMBER) - 5 01710413 +C IEOF (9999 IF LAST RECORD) - 6 01720413 +C 01730413 +C 01740413 +C 01750413 +C 01760413 +C INITIALIZATION SECTION. 01770413 +C 01780413 +C INITIALIZE CONSTANTS 01790413 +C ******************** 01800413 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER 01810413 + I01 = 5 01820413 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER 01830413 + I02 = 6 01840413 +C SYSTEM ENVIRONMENT SECTION 01850413 +C 01860413 +CX010 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-010 CONTROL CARD.01870413 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01880413 +C (UNIT NUMBER FOR CARD READER). 01890413 +CX011 THIS CARD IS REPLACED BY CONTENTS OF FEXEC X-011 CONTROL CARD01900413 +C THE CX011 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01910413 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX010 ABOVE. 01920413 +C 01930413 +CX020 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-020 CONTROL CARD.01940413 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02 = 6 01950413 +C (UNIT NUMBER FOR PRINTER). 01960413 +CX021 THIS CARD IS PEPLACED BY CONTENTS OF FEXEC X-021 CONTROL CARD.01970413 +C THE CX021 CARD IS FOR SYSTEMS WHICH REQUIRE ADDITIONAL 01980413 +C FORTRAN STATEMENTS FOR FILES ASSOCIATED WITH CX020 ABOVE. 01990413 +C 02000413 + IVPASS = 0 02010413 + IVFAIL = 0 02020413 + IVDELE = 0 02030413 + ICZERO = 0 02040413 +C 02050413 +C WRITE OUT PAGE HEADERS 02060413 +C 02070413 + WRITE (I02,90002) 02080413 + WRITE (I02,90006) 02090413 + WRITE (I02,90008) 02100413 + WRITE (I02,90004) 02110413 + WRITE (I02,90010) 02120413 + WRITE (I02,90004) 02130413 + WRITE (I02,90016) 02140413 + WRITE (I02,90001) 02150413 + WRITE (I02,90004) 02160413 + WRITE (I02,90012) 02170413 + WRITE (I02,90014) 02180413 + WRITE (I02,90004) 02190413 +C 02200413 + I10 = 422 02210413 +C I10 CONTAINS THE LOGICAL UNIT NUMBER FOR A DIRECT ACCESS FILE 02220413 +C WITH UNFORMATTED RECORDS 02230413 +CX100 THE CARD IS REPLACED BY CONTENTS OF X-100 CARD 02240413 +CX101 THE CARD IS REPLACED BY CONTENTS OF X-101 CARD 02250413 + IPROG = 413 02260413 + IFILE = I10 02270413 + ITOTR = 214 02280413 + IRLGN = 80 02290413 + IRECN = 0 02300413 + IEOF = 0 02310413 +C 02320413 +C 02330413 +C 02340413 +C TESTS 001 THROUGH 013 OPEN A FILE CONNECTED FOR DIRECT ACCESS 02350413 +C AND WRITE 12 RECORDS INTO THE FILE. THESE TESTS TEST USE OF THE 02360413 +C ALLOWABLE FORMS OF THE OPEN AND WRITE STATEMENTS ON A FILE 02370413 +C CONNECTED FOR DIRECT ACCESS. THE WRITE STATEMENT IS USED WITH 02380413 +C THE I/O LIST ITEM AS A VARIABLE, ARRAY ELEMENT AND AN ARRAY. 02390413 +C THE PURPOSE OF TESTS 001 THROUGH 013 IS TO CHECK THE COMPILER'S02400413 +C ABILITY TO HANDLE THE VARIOUS STATEMENT CONSTRUCTS OF THE OPEN 02410413 +C AND WRITE STATEMENTS. LATER TESTS WITHIN THIS ROUTINE READ 02420413 +C AND CHECK THE RECORDS WHICH WERE CREATED. 02430413 +C THE VALUE IN IVCORR FOR TESTS 002 THROUGH 013 IS THE RECORD 02440413 +C NUMBER USED TO WRITE THE RECORD. 02450413 +C 02460413 +C 02470413 +C 02480413 +C **** FCVS PROGRAM 413 - TEST 001 **** 02490413 +C 02500413 +C 02510413 +C TEST 001 USES THE OPEN STATEMENT TO CONNECT A FILE FOR DIRECT 02520413 +C ACCESS. THIS IS THE FIRST ROUTINE TO USE AN OPEN STATEMENT. 02530413 +C 02540413 +C 02550413 + IVTNUM = 1 02560413 + IF (ICZERO) 30010, 0010, 30010 02570413 + 0010 CONTINUE 02580413 + IVCORR = 1 02590413 + IVCOMP = 0 02600413 + OPEN ( I10, ACCESS = 'DIRECT', RECL = 80 ) 02610413 + IVCOMP = 1 02620413 +40010 IF (IVCOMP - 1) 20010, 10010, 20010 02630413 +30010 IVDELE = IVDELE + 1 02640413 + WRITE (I02,80000) IVTNUM 02650413 + IF (ICZERO) 10010, 0021, 20010 02660413 +10010 IVPASS = IVPASS + 1 02670413 + WRITE (I02,80002) IVTNUM 02680413 + GO TO 0021 02690413 +20010 IVFAIL = IVFAIL + 1 02700413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02710413 + 0021 CONTINUE 02720413 +C 02730413 +C **** FCVS PROGRAM 413 - TEST 002 **** 02740413 +C 02750413 +C 02760413 +C TEST 002 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 02770413 +C IS A VARIABLE OF INTEGER TYPE. 02780413 +C 02790413 +C 02800413 + IVTNUM = 2 02810413 + IF (ICZERO) 30020, 0020, 30020 02820413 + 0020 CONTINUE 02830413 + IRECN = 01 02840413 + IVCORR = 01 02850413 + WRITE (I10,REC=01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 02860413 + 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 02870413 + IVCOMP = IRECN 02880413 +40020 IF (IVCOMP - 01) 20020, 10020, 20020 02890413 +30020 IVDELE = IVDELE + 1 02900413 + WRITE (I02,80000) IVTNUM 02910413 + IF (ICZERO) 10020, 0031, 20020 02920413 +10020 IVPASS = IVPASS + 1 02930413 + WRITE (I02,80002) IVTNUM 02940413 + GO TO 0031 02950413 +20020 IVFAIL = IVFAIL + 1 02960413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02970413 + 0031 CONTINUE 02980413 +C 02990413 +C **** FCVS PROGRAM 413 - TEST 003 **** 03000413 +C 03010413 +C 03020413 +C TEST 003 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03030413 +C IS A VARIABLE OF REAL TYPE. 03040413 +C 03050413 +C 03060413 + IVTNUM = 3 03070413 + IF (ICZERO) 30030, 0030, 30030 03080413 + 0030 CONTINUE 03090413 + IRECN = 02 03100413 + IVCORR = 02 03110413 + WRITE (I10,REC=02) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03120413 + 1 RCON21, RCON22, RCON31, RCON32, RCON33, RCON34, RCON55, RCON56 03130413 + IVCOMP = IRECN 03140413 +40030 IF (IVCOMP - 02) 20030, 10030, 20030 03150413 +30030 IVDELE = IVDELE + 1 03160413 + WRITE (I02,80000) IVTNUM 03170413 + IF (ICZERO) 10030, 0041, 20030 03180413 +10030 IVPASS = IVPASS + 1 03190413 + WRITE (I02,80002) IVTNUM 03200413 + GO TO 0041 03210413 +20030 IVFAIL = IVFAIL + 1 03220413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03230413 + 0041 CONTINUE 03240413 +C 03250413 +C **** FCVS PROGRAM 413 - TEST 004 **** 03260413 +C 03270413 +C 03280413 +C TEST 004 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03290413 +C IS A VARIABLE OF LOGICAL TYPE. 03300413 +C 03310413 +C 03320413 + IVTNUM = 4 03330413 + IF (ICZERO) 30040, 0040, 30040 03340413 + 0040 CONTINUE 03350413 + IRECN = 03 03360413 + IVCORR = 03 03370413 + WRITE (I10,REC=03) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03380413 + 1 LCONT1, LCONF2, LCONT3, LCONF4, LCONT5, LCONF6, LCONT7, LCONF803390413 + IVCOMP = IRECN 03400413 +40040 IF (IVCOMP - 03) 20040, 10040, 20040 03410413 +30040 IVDELE = IVDELE + 1 03420413 + WRITE (I02,80000) IVTNUM 03430413 + IF (ICZERO) 10040, 0051, 20040 03440413 +10040 IVPASS = IVPASS + 1 03450413 + WRITE (I02,80002) IVTNUM 03460413 + GO TO 0051 03470413 +20040 IVFAIL = IVFAIL + 1 03480413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03490413 + 0051 CONTINUE 03500413 +C 03510413 +C **** FCVS PROGRAM 413 - TEST 005 **** 03520413 +C 03530413 +C 03540413 +C TEST 005 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03550413 +C IS AN ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO AND THREE 03560413 +C DIMENSION ARRAYS ARE USED. 03570413 +C 03580413 +C 03590413 + IVTNUM = 5 03600413 + IF (ICZERO) 30050, 0050, 30050 03610413 + 0050 CONTINUE 03620413 + IRECN = 04 03630413 + IVCORR = 04 03640413 + WRITE (I10,REC=04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03650413 + 1 IAON11(1), IAON11(2), IAON21(1,2), IAON21(2,2), IAON31(1,1,2), 03660413 + 2 IAON31(2,1,2), IAON11(7), IAON11(8) 03670413 + IVCOMP = IRECN 03680413 +40050 IF (IVCOMP - 04) 20050, 10050, 20050 03690413 +30050 IVDELE = IVDELE + 1 03700413 + WRITE (I02,80000) IVTNUM 03710413 + IF (ICZERO) 10050, 0061, 20050 03720413 +10050 IVPASS = IVPASS + 1 03730413 + WRITE (I02,80002) IVTNUM 03740413 + GO TO 0061 03750413 +20050 IVFAIL = IVFAIL + 1 03760413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03770413 + 0061 CONTINUE 03780413 +C 03790413 +C **** FCVS PROGRAM 413 - TEST 006 **** 03800413 +C 03810413 +C 03820413 +C TEST 006 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 03830413 +C IS AN ARRAY ELEMENT OF REAL TYPE. ONE, TWO AND THREE 03840413 +C DIMENSION ARRAYS ARE USED. 03850413 +C 03860413 +C 03870413 + IVTNUM = 6 03880413 + IF (ICZERO) 30060, 0060, 30060 03890413 + 0060 CONTINUE 03900413 + IRECN = 05 03910413 + IVCORR = 05 03920413 + WRITE (I10,REC=05) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 03930413 + 1 RAON11(1), RAON11(2), RAON21(1,2), RAON21(2,2), RAON31(1,1,2), 03940413 + 2 RAON31(2,1,2), RAON11(7), RAON11(8) 03950413 + IVCOMP = IRECN 03960413 +40060 IF (IVCOMP - 05) 20060, 10060, 20060 03970413 +30060 IVDELE = IVDELE + 1 03980413 + WRITE (I02,80000) IVTNUM 03990413 + IF (ICZERO) 10060, 0071, 20060 04000413 +10060 IVPASS = IVPASS + 1 04010413 + WRITE (I02,80002) IVTNUM 04020413 + GO TO 0071 04030413 +20060 IVFAIL = IVFAIL + 1 04040413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04050413 + 0071 CONTINUE 04060413 +C 04070413 +C **** FCVS PROGRAM 413 - TEST 007 **** 04080413 +C 04090413 +C 04100413 +C TEST 007 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04110413 +C IS AN ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO AND THREE 04120413 +C DIMENSION ARRAYS ARE USED. 04130413 +C 04140413 +C 04150413 + IVTNUM = 7 04160413 + IF (ICZERO) 30070, 0070, 30070 04170413 + 0070 CONTINUE 04180413 + IRECN = 06 04190413 + IVCORR = 06 04200413 + WRITE (I10,REC=06) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04210413 + 1 LAON11(1), LAON11(2), LAON21(1,2), LAON21(2,2), LAON31(1,1,2), 04220413 + 2 LAON31(2,1,2), LAON11(7), LAON11(8) 04230413 + IVCOMP = IRECN 04240413 +40070 IF (IVCOMP - 06) 20070, 10070, 20070 04250413 +30070 IVDELE = IVDELE + 1 04260413 + WRITE (I02,80000) IVTNUM 04270413 + IF (ICZERO) 10070, 0081, 20070 04280413 +10070 IVPASS = IVPASS + 1 04290413 + WRITE (I02,80002) IVTNUM 04300413 + GO TO 0081 04310413 +20070 IVFAIL = IVFAIL + 1 04320413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04330413 + 0081 CONTINUE 04340413 +C 04350413 +C **** FCVS PROGRAM 413 - TEST 008 **** 04360413 +C 04370413 +C 04380413 +C TEST 008 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04390413 +C IS AN ARRAY OF INTEGER TYPE. 04400413 +C 04410413 +C 04420413 + IVTNUM = 8 04430413 + IF (ICZERO) 30080, 0080, 30080 04440413 + 0080 CONTINUE 04450413 + IRECN = 07 04460413 + IVCORR = 07 04470413 + WRITE (I10,REC=07) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04480413 + 1 IAON31 04490413 + IVCOMP = IRECN 04500413 +40080 IF (IVCOMP - 07) 20080, 10080, 20080 04510413 +30080 IVDELE = IVDELE + 1 04520413 + WRITE (I02,80000) IVTNUM 04530413 + IF (ICZERO) 10080, 0091, 20080 04540413 +10080 IVPASS = IVPASS + 1 04550413 + WRITE (I02,80002) IVTNUM 04560413 + GO TO 0091 04570413 +20080 IVFAIL = IVFAIL + 1 04580413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04590413 + 0091 CONTINUE 04600413 +C 04610413 +C **** FCVS PROGRAM 413 - TEST 009 **** 04620413 +C 04630413 +C 04640413 +C TEST 009 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04650413 +C IS AN ARRAY OF REAL TYPE. 04660413 +C 04670413 +C 04680413 + IVTNUM = 9 04690413 + IF (ICZERO) 30090, 0090, 30090 04700413 + 0090 CONTINUE 04710413 + IRECN = 08 04720413 + IVCORR = 08 04730413 + WRITE (I10,REC=08) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 04740413 + 1 RAON31 04750413 + IVCOMP = IRECN 04760413 +40090 IF (IVCOMP - 08) 20090, 10090, 20090 04770413 +30090 IVDELE = IVDELE + 1 04780413 + WRITE (I02,80000) IVTNUM 04790413 + IF (ICZERO) 10090, 0101, 20090 04800413 +10090 IVPASS = IVPASS + 1 04810413 + WRITE (I02,80002) IVTNUM 04820413 + GO TO 0101 04830413 +20090 IVFAIL = IVFAIL + 1 04840413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04850413 + 0101 CONTINUE 04860413 +C 04870413 +C **** FCVS PROGRAM 413 - TEST 010 **** 04880413 +C 04890413 +C 04900413 +C TEST 010 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 04910413 +C IS AN ARRAY OF LOGICAL TYPE. 04920413 +C 04930413 +C 04940413 + IVTNUM = 10 04950413 + IF (ICZERO) 30100, 0100, 30100 04960413 + 0100 CONTINUE 04970413 + IRECN = 09 04980413 + IVCORR = 09 04990413 + WRITE (I10,REC=09) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05000413 + 1 LAON31 05010413 + IVCOMP = IRECN 05020413 +40100 IF (IVCOMP - 09) 20100, 10100, 20100 05030413 +30100 IVDELE = IVDELE + 1 05040413 + WRITE (I02,80000) IVTNUM 05050413 + IF (ICZERO) 10100, 0111, 20100 05060413 +10100 IVPASS = IVPASS + 1 05070413 + WRITE (I02,80002) IVTNUM 05080413 + GO TO 0111 05090413 +20100 IVFAIL = IVFAIL + 1 05100413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05110413 + 0111 CONTINUE 05120413 +C 05130413 +C **** FCVS PROGRAM 413 - TEST 011 **** 05140413 +C 05150413 +C 05160413 +C TEST 011 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05170413 +C IS AN IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. 05180413 +C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE 05190413 +C ELEMENT SEQUENCE OF ARRAY IAON31. THE SEQUENCE OF VALUES WRITTEN 05200413 +C IN THE RECORD ARE 11, 512, 777, -32767, -11, -512, -777, 32767. 05210413 +C 05220413 +C 05230413 + IVTNUM = 11 05240413 + IF (ICZERO) 30110, 0110, 30110 05250413 + 0110 CONTINUE 05260413 + IRECN = 10 05270413 + IVCORR = 10 05280413 + WRITE (I10,REC=10) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05290413 + 1 (((IAON31 (J,K,I), I=1,2), K=1,2), J=1,2) 05300413 + IVCOMP = IRECN 05310413 +40110 IF (IVCOMP - 10) 20110, 10110, 20110 05320413 +30110 IVDELE = IVDELE + 1 05330413 + WRITE (I02,80000) IVTNUM 05340413 + IF (ICZERO) 10110, 0121, 20110 05350413 +10110 IVPASS = IVPASS + 1 05360413 + WRITE (I02,80002) IVTNUM 05370413 + GO TO 0121 05380413 +20110 IVFAIL = IVFAIL + 1 05390413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05400413 + 0121 CONTINUE 05410413 +C 05420413 +C **** FCVS PROGRAM 413 - TEST 012 **** 05430413 +C 05440413 +C 05450413 +C TEST 012 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05460413 +C IS AN IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE FIELD VALUES 05470413 +C (IN FIELD POSITION ORDER) WRITTEN IN THE RECORD ARE 11., -11., 05480413 +C 7.77, -7.77, .512, -.512, -32767., 32767. 05490413 +C 05500413 +C 05510413 + IVTNUM = 12 05520413 + IF (ICZERO) 30120, 0120, 30120 05530413 + 0120 CONTINUE 05540413 + IRECN = 11 05550413 + IVCORR = 11 05560413 + WRITE (I10,REC=11) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05570413 + 1 (((RAON31 (J,K,I), J=1,2), K=1,2), I=1,2) 05580413 + IVCOMP = IRECN 05590413 +40120 IF (IVCOMP - 11) 20120, 10120, 20120 05600413 +30120 IVDELE = IVDELE + 1 05610413 + WRITE (I02,80000) IVTNUM 05620413 + IF (ICZERO) 10120, 0131, 20120 05630413 +10120 IVPASS = IVPASS + 1 05640413 + WRITE (I02,80002) IVTNUM 05650413 + GO TO 0131 05660413 +20120 IVFAIL = IVFAIL + 1 05670413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05680413 + 0131 CONTINUE 05690413 +C 05700413 +C **** FCVS PROGRAM 413 - TEST 013 **** 05710413 +C 05720413 +C 05730413 +C TEST 013 USES A WRITE STATEMENT WHERE THE OUTPUT LIST ITEM 05740413 +C IS AN IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. 05750413 +C THE FIELD VALUES ARE WRITTEN IN MIXED ORDER VIS-A-VIS THE 05760413 +C ELEMENT SEQUENCE OF ARRAY LAON31. THE SEQUENCE OF VALUES WRITTEN 05770413 +C IN THE RECORD ARE .TRUE., .TRUE., .FALSE., .FALSE., .TRUE., .TRUE.05780413 +C .FALSE, .FALSE. 05790413 +C 05800413 +C 05810413 + IVTNUM = 13 05820413 + IF (ICZERO) 30130, 0130, 30130 05830413 + 0130 CONTINUE 05840413 + IRECN = 12 05850413 + IVCORR = 12 05860413 + WRITE (I10,REC=12) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 05870413 + 1 (((LAON31 (J,K,I), K=1,2), J=1,2), I=1,2) 05880413 + IVCOMP = IRECN 05890413 +40130 IF (IVCOMP - 12) 20130, 10130, 20130 05900413 +30130 IVDELE = IVDELE + 1 05910413 + WRITE (I02,80000) IVTNUM 05920413 + IF (ICZERO) 10130, 0141, 20130 05930413 +10130 IVPASS = IVPASS + 1 05940413 + WRITE (I02,80002) IVTNUM 05950413 + GO TO 0141 05960413 +20130 IVFAIL = IVFAIL + 1 05970413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05980413 + 0141 CONTINUE 05990413 +C 06000413 +C 06010413 +C TESTS 14 AND 15 TEST THE WRITE WITHOUT OUTPUT LIST ITEMS. 06020413 +C 06030413 +C 06040413 +C 06050413 +C 06060413 +C **** FCVS PROGRAM 413 - TEST 014 **** 06070413 +C 06080413 +C 06090413 +C TEST 014 USES A WRITE STATEMENT WITHOUT ANY OUTPUT LIST ITEMS. 06100413 +C THE OUTPUT LIST ITEMS ARE OPTIONAL AND THIS TEST USES THIS FORM 06110413 +C TO ESTABLISH A RECORD NUMBER FOR A RECORD IN THE FILE. 06120413 +C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. 06130413 +C 06140413 +C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS 06150413 +C 12.2.4.2 (5) AND (6), DIRECT ACCESS 06160413 +C 12.8, READ, WRITE AND PRINT STATEMENTS 06170413 +C 06180413 +C 06190413 + IVTNUM = 14 06200413 + IF (ICZERO) 30140, 0140, 30140 06210413 + 0140 CONTINUE 06220413 + IRECN = 13 06230413 + IVCORR = 13 06240413 + WRITE (I10,REC=13) 06250413 + IVCOMP = IRECN 06260413 +40140 IF (IVCOMP - 13) 20140, 10140, 20140 06270413 +30140 IVDELE = IVDELE + 1 06280413 + WRITE (I02,80000) IVTNUM 06290413 + IF (ICZERO) 10140, 0151, 20140 06300413 +10140 IVPASS = IVPASS + 1 06310413 + WRITE (I02,80002) IVTNUM 06320413 + GO TO 0151 06330413 +20140 IVFAIL = IVFAIL + 1 06340413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06350413 + 0151 CONTINUE 06360413 +C 06370413 +C **** FCVS PROGRAM 413 - TEST 015 **** 06380413 +C 06390413 +C 06400413 +C TEST 015 IS SIMILAR TO TEST 014 ABOVE EXCEPT THE RN OF THE 06410413 +C RECORD SPECIFIER (REC = RN) IS AN INTEGER VARIABLE. 06420413 +C 06430413 +C 06440413 + IVTNUM = 15 06450413 + IF (ICZERO) 30150, 0150, 30150 06460413 + 0150 CONTINUE 06470413 + IRECN = 14 06480413 + IVCORR = 14 06490413 + IREC = 14 06500413 + WRITE (I10,REC = IREC) 06510413 + IVCOMP = IRECN 06520413 +40150 IF (IVCOMP - 14) 20150, 10150, 20150 06530413 +30150 IVDELE = IVDELE + 1 06540413 + WRITE (I02,80000) IVTNUM 06550413 + IF (ICZERO) 10150, 0161, 20150 06560413 +10150 IVPASS = IVPASS + 1 06570413 + WRITE (I02,80002) IVTNUM 06580413 + GO TO 0161 06590413 +20150 IVFAIL = IVFAIL + 1 06600413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06610413 + 0161 CONTINUE 06620413 +C 06630413 +C 06640413 +C TESTS 16 AND 17 VERIFY THAT RECORDS MAY BE CREATED IN 06650413 +C OTHER THAN SEQUENTIAL ORDER. ALSO THAT A VARIABLE MAY BY USED 06660413 +C AS THE OPERAND OF THE REC SPECIFIER FOR A WRITE STATEMENT. 06670413 +C 06680413 +C 06690413 +C 06700413 +C **** FCVS PROGRAM 413 - TEST 016 **** 06710413 +C 06720413 +C 06730413 +C TEST 016 TESTS USE OF THE REC SPECIFIER WHERE THE OPERAND 06740413 +C IS A VARIABLE. THIS TEST IS SIMILAR TO TEST 15 EXCEPT THE WRITE 06750413 +C STATEMENT CONTAINS OUTPUT LIST ITEMS. ONE HUNDRED RECORDS ARE 06760413 +C WRITTEN BY INCREMENTING THE VARIABLE BY 2 FOR EACH WRITE. TEST 06770413 +C 032 READS THE RECORDS WRITTEN BY THIS METHOD. 06780413 +C 06790413 +C 06800413 + IVTNUM = 16 06810413 + IF (ICZERO) 30160, 0160, 30160 06820413 + 0160 CONTINUE 06830413 + IRECN = 13 06840413 + IREC = 13 06850413 + DO 4132 I = 1,100 06860413 + IREC = IREC + 2 06870413 + IRECN = IRECN + 2 06880413 + WRITE (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 06890413 + 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 06900413 + 4132 CONTINUE 06910413 + IVCORR = 100 06920413 + IVCOMP = IREC - 113 06930413 +40160 IF (IVCOMP - 100) 20160, 10160, 20160 06940413 +30160 IVDELE = IVDELE + 1 06950413 + WRITE (I02,80000) IVTNUM 06960413 + IF (ICZERO) 10160, 0171, 20160 06970413 +10160 IVPASS = IVPASS + 1 06980413 + WRITE (I02,80002) IVTNUM 06990413 + GO TO 0171 07000413 +20160 IVFAIL = IVFAIL + 1 07010413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07020413 + 0171 CONTINUE 07030413 +C 07040413 +C **** FCVS PROGRAM 413 - TEST 017 **** 07050413 +C 07060413 +C 07070413 +C TEST 17 IS SIMILAR TO TEST 16 EXCEPT THE RECORD IS 07080413 +C WRITTEN IN REVERSE ORDER OF RECORD NUMBER. ONE HUNDERD RECORDS 07090413 +C ARE WRITTEN AND THE VARIABLE OF THE REC SPECIFIER IS DECREMENTED 07100413 +C BY TWO FOR EACH WRITE. 07110413 +C 07120413 +C 07130413 + IVTNUM = 17 07140413 + IF (ICZERO) 30170, 0170, 30170 07150413 + 0170 CONTINUE 07160413 + IRECN = 216 07170413 + IREC = 216 07180413 + IVCOMP = 0 07190413 + DO 4133 I=1,100 07200413 + IREC = IREC - 2 07210413 + IRECN = IRECN - 2 07220413 + WRITE (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 07230413 + 1 ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56 07240413 + IVCOMP = IVCOMP + 1 07250413 + 4133 CONTINUE 07260413 + IVCORR = 100 07270413 +40170 IF (IVCOMP - 100) 20170, 10170, 20170 07280413 +30170 IVDELE = IVDELE + 1 07290413 + WRITE (I02,80000) IVTNUM 07300413 + IF (ICZERO) 10170, 0181, 20170 07310413 +10170 IVPASS = IVPASS + 1 07320413 + WRITE (I02,80002) IVTNUM 07330413 + GO TO 0181 07340413 +20170 IVFAIL = IVFAIL + 1 07350413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07360413 + 0181 CONTINUE 07370413 +C 07380413 +C 07390413 +C TESTS 018 THROUGH 030 READ AND CHECK THE RECORDS CREATED IN 07400413 +C TESTS 002 THROUGH 014. EACH OF THE TESTS IN THIS SET IS CHECKING 07410413 +C TWO THINGS. FIRST, THAT THE READ STATEMENT CONSTRUCT IS ACCEPTED 07420413 +C BY THE COMPILER AND SECOND THAT THE RECORDS CREATED IN TESTS 002 07430413 +C THROUGH 013 AND READ IN THESE TESTS CAN GIVE PREDICTIBLE VALUES. 07440413 +C THE READ STATEMENT IS USED WITH THE I/O LIST ITEM AS A VARIABLE, 07450413 +C AN ARRAY ELEMENT AND AN ARRAY. 07460413 +C 07470413 +C 07480413 +C 07490413 +C **** FCVS PROGRAM 413 - TEST 018 **** 07500413 +C 07510413 +C 07520413 +C TEST 018 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 07530413 +C VARIABLE OF INTEGER TYPE. 07540413 +C 07550413 +C 07560413 + IVTNUM = 18 07570413 + IF (ICZERO) 30180, 0180, 30180 07580413 + 0180 CONTINUE 07590413 + IVON22 = 0 07600413 + IVON56 = 0 07610413 + IVCORR = 30 07620413 + IVCOMP = 1 07630413 + READ (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 07640413 + 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 07650413 + IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 07660413 + IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 3 07670413 + IF (IVON56 .EQ. 32767) IVCOMP = IVCOMP * 5 07680413 +40180 IF (IVCOMP - 30) 20180, 10180, 20180 07690413 +30180 IVDELE = IVDELE + 1 07700413 + WRITE (I02,80000) IVTNUM 07710413 + IF (ICZERO) 10180, 0191, 20180 07720413 +10180 IVPASS = IVPASS + 1 07730413 + WRITE (I02,80002) IVTNUM 07740413 + GO TO 0191 07750413 +20180 IVFAIL = IVFAIL + 1 07760413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07770413 + 0191 CONTINUE 07780413 +C 07790413 +C **** FCVS PROGRAM 413 - TEST 019 **** 07800413 +C 07810413 +C 07820413 +C TEST 019 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 07830413 +C VARIABLE OF REAL TYPE. 07840413 +C 07850413 +C 07860413 + IVTNUM = 19 07870413 + IF (ICZERO) 30190, 0190, 30190 07880413 + 0190 CONTINUE 07890413 + RVON22 = 0.0 07900413 + RVON31 = 0.0 07910413 + IVCORR = 30 07920413 + IVCOMP = 1 07930413 + READ (I10, REC = 02) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 07940413 + 1 RVON21, RVON22, RVON31, RVON32, RVON33, RVON34, RVON55, RVON56 07950413 + IF (IRECN .EQ. 02) IVCOMP = IVCOMP * 2 07960413 + IF (RVON22 .EQ. -11.) IVCOMP = IVCOMP * 3 07970413 + IF (RVON31 .EQ. 7.77) IVCOMP = IVCOMP * 5 07980413 +40190 IF (IVCOMP - 30) 20190, 10190, 20190 07990413 +30190 IVDELE = IVDELE + 1 08000413 + WRITE (I02,80000) IVTNUM 08010413 + IF (ICZERO) 10190, 0201, 20190 08020413 +10190 IVPASS = IVPASS + 1 08030413 + WRITE (I02,80002) IVTNUM 08040413 + GO TO 0201 08050413 +20190 IVFAIL = IVFAIL + 1 08060413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08070413 + 0201 CONTINUE 08080413 +C 08090413 +C **** FCVS PROGRAM 413 - TEST 020 **** 08100413 +C 08110413 +C 08120413 +C TEST 020 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08130413 +C VARIABLE OF LOGICAL TYPE. 08140413 +C 08150413 +C 08160413 + IVTNUM = 20 08170413 + IF (ICZERO) 30200, 0200, 30200 08180413 + 0200 CONTINUE 08190413 + LVONT1 = .FALSE. 08200413 + LVONF6 = .TRUE. 08210413 + IVCORR = 30 08220413 + IVCOMP = 1 08230413 + READ (I10, REC = 03) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08240413 + 1 LVONT1, LVONF2, LVONT3, LVONF4, LVONT5, LVONF6, LVONT7, LVONF808250413 + IF (IRECN .EQ. 03) IVCOMP = IVCOMP * 2 08260413 + IF (.NOT. LVONF6) IVCOMP = IVCOMP * 3 08270413 + IF (LVONT1) IVCOMP = IVCOMP * 5 08280413 +40200 IF (IVCOMP - 30) 20200, 10200, 20200 08290413 +30200 IVDELE = IVDELE + 1 08300413 + WRITE (I02,80000) IVTNUM 08310413 + IF (ICZERO) 10200, 0211, 20200 08320413 +10200 IVPASS = IVPASS + 1 08330413 + WRITE (I02,80002) IVTNUM 08340413 + GO TO 0211 08350413 +20200 IVFAIL = IVFAIL + 1 08360413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08370413 + 0211 CONTINUE 08380413 +C 08390413 +C **** FCVS PROGRAM 413 - TEST 021 **** 08400413 +C 08410413 +C 08420413 +C TEST 021 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08430413 +C ARRAY ELEMENT OF INTEGER TYPE. ONE, TWO, AND THREE 08440413 +C DIMENSION ARRAYS ARE USED. 08450413 +C 08460413 +C 08470413 + IVTNUM = 21 08480413 + IF (ICZERO) 30210, 0210, 30210 08490413 + 0210 CONTINUE 08500413 + IAON12(2) = 0 08510413 + IAON12(8) = 0 08520413 + IVCORR = 30 08530413 + IVCOMP = 1 08540413 + READ (I10, REC = 04) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08550413 + 1 IAON12(1), IAON12(2), IAON22(1,2), IAON22(2,2), IAON32(1,1,2), 08560413 + 2 IAON32(2,1,2), IAON12(7), IAON12(8) 08570413 + IF (IRECN .EQ. 04) IVCOMP = IVCOMP * 2 08580413 + IF (IAON12(2) .EQ. -11) IVCOMP = IVCOMP * 3 08590413 + IF (IAON12(8) .EQ. 32767) IVCOMP = IVCOMP * 5 08600413 +C 08610413 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 08620413 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 08630413 +C 08640413 +40210 IF (IVCOMP - 30) 20210, 10210, 20210 08650413 +30210 IVDELE = IVDELE + 1 08660413 + WRITE (I02,80000) IVTNUM 08670413 + IF (ICZERO) 10210, 0221, 20210 08680413 +10210 IVPASS = IVPASS + 1 08690413 + WRITE (I02,80002) IVTNUM 08700413 + GO TO 0221 08710413 +20210 IVFAIL = IVFAIL + 1 08720413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 08730413 + 0221 CONTINUE 08740413 +C 08750413 +C **** FCVS PROGRAM 413 - TEST 022 **** 08760413 +C 08770413 +C 08780413 +C TEST 022 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 08790413 +C ARRAY ELEMENT OF REAL TYPE. ONE, TWO, AND THREE 08800413 +C DIMENSION ARRAYS ARE USED. 08810413 +C 08820413 +C 08830413 + IVTNUM = 22 08840413 + IF (ICZERO) 30220, 0220, 30220 08850413 + 0220 CONTINUE 08860413 + RAON22(2,2) = 0.0 08870413 + RAON32(1,1,2) = 0.0 08880413 + IVCORR = 30 08890413 + IVCOMP = 1 08900413 + READ (I10, REC = 05) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 08910413 + 1 RAON12(1), RAON12(2), RAON22(1,2), RAON22(2,2), RAON32(1,1,2), 08920413 + 2 RAON32(2,1,2), RAON12(7), RAON12(8) 08930413 + IF (IRECN .EQ. 05) IVCOMP = IVCOMP * 2 08940413 + IF (RAON22(2,2) .EQ. -7.77) IVCOMP = IVCOMP * 3 08950413 + IF (RAON32(1,1,2) .EQ. .512 ) IVCOMP = IVCOMP * 5 08960413 +C 08970413 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 08980413 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 08990413 +C 09000413 +40220 IF (IVCOMP - 30) 20220, 10220, 20220 09010413 +30220 IVDELE = IVDELE + 1 09020413 + WRITE (I02,80000) IVTNUM 09030413 + IF (ICZERO) 10220, 0231, 20220 09040413 +10220 IVPASS = IVPASS + 1 09050413 + WRITE (I02,80002) IVTNUM 09060413 + GO TO 0231 09070413 +20220 IVFAIL = IVFAIL + 1 09080413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09090413 + 0231 CONTINUE 09100413 +C 09110413 +C **** FCVS PROGRAM 413 - TEST 023 **** 09120413 +C 09130413 +C 09140413 +C TEST 023 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09150413 +C ARRAY ELEMENT OF LOGICAL TYPE. ONE, TWO, AND THREE 09160413 +C DIMENSION ARRAYS ARE USED. 09170413 +C 09180413 +C 09190413 + IVTNUM = 23 09200413 + IF (ICZERO) 30230, 0230, 30230 09210413 + 0230 CONTINUE 09220413 + LAON12(1) = .FALSE. 09230413 + LAON32(2,1,2) = .TRUE. 09240413 + IVCORR = 30 09250413 + IVCOMP = 1 09260413 + READ (I10, REC = 06) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09270413 + 1 LAON12(1), LAON12(2), LAON22(1,2), LAON22(2,2), LAON32(1,1,2), 09280413 + 2 LAON32(2,1,2), LAON12(7), LAON12(8) 09290413 + IF (IRECN .EQ. 06) IVCOMP = IVCOMP * 2 09300413 + IF (LAON12(1)) IVCOMP = IVCOMP * 3 09310413 + IF (.NOT. LAON32(2,1,2)) IVCOMP = IVCOMP * 5 09320413 +40230 IF (IVCOMP - 30) 20230, 10230, 20230 09330413 +30230 IVDELE = IVDELE + 1 09340413 + WRITE (I02,80000) IVTNUM 09350413 + IF (ICZERO) 10230, 0241, 20230 09360413 +10230 IVPASS = IVPASS + 1 09370413 + WRITE (I02,80002) IVTNUM 09380413 + GO TO 0241 09390413 +20230 IVFAIL = IVFAIL + 1 09400413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09410413 + 0241 CONTINUE 09420413 +C 09430413 +C **** FCVS PROGRAM 413 - TEST 024 **** 09440413 +C 09450413 +C 09460413 +C TEST 024 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09470413 +C ARRAY OF INTEGER TYPE. 09480413 +C 09490413 +C 09500413 + IVTNUM = 24 09510413 + IF (ICZERO) 30240, 0240, 30240 09520413 + 0240 CONTINUE 09530413 + IAON32(2,1,1) = 0 09540413 + IAON32(2,2,2) = 0 09550413 + IVCORR = 30 09560413 + IVCOMP = 1 09570413 + READ (I10, REC = 07) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09580413 + 1 IAON32 09590413 + IF (IRECN .EQ. 07) IVCOMP = IVCOMP * 2 09600413 + IF (IAON32(2,1,1) .EQ. -11) IVCOMP = IVCOMP * 3 09610413 + IF (IAON32(2,2,2) .EQ. 32767) IVCOMP = IVCOMP * 5 09620413 +C 09630413 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 09640413 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 09650413 +C 09660413 +40240 IF (IVCOMP - 30) 20240, 10240, 20240 09670413 +30240 IVDELE = IVDELE + 1 09680413 + WRITE (I02,80000) IVTNUM 09690413 + IF (ICZERO) 10240, 0251, 20240 09700413 +10240 IVPASS = IVPASS + 1 09710413 + WRITE (I02,80002) IVTNUM 09720413 + GO TO 0251 09730413 +20240 IVFAIL = IVFAIL + 1 09740413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 09750413 + 0251 CONTINUE 09760413 +C 09770413 +C **** FCVS PROGRAM 413 - TEST 025 **** 09780413 +C 09790413 +C 09800413 +C TEST 025 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 09810413 +C ARRAY OF REAL TYPE. 09820413 +C 09830413 +C 09840413 + IVTNUM = 25 09850413 + IF (ICZERO) 30250, 0250, 30250 09860413 + 0250 CONTINUE 09870413 + RAON32(2,1,1) = 0.0 09880413 + RAON32(2,2,2) = 0.0 09890413 + IVCORR = 30 09900413 + IVCOMP = 1 09910413 + READ (I10, REC = 08) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 09920413 + 1 RAON32 09930413 + IF (IRECN .EQ. 08) IVCOMP = IVCOMP * 2 09940413 + IF (RAON32(2,1,1) .EQ. -11.) IVCOMP = IVCOMP * 3 09950413 + IF (RAON32(2,2,2) .EQ. 32767.) IVCOMP = IVCOMP * 5 09960413 +C 09970413 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 09980413 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 09990413 +C 10000413 +40250 IF (IVCOMP - 30) 20250, 10250, 20250 10010413 +30250 IVDELE = IVDELE + 1 10020413 + WRITE (I02,80000) IVTNUM 10030413 + IF (ICZERO) 10250, 0261, 20250 10040413 +10250 IVPASS = IVPASS + 1 10050413 + WRITE (I02,80002) IVTNUM 10060413 + GO TO 0261 10070413 +20250 IVFAIL = IVFAIL + 1 10080413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10090413 + 0261 CONTINUE 10100413 +C 10110413 +C **** FCVS PROGRAM 413 - TEST 026 **** 10120413 +C 10130413 +C 10140413 +C TEST 026 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10150413 +C ARRAY OF LOGICAL TYPE. 10160413 +C 10170413 +C 10180413 + IVTNUM = 26 10190413 + IF (ICZERO) 30260, 0260, 30260 10200413 + 0260 CONTINUE 10210413 + LAON32(1,1,1) = .FALSE. 10220413 + LAON32(2,2,2) = .TRUE. 10230413 + IVCORR = 30 10240413 + IVCOMP = 1 10250413 + READ (I10, REC = 09) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10260413 + 1 LAON32 10270413 + IF (IRECN .EQ. 09) IVCOMP = IVCOMP * 2 10280413 + IF (LAON32(1,1,1)) IVCOMP = IVCOMP * 3 10290413 + IF (.NOT. LAON32(2,2,2)) IVCOMP = IVCOMP * 5 10300413 +40260 IF (IVCOMP - 30) 20260, 10260, 20260 10310413 +30260 IVDELE = IVDELE + 1 10320413 + WRITE (I02,80000) IVTNUM 10330413 + IF (ICZERO) 10260, 0271, 20260 10340413 +10260 IVPASS = IVPASS + 1 10350413 + WRITE (I02,80002) IVTNUM 10360413 + GO TO 0271 10370413 +20260 IVFAIL = IVFAIL + 1 10380413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10390413 + 0271 CONTINUE 10400413 +C 10410413 +C **** FCVS PROGRAM 413 - TEST 027 **** 10420413 +C 10430413 +C 10440413 +C TEST 027 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10450413 +C IMPLIED-DO WITH AN ITEM OF INTEGER TYPE. THE STORAGE VALUES IN 10460413 +C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 10470413 +C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD 10480413 +C OF THE FILE. THIS RECORD IS RECORD NUMBER 10 AND WAS CREATED IN 10490413 +C TEST 012 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN 10500413 +C ARRAY IAON32 AND SUBSCRIPT VALUE AFTER THE READ IS 10510413 +C 10520413 +C VALUE 11 777 512 -32767 -11 -777 -512 32767 10530413 +C FIELD POS 1 3 2 4 5 7 6 8 10540413 +C IAON32 1 2 3 4 5 6 7 8 10550413 +C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,210560413 +C 10570413 +C 10580413 + IVTNUM = 27 10590413 + IF (ICZERO) 30270, 0270, 30270 10600413 + 0270 CONTINUE 10610413 + IAON32(2,1,1) = 0 10620413 + IAON32(2,2,1) = 0 10630413 + IVCORR = 30 10640413 + IVCOMP = 1 10650413 + READ (I10, REC = 10) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 10660413 + 1 (((IAON32 (J,K,I), K=1,2), J=1,2), I=1,2) 10670413 + IF (IRECN .EQ. 10) IVCOMP = IVCOMP * 2 10680413 + IF (IAON32(2,1,1) .EQ. 777) IVCOMP = IVCOMP * 3 10690413 + IF (IAON32(2,2,1) .EQ. -32767) IVCOMP = IVCOMP * 5 10700413 +C 10710413 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 10720413 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 10730413 +C 10740413 +40270 IF (IVCOMP - 30) 20270, 10270, 20270 10750413 +30270 IVDELE = IVDELE + 1 10760413 + WRITE (I02,80000) IVTNUM 10770413 + IF (ICZERO) 10270, 0281, 20270 10780413 +10270 IVPASS = IVPASS + 1 10790413 + WRITE (I02,80002) IVTNUM 10800413 + GO TO 0281 10810413 +20270 IVFAIL = IVFAIL + 1 10820413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 10830413 + 0281 CONTINUE 10840413 +C 10850413 +C **** FCVS PROGRAM 413 - TEST 028 **** 10860413 +C 10870413 +C 10880413 +C TEST 028 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 10890413 +C IMPLIED-DO WITH AN ITEM OF REAL TYPE. THE STORAGE VALUES IN 10900413 +C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 10910413 +C SEQUENCE THE SAME AS FOUND IN THE RECORD OF THE FILE. THIS REC- 10920413 +C ORD IS RECORD NUMBER 011 AND WAS CREATED IN TEST 013 ABOVE. 10930413 +C THE FIELD VALUE, FIELD POSITION, POSITION WITHIN ARRAY RAON32 AND10940413 +C SUBSCRIPT VALUE AFTER THE THE READ IS 10950413 +C 10960413 +C VALUE 11. -11. 7.77 -7.77 .512 -.512 -32767. 32767.10970413 +C FIELD POS 1 2 3 4 5 6 7 8 10980413 +C RAON32 1 2 3 4 5 6 7 8 10990413 +C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,211000413 +C 11010413 +C 11020413 + IVTNUM = 28 11030413 + IF (ICZERO) 30280, 0280, 30280 11040413 + 0280 CONTINUE 11050413 + RAON32(1,2,1) = 0.0 11060413 + RAON32(1,2,2) = 0.0 11070413 + IVCORR = 30 11080413 + IVCOMP = 1 11090413 + READ (I10, REC = 11) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 11100413 + 1 (((RAON32 (J,K,I), J=1,2), K=1,2), I=1,2) 11110413 + IF (IRECN .EQ. 11) IVCOMP = IVCOMP * 2 11120413 + IF (RAON32(1,2,1) .EQ. 7.77) IVCOMP = IVCOMP * 3 11130413 + IF (RAON32(1,2,2) .EQ. -32767.) IVCOMP = IVCOMP * 5 11140413 +C 11150413 +C THE ABOVE 3 IF STATEMENTS CHECK THE RECORD NUMBER, A NEGATIVE 11160413 +C FIELD VALUE AND A POSITIVE FIELD VALUE. 11170413 +C 11180413 +40280 IF (IVCOMP - 30) 20280, 10280, 20280 11190413 +30280 IVDELE = IVDELE + 1 11200413 + WRITE (I02,80000) IVTNUM 11210413 + IF (ICZERO) 10280, 0291, 20280 11220413 +10280 IVPASS = IVPASS + 1 11230413 + WRITE (I02,80002) IVTNUM 11240413 + GO TO 0291 11250413 +20280 IVFAIL = IVFAIL + 1 11260413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11270413 + 0291 CONTINUE 11280413 +C 11290413 +C **** FCVS PROGRAM 413 - TEST 029 **** 11300413 +C 11310413 +C 11320413 +C TEST 029 USES A READ STATEMENT WHERE THE INPUT LIST ITEM IS A 11330413 +C IMPLIED-DO WITH AN ITEM OF LOGICAL TYPE. THE STORAGE VALUES IN 11340413 +C THE ARRAY (BY THE IMPLIED-DO DURING THE READ) SHOULD RESULT IN A 11350413 +C DIFFERENT STORAGE SEQUENCE IN THE ARRAY THAN FOUND IN THE RECORD 11360413 +C OF THE FILE. THIS RECORD IS RECORD NUMBER 12 AND WAS CREATED IN 11370413 +C TEST 014 ABOVE. THE FIELD VALUE, FIELD POSITION, POSITION WITHIN 11380413 +C ARRAY LAON32 AND SUBSCRIPT VALUE AFTER THE READ IS 11390413 +C 11400413 +C VALUE T T F F T T F F 11410413 +C FIELD POS 1 5 3 7 2 6 4 8 11420413 +C LAON32 1 2 3 4 5 6 7 8 11430413 +C SUBSCRIPT 1,1,1 2,1,1 1,2,1 2,2,1 1,1,2 2,1,2 1,2,2 2,2,211440413 +C 11450413 +C 11460413 + IVTNUM = 29 11470413 + IF (ICZERO) 30290, 0290, 30290 11480413 + 0290 CONTINUE 11490413 + LAON32(1,2,1) = .TRUE. 11500413 + LAON32(2,1,1) = .FALSE. 11510413 + IVCORR = 30 11520413 + IVCOMP = 1 11530413 + READ (I10, REC = 12) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 11540413 + 1 (((LAON32 (J,K,I), I=1,2), K=1,2), J=1,2) 11550413 + IF (IRECN .EQ. 12) IVCOMP = IVCOMP * 2 11560413 + IF ( .NOT. LAON32(1,2,1)) IVCOMP = IVCOMP * 3 11570413 + IF (LAON32(2,1,1)) IVCOMP = IVCOMP * 5 11580413 +40290 IF (IVCOMP - 30) 20290, 10290, 20290 11590413 +30290 IVDELE = IVDELE + 1 11600413 + WRITE (I02,80000) IVTNUM 11610413 + IF (ICZERO) 10290, 0301, 20290 11620413 +10290 IVPASS = IVPASS + 1 11630413 + WRITE (I02,80002) IVTNUM 11640413 + GO TO 0301 11650413 +20290 IVFAIL = IVFAIL + 1 11660413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11670413 + 0301 CONTINUE 11680413 +C 11690413 +C **** FCVS PROGRAM 413 - TEST 030 **** 11700413 +C 11710413 +C 11720413 +C TEST 030 USES A READ STATEMENT WITHOUT ANY INPUT LIST ITEMS 11730413 +C (INPUT LIST ITEMS ARE OPTIONAL FOR THE READ STATEMENT). THIS 11740413 +C RECORD WAS WRITTEN IN TEST 14 AND SHOULD BE RECORD NUMBER 13. 11750413 +C THE PURPOSE OF THIS TEST IS TO SEE THAT THE STATEMENT CONSTRUCT 11760413 +C IS ACCEPTABLE TO THE COMPILER. 11770413 +C ALSO THE LENGTH OF AN UNFORMATTED RECORD MAY BE ZERO. 11780413 +C 11790413 +C SEE SECTIONS 12.1.2, UNFORMATTED RECORDS 11800413 +C 12.8, READ, WRITE AND PRINT STATEMENTS11810413 +C 11820413 +C 11830413 + IVTNUM = 30 11840413 + IF (ICZERO) 30300, 0300, 30300 11850413 + 0300 CONTINUE 11860413 + IRECN = 13 11870413 + IVCORR = 13 11880413 + READ (I10, REC = 13) 11890413 + IVCOMP = IRECN 11900413 +40300 IF (IVCOMP - 13) 20300, 10300, 20300 11910413 +30300 IVDELE = IVDELE + 1 11920413 + WRITE (I02,80000) IVTNUM 11930413 + IF (ICZERO) 10300, 0311, 20300 11940413 +10300 IVPASS = IVPASS + 1 11950413 + WRITE (I02,80002) IVTNUM 11960413 + GO TO 0311 11970413 +20300 IVFAIL = IVFAIL + 1 11980413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 11990413 + 0311 CONTINUE 12000413 +C 12010413 +C **** FCVS PROGRAM 413 - TEST 031 **** 12020413 +C 12030413 +C 12040413 +C TEST 031 USES A READ STATEMENT IN WHICH THE NUMBER OF VALUES 12050413 +C REQUIRED BY THE INPUT LIST IS LESS THAN THE NUMBER OF VALUES IN 12060413 +C THE RECORD. 12070413 +C 12080413 +C SEE SECTION 12.9.5.1, UNFORMATED DATA TRANSFER 12090413 +C 12100413 +C 12110413 + IVTNUM = 31 12120413 + IF (ICZERO) 30310, 0310, 30310 12130413 + 0310 CONTINUE 12140413 + IVON21 = 0 12150413 + IVON22 = 0 12160413 + IVON31 = 0 12170413 + IVCORR = 0 12180413 + IVCOMP = 1 12190413 + READ (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12200413 + 1 IVON21, IVON22, IVON31 12210413 + IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 12220413 + IF (IVON21 .EQ. 11) IVCOMP = IVCOMP * 3 12230413 + IF (IVON22 .EQ. -11) IVCOMP = IVCOMP * 5 12240413 +40310 IF (IVCOMP - 30) 20310, 10310, 20310 12250413 +30310 IVDELE = IVDELE + 1 12260413 + WRITE (I02,80000) IVTNUM 12270413 + IF (ICZERO) 10310, 0321, 20310 12280413 +10310 IVPASS = IVPASS + 1 12290413 + WRITE (I02,80002) IVTNUM 12300413 + GO TO 0321 12310413 +20310 IVFAIL = IVFAIL + 1 12320413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12330413 + 0321 CONTINUE 12340413 +C 12350413 +C 12360413 +C TEST 032 AND 033 VERIFIES THAT RECORDS MAY BE READ IN ANY ORDER12370413 +C ALSO THAT A VARIABLE MAY BE USED AS THE OPERAND OF THE REC SPEC- 12380413 +C IFIER FOR A READ STATEMENT. 12390413 +C 12400413 +C SEE SECTION 2.2.4.2(1) , DIRECT ACCESS 12410413 +C 12420413 +C 12430413 +C 12440413 +C **** FCVS PROGRAM 413 - TEST 032 **** 12450413 +C 12460413 +C 12470413 +C TEST 032 READS THE RECORDS WRITTEN IN TEST 16. EVERY OTHER 12480413 +C RECORD IS READ FOR A TOTAL OF 100 RECORDS (THE REC SPECIFIER 12490413 +C VARIABLE IS INCREMENTED BY 2). 12500413 +C 12510413 +C 12520413 + IVTNUM = 32 12530413 + IF (ICZERO) 30320, 0320, 30320 12540413 + 0320 CONTINUE 12550413 + IRECCK = 13 12560413 + IRECN = 0 12570413 + IREC = 13 12580413 + IVCOMP = 0 12590413 + DO 4134 I = 1,100 12600413 + IREC = IREC + 2 12610413 + IRECCK = IRECCK + 2 12620413 + READ (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12630413 + 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 12640413 + IF (IRECN .EQ. IRECCK) IVCOMP = IVCOMP + 1 12650413 + 4134 CONTINUE 12660413 + IVCORR = 100 12670413 +40320 IF (IVCOMP - 100) 20320, 10320, 20320 12680413 +30320 IVDELE = IVDELE + 1 12690413 + WRITE (I02,80000) IVTNUM 12700413 + IF (ICZERO) 10320, 0331, 20320 12710413 +10320 IVPASS = IVPASS + 1 12720413 + WRITE (I02,80002) IVTNUM 12730413 + GO TO 0331 12740413 +20320 IVFAIL = IVFAIL + 1 12750413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 12760413 + 0331 CONTINUE 12770413 +C 12780413 +C **** FCVS PROGRAM 413 - TEST 033 **** 12790413 +C 12800413 +C 12810413 +C TEST 033 READS THE RECORDS WRITTEN IN TEST 17. THIS TEST IS 12820413 +C SIMILAR TO TEST 32 ABOVE EXCEPT THE FILE IS READ IN REVERSE 12830413 +C RECORD NUMBER ORDER. 12840413 +C 12850413 +C 12860413 + IVTNUM = 33 12870413 + IF (ICZERO) 30330, 0330, 30330 12880413 + 0330 CONTINUE 12890413 + IRECCK = 216 12900413 + IRECN = 0 12910413 + IVCOMP = 0 12920413 + IREC = 216 12930413 + DO 4135 I = 1,100 12940413 + IREC = IREC - 2 12950413 + IRECCK = IRECCK - 2 12960413 + READ (I10, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 12970413 + 1 IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56 12980413 + IF (IRECN .EQ. IRECCK) IVCOMP = IVCOMP + 1 12990413 + 4135 CONTINUE 13000413 + IVCORR = 100 13010413 +40330 IF (IVCOMP - 100) 20330, 10330, 20330 13020413 +30330 IVDELE = IVDELE + 1 13030413 + WRITE (I02,80000) IVTNUM 13040413 + IF (ICZERO) 10330, 0341, 20330 13050413 +10330 IVPASS = IVPASS + 1 13060413 + WRITE (I02,80002) IVTNUM 13070413 + GO TO 0341 13080413 +20330 IVFAIL = IVFAIL + 1 13090413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 13100413 + 0341 CONTINUE 13110413 +C 13120413 +C **** FCVS PROGRAM 413 - TEST 034 **** 13130413 +C 13140413 +C 13150413 +C TEST 034 VERIFIES THAT THE VALUES OF A RECORD MAY BE CHANGED 13160413 +C WHEN THE RECORD IS REWRITTEN. RECORD NUMBER 01 IS USED FOR 13170413 +C TESTING. THE RECORD WAS WRITTEN IN TEST 02 AND READ IN TEST 18. 13180413 +C A RECORD CANNOT BE DELETED FROM THE FILE BUT IT CAN BE REWRITTEN. 13190413 +C 13200413 +C SEE SECTION 12.2.4.2 (5), DIRECT ACCESS 13210413 +C 13220413 +C 13230413 + IVTNUM = 34 13240413 + IF (ICZERO) 30340, 0340, 30340 13250413 + 0340 CONTINUE 13260413 + IRECN = 01 13270413 + WRITE (I10, REC = 01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 13280413 + 1 ICON31, ICON32, ICON21, ICON22, ICON55, ICON56, ICON33, ICON3413290413 + READ (I10, REC=01) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF, 13300413 + 1 IVON61, IVON62, IVON63, IVON64, IVON65,IVON66, IVON67, IVON68 13310413 + IVCORR = 210 13320413 + IVCOMP = 1 13330413 + IF (IRECN .EQ. 01) IVCOMP = IVCOMP * 2 13340413 + IF (IVON61 .EQ. 777) IVCOMP = IVCOMP * 3 13350413 + IF (IVON62 .EQ. -777) IVCOMP = IVCOMP * 5 13360413 + IF (IVON66 .EQ. 32767) IVCOMP = IVCOMP * 7 13370413 +40340 IF (IVCOMP - 210) 20340, 10340, 20340 13380413 +30340 IVDELE = IVDELE + 1 13390413 + WRITE (I02,80000) IVTNUM 13400413 + IF (ICZERO) 10340, 0351, 20340 13410413 +10340 IVPASS = IVPASS + 1 13420413 + WRITE (I02,80002) IVTNUM 13430413 + GO TO 0351 13440413 +20340 IVFAIL = IVFAIL + 1 13450413 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 13460413 + 0351 CONTINUE 13470413 +C 13480413 +C 13490413 +C THE FOLLOWING SOURCE CODE BRACKETED BY THE COMMENT LINES 13500413 +C ***** BEGIN-FILE-DUMP SECTION AND ***** END-FILE-DUMP SECTION 13510413 +C MAY OR MAY NOT APPEAR AS COMMENTS IN THE SOURCE PROGRAM. 13520413 +C THIS CODE IS OPTIONAL AND BY DEFAULT IT IS AUTOMATICALLY COMMENTED13530413 +C OUT BY THE EXECUTIVE ROUTINE. A DUMP OF THE FILE USED BY THIS 13540413 +C ROUTINE IS PROVIDED BY USING THE *OPT1 EXECUTIVE ROUTINE CONTROL 13550413 +C CARD. IF THE OPTIONAL CODE IS SELECTED THE ROUTINE WILL DUMP 13560413 +C THE CONTENTS OF THE FILE TO THE PRINT FILE FOLLOWING THE TEST 13570413 +C REPORT AND BEFORE THE TEST REPORT SUMMARY. 13580413 +C 13590413 +CDB** BEGIN FILE DUMP CODE 13600413 +C ITOTR = 214 13610413 +C ILUN = I10 13620413 +C IRLGN = 80 13630413 +C IRNUM = 1 13640413 +C7701 FORMAT (80A1) 13650413 +C7702 FORMAT (1X,80A1) 13660413 +C7703 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - OK" ) 13670413 +C7704 FORMAT (10X,"FILE ",I2," HAS ",I3," RECORDS - THERE SHOULD BE " ,I13680413 +C 13,9H RECORDS.) 13690413 +C DO 7771 IRNUM = 1, ITOTR 13700413 +C READ (ILUN, REC = IRNUM) (IDUMP(ICH), ICH = 1, IRLGN) 13710413 +C WRITE (I02, 7702) (IDUMP(ICH), ICH = 1, IRLGN) 13720413 +C7771 CONTINUE 13730413 +CDE** END OF DUMP CODE 13740413 +C TEST 034 IS THE LAST TEST IN THIS PROGRAM. THE ROUTINE SHOULD13750413 +C HAVE MADE 34 EXPLICIT TESTS AND PROCESSED ONE FILE CONNECTED FOR 13760413 +C DIRECT ACCESS 13770413 +C 13780413 +C 13790413 +C 13800413 +C WRITE OUT TEST SUMMARY 13810413 +C 13820413 + WRITE (I02,90004) 13830413 + WRITE (I02,90014) 13840413 + WRITE (I02,90004) 13850413 + WRITE (I02,90000) 13860413 + WRITE (I02,90004) 13870413 + WRITE (I02,90020) IVFAIL 13880413 + WRITE (I02,90022) IVPASS 13890413 + WRITE (I02,90024) IVDELE 13900413 + STOP 13910413 +90001 FORMAT (" ",24X,"FM413") 13920413 +90000 FORMAT (" ",20X,"END OF PROGRAM FM413" ) 13930413 +C 13940413 +C FORMATS FOR TEST DETAIL LINES 13950413 +C 13960413 +80000 FORMAT (" ",4X,I5,6X,"DELETED") 13970413 +80002 FORMAT (" ",4X,I5,7X,"PASS") 13980413 +80010 FORMAT (" ",4X,I5,7X,"FAIL",10X,I6,9X,I6) 13990413 +80012 FORMAT (" ",4X,I5,7X,"FAIL",4X,E12.5,3X,E12.5) 14000413 +80018 FORMAT (" ",4X,I5,7X,"FAIL",2X,A14,1X,A14) 14010413 +C 14020413 +C FORMAT STATEMENTS FOR PAGE HEADERS 14030413 +C 14040413 +90002 FORMAT ("1") 14050413 +90004 FORMAT (" ") 14060413 +90006 FORMAT (" ",10X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 14070413 +90008 FORMAT (" ",21X,"VERSION 2.1" ) 14080413 +90010 FORMAT (" ",8X,"FOR OFFICIAL USE ONLY - COPYRIGHT 1978" ) 14090413 +90012 FORMAT (" ",5X,"TEST",5X,"PASS/FAIL",5X,"COMPUTED",8X,"CORRECT") 14100413 +90014 FORMAT (" ",5X,"----------------------------------------------" ) 14110413 +90016 FORMAT (" ",18X,"SUBSET LEVEL TEST" ) 14120413 +C 14130413 +C FORMAT STATEMENTS FOR RUN SUMMARY 14140413 +C 14150413 +90020 FORMAT (" ",19X,I5," TESTS FAILED" ) 14160413 +90022 FORMAT (" ",19X,I5," TESTS PASSED" ) 14170413 +90024 FORMAT (" ",19X,I5," TESTS DELETED" ) 14180413 + END 14190413 diff --git a/Fortran/UnitTests/fcvs21_f95/FM413.reference_output b/Fortran/UnitTests/fcvs21_f95/FM413.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM413.reference_output @@ -0,0 +1,55 @@ +1 + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 + + FOR OFFICIAL USE ONLY - COPYRIGHT 1978 + + SUBSET LEVEL TEST + FM413 + + TEST PASS/FAIL COMPUTED CORRECT + ---------------------------------------------- + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + + ---------------------------------------------- + + END OF PROGRAM FM413 + + 0 TESTS FAILED + 34 TESTS PASSED + 0 TESTS DELETED +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM500.f b/Fortran/UnitTests/fcvs21_f95/FM500.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM500.f @@ -0,0 +1,805 @@ + PROGRAM FM500 + +C***********************************************************************00010500 +C***** FORTRAN 77 00020500 +C***** FM500 00030500 +C***** BLKD1 - (260) 00040500 +C***** THIS PROGRAM USES SN501 AND AN502 00050500 +C***********************************************************************00060500 +C***** TESTING OF BLOCK DATA SUBPROGRAMS FEATURES ANS REF 00070500 +C***** IMPLICIT, PARAMETER, EXTERNAL, AND SAVE 16 00080500 +C***** THIS SEGMENT USES BLOCK DATA PROGRAM 00090500 +C***** AN502 AND SUBROUTINE SN501 00100500 +C***** 00110500 +C***** S P E C I F I C A T I O N S SEGMENT 260 00120500 + EXTERNAL AN502 00130500 +C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00140500 +C***** PARAMETER (KPI = 2, LPI = 10) 00150500 +C***** INTEGER FXVI 00160500 +C***** REAL JX1S 00170500 +C***** DOUBLE PRECISION AX1D, BX4D 00180500 +C***** DIMENSION BX4D(KPI, KPI, KPI, KPI) 00190500 +C***** COMPLEX AXVC, BX1C, CZ5C 00200500 +C***** LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00210500 +C***** CHARACTER*1 A1XVK, B1X1K, C1X7K 00220500 +C***** CHARACTER*2 D2Z1K 00230500 +C***** CHARACTER*4 E4XVK, G4X2K 00240500 +C***** CHARACTER*(LPI) I10XVK 00250500 +C***** 00260500 +C***** COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00270500 +C***** COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00280500 +C***** COMMON /BLK3/ RXVD, AX1D(2), BX4D 00290500 +C***** COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00300500 +C***** COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00310500 +C***** COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00320500 +C***** S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00330500 +C***** 00340500 + CALL SN501 00350500 + STOP 00360500 +C***** END OF TEST SEGMENT 260 00370500 + END 00380500 + +C***********************************************************************00010501 +C***** FORTRAN 77 00020501 +C***** FM501 SN501 - (251) 00030501 +C***** THIS SUBROUTINE IS CALLED BY PROGRAM FM500 00040501 +C***********************************************************************00050501 +C***** 00060501 +C***** GENERAL PURPOSE 00070501 +C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 250 00080501 +C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF 00090501 +C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY 00100501 +C***** VARIABLES 00110501 +C***** 00120501 +CBB** ********************** BBCCOMNT **********************************00130501 +C**** 00140501 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150501 +C**** VERSION 2.1 00160501 +C**** 00170501 +C**** 00180501 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190501 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200501 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00210501 +C**** BUILDING 225 RM A266 00220501 +C**** GAITHERSBURG, MD 20899 00230501 +C**** 00240501 +C**** 00250501 +C**** 00260501 +CBE** ********************** BBCCOMNT **********************************00270501 + SUBROUTINE SN501 00280501 +C***** 00290501 + IMPLICIT INTEGER (H) 00300501 + IMPLICIT DOUBLE PRECISION (R) 00310501 + IMPLICIT CHARACTER*2 (S) 00320501 +C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00330501 + PARAMETER (KPI = 2, LPI = 10) 00340501 + INTEGER FXVI 00350501 + REAL JX1S 00360501 + DOUBLE PRECISION AX1D, BX4D, DVCORR 00370501 + DIMENSION BX4D(KPI, KPI, KPI, KPI) 00380501 + COMPLEX AXVC, BX1C, CZ5C 00390501 + LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00400501 + CHARACTER*1 A1XVK, B1X1K, C1X7K, CVNC01 00410501 + CHARACTER*2 D2Z1K, CVNC02 00420501 + CHARACTER*4 E4XVK, G4X2K, CVNC04 00430501 + CHARACTER*(LPI) I10XVK, CVNC10 00440501 +C***** 00450501 + COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00460501 + COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00470501 + COMMON /BLK3/ RXVD, AX1D(2), BX4D 00480501 + COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00490501 + COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00500501 + COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00510501 + 1 S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00520501 +C***** 00530501 + SAVE/BLK6/ 00540501 +C***** 00550501 + EQUIVALENCE (NYVI, EZVS) 00560501 +C***** LOCAL DECLARATIONS 00570501 + DOUBLE PRECISION AVD 00580501 + COMPLEX AVC 00590501 +C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. 00600501 +CBB** ********************** BBCINITA **********************************00610501 +C**** SPECIFICATION STATEMENTS 00620501 +C**** 00630501 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00640501 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00650501 +CBE** ********************** BBCINITA **********************************00660501 +CBB** ********************** BBCINITB **********************************00670501 +C**** INITIALIZE SECTION 00680501 + DATA ZVERS, ZVERSD, ZDATE 00690501 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00700501 + DATA ZCOMPL, ZNAME, ZTAPE 00710501 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00720501 + DATA ZPROJ, ZTAPED, ZPROG 00730501 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00740501 + DATA REMRKS /' '/ 00750501 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00760501 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00770501 +C**** 00780501 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00790501 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00800501 +CZ03 ZPROG = 'PROGRAM NAME' 00810501 +CZ04 ZDATE = 'DATE OF TEST' 00820501 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00830501 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00840501 +CZ07 ZNAME = 'NAME OF USER' 00850501 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00860501 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00870501 +C 00880501 + IVPASS = 0 00890501 + IVFAIL = 0 00900501 + IVDELE = 0 00910501 + IVINSP = 0 00920501 + IVTOTL = 0 00930501 + IVTOTN = 0 00940501 + ICZERO = 0 00950501 +C 00960501 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00970501 + I01 = 05 00980501 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00990501 + I02 = 06 01000501 +C 01010501 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01020501 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01030501 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01040501 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01050501 +C 01060501 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01070501 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01080501 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01090501 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01100501 +C 01110501 +CBE** ********************** BBCINITB **********************************01120501 + NWVI = I02 01130501 + IVTOTL = 37 01140501 + ZPROG='FM500' 01150501 +CBB** ********************** BBCHED0A **********************************01160501 +C**** 01170501 +C**** WRITE REPORT TITLE 01180501 +C**** 01190501 + WRITE (I02, 90002) 01200501 + WRITE (I02, 90006) 01210501 + WRITE (I02, 90007) 01220501 + WRITE (I02, 90008) ZVERS, ZVERSD 01230501 + WRITE (I02, 90009) ZPROG, ZPROG 01240501 + WRITE (I02, 90010) ZDATE, ZCOMPL 01250501 +CBE** ********************** BBCHED0A **********************************01260501 +C***** 01270501 + WRITE(NWVI,26000) 01280501 +26000 FORMAT( / " BLKD1 - (260) BLOCK DATA SUBPROGRAMS --" / 01290501 + 1 " IMPLICIT, PARAMETER, EXTERNAL, SAVE" // 01300501 + 2 " ANS REF. - 16" ) 01310501 +C***** 01320501 +CBB** ********************** BBCHED0B **********************************01330501 +C**** WRITE DETAIL REPORT HEADERS 01340501 +C**** 01350501 + WRITE (I02,90004) 01360501 + WRITE (I02,90004) 01370501 + WRITE (I02,90013) 01380501 + WRITE (I02,90014) 01390501 + WRITE (I02,90015) IVTOTL 01400501 +CBE** ********************** BBCHED0B **********************************01410501 +C**** TO DELETE A TEST USED CODE SHOWN IN TEST 1 01420501 +C**** REPLACE THE DELETE COMMENT WITH DELETE CODE 01430501 +CT001* TEST 1 INTEGER VARIABLE 01440501 + IVTNUM=1 01450501 + WRITE (NWVI,70140) 01460501 + IVCORR=5 01470501 +40010 IF (IXVI - 5) 20010,10010,20010 01480501 +10010 IVPASS=IVPASS+1 01490501 + WRITE (NWVI,80002) IVTNUM 01500501 + GO TO 0011 01510501 +20010 IVFAIL=IVFAIL+1 01520501 + WRITE (NWVI,80008) IVTNUM 01530501 + WRITE (NWVI,80024) IXVI 01540501 + WRITE (NWVI,80026) IVCORR 01550501 + 0011 CONTINUE 01560501 +CT002* TEST 2 INTEGER DECLARE VARIABLE 01570501 + IVTNUM = 2 01580501 + IVCORR=6 01590501 + IF (FXVI - 6) 20020,10020,20020 01600501 +10020 IVPASS=IVPASS+1 01610501 + WRITE (NWVI,80002) IVTNUM 01620501 + GO TO 0021 01630501 +20020 IVFAIL=IVFAIL+1 01640501 + WRITE (NWVI,80008) IVTNUM 01650501 + WRITE (NWVI,80024) FXVI 01660501 + WRITE (NWVI,80026) IVCORR 01670501 + 0021 CONTINUE 01680501 +CT003* TEST 3 INTEGER ARRAY 01690501 + IVTNUM = 3 01700501 + IVCORR=8 01710501 + IF (KX1I(2) - 8) 20030,10030,20030 01720501 +10030 IVPASS=IVPASS+1 01730501 + WRITE (NWVI,80002) IVTNUM 01740501 + GO TO 0031 01750501 +20030 IVFAIL=IVFAIL+1 01760501 + WRITE (NWVI,80008) IVTNUM 01770501 + WRITE (NWVI,80024) KX1I(2) 01780501 + WRITE (NWVI,80026) IVCORR 01790501 + 0031 CONTINUE 01800501 +CT004* TEST 4 IMPLICIT INTEGER ARRAY 01810501 + IVTNUM = 4 01820501 + IVCORR=1 01830501 + IF (HX2I(1,2) - 1) 20040,10040,20040 01840501 +10040 IVPASS=IVPASS+1 01850501 + WRITE (NWVI,80002) IVTNUM 01860501 + GO TO 0041 01870501 +20040 IVFAIL=IVFAIL+1 01880501 + WRITE (NWVI,80008) IVTNUM 01890501 + WRITE (NWVI,80024) HX2I(1,2) 01900501 + WRITE (NWVI,80026) IVCORR 01910501 + 0041 CONTINUE 01920501 +CT005* TEST 5 01930501 + IVTNUM = 5 01940501 + IVCORR=5 01950501 + IF (HX2I(2,2) - 5) 20050,10050,20050 01960501 +10050 IVPASS=IVPASS+1 01970501 + WRITE (NWVI,80002) IVTNUM 01980501 + GO TO 0051 01990501 +20050 IVFAIL=IVFAIL+1 02000501 + WRITE (NWVI,80008) IVTNUM 02010501 + WRITE (NWVI,80024) HX2I(2,2) 02020501 + WRITE (NWVI,80026) IVCORR 02030501 + 0051 CONTINUE 02040501 +CT006* TEST 6 DO INITIALIZE INTEGER ARRAY 02050501 + IVTNUM = 6 02060501 + IVINSP=IVINSP+1 02070501 + WRITE (NWVI,80004) IVTNUM 02080501 + DO 70101 KVI = 1, 2 02090501 + IVI = MX2I(KVI, KVI) - 4 02100501 + WRITE (NWVI, 70100) IVI 02110501 +70101 CONTINUE 02120501 +CT007* TEST 7 REAL VARIABLE 02130501 + IVTNUM = 7 02140501 + RVCORR=5.3 02150501 + RVCOMP=0.0 02160501 + RVCOMP=AXVS - 5.3 02170501 + IF (RVCOMP + .00005) 20070,10070,40070 02180501 +40070 IF (RVCOMP - .00005) 10070,10070,20070 02190501 +10070 IVPASS=IVPASS+1 02200501 + WRITE (NWVI,80002) IVTNUM 02210501 + GO TO 0071 02220501 +20070 IVFAIL=IVFAIL+1 02230501 + WRITE (NWVI,80008) IVTNUM 02240501 + WRITE (NWVI,80028) AXVS 02250501 + WRITE (NWVI,80030) RVCORR 02260501 + 0071 CONTINUE 02270501 +CT008* TEST 8 EXTENDED PRECISION REAL 02280501 + IVTNUM = 8 02290501 + AVS = BXVS - 1.23456789012345 02300501 + RVCOMP=1.23456789012345 02310501 + IF (AVS + .00005) 20080,10080,40080 02320501 +40080 IF (AVS - .00005) 10080,10080,20080 02330501 +10080 IVPASS=IVPASS+1 02340501 + WRITE (NWVI,80002) IVTNUM 02350501 + GO TO 0081 02360501 +20080 IVFAIL=IVFAIL+1 02370501 + WRITE (NWVI,80004) IVTNUM 02380501 +70080 FORMAT (" ",16X,"COMPUTED: " ,E20.14) 02390501 + WRITE (NWVI,70080) BXVS 02400501 +70081 FORMAT (" ",16X,"CORRECT: " ,E20.14) 02410501 + WRITE (NWVI, 70081) RVCOMP 02420501 + 0081 CONTINUE 02430501 +CT009* TEST 9 DECLARED REAL ARRAY 02440501 + IVTNUM = 9 02450501 + RVCORR=2.45 02460501 + RVCOMP=2.0 02470501 + RVCOMP=(JX1S(1) - 2.45) 02480501 + IF (RVCOMP + .00005) 20090,10090,40090 02490501 +40090 IF (RVCOMP - .00005) 10090,10090,20090 02500501 +10090 IVPASS=IVPASS+1 02510501 + WRITE (NWVI,80002) IVTNUM 02520501 + GO TO 0091 02530501 +20090 IVFAIL=IVFAIL+1 02540501 + WRITE (NWVI,80008) IVTNUM 02550501 + WRITE (NWVI,80028) JX1S(1) 02560501 + WRITE (NWVI,80030) RVCORR 02570501 + 0091 CONTINUE 02580501 +CT010* TEST 10 02590501 + IVTNUM = 10 02600501 + RVCORR=4.58 02610501 + RVCOMP=2.0 02620501 + RVCOMP=(JX1S(2) - 4.58) 02630501 +40100 IF (RVCOMP + .00005) 20100,10100,40101 02640501 +40101 IF (RVCOMP - .00005) 10100,10100,20100 02650501 +10100 IVPASS=IVPASS+1 02660501 + WRITE (NWVI,80002) 02670501 + GO TO 0100 02680501 +20100 IVFAIL=IVFAIL+1 02690501 + WRITE (NWVI,80008) IVTNUM 02700501 + WRITE (NWVI,80028) JX1S(2) 02710501 + WRITE (NWVI,80030) RVCORR 02720501 + 0100 CONTINUE 02730501 +CT011* TEST 11 REAL ARRAY - NAME ONLY 02740501 + IVTNUM = 11 02750501 + IVINSP=IVINSP+1 02760501 + WRITE (NWVI,80004) IVTNUM 02770501 + DO 70103 KVI = 1, 2 02780501 + AVS = CX2S(KVI, KVI) - 1.2 02790501 + WRITE (NWVI, 70102) AVS 02800501 +70103 CONTINUE 02810501 +CT012* TEST 12 EQUIVALENCED REAL ARRAY 02820501 + IVTNUM = 12 02830501 + IVINSP=IVINSP+1 02840501 + WRITE (NWVI,80004) IVTNUM 02850501 + DO 70104 KVI=1,2 02860501 + AVS = DZ3S(KVI, KVI, KVI) - 1.1 02870501 + WRITE (NWVI, 70102) AVS 02880501 +70104 CONTINUE 02890501 +CT013* TEST 13 REAL VARIABLE - EQUIVALENCED INTEGER 02900501 + IVTNUM = 13 02910501 + IVCORR=34 02920501 + IVI = NYVI - 34 02930501 +40130 IF (IVI - 0) 20130,10130,20130 02940501 +10130 IVPASS=IVPASS+1 02950501 + WRITE (NWVI,80002) IVTNUM 02960501 + GO TO 0131 02970501 +20130 IVFAIL=IVFAIL+1 02980501 + WRITE (NWVI,80008) IVTNUM 02990501 + WRITE (NWVI,80028) NYVI 03000501 + WRITE (NWVI,80026) IVCORR 03010501 + 0131 CONTINUE 03020501 +CT014* TEST 14 DOUBLE PRECISION ARRAY 03030501 + IVTNUM = 14 03040501 + KVI=1 03050501 + AVD = AX1D(KVI) - 1.456D3 03060501 + DVCORR=1.456D3 03070501 + IF (AVD + .0000000005) 20140,40141,40140 03080501 +40140 IF (AVD - .0000000005) 40141,40141,20140 03090501 +40141 KVI=2 03100501 + AVD = AX1D(KVI) - 1.456D3 03110501 + IF (AVD + .0000000005) 20140,10140,40142 03120501 +40142 IF (AVD - .0000000005) 10140,10140,20140 03130501 +10140 IVPASS=IVPASS+1 03140501 + WRITE (NWVI,80002) IVTNUM 03150501 + GO TO 0141 03160501 +20140 IVFAIL=IVFAIL+1 03170501 + WRITE (NWVI,80008) IVTNUM 03180501 + WRITE (NWVI, 80033) AX1D(KVI) 03190501 + WRITE (NWVI,80035) DVCORR 03200501 + 0141 CONTINUE 03210501 +CT015* TEST 15 DIMENSION DOUBLE PRECISION ARRAY 03220501 + IVTNUM = 15 03230501 + AVD = BX4D(1,2,1,1) - 34.9D8 03240501 + IF (AVD + .0000000005) 20150,10150,40150 03250501 +40150 IF (AVD - .0000000005) 10150,10150,20150 03260501 +10150 IVPASS=IVPASS+1 03270501 + WRITE (NWVI,80002) IVTNUM 03280501 + GO TO 0151 03290501 +20150 IVFAIL=IVFAIL+1 03300501 + DVCORR=34.9D8 03310501 + WRITE (NWVI,80008) IVTNUM 03320501 + WRITE (NWVI, 80033) BX4D(1,2,1,1) 03330501 + WRITE (NWVI,80035) DVCORR 03340501 + 0151 CONTINUE 03350501 +CT016* TEST 16 03360501 + IVTNUM = 16 03370501 + DVCORR=0.00 03380501 + AVD = BX4D(1,2,1,2) - 2.123D0 03390501 + IF (AVD + .0000000005) 20160,10160,40160 03400501 +40160 IF (AVD - .0000000005) 10160,10160,20160 03410501 +10160 IVPASS=IVPASS+1 03420501 + WRITE (NWVI,80002) IVTNUM 03430501 + GO TO 0161 03440501 +20160 IVFAIL=IVFAIL+1 03450501 + DVCORR=2.123D0 03460501 + WRITE (NWVI,80008) IVTNUM 03470501 + WRITE (NWVI, 80033) BX4D(1,2,1,2) 03480501 + WRITE (NWVI,80035) DVCORR 03490501 + 0161 CONTINUE 03500501 +CT017* TEST 17 03510501 + IVTNUM = 17 03520501 + DVCORR=0.00 03530501 + AVD = BX4D(2,1,1,2) - 873.84D-1 03540501 + IF (AVD + .0000000005) 20170,10170,40170 03550501 +40170 IF (AVD - .0000000005) 10170,10170,20170 03560501 +10170 IVPASS=IVPASS+1 03570501 + WRITE (NWVI,80002) IVTNUM 03580501 + GO TO 0171 03590501 +20170 IVFAIL=IVFAIL+1 03600501 + WRITE (NWVI,80008) IVTNUM 03610501 + DVCORR=873.84D-1 03620501 + WRITE (NWVI, 80033) BX4D(2,1,1,2) 03630501 + WRITE (NWVI,80035) DVCORR 03640501 + 0171 CONTINUE 03650501 +CT018* TEST 18 COMPLEX VARIABLE 03660501 + IVTNUM = 18 03670501 + AVC = AXVC - (1.5, 2.3) 03680501 + IVINSP=IVINSP+1 03690501 + WRITE (NWVI,80004) IVTNUM 03700501 + WRITE (NWVI,70107) AVC 03710501 +CT019* TEST 19 COMPLEX ARRAY 03720501 + IVTNUM = 19 03730501 + AVC = BX1C(1) - (1.1, 1.2) 03740501 + IVINSP=IVINSP+1 03750501 + WRITE (NWVI,80004) IVTNUM 03760501 + WRITE (NWVI, 70107) AVC 03770501 +CT020* TEST 20 03780501 + IVTNUM = 20 03790501 + AVC = BX1C(2) - (3.2, 2.3) 03800501 + IVINSP=IVINSP+1 03810501 + WRITE (NWVI,80004) IVTNUM 03820501 + WRITE (NWVI, 70107) AVC 03830501 +CT021* TEST 21 COMPLEX ARRAY - EQUIVALENCE 03840501 + IVTNUM = 21 03850501 + AVC = CZ5C(1,1,1,2,1) - (1.2, 2.1) 03860501 + IVINSP=IVINSP+1 03870501 + WRITE (NWVI,80004) IVTNUM 03880501 + WRITE (NWVI, 70107) AVC 03890501 +CT022* TEST 22 03900501 + IVTNUM = 22 03910501 + AVC = CZ5C(1,2,1,1,2) - (45.3, 2.1) 03920501 + IVINSP=IVINSP+1 03930501 + WRITE (NWVI,80004) IVTNUM 03940501 + WRITE (NWVI, 70107) AVC 03950501 +CT023* TEST 23 03960501 + IVTNUM = 23 03970501 + AVC = CZ5C(2,1,1,1,2) - (309.89, 102.1) 03980501 + IVINSP=IVINSP+1 03990501 + WRITE (NWVI,80004) IVTNUM 04000501 + WRITE (NWVI, 70107) AVC 04010501 +CT024* TEST 24 LOGICAL VARIABLE 04020501 + IVTNUM = 24 04030501 + IVCOMP=0 04040501 + IF (AXVB) IVCOMP=1 04050501 +40240 IF (IVCOMP-1) 20240,10240,20240 04060501 +10240 IVPASS=IVPASS+1 04070501 + WRITE (NWVI,80002) IVTNUM 04080501 + GO TO 0241 04090501 +20240 IVFAIL=IVFAIL+1 04100501 + WRITE (NWVI,80008) IVTNUM 04110501 + 0241 CONTINUE 04120501 +CT025* TEST 25 LOGICAL ARRAY - EQUIVALENCE 04130501 + IVTNUM = 25 04140501 + IVCOMP=0 04150501 + IF (.NOT. BZ1B(2)) IVCOMP=1 04160501 +40250 IF (IVCOMP-1) 20250,10250,20250 04170501 +10250 IVPASS=IVPASS+1 04180501 + WRITE (NWVI,80002) IVTNUM 04190501 + GO TO 0251 04200501 +20250 IVFAIL=IVFAIL+1 04210501 + WRITE (NWVI,80008) IVTNUM 04220501 + 0251 CONTINUE 04230501 +CT026* TEST 26 DECLARED LOGICAL ARRAY 04240501 + IVTNUM = 26 04250501 + IVCOMP=0 04260501 + IF (CX6B(1,1,1,2,2,1)) IVCOMP=1 04270501 +40260 IF (IVCOMP-1) 20260,10260,20260 04280501 +10260 IVPASS=IVPASS+1 04290501 + WRITE (NWVI,80002) IVTNUM 04300501 + GO TO 0261 04310501 +20260 IVFAIL=IVFAIL+1 04320501 + WRITE (NWVI,80008) IVTNUM 04330501 + 0261 CONTINUE 04340501 +CT027* TEST 27 1 CHARACTER VARIABLE 04350501 + IVTNUM = 27 04360501 + CVNC01='A' 04370501 + IVCOMP=0 04380501 + IF (A1XVK .EQ. 'A') IVCOMP=1 04390501 +40270 IF (IVCOMP-1) 20270,10270,20270 04400501 +10270 IVPASS=IVPASS+1 04410501 + WRITE (NWVI,80002) IVTNUM 04420501 + GO TO 0271 04430501 +20270 IVFAIL=IVFAIL+1 04440501 + WRITE (NWVI,80008) IVTNUM 04450501 + WRITE (NWVI,80020) A1XVK 04460501 + WRITE (NWVI,80022) CVNC01 04470501 + 0271 CONTINUE 04480501 +CT028* TEST 28 1 CHARACTER ARRAY 04490501 + IVTNUM = 28 04500501 + CVNC01='K' 04510501 + IVCOMP=0 04520501 + IF (B1X1K(1) .EQ. 'K') IVCOMP=1 04530501 +40280 IF (IVCOMP-1) 20280,10280,20280 04540501 +10280 IVPASS=IVPASS+1 04550501 + WRITE (NWVI,80002) IVTNUM 04560501 + GO TO 0281 04570501 +20280 IVFAIL=IVFAIL+1 04580501 + WRITE (NWVI,80008) IVTNUM 04590501 + WRITE (NWVI,80020) B1X1K(1) 04600501 + WRITE (NWVI,80022) CVNC01 04610501 + 0281 CONTINUE 04620501 +CT029* TEST 29 04630501 + IVTNUM = 29 04640501 + CVNC01='K' 04650501 + IVCOMP=0 04660501 + IF (B1X1K(2) .EQ. 'K') IVCOMP=1 04670501 + IF (IVCOMP-1) 20290,10290,20290 04680501 +10290 IVPASS=IVPASS+1 04690501 + WRITE (NWVI,80002) IVTNUM 04700501 + GO TO 0291 04710501 +20290 IVFAIL=IVFAIL+1 04720501 + WRITE (NWVI,80008) IVTNUM 04730501 + WRITE (NWVI,80020) B1X1K(2) 04740501 + WRITE (NWVI,80022) CVNC01 04750501 + 0291 CONTINUE 04760501 +CT030* TEST 30 7 DIMENSION 1 CHARACTER ARRAY 04770501 + IVTNUM = 30 04780501 + CVNC01='X' 04790501 + IVCOMP=0 04800501 + KVI=1 04810501 + IF (C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) .EQ. 'X') IVCOMP=1 04820501 +40300 IF(IVCOMP-1) 20300,40301,20300 04830501 +40301 KVI=2 04840501 + IVCOMP=0 04850501 + IF (C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) .EQ. 'X') IVCOMP=1 04860501 +40302 IF (IVCOMP-1) 20300,40303,20300 04870501 +40303 IVPASS=IVPASS+1 04880501 + WRITE (NWVI,80002) IVTNUM 04890501 + GO TO 0301 04900501 +20300 IVFAIL=IVFAIL+1 04910501 + WRITE (NWVI,80008) IVTNUM 04920501 + WRITE (NWVI,80020) C1X7K(KVI,KVI,KVI,KVI,KVI,KVI,KVI) 04930501 + WRITE (NWVI,80022) CVNC01 04940501 + 0301 CONTINUE 04950501 +CT031* TEST 31 IMPLICIT 2 CHARACTER VARIABLE 04960501 + IVTNUM = 31 04970501 + CVNC02='.,' 04980501 + IVCOMP=0 04990501 + IF (S2XVK .EQ. '.,') IVCOMP=1 05000501 +40310 IF (IVCOMP-1) 20310,10310,20310 05010501 +10310 IVPASS=IVPASS+1 05020501 + WRITE (NWVI,80002) IVTNUM 05030501 + GO TO 0311 05040501 +20310 IVFAIL=IVFAIL+1 05050501 + WRITE (NWVI,80008) IVTNUM 05060501 + WRITE (NWVI,80020) S2XVK 05070501 + WRITE (NWVI,80022) CVNC02 05080501 + 0311 CONTINUE 05090501 +CT032* TEST 32 2 CHARACTER ARRAY - EQUIVALENCED 05100501 + IVTNUM = 32 05110501 + CVNC02='TE' 05120501 + IVCOMP=0 05130501 + IF (D2Z1K(1) .EQ. 'TE') IVCOMP=1 05140501 +40320 IF (IVCOMP-1) 20320,10320,20320 05150501 +10320 IVPASS=IVPASS+1 05160501 + WRITE (NWVI,80002) IVTNUM 05170501 + GO TO 0321 05180501 +20320 IVFAIL=IVFAIL+1 05190501 + WRITE (NWVI,80008) IVTNUM 05200501 + WRITE (NWVI,80020) D2Z1K(1) 05210501 + WRITE (NWVI,80022) CVNC02 05220501 + 0321 CONTINUE 05230501 +CT033* TEST 33 05240501 + IVTNUM = 33 05250501 + CVNC02='ST' 05260501 + IVCOMP=0 05270501 + IF (D2Z1K(2) .EQ. 'ST') IVCOMP=1 05280501 +40330 IF (IVCOMP-1) 20330,10330,20330 05290501 +10330 IVPASS=IVPASS+1 05300501 + WRITE (NWVI,80002) IVTNUM 05310501 + GO TO 0331 05320501 +20330 IVFAIL=IVFAIL+1 05330501 + WRITE (NWVI,80008) IVTNUM 05340501 + WRITE (NWVI,80020) D2Z1K(2) 05350501 + WRITE (NWVI,80022) CVNC02 05360501 + 0331 CONTINUE 05370501 +CT034* TEST 34 DECLARED 4 CHARACTER VARIABLE 05380501 + IVTNUM = 34 05390501 + CVNC04='ZXCV' 05400501 + IVCOMP=0 05410501 + IF (E4XVK .EQ. 'ZXCV') IVCOMP=1 05420501 +40340 IF (IVCOMP-1) 20340,10340,20340 05430501 +10340 IVPASS=IVPASS+1 05440501 + WRITE (NWVI,80002) IVTNUM 05450501 + GO TO 0341 05460501 +20340 IVFAIL=IVFAIL+1 05470501 + WRITE (NWVI,80008) IVTNUM 05480501 + WRITE (NWVI,80020) E4XVK 05490501 + WRITE (NWVI,80022) CVNC04 05500501 + 0341 CONTINUE 05510501 +CT035* TEST 35 DECLARED 4 CHARACTER ARRAY 05520501 + IVTNUM = 35 05530501 + CVNC02='SO' 05540501 + IVCOMP=0 05550501 + IF (G4X2K(1,1) .EQ. 'SO') IVCOMP=1 05560501 +40350 IF (IVCOMP-1) 20350,10350,20350 05570501 +10350 IVPASS=IVPASS+1 05580501 + WRITE (NWVI,80002) IVTNUM 05590501 + GO TO 0351 05600501 +20350 IVFAIL=IVFAIL+1 05610501 + WRITE (NWVI,80008) IVTNUM 05620501 + WRITE (NWVI,80020) G4X2K(1,1) 05630501 + WRITE (NWVI,80022) CVNC02 05640501 + 0351 CONTINUE 05650501 +CT036* TEST 36 05660501 + IVTNUM = 36 05670501 + CVNC02='OS' 05680501 + IVCOMP=0 05690501 + IF (G4X2K(2,1) .EQ. 'OS') IVCOMP=1 05700501 +40360 IF (IVCOMP-1) 20360,10360,20360 05710501 +10360 IVPASS=IVPASS+1 05720501 + WRITE (NWVI,80002) IVTNUM 05730501 + GO TO 0361 05740501 +20360 IVFAIL=IVFAIL+1 05750501 + WRITE (NWVI,80008) IVTNUM 05760501 + WRITE (NWVI,80020) G4X2K(2,1) 05770501 + WRITE (NWVI,80022) CVNC02 05780501 + 0361 CONTINUE 05790501 +CT037* TEST 37 CHARACTER VARIABLE - PARAMTER LENGTH 05800501 + IVTNUM = 37 05810501 + CVNC10='FINAL TEST' 05820501 + IVCOMP=0 05830501 + IF (I10XVK .EQ. 'FINAL TEST') IVCOMP=1 05840501 +40370 IF (IVCOMP-1) 20370, 10370, 20370 05850501 +10370 IVPASS=IVPASS+1 05860501 + WRITE (NWVI,80002) IVTNUM 05870501 + GO TO 0371 05880501 +20370 IVFAIL=IVFAIL+1 05890501 + WRITE (NWVI,80008) IVTNUM 05900501 + WRITE (NWVI,80020) I10XVK 05910501 + WRITE (NWVI,80022) CVNC10 05920501 + 0371 CONTINUE 05930501 +C***** 05940501 +70100 FORMAT(" ",26X,I5) 05950501 +70102 FORMAT(" ",26X,F7.2) 05960501 +70106 FORMAT(" ",26X,F7.2) 05970501 +70107 FORMAT(" ",26X,"(",F7.2,", ",F7.2,")",4X,"SHOULD BE ZERO" ) 05980501 +70140 FORMAT (/49X,"ALL VISUAL ANSWERS SHOULD BE" 05990501 + 1 /49X,"ZERO FOR TEST SEGMENT TO BE" 06000501 + 2 /49X,"SUCCESSFUL" ) 06010501 +CBB** ********************** BBCSUM0 **********************************06020501 +C**** WRITE OUT TEST SUMMARY 06030501 +C**** 06040501 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 06050501 + WRITE (I02, 90004) 06060501 + WRITE (I02, 90014) 06070501 + WRITE (I02, 90004) 06080501 + WRITE (I02, 90020) IVPASS 06090501 + WRITE (I02, 90022) IVFAIL 06100501 + WRITE (I02, 90024) IVDELE 06110501 + WRITE (I02, 90026) IVINSP 06120501 + WRITE (I02, 90028) IVTOTN, IVTOTL 06130501 +CBE** ********************** BBCSUM0 **********************************06140501 +CBB** ********************** BBCFOOT0 **********************************06150501 +C**** WRITE OUT REPORT FOOTINGS 06160501 +C**** 06170501 + WRITE (I02,90016) ZPROG, ZPROG 06180501 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 06190501 + WRITE (I02,90019) 06200501 +CBE** ********************** BBCFOOT0 **********************************06210501 +CBB** ********************** BBCFMT0A **********************************06220501 +C**** FORMATS FOR TEST DETAIL LINES 06230501 +C**** 06240501 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 06250501 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 06260501 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 06270501 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 06280501 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 06290501 + 1I6,/," ",15X,"CORRECT= " ,I6) 06300501 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06310501 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 06320501 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06330501 + 1A21,/," ",16X,"CORRECT= " ,A21) 06340501 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 06350501 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 06360501 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 06370501 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 06380501 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 06390501 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 06400501 +80050 FORMAT (" ",48X,A31) 06410501 +CBE** ********************** BBCFMT0A **********************************06420501 +CBB** ********************** BBCFMAT1 **********************************06430501 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 06440501 +C**** 06450501 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06460501 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 06470501 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 06480501 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 06490501 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06500501 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06510501 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06520501 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06530501 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06540501 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 06550501 + 2"(",F12.5,", ",F12.5,")") 06560501 +CBE** ********************** BBCFMAT1 **********************************06570501 +CBB** ********************** BBCFMT0B **********************************06580501 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 06590501 +C**** 06600501 +90002 FORMAT ("1") 06610501 +90004 FORMAT (" ") 06620501 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )06630501 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06640501 +90008 FORMAT (" ",21X,A13,A17) 06650501 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 06660501 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 06670501 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 06680501 + 1 7X,"REMARKS",24X) 06690501 +90014 FORMAT (" ","----------------------------------------------" , 06700501 + 1 "---------------------------------" ) 06710501 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 06720501 +C**** 06730501 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 06740501 +C**** 06750501 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 06760501 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 06770501 + 1 A13) 06780501 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 06790501 +C**** 06800501 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 06810501 +C**** 06820501 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 06830501 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 06840501 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 06850501 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 06860501 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 06870501 +CBE** ********************** BBCFMT0B **********************************06880501 +C***** 06890501 + RETURN 06900501 + END 06910501 + +C***********************************************************************00010502 +C***** FORTRAN 77 00020502 +C***** FM502 AN502 00030502 +C***** THIS BLOCK DATA SUBPROGRAM IS USED BY MIAN PROGRAM FM500 00040502 +C***********************************************************************00050502 +C***** 00060502 +C***** GENERAL PURPOSE 00070502 +C***** THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS 00080502 +C***** TO BE RUN WITH SEGMENT FM500 00090502 +C***** THIS SEGMENT WILL USE IMPLICIT, PARAMETER, EXTERNAL 00100502 +C***** AND SAVE STATEMENTS WITHIN IT. 00110502 +C***** 00120502 + BLOCK DATA AN502 00130502 +C***** 00140502 + IMPLICIT INTEGER (H) 00150502 + IMPLICIT DOUBLE PRECISION (R) 00160502 + IMPLICIT CHARACTER*2 (S) 00170502 +C***** 00180502 + SAVE/BLK6/ 00190502 +C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00200502 + PARAMETER (KPI = 2, LPI = 10) 00210502 + INTEGER FXVI 00220502 + REAL JX1S 00230502 + DOUBLE PRECISION AX1D, BX4D 00240502 + DIMENSION BX4D(KPI, KPI, KPI, KPI) 00250502 + COMPLEX AXVC, BX1C, CZ5C 00260502 + LOGICAL AXVB, BZ1B, CX6B(2,2,2,2,2,2) 00270502 + CHARACTER*1 A1XVK, B1X1K, C1X7K 00280502 + CHARACTER*2 D2Z1K 00290502 + CHARACTER*4 E4XVK, G4X2K 00300502 + CHARACTER*(LPI) I10XVK 00310502 +C***** 00320502 + COMMON /BLK1/ IXVI, FXVI, KX1I(2), HX2I(2,2), MX2I(2,2) 00330502 + COMMON /BLK2/ AXVS, BXVS, JX1S(2), CX2S(2,2), DZ3S(2,2,2), EZVS 00340502 + COMMON /BLK3/ RXVD, AX1D(2), BX4D 00350502 + COMMON /BLK4/ AXVC, BX1C(2), CZ5C(2,2,2,2,2) 00360502 + COMMON /BLK5/ AXVB, BZ1B(2), CX6B 00370502 + COMMON /BLK6/ A1XVK, B1X1K(2), C1X7K(2,2,2,2,2,2,2), 00380502 + 1 S2XVK, D2Z1K(2), E4XVK, G4X2K(2,2), I10XVK 00390502 +C***** DECLARATION OF VARIABLES FOR EQUIVALENCE STATEMENTS 00400502 + DIMENSION AY3S(2,2,2) 00410502 + COMPLEX AY5C (2,2,2,2,2) 00420502 + LOGICAL AY1B(2) 00430502 + CHARACTER*2 A2Y1K(2) 00440502 + CHARACTER*1 APK 00450502 + PARAMETER (IPI = 5, APS = 5.3, JPI = 2, APK = 'X', MPI = 128) 00460502 +C***** 00470502 + EQUIVALENCE (AY3S, DZ3S) 00480502 + EQUIVALENCE (NYVI, EZVS) 00490502 + EQUIVALENCE (AY5C, CZ5C) 00500502 + EQUIVALENCE (AY1B, BZ1B) 00510502 + EQUIVALENCE (A2Y1K, D2Z1K) 00520502 +C***** 00530502 + DATA IXVI, FXVI, KX1I(2), HX2I(1,2), HX2I(2,2), 00540502 + 1 ((MX2I(IVI, JVI), IVI=1,2), JVI=1,2) /IPI, 6, 8, 1, 5, 4*4/ 00550502 + DATA AXVS, BXVS, JX1S(1), JX1S(2), CX2S /APS, 1.23456789012345, 00560502 + 1 2.45, 4.58, 4*1.2/ 00570502 + DATA AY3S / 8*1.1/ 00580502 + DATA NYVI /34/ 00590502 + DATA AX1D, BX4D(1,2,1,1), BX4D(1,2,1,2), BX4D(2,1,1,2) 00600502 + 1 /JPI*1.456D3, 34.9D8, 2.123D0, 873.84D-1/ 00610502 + DATA AXVC /(1.5, 2.3)/ 00620502 + DATA AY5C(1,1,1,2,1), AY5C(1,2,1,1,2), AY5C(2,1,1,1,2) 00630502 + 1 /(1.2, 2.1), (45.3, 2.1), (309.89, 102.1)/ 00640502 + DATA BX1C(1), BX1C(2), AXVB /(1.1, 1.2), (3.2, 2.3), .TRUE./ 00650502 + DATA AY1B(2), CX6B(1,1,1,2,2,1) /.FALSE., .TRUE./ 00660502 + DATA A1XVK, C1X7K, S2XVK, A2Y1K(1), A2Y1K(2), E4XVK, G4X2K(1,1),00670502 + 1 G4X2K(2,1), I10XVK, (B1X1K(IVI), IVI=1,2) 00680502 + 2 /'A', MPI*APK, '.,', 'TE', 'ST', 'ZXCV', 'SO', 'OS', 00690502 + 3 'FINAL TEST', 2*'K'/ 00700502 +C***** 00710502 + END 00720502 diff --git a/Fortran/UnitTests/fcvs21_f95/FM500.reference_output b/Fortran/UnitTests/fcvs21_f95/FM500.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM500.reference_output @@ -0,0 +1,86 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM500BEGIN* TEST RESULTS - FM500 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + BLKD1 - (260) BLOCK DATA SUBPROGRAMS -- + IMPLICIT, PARAMETER, EXTERNAL, SAVE + + ANS REF. - 16 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 37 TESTS + + + ALL VISUAL ANSWERS SHOULD BE + ZERO FOR TEST SEGMENT TO BE + SUCCESSFUL + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 INSPECT + 0 + 0 + 7 PASS + 8 PASS + 9 PASS + + 11 INSPECT + 0.00 + 0.00 + 12 INSPECT + 0.00 + 0.00 + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 INSPECT + ( 0.00, 0.00) SHOULD BE ZERO + 19 INSPECT + ( 0.00, 0.00) SHOULD BE ZERO + 20 INSPECT + ( 0.00, 0.00) SHOULD BE ZERO + 21 INSPECT + ( 0.00, 0.00) SHOULD BE ZERO + 22 INSPECT + ( 0.00, 0.00) SHOULD BE ZERO + 23 INSPECT + ( 0.00, 0.00) SHOULD BE ZERO + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + 36 PASS + 37 PASS + + ------------------------------------------------------------------------------- + + 28 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 9 TESTS REQUIRE INSPECTION + 37 OF 37 TESTS EXECUTED + + *FM500END* END OF TEST - FM500 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM503.f b/Fortran/UnitTests/fcvs21_f95/FM503.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM503.f @@ -0,0 +1,375 @@ + PROGRAM FM503 + +C***********************************************************************00010503 +C***** FORTRAN 77 00020503 +C***** FM503 00030503 +C***** BLKD2 - (261) 00040503 +C***** THIS PROGRAM USES FM504 (UNNAMED BLOCK DATA SUBPROGRAM 00050503 +C***** AND SUBROUTINE SN505 00060503 +C***********************************************************************00070503 +C***** TESTING OF BLOCK DATA SUBPROGRAMS ANS REF 00080503 +C***** DATA INTERNAL FORMS 16 00090503 +C***** THIS SEGMENT USES SEGMENTS 702 AND 703, BLOCK DATA PROGRAM 00100503 +C***** FM504 AND SUBROUTINE SN505 00110503 +C***** 00120503 +CBB** ********************** BBCCOMNT **********************************00130503 +C**** 00140503 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150503 +C**** VERSION 2.1 00160503 +C**** 00170503 +C**** 00180503 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190503 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200503 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00210503 +C**** BUILDING 225 RM A266 00220503 +C**** GAITHERSBURG, MD 20899 00230503 +C**** 00240503 +C**** 00250503 +C**** 00260503 +CBE** ********************** BBCCOMNT **********************************00270503 +C***** 00280503 +C***** S P E C I F I C A T I O N S SEGMENT 261 00290503 +C***** 00300503 +C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00310503 +C***** DOUBLE PRECISION AXVD, DVCORR 00320503 +C***** COMPLEX AXVC, ZVCORR 00330503 +C***** LOGICAL AXVB 00340503 +C***** CHARACTER*6 A6XVK, B6XVK, CVCORR 00350503 +C***** 00360503 +C***** COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB 00370503 +C***** COMMON /BLK7/ A6XVK, B6XVK 00380503 +C***** 00390503 +C***** 00400503 + CALL SN505 00410503 + STOP 00420503 +C***** 00430503 +C***** END OF TEST SEGMENT 261 00440503 + END 00450503 + +C***********************************************************************00010504 +C***** FORTRAN 77 00020504 +C***** FM504 BDS2 (UNNAMED) - (702) 00030504 +C***** THIS BLOCK DATA SUBPROGRAM IS USED BY FM503 00040504 +C***********************************************************************00050504 +C***** 00060504 +C***** GENERAL PURPOSE 00070504 +C***** THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS 00080504 +C***** TO BE RUN WITH TEST SEGMENT 261 00090504 +C***** THIS SEGMENT WILL TEST INTERNAL DATA FORMS, AS WELL 00100504 +C***** AS THE USE OF UNNAMED BLOCK DATA PROGRAM 00110504 +C***** 00120504 + BLOCK DATA 00130504 +C***** 00140504 +C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00150504 + DOUBLE PRECISION AXVD 00160504 + COMPLEX AXVC 00170504 + LOGICAL AXVB 00180504 + CHARACTER*6 A6XVK, B6XVK 00190504 +C***** 00200504 + COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB 00210504 + COMMON /BLK7/ A6XVK, B6XVK 00220504 + DATA AXVS, BXVS, IXVI, AXVD, AXVC, AXVB /34.25E-1, 43.23, 21, 00230504 + 1 1.23456, (234.23, 34.9), .TRUE./ 00240504 + DATA A6XVK, B6XVK /'ABCDE', 'FGHIJK'/ 00250504 +C***** 00260504 + END 00270504 + +C***********************************************************************00010505 +C***** FORTRAN 77 00020505 +C***** FM505 BLKD2Q - (703) 00030505 +C***** THIS SUBROUTINE IS CALLED BY FM503 00040505 +C***********************************************************************00050505 +C***** 00060505 +C***** GENERAL PURPOSE 00070505 +C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 261 00080505 +C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF 00090505 +C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED THE MANY 00100505 +C***** VARIABLES 00110505 +C***** 00120505 + SUBROUTINE SN505 00130505 +C***** 00140505 +C***** 00150505 +C***** DECLARATION OF VARIABLES IN COMMON BLOCKS 00160505 + DOUBLE PRECISION AXVD, DVCORR 00170505 + COMPLEX AXVC, ZVCORR 00180505 + LOGICAL AXVB 00190505 + CHARACTER*6 A6XVK, B6XVK, CVCORR 00200505 +C***** 00210505 + COMMON /BLK9/ AXVS, BXVS, IXVI, AXVD, AXVC, AXVB 00220505 + COMMON /BLK7/ A6XVK, B6XVK 00230505 +C***** LOCAL DECLARATION 00240505 + DOUBLE PRECISION AVD 00250505 + COMPLEX AVC 00260505 + REAL R2E(2) 00270505 + EQUIVALENCE (AVC, R2E) 00280505 +C***** 00290505 +CBB** ********************** BBCINITA **********************************00300505 +C**** SPECIFICATION STATEMENTS 00310505 +C**** 00320505 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330505 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340505 +CBE** ********************** BBCINITA **********************************00350505 +CBB** ********************** BBCINITB **********************************00360505 +C**** INITIALIZE SECTION 00370505 + DATA ZVERS, ZVERSD, ZDATE 00380505 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390505 + DATA ZCOMPL, ZNAME, ZTAPE 00400505 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410505 + DATA ZPROJ, ZTAPED, ZPROG 00420505 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430505 + DATA REMRKS /' '/ 00440505 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450505 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460505 +C**** 00470505 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480505 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490505 +CZ03 ZPROG = 'PROGRAM NAME' 00500505 +CZ04 ZDATE = 'DATE OF TEST' 00510505 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520505 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530505 +CZ07 ZNAME = 'NAME OF USER' 00540505 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00550505 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00560505 +C 00570505 + IVPASS = 0 00580505 + IVFAIL = 0 00590505 + IVDELE = 0 00600505 + IVINSP = 0 00610505 + IVTOTL = 0 00620505 + IVTOTN = 0 00630505 + ICZERO = 0 00640505 +C 00650505 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660505 + I01 = 05 00670505 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680505 + I02 = 06 00690505 +C 00700505 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710505 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720505 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730505 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740505 +C 00750505 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760505 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770505 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780505 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790505 +C 00800505 +CBE** ********************** BBCINITB **********************************00810505 + NUVI = I02 00820505 + IVTOTL = 8 00830505 + ZPROG = 'FM503' 00840505 +CBB** ********************** BBCHED0A **********************************00850505 +C**** 00860505 +C**** WRITE REPORT TITLE 00870505 +C**** 00880505 + WRITE (I02, 90002) 00890505 + WRITE (I02, 90006) 00900505 + WRITE (I02, 90007) 00910505 + WRITE (I02, 90008) ZVERS, ZVERSD 00920505 + WRITE (I02, 90009) ZPROG, ZPROG 00930505 + WRITE (I02, 90010) ZDATE, ZCOMPL 00940505 +CBE** ********************** BBCHED0A **********************************00950505 + WRITE(NUVI,26100) 00960505 +26100 FORMAT( " ", / " BLKD2 - (261) BLOCK DATA SUBPROGRAM --" // 00970505 + 1 " DATA INTERNAL FORMS" // 00980505 + 2 " ANS REF. - 16" ) 00990505 +CBB** ********************** BBCHED0B **********************************01000505 +C**** WRITE DETAIL REPORT HEADERS 01010505 +C**** 01020505 + WRITE (I02,90004) 01030505 + WRITE (I02,90004) 01040505 + WRITE (I02,90013) 01050505 + WRITE (I02,90014) 01060505 + WRITE (I02,90015) IVTOTL 01070505 +CBE** ********************** BBCHED0B **********************************01080505 +C***** 01090505 +CT001* TEST 1 REAL VARIABLE - EXPONENT FORM 01100505 + IVTNUM = 1 01110505 + AVS = AXVS 01120505 + IF (AVS - 0.34248E+01) 20010, 10010, 40010 01130505 +40010 IF (AVS - 0.34252E+01) 10010, 10010, 20010 01140505 +10010 IVPASS = IVPASS + 1 01150505 + WRITE (NUVI, 80002) IVTNUM 01160505 + GO TO 0011 01170505 +20010 IVFAIL = IVFAIL + 1 01180505 + RVCORR = 34.25E-1 01190505 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01200505 + 0011 CONTINUE 01210505 +CT002* TEST 2 REAL VARIABLE - NON EXPONENT FORM 01220505 + IVTNUM = 2 01230505 + AVS = BXVS 01240505 + IF (AVS - 0.43227E+02) 20020, 10020, 40020 01250505 +40020 IF (AVS - 0.43233E+02) 10020, 10020, 20020 01260505 +10020 IVPASS = IVPASS + 1 01270505 + WRITE (NUVI, 80002) IVTNUM 01280505 + GO TO 0021 01290505 +20020 IVFAIL = IVFAIL + 1 01300505 + RVCORR = 43.23 01310505 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01320505 + 0021 CONTINUE 01330505 +CT003* TEST 3 INTEGER VARIABLE 01340505 + IVTNUM = 3 01350505 + IVI = IXVI 01360505 + IF (IVI - 21) 20030, 10030, 20030 01370505 +10030 IVPASS = IVPASS + 1 01380505 + WRITE (NUVI, 80002) IVTNUM 01390505 + GO TO 0031 01400505 +20030 IVFAIL = IVFAIL + 1 01410505 + IVCORR = 21 01420505 + WRITE (NUVI, 80010) IVTNUM, IVI, IVCORR 01430505 + 0031 CONTINUE 01440505 +CT004* TEST 4 DOUBLE PRECISION VARIABLE 01450505 + IVTNUM = 4 01460505 + AVD = AXVD 01470505 + IF (AVD - 0.12345D+01) 20040, 10040, 40040 01480505 +40040 IF (AVD - 0.12347D+01) 10040, 10040, 20040 01490505 +10040 IVPASS = IVPASS + 1 01500505 + WRITE (NUVI, 80002) IVTNUM 01510505 + GO TO 0041 01520505 +20040 IVFAIL = IVFAIL + 1 01530505 + DVCORR = 1.23456D+0 01540505 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01550505 + 0041 CONTINUE 01560505 +CT005* TEST 5 COMPLEX VARIABLE 01570505 + IVTNUM = 5 01580505 + AVC = AXVC 01590505 + IF (R2E(1) - 0.23421E+03) 20050, 40052, 40051 01600505 +40051 IF (R2E(1) - 0.23425E+03) 40052, 40052, 20050 01610505 +40052 IF (R2E(2) - 0.34898E+02) 20050, 10050, 40050 01620505 +40050 IF (R2E(2) - 0.34902E+02) 10050, 10050, 20050 01630505 +10050 IVPASS = IVPASS + 1 01640505 + WRITE (NUVI, 80002) IVTNUM 01650505 + GO TO 0051 01660505 +20050 IVFAIL = IVFAIL + 1 01670505 + ZVCORR = (234.23, 34.9) 01680505 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01690505 + 0051 CONTINUE 01700505 +CT006* TEST 6 LOGICAL VARIABLE 01710505 + IVTNUM = 6 01720505 + IVI = 0 01730505 + IF (AXVB) IVI = 1 01740505 + IF (IVI - 1) 20060, 10060, 20060 01750505 +10060 IVPASS = IVPASS + 1 01760505 + WRITE (NUVI, 80002) IVTNUM 01770505 + GO TO 0061 01780505 +20060 IVFAIL = IVFAIL + 1 01790505 + LVCORR = 1 01800505 + REMRKS = '1 = TRUE ; 0 = FALSE' 01810505 + WRITE (NUVI, 80008) IVTNUM, REMRKS 01820505 + WRITE (NUVI, 80024) IVI 01830505 + WRITE (NUVI, 80026) LVCORR 01840505 + 0061 CONTINUE 01850505 +CT007* TEST 7 6 CHARACTER VARIABLE - INIT WITH 5 CHARACTERS 01860505 + IVTNUM = 7 01870505 + IVI = 0 01880505 + IF (A6XVK.EQ.'ABCDE ') IVI = 1 01890505 + IF (IVI - 1) 20070, 10070, 20070 01900505 +10070 IVPASS = IVPASS + 1 01910505 + WRITE (NUVI, 80002) IVTNUM 01920505 + GO TO 0071 01930505 +20070 IVFAIL = IVFAIL + 1 01940505 + CVCORR = 'ABCDE ' 01950505 + WRITE (NUVI, 80018) IVTNUM, A6XVK, CVCORR 01960505 + 0071 CONTINUE 01970505 +CT008* TEST 8 6 CHARACTER VARIABLE - INIT WITH 6 CHARACTERS 01980505 + IVTNUM = 8 01990505 + IVI = 0 02000505 + IF (B6XVK.EQ.'FGHIJK') IVI = 1 02010505 + IF (IVI - 1) 20080, 10080, 20080 02020505 +10080 IVPASS = IVPASS + 1 02030505 + WRITE (NUVI, 80002) IVTNUM 02040505 + GO TO 0081 02050505 +20080 IVFAIL = IVFAIL + 1 02060505 + CVCORR = 'FGHIJK' 02070505 + WRITE (NUVI, 80018) IVTNUM, B6XVK, CVCORR 02080505 + 0081 CONTINUE 02090505 +C***** 02100505 +CBB** ********************** BBCSUM0 **********************************02110505 +C**** WRITE OUT TEST SUMMARY 02120505 +C**** 02130505 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02140505 + WRITE (I02, 90004) 02150505 + WRITE (I02, 90014) 02160505 + WRITE (I02, 90004) 02170505 + WRITE (I02, 90020) IVPASS 02180505 + WRITE (I02, 90022) IVFAIL 02190505 + WRITE (I02, 90024) IVDELE 02200505 + WRITE (I02, 90026) IVINSP 02210505 + WRITE (I02, 90028) IVTOTN, IVTOTL 02220505 +CBE** ********************** BBCSUM0 **********************************02230505 +CBB** ********************** BBCFOOT0 **********************************02240505 +C**** WRITE OUT REPORT FOOTINGS 02250505 +C**** 02260505 + WRITE (I02,90016) ZPROG, ZPROG 02270505 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02280505 + WRITE (I02,90019) 02290505 +CBE** ********************** BBCFOOT0 **********************************02300505 +CBB** ********************** BBCFMT0A **********************************02310505 +C**** FORMATS FOR TEST DETAIL LINES 02320505 +C**** 02330505 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02340505 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02350505 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02360505 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02370505 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02380505 + 1I6,/," ",15X,"CORRECT= " ,I6) 02390505 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02400505 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02410505 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02420505 + 1A21,/," ",16X,"CORRECT= " ,A21) 02430505 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02440505 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02450505 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02460505 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02470505 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02480505 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02490505 +80050 FORMAT (" ",48X,A31) 02500505 +CBE** ********************** BBCFMT0A **********************************02510505 +CBB** ********************** BBCFMAT1 **********************************02520505 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02530505 +C**** 02540505 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02550505 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02560505 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02570505 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02580505 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02590505 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02600505 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02610505 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02620505 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02630505 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02640505 + 2"(",F12.5,", ",F12.5,")") 02650505 +CBE** ********************** BBCFMAT1 **********************************02660505 +CBB** ********************** BBCFMT0B **********************************02670505 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02680505 +C**** 02690505 +90002 FORMAT ("1") 02700505 +90004 FORMAT (" ") 02710505 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02720505 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02730505 +90008 FORMAT (" ",21X,A13,A17) 02740505 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02750505 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02760505 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02770505 + 1 7X,"REMARKS",24X) 02780505 +90014 FORMAT (" ","----------------------------------------------" , 02790505 + 1 "---------------------------------" ) 02800505 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02810505 +C**** 02820505 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02830505 +C**** 02840505 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02850505 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02860505 + 1 A13) 02870505 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02880505 +C**** 02890505 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02900505 +C**** 02910505 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02920505 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02930505 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02940505 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02950505 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02960505 +CBE** ********************** BBCFMT0B **********************************02970505 +C***** 02980505 + END 02990505 diff --git a/Fortran/UnitTests/fcvs21_f95/FM503.reference_output b/Fortran/UnitTests/fcvs21_f95/FM503.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM503.reference_output @@ -0,0 +1,42 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM503BEGIN* TEST RESULTS - FM503 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + BLKD2 - (261) BLOCK DATA SUBPROGRAM -- + + DATA INTERNAL FORMS + + ANS REF. - 16 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 8 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + + ------------------------------------------------------------------------------- + + 8 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 8 OF 8 TESTS EXECUTED + + *FM503END* END OF TEST - FM503 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM506.f b/Fortran/UnitTests/fcvs21_f95/FM506.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM506.f @@ -0,0 +1,333 @@ + PROGRAM FM506 + +C***********************************************************************00010506 +C***** FORTRAN 77 00020506 +C***** FM506 00030506 +C***** BLKD3 - (262) 00040506 +C***** USES BLOCK DATA SUBPROGRAM AN507 AND SUBROUTINE SN508 00050506 +C***********************************************************************00060506 +C***** TESTING OF BLOCK DATA SUBPROGRAMS ANS REF 00070506 +C***** VARYING CHARACTER VARIABLE LENGTHS 16 00080506 +C***** THIS SEGMENT USES SEGMENTS 704 AND 705, BLOCK DATA PROGRAM 00090506 +C***** AN507 AND SUBROUTINE SN508 00100506 +C***** 00110506 +CBB** ********************** BBCCOMNT **********************************00120506 +C**** 00130506 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140506 +C**** VERSION 2.1 00150506 +C**** 00160506 +C**** 00170506 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180506 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00190506 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00200506 +C**** BUILDING 225 RM A266 00210506 +C**** GAITHERSBURG, MD 20899 00220506 +C**** 00230506 +C**** 00240506 +C**** 00250506 +CBE** ********************** BBCCOMNT **********************************00260506 +C***** 00270506 +C***** S P E C I F I C A T I O N S SEGMENT 262 00280506 +C***** 00290506 +C***** CHARACTER*3 C3XVK, F3XVK 00300506 +C***** CHARACTER*2 D2XVK 00310506 +C***** CHARACTER*5 E5XVK 00320506 +C***** COMMON /BLK8/ C3XVK, D2XVK, E5XVK, F3XVK 00330506 +C***** 00340506 + NUVI = 4 00350506 +C***** 00360506 + CALL SN508(NUVI) 00370506 +C***** 00380506 +C***** END OF TEST SEGMENT 262 00390506 + STOP 00400506 + END 00410506 + +C***********************************************************************00010507 +C***** FORTRAN 77 00020507 +C***** FM507 BDS3 - (704) 00030507 +C***** BLOCK DATA SUBPROGRAM AN507 USED BY FM506 00040507 +C***********************************************************************00050507 +C***** 00060507 +C***** GENERAL PURPOSE 00070507 +C***** THIS SEGMENT CONTAINS A BLOCK DATA SUBPROGRAM THAT IS 00080507 +C***** TO BE RUN WITH TEST SEGMENT FM506 (262) 00090507 +C***** THIS SEGMENT WILL TEST CHARACTER VARIABLES WITH VARYING 00100507 +C***** LENGHTS IN COMMON AREAS 00110507 +C***** 00120507 +CBB** ********************** BBCCOMNT **********************************00130507 +C**** 00140507 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150507 +C**** VERSION 2.1 00160507 +C**** 00170507 +C**** 00180507 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190507 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200507 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00210507 +C**** BUILDING 225 RM A266 00220507 +C**** GAITHERSBURG, MD 20899 00230507 +C**** 00240507 +C**** 00250507 +C**** 00260507 +CBE** ********************** BBCCOMNT **********************************00270507 + BLOCK DATA AN507 00280507 +C***** 00290507 + CHARACTER*3 C3XVK, F3XVK 00300507 + CHARACTER*2 D2XVK 00310507 + CHARACTER*5 E5XVK 00320507 + COMMON /BLK8/ C3XVK, D2XVK, E5XVK, F3XVK 00330507 + DATA C3XVK, D2XVK, E5XVK, F3XVK /'123', 'GH', 'LONGS', 'END'/ 00340507 +C***** 00350507 + END 00360507 + +C***********************************************************************00010508 +C***** FORTRAN 77 00020508 +C***** FM508 BLKD3Q - (705) 00030508 +C***** THIS SUBROUTINE IS CALLED BY FM506 00040508 +C***********************************************************************00050508 +C***** 00060508 +C***** GENERAL PURPOSE 00070508 +C***** THIS SEGMENT IS TO BE RUN WITH TEST SEGMENT 262 00080508 +C***** THIS SEGMENT CONTAINS A SUBROUTINE THAT CHECKS TO SEE IF 00090508 +C***** IF THE BLOCK DATA PROGRAM CORRECTLY INITIALIZED CHARACTER 00100508 +C***** VARIABLES INTERMIXED WITH DIFFERENT LENGTHS 00110508 +C***** 00120508 + SUBROUTINE SN508 (NWVI) 00130508 +C***** 00140508 +CBB** ********************** BBCCOMNT **********************************00150508 +C**** 00160508 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00170508 +C**** VERSION 2.1 00180508 +C**** 00190508 +C**** 00200508 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00210508 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00220508 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00230508 +C**** BUILDING 225 RM A266 00240508 +C**** GAITHERSBURG, MD 20899 00250508 +C**** 00260508 +C**** 00270508 +C**** 00280508 +CBE** ********************** BBCCOMNT **********************************00290508 + CHARACTER*3 C3XVK, F3XVK 00300508 + CHARACTER*2 D2XVK 00310508 + CHARACTER*5 E5XVK, CVCORR 00320508 + COMMON /BLK8/ C3XVK, D2XVK, E5XVK, F3XVK 00330508 +CBB** ********************** BBCINITA **********************************00340508 +C**** SPECIFICATION STATEMENTS 00350508 +C**** 00360508 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00370508 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00380508 +CBE** ********************** BBCINITA **********************************00390508 +CBB** ********************** BBCINITB **********************************00400508 +C**** INITIALIZE SECTION 00410508 + DATA ZVERS, ZVERSD, ZDATE 00420508 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00430508 + DATA ZCOMPL, ZNAME, ZTAPE 00440508 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00450508 + DATA ZPROJ, ZTAPED, ZPROG 00460508 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00470508 + DATA REMRKS /' '/ 00480508 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00490508 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00500508 +C**** 00510508 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00520508 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00530508 +CZ03 ZPROG = 'PROGRAM NAME' 00540508 +CZ04 ZDATE = 'DATE OF TEST' 00550508 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00560508 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00570508 +CZ07 ZNAME = 'NAME OF USER' 00580508 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00590508 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00600508 +C 00610508 + IVPASS = 0 00620508 + IVFAIL = 0 00630508 + IVDELE = 0 00640508 + IVINSP = 0 00650508 + IVTOTL = 0 00660508 + IVTOTN = 0 00670508 + ICZERO = 0 00680508 +C 00690508 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00700508 + I01 = 05 00710508 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00720508 + I02 = 06 00730508 +C 00740508 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00750508 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00760508 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00770508 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00780508 +C 00790508 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00800508 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00810508 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00820508 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00830508 +C 00840508 +CBE** ********************** BBCINITB **********************************00850508 + NUVI = I02 00860508 + IVTOTL = 4 00870508 + ZPROG = 'FM506' 00880508 +CBB** ********************** BBCHED0A **********************************00890508 +C**** 00900508 +C**** WRITE REPORT TITLE 00910508 +C**** 00920508 + WRITE (I02, 90002) 00930508 + WRITE (I02, 90006) 00940508 + WRITE (I02, 90007) 00950508 + WRITE (I02, 90008) ZVERS, ZVERSD 00960508 + WRITE (I02, 90009) ZPROG, ZPROG 00970508 + WRITE (I02, 90010) ZDATE, ZCOMPL 00980508 +CBE** ********************** BBCHED0A **********************************00990508 +C***** 01000508 + WRITE(NUVI,26200) 01010508 +26200 FORMAT( " ", / " BLKD3 - (262) BLOCK DATA SUBPROGRAM --" // 01020508 + 1 " VARYING CHARACTER VARIABLE LENGTHS" // 01030508 + 2 " ANS REF. - 16" ) 01040508 +CBB** ********************** BBCHED0B **********************************01050508 +C**** WRITE DETAIL REPORT HEADERS 01060508 +C**** 01070508 + WRITE (I02,90004) 01080508 + WRITE (I02,90004) 01090508 + WRITE (I02,90013) 01100508 + WRITE (I02,90014) 01110508 + WRITE (I02,90015) IVTOTL 01120508 +CBE** ********************** BBCHED0B **********************************01130508 +C***** 01140508 +CT001* TEST 1 3 CHARACTER VARIABLE 01150508 + IVTNUM = 1 01160508 + IVCOMP = 0 01170508 + IF (C3XVK.EQ.'123') IVCOMP = 1 01180508 + IF (IVCOMP - 1) 20010, 10010, 20010 01190508 +10010 IVPASS = IVPASS + 1 01200508 + WRITE (NUVI, 80002) IVTNUM 01210508 + GO TO 0011 01220508 +20010 IVFAIL = IVFAIL + 1 01230508 + CVCORR = '123' 01240508 + WRITE (NUVI, 80018) IVTNUM, C3XVK, CVCORR 01250508 + 0011 CONTINUE 01260508 +CT002* TEST 2 2 CHARACTER VARIABLE 01270508 + IVTNUM = 2 01280508 + IVCOMP = 0 01290508 + IF (D2XVK.EQ.'GH') IVCOMP = 1 01300508 + IF (IVCOMP - 1) 20020, 10020, 20020 01310508 +10020 IVPASS = IVPASS + 1 01320508 + WRITE (NUVI, 80002) IVTNUM 01330508 + GO TO 0021 01340508 +20020 IVFAIL = IVFAIL + 1 01350508 + CVCORR = 'GH' 01360508 + WRITE (NUVI, 80018) IVTNUM, D2XVK, CVCORR 01370508 + 0021 CONTINUE 01380508 +CT003* TEST 3 5 CHARACTER VARIABLE 01390508 + IVTNUM = 3 01400508 + IVCOMP = 0 01410508 + IF (E5XVK.EQ.'LONGS') IVCOMP = 1 01420508 + IF (IVCOMP - 1) 20030, 10030, 20030 01430508 +10030 IVPASS = IVPASS + 1 01440508 + WRITE (NUVI, 80002) IVTNUM 01450508 + GO TO 0031 01460508 +20030 IVFAIL = IVFAIL + 1 01470508 + CVCORR = 'LONGS' 01480508 + WRITE (NUVI, 80018) IVTNUM, E5XVK, CVCORR 01490508 + 0031 CONTINUE 01500508 +CT004* TEST 4 3 CHARACTER VARIABLE 01510508 + IVTNUM = 4 01520508 + IVCOMP = 0 01530508 + IF (F3XVK.EQ.'END') IVCOMP = 1 01540508 + IF (IVCOMP - 1) 20040, 10040, 20040 01550508 +10040 IVPASS = IVPASS + 1 01560508 + WRITE (NUVI, 80002) IVTNUM 01570508 + GO TO 0041 01580508 +20040 IVFAIL = IVFAIL + 1 01590508 + CVCORR = 'END' 01600508 + WRITE (NUVI, 80018) IVTNUM, F3XVK, CVCORR 01610508 + 0041 CONTINUE 01620508 +C***** 01630508 +CBB** ********************** BBCSUM0 **********************************01640508 +C**** WRITE OUT TEST SUMMARY 01650508 +C**** 01660508 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01670508 + WRITE (I02, 90004) 01680508 + WRITE (I02, 90014) 01690508 + WRITE (I02, 90004) 01700508 + WRITE (I02, 90020) IVPASS 01710508 + WRITE (I02, 90022) IVFAIL 01720508 + WRITE (I02, 90024) IVDELE 01730508 + WRITE (I02, 90026) IVINSP 01740508 + WRITE (I02, 90028) IVTOTN, IVTOTL 01750508 +CBE** ********************** BBCSUM0 **********************************01760508 +CBB** ********************** BBCFOOT0 **********************************01770508 +C**** WRITE OUT REPORT FOOTINGS 01780508 +C**** 01790508 + WRITE (I02,90016) ZPROG, ZPROG 01800508 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 01810508 + WRITE (I02,90019) 01820508 +CBE** ********************** BBCFOOT0 **********************************01830508 +CBB** ********************** BBCFMT0A **********************************01840508 +C**** FORMATS FOR TEST DETAIL LINES 01850508 +C**** 01860508 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 01870508 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 01880508 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 01890508 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 01900508 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 01910508 + 1I6,/," ",15X,"CORRECT= " ,I6) 01920508 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01930508 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 01940508 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01950508 + 1A21,/," ",16X,"CORRECT= " ,A21) 01960508 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 01970508 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 01980508 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 01990508 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02000508 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02010508 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02020508 +80050 FORMAT (" ",48X,A31) 02030508 +CBE** ********************** BBCFMT0A **********************************02040508 +CBB** ********************** BBCFMAT1 **********************************02050508 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02060508 +C**** 02070508 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02080508 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02090508 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02100508 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02110508 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02120508 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02130508 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02140508 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02150508 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02160508 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02170508 + 2"(",F12.5,", ",F12.5,")") 02180508 +CBE** ********************** BBCFMAT1 **********************************02190508 +CBB** ********************** BBCFMT0B **********************************02200508 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02210508 +C**** 02220508 +90002 FORMAT ("1") 02230508 +90004 FORMAT (" ") 02240508 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02250508 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02260508 +90008 FORMAT (" ",21X,A13,A17) 02270508 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02280508 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02290508 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02300508 + 1 7X,"REMARKS",24X) 02310508 +90014 FORMAT (" ","----------------------------------------------" , 02320508 + 1 "---------------------------------" ) 02330508 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02340508 +C**** 02350508 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02360508 +C**** 02370508 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02380508 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02390508 + 1 A13) 02400508 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02410508 +C**** 02420508 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02430508 +C**** 02440508 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02450508 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02460508 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02470508 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02480508 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02490508 +CBE** ********************** BBCFMT0B **********************************02500508 +C***** 02510508 + END 02520508 diff --git a/Fortran/UnitTests/fcvs21_f95/FM506.reference_output b/Fortran/UnitTests/fcvs21_f95/FM506.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM506.reference_output @@ -0,0 +1,38 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM506BEGIN* TEST RESULTS - FM506 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + BLKD3 - (262) BLOCK DATA SUBPROGRAM -- + + VARYING CHARACTER VARIABLE LENGTHS + + ANS REF. - 16 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 4 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + + ------------------------------------------------------------------------------- + + 4 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 4 OF 4 TESTS EXECUTED + + *FM506END* END OF TEST - FM506 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM509.f b/Fortran/UnitTests/fcvs21_f95/FM509.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM509.f @@ -0,0 +1,569 @@ + PROGRAM FM509 00010509 +C 00020509 +C THIS ROUTINE TESTS SUBROUTINE SUBPROGRAMS AND ANS REF. 00030509 +C FUNCTION SUBPROGRAMS WITH MULTIPLE ENTRIES. 15.6.1 00040509 +C THIS ROUTINE ALSO TESTS THE USE OF SYMBOLIC 15.7, 15.7.1 00050509 +C NAMES OF CONSTANTS, SUBSTRINGS NAMES, AND 15.9.2 00060509 +C ARRAY ELEMENT SUBSTRINGS AS ARGUMENTS. 15.9.3.2 00070509 +C 15.9.3.3 00080509 +C THIS ROUTINE USES THE SUBROUTINE SUBPROGRAMS SN510, 00090509 +C SN511, AND SN512, AND THE FUNCTION SUBPROGRAM RF513. 00100509 +C 00110509 +CBB** ********************** BBCCOMNT **********************************00120509 +C**** 00130509 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140509 +C**** VERSION 2.1 00150509 +C**** 00160509 +C**** 00170509 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180509 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00190509 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00200509 +C**** BUILDING 225 RM A266 00210509 +C**** GAITHERSBURG, MD 20899 00220509 +C**** 00230509 +C**** 00240509 +C**** 00250509 +CBE** ********************** BBCCOMNT **********************************00260509 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00270509 + IMPLICIT CHARACTER*27 (C) 00280509 +CBB** ********************** BBCINITA **********************************00290509 +C**** SPECIFICATION STATEMENTS 00300509 +C**** 00310509 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320509 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330509 +CBE** ********************** BBCINITA **********************************00340509 +C 00350509 + INTEGER I2N001(2,2) 00360509 + CHARACTER CVCOMP*12,CVCORR*12,CVN001*30 00370509 + CHARACTER C1N001(6)*10 00380509 + PARAMETER (IPN001=31) 00390509 + COMMON IVC001, IVC002, IVC003 00400509 + EXTERNAL RF513 00410509 + DATA I2N001 /1, 3, 5, 7/ 00420509 + DATA CVN001 /'REDORANGEYELLOWGREENBLUEVIOLET'/ 00430509 + DATA C1N001 /'FIRST-AID:','SECONDRATE','THIRD-TERM', 00440509 + 1 'FOURTH-DAY','FIFTHROUND','SIXTHMONTH'/ 00450509 +C 00460509 +C 00470509 +CBB** ********************** BBCINITB **********************************00480509 +C**** INITIALIZE SECTION 00490509 + DATA ZVERS, ZVERSD, ZDATE 00500509 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00510509 + DATA ZCOMPL, ZNAME, ZTAPE 00520509 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00530509 + DATA ZPROJ, ZTAPED, ZPROG 00540509 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00550509 + DATA REMRKS /' '/ 00560509 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00570509 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00580509 +C**** 00590509 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00600509 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00610509 +CZ03 ZPROG = 'PROGRAM NAME' 00620509 +CZ04 ZDATE = 'DATE OF TEST' 00630509 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00640509 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00650509 +CZ07 ZNAME = 'NAME OF USER' 00660509 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00670509 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00680509 +C 00690509 + IVPASS = 0 00700509 + IVFAIL = 0 00710509 + IVDELE = 0 00720509 + IVINSP = 0 00730509 + IVTOTL = 0 00740509 + IVTOTN = 0 00750509 + ICZERO = 0 00760509 +C 00770509 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00780509 + I01 = 05 00790509 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00800509 + I02 = 06 00810509 +C 00820509 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00830509 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00840509 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00850509 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00860509 +C 00870509 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00880509 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00890509 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00900509 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00910509 +C 00920509 +CBE** ********************** BBCINITB **********************************00930509 + ZPROG = 'FM509' 00940509 + IVTOTL = 16 00950509 +CBB** ********************** BBCHED0A **********************************00960509 +C**** 00970509 +C**** WRITE REPORT TITLE 00980509 +C**** 00990509 + WRITE (I02, 90002) 01000509 + WRITE (I02, 90006) 01010509 + WRITE (I02, 90007) 01020509 + WRITE (I02, 90008) ZVERS, ZVERSD 01030509 + WRITE (I02, 90009) ZPROG, ZPROG 01040509 + WRITE (I02, 90010) ZDATE, ZCOMPL 01050509 +CBE** ********************** BBCHED0A **********************************01060509 +CBB** ********************** BBCHED0B **********************************01070509 +C**** WRITE DETAIL REPORT HEADERS 01080509 +C**** 01090509 + WRITE (I02,90004) 01100509 + WRITE (I02,90004) 01110509 + WRITE (I02,90013) 01120509 + WRITE (I02,90014) 01130509 + WRITE (I02,90015) IVTOTL 01140509 +CBE** ********************** BBCHED0B **********************************01150509 +C 01160509 +CT001* TEST 001 **** FCVS PROGRAM 509 **** 01170509 +C SUBROUTINE WITH MULTIPLE ENTRIES 01180509 +C 01190509 + IVTNUM = 1 01200509 + IVCOMP = 0 01210509 + IVCORR = 25 01220509 + IVD020=3 01220509 + CALL SN510(IVD020,IVN001) 01230509 + CALL EN851(IVN001,IVCOMP) 01240509 +40010 IF (IVCOMP - 25) 20010, 10010, 20010 01250509 +10010 IVPASS = IVPASS + 1 01260509 + WRITE (I02,80002) IVTNUM 01270509 + GO TO 0011 01280509 +20010 IVFAIL = IVFAIL + 1 01290509 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01300509 + 0011 CONTINUE 01310509 +C 01320509 +CT002* TEST 002 **** FCVS PROGRAM 509 **** 01330509 +C ENTRY WITH ONE ARGUMENT 01340509 +C 01350509 + IVTNUM = 2 01360509 + IVCOMP = 0 01370509 + IVCORR = 137 01380509 + IVN001 = 37 01390509 + CALL EN852(IVN001) 01400509 + IVCOMP = IVN001 01410509 +40020 IF (IVCOMP - 137) 20020, 10020, 20020 01420509 +10020 IVPASS = IVPASS + 1 01430509 + WRITE (I02,80002) IVTNUM 01440509 + GO TO 0021 01450509 +20020 IVFAIL = IVFAIL + 1 01460509 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01470509 + 0021 CONTINUE 01480509 +C 01490509 +CT003* TEST 003 **** FCVS PROGRAM 509 **** 01500509 +C ENTRY WITH TWO ARGUMENT 01510509 +C 01520509 + IVTNUM = 3 01530509 + IVCOMP = 0 01540509 + IVCORR = -51 01550509 + CALL EN853(-9,IVCOMP) 01560509 +40030 IF (IVCOMP + 51) 20030, 10030, 20030 01570509 +10030 IVPASS = IVPASS + 1 01580509 + WRITE (I02,80002) IVTNUM 01590509 + GO TO 0031 01600509 +20030 IVFAIL = IVFAIL + 1 01610509 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01620509 + 0031 CONTINUE 01630509 +C 01640509 +CT004* TEST 004 **** FCVS PROGRAM 509 **** 01650509 +C ENTRY WITH THREE ARGUMENTS 01660509 +C 01670509 + IVTNUM = 4 01680509 + IVCOMP = 0 01690509 + IVCORR = -71 01700509 + CALL EN854(275,147,IVCOMP) 01710509 +40040 IF (IVCOMP + 71) 20040, 10040, 20040 01720509 +10040 IVPASS = IVPASS + 1 01730509 + WRITE (I02,80002) IVTNUM 01740509 + GO TO 0041 01750509 +20040 IVFAIL = IVFAIL + 1 01760509 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01770509 + 0041 CONTINUE 01780509 +C 01790509 +CT005* TEST 005 **** FCVS PROGRAM 509 **** 01800509 +C ENTRY WITH FOUR ARGUMENTS 01810509 +C 01820509 + IVTNUM = 5 01830509 + IVCOMP = 0 01840509 + IVCORR = 567 01850509 + CALL EN855(12,-15,63,IVCOMP) 01860509 +40050 IF (IVCOMP - 567) 20050, 10050, 20050 01870509 +10050 IVPASS = IVPASS + 1 01880509 + WRITE (I02,80002) IVTNUM 01890509 + GO TO 0051 01900509 +20050 IVFAIL = IVFAIL + 1 01910509 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01920509 + 0051 CONTINUE 01930509 +C 01940509 +CT006* TEST 006 **** FCVS PROGRAM 509 **** 01950509 +C ENTRY WITH ARRAY AS DUMMY ARGUMENT 01960509 +C 01970509 + IVTNUM = 6 01980509 + IVCOMP = 0 01990509 + IVCORR = 16 02000509 + IVN001 = 2 02010509 + CALL EN856(IVN001,I2N001,IVCOMP) 02020509 +40060 IF (IVCOMP - 16) 20060, 10060, 20060 02030509 +10060 IVPASS = IVPASS + 1 02040509 + WRITE (I02,80002) IVTNUM 02050509 + GO TO 0061 02060509 +20060 IVFAIL = IVFAIL + 1 02070509 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02080509 + 0061 CONTINUE 02090509 +C 02100509 +CT007* TEST 007 **** FCVS PROGRAM 509 **** 02110509 +C ENTRY WITH PROCEDURE AS DUMMY ARGUMENT 02120509 +C 02130509 + IVTNUM = 7 02140509 + RVCOMP = 0.0 02150509 + RVCORR = 2.25 02160509 + CALL EN857(1.5,RVCOMP,RF513) 02170509 + IF (RVCOMP - 0.22498E+01) 20070, 10070, 40070 02180509 +40070 IF (RVCOMP - 0.22502E+01) 10070, 10070, 20070 02190509 +10070 IVPASS = IVPASS + 1 02200509 + WRITE (I02,80002) IVTNUM 02210509 + GO TO 0071 02220509 +20070 IVFAIL = IVFAIL + 1 02230509 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02240509 + 0071 CONTINUE 02250509 +C 02260509 +CT008* TEST 008 **** FCVS PROGRAM 509 **** 02270509 +C ENTRY WITH ASTERISK AS DUMMY ARGUMENT 02280509 +C 02290509 + IVTNUM = 8 02300509 + IVCOMP = 0 02310509 + IVCORR = 19 02320509 + IVN001 = 2 02330509 + CALL EN858(IVN001,*0082,*0083) 02340509 +0082 IVCOMP = 5 02350509 + GO TO 0084 02360509 +0083 IVCOMP = 19 02370509 +0084 CONTINUE 02380509 +40080 IF (IVCOMP - 19) 20080, 10080, 20080 02390509 +10080 IVPASS = IVPASS + 1 02400509 + WRITE (I02,80002) IVTNUM 02410509 + GO TO 0081 02420509 +20080 IVFAIL = IVFAIL + 1 02430509 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02440509 + 0081 CONTINUE 02450509 +C 02460509 +C TESTS 9 AND 10 TEST ENTRY WITHOUT ARGUMENTS 02470509 +C 02480509 +CT009* TEST 009 **** FCVS PROGRAM 509 **** 02490509 +C 02500509 + IVTNUM = 9 02510509 + IVCOMP = 0 02520509 + IVCORR = 88 02530509 + IVC002 = 65 02540509 + IVC003 = 23 02550509 + CALL EN859( ) 02560509 + IVCOMP = IVC001 02570509 +40090 IF (IVCOMP - 88) 20090, 10090, 20090 02580509 +10090 IVPASS = IVPASS + 1 02590509 + WRITE (I02,80002) IVTNUM 02600509 + GO TO 0091 02610509 +20090 IVFAIL = IVFAIL + 1 02620509 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02630509 + 0091 CONTINUE 02640509 +C 02650509 +CT010* TEST 010 **** FCVS PROGRAM 509 **** 02660509 +C 02670509 + IVTNUM = 10 02680509 + IVCOMP = 0 02690509 + IVCORR = -13 02700509 + IVC001 = 4 02710509 + IVC002 = -17 02720509 + CALL EN860 02730509 + IVCOMP = IVC003 02740509 +40100 IF (IVCOMP + 13) 20100, 10100, 20100 02750509 +10100 IVPASS = IVPASS + 1 02760509 + WRITE (I02,80002) IVTNUM 02770509 + GO TO 0101 02780509 +20100 IVFAIL = IVFAIL + 1 02790509 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02800509 + 0101 CONTINUE 02810509 +C 02820509 +CT011* TEST 011 **** FCVS PROGRAM 509 **** 02830509 +C FUNCTION SUBPROGRAM WITH MULTIPLE ENTRIES 02840509 +C 02850509 + IVTNUM = 11 02860509 + RVCOMP = 0.0 02870509 + RVCORR = 3.675E-3 02880509 + RVN001 = RF513(3.5E-2) 02890509 + RVCOMP = EF852(RVN001) 02900509 + IF (RVCOMP - 0.36748E-02) 20110, 10110, 40110 02910509 +40110 IF (RVCOMP - 0.36752E-02) 10110, 10110, 20110 02920509 +10110 IVPASS = IVPASS + 1 02930509 + WRITE (I02,80002) IVTNUM 02940509 + GO TO 0111 02950509 +20110 IVFAIL = IVFAIL + 1 02960509 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02970509 + 0111 CONTINUE 02980509 +C 02990509 +CT012* TEST 012 **** FCVS PROGRAM 509 **** 03000509 +C SYMBOLIC NAME OF A CONSTANT AS AN ACTUAL ARGUMENT 03010509 +C 03020509 + IVTNUM = 12 03030509 + IVCOMP = 0 03040509 + IVCORR = 34 03050509 + CALL SN510(IPN001,IVCOMP) 03060509 +40120 IF (IVCOMP - 34) 20120, 10120, 20120 03070509 +10120 IVPASS = IVPASS + 1 03080509 + WRITE (I02,80002) IVTNUM 03090509 + GO TO 0121 03100509 +20120 IVFAIL = IVFAIL + 1 03110509 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03120509 + 0121 CONTINUE 03130509 +C 03140509 +C TESTS 13 AND 14 TEST THE USE OF A SUBSTRING AS AN ACTUAL ARGUMENT 03150509 +C WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIABLE 03160509 +C 03170509 +C 03180509 +CT013* TEST 013 **** FCVS PROGRAM 509 **** 03190509 +C 03200509 + IVTNUM = 13 03210509 + CVCOMP = ' ' 03220509 + CVCORR = 'COLOR=YELLOW ' 03230509 + CALL SN511(CVN001(10:15),CVCOMP) 03240509 + IVCOMP = 0 03250509 + IF (CVCOMP.EQ.'COLOR=YELLOW ') IVCOMP = 1 03260509 +40130 IF (IVCOMP - 1) 20130, 10130, 20130 03270509 +10130 IVPASS = IVPASS + 1 03280509 + WRITE (I02,80002) IVTNUM 03290509 + GO TO 0131 03300509 +20130 IVFAIL = IVFAIL + 1 03310509 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03320509 + 0131 CONTINUE 03330509 +C 03340509 +CT014* TEST 014 **** FCVS PROGRAM 509 **** 03350509 +C 03360509 + IVTNUM = 14 03370509 + CVCOMP = ' ' 03380509 + CVCORR = 'COLOR=VIOLET ' 03390509 + CALL SN511(CVN001(25:30),CVCOMP) 03400509 + IVCOMP = 0 03410509 + IF (CVCOMP.EQ.'COLOR=VIOLET ') IVCOMP = 1 03420509 +40140 IF (IVCOMP - 1) 20140, 10140, 20140 03430509 +10140 IVPASS = IVPASS + 1 03440509 + WRITE (I02,80002) IVTNUM 03450509 + GO TO 0141 03460509 +20140 IVFAIL = IVFAIL + 1 03470509 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03480509 + 0141 CONTINUE 03490509 +C 03500509 +C TESTS 15 AND 16 TEST THE USE OF AN ARRAY ELEMENT SUBSTRING AS AN 03510509 +C ACTUAL ARGUMENT WHICH IS ASSOCIATED WITH A DUMMY ARGUMENT THAT 03520509 +C IS AN ARRAY 03530509 +C 03540509 +C 03550509 +CT015* TEST 015 **** FCVS PROGRAM 509 **** 03560509 +C 03570509 + IVTNUM = 15 03580509 + CVCOMP = ' ' 03590509 + CVCORR = 'RST-AID: ' 03600509 + CALL SN512(C1N001(1)(3:10),CVCOMP) 03610509 + IVCOMP = 0 03620509 + IF (CVCOMP.EQ.'RST-AID: ') IVCOMP = 1 03630509 +40150 IF (IVCOMP - 1) 20150, 10150, 20150 03640509 +10150 IVPASS = IVPASS + 1 03650509 + WRITE (I02,80002) IVTNUM 03660509 + GO TO 0151 03670509 +20150 IVFAIL = IVFAIL + 1 03680509 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03690509 + 0151 CONTINUE 03700509 +C 03710509 +CT016* TEST 016 **** FCVS PROGRAM 509 **** 03720509 +C 03730509 + IVTNUM = 16 03740509 + CVCOMP = ' ' 03750509 + CVCORR = 'IFTHROUN ' 03760509 + CALL SN512(C1N001(5)(2:9),CVCOMP) 03770509 + IVCOMP = 0 03780509 + IF (CVCOMP.EQ.'IFTHROUN ') IVCOMP = 1 03790509 +40160 IF (IVCOMP - 1) 20160, 10160, 20160 03800509 +10160 IVPASS = IVPASS + 1 03810509 + WRITE (I02,80002) IVTNUM 03820509 + GO TO 0161 03830509 +20160 IVFAIL = IVFAIL + 1 03840509 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03850509 + 0161 CONTINUE 03860509 +C 03870509 +CBB** ********************** BBCSUM0 **********************************03880509 +C**** WRITE OUT TEST SUMMARY 03890509 +C**** 03900509 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03910509 + WRITE (I02, 90004) 03920509 + WRITE (I02, 90014) 03930509 + WRITE (I02, 90004) 03940509 + WRITE (I02, 90020) IVPASS 03950509 + WRITE (I02, 90022) IVFAIL 03960509 + WRITE (I02, 90024) IVDELE 03970509 + WRITE (I02, 90026) IVINSP 03980509 + WRITE (I02, 90028) IVTOTN, IVTOTL 03990509 +CBE** ********************** BBCSUM0 **********************************04000509 +CBB** ********************** BBCFOOT0 **********************************04010509 +C**** WRITE OUT REPORT FOOTINGS 04020509 +C**** 04030509 + WRITE (I02,90016) ZPROG, ZPROG 04040509 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04050509 + WRITE (I02,90019) 04060509 +CBE** ********************** BBCFOOT0 **********************************04070509 +90001 FORMAT (" ",56X,"FM509") 04080509 +90000 FORMAT (" ",50X,"END OF PROGRAM FM509" ) 04090509 +CBB** ********************** BBCFMT0A **********************************04100509 +C**** FORMATS FOR TEST DETAIL LINES 04110509 +C**** 04120509 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04130509 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04140509 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04150509 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04160509 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04170509 + 1I6,/," ",15X,"CORRECT= " ,I6) 04180509 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04190509 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04200509 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04210509 + 1A21,/," ",16X,"CORRECT= " ,A21) 04220509 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04230509 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04240509 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04250509 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04260509 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04270509 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04280509 +80050 FORMAT (" ",48X,A31) 04290509 +CBE** ********************** BBCFMT0A **********************************04300509 +CBB** ********************** BBCFMAT1 **********************************04310509 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04320509 +C**** 04330509 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04340509 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04350509 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04360509 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04370509 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04380509 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04390509 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04400509 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04410509 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04420509 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04430509 + 2"(",F12.5,", ",F12.5,")") 04440509 +CBE** ********************** BBCFMAT1 **********************************04450509 +CBB** ********************** BBCFMT0B **********************************04460509 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04470509 +C**** 04480509 +90002 FORMAT ("1") 04490509 +90004 FORMAT (" ") 04500509 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04510509 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04520509 +90008 FORMAT (" ",21X,A13,A17) 04530509 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04540509 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04550509 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04560509 + 1 7X,"REMARKS",24X) 04570509 +90014 FORMAT (" ","----------------------------------------------" , 04580509 + 1 "---------------------------------" ) 04590509 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04600509 +C**** 04610509 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04620509 +C**** 04630509 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04640509 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04650509 + 1 A13) 04660509 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04670509 +C**** 04680509 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04690509 +C**** 04700509 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04710509 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04720509 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04730509 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04740509 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04750509 +CBE** ********************** BBCFMT0B **********************************04760509 + STOP 04770509 + END 04780509 + +C 00010510 +C THIS ROUTINE IS TO BE RUN WITH ROUTINE 509. 00020510 +C 00030510 +C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST IF 00040510 +C MULTIPLE ENTRIES ARE PERMITTED IN A SUBROUTINE SUBPROGRAM. 00050510 +C 00060510 + SUBROUTINE SN510(IVD021,IVD002) 00070510 + INTEGER I2D001(2,2) 00080510 + COMMON IVC001, IVC002, IVC003 00090510 + IVD001 = IVD021 00090510 + DO 70010 IVN001 = 1, 3 00100510 + IVD001 = IVD001 + 1 00110510 +70010 CONTINUE 00120510 + IVD002 = IVD001 00130510 + RETURN 00140510 + ENTRY EN851(IVD003,IVD004) 00150510 + IVD004 = 3*IVD003 + 7 00160510 + RETURN 00170510 + ENTRY EN852(IVD005) 00180510 + IVD005 = IVD005 + 100 00190510 + RETURN 00200510 + ENTRY EN853(IVD006,IVD007) 00210510 + IVD007 = 5*(IVD006 + 2) - 16 00220510 + RETURN 00230510 + ENTRY EN854(IVD008,IVD009,IVD010) 00240510 + IVD010 = 4*(IVD008 - 2*IVD009) + 5 00250510 + RETURN 00260510 + ENTRY EN855(IVD011, IVD012, IVD013, IVD014) 00270510 + IVD014 = IVD013*(2*IVD011 + IVD012) 00280510 + RETURN 00290510 + ENTRY EN856(IVD015,I2D001,IVD016) 00300510 + IVD016 = 0 00310510 + DO 70020 IVN001 = 1, IVD015 00320510 + DO 70020 IVN002 = 1, IVD015 00330510 +70020 IVD016 = IVD016 + I2D001(IVN001,IVN002) 00340510 + RETURN 00350510 + ENTRY EN857(RVD017,RVD018,RFD001) 00360510 + RVD018 = RFD001(RVD017) 00370510 + RETURN 00380510 + ENTRY EN858(IVD019,*,*) 00390510 + RETURN IVD019 00400510 + ENTRY EN859( ) 00410510 + IVC001 = IVC002 + IVC003 00420510 + RETURN 00430510 + ENTRY EN860 00440510 + IVC003 = IVC001 + IVC002 00450510 + RETURN 00460510 + END 00470510 +C 00480510 + +C 00010511 +C THIS ROUTINE IS TO BE RUN WITH ROUTINE 509. 00020511 +C 00030511 +C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE 00040511 +C OF A SUBSTRING NAME AS AN ACTUAL ARGUMENT WHICH IS 00050511 +C ASSOCIATED WITH A DUMMY ARGUMENT THAT IS A VARIBLE 00060511 +C 00070511 + SUBROUTINE SN511(CVD001,CVD002) 00080511 + CHARACTER CVD001*6, CVD002*12 00090511 + CVD002 = 'COLOR='//CVD001 00100511 + RETURN 00110511 + END 00120511 + +C 00010512 +C THIS ROUTINE IS TO BE RUN WIHT ROUTINE 509. 00020512 +C 00030512 +C THIS SUBROUTINE IS CALLED IN THE MAIN PROGRAM TO TEST THE USE OF 00040512 +C AN ARRAY ELEMENT SUBSTRING AS AN ACTUAL ARGUMENT WHICH 00050512 +C IS ASSOCIATED WITH A DUMMY ARGUMENT THAT IS AN ARRAY. 00060512 +C 00070512 + SUBROUTINE SN512(C1D001,CVD001) 00080512 + CHARACTER C1D001(6)*8,CVD001*8 00090512 + CVD001 = C1D001(1) 00100512 + RETURN 00110512 + END 00120512 + +C 00010513 +C THIS FUNCTION IS TO BE RUN WITH ROUTINE 509. 00020513 +C 00030513 +C THIS FUNCTION IS REFERENCED IN THE MAIN PROGRAM TO TEST IF 00040513 +C MULTIPLE ENTRIES ARE PERMITTED IN A FUNCTION SUBPROGRAM. 00050513 +C 00060513 + FUNCTION RF513(RVD001) 00070513 + RF513 = RVD001**2 00080513 + RETURN 00090513 + ENTRY EF852(RVD002) 00100513 + EF852 = 3*RVD002 00110513 + RETURN 00120513 + END 00130513 diff --git a/Fortran/UnitTests/fcvs21_f95/FM509.reference_output b/Fortran/UnitTests/fcvs21_f95/FM509.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM509.reference_output @@ -0,0 +1,44 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM509BEGIN* TEST RESULTS - FM509 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 16 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + + ------------------------------------------------------------------------------- + + 16 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 16 OF 16 TESTS EXECUTED + + *FM509END* END OF TEST - FM509 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM514.f b/Fortran/UnitTests/fcvs21_f95/FM514.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM514.f @@ -0,0 +1,263 @@ + PROGRAM FM514 00010514 +C 00020514 +C THIS ROUTINE TESTS SUBROUTINE STATEMENT WITH ANS REF. 00030514 +C ASTERISK DUMMY ARGUMENTS AND TEST ALTERNATE 15.6.1 00040514 +C RETURN SPECIFIER AS AN ACTUAL ARGUMENT. 15.9.3.5 00050514 +C 15.6.2.3 00060514 +C THIS ROUTINE USES SUBROUTINE SUBPROGRAMS SN515 AND 00070514 +C SN516. 00080514 +C 00090514 +CBB** ********************** BBCCOMNT **********************************00100514 +C**** 00110514 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120514 +C**** VERSION 2.1 00130514 +C**** 00140514 +C**** 00150514 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160514 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170514 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180514 +C**** BUILDING 225 RM A266 00190514 +C**** GAITHERSBURG, MD 20899 00200514 +C**** 00210514 +C**** 00220514 +C**** 00230514 +CBE** ********************** BBCCOMNT **********************************00240514 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00250514 + IMPLICIT CHARACTER*27 (C) 00260514 +CBB** ********************** BBCINITA **********************************00270514 +C**** SPECIFICATION STATEMENTS 00280514 +C**** 00290514 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00300514 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00310514 +CBE** ********************** BBCINITA **********************************00320514 +C 00330514 +CBB** ********************** BBCINITB **********************************00340514 +C**** INITIALIZE SECTION 00350514 + DATA ZVERS, ZVERSD, ZDATE 00360514 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00370514 + DATA ZCOMPL, ZNAME, ZTAPE 00380514 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00390514 + DATA ZPROJ, ZTAPED, ZPROG 00400514 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00410514 + DATA REMRKS /' '/ 00420514 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00430514 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00440514 +C**** 00450514 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00460514 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00470514 +CZ03 ZPROG = 'PROGRAM NAME' 00480514 +CZ04 ZDATE = 'DATE OF TEST' 00490514 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00500514 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00510514 +CZ07 ZNAME = 'NAME OF USER' 00520514 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00530514 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00540514 +C 00550514 + IVPASS = 0 00560514 + IVFAIL = 0 00570514 + IVDELE = 0 00580514 + IVINSP = 0 00590514 + IVTOTL = 0 00600514 + IVTOTN = 0 00610514 + ICZERO = 0 00620514 +C 00630514 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640514 + I01 = 05 00650514 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660514 + I02 = 06 00670514 +C 00680514 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690514 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700514 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00710514 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00720514 +C 00730514 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00740514 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00750514 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00760514 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00770514 +C 00780514 +CBE** ********************** BBCINITB **********************************00790514 + ZPROG = 'FM514' 00800514 + IVTOTL = 2 00810514 +CBB** ********************** BBCHED0A **********************************00820514 +C**** 00830514 +C**** WRITE REPORT TITLE 00840514 +C**** 00850514 + WRITE (I02, 90002) 00860514 + WRITE (I02, 90006) 00870514 + WRITE (I02, 90007) 00880514 + WRITE (I02, 90008) ZVERS, ZVERSD 00890514 + WRITE (I02, 90009) ZPROG, ZPROG 00900514 + WRITE (I02, 90010) ZDATE, ZCOMPL 00910514 +CBE** ********************** BBCHED0A **********************************00920514 +CBB** ********************** BBCHED0B **********************************00930514 +C**** WRITE DETAIL REPORT HEADERS 00940514 +C**** 00950514 + WRITE (I02,90004) 00960514 + WRITE (I02,90004) 00970514 + WRITE (I02,90013) 00980514 + WRITE (I02,90014) 00990514 + WRITE (I02,90015) IVTOTL 01000514 +CBE** ********************** BBCHED0B **********************************01010514 +C 01020514 +CT001* TEST 001 **** FCVS PROGRAM 514 **** 01030514 +C TEST 001 TEST SUBROUTINE STATEMENT WITH ASTERISK DUMMY ARGUMENTS 01040514 +C 01050514 + IVTNUM = 1 01060514 + IVCOMP = 0 01070514 + IVCORR = 3 01080514 + IVN001 = 1 01090514 +0012 CALL SN515(IVN001,*0013,*0014) 01100514 + IVCOMP = 10 01110514 +0013 CONTINUE 01120514 + IVCOMP = IVCOMP + IVN001 01130514 + IVN001 = 2 01140514 + GO TO 0012 01150514 +0014 CONTINUE 01160514 + IVCOMP = IVCOMP + IVN001 01170514 +40010 IF (IVCOMP - 3) 20010, 10010, 20010 01180514 +10010 IVPASS = IVPASS + 1 01190514 + WRITE (I02,80002) IVTNUM 01200514 + GO TO 0011 01210514 +20010 IVFAIL = IVFAIL + 1 01220514 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01230514 + 0011 CONTINUE 01240514 +C 01250514 +CT002* TEST 002 **** FCVS PROGRAM 514 **** 01260514 +C TEST 002 TESTS THE USE OF AN ALTERNATE RETURN SPECIFIER 01270514 +C AS AN ACTUAL ARGUMENT 01280514 +C 01290514 + IVTNUM = 2 01300514 + IVCOMP = 0 01310514 + IVCORR = 0 01320514 + CALL SN516(5,IVN001,*0024) 01330514 +0022 IVCOMP = IVCOMP - IVN001 01340514 + GO TO 0025 01350514 +0023 CONTINUE 01360514 + IVCOMP = IVCOMP - IVN001 01370514 + CALL SN516(4,IVN001,*0022) 01380514 + IVCOMP = IVCOMP + IVN001 01390514 +0024 CONTINUE 01400514 + IVCOMP = IVCOMP + IVN001 01410514 + CALL SN516(3,IVN001,*0023) 01420514 + IVCOMP = IVCOMP + IVN001 01430514 +0025 CONTINUE 01440514 +40020 IF (IVCOMP - 0) 20020, 10020, 20020 01450514 +10020 IVPASS = IVPASS + 1 01460514 + WRITE (I02,80002) IVTNUM 01470514 + GO TO 0021 01480514 +20020 IVFAIL = IVFAIL + 1 01490514 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01500514 + 0021 CONTINUE 01510514 +C 01520514 +CBB** ********************** BBCSUM0 **********************************01530514 +C**** WRITE OUT TEST SUMMARY 01540514 +C**** 01550514 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01560514 + WRITE (I02, 90004) 01570514 + WRITE (I02, 90014) 01580514 + WRITE (I02, 90004) 01590514 + WRITE (I02, 90020) IVPASS 01600514 + WRITE (I02, 90022) IVFAIL 01610514 + WRITE (I02, 90024) IVDELE 01620514 + WRITE (I02, 90026) IVINSP 01630514 + WRITE (I02, 90028) IVTOTN, IVTOTL 01640514 +CBE** ********************** BBCSUM0 **********************************01650514 +CBB** ********************** BBCFOOT0 **********************************01660514 +C**** WRITE OUT REPORT FOOTINGS 01670514 +C**** 01680514 + WRITE (I02,90016) ZPROG, ZPROG 01690514 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 01700514 + WRITE (I02,90019) 01710514 +CBE** ********************** BBCFOOT0 **********************************01720514 +90001 FORMAT (" ",56X,"FM514") 01730514 +90000 FORMAT (" ",50X,"END OF PROGRAM FM514" ) 01740514 +CBB** ********************** BBCFMT0A **********************************01750514 +C**** FORMATS FOR TEST DETAIL LINES 01760514 +C**** 01770514 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 01780514 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 01790514 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 01800514 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 01810514 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 01820514 + 1I6,/," ",15X,"CORRECT= " ,I6) 01830514 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01840514 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 01850514 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01860514 + 1A21,/," ",16X,"CORRECT= " ,A21) 01870514 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 01880514 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 01890514 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 01900514 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 01910514 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 01920514 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 01930514 +80050 FORMAT (" ",48X,A31) 01940514 +CBE** ********************** BBCFMT0A **********************************01950514 +CBB** ********************** BBCFMAT1 **********************************01960514 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 01970514 +C**** 01980514 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 01990514 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02000514 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02010514 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02020514 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02030514 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02040514 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02050514 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02060514 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02070514 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02080514 + 2"(",F12.5,", ",F12.5,")") 02090514 +CBE** ********************** BBCFMAT1 **********************************02100514 +CBB** ********************** BBCFMT0B **********************************02110514 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02120514 +C**** 02130514 +90002 FORMAT ("1") 02140514 +90004 FORMAT (" ") 02150514 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02160514 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02170514 +90008 FORMAT (" ",21X,A13,A17) 02180514 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02190514 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02200514 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02210514 + 1 7X,"REMARKS",24X) 02220514 +90014 FORMAT (" ","----------------------------------------------" , 02230514 + 1 "---------------------------------" ) 02240514 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02250514 +C**** 02260514 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02270514 +C**** 02280514 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02290514 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02300514 + 1 A13) 02310514 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02320514 +C**** 02330514 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02340514 +C**** 02350514 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02360514 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02370514 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02380514 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02390514 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02400514 +CBE** ********************** BBCFMT0B **********************************02410514 + STOP 02420514 + END 02430514 + +C 00010515 +C THIS ROUTINE IS TO BE RUN WITH ROUTINE 514 00020515 +C 00030515 +C THIS SUBROUTINE IS USED TO TEST SUBROUTINE STATEMENT WITH 00040515 +C ASTERISK DUMMY ARGUMENTS 00050515 +C 00060515 + SUBROUTINE SN515(IVD001,*,*) 00070515 + RETURN IVD001 00080515 + END 00090515 + +C THIS ROUTINE IS TO BE RUN WITH ROUTINE 514. 00010516 +C 00020516 +C THIS SUBROUTINE IS CALLED TO TEST THE USE OF AN ALTERNATE 00030516 +C RETURN SPECIFIER AS AN ACTUAL ARGUMENT 00040516 +C 00050516 + SUBROUTINE SN516(IVD001,IVD002,*) 00060516 + IVD002 = IVD001**2 00070516 + RETURN 1 00080516 + END 00090516 diff --git a/Fortran/UnitTests/fcvs21_f95/FM514.reference_output b/Fortran/UnitTests/fcvs21_f95/FM514.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM514.reference_output @@ -0,0 +1,30 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM514BEGIN* TEST RESULTS - FM514 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 2 TESTS + + 1 PASS + 2 PASS + + ------------------------------------------------------------------------------- + + 2 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 2 OF 2 TESTS EXECUTED + + *FM514END* END OF TEST - FM514 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM517.f b/Fortran/UnitTests/fcvs21_f95/FM517.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM517.f @@ -0,0 +1,339 @@ + PROGRAM FM517 00010517 +C 00020517 +C THIS PROGRAM TESTS THE RETURN STATEMENT ANS REF. 00030517 +C RETURN E 15.8.1 00040517 +C IN SUBROUTINE SUBPROGRAMS. E IS AN ARITHMETIC 15.8.3 00050517 +C EXPRESSION WHOSE VALUE INDICATES WHERE CONTROL 00060517 +C WILL BE RETURNED TO. 00070517 +C 00080517 +C THIS ROUTINE USES SUBROUTINE SUBPROGRAMS SN518 00090517 +C AND SN519 00100517 +C 00110517 +CBB** ********************** BBCCOMNT **********************************00120517 +C**** 00130517 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140517 +C**** VERSION 2.1 00150517 +C**** 00160517 +C**** 00170517 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180517 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00190517 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00200517 +C**** BUILDING 225 RM A266 00210517 +C**** GAITHERSBURG, MD 20899 00220517 +C**** 00230517 +C**** 00240517 +C**** 00250517 +CBE** ********************** BBCCOMNT **********************************00260517 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00270517 + IMPLICIT CHARACTER*27 (C) 00280517 +CBB** ********************** BBCINITA **********************************00290517 +C**** SPECIFICATION STATEMENTS 00300517 +C**** 00310517 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320517 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330517 +CBE** ********************** BBCINITA **********************************00340517 +C 00350517 + 00360517 +C 00370517 +C 00380517 +CBB** ********************** BBCINITB **********************************00390517 +C**** INITIALIZE SECTION 00400517 + DATA ZVERS, ZVERSD, ZDATE 00410517 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00420517 + DATA ZCOMPL, ZNAME, ZTAPE 00430517 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00440517 + DATA ZPROJ, ZTAPED, ZPROG 00450517 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00460517 + DATA REMRKS /' '/ 00470517 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00480517 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00490517 +C**** 00500517 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00510517 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00520517 +CZ03 ZPROG = 'PROGRAM NAME' 00530517 +CZ04 ZDATE = 'DATE OF TEST' 00540517 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00550517 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00560517 +CZ07 ZNAME = 'NAME OF USER' 00570517 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00580517 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00590517 +C 00600517 + IVPASS = 0 00610517 + IVFAIL = 0 00620517 + IVDELE = 0 00630517 + IVINSP = 0 00640517 + IVTOTL = 0 00650517 + IVTOTN = 0 00660517 + ICZERO = 0 00670517 +C 00680517 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00690517 + I01 = 05 00700517 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00710517 + I02 = 06 00720517 +C 00730517 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00740517 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750517 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00760517 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00770517 +C 00780517 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00790517 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00800517 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00810517 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00820517 +C 00830517 +CBE** ********************** BBCINITB **********************************00840517 + ZPROG = 'FM517' 00850517 + IVTOTL = 5 00860517 +CBB** ********************** BBCHED0A **********************************00870517 +C**** 00880517 +C**** WRITE REPORT TITLE 00890517 +C**** 00900517 + WRITE (I02, 90002) 00910517 + WRITE (I02, 90006) 00920517 + WRITE (I02, 90007) 00930517 + WRITE (I02, 90008) ZVERS, ZVERSD 00940517 + WRITE (I02, 90009) ZPROG, ZPROG 00950517 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960517 +CBE** ********************** BBCHED0A **********************************00970517 +CBB** ********************** BBCHED0B **********************************00980517 +C**** WRITE DETAIL REPORT HEADERS 00990517 +C**** 01000517 + WRITE (I02,90004) 01010517 + WRITE (I02,90004) 01020517 + WRITE (I02,90013) 01030517 + WRITE (I02,90014) 01040517 + WRITE (I02,90015) IVTOTL 01050517 +CBE** ********************** BBCHED0B **********************************01060517 +C TESTS 1 AND 2 TEST RETURN CONTROL PROCESSING IN THE EXECUTION 01070517 +C OF A SUBROUTINE SUBPROGRAM WHICH PROVIDES ALTERNATE RETURN 01080517 +C 01090517 +CT001* TEST 001 **** FCVS PROGRAM 517 **** 01100517 +C 01110517 + IVTNUM = 1 01120517 + IVCOMP = 0 01130517 + IVCORR = 3 01140517 + IVN001 = 2 01150517 + CALL SN518(IVN001,*0012,*0013) 01160517 + IVCOMP = 1 01170517 + GO TO 0014 01180517 +0012 CONTINUE 01190517 + IVCOMP = 2 01200517 + GO TO 0014 01210517 +0013 CONTINUE 01220517 + IVCOMP = 3 01230517 +0014 CONTINUE 01240517 +40010 IF (IVCOMP - 3) 20010, 10010, 20010 01250517 +10010 IVPASS = IVPASS + 1 01260517 + WRITE (I02,80002) IVTNUM 01270517 + GO TO 0011 01280517 +20010 IVFAIL = IVFAIL + 1 01290517 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01300517 + 0011 CONTINUE 01310517 +C 01320517 +CT002* TEST 002 **** FCVS PROGRAM 517 **** 01330517 +C 01340517 + IVTNUM = 2 01350517 + IVCOMP = 0 01360517 + IVCORR = 5 01370517 + CALL SN519(7,*0022,*0023) 01380517 + IVCOMP = 1 01390517 + GO TO 0024 01400517 +0022 CONTINUE 01410517 + IVCOMP = 3 01420517 + GO TO 0024 01430517 +0023 CONTINUE 01440517 + IVCOMP = 5 01450517 +0024 CONTINUE 01460517 +40020 IF (IVCOMP - 5) 20020, 10020, 20020 01470517 +10020 IVPASS = IVPASS + 1 01480517 + WRITE (I02,80002) IVTNUM 01490517 + GO TO 0021 01500517 +20020 IVFAIL = IVFAIL + 1 01510517 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01520517 + 0021 CONTINUE 01530517 +C 01540517 +CT003* TEST 003 **** FCVS PROGRAM 517 **** 01550517 +C TEST 003 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE 01560517 +C LESS THAN ONE 01570517 +C 01580517 + IVTNUM = 3 01590517 + IVCOMP = 0 01600517 + IVCORR = -2 01610517 + CALL SN518(-3,*0032,*0033) 01620517 + IVCOMP = -2 01630517 + GO TO 0034 01640517 +0032 CONTINUE 01650517 + IVCOMP = -4 01660517 + GO TO 0034 01670517 +0033 CONTINUE 01680517 + IVCOMP = -6 01690517 +0034 CONTINUE 01700517 +40030 IF (IVCOMP + 2) 20030, 10030, 20030 01710517 +10030 IVPASS = IVPASS + 1 01720517 + WRITE (I02,80002) IVTNUM 01730517 + GO TO 0031 01740517 +20030 IVFAIL = IVFAIL + 1 01750517 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01760517 + 0031 CONTINUE 01770517 +C 01780517 +CT004* TEST 004 **** FCVS PROGRAM 517 **** 01790517 +C TEST 004 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE 01800517 +C GREATER THAN THE NUMBER OF ASTERISKS IN A SUBROUTINE STATEMENT 01810517 +C 01820517 + IVTNUM = 4 01830517 + IVCOMP = 0 01840517 + IVCORR = 7 01850517 + CALL SN518(3,*0042,*0043) 01860517 + IVCOMP = 7 01870517 + GO TO 0044 01880517 +0042 CONTINUE 01890517 + IVCOMP = 9 01900517 + GO TO 0044 01910517 +0043 CONTINUE 01920517 + IVCOMP = 11 01930517 +0044 CONTINUE 01940517 +40040 IF (IVCOMP - 7) 20040, 10040, 20040 01950517 +10040 IVPASS = IVPASS + 1 01960517 + WRITE (I02,80002) IVTNUM 01970517 + GO TO 0041 01980517 +20040 IVFAIL = IVFAIL + 1 01990517 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02000517 + 0041 CONTINUE 02010517 +C 02020517 +CT005* TEST 005 **** FCVS PROGRAM 517 **** 02030517 +C TEST 005 TESTS THE "RETURN E" STATEMENT WHERE E HAS VALUE 02040517 +C GREATER THAN THE NUMBER OF ASTERISKS IN AN ENTRY STATEMENT 02050517 +C 02060517 + IVTNUM = 5 02070517 + IVCOMP = 0 02080517 + IVCORR = -10 02090517 + CALL EN872(9,*0052,*0053) 02100517 + IVCOMP = -10 02110517 + GO TO 0054 02120517 +0052 CONTINUE 02130517 + IVCOMP = 3 02140517 + GO TO 0054 02150517 +0053 CONTINUE 02160517 + IVCOMP = 11 02170517 +0054 CONTINUE 02180517 +40050 IF (IVCOMP + 10) 20050, 10050, 20050 02190517 +10050 IVPASS = IVPASS + 1 02200517 + WRITE (I02,80002) IVTNUM 02210517 + GO TO 0051 02220517 +20050 IVFAIL = IVFAIL + 1 02230517 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02240517 + 0051 CONTINUE 02250517 +C 02260517 +CBB** ********************** BBCSUM0 **********************************02270517 +C**** WRITE OUT TEST SUMMARY 02280517 +C**** 02290517 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02300517 + WRITE (I02, 90004) 02310517 + WRITE (I02, 90014) 02320517 + WRITE (I02, 90004) 02330517 + WRITE (I02, 90020) IVPASS 02340517 + WRITE (I02, 90022) IVFAIL 02350517 + WRITE (I02, 90024) IVDELE 02360517 + WRITE (I02, 90026) IVINSP 02370517 + WRITE (I02, 90028) IVTOTN, IVTOTL 02380517 +CBE** ********************** BBCSUM0 **********************************02390517 +CBB** ********************** BBCFOOT0 **********************************02400517 +C**** WRITE OUT REPORT FOOTINGS 02410517 +C**** 02420517 + WRITE (I02,90016) ZPROG, ZPROG 02430517 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02440517 + WRITE (I02,90019) 02450517 +CBE** ********************** BBCFOOT0 **********************************02460517 +90001 FORMAT (" ",56X,"FM517") 02470517 +90000 FORMAT (" ",50X,"END OF PROGRAM FM517" ) 02480517 +CBB** ********************** BBCFMT0A **********************************02490517 +C**** FORMATS FOR TEST DETAIL LINES 02500517 +C**** 02510517 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02520517 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02530517 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02540517 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02550517 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02560517 + 1I6,/," ",15X,"CORRECT= " ,I6) 02570517 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02580517 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02590517 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02600517 + 1A21,/," ",16X,"CORRECT= " ,A21) 02610517 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02620517 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02630517 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02640517 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02650517 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02660517 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02670517 +80050 FORMAT (" ",48X,A31) 02680517 +CBE** ********************** BBCFMT0A **********************************02690517 +CBB** ********************** BBCFMAT1 **********************************02700517 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02710517 +C**** 02720517 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02730517 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02740517 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02750517 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02760517 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02770517 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02780517 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02790517 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02800517 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02810517 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02820517 + 2"(",F12.5,", ",F12.5,")") 02830517 +CBE** ********************** BBCFMAT1 **********************************02840517 +CBB** ********************** BBCFMT0B **********************************02850517 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02860517 +C**** 02870517 +90002 FORMAT ("1") 02880517 +90004 FORMAT (" ") 02890517 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02900517 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02910517 +90008 FORMAT (" ",21X,A13,A17) 02920517 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02930517 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02940517 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02950517 + 1 7X,"REMARKS",24X) 02960517 +90014 FORMAT (" ","----------------------------------------------" , 02970517 + 1 "---------------------------------" ) 02980517 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02990517 +C**** 03000517 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03010517 +C**** 03020517 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03030517 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03040517 + 1 A13) 03050517 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03060517 +C**** 03070517 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03080517 +C**** 03090517 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03100517 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03110517 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03120517 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03130517 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03140517 +CBE** ********************** BBCFMT0B **********************************03150517 + STOP 03160517 + END 03170517 + +C 00010518 +C THIS ROUTINE IS TO BE RUN WITH ROUTINE 517 00020518 +C 00030518 +C THIS SUBROUTINE TESTS THE USE OF THE "RETURN E" STATEMENT 00040518 +C WHERE E IS AN INTEGER VARIABLE 00050518 +C 00060518 + SUBROUTINE SN518(IVD001,*,*) 00070518 + RETURN IVD001 00080518 + END 00090518 + +C 00010519 +C THIS ROUTINE IS TO BE RUN WITH ROUTINE 517 00020519 +C 00030519 +C THIS SUBROUTINE TESTS THE USE OF THE "RETURN E" STATEMENT 00040519 +C WHERE E IS AN INTEGER EXPRESSION 00050519 +C 00060519 + SUBROUTINE SN519(IVD001,*,*) 00070519 + RETURN (IVD001 - 2*(IVD001/2) + 1) 00080519 + ENTRY EN872(IVD002,*,*) 00090519 + RETURN (IVD002 - 3) 00100519 + END 00110519 diff --git a/Fortran/UnitTests/fcvs21_f95/FM517.reference_output b/Fortran/UnitTests/fcvs21_f95/FM517.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM517.reference_output @@ -0,0 +1,33 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM517BEGIN* TEST RESULTS - FM517 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 5 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + + ------------------------------------------------------------------------------- + + 5 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 5 OF 5 TESTS EXECUTED + + *FM517END* END OF TEST - FM517 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM520.f b/Fortran/UnitTests/fcvs21_f95/FM520.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM520.f @@ -0,0 +1,638 @@ + PROGRAM FM520 00010520 +C 00020520 +C TESTING PARAMETER STATEMENT 00030520 +C 00040520 +C 00050520 +CBB** ********************** BBCCOMNT **********************************00060520 +C**** 00070520 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00080520 +C**** VERSION 2.1 00090520 +C**** 00100520 +C**** 00110520 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00120520 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00130520 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00140520 +C**** BUILDING 225 RM A266 00150520 +C**** GAITHERSBURG, MD 20899 00160520 +C**** 00170520 +C**** 00180520 +C**** 00190520 +CBE** ********************** BBCCOMNT **********************************00200520 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00210520 + IMPLICIT CHARACTER*27 (C) 00220520 +CBB** ********************** BBCINITA **********************************00230520 +C**** SPECIFICATION STATEMENTS 00240520 +C**** 00250520 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00260520 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00270520 +CBE** ********************** BBCINITA **********************************00280520 +C 00290520 + PARAMETER(IPN001=5+5,IPN002=8-3,IPN003=1*5) 00300520 + PARAMETER(RPN001=5.1+4.9,RPN002=8.7-3.7,RPN003=2.0*2.5) 00310520 +C 00320520 +C TEST 1 - 7 TEST INTEGER ARITHMETIC EXPRESSION USING 00330520 +C ONLY SYMBOLIC NAMES OF ARITHMETIC CONSTANTS 00340520 +C S06AF-2P 4.A 00350520 +C 00360520 +C 00370520 +C 00380520 +CBB** ********************** BBCINITB **********************************00390520 +C**** INITIALIZE SECTION 00400520 + DATA ZVERS, ZVERSD, ZDATE 00410520 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00420520 + DATA ZCOMPL, ZNAME, ZTAPE 00430520 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00440520 + DATA ZPROJ, ZTAPED, ZPROG 00450520 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00460520 + DATA REMRKS /' '/ 00470520 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00480520 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00490520 +C**** 00500520 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00510520 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00520520 +CZ03 ZPROG = 'PROGRAM NAME' 00530520 +CZ04 ZDATE = 'DATE OF TEST' 00540520 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00550520 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00560520 +CZ07 ZNAME = 'NAME OF USER' 00570520 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00580520 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00590520 +C 00600520 + IVPASS = 0 00610520 + IVFAIL = 0 00620520 + IVDELE = 0 00630520 + IVINSP = 0 00640520 + IVTOTL = 0 00650520 + IVTOTN = 0 00660520 + ICZERO = 0 00670520 +C 00680520 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00690520 + I01 = 05 00700520 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00710520 + I02 = 06 00720520 +C 00730520 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00740520 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750520 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00760520 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00770520 +C 00780520 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00790520 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00800520 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00810520 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00820520 +C 00830520 +CBE** ********************** BBCINITB **********************************00840520 + ZPROG='FM520' 00850520 + IVTOTL = 30 00860520 +CBB** ********************** BBCHED0A **********************************00870520 +C**** 00880520 +C**** WRITE REPORT TITLE 00890520 +C**** 00900520 + WRITE (I02, 90002) 00910520 + WRITE (I02, 90006) 00920520 + WRITE (I02, 90007) 00930520 + WRITE (I02, 90008) ZVERS, ZVERSD 00940520 + WRITE (I02, 90009) ZPROG, ZPROG 00950520 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960520 +CBE** ********************** BBCHED0A **********************************00970520 +CBB** ********************** BBCHED0B **********************************00980520 +C**** WRITE DETAIL REPORT HEADERS 00990520 +C**** 01000520 + WRITE (I02,90004) 01010520 + WRITE (I02,90004) 01020520 + WRITE (I02,90013) 01030520 + WRITE (I02,90014) 01040520 + WRITE (I02,90015) IVTOTL 01050520 +CBE** ********************** BBCHED0B **********************************01060520 +C 01070520 +CT001* TEST 001 **** FCVS PROGRAM 520 **** 01080520 +C 01090520 +C 01100520 + IVTNUM = 1 01110520 + IVCOMP=+IPN001 01120520 + IVCORR=+10 01130520 +40010 IF (IVCOMP - 10) 20010, 10010, 20010 01140520 +10010 IVPASS = IVPASS + 1 01150520 + WRITE (I02,80002) IVTNUM 01160520 + GO TO 0021 01170520 +20010 IVFAIL = IVFAIL + 1 01180520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01190520 + 0021 CONTINUE 01200520 +C 01210520 +CT002* TEST 002 **** FCVS PROGRAM 520 **** 01220520 +C 01230520 +C 01240520 + IVTNUM = 2 01250520 + IVCOMP=-IPN001 01260520 + IVCORR=-10 01270520 +40020 IF (IVCOMP + 10) 20020, 10020, 20020 01280520 +10020 IVPASS = IVPASS + 1 01290520 + WRITE (I02,80002) IVTNUM 01300520 + GO TO 0031 01310520 +20020 IVFAIL = IVFAIL + 1 01320520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01330520 + 0031 CONTINUE 01340520 +C 01350520 +CT003* TEST 003 **** FCVS PROGRAM 520 **** 01360520 +C 01370520 +C 01380520 + IVTNUM = 3 01390520 + IVCOMP=IPN001+IPN002 01400520 + IVCORR=15 01410520 +40030 IF (IVCOMP - 15) 20030, 10030, 20030 01420520 +10030 IVPASS = IVPASS + 1 01430520 + WRITE (I02,80002) IVTNUM 01440520 + GO TO 0041 01450520 +20030 IVFAIL = IVFAIL + 1 01460520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01470520 + 0041 CONTINUE 01480520 +C 01490520 +CT004* TEST 004 **** FCVS PROGRAM 520 **** 01500520 +C 01510520 +C 01520520 + IVTNUM = 4 01530520 + IVCOMP=IPN001-IPN002 01540520 + IVCORR=5 01550520 +40040 IF (IVCOMP - 5) 20040, 10040, 20040 01560520 +10040 IVPASS = IVPASS + 1 01570520 + WRITE (I02,80002) IVTNUM 01580520 + GO TO 0051 01590520 +20040 IVFAIL = IVFAIL + 1 01600520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01610520 + 0051 CONTINUE 01620520 +C 01630520 +CT005* TEST 005 **** FCVS PROGRAM 520 **** 01640520 +C 01650520 +C 01660520 + IVTNUM = 5 01670520 + IVCOMP=IPN001*IPN002 01680520 + IVCORR=50 01690520 +40050 IF (IVCOMP - 50) 20050, 10050, 20050 01700520 +10050 IVPASS = IVPASS + 1 01710520 + WRITE (I02,80002) IVTNUM 01720520 + GO TO 0061 01730520 +20050 IVFAIL = IVFAIL + 1 01740520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01750520 + 0061 CONTINUE 01760520 +C 01770520 +CT006* TEST 006 **** FCVS PROGRAM 520 **** 01780520 +C 01790520 +C 01800520 + IVTNUM = 6 01810520 + IVCOMP=IPN001/IPN002 01820520 + IVCORR=2 01830520 +40060 IF (IVCOMP - 2) 20060, 10060, 20060 01840520 +10060 IVPASS = IVPASS + 1 01850520 + WRITE (I02,80002) IVTNUM 01860520 + GO TO 0071 01870520 +20060 IVFAIL = IVFAIL + 1 01880520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01890520 + 0071 CONTINUE 01900520 +C 01910520 +CT007* TEST 007 **** FCVS PROGRAM 520 **** 01920520 +C 01930520 +C 01940520 + IVTNUM = 7 01950520 + IVCOMP=IPN001**IPN002 01960520 + IVCORR=100000 01970520 +40070 IF (IVCOMP - 100000) 20070, 10070, 20070 01980520 +10070 IVPASS = IVPASS + 1 01990520 + WRITE (I02,80002) IVTNUM 02000520 + GO TO 0081 02010520 +20070 IVFAIL = IVFAIL + 1 02020520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02030520 + 0081 CONTINUE 02040520 +C 02050520 +C 02060520 +C TEST 8 - 14 TEST REAL ARITHMETIC EXPRESSION USING 02070520 +C ONLY SYMBOLIC NAMES OF ARITHMETIC CONSTANTS 02080520 +C S06AF-2P 4.A 02090520 +C 02100520 +CT008* TEST 008 **** FCVS PROGRAM 520 **** 02110520 +C 02120520 +C 02130520 + IVTNUM = 8 02140520 + RVCOMP=+RPN001 02150520 + RVCORR=+10.0 02160520 + IF (RVCOMP - 0.99995E+01) 20080, 10080, 40080 02170520 +40080 IF (RVCOMP - 0.10001E+02) 10080, 10080, 20080 02180520 +10080 IVPASS = IVPASS + 1 02190520 + WRITE (I02,80002) IVTNUM 02200520 + GO TO 0091 02210520 +20080 IVFAIL = IVFAIL + 1 02220520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02230520 + 0091 CONTINUE 02240520 +C 02250520 +CT009* TEST 009 **** FCVS PROGRAM 520 **** 02260520 +C 02270520 +C 02280520 + IVTNUM = 9 02290520 + RVCOMP=-RPN001 02300520 + RVCORR=-10.0 02310520 + IF (RVCOMP + 0.10001E+02) 20090, 10090, 40090 02320520 +40090 IF (RVCOMP + 0.99995E+01) 10090, 10090, 20090 02330520 +10090 IVPASS = IVPASS + 1 02340520 + WRITE (I02,80002) IVTNUM 02350520 + GO TO 0101 02360520 +20090 IVFAIL = IVFAIL + 1 02370520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02380520 + 0101 CONTINUE 02390520 +C 02400520 +CT010* TEST 010 **** FCVS PROGRAM 520 **** 02410520 +C 02420520 + IVTNUM = 10 02430520 + RVCOMP=RPN001+RPN002 02440520 + RVCORR=15.0 02450520 + IF (RVCOMP - 0.14999E+02) 20100, 10100, 40100 02460520 +40100 IF (RVCOMP - 0.15001E+02) 10100, 10100, 20100 02470520 +10100 IVPASS = IVPASS + 1 02480520 + WRITE (I02,80002) IVTNUM 02490520 + GO TO 0111 02500520 +20100 IVFAIL = IVFAIL + 1 02510520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02520520 + 0111 CONTINUE 02530520 +C 02540520 +CT011* TEST 011 **** FCVS PROGRAM 520 **** 02550520 +C 02560520 +C 02570520 + IVTNUM = 11 02580520 + RVCOMP=RPN001-RPN002 02590520 + RVCORR=5.0 02600520 + IF (RVCOMP - 0.49997E+01) 20110, 10110, 40110 02610520 +40110 IF (RVCOMP - 0.50003E+01) 10110, 10110, 20110 02620520 +10110 IVPASS = IVPASS + 1 02630520 + WRITE (I02,80002) IVTNUM 02640520 + GO TO 0121 02650520 +20110 IVFAIL = IVFAIL + 1 02660520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02670520 + 0121 CONTINUE 02680520 +C 02690520 +CT012* TEST 012 **** FCVS PROGRAM 520 **** 02700520 +C 02710520 +C 02720520 + IVTNUM = 12 02730520 + RVCOMP=RPN001*RPN002 02740520 + RVCORR=50.0 02750520 + IF (RVCOMP - 0.49997E+02) 20120, 10120, 40120 02760520 +40120 IF (RVCOMP - 0.50003E+02) 10120, 10120, 20120 02770520 +10120 IVPASS = IVPASS + 1 02780520 + WRITE (I02,80002) IVTNUM 02790520 + GO TO 0131 02800520 +20120 IVFAIL = IVFAIL + 1 02810520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02820520 + 0131 CONTINUE 02830520 +C 02840520 +CT013* TEST 013 **** FCVS PROGRAM 520 **** 02850520 +C 02860520 + IVTNUM = 13 02870520 + RVCOMP=RPN001/RPN002 02880520 + RVCORR=2.0 02890520 + IF (RVCOMP - 0.19999E+01) 20130, 10130, 40130 02900520 +40130 IF (RVCOMP - 0.20001E+01) 10130, 10130, 20130 02910520 +10130 IVPASS = IVPASS + 1 02920520 + WRITE (I02,80002) IVTNUM 02930520 + GO TO 0141 02940520 +20130 IVFAIL = IVFAIL + 1 02950520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 02960520 + 0141 CONTINUE 02970520 +C 02980520 +CT014* TEST 014 **** FCVS PROGRAM 520 **** 02990520 +C 03000520 + IVTNUM = 14 03010520 + RVCOMP=RPN001**RPN002 03020520 + RVCORR=100000.0 03030520 + IF (RVCOMP - 0.99995E+05) 20140, 10140, 40140 03040520 +40140 IF (RVCOMP - 0.10001E+06) 10140, 10140, 20140 03050520 +10140 IVPASS = IVPASS + 1 03060520 + WRITE (I02,80002) IVTNUM 03070520 + GO TO 0151 03080520 +20140 IVFAIL = IVFAIL + 1 03090520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03100520 + 0151 CONTINUE 03110520 +C 03120520 +C 03130520 +C TEST 15 - 18 REPEATS TEST 1 - 7 USING MORE THAN ONE OPERATOR 03140520 +C S06AF-2P 4.C 03150520 +C 03160520 +CT015* TEST 015 **** FCVS PROGRAM 520 **** 03170520 +C 03180520 +C 03190520 + IVTNUM = 15 03200520 + IVCOMP=IPN001+IPN001-IPN002 03210520 + IVCORR=15 03220520 +40150 IF (IVCOMP - 15) 20150, 10150, 20150 03230520 +10150 IVPASS = IVPASS + 1 03240520 + WRITE (I02,80002) IVTNUM 03250520 + GO TO 0161 03260520 +20150 IVFAIL = IVFAIL + 1 03270520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03280520 + 0161 CONTINUE 03290520 +C 03300520 +CT016* TEST 016 **** FCVS PROGRAM 520 **** 03310520 +C 03320520 + IVTNUM = 16 03330520 + IVCOMP=IPN001+IPN001-IPN002*IPN002 03340520 + IVCORR=-5 03350520 +40160 IF (IVCOMP + 5) 20160, 10160, 20160 03360520 +10160 IVPASS = IVPASS + 1 03370520 + WRITE (I02,80002) IVTNUM 03380520 + GO TO 0171 03390520 +20160 IVFAIL = IVFAIL + 1 03400520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03410520 + 0171 CONTINUE 03420520 +C 03430520 +CT017* TEST 017 **** FCVS PROGRAM 520 **** 03440520 +C 03450520 +C 03460520 + IVTNUM = 17 03470520 + IVCOMP=IPN001+IPN001-IPN002*IPN002/IPN003 03480520 + IVCORR=15 03490520 +40170 IF (IVCOMP - 15) 20170, 10170, 20170 03500520 +10170 IVPASS = IVPASS + 1 03510520 + WRITE (I02,80002) IVTNUM 03520520 + GO TO 0181 03530520 +20170 IVFAIL = IVFAIL + 1 03540520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03550520 + 0181 CONTINUE 03560520 +C 03570520 +CT018* TEST 018 **** FCVS PROGRAM 520 **** 03580520 +C 03590520 + IVTNUM = 18 03600520 + IVCOMP=IPN001+IPN001**IPN002-IPN002*IPN002/IPN003 03610520 + IVCORR=100005 03620520 +40180 IF (IVCOMP - 100005) 20180, 10180, 20180 03630520 +10180 IVPASS = IVPASS + 1 03640520 + WRITE (I02,80002) IVTNUM 03650520 + GO TO 0191 03660520 +20180 IVFAIL = IVFAIL + 1 03670520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03680520 + 0191 CONTINUE 03690520 +C 03700520 +C 03710520 +C TEST 19 - 22 REPEATS TEST 8 - 14 USING MORE THAN ONE OPERATOR 03720520 +C S06AF-2P 4.C 03730520 +C 03740520 +CT019* TEST 019 **** FCVS PROGRAM 520 **** 03750520 +C 03760520 + IVTNUM = 19 03770520 + RVCOMP=RPN001+RPN001-RPN002 03780520 + RVCORR=15.0 03790520 + IF (RVCOMP - 0.14999E+02) 20190, 10190, 40190 03800520 +40190 IF (RVCOMP - 0.15001E+02) 10190, 10190, 20190 03810520 +10190 IVPASS = IVPASS + 1 03820520 + WRITE (I02,80002) IVTNUM 03830520 + GO TO 0201 03840520 +20190 IVFAIL = IVFAIL + 1 03850520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 03860520 + 0201 CONTINUE 03870520 +C 03880520 +CT020* TEST 020 **** FCVS PROGRAM 520 **** 03890520 +C 03900520 + IVTNUM = 20 03910520 + RVCOMP=RPN001+RPN001-RPN002*RPN002 03920520 + RVCORR=-5.0 03930520 + IF (RVCOMP + 0.50003E+01) 20200, 10200, 40200 03940520 +40200 IF (RVCOMP + 0.49997E+01) 10200, 10200, 20200 03950520 +10200 IVPASS = IVPASS + 1 03960520 + WRITE (I02,80002) IVTNUM 03970520 + GO TO 0211 03980520 +20200 IVFAIL = IVFAIL + 1 03990520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04000520 + 0211 CONTINUE 04010520 +C 04020520 +CT021* TEST 021 **** FCVS PROGRAM 520 **** 04030520 +C 04040520 + IVTNUM = 21 04050520 + RVCOMP=RPN001+RPN001-RPN002*RPN002/RPN003 04060520 + RVCORR=15.0 04070520 + IF (RVCOMP - 0.14999E+02) 20210, 10210, 40210 04080520 +40210 IF (RVCOMP - 0.15001E+02) 10210, 10210, 20210 04090520 +10210 IVPASS = IVPASS + 1 04100520 + WRITE (I02,80002) IVTNUM 04110520 + GO TO 0221 04120520 +20210 IVFAIL = IVFAIL + 1 04130520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04140520 + 0221 CONTINUE 04150520 +C 04160520 +CT022* TEST 022 **** FCVS PROGRAM 520 **** 04170520 +C 04180520 + IVTNUM = 22 04190520 + RVCOMP=RPN001+RPN001**RPN002-RPN002*RPN002/RPN003 04200520 + RVCORR=100005.0 04210520 + IF (RVCOMP - 0.10000E+06) 20220, 10220, 40220 04220520 +40220 IF (RVCOMP - 0.10001E+06) 10220, 10220, 20220 04230520 +10220 IVPASS = IVPASS + 1 04240520 + WRITE (I02,80002) IVTNUM 04250520 + GO TO 0231 04260520 +20220 IVFAIL = IVFAIL + 1 04270520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 04280520 + 0231 CONTINUE 04290520 +C 04300520 +C 04310520 +C TEST 23 - 26 REPEATS TEST 15 - 18 USING PARENTHESES 04320520 +C S06AF-2P 4.D 04330520 +C 04340520 +C 04350520 +C 04360520 +CT023* TEST 023 **** FCVS PROGRAM 520 **** 04370520 +C 04380520 + IVTNUM = 23 04390520 + IVCOMP=IPN001+(IPN001-IPN002) 04400520 + IVCORR=15 04410520 +40230 IF (IVCOMP - 15) 20230, 10230, 20230 04420520 +10230 IVPASS = IVPASS + 1 04430520 + WRITE (I02,80002) IVTNUM 04440520 + GO TO 0241 04450520 +20230 IVFAIL = IVFAIL + 1 04460520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04470520 + 0241 CONTINUE 04480520 +C 04490520 +CT024* TEST 024 **** FCVS PROGRAM 520 **** 04500520 +C 04510520 + IVTNUM = 24 04520520 + IVCOMP=((IPN001+IPN001)-IPN002)*IPN002 04530520 + IVCORR=75 04540520 +40240 IF (IVCOMP - 75) 20240, 10240, 20240 04550520 +10240 IVPASS = IVPASS + 1 04560520 + WRITE (I02,80002) IVTNUM 04570520 + GO TO 0251 04580520 +20240 IVFAIL = IVFAIL + 1 04590520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04600520 + 0251 CONTINUE 04610520 +C 04620520 +CT025* TEST 025 **** FCVS PROGRAM 520 **** 04630520 +C 04640520 + IVTNUM = 25 04650520 + IVCOMP=(IPN001+IPN001)-IPN002*(IPN002/IPN003) 04660520 + IVCORR=15 04670520 +40250 IF (IVCOMP - 15) 20250, 10250, 20250 04680520 +10250 IVPASS = IVPASS + 1 04690520 + WRITE (I02,80002) IVTNUM 04700520 + GO TO 0261 04710520 +20250 IVFAIL = IVFAIL + 1 04720520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04730520 + 0261 CONTINUE 04740520 +C 04750520 +CT026* TEST 026 **** FCVS PROGRAM 520 **** 04760520 +C 04770520 + IVTNUM = 26 04780520 + IVCOMP=(IPN001+IPN001)**2-((IPN002*IPN002)/IPN003) 04790520 + IVCORR=395 04800520 +40260 IF (IVCOMP - 395) 20260, 10260, 20260 04810520 +10260 IVPASS = IVPASS + 1 04820520 + WRITE (I02,80002) IVTNUM 04830520 + GO TO 0271 04840520 +20260 IVFAIL = IVFAIL + 1 04850520 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04860520 + 0271 CONTINUE 04870520 +C 04880520 +C TEST 27 - 30 REPEATS TEST 19 - 22 USING PARENTHESES 04890520 +C S06AF-2P 4.D 04900520 +C 04910520 +CT027* TEST 027 **** FCVS PROGRAM 520 **** 04920520 +C 04930520 + IVTNUM = 27 04940520 + RVCOMP=RPN001+(RPN001-RPN002) 04950520 + RVCORR=15.0 04960520 + IF (RVCOMP - 0.14999E+02) 20270, 10270, 40270 04970520 +40270 IF (RVCOMP - 0.15001E+02) 10270, 10270, 20270 04980520 +10270 IVPASS = IVPASS + 1 04990520 + WRITE (I02,80002) IVTNUM 05000520 + GO TO 0281 05010520 +20270 IVFAIL = IVFAIL + 1 05020520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05030520 + 0281 CONTINUE 05040520 +C 05050520 +CT028* TEST 028 **** FCVS PROGRAM 520 **** 05060520 +C 05070520 + IVTNUM = 28 05080520 + RVCOMP=((RPN001+RPN001)-RPN002)*RPN002 05090520 + RVCORR=75.0 05100520 + IF (RVCOMP - 0.74996E+02) 20280, 10280, 40280 05110520 +40280 IF (RVCOMP - 0.75004E+02) 10280, 10280, 20280 05120520 +10280 IVPASS = IVPASS + 1 05130520 + WRITE (I02,80002) IVTNUM 05140520 + GO TO 0291 05150520 +20280 IVFAIL = IVFAIL + 1 05160520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05170520 + 0291 CONTINUE 05180520 +C 05190520 +CT029* TEST 029 **** FCVS PROGRAM 520 **** 05200520 +C 05210520 + IVTNUM = 29 05220520 + RVCOMP=(RPN001+RPN001)-RPN002*(RPN002/RPN003) 05230520 + RVCORR=15.0 05240520 + IF (RVCOMP - 0.14999E+02) 20290, 10290, 40290 05250520 +40290 IF (RVCOMP - 0.15001E+02) 10290, 10290, 20290 05260520 +10290 IVPASS = IVPASS + 1 05270520 + WRITE (I02,80002) IVTNUM 05280520 + GO TO 0301 05290520 +20290 IVFAIL = IVFAIL + 1 05300520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05310520 + 0301 CONTINUE 05320520 +C 05330520 +CT030* TEST 030 **** FCVS PROGRAM 520 **** 05340520 +C 05350520 +C 05360520 + IVTNUM = 30 05370520 + RVCOMP=(RPN001+RPN001)**3.0-((RPN002*RPN002)/RPN003) 05380520 + RVCORR=7995.0 05390520 + IF (RVCOMP - 0.79946E+04) 20300, 10300, 40300 05400520 +40300 IF (RVCOMP - 0.79954E+04) 10300, 10300, 20300 05410520 +10300 IVPASS = IVPASS + 1 05420520 + WRITE (I02,80002) IVTNUM 05430520 + GO TO 0311 05440520 +20300 IVFAIL = IVFAIL + 1 05450520 + WRITE (I02,80012) IVTNUM, RVCOMP, RVCORR 05460520 + 0311 CONTINUE 05470520 +C 05480520 +CBB** ********************** BBCSUM0 **********************************05490520 +C**** WRITE OUT TEST SUMMARY 05500520 +C**** 05510520 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 05520520 + WRITE (I02, 90004) 05530520 + WRITE (I02, 90014) 05540520 + WRITE (I02, 90004) 05550520 + WRITE (I02, 90020) IVPASS 05560520 + WRITE (I02, 90022) IVFAIL 05570520 + WRITE (I02, 90024) IVDELE 05580520 + WRITE (I02, 90026) IVINSP 05590520 + WRITE (I02, 90028) IVTOTN, IVTOTL 05600520 +CBE** ********************** BBCSUM0 **********************************05610520 +CBB** ********************** BBCFOOT0 **********************************05620520 +C**** WRITE OUT REPORT FOOTINGS 05630520 +C**** 05640520 + WRITE (I02,90016) ZPROG, ZPROG 05650520 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 05660520 + WRITE (I02,90019) 05670520 +CBE** ********************** BBCFOOT0 **********************************05680520 +90001 FORMAT (" ",56X,"FM520") 05690520 +90000 FORMAT (" ",50X,"END OF PROGRAM FM520" ) 05700520 +CBB** ********************** BBCFMT0A **********************************05710520 +C**** FORMATS FOR TEST DETAIL LINES 05720520 +C**** 05730520 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 05740520 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 05750520 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 05760520 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 05770520 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 05780520 + 1I6,/," ",15X,"CORRECT= " ,I6) 05790520 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05800520 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 05810520 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05820520 + 1A21,/," ",16X,"CORRECT= " ,A21) 05830520 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 05840520 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 05850520 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 05860520 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 05870520 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 05880520 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 05890520 +80050 FORMAT (" ",48X,A31) 05900520 +CBE** ********************** BBCFMT0A **********************************05910520 +CBB** ********************** BBCFMAT1 **********************************05920520 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 05930520 +C**** 05940520 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05950520 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 05960520 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 05970520 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 05980520 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05990520 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06000520 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06010520 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06020520 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06030520 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 06040520 + 2"(",F12.5,", ",F12.5,")") 06050520 +CBE** ********************** BBCFMAT1 **********************************06060520 +CBB** ********************** BBCFMT0B **********************************06070520 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 06080520 +C**** 06090520 +90002 FORMAT ("1") 06100520 +90004 FORMAT (" ") 06110520 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )06120520 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06130520 +90008 FORMAT (" ",21X,A13,A17) 06140520 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 06150520 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 06160520 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 06170520 + 1 7X,"REMARKS",24X) 06180520 +90014 FORMAT (" ","----------------------------------------------" , 06190520 + 1 "---------------------------------" ) 06200520 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 06210520 +C**** 06220520 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 06230520 +C**** 06240520 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 06250520 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 06260520 + 1 A13) 06270520 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 06280520 +C**** 06290520 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 06300520 +C**** 06310520 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 06320520 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 06330520 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 06340520 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 06350520 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 06360520 +CBE** ********************** BBCFMT0B **********************************06370520 + END 06380520 diff --git a/Fortran/UnitTests/fcvs21_f95/FM520.reference_output b/Fortran/UnitTests/fcvs21_f95/FM520.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM520.reference_output @@ -0,0 +1,58 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM520BEGIN* TEST RESULTS - FM520 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 30 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + + ------------------------------------------------------------------------------- + + 30 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 30 OF 30 TESTS EXECUTED + + *FM520END* END OF TEST - FM520 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM700.f b/Fortran/UnitTests/fcvs21_f95/FM700.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM700.f @@ -0,0 +1,608 @@ + PROGRAM FM700 00010700 +C 00020700 +C THIS PROGRAM TESTS THE DATA STATEMENT WITH ANS REF. 00030700 +C VARIABLE NAMES, ARRAY NAMES, ARRAY ELEMENT 9.1 00040700 +C NAMES, SUBSTRING NAMES, AND IMPLIED-DO LISTS. 9.2 00050700 +C 9.3 00060700 +C SYMBOLIC NAMES OF CONSTANTS ARE PERMITTED IN THE 00070700 +C CLIST OF THE DATA STATEMENT. IF NECESSARY, 00080700 +C THE CLIST CONSTANT IS CONVERTED TO THE TYPE 00090700 +C OF THE NLIST ENTITY ACCORDING TO THE RULES 00100700 +C FOR ARITHMETIC CONVERSION. 00110700 +C 00120700 +C 00130700 +CBB** ********************** BBCCOMNT **********************************00140700 +C**** 00150700 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00160700 +C**** VERSION 2.1 00170700 +C**** 00180700 +C**** 00190700 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00200700 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00210700 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00220700 +C**** BUILDING 225 RM A266 00230700 +C**** GAITHERSBURG, MD 20899 00240700 +C**** 00250700 +C**** 00260700 +C**** 00270700 +CBE** ********************** BBCCOMNT **********************************00280700 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00290700 + IMPLICIT CHARACTER*27 (C) 00300700 +CBB** ********************** BBCINITA **********************************00310700 +C**** SPECIFICATION STATEMENTS 00320700 +C**** 00330700 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00340700 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00350700 +CBE** ********************** BBCINITA **********************************00360700 +C 00370700 + INTEGER I2N001(2,3), I2N002(7), I2N003(3,7) 00380700 + INTEGER I2N004(3,10), I2N005(4,5), I2N006(6,8) 00390700 + CHARACTER CVCOMP*25, CVCORR*25, CPN001*5 00400700 + CHARACTER CVN001*25, CVN002*5, C1N001(3)*5 00410700 + CHARACTER C2N001(3,4)*4, CVN003*17 00420700 + REAL R2E001(2), R2N001(5,3) 00430700 + DOUBLE PRECISION DVCOMP, DVCORR, DVN001, D1N001(9), DPN001 00440700 + COMPLEX ZVCOMP, ZVCORR, ZVN001, Z1N001(10) 00450700 + PARAMETER (IPN001=-14, CPN001='SEVEN', IPN002=5, DPN001=0.1948D+3)00460700 + EQUIVALENCE (ZVCOMP, R2E001) 00470700 + DATA IVN001, C1N001, I2N001(2,1), CVN001(11:22) 00480700 + 1 /-137, 'FIRST', 'SECND', 'THIRD', 65, 'ELEVENTWELVE'/ 00490700 + DATA (I2N001(1,I), I=1,3) /-47, 198, -217/ 00500700 + DATA IVN002, CVN002 /IPN001, CPN001/ 00510700 + DATA I2N002, (I2N003(I,7), I=1,3), C2N001, CVN003(13:16) 00520700 + 1 /3*19, 7*-4, 13*'SAME'/ 00530700 + DATA IVN003, IVN004, RVN001, ZVN001, DVN001, DVN002 00540700 + 1 /-0.473E+3, 239.2D-1, 71, (71, -27), 6, 9.1534E-2/ 00550700 + DATA (I2N004(2,J), J=1,10) /9,8,7,6,5,4,3,2,1,0/ 00560700 + DATA ((R2N001(I,J), J=1,3), I=3,5) 00570700 + 1 /3.1, 3.2, 3.3, 4.1, 4.2, 4.3, 5.1, 5.2, 5.3/ 00580700 + DATA (Z1N001(I), I=3,7) /IPN002*(7.3, -2.28)/ 00590700 + DATA (D1N001(I), I=1,9,2) /IPN002*DPN001/ 00600700 + DATA (I2N005(I,I+1),I=1,4) / 91, -82, 73, -64/ 00610700 + DATA ((I2N006(2*I,I*J-1), I=2,3), J=1,3,2) /41, 62, 45, 68/ 00620700 +C 00630700 +C 00640700 +CBB** ********************** BBCINITB **********************************00650700 +C**** INITIALIZE SECTION 00660700 + DATA ZVERS, ZVERSD, ZDATE 00670700 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00680700 + DATA ZCOMPL, ZNAME, ZTAPE 00690700 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00700700 + DATA ZPROJ, ZTAPED, ZPROG 00710700 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00720700 + DATA REMRKS /' '/ 00730700 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00740700 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00750700 +C**** 00760700 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00770700 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00780700 +CZ03 ZPROG = 'PROGRAM NAME' 00790700 +CZ04 ZDATE = 'DATE OF TEST' 00800700 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00810700 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00820700 +CZ07 ZNAME = 'NAME OF USER' 00830700 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00840700 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00850700 +C 00860700 + IVPASS = 0 00870700 + IVFAIL = 0 00880700 + IVDELE = 0 00890700 + IVINSP = 0 00900700 + IVTOTL = 0 00910700 + IVTOTN = 0 00920700 + ICZERO = 0 00930700 +C 00940700 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00950700 + I01 = 05 00960700 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00970700 + I02 = 06 00980700 +C 00990700 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01000700 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01010700 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01020700 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01030700 +C 01040700 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01050700 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01060700 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01070700 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01080700 +C 01090700 +CBE** ********************** BBCINITB **********************************01100700 + ZPROG = 'FM700' 01110700 + IVTOTL = 23 01120700 +CBB** ********************** BBCHED0A **********************************01130700 +C**** 01140700 +C**** WRITE REPORT TITLE 01150700 +C**** 01160700 + WRITE (I02, 90002) 01170700 + WRITE (I02, 90006) 01180700 + WRITE (I02, 90007) 01190700 + WRITE (I02, 90008) ZVERS, ZVERSD 01200700 + WRITE (I02, 90009) ZPROG, ZPROG 01210700 + WRITE (I02, 90010) ZDATE, ZCOMPL 01220700 +CBE** ********************** BBCHED0A **********************************01230700 +CBB** ********************** BBCHED0B **********************************01240700 +C**** WRITE DETAIL REPORT HEADERS 01250700 +C**** 01260700 + WRITE (I02,90004) 01270700 + WRITE (I02,90004) 01280700 + WRITE (I02,90013) 01290700 + WRITE (I02,90014) 01300700 + WRITE (I02,90015) IVTOTL 01310700 +CBE** ********************** BBCHED0B **********************************01320700 +C 01330700 +C 01340700 +C TESTS 1 THRU 5 TEST DATA STATEMENT WITH VARIABLE NAMES, 01350700 +C ARRAY NAMES, ARRAY ELEMENT NAMES, SUBSTRING NAMES, AND IMPLIED- 01360700 +C DO LISTS. 01370700 +C 01380700 +CT001* TEST 001 **** FCVS PROGRAM 700 ***** 01390700 +C VARIABLE NAME 01400700 +C 01410700 + IVTNUM = 1 01420700 + IVCOMP = 0 01430700 + IVCORR = -137 01440700 + IVCOMP = IVN001 01450700 +40010 IF (IVCOMP + 137) 20010, 10010, 20010 01460700 +10010 IVPASS = IVPASS + 1 01470700 + WRITE (I02, 80002) IVTNUM 01480700 + GO TO 0011 01490700 +20010 IVFAIL = IVFAIL + 1 01500700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 01510700 + 0011 CONTINUE 01520700 +C 01530700 +CT002* TEST 002 **** FCVS PROGRAM 700 ***** 01540700 +C ARRAY NAME 01550700 +C 01560700 + IVTNUM = 2 01570700 + CVCOMP = ' ' 01580700 + CVCORR = 'SECND' 01590700 + CVCOMP = C1N001(2) 01600700 + IVCOMP = 0 01610700 + IF (CVCOMP.EQ.'SECND') IVCOMP = 1 01620700 +40020 IF (IVCOMP - 1) 20020, 10020, 20020 01630700 +10020 IVPASS = IVPASS + 1 01640700 + WRITE (I02, 80002) IVTNUM 01650700 + GO TO 0021 01660700 +20020 IVFAIL = IVFAIL + 1 01670700 + WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 01680700 + 0021 CONTINUE 01690700 +C 01700700 +CT003* TEST 003 **** FCVS PROGRAM 700 ***** 01710700 +C ARRAY ELEMENT NAME 01720700 +C 01730700 + IVTNUM = 3 01740700 + IVCOMP = 0 01750700 + IVCORR = 65 01760700 + IVCOMP = I2N001(2,1) 01770700 +40030 IF (IVCOMP - 65) 20030, 10030, 20030 01780700 +10030 IVPASS = IVPASS + 1 01790700 + WRITE (I02, 80002) IVTNUM 01800700 + GO TO 0031 01810700 +20030 IVFAIL = IVFAIL + 1 01820700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 01830700 + 0031 CONTINUE 01840700 +C 01850700 +CT004* TEST 004 **** FCVS PROGRAM 700 ***** 01860700 +C SUBSTRING NAME 01870700 +C 01880700 + IVTNUM = 4 01890700 + CVCOMP = ' ' 01900700 + CVCORR = 'ELEVENTWELVE' 01910700 + CVCOMP = CVN001(11:22) 01920700 + IVCOMP = 0 01930700 + IF (CVCOMP.EQ.'ELEVENTWELVE') IVCOMP = 1 01940700 +40040 IF (IVCOMP - 1) 20040, 10040, 20040 01950700 +10040 IVPASS = IVPASS + 1 01960700 + WRITE (I02, 80002) IVTNUM 01970700 + GO TO 0041 01980700 +20040 IVFAIL = IVFAIL + 1 01990700 + WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 02000700 + 0041 CONTINUE 02010700 +C 02020700 +CT005* TEST 005 **** FCVS PROGRAM 700 ***** 02030700 +C IMPLIED-DO LIST 02040700 +C 02050700 + IVTNUM = 5 02060700 + IVCOMP = 0 02070700 + IVCORR = -217 02080700 + IVCOMP = I2N001(1,3) 02090700 +40050 IF (IVCOMP + 217) 20050, 10050, 20050 02100700 +10050 IVPASS = IVPASS + 1 02110700 + WRITE (I02, 80002) IVTNUM 02120700 + GO TO 0051 02130700 +20050 IVFAIL = IVFAIL + 1 02140700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02150700 + 0051 CONTINUE 02160700 +C 02170700 +CT006* TEST 006 **** FCVS PROGRAM 700 ***** 02180700 +C CLIST CONTAINS A SYMBOLIC NAME OF AN INTEGER CONSTANT 02190700 +C 02200700 + IVTNUM = 6 02210700 + IVCOMP = 0 02220700 + IVCORR = -14 02230700 + IVCOMP = IVN002 02240700 +40060 IF (IVCOMP + 14) 20060, 10060, 20060 02250700 +10060 IVPASS = IVPASS + 1 02260700 + WRITE (I02, 80002) IVTNUM 02270700 + GO TO 0061 02280700 +20060 IVFAIL = IVFAIL + 1 02290700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02300700 + 0061 CONTINUE 02310700 +C 02320700 +CT007* TEST 007 **** FCVS PROGRAM 700 ***** 02330700 +C CLIST CONTAINS A SYMBOLIC NAME OF A CHARACTER CONSTANT 02340700 +C 02350700 + IVTNUM = 7 02360700 + CVCOMP = ' ' 02370700 + CVCORR = 'SEVEN' 02380700 + CVCOMP = CVN002 02390700 + IVCOMP = 0 02400700 + IF (CVCOMP.EQ.'SEVEN') IVCOMP = 1 02410700 +40070 IF (IVCOMP - 1) 20070, 10070, 20070 02420700 +10070 IVPASS = IVPASS + 1 02430700 + WRITE (I02, 80002) IVTNUM 02440700 + GO TO 0071 02450700 +20070 IVFAIL = IVFAIL + 1 02460700 + WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 02470700 + 0071 CONTINUE 02480700 +C 02490700 +C TESTS 8 THRU 11 TEST COMBINATIONS OF SUBSTRING NAMES AND 02500700 +C ARRAY NAMES AND THE R*C FORMAT OF THE CLIST 02510700 +C 02520700 +CT008* TEST 008 **** FCVS PROGRAM 700 ***** 02530700 +C 02540700 + IVTNUM = 8 02550700 + IVCOMP = 0 02560700 + IVCORR = 23 02570700 + IVCOMP = I2N002(3) - I2N002(4) 02580700 +40080 IF (IVCOMP - 23) 20080, 10080, 20080 02590700 +10080 IVPASS = IVPASS + 1 02600700 + WRITE (I02, 80002) IVTNUM 02610700 + GO TO 0081 02620700 +20080 IVFAIL = IVFAIL + 1 02630700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02640700 + 0081 CONTINUE 02650700 +C 02660700 +CT009* TEST 009 **** FCVS PROGRAM 700 ***** 02670700 +C 02680700 + IVTNUM = 9 02690700 + IVCOMP = 0 02700700 + IVCORR = -4 02710700 + DO 0092 I = 1, 3 02720700 + IF (I2N003(I,7) + 4) 0093, 0092, 0093 02730700 +0092 CONTINUE 02740700 +0093 IVCOMP = I2N003(3,7) 02750700 +40090 IF (IVCOMP + 4) 20090, 10090, 20090 02760700 +10090 IVPASS = IVPASS + 1 02770700 + WRITE (I02, 80002) IVTNUM 02780700 + GO TO 0091 02790700 +20090 IVFAIL = IVFAIL + 1 02800700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 02810700 + 0091 CONTINUE 02820700 +C 02830700 +CT010* TEST 010 **** FCVS PROGRAM 700 ***** 02840700 +C 02850700 + IVTNUM = 10 02860700 + CVCOMP = ' ' 02870700 + CVCORR = 'SAME' 02880700 + DO 0102 I = 1, 3 02890700 + DO 0102 J = 1, 4 02900700 + IF (C2N001(I,J).NE.'SAME') GO TO 0103 02910700 +0102 CONTINUE 02920700 +0103 CVCOMP = C2N001(3,4) 02930700 + IVCOMP = 0 02940700 + IF (CVCOMP.EQ.'SAME') IVCOMP = 1 02950700 +40100 IF (IVCOMP - 1) 20100, 10100, 20100 02960700 +10100 IVPASS = IVPASS + 1 02970700 + WRITE (I02, 80002) IVTNUM 02980700 + GO TO 0101 02990700 +20100 IVFAIL = IVFAIL + 1 03000700 + WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 03010700 + 0101 CONTINUE 03020700 +C 03030700 +CT011* TEST 011 **** FCVS PROGRAM 700 ***** 03040700 +C 03050700 + IVTNUM = 11 03060700 + CVCOMP = ' ' 03070700 + CVCORR = 'SAME' 03080700 + CVCOMP = CVN003(13:16) 03090700 + IVCOMP = 0 03100700 + IF (CVCOMP.EQ.'SAME') IVCOMP = 1 03110700 +40110 IF (IVCOMP - 1) 20110, 10110, 20110 03120700 +10110 IVPASS = IVPASS + 1 03130700 + WRITE (I02, 80002) IVTNUM 03140700 + GO TO 0111 03150700 +20110 IVFAIL = IVFAIL + 1 03160700 + WRITE (I02, 80018) IVTNUM, CVCOMP, CVCORR 03170700 + 0111 CONTINUE 03180700 +C 03190700 +C TESTS 12 THRU 17 TEST ARITHMETIC CONVERSION OF CLIST 03200700 +C CONSTANTS TO THE TYPE OF THE CORRESPONDING NLIST ENTITIES 03210700 +C 03220700 +CT012* TEST 012 **** FCVS PROGRAM 700 ***** 03230700 +C REAL TO INTEGER 03240700 +C 03250700 + IVTNUM = 12 03260700 + IVCOMP = 0 03270700 + IVCORR = -473 03280700 + IVCOMP = IVN003 03290700 +40120 IF (IVCOMP + 473) 20120, 10120, 20120 03300700 +10120 IVPASS = IVPASS + 1 03310700 + WRITE (I02, 80002) IVTNUM 03320700 + GO TO 0121 03330700 +20120 IVFAIL = IVFAIL + 1 03340700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 03350700 + 0121 CONTINUE 03360700 +C 03370700 +CT013* TEST 013 **** FCVS PROGRAM 700 ***** 03380700 +C DOUBLE PRECISION TO INTEGER 03390700 +C 03400700 + IVTNUM = 13 03410700 + IVCOMP = 0 03420700 + IVCORR = 23 03430700 + IVCOMP = IVN004 03440700 +40130 IF (IVCOMP - 23) 20130, 10130, 20130 03450700 +10130 IVPASS = IVPASS + 1 03460700 + WRITE (I02, 80002) IVTNUM 03470700 + GO TO 0131 03480700 +20130 IVFAIL = IVFAIL + 1 03490700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 03500700 + 0131 CONTINUE 03510700 +C 03520700 +CT014* TEST 014 **** FCVS PROGRAM 700 ***** 03530700 +C INTEGER TO REAL 03540700 +C 03550700 + IVTNUM = 14 03560700 + RVCOMP = 0.0 03570700 + RVCORR = 71.0 03580700 + RVCOMP = RVN001 03590700 + IF (RVCOMP - 0.70996E+02) 20140, 10140, 40140 03600700 +40140 IF (RVCOMP - 0.71004E+02) 10140, 10140, 20140 03610700 +10140 IVPASS = IVPASS + 1 03620700 + WRITE (I02, 80002) IVTNUM 03630700 + GO TO 0141 03640700 +20140 IVFAIL = IVFAIL + 1 03650700 + WRITE (I02, 80012) IVTNUM, RVCOMP, RVCORR 03660700 + 0141 CONTINUE 03670700 +C 03680700 +CT015* TEST 015 **** FCVS PROGRAM 700 ***** 03690700 +C COMPLEX 03700700 +C 03710700 + IVTNUM = 15 03720700 + ZVCOMP = (0.0, 0.0) 03730700 + ZVCORR = (71.0, -27.0) 03740700 + ZVCOMP = ZVN001 03750700 + IF (R2E001(1) - 0.70996E+02) 20150, 40152, 40151 03760700 +40151 IF (R2E001(1) - 0.71004E+02) 40152, 40152, 20150 03770700 +40152 IF (R2E001(2) + 0.27002E+02) 20150, 10150, 40150 03780700 +40150 IF (R2E001(2) + 0.26998E+02) 10150, 10150, 20150 03790700 +10150 IVPASS = IVPASS + 1 03800700 + WRITE (I02, 80002) IVTNUM 03810700 + GO TO 0151 03820700 +20150 IVFAIL = IVFAIL + 1 03830700 + WRITE (I02, 80045) IVTNUM, ZVCOMP, ZVCORR 03840700 + 0151 CONTINUE 03850700 +C 03860700 +CT016* TEST 016 **** FCVS PROGRAM 700 ***** 03870700 +C INTEGER TO DOUBLE PRECISION 03880700 +C 03890700 + IVTNUM = 16 03900700 + DVCOMP = 0.0D0 03910700 + DVCORR = 6.0D0 03920700 + DVCOMP = DVN001 03930700 + IF (DVCOMP - 0.5999999997D+01) 20160, 10160, 40160 03940700 +40160 IF (DVCOMP - 0.6000000003D+01) 10160, 10160, 20160 03950700 +10160 IVPASS = IVPASS + 1 03960700 + WRITE (I02, 80002) IVTNUM 03970700 + GO TO 0161 03980700 +20160 IVFAIL = IVFAIL + 1 03990700 + WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR 04000700 + 0161 CONTINUE 04010700 +C 04020700 +CT017* TEST 017 **** FCVS PROGRAM 700 ***** 04030700 +C REAL TO DOUBLE PRECISION 04040700 +C 04050700 + IVTNUM = 17 04060700 + DVCOMP = 0.0D0 04070700 + DVCORR = 9.1534D-2 04080700 + DVCOMP = DVN002 04090700 + IF (DVCOMP - 0.91529D-01) 20170, 10170, 40170 04100700 +40170 IF (DVCOMP - 0.91539D-01) 10170, 10170, 20170 04110700 +10170 IVPASS = IVPASS + 1 04120700 + WRITE (I02, 80002) IVTNUM 04130700 + GO TO 0171 04140700 +20170 IVFAIL = IVFAIL + 1 04150700 + WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR 04160700 + 0171 CONTINUE 04170700 +C 04180700 +C TESTS 18 THRU 21 TEST DIFFERENT DATA TYPES USING THE IMPLIED-DO 04190700 +C 04200700 +CT018* TEST 018 **** FCVS PROGRAM 700 ***** 04210700 +C INTEGER 04220700 +C 04230700 + IVTNUM = 18 04240700 + IVCOMP = 0 04250700 + IVCORR = 3 04260700 + IVCOMP = I2N004(2,7) 04270700 +40180 IF (IVCOMP - 3) 20180, 10180, 20180 04280700 +10180 IVPASS = IVPASS + 1 04290700 + WRITE (I02, 80002) IVTNUM 04300700 + GO TO 0181 04310700 +20180 IVFAIL = IVFAIL + 1 04320700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 04330700 + 0181 CONTINUE 04340700 +C 04350700 +CT019* TEST 019 **** FCVS PROGRAM 700 ***** 04360700 +C REAL 04370700 +C 04380700 + IVTNUM = 19 04390700 + RVCOMP = 0.0 04400700 + RVCORR = 4.1 04410700 + RVCOMP = R2N001(4,1) 04420700 + IF (RVCOMP - 0.40998E+01) 20190, 10190, 40190 04430700 +40190 IF (RVCOMP - 0.41002E+01) 10190, 10190, 20190 04440700 +10190 IVPASS = IVPASS + 1 04450700 + WRITE (I02, 80002) IVTNUM 04460700 + GO TO 0191 04470700 +20190 IVFAIL = IVFAIL + 1 04480700 + WRITE (I02, 80012) IVTNUM, RVCOMP, RVCORR 04490700 + 0191 CONTINUE 04500700 +C 04510700 +CT020* TEST 020 **** FCVS PROGRAM 700 ***** 04520700 +C COMPLEX 04530700 +C 04540700 + IVTNUM = 20 04550700 + ZVCOMP = (0.0, 0.0) 04560700 + ZVCORR = (7.3, -2.28) 04570700 + ZVCOMP = Z1N001(7) 04580700 + IF (R2E001(1) - 0.72996E+01) 20200, 40202, 40201 04590700 +40201 IF (R2E001(1) - 0.73004E+01) 40202, 40202, 20200 04600700 +40202 IF (R2E001(2) + 0.22802E+01) 20200, 10200, 40200 04610700 +40200 IF (R2E001(2) + 0.22798E+01) 10200, 10200, 20200 04620700 +10200 IVPASS = IVPASS + 1 04630700 + WRITE (I02, 80002) IVTNUM 04640700 + GO TO 0201 04650700 +20200 IVFAIL = IVFAIL + 1 04660700 + WRITE (I02, 80045) IVTNUM, ZVCOMP, ZVCORR 04670700 + 0201 CONTINUE 04680700 +C 04690700 +CT021* TEST 021 **** FCVS PROGRAM 700 ***** 04700700 +C DOUBLE PRECISION 04710700 +C 04720700 + IVTNUM = 21 04730700 + DVCOMP = 0.0D0 04740700 + DVCORR = 0.1948D+3 04750700 + DVCOMP = D1N001(9) 04760700 + IF (DVCOMP - 0.1947999999D+03) 20210, 10210, 40210 04770700 +40210 IF (DVCOMP - 0.1948000001D+03) 10210, 10210, 20210 04780700 +10210 IVPASS = IVPASS + 1 04790700 + WRITE (I02, 80002) IVTNUM 04800700 + GO TO 0211 04810700 +20210 IVFAIL = IVFAIL + 1 04820700 + WRITE (I02, 80031) IVTNUM, DVCOMP, DVCORR 04830700 + 0211 CONTINUE 04840700 +C 04850700 +C TESTS 22 AND 23 TEST THAT EACH SUBSCRIPT EXPRESSION 04860700 +C IN AN IMPLIED-DO LIST MAY CONTAIN IMPLIED-DO-VARIABLES OF 04870700 +C THE LIST THAT HAS THE SUBSCRIPT EXPRESSION WITHIN ITS RANGE. 04880700 +C 04890700 +CT022* TEST 022 **** FCVS PROGRAM 700 ***** 04900700 +C 04910700 + IVTNUM = 22 04920700 + IVCOMP = 0 04930700 + IVCORR = 155 04940700 + IVCOMP = I2N005(3,4) - I2N005(2,3) 04950700 +40220 IF (IVCOMP - 155) 20220, 10220, 20220 04960700 +10220 IVPASS = IVPASS + 1 04970700 + WRITE (I02, 80002) IVTNUM 04980700 + GO TO 0221 04990700 +20220 IVFAIL = IVFAIL + 1 05000700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 05010700 + 0221 CONTINUE 05020700 +C 05030700 +CT023* TEST 023 **** FCVS PROGRAM 700 ***** 05040700 +C 05050700 + IVTNUM = 23 05060700 + IVCOMP = 0 05070700 + IVCORR = 130 05080700 + IVCOMP = I2N006(6,2) + I2N006(6,8) 05090700 +40230 IF (IVCOMP - 130) 20230, 10230, 20230 05100700 +10230 IVPASS = IVPASS + 1 05110700 + WRITE (I02, 80002) IVTNUM 05120700 + GO TO 0231 05130700 +20230 IVFAIL = IVFAIL + 1 05140700 + WRITE (I02, 80010) IVTNUM, IVCOMP, IVCORR 05150700 + 0231 CONTINUE 05160700 +C 05170700 +CBB** ********************** BBCSUM0 **********************************05180700 +C**** WRITE OUT TEST SUMMARY 05190700 +C**** 05200700 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 05210700 + WRITE (I02, 90004) 05220700 + WRITE (I02, 90014) 05230700 + WRITE (I02, 90004) 05240700 + WRITE (I02, 90020) IVPASS 05250700 + WRITE (I02, 90022) IVFAIL 05260700 + WRITE (I02, 90024) IVDELE 05270700 + WRITE (I02, 90026) IVINSP 05280700 + WRITE (I02, 90028) IVTOTN, IVTOTL 05290700 +CBE** ********************** BBCSUM0 **********************************05300700 +CBB** ********************** BBCFOOT0 **********************************05310700 +C**** WRITE OUT REPORT FOOTINGS 05320700 +C**** 05330700 + WRITE (I02,90016) ZPROG, ZPROG 05340700 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 05350700 + WRITE (I02,90019) 05360700 +CBE** ********************** BBCFOOT0 **********************************05370700 +90001 FORMAT (" ",56X,"FM700") 05380700 +90000 FORMAT (" ",50X,"END OF PROGRAM FM700" ) 05390700 +CBB** ********************** BBCFMT0A **********************************05400700 +C**** FORMATS FOR TEST DETAIL LINES 05410700 +C**** 05420700 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 05430700 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 05440700 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 05450700 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 05460700 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 05470700 + 1I6,/," ",15X,"CORRECT= " ,I6) 05480700 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05490700 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 05500700 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05510700 + 1A21,/," ",16X,"CORRECT= " ,A21) 05520700 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 05530700 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 05540700 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 05550700 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 05560700 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 05570700 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 05580700 +80050 FORMAT (" ",48X,A31) 05590700 +CBE** ********************** BBCFMT0A **********************************05600700 +CBB** ********************** BBCFMAT1 **********************************05610700 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 05620700 +C**** 05630700 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05640700 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 05650700 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 05660700 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 05670700 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05680700 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05690700 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 05700700 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 05710700 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05720700 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 05730700 + 2"(",F12.5,", ",F12.5,")") 05740700 +CBE** ********************** BBCFMAT1 **********************************05750700 +CBB** ********************** BBCFMT0B **********************************05760700 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 05770700 +C**** 05780700 +90002 FORMAT ("1") 05790700 +90004 FORMAT (" ") 05800700 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )05810700 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05820700 +90008 FORMAT (" ",21X,A13,A17) 05830700 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 05840700 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 05850700 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 05860700 + 1 7X,"REMARKS",24X) 05870700 +90014 FORMAT (" ","----------------------------------------------" , 05880700 + 1 "---------------------------------" ) 05890700 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 05900700 +C**** 05910700 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 05920700 +C**** 05930700 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 05940700 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 05950700 + 1 A13) 05960700 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 05970700 +C**** 05980700 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 05990700 +C**** 06000700 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 06010700 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 06020700 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 06030700 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 06040700 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 06050700 +CBE** ********************** BBCFMT0B **********************************06060700 + STOP 06070700 + END 06080700 diff --git a/Fortran/UnitTests/fcvs21_f95/FM700.reference_output b/Fortran/UnitTests/fcvs21_f95/FM700.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM700.reference_output @@ -0,0 +1,51 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM700BEGIN* TEST RESULTS - FM700 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 23 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + + ------------------------------------------------------------------------------- + + 23 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 23 OF 23 TESTS EXECUTED + + *FM700END* END OF TEST - FM700 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM701.f b/Fortran/UnitTests/fcvs21_f95/FM701.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM701.f @@ -0,0 +1,953 @@ + PROGRAM FM701 00010701 +C 00020701 +C THIS ROUTINE TESTS ARRAY DECLARATORS WHERE DIMENSION ANS REF.00030701 +C BOUND EXPRESSIONS MAY CONTAIN CONSTANTS, 5.1.1.2 00040701 +C SYMBOLIC NAMES OF CONSTANTS, OR VARIABLES 5.1.1 00050701 +C OF TYPE INTEGER. 00060701 +C 00070701 +C THIS ROUTINE USES ROUTINES 602 THROUGH 609 AS SUBROUTINES. 00080701 +C 00090701 +C 00100701 +CBB** ********************** BBCCOMNT **********************************00110701 +C**** 00120701 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130701 +C**** VERSION 2.1 00140701 +C**** 00150701 +C**** 00160701 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170701 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180701 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190701 +C**** BUILDING 225 RM A266 00200701 +C**** GAITHERSBURG, MD 20899 00210701 +C**** 00220701 +C**** 00230701 +C**** 00240701 +CBE** ********************** BBCCOMNT **********************************00250701 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00260701 + IMPLICIT CHARACTER*27 (C) 00270701 +CBB** ********************** BBCINITA **********************************00280701 +C**** SPECIFICATION STATEMENTS 00290701 +C**** 00300701 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310701 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320701 +CBE** ********************** BBCINITA **********************************00330701 +C 00340701 + INTEGER I2D001(3,5), I2D002(2,4), I2D003(5,2) 00350701 + PARAMETER (IPN001=1, IPN002=-1, IPN003=4) 00360701 + DIMENSION I2N004(IPN001:2,3), I2N005(2,-1:IPN001), 00370701 + 1 I2N006(IPN002:IPN001,1:IPN003) 00380701 + DIMENSION I2N007(+5:7,+1:2), I2N008(0:2,2), I2N009(1:3,-1:1), 00390701 + 1 I2N010(4,2), I2N011(2*2+1:7,1:2) 00400701 + DIMENSION I2N012(1:+2,2:+4), I2N013(-2:0,2), I2D014(1:3,-3:-1), 00410701 + 1 I2N015(1:2*2+1,1:2), I2N016(2,6/3-1:2*5-7) 00420701 + CHARACTER*4 CVCOMP, CVCORR 00430701 + CHARACTER*4 C2N001(0:5,1:6), C2D002(2,1:3), C2N003(-2:1,3:10), 00440701 + 1 C2D004(1:2,5:7), C1N005(+1:6),C3D006(1:2,2,5:7) 00450701 + DATA I2D001 / 12*0, -47, 2*0 / 00460701 + DATA I2D002 / 6*0, 5, 0 / 00470701 + DATA I2D003 / 6, 8*0, -11 / 00480701 + DATA I2N004 / -4, 5*4 / 00490701 + DATA I2N005 / -5, 5*5 / 00500701 + DATA I2N006 / 6*6, -6, 5*6 / 00510701 + DATA I2N007 / 3*7, -7, 2*7 / 00520701 + DATA I2N008 / -8, 5*8 / 00530701 + DATA I2N009 / 2*9, -9, 6*9 / 00540701 + DATA I2N010 / -10, 7*10 / 00550701 + DATA I2N011 / 3*11, -11, 2*11 / 00560701 + DATA I2N012 / 7, 5*-7 / 00570701 + DATA I2N013 / 8, 5*-8 / 00580701 + DATA I2D014 / 9, 8*-9 / 00590701 + DATA I2N015 / 9*-10, 10 / 00600701 + DATA I2N016 / 11, 4*-11, -10 / 00610701 + DATA C2N001 / 'C001', 35*' ' / 00620701 + DATA C2D002 / 5*' ', 'C002' / 00630701 + DATA C2N003 / 'C003', 31*' ' / 00640701 + DATA C2D004 / 'C004', 5*' ' / 00650701 + DATA C1N005 / 'C005', 5*' ' / 00660701 + DATA C3D006 / 'C006', 11*' ' / 00670701 +C 00680701 +C 00690701 +CBB** ********************** BBCINITB **********************************00700701 +C**** INITIALIZE SECTION 00710701 + DATA ZVERS, ZVERSD, ZDATE 00720701 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00730701 + DATA ZCOMPL, ZNAME, ZTAPE 00740701 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00750701 + DATA ZPROJ, ZTAPED, ZPROG 00760701 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00770701 + DATA REMRKS /' '/ 00780701 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00790701 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00800701 +C**** 00810701 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00820701 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00830701 +CZ03 ZPROG = 'PROGRAM NAME' 00840701 +CZ04 ZDATE = 'DATE OF TEST' 00850701 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00860701 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00870701 +CZ07 ZNAME = 'NAME OF USER' 00880701 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00890701 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00900701 +C 00910701 + IVPASS = 0 00920701 + IVFAIL = 0 00930701 + IVDELE = 0 00940701 + IVINSP = 0 00950701 + IVTOTL = 0 00960701 + IVTOTN = 0 00970701 + ICZERO = 0 00980701 +C 00990701 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01000701 + I01 = 05 01010701 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01020701 + I02 = 06 01030701 +C 01040701 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01050701 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01060701 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01070701 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01080701 +C 01090701 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01100701 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01110701 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01120701 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01130701 +C 01140701 +CBE** ********************** BBCINITB **********************************01150701 + ZPROG='FM701' 01160701 + IVTOTL = 35 01170701 +CBB** ********************** BBCHED0A **********************************01180701 +C**** 01190701 +C**** WRITE REPORT TITLE 01200701 +C**** 01210701 + WRITE (I02, 90002) 01220701 + WRITE (I02, 90006) 01230701 + WRITE (I02, 90007) 01240701 + WRITE (I02, 90008) ZVERS, ZVERSD 01250701 + WRITE (I02, 90009) ZPROG, ZPROG 01260701 + WRITE (I02, 90010) ZDATE, ZCOMPL 01270701 +CBE** ********************** BBCHED0A **********************************01280701 +CBB** ********************** BBCHED0B **********************************01290701 +C**** WRITE DETAIL REPORT HEADERS 01300701 +C**** 01310701 + WRITE (I02,90004) 01320701 + WRITE (I02,90004) 01330701 + WRITE (I02,90013) 01340701 + WRITE (I02,90014) 01350701 + WRITE (I02,90015) IVTOTL 01360701 +CBE** ********************** BBCHED0B **********************************01370701 +C 01380701 +C TESTS 1-3 - LOWER AND/OR UPPER BOUNDS ARE ARITHMETIC EXPRESSIONS 01390701 +C OF TYPE INTEGER, USING VARIABLES 01400701 +C 01410701 +C 01420701 +CT001* TEST 001 **** FCVS PROGRAM 701 **** 01430701 +C 01440701 +C TEST 001 LOWER BOUND 01450701 +C 01460701 + IVTNUM = 1 01470701 + IVCORR = -47 01480701 + CALL SN702(1,1,2,6,I2D001,I2D002,I2D003,IVCOMP) 01490701 +40010 IF (IVCOMP + 47) 20010, 10010, 20010 01500701 +10010 IVPASS = IVPASS + 1 01510701 + WRITE (I02,80002) IVTNUM 01520701 + GO TO 0011 01530701 +20010 IVFAIL = IVFAIL + 1 01540701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01550701 + 0011 CONTINUE 01560701 +C 01570701 +CT002* TEST 002 **** FCVS PROGRAM 701 **** 01580701 +C 01590701 +C TEST 002 UPPER BOUND 01600701 +C 01610701 + IVTNUM = 2 01620701 + IVCORR = 5 01630701 + CALL SN702(2,1,2,6,I2D001,I2D002,I2D003,IVCOMP) 01640701 +40020 IF (IVCOMP - 5) 20020, 10020, 20020 01650701 +10020 IVPASS = IVPASS + 1 01660701 + WRITE (I02,80002) IVTNUM 01670701 + GO TO 0021 01680701 +20020 IVFAIL = IVFAIL + 1 01690701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01700701 + 0021 CONTINUE 01710701 +C 01720701 +CT003* TEST 003 **** FCVS PROGRAM 701 **** 01730701 +C 01740701 +C TEST 003 BOTH LOWER AND UPPER BOUNDS 01750701 +C 01760701 + IVTNUM = 3 01770701 + IVCORR = 17 01780701 + CALL SN702(3,1,2,6,I2D001,I2D002,I2D003,IVCOMP) 01790701 +40030 IF (IVCOMP - 17) 20030, 10030, 20030 01800701 +10030 IVPASS = IVPASS + 1 01810701 + WRITE (I02,80002) IVTNUM 01820701 + GO TO 0031 01830701 +20030 IVFAIL = IVFAIL + 1 01840701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01850701 + 0031 CONTINUE 01860701 +C 01870701 +C TESTS 4-6 - LOWER AND/OR UPPER BOUNDS ARE SYMBOLIC NAMES 01880701 +C OF INTEGER CONSTANTS 01890701 +C 01900701 +C 01910701 +CT004* TEST 004 **** FCVS PROGRAM 701 **** 01920701 +C 01930701 +C TEST 004 LOWER BOUND 01940701 +C 01950701 + IVTNUM = 4 01960701 + IVCOMP = 0 01970701 + IVCORR = -4 01980701 + IVCOMP = I2N004(1,1) 01990701 +40040 IF (IVCOMP + 4) 20040, 10040, 20040 02000701 +10040 IVPASS = IVPASS + 1 02010701 + WRITE (I02,80002) IVTNUM 02020701 + GO TO 0041 02030701 +20040 IVFAIL = IVFAIL + 1 02040701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02050701 + 0041 CONTINUE 02060701 +C 02070701 +CT005* TEST 005 **** FCVS PROGRAM 701 **** 02080701 +C 02090701 +C TEST 005 UPPER BOUND 02100701 +C 02110701 + IVTNUM = 5 02120701 + IVCOMP = 0 02130701 + IVCORR = -5 02140701 + IVCOMP = I2N005(1,-1) 02150701 +40050 IF (IVCOMP + 5) 20050, 10050, 20050 02160701 +10050 IVPASS = IVPASS + 1 02170701 + WRITE (I02,80002) IVTNUM 02180701 + GO TO 0051 02190701 +20050 IVFAIL = IVFAIL + 1 02200701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02210701 + 0051 CONTINUE 02220701 +C 02230701 +CT006* TEST 006 **** FCVS PROGRAM 701 **** 02240701 +C 02250701 +C TEST 006 BOTH UPPER AND LOWER BOUNDS 02260701 +C 02270701 + IVTNUM = 6 02280701 + IVCOMP = 0 02290701 + IVCORR = -6 02300701 + IVCOMP = I2N006(-1,3) 02310701 +40060 IF (IVCOMP + 6) 20060, 10060, 20060 02320701 +10060 IVPASS = IVPASS + 1 02330701 + WRITE (I02,80002) IVTNUM 02340701 + GO TO 0061 02350701 +20060 IVFAIL = IVFAIL + 1 02360701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02370701 + 0061 CONTINUE 02380701 +C 02390701 +CT007* TEST 007 **** FCVS PROGRAM 701 **** 02400701 +C 02410701 +C TEST 007 LOWER BOUND POSITIVE 02420701 +C 02430701 + IVTNUM = 7 02440701 + IVCOMP = 0 02450701 + IVCORR = -7 02460701 + IVCOMP = I2N007(5,2) 02470701 +40070 IF (IVCOMP + 7) 20070, 10070, 20070 02480701 +10070 IVPASS = IVPASS + 1 02490701 + WRITE (I02,80002) IVTNUM 02500701 + GO TO 0071 02510701 +20070 IVFAIL = IVFAIL + 1 02520701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02530701 + 0071 CONTINUE 02540701 +C 02550701 +CT008* TEST 008 **** FCVS PROGRAM 701 **** 02560701 +C 02570701 +C TEST 008 LOWER BOUND ZERO 02580701 +C 02590701 + IVTNUM = 8 02600701 + IVCOMP = 0 02610701 + IVCORR = -8 02620701 + IVCOMP = I2N008(0,1) 02630701 +40080 IF (IVCOMP + 8) 20080, 10080, 20080 02640701 +10080 IVPASS = IVPASS + 1 02650701 + WRITE (I02,80002) IVTNUM 02660701 + GO TO 0081 02670701 +20080 IVFAIL = IVFAIL + 1 02680701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02690701 + 0081 CONTINUE 02700701 +C 02710701 +CT009* TEST 009 **** FCVS PROGRAM 701 **** 02720701 +C 02730701 +C TEST 009 LOWER BOUND NEGATIVE 02740701 +C 02750701 + IVTNUM = 9 02760701 + IVCOMP = 0 02770701 + IVCORR = -9 02780701 + IVCOMP = I2N009(3,-1) 02790701 +40090 IF (IVCOMP + 9) 20090, 10090, 20090 02800701 +10090 IVPASS = IVPASS + 1 02810701 + WRITE (I02,80002) IVTNUM 02820701 + GO TO 0091 02830701 +20090 IVFAIL = IVFAIL + 1 02840701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02850701 + 0091 CONTINUE 02860701 +C 02870701 +CT010* TEST 010 **** FCVS PROGRAM 701 **** 02880701 +C 02890701 +C TEST 010 LOWER BOUND OMITTED 02900701 +C 02910701 + IVTNUM = 10 02920701 + IVCOMP = 0 02930701 + IVCORR = -10 02940701 + IVCOMP = I2N010(1,1) 02950701 +40100 IF (IVCOMP + 10) 20100, 10100, 20100 02960701 +10100 IVPASS = IVPASS + 1 02970701 + WRITE (I02,80002) IVTNUM 02980701 + GO TO 0101 02990701 +20100 IVFAIL = IVFAIL + 1 03000701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03010701 + 0101 CONTINUE 03020701 +C 03030701 +CT011* TEST 011 **** FCVS PROGRAM 701 **** 03040701 +C 03050701 +C TEST 011 LOWER BOUND IS AN INTEGER EXPRESSION 03060701 +C 03070701 + IVTNUM = 11 03080701 + IVCOMP = 0 03090701 + IVCORR = -11 03100701 + IVCOMP = I2N011(5,2) 03110701 +40110 IF (IVCOMP + 11) 20110, 10110, 20110 03120701 +10110 IVPASS = IVPASS + 1 03130701 + WRITE (I02,80002) IVTNUM 03140701 + GO TO 0111 03150701 +20110 IVFAIL = IVFAIL + 1 03160701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03170701 + 0111 CONTINUE 03180701 +C 03190701 +CT012* TEST 012 **** FCVS PROGRAM 701 **** 03200701 +C 03210701 +C TEST 012 UPPER BOUND POSITIVE 03220701 +C 03230701 + IVTNUM = 12 03240701 + IVCOMP = 0 03250701 + IVCORR = 7 03260701 + IVCOMP = I2N012(1,2) 03270701 +40120 IF (IVCOMP - 7) 20120, 10120, 20120 03280701 +10120 IVPASS = IVPASS + 1 03290701 + WRITE (I02,80002) IVTNUM 03300701 + GO TO 0121 03310701 +20120 IVFAIL = IVFAIL + 1 03320701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03330701 + 0121 CONTINUE 03340701 +C 03350701 +CT013* TEST 013 **** FCVS PROGRAM 701 **** 03360701 +C 03370701 +C TEST 013 UPPER BOUND ZERO 03380701 +C 03390701 + IVTNUM = 13 03400701 + IVCOMP = 0 03410701 + IVCORR = 8 03420701 + IVCOMP = I2N013(-2,1) 03430701 +40130 IF (IVCOMP - 8) 20130, 10130, 20130 03440701 +10130 IVPASS = IVPASS + 1 03450701 + WRITE (I02,80002) IVTNUM 03460701 + GO TO 0131 03470701 +20130 IVFAIL = IVFAIL + 1 03480701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03490701 + 0131 CONTINUE 03500701 +C 03510701 +CT014* TEST 014 **** FCVS PROGRAM 701 **** 03520701 +C 03530701 +C TEST 014 UPPER BOUND NEGATIVE 03540701 +C 03550701 + IVTNUM = 14 03560701 + IVCOMP = 0 03570701 + IVCORR = 9 03580701 + IVCOMP = I2D014(1,-3) 03590701 +40140 IF (IVCOMP - 9) 20140, 10140, 20140 03600701 +10140 IVPASS = IVPASS + 1 03610701 + WRITE (I02,80002) IVTNUM 03620701 + GO TO 0141 03630701 +20140 IVFAIL = IVFAIL + 1 03640701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03650701 + 0141 CONTINUE 03660701 +C 03670701 +CT015* TEST 015 **** FCVS PROGRAM 701 **** 03680701 +C 03690701 +C TEST 015 UPPER BOUND IS INTEGER EXPRESSION 03700701 +C 03710701 + IVTNUM = 15 03720701 + IVCOMP = 0 03730701 + IVCORR = 10 03740701 + IVCOMP = I2N015(5,2) 03750701 +40150 IF (IVCOMP - 10) 20150, 10150, 20150 03760701 +10150 IVPASS = IVPASS + 1 03770701 + WRITE (I02,80002) IVTNUM 03780701 + GO TO 0151 03790701 +20150 IVFAIL = IVFAIL + 1 03800701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03810701 + 0151 CONTINUE 03820701 +C 03830701 +CT016* TEST 016 **** FCVS PROGRAM 701 **** 03840701 +C 03850701 +C TEST 016 UPPER BOUNDS ARE INTEGER EXPRESSIONS 03860701 +C 03870701 + IVTNUM = 16 03880701 + IVCOMP = 0 03890701 + IVCORR = -110 03900701 + IVCOMP = I2N016(1,1)*I2N016(2,3) 03910701 +40160 IF (IVCOMP + 110) 20160, 10160, 20160 03920701 +10160 IVPASS = IVPASS + 1 03930701 + WRITE (I02,80002) IVTNUM 03940701 + GO TO 0161 03950701 +20160 IVFAIL = IVFAIL + 1 03960701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03970701 + 0161 CONTINUE 03980701 +C 03990701 +CT017* TEST 017 **** FCVS PROGRAM 701 **** 04000701 +C 04010701 +C TEST 017 ZERO AS A DIMENSION 04020701 +C 04030701 + IVTNUM = 17 04040701 + CVCOMP = ' ' 04050701 + IVCOMP = 0 04060701 + CVCORR = 'C001' 04070701 + CVCOMP = C2N001(0,1) 04080701 + IF (CVCOMP .EQ. 'C001') IVCOMP = 1 04090701 + IF (IVCOMP - 1) 20170, 10170, 20170 04100701 +10170 IVPASS = IVPASS + 1 04110701 + WRITE (I02,80002) IVTNUM 04120701 + GO TO 0171 04130701 +20170 IVFAIL = IVFAIL + 1 04140701 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04150701 + 0171 CONTINUE 04160701 +C 04170701 +CT018* TEST 018 **** FCVS PROGRAM 701 **** 04180701 +C 04190701 +C TEST 018 UPPER DIMENSION UNDEFINED IN THE SUBROUTINE 04200701 +C 04210701 + IVTNUM = 18 04220701 + CVCOMP = ' ' 04230701 + IVCOMP = 0 04240701 + CVCORR = 'C002' 04250701 + CALL SN703(1,1,2,C2D002,C2D004,CVCOMP) 04260701 + IF (CVCOMP .EQ. 'C002') IVCOMP = 1 04270701 + IF (IVCOMP - 1) 20180, 10180, 20180 04280701 +10180 IVPASS = IVPASS + 1 04290701 + WRITE (I02,80002) IVTNUM 04300701 + GO TO 0181 04310701 +20180 IVFAIL = IVFAIL + 1 04320701 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04330701 + 0181 CONTINUE 04340701 +C 04350701 +CT019* TEST 019 **** FCVS PROGRAM 701 **** 04360701 +C 04370701 +C TEST 019 NEGATIVE DIMENSION 04380701 +C 04390701 + IVTNUM = 19 04400701 + CVCOMP = ' ' 04410701 + IVCOMP = 0 04420701 + CVCORR = 'C003' 04430701 + CVCOMP = C2N003(-2,3) 04440701 + IF (CVCOMP .EQ. 'C003') IVCOMP = 1 04450701 + IF (IVCOMP - 1) 20190, 10190, 20190 04460701 +10190 IVPASS = IVPASS + 1 04470701 + WRITE (I02,80002) IVTNUM 04480701 + GO TO 0191 04490701 +20190 IVFAIL = IVFAIL + 1 04500701 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04510701 + 0191 CONTINUE 04520701 +C 04530701 +CT020* TEST 020 **** FCVS PROGRAM 701 **** 04540701 +C 04550701 +C TEST 020 VARIABLE DIMENSION 04560701 +C 04570701 + IVTNUM = 20 04580701 + CVCOMP = ' ' 04590701 + IVCOMP = 0 04600701 + CVCORR = 'C004' 04610701 + CALL SN703(2,1,2,C2D002,C2D004,CVCOMP) 04620701 + IF (CVCOMP .EQ. 'C004') IVCOMP = 1 04630701 + IF (IVCOMP - 1) 20200, 10200, 20200 04640701 +10200 IVPASS = IVPASS + 1 04650701 + WRITE (I02,80002) IVTNUM 04660701 + GO TO 0201 04670701 +20200 IVFAIL = IVFAIL + 1 04680701 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04690701 + 0201 CONTINUE 04700701 +C 04710701 +CT021* TEST 021 **** FCVS PROGRAM 701 **** 04720701 +C 04730701 +C TEST 021 POSITIVE DIMENSION 04740701 +C 04750701 + IVTNUM = 21 04760701 + CVCOMP = ' ' 04770701 + IVCOMP = 0 04780701 + CVCORR = 'C005' 04790701 + CVCOMP = C1N005(1) 04800701 + IF (CVCOMP .EQ. 'C005') IVCOMP = 1 04810701 + IF (IVCOMP - 1) 20210, 10210, 20210 04820701 +10210 IVPASS = IVPASS + 1 04830701 + WRITE (I02,80002) IVTNUM 04840701 + GO TO 0211 04850701 +20210 IVFAIL = IVFAIL + 1 04860701 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04870701 + 0211 CONTINUE 04880701 +C 04890701 +C TESTS 22-25 - MIXED DIMENSION BOUNDS WITH VARIABLE NUMBER OF 04900701 +C ELEMENTS IN EACH DIMENSION 04910701 +C 04920701 +C 04930701 +CT022* TEST 022 **** FCVS PROGRAM 701 **** 04940701 +C 04950701 +C 04960701 + IVTNUM = 22 04970701 + CVCOMP = ' ' 04980701 + IVCOMP = 0 04990701 + CVCORR = 'C006' 05000701 + CALL SN704(1,1,2,5,C3D006,CVCOMP) 05010701 + IF (CVCOMP .EQ. 'C006') IVCOMP = 1 05020701 + IF (IVCOMP - 1) 20220, 10220, 20220 05030701 +10220 IVPASS = IVPASS + 1 05040701 + WRITE (I02,80002) IVTNUM 05050701 + GO TO 0221 05060701 +20220 IVFAIL = IVFAIL + 1 05070701 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05080701 + 0221 CONTINUE 05090701 +C 05100701 +CT023* TEST 023 **** FCVS PROGRAM 701 **** 05110701 +C 05120701 +C 05130701 + IVTNUM = 23 05140701 + CVCOMP = ' ' 05150701 + IVCOMP = 0 05160701 + CVCORR = 'IJKL' 05170701 + CALL SN704(2,1,2,6,C3D006,CVCOMP) 05180701 + IF (CVCOMP .EQ. 'IJKL') IVCOMP = 1 05190701 + IF (IVCOMP - 1) 20230, 10230, 20230 05200701 +10230 IVPASS = IVPASS + 1 05210701 + WRITE (I02,80002) IVTNUM 05220701 + GO TO 0231 05230701 +20230 IVFAIL = IVFAIL + 1 05240701 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05250701 + 0231 CONTINUE 05260701 +C 05270701 +CT024* TEST 024 **** FCVS PROGRAM 701 **** 05280701 +C 05290701 +C 05300701 + IVTNUM = 24 05310701 + CVCOMP = ' ' 05320701 + IVCOMP = 0 05330701 + CVCORR = 'EFGH' 05340701 + CALL SN704(3,1,1,5,C3D006,CVCOMP) 05350701 + IF (CVCOMP .EQ. 'EFGH') IVCOMP = 1 05360701 + IF (IVCOMP - 1) 20240, 10240, 20240 05370701 +10240 IVPASS = IVPASS + 1 05380701 + WRITE (I02,80002) IVTNUM 05390701 + GO TO 0241 05400701 +20240 IVFAIL = IVFAIL + 1 05410701 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05420701 + 0241 CONTINUE 05430701 +C 05440701 +CT025* TEST 025 **** FCVS PROGRAM 701 **** 05450701 +C 05460701 +C 05470701 + IVTNUM = 25 05480701 + CVCOMP = ' ' 05490701 + IVCOMP = 0 05500701 + CVCORR = 'ABCD' 05510701 + CALL SN704(4,2,2,6,C3D006,CVCOMP) 05520701 + IF (CVCOMP .EQ. 'ABCD') IVCOMP = 1 05530701 + IF (IVCOMP - 1) 20250, 10250, 20250 05540701 +10250 IVPASS = IVPASS + 1 05550701 + WRITE (I02,80002) IVTNUM 05560701 + GO TO 0251 05570701 +20250 IVFAIL = IVFAIL + 1 05580701 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05590701 + 0251 CONTINUE 05600701 +C 05610701 +C TESTS 26-28 - LOWER BOUND IS AN EXPRESSION INVOLVING 05620701 +C ARITHMETIC OPERATORS 05630701 +C 05640701 +C 05650701 +CT026* TEST 026 **** FCVS PROGRAM 701 **** 05660701 +C 05670701 +C 05680701 + IVTNUM = 26 05690701 + IVCORR = -47 05700701 + CALL SN705(1,2,-1,1,I2D001,I2D002,I2D003,IVCOMP) 05710701 +40260 IF (IVCOMP + 47) 20260, 10260, 20260 05720701 +10260 IVPASS = IVPASS + 1 05730701 + WRITE (I02,80002) IVTNUM 05740701 + GO TO 0261 05750701 +20260 IVFAIL = IVFAIL + 1 05760701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05770701 + 0261 CONTINUE 05780701 +C 05790701 +CT027* TEST 027 **** FCVS PROGRAM 701 **** 05800701 +C 05810701 +C 05820701 + IVTNUM = 27 05830701 + IVCORR = 5 05840701 + CALL SN705(2,2,-1,1,I2D001,I2D002,I2D003,IVCOMP) 05850701 +40270 IF (IVCOMP - 5) 20270, 10270, 20270 05860701 +10270 IVPASS = IVPASS + 1 05870701 + WRITE (I02,80002) IVTNUM 05880701 + GO TO 0271 05890701 +20270 IVFAIL = IVFAIL + 1 05900701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05910701 + 0271 CONTINUE 05920701 +C 05930701 +CT028* TEST 028 **** FCVS PROGRAM 701 **** 05940701 +C 05950701 +C 05960701 + IVTNUM = 28 05970701 + IVCORR = 17 05980701 + CALL SN705(3,2,-1,1,I2D001,I2D002,I2D003,IVCOMP) 05990701 +40280 IF (IVCOMP - 17) 20280, 10280, 20280 06000701 +10280 IVPASS = IVPASS + 1 06010701 + WRITE (I02,80002) IVTNUM 06020701 + GO TO 0281 06030701 +20280 IVFAIL = IVFAIL + 1 06040701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06050701 + 0281 CONTINUE 06060701 +C 06070701 +C TESTS 29-31 - UPPER BOUND IS AN EXPRESSION INVOLVING 06080701 +C ARITHMETIC OPERATORS 06090701 +C 06100701 +C 06110701 +CT029* TEST 029 **** FCVS PROGRAM 701 **** 06120701 +C 06130701 +C 06140701 + IVTNUM = 29 06150701 + IVCORR = -47 06160701 + CALL SN706(1,4,0,3,I2D001,I2D002,I2D003,IVCOMP) 06170701 +40290 IF (IVCOMP + 47) 20290, 10290, 20290 06180701 +10290 IVPASS = IVPASS + 1 06190701 + WRITE (I02,80002) IVTNUM 06200701 + GO TO 0291 06210701 +20290 IVFAIL = IVFAIL + 1 06220701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06230701 + 0291 CONTINUE 06240701 +C 06250701 +CT030* TEST 030 **** FCVS PROGRAM 701 **** 06260701 +C 06270701 +C 06280701 + IVTNUM = 30 06290701 + IVCORR = 5 06300701 + CALL SN706(2,4,0,3,I2D001,I2D002,I2D003,IVCOMP) 06310701 +40300 IF (IVCOMP - 5) 20300, 10300, 20300 06320701 +10300 IVPASS = IVPASS + 1 06330701 + WRITE (I02,80002) IVTNUM 06340701 + GO TO 0301 06350701 +20300 IVFAIL = IVFAIL + 1 06360701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06370701 + 0301 CONTINUE 06380701 +C 06390701 +CT031* TEST 031 **** FCVS PROGRAM 701 **** 06400701 +C 06410701 +C 06420701 + IVTNUM = 31 06430701 + IVCORR = 17 06440701 + CALL SN706(3,4,0,3,I2D001,I2D002,I2D003,IVCOMP) 06450701 +40310 IF (IVCOMP - 17) 20310, 10310, 20310 06460701 +10310 IVPASS = IVPASS + 1 06470701 + WRITE (I02,80002) IVTNUM 06480701 + GO TO 0311 06490701 +20310 IVFAIL = IVFAIL + 1 06500701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06510701 + 0311 CONTINUE 06520701 +C 06530701 +CT032* TEST 032 **** FCVS PROGRAM 701 **** 06540701 +C 06550701 +C TEST 032 "/" IN LOWER BOUND 06560701 +C 06570701 + IVTNUM = 32 06580701 + IVCORR = -47 06590701 + CALL SN707(1,3,2,I2D001,I2D002,IVCOMP) 06600701 +40320 IF (IVCOMP + 47) 20320, 10320, 20320 06610701 +10320 IVPASS = IVPASS + 1 06620701 + WRITE (I02,80002) IVTNUM 06630701 + GO TO 0321 06640701 +20320 IVFAIL = IVFAIL + 1 06650701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06660701 + 0321 CONTINUE 06670701 +C 06680701 +CT033* TEST 033 **** FCVS PROGRAM 701 **** 06690701 +C 06700701 +C TEST 033 "**" IN UPPER BOUND 06710701 +C 06720701 + IVTNUM = 33 06730701 + IVCORR = 5 06740701 + CALL SN707(2,3,2,I2D001,I2D002,IVCOMP) 06750701 +40330 IF (IVCOMP - 5) 20330, 10330, 20330 06760701 +10330 IVPASS = IVPASS + 1 06770701 + WRITE (I02,80002) IVTNUM 06780701 + GO TO 0331 06790701 +20330 IVFAIL = IVFAIL + 1 06800701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06810701 + 0331 CONTINUE 06820701 +C 06830701 +C TESTS 34-35 - UPPER AND LOWER BOUNDS WITH ARITHMETIC OPERATORS 06840701 +C IN EXPRESSION 06850701 +C 06860701 +C 06870701 +CT034* TEST 034 **** FCVS PROGRAM 701 **** 06880701 +C 06890701 +C 06900701 + IVTNUM = 34 06910701 + IVCORR = -47 06920701 + CALL SN708(3,-2,2,I2D001,IVCOMP) 06930701 +40340 IF (IVCOMP + 47) 20340, 10340, 20340 06940701 +10340 IVPASS = IVPASS + 1 06950701 + WRITE (I02,80002) IVTNUM 06960701 + GO TO 0341 06970701 +20340 IVFAIL = IVFAIL + 1 06980701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06990701 + 0341 CONTINUE 07000701 +C 07010701 +CT035* TEST 035 **** FCVS PROGRAM 701 **** 07020701 +C 07030701 +C 07040701 + IVTNUM = 35 07050701 + IVCORR = 9 07060701 + CALL SN709(-1,-2,1,I2D014,IVCOMP) 07070701 +40350 IF (IVCOMP - 9) 20350, 10350, 20350 07080701 +10350 IVPASS = IVPASS + 1 07090701 + WRITE (I02,80002) IVTNUM 07100701 + GO TO 0351 07110701 +20350 IVFAIL = IVFAIL + 1 07120701 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07130701 + 0351 CONTINUE 07140701 +C 07150701 +CBB** ********************** BBCSUM0 **********************************07160701 +C**** WRITE OUT TEST SUMMARY 07170701 +C**** 07180701 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 07190701 + WRITE (I02, 90004) 07200701 + WRITE (I02, 90014) 07210701 + WRITE (I02, 90004) 07220701 + WRITE (I02, 90020) IVPASS 07230701 + WRITE (I02, 90022) IVFAIL 07240701 + WRITE (I02, 90024) IVDELE 07250701 + WRITE (I02, 90026) IVINSP 07260701 + WRITE (I02, 90028) IVTOTN, IVTOTL 07270701 +CBE** ********************** BBCSUM0 **********************************07280701 +CBB** ********************** BBCFOOT0 **********************************07290701 +C**** WRITE OUT REPORT FOOTINGS 07300701 +C**** 07310701 + WRITE (I02,90016) ZPROG, ZPROG 07320701 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 07330701 + WRITE (I02,90019) 07340701 +CBE** ********************** BBCFOOT0 **********************************07350701 +90001 FORMAT (" ",56X,"FM701") 07360701 +90000 FORMAT (" ",50X,"END OF PROGRAM FM701" ) 07370701 +CBB** ********************** BBCFMT0A **********************************07380701 +C**** FORMATS FOR TEST DETAIL LINES 07390701 +C**** 07400701 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 07410701 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 07420701 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 07430701 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 07440701 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 07450701 + 1I6,/," ",15X,"CORRECT= " ,I6) 07460701 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07470701 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 07480701 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07490701 + 1A21,/," ",16X,"CORRECT= " ,A21) 07500701 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 07510701 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 07520701 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 07530701 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 07540701 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 07550701 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 07560701 +80050 FORMAT (" ",48X,A31) 07570701 +CBE** ********************** BBCFMT0A **********************************07580701 +CBB** ********************** BBCFMAT1 **********************************07590701 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 07600701 +C**** 07610701 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07620701 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 07630701 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 07640701 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 07650701 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 07660701 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 07670701 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 07680701 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 07690701 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07700701 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 07710701 + 2"(",F12.5,", ",F12.5,")") 07720701 +CBE** ********************** BBCFMAT1 **********************************07730701 +CBB** ********************** BBCFMT0B **********************************07740701 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 07750701 +C**** 07760701 +90002 FORMAT ("1") 07770701 +90004 FORMAT (" ") 07780701 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )07790701 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07800701 +90008 FORMAT (" ",21X,A13,A17) 07810701 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 07820701 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 07830701 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 07840701 + 1 7X,"REMARKS",24X) 07850701 +90014 FORMAT (" ","----------------------------------------------" , 07860701 + 1 "---------------------------------" ) 07870701 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 07880701 +C**** 07890701 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 07900701 +C**** 07910701 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 07920701 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 07930701 + 1 A13) 07940701 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 07950701 +C**** 07960701 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 07970701 +C**** 07980701 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 07990701 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 08000701 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 08010701 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 08020701 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 08030701 +CBE** ********************** BBCFMT0B **********************************08040701 + END 08050701 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010702 +C 00020702 +C THIS SUBROUTINE TESTS DIMENSION BOUND EXPRESSIONS 00030702 +C CONTAINING VARIABLES OF TYPE INTEGER. 00040702 +C 00050702 + SUBROUTINE SN702(IVD001,IVD002,IVD003,IVD004,I2D001,I2D002,I2D003,00060702 + 1 IVD005) 00070702 +C 00080702 + DIMENSION I2D001(IVD002:3,1:5), I2D002(2,1:2*IVD003), 00090702 + 1 I2D003(IVD004/3 - 1 : IVD002 + 4, 1:2) 00100702 +C 00110702 + IF (IVD001 - 2) 70010, 70020, 70030 00120702 +70010 IVD005 = I2D001(1,5) 00130702 + RETURN 00140702 +70020 IVD005 = I2D002(1,4) 00150702 + RETURN 00160702 +70030 IVD005 = I2D003(1,1) - I2D003(5,2) 00170702 + RETURN 00180702 + END 00190702 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010703 +C 00020703 +C THIS SUBROUTINE TESTS ASSUMED-SIZE ARRAY DECLARATORS 00030703 +C AND ADJUSTABLE ARRAY DECLARATORS. 00040703 +C 00050703 + SUBROUTINE SN703(IVD001,IVD002,IVD003,C2D001,C2D002,CVD001) 00060703 +C 00070703 + CHARACTER*4 CVD001, C2D001(2,1:*), C2D002(IVD002:IVD003,5:7) 00080703 +C 00090703 + IF (IVD001 - 1) 70010, 70010, 70020 00100703 +70010 CVD001 = C2D001(2,3) 00110703 + RETURN 00120703 +70020 CVD001 = C2D002(1,5) 00130703 + RETURN 00140703 + END 00150703 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010704 +C 00020704 +C THIS SUBROUTINE TESTS ADJUSTABLE ARRAY DECLARATORS. 00030704 +C 00040704 + SUBROUTINE SN704(IVD001,IVD002,IVD003,IVD004,C3D001,CVD001) 00050704 +C 00060704 + CHARACTER*4 CVD001, C3D001(IVD002:IVD003,2,IVD004:7) 00070704 +C 00080704 + IF (IVD001 - 2) 70010, 70020, 70030 00090704 +70010 CVD001 = C3D001(1,1,5) 00100704 + RETURN 00110704 +70020 C3D001(1,2,6) = 'IJKL' 00120704 + CVD001 = C3D001(1,2,6) 00130704 + RETURN 00140704 +70030 IF (IVD001 - 3) 70040, 70040, 70050 00150704 +70040 C3D001(1,1,5) = 'EFGH' 00160704 + CVD001 = C3D001(1,1,5) 00170704 + RETURN 00180704 +70050 C3D001(2,2,6) = 'ABCD' 00190704 + CVD001 = C3D001(2,2,6) 00200704 + RETURN 00210704 + END 00220704 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010705 +C 00020705 +C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE THE LOWER BOUNDS 00030705 +C CONTAIN ARITHMETIC EXPRESSIONS OF TYPE 00040705 +C INTEGER. 00050705 +C 00060705 + SUBROUTINE SN705(IVD001,IVD002,IVD003,IVD004,I2D001,I2D002,I2D003,00070705 + 1 IVD005) 00080705 +C 00090705 + DIMENSION I2D001(IVD002-1:3,1:5),I2D002(IVD003+2:2,1:4), 00100705 + 1 I2D003(2*IVD004-1:5,2) 00110705 +C 00120705 + IF (IVD001 - 2) 70010, 70020, 70030 00130705 +70010 IVD005 = I2D001(1,5) 00140705 + RETURN 00150705 +70020 IVD005 = I2D002(1,4) 00160705 + RETURN 00170705 +70030 IVD005 = I2D003(1,1) - I2D003(5,2) 00180705 + RETURN 00190705 + END 00200705 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010706 +C 00020706 +C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE THE UPPER BOUNDS 00030706 +C CONTAIN ARITHMETIC EXPRESSIONS OF TYPE 00040706 +C INTEGER. 00050706 +C 00060706 + SUBROUTINE SN706(IVD001,IVD002,IVD003,IVD004,I2D001,I2D002,I2D003,00070706 + 1 IVD005) 00080706 +C 00090706 + DIMENSION I2D001(1:IVD002-1,1:5),I2D002(1:IVD003+2,1:4), 00100706 + 1 I2D003(1:2*IVD004-1,2) 00110706 +C 00120706 + IF (IVD001 - 2) 70010, 70020, 70030 00130706 +70010 IVD005 = I2D001(1,5) 00140706 + RETURN 00150706 +70020 IVD005 = I2D002(1,4) 00160706 + RETURN 00170706 +70030 IVD005 = I2D003(1,1) - I2D003(5,2) 00180706 + RETURN 00190706 + END 00200706 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010707 +C 00020707 +C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE BOUND EXPRESSIONS 00030707 +C MAY CONTAIN DIVISION OPERATORS OR 00040707 +C EXPONENTIATION OPERATORS. 00050707 +C 00060707 + SUBROUTINE SN707(IVD001,IVD002,IVD003,I2D001,I2D002,IVD004) 00070707 +C 00080707 + DIMENSION I2D001(IVD002/3:3,1:5),I2D002(1:2,1:IVD003**2) 00090707 +C 00100707 + IF (IVD001 - 1) 70010, 70010, 70020 00110707 +70010 IVD004 = I2D001(1,5) 00120707 + RETURN 00130707 +70020 IVD004 = I2D002(1,4) 00140707 + RETURN 00150707 + END 00160707 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010708 +C 00020708 +C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE BOTH THE LOWER 00030708 +C AND UPPER BOUNDS CONTAIN ARITHMETIC 00040708 +C EXPRESSIONS OF TYPE INTEGER. 00050708 +C 00060708 + SUBROUTINE SN708(IVD001,IVD002,IVD003,I2D001,IVD004) 00070708 +C 00080708 + DIMENSION I2D001(IVD001/3:IVD001,IVD002+3 : 4*(2*IVD003-1)/3 + 1) 00090708 +C 00100708 + IVD004 = I2D001(1,5) 00110708 + RETURN 00120708 + END 00130708 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 701. 00010709 +C 00020709 +C THIS SUBROUTINE TESTS ARRAY DECLARATORS WHERE THE BOUND 00030709 +C EXPRESSIONS CONTAIN SYMBOLIC NAMES 00040709 +C OF CONSTANTS OR VARIABLES OF TYPE 00050709 +C INTEGER. 00060709 +C 00070709 + SUBROUTINE SN709(IVD001,IVD002,IVD003,I2D001,IVD005) 00080709 +C 00090709 + PARAMETER (IPN001=-3) 00100709 + DIMENSION I2D001(IPN001+4:(2*IVD003 + 1),IPN001:(1-IVD001)/IVD002)00110709 +C 00120709 + IVD005 = I2D001(1,-3) 00130709 + RETURN 00140709 + END 00150709 diff --git a/Fortran/UnitTests/fcvs21_f95/FM701.reference_output b/Fortran/UnitTests/fcvs21_f95/FM701.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM701.reference_output @@ -0,0 +1,63 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM701BEGIN* TEST RESULTS - FM701 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 35 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + + ------------------------------------------------------------------------------- + + 35 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 35 OF 35 TESTS EXECUTED + + *FM701END* END OF TEST - FM701 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM710.f b/Fortran/UnitTests/fcvs21_f95/FM710.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM710.f @@ -0,0 +1,553 @@ + PROGRAM FM710 00010710 +C 00020710 +C THIS ROUTINE TESTS SUBSCRIPT EXPRESSIONS AND ANS REF. 00030710 +C CHARACTER SUBSTRINGS. 5.4.2, 5.4.300040710 +C 5.7.1, 5.7.200050710 +C 00060710 +C THIS ROUTINE ASSUMES THE INTRINSIC FUNCTIONS 00070710 +C INT AND IABS ARE WORKING. 00080710 +C 00090710 +CBB** ********************** BBCCOMNT **********************************00100710 +C**** 00110710 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120710 +C**** VERSION 2.1 00130710 +C**** 00140710 +C**** 00150710 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160710 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170710 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180710 +C**** BUILDING 225 RM A266 00190710 +C**** GAITHERSBURG, MD 20899 00200710 +C**** 00210710 +C**** 00220710 +C**** 00230710 +CBE** ********************** BBCCOMNT **********************************00240710 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00250710 + IMPLICIT CHARACTER*27 (C) 00260710 +CBB** ********************** BBCINITA **********************************00270710 +C**** SPECIFICATION STATEMENTS 00280710 +C**** 00290710 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00300710 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00310710 +CBE** ********************** BBCINITA **********************************00320710 +C 00330710 + DIMENSION I2N001(2,3), I2N002(3,5), I1N003(-1:8), I2N004(10,4) 00340710 + CHARACTER*10 CVCOMP, CVCORR, CVN001, C2N001(2,4) 00350710 + DATA I2N001 /1,2,3,4,5,6/ 00360710 + DATA I2N002 /11,21,31,12,22,32,13,23,33,14,24,34,15,25,35/ 00370710 + DATA I1N003 /1,2,3,4,5,6,7,8,9,10/ 00380710 + DATA I2N004 / 10, 9, 8, 7, 6, 5, 4, 3, 2, 1, 00390710 + 1 4,-2, 6,-3, 8,-4,10,-5, 2,-1, 00400710 + 2 1, 3, 5, 7, 9, 2, 4, 6, 8, 10, 00410710 + 3 -10,-9,-8,-7,-6,-5,-4,-3,-2,-1 / 00420710 + DATA C2N001 /'11FIRSTELE','21SECONDXX','12THIRDXYZ','22FOURTHWW', 00430710 + 1 '13FIFTHABC','23SIXTHIJK','14SEVENTHH','24EIGHTHUV'/ 00440710 +C 00450710 +C 00460710 +CBB** ********************** BBCINITB **********************************00470710 +C**** INITIALIZE SECTION 00480710 + DATA ZVERS, ZVERSD, ZDATE 00490710 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00500710 + DATA ZCOMPL, ZNAME, ZTAPE 00510710 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00520710 + DATA ZPROJ, ZTAPED, ZPROG 00530710 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00540710 + DATA REMRKS /' '/ 00550710 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00560710 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00570710 +C**** 00580710 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00590710 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00600710 +CZ03 ZPROG = 'PROGRAM NAME' 00610710 +CZ04 ZDATE = 'DATE OF TEST' 00620710 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00630710 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00640710 +CZ07 ZNAME = 'NAME OF USER' 00650710 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00660710 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00670710 +C 00680710 + IVPASS = 0 00690710 + IVFAIL = 0 00700710 + IVDELE = 0 00710710 + IVINSP = 0 00720710 + IVTOTL = 0 00730710 + IVTOTN = 0 00740710 + ICZERO = 0 00750710 +C 00760710 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00770710 + I01 = 05 00780710 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00790710 + I02 = 06 00800710 +C 00810710 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00820710 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00830710 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00840710 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00850710 +C 00860710 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00870710 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00880710 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00890710 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00900710 +C 00910710 +CBE** ********************** BBCINITB **********************************00920710 + ZPROG='FM710' 00930710 + IVTOTL = 19 00940710 +CBB** ********************** BBCHED0A **********************************00950710 +C**** 00960710 +C**** WRITE REPORT TITLE 00970710 +C**** 00980710 + WRITE (I02, 90002) 00990710 + WRITE (I02, 90006) 01000710 + WRITE (I02, 90007) 01010710 + WRITE (I02, 90008) ZVERS, ZVERSD 01020710 + WRITE (I02, 90009) ZPROG, ZPROG 01030710 + WRITE (I02, 90010) ZDATE, ZCOMPL 01040710 +CBE** ********************** BBCHED0A **********************************01050710 +CBB** ********************** BBCHED0B **********************************01060710 +C**** WRITE DETAIL REPORT HEADERS 01070710 +C**** 01080710 + WRITE (I02,90004) 01090710 + WRITE (I02,90004) 01100710 + WRITE (I02,90013) 01110710 + WRITE (I02,90014) 01120710 + WRITE (I02,90015) IVTOTL 01130710 +CBE** ********************** BBCHED0B **********************************01140710 +C 01150710 +C TESTS 1-2 - SUBSCRIPT EXPRESSION TO IDENTIFY VARIOUS 01160710 +C ARRAY ELEMENTS 01170710 +C 01180710 +C 01190710 +CT001* TEST 001 **** FCVS PROGRAM 710 **** 01200710 +C 01210710 +C TEST 001 ARRAY ELEMENT REFERENCE 01220710 +C 01230710 + IVTNUM = 1 01240710 + IVCOMP = 0 01250710 + IVCORR = 34 01260710 + IVCOMP = I2N002(I2N001(1,2),I2N001(2,3)/2 + 1) 01270710 +40010 IF (IVCOMP - 34) 20010, 10010, 20010 01280710 +10010 IVPASS = IVPASS + 1 01290710 + WRITE (I02,80002) IVTNUM 01300710 + GO TO 0011 01310710 +20010 IVFAIL = IVFAIL + 1 01320710 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01330710 + 0011 CONTINUE 01340710 +C 01350710 +CT002* TEST 002 **** FCVS PROGRAM 710 **** 01360710 +C 01370710 +C TEST 002 FUNCTION REFERENCE 01380710 +C 01390710 + IVTNUM = 2 01400710 + RVD001 = 2.64 01410710 + IVCOMP = 0 01420710 + IVCORR = 25 01430710 + IVCOMP = I2N002(INT(RVD001), 19 - IABS(-7)*2) 01440710 +40020 IF (IVCOMP - 25) 20020, 10020, 20020 01450710 +10020 IVPASS = IVPASS + 1 01460710 + WRITE (I02,80002) IVTNUM 01470710 + GO TO 0021 01480710 +20020 IVFAIL = IVFAIL + 1 01490710 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01500710 + 0021 CONTINUE 01510710 +C 01520710 +C TESTS 3-7 - TEST SUBSCRIPT VALUE IN IDENTIFYING 01530710 +C ARRAY ELEMENTS 01540710 +C 01550710 +CT003* TEST 003 **** FCVS PROGRAM 710 **** 01560710 +C 01570710 +C TEST 003 RANGE 01580710 +C 01590710 + IVTNUM = 3 01600710 + WRITE (I02, 80004) IVTNUM 01610710 + WRITE (I02, 80020) 01620710 + WRITE (I02, 70030) (I1N003(IVN001), IVN001=5,8) 01630710 +70030 FORMAT (" ",26X,4I4) 01640710 + IVINSP = IVINSP + 1 01650710 + WRITE (I02, 80022) 01660710 + WRITE (I02, 70031) 01670710 +70031 FORMAT (" ",26X," 7 8 9 10" ) 01680710 +C 01690710 +CT004* TEST 004 **** FCVS PROGRAM 710 **** 01700710 +C 01710710 +C TEST 004 SINGLE ELEMENT 01720710 +C 01730710 + IVTNUM = 4 01740710 + IVCOMP = 0 01750710 + IVCORR = 4 01760710 + IVCOMP = I1N003(2) 01770710 +40040 IF (IVCOMP - 4) 20040, 10040, 20040 01780710 +10040 IVPASS = IVPASS + 1 01790710 + WRITE (I02,80002) IVTNUM 01800710 + GO TO 0041 01810710 +20040 IVFAIL = IVFAIL + 1 01820710 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01830710 + 0041 CONTINUE 01840710 +C 01850710 +CT005* TEST 005 **** FCVS PROGRAM 710 **** 01860710 +C 01870710 +C TEST 005 EXPRESSION 01880710 +C 01890710 + IVTNUM = 5 01900710 + IVN001 = -3 01910710 + IVCOMP = 0 01920710 + IVCORR = 1 01930710 + IVCOMP = I1N003((IVN001+5)*3 - 7) 01940710 +40050 IF (IVCOMP - 1) 20050, 10050, 20050 01950710 +10050 IVPASS = IVPASS + 1 01960710 + WRITE (I02,80002) IVTNUM 01970710 + GO TO 0051 01980710 +20050 IVFAIL = IVFAIL + 1 01990710 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02000710 + 0051 CONTINUE 02010710 +C 02020710 +CT006* TEST 006 **** FCVS PROGRAM 710 **** 02030710 +C 02040710 +C TEST 006 31ST ELEMENT IN 2 DIMENSIONAL, 40 ELEMENT ARRAY 02050710 +C 02060710 + IVTNUM = 6 02070710 + IVCOMP = 0 02080710 + IVCORR = -10 02090710 + IVCOMP = I2N004(1,4) 02100710 +40060 IF (IVCOMP + 10) 20060, 10060, 20060 02110710 +10060 IVPASS = IVPASS + 1 02120710 + WRITE (I02,80002) IVTNUM 02130710 + GO TO 0061 02140710 +20060 IVFAIL = IVFAIL + 1 02150710 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02160710 + 0061 CONTINUE 02170710 +C 02180710 +CT007* TEST 007 **** FCVS PROGRAM 710 **** 02190710 +C 02200710 +C TEST 007 4TH ELEMENT OF FIRST ARRAY EQUAL TO 02210710 +C 11TH ELEMENT OF SECOND ARRAY 02220710 +C 02230710 + IVTNUM = 7 02240710 + IVCOMP = 0 02250710 + IVCORR = 1 02260710 + IF (I1N003(2).EQ.I2N004(1,2)) IVCOMP = 1 02270710 +40070 IF (IVCOMP - 1) 20070, 10070, 20070 02280710 +10070 IVPASS = IVPASS + 1 02290710 + WRITE (I02,80002) IVTNUM 02300710 + GO TO 0071 02310710 +20070 IVFAIL = IVFAIL + 1 02320710 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02330710 + 0071 CONTINUE 02340710 +C 02350710 +C TESTS 8-15 - CHARACTER SUBSTRING NAME 02360710 +C 02370710 +C 02380710 +CT008* TEST 008 **** FCVS PROGRAM 710 **** 02390710 +C 02400710 +C TEST 008 USING LEFT AND RIGHT POSITION OF SUBSTRING 02410710 +C 02420710 + IVTNUM = 8 02430710 + CVCOMP = ' ' 02440710 + IVCOMP = 0 02450710 + CVN001 = 'THIS IS IT' 02460710 + CVCORR = 'HIS ' 02470710 + CVCOMP = CVN001(2:4) 02480710 + IF (CVCOMP .EQ. 'HIS ') IVCOMP = 1 02490710 + IF (IVCOMP - 1) 20080, 10080, 20080 02500710 +10080 IVPASS = IVPASS + 1 02510710 + WRITE (I02,80002) IVTNUM 02520710 + GO TO 0081 02530710 +20080 IVFAIL = IVFAIL + 1 02540710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 02550710 + 0081 CONTINUE 02560710 +C 02570710 +CT009* TEST 009 **** FCVS PROGRAM 710 **** 02580710 +C 02590710 +C TEST 009 LEFT POSITION OMITTED, VALUE OF 1 ASSUMED 02600710 +C 02610710 + IVTNUM = 9 02620710 + CVCOMP = ' ' 02630710 + IVCOMP = 0 02640710 + CVCORR = 'THIS ' 02650710 + CVCOMP = CVN001(:4) 02660710 + IF (CVCOMP .EQ. 'THIS ') IVCOMP = 1 02670710 + IF (IVCOMP - 1) 20090, 10090, 20090 02680710 +10090 IVPASS = IVPASS + 1 02690710 + WRITE (I02,80002) IVTNUM 02700710 + GO TO 0091 02710710 +20090 IVFAIL = IVFAIL + 1 02720710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 02730710 + 0091 CONTINUE 02740710 +C 02750710 +CT010* TEST 010 **** FCVS PROGRAM 710 **** 02760710 +C 02770710 +C TEST 010 RIGHT POSITION OMITTED, RIGHT-HAND END OF STRING ASSUMED 02780710 +C 02790710 + IVTNUM = 10 02800710 + CVCOMP = ' ' 02810710 + IVCOMP = 0 02820710 + CVCORR = 'S IS IT ' 02830710 + CVCOMP = CVN001(4:) 02840710 + IF (CVCOMP .EQ. 'S IS IT ') IVCOMP = 1 02850710 + IF (IVCOMP - 1) 20100, 10100, 20100 02860710 +10100 IVPASS = IVPASS + 1 02870710 + WRITE (I02,80002) IVTNUM 02880710 + GO TO 0101 02890710 +20100 IVFAIL = IVFAIL + 1 02900710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 02910710 + 0101 CONTINUE 02920710 +C 02930710 +CT011* TEST 011 **** FCVS PROGRAM 710 **** 02940710 +C 02950710 +C TEST 011 EXTRACT SUBSTRING FROM ARRAY 02960710 +C 02970710 + IVTNUM = 11 02980710 + CVCOMP = ' ' 02990710 + IVCOMP = 0 03000710 + CVCORR = '12THIR ' 03010710 + CVCOMP = C2N001(1,2)(1:6) 03020710 + IF (CVCOMP .EQ. '12THIR ') IVCOMP = 1 03030710 + IF (IVCOMP - 1) 20110, 10110, 20110 03040710 +10110 IVPASS = IVPASS + 1 03050710 + WRITE (I02,80002) IVTNUM 03060710 + GO TO 0111 03070710 +20110 IVFAIL = IVFAIL + 1 03080710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03090710 + 0111 CONTINUE 03100710 +C 03110710 +CT012* TEST 012 **** FCVS PROGRAM 710 **** 03120710 +C 03130710 +C TEST 012 ENTIRE SUBSTRING 03140710 +C 03150710 + IVTNUM = 12 03160710 + CVCOMP = ' ' 03170710 + IVCOMP = 0 03180710 + CVCORR = 'THIS IS IT' 03190710 + CVCOMP = CVN001(:) 03200710 + IF (CVCOMP .EQ. 'THIS IS IT') IVCOMP = 1 03210710 + IF (IVCOMP - 1) 20120, 10120, 20120 03220710 +10120 IVPASS = IVPASS + 1 03230710 + WRITE (I02,80002) IVTNUM 03240710 + GO TO 0121 03250710 +20120 IVFAIL = IVFAIL + 1 03260710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03270710 + 0121 CONTINUE 03280710 +C 03290710 +CT013* TEST 013 **** FCVS PROGRAM 710 **** 03300710 +C 03310710 +C TEST 013 ENTIRE SUBSTRING FROM ARRAY 03320710 +C 03330710 + IVTNUM = 13 03340710 + CVCOMP = ' ' 03350710 + IVCOMP = 0 03360710 + CVCORR = '23SIXTHIJK' 03370710 + CVCOMP = C2N001(2,3)(:) 03380710 + IF (CVCOMP .EQ. '23SIXTHIJK') IVCOMP = 1 03390710 + IF (IVCOMP - 1) 20130, 10130, 20130 03400710 +10130 IVPASS = IVPASS + 1 03410710 + WRITE (I02,80002) IVTNUM 03420710 + GO TO 0131 03430710 +20130 IVFAIL = IVFAIL + 1 03440710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03450710 + 0131 CONTINUE 03460710 +C 03470710 +CT014* TEST 014 **** FCVS PROGRAM 710 **** 03480710 +C 03490710 +C RIGHT POSITION OMITTED USING ARRAY 03500710 +C 03510710 + IVTNUM = 14 03520710 + CVCOMP = ' ' 03530710 + IVCOMP = 0 03540710 + CVCORR = 'EVENTHH ' 03550710 + CVCOMP = C2N001(1,4)(4:) 03560710 + IF (CVCOMP .EQ. 'EVENTHH ') IVCOMP = 1 03570710 + IF (IVCOMP - 1) 20140, 10140, 20140 03580710 +10140 IVPASS = IVPASS + 1 03590710 + WRITE (I02,80002) IVTNUM 03600710 + GO TO 0141 03610710 +20140 IVFAIL = IVFAIL + 1 03620710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03630710 + 0141 CONTINUE 03640710 +C 03650710 +CT015* TEST 015 **** FCVS PROGRAM 710 **** 03660710 +C 03670710 +C LEFT POSITION OMITTED 03680710 +C 03690710 + IVTNUM = 15 03700710 + CVCOMP = ' ' 03710710 + IVCOMP = 0 03720710 + CVCORR = '24EI ' 03730710 + CVCOMP = C2N001(2,4)(:4) 03740710 + IF (CVCOMP .EQ. '24EI ') IVCOMP = 1 03750710 + IF (IVCOMP - 1) 20150, 10150, 20150 03760710 +10150 IVPASS = IVPASS + 1 03770710 + WRITE (I02,80002) IVTNUM 03780710 + GO TO 0151 03790710 +20150 IVFAIL = IVFAIL + 1 03800710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03810710 + 0151 CONTINUE 03820710 +C 03830710 +C TESTS 16-19 - SUBSTRING EXPRESSION 03840710 +C 03850710 +C 03860710 +CT016* TEST 016 **** FCVS PROGRAM 710 **** 03870710 +C 03880710 +C TEST 016 ARITHMETIC EXPRESSION 03890710 +C 03900710 + IVTNUM = 16 03910710 + CVCOMP = ' ' 03920710 + IVCOMP = 0 03930710 + CVCORR = 'HIS IS IT ' 03940710 + CVCOMP = CVN001(2:5*2) 03950710 + IF (CVCOMP .EQ. 'HIS IS IT ') IVCOMP = 1 03960710 + IF (IVCOMP - 1) 20160, 10160, 20160 03970710 +10160 IVPASS = IVPASS + 1 03980710 + WRITE (I02,80002) IVTNUM 03990710 + GO TO 0161 04000710 +20160 IVFAIL = IVFAIL + 1 04010710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04020710 + 0161 CONTINUE 04030710 +C 04040710 +CT017* TEST 017 **** FCVS PROGRAM 710 **** 04050710 +C 04060710 +C TEST 017 SUBSTRING EXPRESSION IN AN ASSIGNMENT STATEMENT 04070710 +C 04080710 + IVTNUM = 17 04090710 + IVN001 = 5 04100710 + IVN002 = 8 04110710 + CVCOMP = ' ' 04120710 + IVCOMP = 0 04130710 + CVCORR = 'THISLIKEIT' 04140710 + CVN001(IVN001:IVN002) = 'LIKE' 04150710 + CVCOMP = CVN001 04160710 + IF (CVCOMP .EQ. 'THISLIKEIT') IVCOMP = 1 04170710 + IF (IVCOMP - 1) 20170, 10170, 20170 04180710 +10170 IVPASS = IVPASS + 1 04190710 + WRITE (I02,80002) IVTNUM 04200710 + GO TO 0171 04210710 +20170 IVFAIL = IVFAIL + 1 04220710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04230710 + 0171 CONTINUE 04240710 +C 04250710 +CT018* TEST 018 **** FCVS PROGRAM 710 **** 04260710 +C 04270710 +C TEST 018 SUBSTRING EXPRESSION CONTAINING ARRAY ELEMENT REFERENCE 04280710 +C 04290710 + IVTNUM = 18 04300710 + CVCOMP = ' ' 04310710 + IVCOMP = 0 04320710 + CVCORR = 'HISLIKE ' 04330710 + CVCOMP = CVN001(I2N001(2,1):I2N002(3,5)-27) 04340710 + IF (CVCOMP .EQ. 'HISLIKE ') IVCOMP = 1 04350710 + IF (IVCOMP - 1) 20180, 10180, 20180 04360710 +10180 IVPASS = IVPASS + 1 04370710 + WRITE (I02,80002) IVTNUM 04380710 + GO TO 0181 04390710 +20180 IVFAIL = IVFAIL + 1 04400710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04410710 + 0181 CONTINUE 04420710 +C 04430710 +CT019* TEST 019 **** FCVS PROGRAM 710 **** 04440710 +C 04450710 +C TEST 019 SUBSTRING EXPRESSION CONTAINING FUNCTION REFERENCES 04460710 +C 04470710 + IVTNUM = 19 04480710 + RVD001 = 1.475 04490710 + IVN001 = 1 04500710 + CVCOMP = ' ' 04510710 + IVCOMP = 0 04520710 + CVCORR = 'IFTHABC ' 04530710 + CVCOMP = C2N001(1,3)(INT(RVD001)+3 : (IVN001*5 + 7)/IABS(-6) + 8) 04540710 + IF (CVCOMP .EQ. 'IFTHABC ') IVCOMP = 1 04550710 + IF (IVCOMP - 1) 20190, 10190, 20190 04560710 +10190 IVPASS = IVPASS + 1 04570710 + WRITE (I02,80002) IVTNUM 04580710 + GO TO 0191 04590710 +20190 IVFAIL = IVFAIL + 1 04600710 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04610710 + 0191 CONTINUE 04620710 +C 04630710 +CBB** ********************** BBCSUM0 **********************************04640710 +C**** WRITE OUT TEST SUMMARY 04650710 +C**** 04660710 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04670710 + WRITE (I02, 90004) 04680710 + WRITE (I02, 90014) 04690710 + WRITE (I02, 90004) 04700710 + WRITE (I02, 90020) IVPASS 04710710 + WRITE (I02, 90022) IVFAIL 04720710 + WRITE (I02, 90024) IVDELE 04730710 + WRITE (I02, 90026) IVINSP 04740710 + WRITE (I02, 90028) IVTOTN, IVTOTL 04750710 +CBE** ********************** BBCSUM0 **********************************04760710 +CBB** ********************** BBCFOOT0 **********************************04770710 +C**** WRITE OUT REPORT FOOTINGS 04780710 +C**** 04790710 + WRITE (I02,90016) ZPROG, ZPROG 04800710 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04810710 + WRITE (I02,90019) 04820710 +CBE** ********************** BBCFOOT0 **********************************04830710 +90001 FORMAT (" ",56X,"FM710") 04840710 +90000 FORMAT (" ",50X,"END OF PROGRAM FM710" ) 04850710 +CBB** ********************** BBCFMT0A **********************************04860710 +C**** FORMATS FOR TEST DETAIL LINES 04870710 +C**** 04880710 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04890710 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04900710 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04910710 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04920710 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04930710 + 1I6,/," ",15X,"CORRECT= " ,I6) 04940710 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04950710 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04960710 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04970710 + 1A21,/," ",16X,"CORRECT= " ,A21) 04980710 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04990710 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 05000710 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 05010710 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 05020710 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 05030710 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 05040710 +80050 FORMAT (" ",48X,A31) 05050710 +CBE** ********************** BBCFMT0A **********************************05060710 +CBB** ********************** BBCFMAT1 **********************************05070710 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 05080710 +C**** 05090710 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05100710 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 05110710 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 05120710 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 05130710 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05140710 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05150710 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 05160710 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 05170710 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05180710 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 05190710 + 2"(",F12.5,", ",F12.5,")") 05200710 +CBE** ********************** BBCFMAT1 **********************************05210710 +CBB** ********************** BBCFMT0B **********************************05220710 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 05230710 +C**** 05240710 +90002 FORMAT ("1") 05250710 +90004 FORMAT (" ") 05260710 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )05270710 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05280710 +90008 FORMAT (" ",21X,A13,A17) 05290710 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 05300710 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 05310710 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 05320710 + 1 7X,"REMARKS",24X) 05330710 +90014 FORMAT (" ","----------------------------------------------" , 05340710 + 1 "---------------------------------" ) 05350710 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 05360710 +C**** 05370710 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 05380710 +C**** 05390710 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 05400710 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 05410710 + 1 A13) 05420710 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 05430710 +C**** 05440710 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 05450710 +C**** 05460710 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 05470710 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 05480710 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 05490710 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 05500710 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 05510710 +CBE** ********************** BBCFMT0B **********************************05520710 + END 05530710 diff --git a/Fortran/UnitTests/fcvs21_f95/FM710.reference_output b/Fortran/UnitTests/fcvs21_f95/FM710.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM710.reference_output @@ -0,0 +1,51 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM710BEGIN* TEST RESULTS - FM710 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 19 TESTS + + 1 PASS + 2 PASS + 3 INSPECT + COMPUTED= + 7 8 9 10 + CORRECT= + 7 8 9 10 + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + + ------------------------------------------------------------------------------- + + 18 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 1 TESTS REQUIRE INSPECTION + 19 OF 19 TESTS EXECUTED + + *FM710END* END OF TEST - FM710 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM711.f b/Fortran/UnitTests/fcvs21_f95/FM711.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM711.f @@ -0,0 +1,333 @@ + PROGRAM FM711 00010711 +C 00020711 +C THIS ROUTINE TESTS ADJUSTABLE ARRAYS AND ADJUSTABLE ANS REF.00030711 +C DIMENSIONS, AND THE USE OF ARRAY 5.5.1 00040711 +C NAMES. 5.6 00050711 +C 00060711 +C THIS ROUTINE USES ROUTINES 712-714 AS SUBROUTINES. 00070711 +C 00080711 +CBB** ********************** BBCCOMNT **********************************00090711 +C**** 00100711 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00110711 +C**** VERSION 2.1 00120711 +C**** 00130711 +C**** 00140711 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00150711 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00160711 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00170711 +C**** BUILDING 225 RM A266 00180711 +C**** GAITHERSBURG, MD 20899 00190711 +C**** 00200711 +C**** 00210711 +C**** 00220711 +CBE** ********************** BBCCOMNT **********************************00230711 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00240711 + IMPLICIT CHARACTER*27 (C) 00250711 +CBB** ********************** BBCINITA **********************************00260711 +C**** SPECIFICATION STATEMENTS 00270711 +C**** 00280711 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00290711 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00300711 +CBE** ********************** BBCINITA **********************************00310711 +C 00320711 + INTEGER I2D001(3,5) 00330711 + CHARACTER CVCOMP*20,CVCORR*20,C1N001(3)*5,C1N002(4)*5,CVN001*10 00340711 + COMMON ICC001, ICC002 00350711 + DATA I2D001 / 11,21,31,12,22,32,13,23,33,14,24,34,15,25,35 / 00360711 + DATA C1N001 / '-3412', ' 108', '+9792' / 00370711 + DATA C1N002 / '( "I/', 'O TES', 'T: ",', ' A10)' / 00380711 +C 00390711 +C 00400711 +CBB** ********************** BBCINITB **********************************00410711 +C**** INITIALIZE SECTION 00420711 + DATA ZVERS, ZVERSD, ZDATE 00430711 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00440711 + DATA ZCOMPL, ZNAME, ZTAPE 00450711 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00460711 + DATA ZPROJ, ZTAPED, ZPROG 00470711 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00480711 + DATA REMRKS /' '/ 00490711 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00500711 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00510711 +C**** 00520711 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00530711 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00540711 +CZ03 ZPROG = 'PROGRAM NAME' 00550711 +CZ04 ZDATE = 'DATE OF TEST' 00560711 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00570711 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00580711 +CZ07 ZNAME = 'NAME OF USER' 00590711 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00600711 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00610711 +C 00620711 + IVPASS = 0 00630711 + IVFAIL = 0 00640711 + IVDELE = 0 00650711 + IVINSP = 0 00660711 + IVTOTL = 0 00670711 + IVTOTN = 0 00680711 + ICZERO = 0 00690711 +C 00700711 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00710711 + I01 = 05 00720711 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00730711 + I02 = 06 00740711 +C 00750711 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00760711 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00770711 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00780711 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00790711 +C 00800711 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00810711 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00820711 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00830711 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00840711 +C 00850711 +CBE** ********************** BBCINITB **********************************00860711 + ZPROG='FM711' 00870711 + IVTOTL = 5 00880711 +CBB** ********************** BBCHED0A **********************************00890711 +C**** 00900711 +C**** WRITE REPORT TITLE 00910711 +C**** 00920711 + WRITE (I02, 90002) 00930711 + WRITE (I02, 90006) 00940711 + WRITE (I02, 90007) 00950711 + WRITE (I02, 90008) ZVERS, ZVERSD 00960711 + WRITE (I02, 90009) ZPROG, ZPROG 00970711 + WRITE (I02, 90010) ZDATE, ZCOMPL 00980711 +CBE** ********************** BBCHED0A **********************************00990711 +CBB** ********************** BBCHED0B **********************************01000711 +C**** WRITE DETAIL REPORT HEADERS 01010711 +C**** 01020711 + WRITE (I02,90004) 01030711 + WRITE (I02,90004) 01040711 + WRITE (I02,90013) 01050711 + WRITE (I02,90014) 01060711 + WRITE (I02,90015) IVTOTL 01070711 +CBE** ********************** BBCHED0B **********************************01080711 + ICC001 = 3 01090711 + ICC002 = 4 01100711 +C 01110711 +C TESTS 1-2 - TEST ADJUSTABLE ARRAYS WHERE THE LOWER AND/OR UPPER 01120711 +C BOUNDS ARE ARGUMENTS OF A SUBROUTINE OR IN COMMON. 01130711 +C 01140711 +C 01150711 +CT001* TEST 001 **** FCVS PROGRAM 711 **** 01160711 +C 01170711 + IVTNUM = 1 01180711 + IVCOMP = 0 01190711 + IVCORR = 24 01200711 + CALL SN712(3,5,I2D001,IVCOMP) 01210711 +40010 IF (IVCOMP - 24) 20010, 10010, 20010 01220711 +10010 IVPASS = IVPASS + 1 01230711 + WRITE (I02,80002) IVTNUM 01240711 + GO TO 0011 01250711 +20010 IVFAIL = IVFAIL + 1 01260711 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01270711 + 0011 CONTINUE 01280711 +C 01290711 +CT002* TEST 002 **** FCVS PROGRAM 711 **** 01300711 +C 01310711 + IVTNUM = 2 01320711 + IVCOMP = 0 01330711 + IVCORR = 113 01340711 + CALL SN713(1,I2D001,IVCOMP) 01350711 +40020 IF (IVCOMP - 113) 20020, 10020, 20020 01360711 +10020 IVPASS = IVPASS + 1 01370711 + WRITE (I02,80002) IVTNUM 01380711 + GO TO 0021 01390711 +20020 IVFAIL = IVFAIL + 1 01400711 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01410711 + 0021 CONTINUE 01420711 +C 01430711 +CT003* TEST 003 **** FCVS PROGRAM 711 **** 01440711 +C 01450711 +C TEST THE ABILITY TO USE AN ARRAY ELEMENT NAME 01460711 +C AS A UNIT IDENTIFIER FOR AN INTERNAL FILE 01470711 +C IN AN INPUT/OUTPUT STATEMENT 01480711 +C 01490711 + IVTNUM = 3 01500711 + IVCOMP = 0 01510711 + IVCORR = 9792 01520711 + READ (UNIT=C1N001(3),FMT=70010) IVCOMP 01530711 +70010 FORMAT (I5) 01540711 +40030 IF (IVCOMP - 9792) 20030, 10030, 20030 01550711 +10030 IVPASS = IVPASS + 1 01560711 + WRITE (I02,80002) IVTNUM 01570711 + GO TO 0031 01580711 +20030 IVFAIL = IVFAIL + 1 01590711 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01600711 + 0031 CONTINUE 01610711 +C 01620711 +CT004* TEST 004 **** FCVS PROGRAM 711 **** 01630711 +C TEST THE ABILITY TO USE AN ARRAY NAME 01640711 +C AS A FORMAT IDENTIFIER IN AN INPUT/OUTPUT 01650711 +C STATEMENT 01660711 +C 01670711 + IVTNUM = 4 01680711 + CVCOMP = ' ' 01690711 + CVCORR = 'I/O TEST: THIS IS IT' 01700711 + CVN001 = 'THIS IS IT' 01710711 + WRITE (UNIT=CVCOMP, FMT=C1N002) CVN001 01720711 + IVCOMP = 0 01730711 + IF (CVCOMP .EQ. 'I/O TEST: THIS IS IT') IVCOMP = 1 01740711 + IF (IVCOMP - 1) 20040, 10040, 20040 01750711 +10040 IVPASS = IVPASS + 1 01760711 + WRITE (I02,80002) IVTNUM 01770711 + GO TO 0041 01780711 +20040 IVFAIL = IVFAIL + 1 01790711 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 01800711 + 0041 CONTINUE 01810711 +C 01820711 +CT005* TEST 005 **** FCVS PROGRAM 711 **** 01830711 +C TEST THE ABILITY TO USE AN ARRAY NAME 01840711 +C IN A SAVE STATMENT 01850711 +C 01860711 + IVTNUM = 5 01870711 + IVCOMP = 0 01880711 + IVCORR = 174 01890711 + CALL SN714(1,IVD001) 01900711 + CALL SN714(2,IVCOMP) 01910711 +40050 IF (IVCOMP - 174) 20050, 10050, 20050 01920711 +10050 IVPASS = IVPASS + 1 01930711 + WRITE (I02,80002) IVTNUM 01940711 + GO TO 0051 01950711 +20050 IVFAIL = IVFAIL + 1 01960711 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01970711 + 0051 CONTINUE 01980711 +C 01990711 +CBB** ********************** BBCSUM0 **********************************02000711 +C**** WRITE OUT TEST SUMMARY 02010711 +C**** 02020711 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02030711 + WRITE (I02, 90004) 02040711 + WRITE (I02, 90014) 02050711 + WRITE (I02, 90004) 02060711 + WRITE (I02, 90020) IVPASS 02070711 + WRITE (I02, 90022) IVFAIL 02080711 + WRITE (I02, 90024) IVDELE 02090711 + WRITE (I02, 90026) IVINSP 02100711 + WRITE (I02, 90028) IVTOTN, IVTOTL 02110711 +CBE** ********************** BBCSUM0 **********************************02120711 +CBB** ********************** BBCFOOT0 **********************************02130711 +C**** WRITE OUT REPORT FOOTINGS 02140711 +C**** 02150711 + WRITE (I02,90016) ZPROG, ZPROG 02160711 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02170711 + WRITE (I02,90019) 02180711 +CBE** ********************** BBCFOOT0 **********************************02190711 +90001 FORMAT (" ",56X,"FM711") 02200711 +90000 FORMAT (" ",50X,"END OF PROGRAM FM711" ) 02210711 +CBB** ********************** BBCFMT0A **********************************02220711 +C**** FORMATS FOR TEST DETAIL LINES 02230711 +C**** 02240711 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02250711 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02260711 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02270711 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02280711 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02290711 + 1I6,/," ",15X,"CORRECT= " ,I6) 02300711 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02310711 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02320711 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02330711 + 1A21,/," ",16X,"CORRECT= " ,A21) 02340711 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02350711 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02360711 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02370711 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02380711 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02390711 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02400711 +80050 FORMAT (" ",48X,A31) 02410711 +CBE** ********************** BBCFMT0A **********************************02420711 +CBB** ********************** BBCFMAT1 **********************************02430711 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02440711 +C**** 02450711 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02460711 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02470711 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02480711 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02490711 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02500711 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02510711 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02520711 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02530711 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02540711 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02550711 + 2"(",F12.5,", ",F12.5,")") 02560711 +CBE** ********************** BBCFMAT1 **********************************02570711 +CBB** ********************** BBCFMT0B **********************************02580711 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02590711 +C**** 02600711 +90002 FORMAT ("1") 02610711 +90004 FORMAT (" ") 02620711 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02630711 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02640711 +90008 FORMAT (" ",21X,A13,A17) 02650711 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02660711 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02670711 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02680711 + 1 7X,"REMARKS",24X) 02690711 +90014 FORMAT (" ","----------------------------------------------" , 02700711 + 1 "---------------------------------" ) 02710711 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02720711 +C**** 02730711 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02740711 +C**** 02750711 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02760711 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02770711 + 1 A13) 02780711 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02790711 +C**** 02800711 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02810711 +C**** 02820711 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02830711 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02840711 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02850711 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02860711 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02870711 +CBE** ********************** BBCFMT0B **********************************02880711 + END 02890711 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 711. 00010712 +C 00020712 +C THIS SUBROUTINE TESTS ADJUSTABLE ARRAYS AND ADJUSTABLE 00030712 +C DIMENSIONS WHERE THE UPPER BOUND 00040712 +C IS A DUMMY ARGUMENT. 00050712 +C 00060712 + SUBROUTINE SN712(IVD001,IVD002,I2D001,IVD003) 00070712 + INTEGER I2D001(1:IVD001,1:IVD002) 00080712 + IVD003 = I2D001(2,4) 00090712 + RETURN 00100712 + END 00110712 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 711. 00010713 +C 00020713 +C THIS SUBROUTINE TESTS ADJUSTABLE ARRAYS AND ADJUSTABLE 00030713 +C DIMENSIONS WHERE THE LOWER AND 00040713 +C UPPER BOUND MAY BE A DUMMY ARGUMENT 00050713 +C AND/OR IN COMMON. 00060713 +C 00070713 + SUBROUTINE SN713(IVD001,I2D001,IVD002) 00080713 + COMMON ICC001, ICC002 00090713 + INTEGER I2D001(IVD001:ICC001,2:ICC002) 00100713 + I2D001(3,4) = 113 00110713 + IVD002 = I2D001(3,4) 00120713 + RETURN 00130713 + END 00140713 + +C THIS SUBROUTINE IS TO BE RUN WITH ROUTINE 711. 00010714 +C 00020714 +C THIS SUBROUTINE TESTS THE USE OF ARRAY NAMES IN A 00030714 +C SAVE STATEMENT. 00040714 +C 00050714 + SUBROUTINE SN714(IVD001, IVD002) 00060714 + INTEGER I2N001(2,2) 00070714 + SAVE I2N001 00080714 + IF (IVD001.GT.1) GO TO 70010 00090714 + I2N001(1,1) = -12 00100714 + I2N001(1,2) = 137 00110714 + I2N001(2,1) = 69 00120714 + I2N001(2,2) = 102 00130714 +70010 IVD002 = I2N001(1,2)+I2N001(2,2)/17-(2*I2N001(1,1)-I2N001(2,1))/3 00140714 + RETURN 00150714 + END 00160714 diff --git a/Fortran/UnitTests/fcvs21_f95/FM711.reference_output b/Fortran/UnitTests/fcvs21_f95/FM711.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM711.reference_output @@ -0,0 +1,33 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM711BEGIN* TEST RESULTS - FM711 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 5 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + + ------------------------------------------------------------------------------- + + 5 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 5 OF 5 TESTS EXECUTED + + *FM711END* END OF TEST - FM711 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM715.f b/Fortran/UnitTests/fcvs21_f95/FM715.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM715.f @@ -0,0 +1,867 @@ + PROGRAM FM715 00010715 +C 00020715 +C THIS ROUTINE TESTS CHARACTER EXPRESSIONS ANS REF. 00030715 +C AND CONCATENATION OPERATIONS USING 6.2, 6.2.1, 00040715 +C ASSIGNMENT STATEMENTS AND RELATIONAL 6.2.2, 6.2.2.2,00050715 +C EXPRESSIONS. 6.6.5 00060715 +C 00070715 +C THIS ROUTINE USES ROUTINES CF716-CF717 AS FUNCTION SUBPROGRAMS. 00080715 +C 00090715 +C THE FUNCTION LEN IS ASSUMED WORKING. 00100715 +C 00110715 +CBB** ********************** BBCCOMNT **********************************00120715 +C**** 00130715 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140715 +C**** VERSION 2.1 00150715 +C**** 00160715 +C**** 00170715 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180715 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00190715 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00200715 +C**** BUILDING 225 RM A266 00210715 +C**** GAITHERSBURG, MD 20899 00220715 +C**** 00230715 +C**** 00240715 +C**** 00250715 +CBE** ********************** BBCCOMNT **********************************00260715 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00270715 + IMPLICIT CHARACTER*27 (C) 00280715 +CBB** ********************** BBCINITA **********************************00290715 +C**** SPECIFICATION STATEMENTS 00300715 +C**** 00310715 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320715 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330715 +CBE** ********************** BBCINITA **********************************00340715 +C 00350715 + CHARACTER CVCOMP*65, CVCORR*65, CPN001*5, CPN002*10 00360715 + CHARACTER CVN001*7, CVN002*35, C2N001(2,2)*6, CF716*10 00370715 + CHARACTER*(*) CPN003 00380715 + CHARACTER*2 CVN003, CVN004, CVD005, CF717 00390715 + PARAMETER (CPN001='PQRST', CPN002='EXPRESSION') 00400715 + PARAMETER (CPN003='NOW IS THE TIME FOR ALL GOOD MEN') 00410715 + DATA CVN001 / 'ONE+TWO' / 00420715 + DATA CVN002 / 'THIS-IS-A-LONG-CHARACTER-STRING' / 00430715 + DATA C2N001 / 'ABCDEF', 'GHIJKL', 'MNOPQR', 'STUVWX' / 00440715 +C 00450715 +C 00460715 +CBB** ********************** BBCINITB **********************************00470715 +C**** INITIALIZE SECTION 00480715 + DATA ZVERS, ZVERSD, ZDATE 00490715 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00500715 + DATA ZCOMPL, ZNAME, ZTAPE 00510715 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00520715 + DATA ZPROJ, ZTAPED, ZPROG 00530715 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00540715 + DATA REMRKS /' '/ 00550715 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00560715 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00570715 +C**** 00580715 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00590715 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00600715 +CZ03 ZPROG = 'PROGRAM NAME' 00610715 +CZ04 ZDATE = 'DATE OF TEST' 00620715 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00630715 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00640715 +CZ07 ZNAME = 'NAME OF USER' 00650715 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00660715 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00670715 +C 00680715 + IVPASS = 0 00690715 + IVFAIL = 0 00700715 + IVDELE = 0 00710715 + IVINSP = 0 00720715 + IVTOTL = 0 00730715 + IVTOTN = 0 00740715 + ICZERO = 0 00750715 +C 00760715 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00770715 + I01 = 05 00780715 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00790715 + I02 = 06 00800715 +C 00810715 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00820715 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00830715 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00840715 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00850715 +C 00860715 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00870715 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00880715 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00890715 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00900715 +C 00910715 +CBE** ********************** BBCINITB **********************************00920715 + ZPROG='FM715' 00930715 + IVTOTL = 34 00940715 +CBB** ********************** BBCHED0A **********************************00950715 +C**** 00960715 +C**** WRITE REPORT TITLE 00970715 +C**** 00980715 + WRITE (I02, 90002) 00990715 + WRITE (I02, 90006) 01000715 + WRITE (I02, 90007) 01010715 + WRITE (I02, 90008) ZVERS, ZVERSD 01020715 + WRITE (I02, 90009) ZPROG, ZPROG 01030715 + WRITE (I02, 90010) ZDATE, ZCOMPL 01040715 +CBE** ********************** BBCHED0A **********************************01050715 +CBB** ********************** BBCHED0B **********************************01060715 +C**** WRITE DETAIL REPORT HEADERS 01070715 +C**** 01080715 + WRITE (I02,90004) 01090715 + WRITE (I02,90004) 01100715 + WRITE (I02,90013) 01110715 + WRITE (I02,90014) 01120715 + WRITE (I02,90015) IVTOTL 01130715 +CBE** ********************** BBCHED0B **********************************01140715 +C 01150715 +C TESTS 1-12 - CHARACTER EXPRESSIONS 01160715 +C 01170715 +C 01180715 +CT001* TEST 001 **** FCVS PROGRAM 715 **** 01190715 +C 01200715 +C CHARACTER CONSTANT IN AN ASSIGNMENT STATEMENT 01210715 +C 01220715 + IVTNUM = 1 01230715 + CVCOMP = ' ' 01240715 + IVCOMP = 0 01250715 + CVCORR = 'CONSTANT' 01260715 + CVCOMP = 'CONSTANT' 01270715 + IF (CVCOMP .EQ. 'CONSTANT') IVCOMP = 1 01280715 + IF (IVCOMP - 1) 20010, 10010, 20010 01290715 +10010 IVPASS = IVPASS + 1 01300715 + WRITE (I02,80002) IVTNUM 01310715 + GO TO 0011 01320715 +20010 IVFAIL = IVFAIL + 1 01330715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 01340715 + 0011 CONTINUE 01350715 +C 01360715 +CT002* TEST 002 **** FCVS PROGRAM 715 **** 01370715 +C 01380715 +C CHARACTER CONSTANT IN AN IF STATEMENT 01390715 +C 01400715 + IVTNUM = 2 01410715 + IVCOMP = 0 01420715 + CVCOMP = ' ' 01430715 + IVCORR = 1 01440715 + CVCOMP = 'RELATIONAL' 01450715 + IF (CVCOMP.EQ.'RELATIONAL') IVCOMP = 1 01460715 +40020 IF (IVCOMP - 1) 20020, 10020, 20020 01470715 +10020 IVPASS = IVPASS + 1 01480715 + WRITE (I02,80002) IVTNUM 01490715 + GO TO 0021 01500715 +20020 IVFAIL = IVFAIL + 1 01510715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01520715 + 0021 CONTINUE 01530715 +C 01540715 +CT003* TEST 003 **** FCVS PROGRAM 715 **** 01550715 +C 01560715 +C SYMBOLIC NAME OF A CHARACTER CONSTANT IN AN ASSIGNMENT STATEMENT 01570715 +C 01580715 + IVTNUM = 3 01590715 + CVCOMP = ' ' 01600715 + IVCOMP = 0 01610715 + CVCORR = 'PQRST' 01620715 + CVCOMP = CPN001 01630715 + IF (CVCOMP .EQ. 'PQRST') IVCOMP = 1 01640715 + IF (IVCOMP - 1) 20030, 10030, 20030 01650715 +10030 IVPASS = IVPASS + 1 01660715 + WRITE (I02,80002) IVTNUM 01670715 + GO TO 0031 01680715 +20030 IVFAIL = IVFAIL + 1 01690715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 01700715 + 0031 CONTINUE 01710715 +C 01720715 +CT004* TEST 004 **** FCVS PROGRAM 715 **** 01730715 +C 01740715 +C SYMBOLIC NAME OF A CHARACTER CONSTANT IN AN IF STATEMENT 01750715 +C 01760715 + IVTNUM = 4 01770715 + IVCOMP = 0 01780715 + CVCOMP = ' ' 01790715 + IVCORR = 1 01800715 + CVCOMP = 'EXPRESSION' 01810715 + IF (CVCOMP.EQ.CPN002) IVCOMP = 1 01820715 +40040 IF (IVCOMP - 1) 20040, 10040, 20040 01830715 +10040 IVPASS = IVPASS + 1 01840715 + WRITE (I02,80002) IVTNUM 01850715 + GO TO 0041 01860715 +20040 IVFAIL = IVFAIL + 1 01870715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01880715 + 0041 CONTINUE 01890715 +C 01900715 +CT005* TEST 005 **** FCVS PROGRAM 715 **** 01910715 +C 01920715 +C CHARACTER VARIABLE IN AN ASSIGNMENT STATEMENT 01930715 +C 01940715 + IVTNUM = 5 01950715 + CVCOMP = ' ' 01960715 + IVCOMP = 0 01970715 + CVCORR = 'ONE+TWO' 01980715 + CVCOMP = CVN001 01990715 + IF (CVCOMP .EQ. 'ONE+TWO') IVCOMP = 1 02000715 + IF (IVCOMP - 1) 20050, 10050, 20050 02010715 +10050 IVPASS = IVPASS + 1 02020715 + WRITE (I02,80002) IVTNUM 02030715 + GO TO 0051 02040715 +20050 IVFAIL = IVFAIL + 1 02050715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 02060715 + 0051 CONTINUE 02070715 +C 02080715 +CT006* TEST 006 **** FCVS PROGRAM 715 **** 02090715 +C 02100715 +C CHARACTER VARIABLE IN AN IF STATEMENT 02110715 +C 02120715 + IVTNUM = 6 02130715 + IVCOMP = 0 02140715 + CVCOMP = ' ' 02150715 + IVCORR = 1 02160715 + CVCOMP = 'THIS-IS-A-LONG-CHARACTER-STRING' 02170715 + IF (CVCOMP.EQ.CVN002) IVCOMP = 1 02180715 +40060 IF (IVCOMP - 1) 20060, 10060, 20060 02190715 +10060 IVPASS = IVPASS + 1 02200715 + WRITE (I02,80002) IVTNUM 02210715 + GO TO 0061 02220715 +20060 IVFAIL = IVFAIL + 1 02230715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02240715 + 0061 CONTINUE 02250715 +C 02260715 +CT007* TEST 007 **** FCVS PROGRAM 715 **** 02270715 +C 02280715 +C CHARACTER ARRAY ELEMENT REFERENCE IN AN ASSIGNMENT STATEMENT 02290715 +C 02300715 + IVTNUM = 7 02310715 + CVCOMP = ' ' 02320715 + CVCORR = 'GHIJKL' 02330715 + IVCOMP = 0 02340715 + CVCOMP = C2N001(2,1) 02350715 + IF (CVCOMP .EQ. 'GHIJKL') IVCOMP = 1 02360715 + IF (IVCOMP - 1) 20070, 10070, 20070 02370715 +10070 IVPASS = IVPASS + 1 02380715 + WRITE (I02,80002) IVTNUM 02390715 + GO TO 0071 02400715 +20070 IVFAIL = IVFAIL + 1 02410715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 02420715 + 0071 CONTINUE 02430715 +C 02440715 +CT008* TEST 008 **** FCVS PROGRAM 715 **** 02450715 +C 02460715 +C CHARACTER ARRAY ELEMENT REFERENCE IN AN IF STATEMENT 02470715 +C 02480715 + IVTNUM = 8 02490715 + CVCOMP = ' ' 02500715 + IVCOMP = 0 02510715 + IVCORR = 1 02520715 + CVCOMP = 'MNOPQR' 02530715 + IF (CVCOMP.EQ.C2N001(1,2)) IVCOMP = 1 02540715 +40080 IF (IVCOMP - 1) 20080, 10080, 20080 02550715 +10080 IVPASS = IVPASS + 1 02560715 + WRITE (I02,80002) IVTNUM 02570715 + GO TO 0081 02580715 +20080 IVFAIL = IVFAIL + 1 02590715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02600715 + 0081 CONTINUE 02610715 +C 02620715 +CT009* TEST 009 **** FCVS PROGRAM 715 **** 02630715 +C 02640715 +C SUBSTRING REFERENCE IN AN ASSIGNMENT STATEMENT 02650715 +C 02660715 + IVTNUM = 9 02670715 + CVCOMP = ' ' 02680715 + IVCOMP = 0 02690715 + CVCORR = 'CTER-STRIN' 02700715 + CVCOMP = CVN002(21:30) 02710715 + IF (CVCOMP .EQ. 'CTER-STRIN') IVCOMP = 1 02720715 + IF (IVCOMP - 1) 20090, 10090, 20090 02730715 +10090 IVPASS = IVPASS + 1 02740715 + WRITE (I02,80002) IVTNUM 02750715 + GO TO 0091 02760715 +20090 IVFAIL = IVFAIL + 1 02770715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 02780715 + 0091 CONTINUE 02790715 +C 02800715 +CT010* TEST 010 **** FCVS PROGRAM 715 **** 02810715 +C 02820715 +C SUBSTRING REFERENCE IN AN IF STATEMENT 02830715 +C 02840715 + IVTNUM = 10 02850715 + IVCOMP = 0 02860715 + CVCOMP = ' ' 02870715 + IVCORR = 1 02880715 + CVCOMP = 'A-LONG-CHA' 02890715 + IF (CVCOMP.EQ.CVN002(9:18)) IVCOMP = 1 02900715 +40100 IF (IVCOMP - 1) 20100, 10100, 20100 02910715 +10100 IVPASS = IVPASS + 1 02920715 + WRITE (I02,80002) IVTNUM 02930715 + GO TO 0101 02940715 +20100 IVFAIL = IVFAIL + 1 02950715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02960715 + 0101 CONTINUE 02970715 +C 02980715 +CT011* TEST 011 **** FCVS PROGRAM 715 **** 02990715 +C 03000715 +C CHARACTER FUNCTION REFERENCE IN AN ASSIGNMENT STATEMENT 03010715 +C 03020715 + IVTNUM = 11 03030715 + CVCOMP = ' ' 03040715 + IVCOMP = 0 03050715 + CVCORR = 'FIRST AID' 03060715 + CVCOMP = CF716(1) 03070715 + IF (CVCOMP .EQ. 'FIRST AID') IVCOMP = 1 03080715 + IF (IVCOMP - 1) 20110, 10110, 20110 03090715 +10110 IVPASS = IVPASS + 1 03100715 + WRITE (I02,80002) IVTNUM 03110715 + GO TO 0111 03120715 +20110 IVFAIL = IVFAIL + 1 03130715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03140715 + 0111 CONTINUE 03150715 +C 03160715 +CT012* TEST 012 **** FCVS PROGRAM 715 **** 03170715 +C 03180715 +C CHARACTER FUNCTION REFERENCE IN AN IF STATEMENT 03190715 +C 03200715 + IVTNUM = 12 03210715 + IVCOMP = 0 03220715 + CVCOMP = ' ' 03230715 + IVCORR = 1 03240715 + CVCOMP = 'SECONDRATE' 03250715 + IF (CVCOMP.EQ.CF716(2)) IVCOMP = 1 03260715 +40120 IF (IVCOMP - 1) 20120, 10120, 20120 03270715 +10120 IVPASS = IVPASS + 1 03280715 + WRITE (I02,80002) IVTNUM 03290715 + GO TO 0121 03300715 +20120 IVFAIL = IVFAIL + 1 03310715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03320715 + 0121 CONTINUE 03330715 +C 03340715 +C TESTS 13-30 CONCATENATION OPERATIONS 03350715 +C 03360715 +C 03370715 +CT013* TEST 013 **** FCVS PROGRAM 715 **** 03380715 +C 03390715 +C CONCATENATE TWO CHARACTER CONSTANTS IN AN ASSIGNMENT STATEMENT 03400715 +C 03410715 + IVTNUM = 13 03420715 + CVCOMP = ' ' 03430715 + IVCOMP = 0 03440715 + CVCORR = 'ABCUVWXYZ' 03450715 + CVCOMP = 'ABC'//'UVWXYZ' 03460715 + IF (CVCOMP .EQ. 'ABCUVWXYZ') IVCOMP = 1 03470715 + IF (IVCOMP - 1) 20130, 10130, 20130 03480715 +10130 IVPASS = IVPASS + 1 03490715 + WRITE (I02,80002) IVTNUM 03500715 + GO TO 0131 03510715 +20130 IVFAIL = IVFAIL + 1 03520715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03530715 + 0131 CONTINUE 03540715 +C 03550715 +CT014* TEST 014 **** FCVS PROGRAM 715 **** 03560715 +C 03570715 +C CONCATENATE TWO CHARACTER CONSTANTS IN AN IF STATEMENT 03580715 +C 03590715 + IVTNUM = 14 03600715 + IVCOMP = 0 03610715 + CVCOMP = ' ' 03620715 + IVCORR = 1 03630715 + CVCOMP = 'THIS-IS-IT' 03640715 + IF (CVCOMP .EQ.'THIS-I'//'S-IT') IVCOMP = 1 03650715 +40140 IF (IVCOMP - 1) 20140, 10140, 20140 03660715 +10140 IVPASS = IVPASS + 1 03670715 + WRITE (I02,80002) IVTNUM 03680715 + GO TO 0141 03690715 +20140 IVFAIL = IVFAIL + 1 03700715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03710715 + 0141 CONTINUE 03720715 +C 03730715 +CT015* TEST 015 **** FCVS PROGRAM 715 **** 03740715 +C 03750715 +C CONCATENATE A SYMBOLIC NAME OF A CHARACTER CONSTANT WITH A LITERAL03760715 +C STRING IN AN ASSIGNMENT STATEMENT 03770715 +C 03780715 + IVTNUM = 15 03790715 + CVCOMP = ' ' 03800715 + IVCOMP = 0 03810715 + CVCORR = 'PQRSTUVWXYZ' 03820715 + CVCOMP = CPN001//'UVWXYZ' 03830715 + IF (CVCOMP .EQ. 'PQRSTUVWXYZ') IVCOMP = 1 03840715 + IF (IVCOMP - 1) 20150, 10150, 20150 03850715 +10150 IVPASS = IVPASS + 1 03860715 + WRITE (I02,80002) IVTNUM 03870715 + GO TO 0151 03880715 +20150 IVFAIL = IVFAIL + 1 03890715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 03900715 + 0151 CONTINUE 03910715 +C 03920715 +CT016* TEST 016 **** FCVS PROGRAM 715 **** 03930715 +C 03940715 +C CONCATENATE A SYMBOLIC NAME OF A CHARACTER CONSTANT WITH A LITERAL03950715 +C STRING IN AN IF STATEMENT 03960715 +C 03970715 + IVTNUM = 16 03980715 + CVCOMP = ' ' 03990715 + IVCOMP = 0 04000715 + IVCORR = 1 04010715 + CVCOMP = 'USEFUL-EXPRESSION' 04020715 + IF (CVCOMP.EQ.'USEFUL-'//CPN002) IVCOMP = 1 04030715 +40160 IF (IVCOMP - 1) 20160, 10160, 20160 04040715 +10160 IVPASS = IVPASS + 1 04050715 + WRITE (I02,80002) IVTNUM 04060715 + GO TO 0161 04070715 +20160 IVFAIL = IVFAIL + 1 04080715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04090715 + 0161 CONTINUE 04100715 +C 04110715 +CT017* TEST 017 **** FCVS PROGRAM 715 **** 04120715 +C 04130715 +C CONCATENATE A CHARACTER VARIABLE WITH A LITERAL STRING IN AN 04140715 +C ASSIGNMENT STATEMENT 04150715 +C 04160715 + IVTNUM = 17 04170715 + CVCOMP = ' ' 04180715 + IVCOMP = 0 04190715 + CVCORR = 'ONE+TWO+THREE' 04200715 + CVCOMP = CVN001//'+THREE' 04210715 + IF (CVCOMP .EQ. 'ONE+TWO+THREE') IVCOMP = 1 04220715 + IF (IVCOMP - 1) 20170, 10170, 20170 04230715 +10170 IVPASS = IVPASS + 1 04240715 + WRITE (I02,80002) IVTNUM 04250715 + GO TO 0171 04260715 +20170 IVFAIL = IVFAIL + 1 04270715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04280715 + 0171 CONTINUE 04290715 +C 04300715 +CT018* TEST 018 **** FCVS PROGRAM 715 **** 04310715 +C 04320715 +C CONCATENATE A CHARACTER VARIABLE WITH A LITERAL STRING IN AN 04330715 +C IF STATEMENT 04340715 +C 04350715 + IVTNUM = 18 04360715 + CVCOMP = ' ' 04370715 + IVCOMP = 0 04380715 + IVCORR = 1 04390715 + CVCOMP = 'ZERO+ONE+TWO' 04400715 + IF (CVCOMP.EQ.'ZERO+'//CVN001) IVCOMP = 1 04410715 +40180 IF (IVCOMP - 1) 20180, 10180, 20180 04420715 +10180 IVPASS = IVPASS + 1 04430715 + WRITE (I02,80002) IVTNUM 04440715 + GO TO 0181 04450715 +20180 IVFAIL = IVFAIL + 1 04460715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04470715 + 0181 CONTINUE 04480715 +C 04490715 +CT019* TEST 019 **** FCVS PROGRAM 715 **** 04500715 +C 04510715 +C CONCATENATE A CHARACTER ARRAY ELEMENT WITH A LITERAL STRING IN AN 04520715 +C ASSIGNMENT STATEMENT 04530715 +C 04540715 + IVTNUM = 19 04550715 + CVCOMP = ' ' 04560715 + IVCOMP = 0 04570715 + CVCORR = 'STUVWXYZ-END' 04580715 + CVCOMP = C2N001(2,2)//'YZ-END' 04590715 + IF (CVCOMP .EQ. 'STUVWXYZ-END') IVCOMP = 1 04600715 + IF (IVCOMP - 1) 20190, 10190, 20190 04610715 +10190 IVPASS = IVPASS + 1 04620715 + WRITE (I02,80002) IVTNUM 04630715 + GO TO 0191 04640715 +20190 IVFAIL = IVFAIL + 1 04650715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 04660715 + 0191 CONTINUE 04670715 +C 04680715 +CT020* TEST 020 **** FCVS PROGRAM 715 **** 04690715 +C 04700715 +C CONCATENATE A CHARACTER ARRAY ELEMENT WITH A LITERAL STRING IN AN 04710715 +C IF STATEMENT 04720715 +C 04730715 + IVTNUM = 20 04740715 + CVCOMP = ' ' 04750715 + IVCOMP = 0 04760715 + IVCORR = 1 04770715 + CVCOMP = 'BEGIN-ABCDEF' 04780715 + IF (CVCOMP.EQ.'BEGIN-'//C2N001(1,1)) IVCOMP = 1 04790715 +40200 IF (IVCOMP - 1) 20200, 10200, 20200 04800715 +10200 IVPASS = IVPASS + 1 04810715 + WRITE (I02,80002) IVTNUM 04820715 + GO TO 0201 04830715 +20200 IVFAIL = IVFAIL + 1 04840715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04850715 + 0201 CONTINUE 04860715 +C 04870715 +CT021* TEST 021 **** FCVS PROGRAM 715 **** 04880715 +C 04890715 +C CONCATENATE SPECIAL CHARACTERS IN AN ASSIGNMENT STATEMENT 04900715 +C 04910715 + IVTNUM = 21 04920715 + CVCOMP = ' ' 04930715 + IVCOMP = 0 04940715 + CVCORR = '=+-*/(),.$'':' 04950715 + CVCOMP = '=+-*/('//'),.$'':' 04960715 + IF (CVCOMP .EQ. '=+-*/(),.$'':') IVCOMP = 1 04970715 + IF (IVCOMP - 1) 20210, 10210, 20210 04980715 +10210 IVPASS = IVPASS + 1 04990715 + WRITE (I02,80002) IVTNUM 05000715 + GO TO 0211 05010715 +20210 IVFAIL = IVFAIL + 1 05020715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05030715 + 0211 CONTINUE 05040715 +C 05050715 +CT022* TEST 022 **** FCVS PROGRAM 715 **** 05060715 +C 05070715 +C CONCATENATE SPECIAL CHARACTERS IN AN IF STATEMENT 05080715 +C 05090715 + IVTNUM = 22 05100715 + IVCOMP = 0 05110715 + CVCOMP = ' ' 05120715 + IVCORR = 1 05130715 + CVCOMP = '$X=(A/B+C):(-''D'')' 05140715 + IF (CVCOMP.EQ.'$X=(A/'//'B+C):(-''D'')') IVCOMP = 1 05150715 +40220 IF (IVCOMP - 1) 20220, 10220, 20220 05160715 +10220 IVPASS = IVPASS + 1 05170715 + WRITE (I02,80002) IVTNUM 05180715 + GO TO 0221 05190715 +20220 IVFAIL = IVFAIL + 1 05200715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05210715 + 0221 CONTINUE 05220715 +C 05230715 +C TESTS 23-24 - TESTS THE INTRINSIC FUNCTION LEN(E) WHERE THE 05240715 +C ARGUMENT IS A CHARACTER EXPRESSION 05250715 +C 05260715 +C 05270715 +CT023* TEST 023 **** FCVS PROGRAM 715 **** 05280715 +C 05290715 +C 05300715 + IVTNUM = 23 05310715 + IVCOMP = 0 05320715 + IVCORR = 15 05330715 + IVCOMP = LEN(CVN001//'EIGHTEEN') 05340715 +40230 IF (IVCOMP - 15) 20230, 10230, 20230 05350715 +10230 IVPASS = IVPASS + 1 05360715 + WRITE (I02,80002) IVTNUM 05370715 + GO TO 0231 05380715 +20230 IVFAIL = IVFAIL + 1 05390715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05400715 + 0231 CONTINUE 05410715 +C 05420715 +CT024* TEST 024 **** FCVS PROGRAM 715 **** 05430715 +C 05440715 +C 05450715 + IVTNUM = 24 05460715 + IVCOMP = 0 05470715 + IVCORR = 30 05480715 + IVCOMP = LEN('THIS-IS-A-LITERAL-STRING'//C2N001(1,2)) 05490715 +40240 IF (IVCOMP - 30) 20240, 10240, 20240 05500715 +10240 IVPASS = IVPASS + 1 05510715 + WRITE (I02,80002) IVTNUM 05520715 + GO TO 0241 05530715 +20240 IVFAIL = IVFAIL + 1 05540715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05550715 + 0241 CONTINUE 05560715 +C 05570715 +CT025* TEST 025 **** FCVS PROGRAM 715 **** 05580715 +C 05590715 +C CONCATENATE A SUBSTRING WITH A LITERAL STRING IN AN ASSIGNMENT 05600715 +C STATEMENT 05610715 +C 05620715 + IVTNUM = 25 05630715 + CVCOMP = ' ' 05640715 + IVCOMP = 0 05650715 + CVCORR = 'IS-A-LONG-ARRAY' 05660715 + CVCOMP = CVN002(6:15)//'ARRAY' 05670715 + IF (CVCOMP .EQ. 'IS-A-LONG-ARRAY') IVCOMP = 1 05680715 + IF (IVCOMP - 1) 20250, 10250, 20250 05690715 +10250 IVPASS = IVPASS + 1 05700715 + WRITE (I02,80002) IVTNUM 05710715 + GO TO 0251 05720715 +20250 IVFAIL = IVFAIL + 1 05730715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 05740715 + 0251 CONTINUE 05750715 +C 05760715 +CT026* TEST 026 **** FCVS PROGRAM 715 **** 05770715 +C 05780715 +C CONCATENATE A SUBSTRING WITH A LITERAL STRING IN AN IF 05790715 +C STATEMENT 05800715 +C 05810715 + IVTNUM = 26 05820715 + IVCOMP = 0 05830715 + CVCOMP = ' ' 05840715 + IVCORR = 1 05850715 + CVCOMP = 'A-LONG-CHARTER-PLANE' 05860715 + IF (CVCOMP.EQ.CVN002(9:19)//'TER-PLANE') IVCOMP = 1 05870715 +40260 IF (IVCOMP - 1) 20260, 10260, 20260 05880715 +10260 IVPASS = IVPASS + 1 05890715 + WRITE (I02,80002) IVTNUM 05900715 + GO TO 0261 05910715 +20260 IVFAIL = IVFAIL + 1 05920715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05930715 + 0261 CONTINUE 05940715 +C 05950715 +CT027* TEST 027 **** FCVS PROGRAM 715 **** 05960715 +C 05970715 +C CONCATENATE A CHARACTER FUNCTION REFERENCE WITH A LITERAL STRING 05980715 +C 05990715 + IVTNUM = 27 06000715 + CVCOMP = ' ' 06010715 + IVCOMP = 0 06020715 + CVCORR = 'THIRDCLASSMAIL' 06030715 + CVCOMP = CF716(3)//'MAIL' 06040715 + IF (CVCOMP .EQ. 'THIRDCLASSMAIL') IVCOMP = 1 06050715 + IF (IVCOMP - 1) 20270, 10270, 20270 06060715 +10270 IVPASS = IVPASS + 1 06070715 + WRITE (I02,80002) IVTNUM 06080715 + GO TO 0271 06090715 +20270 IVFAIL = IVFAIL + 1 06100715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06110715 + 0271 CONTINUE 06120715 +C 06130715 +CT028* TEST 028 **** FCVS PROGRAM 715 **** 06140715 +C 06150715 +C CONCATENATE A CHARACTER ARRAY ELEMENT WITH A CHARACTER FUNCTION RE06160715 +C 06170715 + IVTNUM = 28 06180715 + CVCOMP = ' ' 06190715 + IVCOMP = 0 06200715 + CVCORR = 'MNOPQRFIRST AID' 06210715 + CVCOMP = C2N001(1,2)//CF716(1) 06220715 + IF (CVCOMP .EQ. 'MNOPQRFIRST AID') IVCOMP = 1 06230715 + IF (IVCOMP - 1) 20280, 10280, 20280 06240715 +10280 IVPASS = IVPASS + 1 06250715 + WRITE (I02,80002) IVTNUM 06260715 + GO TO 0281 06270715 +20280 IVFAIL = IVFAIL + 1 06280715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06290715 + 0281 CONTINUE 06300715 +C 06310715 +CT029* TEST 029 **** FCVS PROGRAM 715 **** 06320715 +C 06330715 +C CONCATENATE A CHARACTER SUBSTRING WITH A CHARACTER FUNCTION REFERE06340715 +C 06350715 + IVTNUM = 29 06360715 + CVCOMP = ' ' 06370715 + IVCOMP = 0 06380715 + CVCORR = 'G-CHARACSECONDRATE' 06390715 + CVCOMP = CVN002(14:21)//CF716(2) 06400715 + IF (CVCOMP .EQ. 'G-CHARACSECONDRATE') IVCOMP = 1 06410715 + IF (IVCOMP - 1) 20290, 10290, 20290 06420715 +10290 IVPASS = IVPASS + 1 06430715 + WRITE (I02,80002) IVTNUM 06440715 + GO TO 0291 06450715 +20290 IVFAIL = IVFAIL + 1 06460715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 06470715 + 0291 CONTINUE 06480715 +C 06490715 +CT030* TEST 030 **** FCVS PROGRAM 715 **** 06500715 +C 06510715 +C CONCATENATIONS ON BOTH SIDES OF ".EQ." IN AN IF STATEMENT 06520715 +C 06530715 + IVTNUM = 30 06540715 + IVCOMP = 0 06550715 + IVCORR = 1 06560715 + CVN002 = 'STTHIRDCLASS' 06570715 + IF (CPN001//CF716(3).EQ.C2N001(1,2)(4:6)//CVN002) IVCOMP = 1 06580715 +40300 IF (IVCOMP - 1) 20300, 10300, 20300 06590715 +10300 IVPASS = IVPASS + 1 06600715 + WRITE (I02,80002) IVTNUM 06610715 + GO TO 0301 06620715 +20300 IVFAIL = IVFAIL + 1 06630715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06640715 + 0301 CONTINUE 06650715 +C 06660715 +CT031* TEST 031 **** FCVS PROGRAM 715 **** 06670715 +C 06680715 +C CONCATENATE A LITERAL WITH A SYMBOLIC NAME OF A CHARACTER CONSTANT06690715 +C LENGTH IS SPECIFIED BY AN ASTERISK WITH A LITERAL 06700715 +C 06710715 + IVTNUM = 31 06720715 + IVCOMP = 0 06730715 + CVCOMP = ' ' 06740715 + IVCORR = 1 06750715 + CVCOMP = 'NOW IS THE TIME FOR ALL GOOD MENTO COME TO THE AID OF TH06760715 + 1EIR PARTY' 06770715 + IF (CVCOMP.EQ.CPN003//'TO COME TO THE AID OF THEIR PARTY') 06780715 + 1 IVCOMP = 1 06790715 +40310 IF (IVCOMP - 1) 20310, 10310, 20310 06800715 +10310 IVPASS = IVPASS + 1 06810715 + WRITE (I02,80002) IVTNUM 06820715 + GO TO 0311 06830715 +20310 IVFAIL = IVFAIL + 1 06840715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 06850715 + 0311 CONTINUE 06860715 +C 06870715 +CT032* TEST 032 **** FCVS PROGRAM 715 **** 06880715 +C 06890715 +C CHARACTER EXPRESSION CONCATENATED WITH CHARACTER PRIMARY 06900715 +C 06910715 + IVTNUM = 32 06920715 + IVCOMP = 0 06930715 + CVCOMP = ' ' 06940715 + CVCORR = ' ' 06950715 + IVCORR = 1 06960715 + CVCOMP = ('ONE'//'TWO')//'THREE' 06970715 + CVCORR = 'ONE'//'TWO'//'THREE' 06980715 + IF (CVCOMP.EQ.CVCORR) IVCOMP = 1 06990715 +40320 IF (IVCOMP - 1) 20320, 10320, 20320 07000715 +10320 IVPASS = IVPASS + 1 07010715 + WRITE (I02,80002) IVTNUM 07020715 + GO TO 0321 07030715 +20320 IVFAIL = IVFAIL + 1 07040715 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 07050715 + 0321 CONTINUE 07060715 +C 07070715 +C TESTS 33-34 - EVALUATION OF CHARACTER EXPRESSIONS 07080715 +C (PROCESSOR NEEDS TO EVALUATE ONLY AS MUCH OF THE CHARACTER 07090715 +C EXPRESSION AS IS REQUIRED BY THE CONTEXT IN WHICH THE 07100715 +C EXPRESSION APPEARS) 07110715 +C 07120715 +C 07130715 +CT033* TEST 033 **** FCVS PROGRAM 715 **** 07140715 +C 07150715 +C 07160715 + IVTNUM = 33 07170715 + CVCOMP = ' ' 07180715 + IVCOMP = 0 07190715 + CVCORR = 'AB' 07200715 + CVN003 = 'ABC' 07210715 + CVCOMP = CVN003 07220715 + IF (CVCOMP .EQ. 'AB') IVCOMP = 1 07230715 + IF (IVCOMP - 1) 20330, 10330, 20330 07240715 +10330 IVPASS = IVPASS + 1 07250715 + WRITE (I02,80002) IVTNUM 07260715 + GO TO 0331 07270715 +20330 IVFAIL = IVFAIL + 1 07280715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 07290715 + 0331 CONTINUE 07300715 +C 07310715 +CT034* TEST 034 **** FCVS PROGRAM 715 **** 07320715 +C 07330715 +C 07340715 + IVTNUM = 34 07350715 + CVCOMP = ' ' 07360715 + IVCOMP = 0 07370715 + CVCORR = 'LO' 07380715 + CVN004 = 'LONG' 07390715 + CVD005 = 'SHORT' 07400715 + CVN003 = CVN004//CF717(CVD005) 07410715 + CVCOMP = CVN003 07420715 + IF (CVCOMP .EQ. 'LO') IVCOMP = 1 07430715 + IF (IVCOMP - 1) 20340, 10340, 20340 07440715 +10340 IVPASS = IVPASS + 1 07450715 + WRITE (I02,80002) IVTNUM 07460715 + GO TO 0341 07470715 +20340 IVFAIL = IVFAIL + 1 07480715 + WRITE (I02,80018) IVTNUM, CVCOMP, CVCORR 07490715 + 0341 CONTINUE 07500715 +C 07510715 +CBB** ********************** BBCSUM0 **********************************07520715 +C**** WRITE OUT TEST SUMMARY 07530715 +C**** 07540715 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 07550715 + WRITE (I02, 90004) 07560715 + WRITE (I02, 90014) 07570715 + WRITE (I02, 90004) 07580715 + WRITE (I02, 90020) IVPASS 07590715 + WRITE (I02, 90022) IVFAIL 07600715 + WRITE (I02, 90024) IVDELE 07610715 + WRITE (I02, 90026) IVINSP 07620715 + WRITE (I02, 90028) IVTOTN, IVTOTL 07630715 +CBE** ********************** BBCSUM0 **********************************07640715 +CBB** ********************** BBCFOOT0 **********************************07650715 +C**** WRITE OUT REPORT FOOTINGS 07660715 +C**** 07670715 + WRITE (I02,90016) ZPROG, ZPROG 07680715 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 07690715 + WRITE (I02,90019) 07700715 +CBE** ********************** BBCFOOT0 **********************************07710715 +90001 FORMAT (" ",56X,"FM715") 07720715 +90000 FORMAT (" ",50X,"END OF PROGRAM FM715" ) 07730715 +CBB** ********************** BBCFMT0A **********************************07740715 +C**** FORMATS FOR TEST DETAIL LINES 07750715 +C**** 07760715 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 07770715 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 07780715 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 07790715 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 07800715 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 07810715 + 1I6,/," ",15X,"CORRECT= " ,I6) 07820715 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07830715 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 07840715 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07850715 + 1A21,/," ",16X,"CORRECT= " ,A21) 07860715 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 07870715 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 07880715 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 07890715 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 07900715 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 07910715 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 07920715 +80050 FORMAT (" ",48X,A31) 07930715 +CBE** ********************** BBCFMT0A **********************************07940715 +CBB** ********************** BBCFMAT1 **********************************07950715 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 07960715 +C**** 07970715 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07980715 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 07990715 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 08000715 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 08010715 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 08020715 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 08030715 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 08040715 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 08050715 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08060715 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 08070715 + 2"(",F12.5,", ",F12.5,")") 08080715 +CBE** ********************** BBCFMAT1 **********************************08090715 +CBB** ********************** BBCFMT0B **********************************08100715 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 08110715 +C**** 08120715 +90002 FORMAT ("1") 08130715 +90004 FORMAT (" ") 08140715 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )08150715 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08160715 +90008 FORMAT (" ",21X,A13,A17) 08170715 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 08180715 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 08190715 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 08200715 + 1 7X,"REMARKS",24X) 08210715 +90014 FORMAT (" ","----------------------------------------------" , 08220715 + 1 "---------------------------------" ) 08230715 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 08240715 +C**** 08250715 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08260715 +C**** 08270715 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 08280715 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 08290715 + 1 A13) 08300715 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 08310715 +C**** 08320715 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 08330715 +C**** 08340715 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 08350715 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 08360715 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 08370715 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 08380715 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 08390715 +CBE** ********************** BBCFMT0B **********************************08400715 + END 08410715 + +C THIS FUNCTION SUBPROGRAM IS TO BE RUN WITH ROUTINE 715. 00010716 +C 00020716 +C THIS FUNCTION SUBPROGRAM IS USED TO TEST CHARACTER FUNCTION 00030716 +C REFERENCES IN CHARACTER EXPRESSIONS 00040716 +C 00050716 + CHARACTER*10 FUNCTION CF716(IVD001) 00060716 + IF (IVD001 - 2) 70010, 70020, 70030 00070716 +70010 CF716 = 'FIRST AID' 00080716 + RETURN 00090716 +70020 CF716 = 'SECONDRATE' 00100716 + RETURN 00110716 +70030 CF716 = 'THIRDCLASS' 00120716 + RETURN 00130716 + END 00140716 + +C THIS FUNCTION SUBPROGRAM IS TO BE RUN WITH ROUTINE 715. 00010717 +C 00020717 +C THIS FUNCTION SUBPROGRAM IS USED TO TEST CHARACTER FUNCTION 00030717 +C REFERENCES IN CHARACTER EXPRESSIONS 00040717 +C 00050717 + CHARACTER*(*) FUNCTION CF717(CVD001) 00060717 + CHARACTER*(*) CVD001 00070717 + CF717 = CVD001 00080717 + RETURN 00090717 + END 00100717 diff --git a/Fortran/UnitTests/fcvs21_f95/FM715.reference_output b/Fortran/UnitTests/fcvs21_f95/FM715.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM715.reference_output @@ -0,0 +1,62 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM715BEGIN* TEST RESULTS - FM715 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 34 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + + ------------------------------------------------------------------------------- + + 34 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 34 OF 34 TESTS EXECUTED + + *FM715END* END OF TEST - FM715 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM718.f b/Fortran/UnitTests/fcvs21_f95/FM718.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM718.f @@ -0,0 +1,688 @@ + PROGRAM FM718 00010718 +C 00020718 +C THIS ROUTINE TESTS LOGICAL EXPRESSIONS AND ANS REF. 00030718 +C USE OF THE LOGICAL OPERATORS .NOT., .AND., .OR., 6.4, 6.4.2, 00040718 +C .EQV., AND .NEQV. 6.4.3, 6.4.400050718 +C 00060718 +CBB** ********************** BBCCOMNT **********************************00070718 +C**** 00080718 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00090718 +C**** VERSION 2.1 00100718 +C**** 00110718 +C**** 00120718 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00130718 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00140718 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00150718 +C**** BUILDING 225 RM A266 00160718 +C**** GAITHERSBURG, MD 20899 00170718 +C**** 00180718 +C**** 00190718 +C**** 00200718 +CBE** ********************** BBCCOMNT **********************************00210718 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00220718 + IMPLICIT CHARACTER*27 (C) 00230718 +CBB** ********************** BBCINITA **********************************00240718 +C**** SPECIFICATION STATEMENTS 00250718 +C**** 00260718 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00270718 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00280718 +CBE** ********************** BBCINITA **********************************00290718 +C 00300718 + LOGICAL LPN001, LPN002, LPN003, LPN004 00310718 + LOGICAL LVCOMP, LVCORR, LVN001 00320718 + PARAMETER (LPN001 = .TRUE., LPN002 = .FALSE., 00330718 + 1 LPN003 = .TRUE., LPN004 = .FALSE.) 00340718 +C 00350718 +C 00360718 +CBB** ********************** BBCINITB **********************************00370718 +C**** INITIALIZE SECTION 00380718 + DATA ZVERS, ZVERSD, ZDATE 00390718 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00400718 + DATA ZCOMPL, ZNAME, ZTAPE 00410718 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00420718 + DATA ZPROJ, ZTAPED, ZPROG 00430718 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00440718 + DATA REMRKS /' '/ 00450718 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00460718 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00470718 +C**** 00480718 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00490718 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00500718 +CZ03 ZPROG = 'PROGRAM NAME' 00510718 +CZ04 ZDATE = 'DATE OF TEST' 00520718 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00530718 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00540718 +CZ07 ZNAME = 'NAME OF USER' 00550718 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00560718 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00570718 +C 00580718 + IVPASS = 0 00590718 + IVFAIL = 0 00600718 + IVDELE = 0 00610718 + IVINSP = 0 00620718 + IVTOTL = 0 00630718 + IVTOTN = 0 00640718 + ICZERO = 0 00650718 +C 00660718 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00670718 + I01 = 05 00680718 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00690718 + I02 = 06 00700718 +C 00710718 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00720718 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00730718 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00740718 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00750718 +C 00760718 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00770718 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00780718 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00790718 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00800718 +C 00810718 +CBE** ********************** BBCINITB **********************************00820718 + ZPROG='FM718' 00830718 + IVTOTL = 29 00840718 +CBB** ********************** BBCHED0A **********************************00850718 +C**** 00860718 +C**** WRITE REPORT TITLE 00870718 +C**** 00880718 + WRITE (I02, 90002) 00890718 + WRITE (I02, 90006) 00900718 + WRITE (I02, 90007) 00910718 + WRITE (I02, 90008) ZVERS, ZVERSD 00920718 + WRITE (I02, 90009) ZPROG, ZPROG 00930718 + WRITE (I02, 90010) ZDATE, ZCOMPL 00940718 +CBE** ********************** BBCHED0A **********************************00950718 +CBB** ********************** BBCHED0B **********************************00960718 +C**** WRITE DETAIL REPORT HEADERS 00970718 +C**** 00980718 + WRITE (I02,90004) 00990718 + WRITE (I02,90004) 01000718 + WRITE (I02,90013) 01010718 + WRITE (I02,90014) 01020718 + WRITE (I02,90015) IVTOTL 01030718 +CBE** ********************** BBCHED0B **********************************01040718 +C 01050718 +CT001* TEST 001 **** FCVS PROGRAM 718 **** 01060718 +C 01070718 +C LOGICAL EXPRESSION CONTAINING SYMBOLIC NAME OF A LOGICAL CONSTANT 01080718 +C 01090718 + IVTNUM = 1 01100718 + LVCORR = .TRUE. 01110718 + LVCOMP = LPN001 01120718 + IVCOMP = 0 01130718 + IF (LVCOMP) IVCOMP = 1 01140718 + IF (IVCOMP - 1) 20010, 10010, 20010 01150718 +10010 IVPASS = IVPASS + 1 01160718 + WRITE (I02,80002) IVTNUM 01170718 + GO TO 0011 01180718 +20010 IVFAIL = IVFAIL + 1 01190718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01200718 + 0011 CONTINUE 01210718 +C 01220718 +C TESTS 2-3 - TEST LOGICAL EXPRESSIONS INVOLVING .NOT. 01230718 +C 01240718 +C 01250718 +CT002* TEST 002 **** FCVS PROGRAM 718 **** 01260718 +C 01270718 +C 01280718 + IVTNUM = 2 01290718 + LVCORR = .TRUE. 01300718 + LVCOMP = .NOT..FALSE. 01310718 + IVCOMP = 0 01320718 + IF (LVCOMP) IVCOMP = 1 01330718 + IF (IVCOMP - 1) 20020, 10020, 20020 01340718 +10020 IVPASS = IVPASS + 1 01350718 + WRITE (I02,80002) IVTNUM 01360718 + GO TO 0021 01370718 +20020 IVFAIL = IVFAIL + 1 01380718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01390718 + 0021 CONTINUE 01400718 +C 01410718 +CT003* TEST 003 **** FCVS PROGRAM 718 **** 01420718 +C 01430718 +C 01440718 + IVTNUM = 3 01450718 + IVCORR = 1 01460718 + IVCOMP = 0 01470718 + IF (.NOT. LPN002) IVCOMP = 1 01480718 +40030 IF (IVCOMP - 1) 20030, 10030, 20030 01490718 +10030 IVPASS = IVPASS + 1 01500718 + WRITE (I02,80002) IVTNUM 01510718 + GO TO 0031 01520718 +20030 IVFAIL = IVFAIL + 1 01530718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01540718 + 0031 CONTINUE 01550718 +C 01560718 +C TESTS 4-5 - TEST LOGICAL EXPRESSIONS INVOLVING .AND. 01570718 +C 01580718 +C 01590718 +CT004* TEST 004 **** FCVS PROGRAM 718 **** 01600718 +C 01610718 +C 01620718 + IVTNUM = 4 01630718 + LVCORR = .TRUE. 01640718 + LVCOMP = .TRUE..AND.LPN003 01650718 + IVCOMP = 0 01660718 + IF (LVCOMP) IVCOMP = 1 01670718 + IF (IVCOMP - 1) 20040, 10040, 20040 01680718 +10040 IVPASS = IVPASS + 1 01690718 + WRITE (I02,80002) IVTNUM 01700718 + GO TO 0041 01710718 +20040 IVFAIL = IVFAIL + 1 01720718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01730718 + 0041 CONTINUE 01740718 +C 01750718 +CT005* TEST 005 **** FCVS PROGRAM 718 **** 01760718 +C 01770718 +C 01780718 + IVTNUM = 5 01790718 + IVCORR = 1 01800718 + IVCOMP = 0 01810718 + IF (LPN003.AND..TRUE.) IVCOMP = 1 01820718 +40050 IF (IVCOMP - 1) 20050, 10050, 20050 01830718 +10050 IVPASS = IVPASS + 1 01840718 + WRITE (I02,80002) IVTNUM 01850718 + GO TO 0051 01860718 +20050 IVFAIL = IVFAIL + 1 01870718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 01880718 + 0051 CONTINUE 01890718 +C 01900718 +C TESTS 6-7 - TEST LOGICAL EXPRESSIONS INVOLVING .OR. 01910718 +C 01920718 +C 01930718 +CT006* TEST 006 **** FCVS PROGRAM 718 **** 01940718 +C 01950718 +C 01960718 + IVTNUM = 6 01970718 + LVCORR = .TRUE. 01980718 + LVCOMP = .TRUE..OR.LPN004 01990718 + IVCOMP = 0 02000718 + IF (LVCOMP) IVCOMP = 1 02010718 + IF (IVCOMP - 1) 20060, 10060, 20060 02020718 +10060 IVPASS = IVPASS + 1 02030718 + WRITE (I02,80002) IVTNUM 02040718 + GO TO 0061 02050718 +20060 IVFAIL = IVFAIL + 1 02060718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02070718 + 0061 CONTINUE 02080718 +C 02090718 +CT007* TEST 007 **** FCVS PROGRAM 718 **** 02100718 +C 02110718 +C 02120718 + IVTNUM = 7 02130718 + IVCORR = 1 02140718 + IVCOMP = 0 02150718 + IF (LPN001.OR..FALSE.) IVCOMP = 1 02160718 +40070 IF (IVCOMP - 1) 20070, 10070, 20070 02170718 +10070 IVPASS = IVPASS + 1 02180718 + WRITE (I02,80002) IVTNUM 02190718 + GO TO 0071 02200718 +20070 IVFAIL = IVFAIL + 1 02210718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02220718 + 0071 CONTINUE 02230718 +C 02240718 +C TESTS 8-9 - TEST LOGICAL EXPRESSIONS INVOLVING .EQV. 02250718 +C 02260718 +C 02270718 +CT008* TEST 008 **** FCVS PROGRAM 718 **** 02280718 +C 02290718 +C 02300718 + IVTNUM = 8 02310718 + LVCORR = .TRUE. 02320718 + LVCOMP = .FALSE..EQV.LPN002 02330718 + IVCOMP = 0 02340718 + IF (LVCOMP) IVCOMP = 1 02350718 + IF (IVCOMP - 1) 20080, 10080, 20080 02360718 +10080 IVPASS = IVPASS + 1 02370718 + WRITE (I02,80002) IVTNUM 02380718 + GO TO 0081 02390718 +20080 IVFAIL = IVFAIL + 1 02400718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02410718 + 0081 CONTINUE 02420718 +C 02430718 +CT009* TEST 009 **** FCVS PROGRAM 718 **** 02440718 +C 02450718 +C 02460718 + IVTNUM = 9 02470718 + IVCORR = 1 02480718 + IVCOMP = 0 02490718 + IF (LPN003.EQV..TRUE.) IVCOMP = 1 02500718 +40090 IF (IVCOMP - 1) 20090, 10090, 20090 02510718 +10090 IVPASS = IVPASS + 1 02520718 + WRITE (I02,80002) IVTNUM 02530718 + GO TO 0091 02540718 +20090 IVFAIL = IVFAIL + 1 02550718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02560718 + 0091 CONTINUE 02570718 +C 02580718 +C TESTS 10-11 - TEST LOGICAL EXPRESSIONS INVOLVING .NEQV. 02590718 +C 02600718 +C 02610718 +CT010* TEST 010 **** FCVS PROGRAM 718 **** 02620718 +C 02630718 +C 02640718 + IVTNUM = 10 02650718 + LVCORR = .TRUE. 02660718 + LVCOMP = .FALSE..NEQV.LPN001 02670718 + IVCOMP = 0 02680718 + IF (LVCOMP) IVCOMP = 1 02690718 + IF (IVCOMP - 1) 20100, 10100, 20100 02700718 +10100 IVPASS = IVPASS + 1 02710718 + WRITE (I02,80002) IVTNUM 02720718 + GO TO 0101 02730718 +20100 IVFAIL = IVFAIL + 1 02740718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02750718 + 0101 CONTINUE 02760718 +C 02770718 +CT011* TEST 011 **** FCVS PROGRAM 718 **** 02780718 +C 02790718 +C 02800718 + IVTNUM = 11 02810718 + IVCORR = 1 02820718 + IVCOMP = 0 02830718 + IF (LPN003.NEQV..FALSE.) IVCOMP = 1 02840718 +40110 IF (IVCOMP - 1) 20110, 10110, 20110 02850718 +10110 IVPASS = IVPASS + 1 02860718 + WRITE (I02,80002) IVTNUM 02870718 + GO TO 0111 02880718 +20110 IVFAIL = IVFAIL + 1 02890718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 02900718 + 0111 CONTINUE 02910718 +C 02920718 +C TESTS 12-17 - TEST LOGICAL EXPRESSIONS INVOLVING VARIOUS COMBINA- 02930718 +C TIONS OF LOGICAL OPERATORS AND ALSO TEST PRECEDENCE AMONG THE 02940718 +C LOGICAL OPERATORS WITH OR WITHOUT PARENTHESES 02950718 +C 02960718 +C 02970718 +CT012* TEST 012 **** FCVS PROGRAM 718 **** 02980718 +C 02990718 +C 03000718 + IVTNUM = 12 03010718 + LVCORR = .TRUE. 03020718 + LVN001 = .TRUE. 03030718 + LVCOMP = LVN001.EQV.LPN002.AND..TRUE..NEQV.LPN003 03040718 + IVCOMP = 0 03050718 + IF (LVCOMP) IVCOMP = 1 03060718 + IF (IVCOMP - 1) 20120, 10120, 20120 03070718 +10120 IVPASS = IVPASS + 1 03080718 + WRITE (I02,80002) IVTNUM 03090718 + GO TO 0121 03100718 +20120 IVFAIL = IVFAIL + 1 03110718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03120718 + 0121 CONTINUE 03130718 +C 03140718 +CT013* TEST 013 **** FCVS PROGRAM 718 **** 03150718 +C 03160718 +C 03170718 + IVTNUM = 13 03180718 + LVCORR = .FALSE. 03190718 + LVCOMP = (.TRUE..EQV..FALSE.).AND.(LVN001.NEQV.LPN003) 03200718 + IVCOMP = 0 03210718 + IF (LVCOMP) IVCOMP = 1 03220718 + IF (IVCOMP - 0) 20130, 10130, 20130 03230718 +10130 IVPASS = IVPASS + 1 03240718 + WRITE (I02,80002) IVTNUM 03250718 + GO TO 0131 03260718 +20130 IVFAIL = IVFAIL + 1 03270718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03280718 + 0131 CONTINUE 03290718 +C 03300718 +CT014* TEST 014 **** FCVS PROGRAM 718 **** 03310718 +C 03320718 +C 03330718 + IVTNUM = 14 03340718 + LVCORR = .TRUE. 03350718 + LVN001 = .FALSE. 03360718 + LVCOMP = LVN001.EQV.LPN002.AND..NOT.LPN001.OR..FALSE. 03370718 + IVCOMP = 0 03380718 + IF (LVCOMP) IVCOMP = 1 03390718 + IF (IVCOMP - 1) 20140, 10140, 20140 03400718 +10140 IVPASS = IVPASS + 1 03410718 + WRITE (I02,80002) IVTNUM 03420718 + GO TO 0141 03430718 +20140 IVFAIL = IVFAIL + 1 03440718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03450718 + 0141 CONTINUE 03460718 +C 03470718 +CT015* TEST 015 **** FCVS PROGRAM 718 **** 03480718 +C 03490718 +C 03500718 + IVTNUM = 15 03510718 + LVCORR = .FALSE. 03520718 + LVCOMP = (LVN001.EQV.LPN002).AND.(.NOT.LPN001.OR..FALSE.) 03530718 + IVCOMP = 0 03540718 + IF (LVCOMP) IVCOMP = 1 03550718 + IF (IVCOMP - 0) 20150, 10150, 20150 03560718 +10150 IVPASS = IVPASS + 1 03570718 + WRITE (I02,80002) IVTNUM 03580718 + GO TO 0151 03590718 +20150 IVFAIL = IVFAIL + 1 03600718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03610718 + 0151 CONTINUE 03620718 +C 03630718 +CT016* TEST 016 **** FCVS PROGRAM 718 **** 03640718 +C 03650718 +C 03660718 + IVTNUM = 16 03670718 + LVCORR = .TRUE. 03680718 + LVCOMP = LPN001.EQV.LVN001.OR..NOT.LPN003.NEQV..TRUE. 03690718 + IVCOMP = 0 03700718 + IF (LVCOMP) IVCOMP = 1 03710718 + IF (IVCOMP - 1) 20160, 10160, 20160 03720718 +10160 IVPASS = IVPASS + 1 03730718 + WRITE (I02,80002) IVTNUM 03740718 + GO TO 0161 03750718 +20160 IVFAIL = IVFAIL + 1 03760718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03770718 + 0161 CONTINUE 03780718 +C 03790718 +CT017* TEST 017 **** FCVS PROGRAM 718 **** 03800718 +C 03810718 +C 03820718 + IVTNUM = 17 03830718 + LVCORR = .TRUE. 03840718 + LVCOMP = LPN001.AND.(LVN001.OR..NOT.(LPN002.EQV.(LPN003.NEQV. 03850718 + 1 LPN004))) 03860718 + IVCOMP = 0 03870718 + IF (LVCOMP) IVCOMP = 1 03880718 + IF (IVCOMP - 1) 20170, 10170, 20170 03890718 +10170 IVPASS = IVPASS + 1 03900718 + WRITE (I02,80002) IVTNUM 03910718 + GO TO 0171 03920718 +20170 IVFAIL = IVFAIL + 1 03930718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 03940718 + 0171 CONTINUE 03950718 +C 03960718 +C TESTS 18-21 - TEST LOGICAL EXPRESSIONS INVOLOVING .EQV. 03970718 +C 03980718 +C 03990718 +CT018* TEST 018 **** FCVS PROGRAM 718 **** 04000718 +C 04010718 +C 04020718 + IVTNUM = 18 04030718 + LVCORR = .TRUE. 04040718 + LVCOMP = LPN001.EQV.LPN003 04050718 + IVCOMP = 0 04060718 + IF (LVCOMP) IVCOMP = 1 04070718 + IF (IVCOMP - 1) 20180, 10180, 20180 04080718 +10180 IVPASS = IVPASS + 1 04090718 + WRITE (I02,80002) IVTNUM 04100718 + GO TO 0181 04110718 +20180 IVFAIL = IVFAIL + 1 04120718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04130718 + 0181 CONTINUE 04140718 +C 04150718 +CT019* TEST 019 **** FCVS PROGRAM 718 **** 04160718 +C 04170718 +C 04180718 + IVTNUM = 19 04190718 + LVCORR = .FALSE. 04200718 + LVCOMP = LPN001.EQV.LPN002 04210718 + IVCOMP = 0 04220718 + IF (LVCOMP) IVCOMP = 1 04230718 + IF (IVCOMP - 0) 20190, 10190, 20190 04240718 +10190 IVPASS = IVPASS + 1 04250718 + WRITE (I02,80002) IVTNUM 04260718 + GO TO 0191 04270718 +20190 IVFAIL = IVFAIL + 1 04280718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04290718 + 0191 CONTINUE 04300718 +C 04310718 +CT020* TEST 020 **** FCVS PROGRAM 718 **** 04320718 +C 04330718 +C 04340718 + IVTNUM = 20 04350718 + LVCORR = .FALSE. 04360718 + LVCOMP = LPN002.EQV.LPN003 04370718 + IVCOMP = 0 04380718 + IF (LVCOMP) IVCOMP = 1 04390718 + IF (IVCOMP - 0) 20200, 10200, 20200 04400718 +10200 IVPASS = IVPASS + 1 04410718 + WRITE (I02,80002) IVTNUM 04420718 + GO TO 0201 04430718 +20200 IVFAIL = IVFAIL + 1 04440718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04450718 + 0201 CONTINUE 04460718 +C 04470718 +CT021* TEST 021 **** FCVS PROGRAM 718 **** 04480718 +C 04490718 +C 04500718 + IVTNUM = 21 04510718 + LVCORR = .TRUE. 04520718 + LVCOMP = LPN002.EQV.LPN004 04530718 + IVCOMP = 0 04540718 + IF (LVCOMP) IVCOMP = 1 04550718 + IF (IVCOMP - 1) 20210, 10210, 20210 04560718 +10210 IVPASS = IVPASS + 1 04570718 + WRITE (I02,80002) IVTNUM 04580718 + GO TO 0211 04590718 +20210 IVFAIL = IVFAIL + 1 04600718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04610718 + 0211 CONTINUE 04620718 +C 04630718 +C TESTS 22-25 - TEST LOGICAL EXPRESSIONS INVOLVING .NEQV. 04640718 +C 04650718 +C 04660718 +CT022* TEST 022 **** FCVS PROGRAM 718 **** 04670718 +C 04680718 +C 04690718 + IVTNUM = 22 04700718 + LVCORR = .FALSE. 04710718 + LVCOMP = LPN001.NEQV.LPN003 04720718 + IVCOMP = 0 04730718 + IF (LVCOMP) IVCOMP = 1 04740718 + IF (IVCOMP - 0) 20220, 10220, 20220 04750718 +10220 IVPASS = IVPASS + 1 04760718 + WRITE (I02,80002) IVTNUM 04770718 + GO TO 0221 04780718 +20220 IVFAIL = IVFAIL + 1 04790718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04800718 + 0221 CONTINUE 04810718 +C 04820718 +CT023* TEST 023 **** FCVS PROGRAM 718 **** 04830718 +C 04840718 +C 04850718 + IVTNUM = 23 04860718 + LVCORR = .TRUE. 04870718 + LVCOMP = LPN001.NEQV.LPN002 04880718 + IVCOMP = 0 04890718 + IF (LVCOMP) IVCOMP = 1 04900718 + IF (IVCOMP - 1) 20230, 10230, 20230 04910718 +10230 IVPASS = IVPASS + 1 04920718 + WRITE (I02,80002) IVTNUM 04930718 + GO TO 0231 04940718 +20230 IVFAIL = IVFAIL + 1 04950718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 04960718 + 0231 CONTINUE 04970718 +C 04980718 +CT024* TEST 024 **** FCVS PROGRAM 718 **** 04990718 +C 05000718 +C 05010718 + IVTNUM = 24 05020718 + LVCORR = .TRUE. 05030718 + LVCOMP = LPN002.NEQV.LPN003 05040718 + IVCOMP = 0 05050718 + IF (LVCOMP) IVCOMP = 1 05060718 + IF (IVCOMP - 1) 20240, 10240, 20240 05070718 +10240 IVPASS = IVPASS + 1 05080718 + WRITE (I02,80002) IVTNUM 05090718 + GO TO 0241 05100718 +20240 IVFAIL = IVFAIL + 1 05110718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05120718 + 0241 CONTINUE 05130718 +C 05140718 +CT025* TEST 025 **** FCVS PROGRAM 718 **** 05150718 +C 05160718 +C 05170718 + IVTNUM = 25 05180718 + LVCORR = .FALSE. 05190718 + LVCOMP = LPN002.NEQV.LPN004 05200718 + IVCOMP = 0 05210718 + IF (LVCOMP) IVCOMP = 1 05220718 + IF (IVCOMP - 0) 20250, 10250, 20250 05230718 +10250 IVPASS = IVPASS + 1 05240718 + WRITE (I02,80002) IVTNUM 05250718 + GO TO 0251 05260718 +20250 IVFAIL = IVFAIL + 1 05270718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05280718 + 0251 CONTINUE 05290718 +C 05300718 +C TESTS 26-29 TEST LOGICAL CONSTANT EXPRESSIONS USING SYMBOLIC NAMES 05310718 +C OF LOGICAL CONSTANTS 05320718 +C 05330718 +C 05340718 +CT026* TEST 026 **** FCVS PROGRAM 718 **** 05350718 +C 05360718 +C 05370718 + IVTNUM = 26 05380718 + LVCORR = .FALSE. 05390718 + LVCOMP = LPN001.EQV.LPN002.NEQV.LPN004 05400718 + IVCOMP = 0 05410718 + IF (LVCOMP) IVCOMP = 1 05420718 + IF (IVCOMP - 0) 20260, 10260, 20260 05430718 +10260 IVPASS = IVPASS + 1 05440718 + WRITE (I02,80002) IVTNUM 05450718 + GO TO 0261 05460718 +20260 IVFAIL = IVFAIL + 1 05470718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05480718 + 0261 CONTINUE 05490718 +C 05500718 +CT027* TEST 027 **** FCVS PROGRAM 718 **** 05510718 +C 05520718 +C 05530718 + IVTNUM = 27 05540718 + LVCORR = .TRUE. 05550718 + LVCOMP = LPN003.NEQV.LPN001.AND.LPN002 05560718 + IVCOMP = 0 05570718 + IF (LVCOMP) IVCOMP = 1 05580718 + IF (IVCOMP - 1) 20270, 10270, 20270 05590718 +10270 IVPASS = IVPASS + 1 05600718 + WRITE (I02,80002) IVTNUM 05610718 + GO TO 0271 05620718 +20270 IVFAIL = IVFAIL + 1 05630718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05640718 + 0271 CONTINUE 05650718 +C 05660718 +CT028* TEST 028 **** FCVS PROGRAM 718 **** 05670718 +C 05680718 +C 05690718 + IVTNUM = 28 05700718 + LVCORR = .FALSE. 05710718 + LVCOMP = (LPN003.NEQV.LPN001).AND.LPN002 05720718 + IVCOMP = 0 05730718 + IF (LVCOMP) IVCOMP = 1 05740718 + IF (IVCOMP - 0) 20280, 10280, 20280 05750718 +10280 IVPASS = IVPASS + 1 05760718 + WRITE (I02,80002) IVTNUM 05770718 + GO TO 0281 05780718 +20280 IVFAIL = IVFAIL + 1 05790718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05800718 + 0281 CONTINUE 05810718 +C 05820718 +CT029* TEST 029 **** FCVS PROGRAM 718 **** 05830718 +C 05840718 +C 05850718 + IVTNUM = 29 05860718 + LVCORR = .TRUE. 05870718 + LVCOMP = .NOT.(LPN002.EQV.LPN004.AND.LPN001.OR.LPN003) 05880718 + IVCOMP = 0 05890718 + IF (LVCOMP) IVCOMP = 1 05900718 + IF (IVCOMP - 1) 20290, 10290, 20290 05910718 +10290 IVPASS = IVPASS + 1 05920718 + WRITE (I02,80002) IVTNUM 05930718 + GO TO 0291 05940718 +20290 IVFAIL = IVFAIL + 1 05950718 + WRITE (I02,80010) IVTNUM, IVCOMP, IVCORR 05960718 + 0291 CONTINUE 05970718 +C 05980718 +CBB** ********************** BBCSUM0 **********************************05990718 +C**** WRITE OUT TEST SUMMARY 06000718 +C**** 06010718 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 06020718 + WRITE (I02, 90004) 06030718 + WRITE (I02, 90014) 06040718 + WRITE (I02, 90004) 06050718 + WRITE (I02, 90020) IVPASS 06060718 + WRITE (I02, 90022) IVFAIL 06070718 + WRITE (I02, 90024) IVDELE 06080718 + WRITE (I02, 90026) IVINSP 06090718 + WRITE (I02, 90028) IVTOTN, IVTOTL 06100718 +CBE** ********************** BBCSUM0 **********************************06110718 +CBB** ********************** BBCFOOT0 **********************************06120718 +C**** WRITE OUT REPORT FOOTINGS 06130718 +C**** 06140718 + WRITE (I02,90016) ZPROG, ZPROG 06150718 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 06160718 + WRITE (I02,90019) 06170718 +CBE** ********************** BBCFOOT0 **********************************06180718 +90001 FORMAT (" ",56X,"FM718") 06190718 +90000 FORMAT (" ",50X,"END OF PROGRAM FM718" ) 06200718 +CBB** ********************** BBCFMT0A **********************************06210718 +C**** FORMATS FOR TEST DETAIL LINES 06220718 +C**** 06230718 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 06240718 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 06250718 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 06260718 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 06270718 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 06280718 + 1I6,/," ",15X,"CORRECT= " ,I6) 06290718 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06300718 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 06310718 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06320718 + 1A21,/," ",16X,"CORRECT= " ,A21) 06330718 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 06340718 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 06350718 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 06360718 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 06370718 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 06380718 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 06390718 +80050 FORMAT (" ",48X,A31) 06400718 +CBE** ********************** BBCFMT0A **********************************06410718 +CBB** ********************** BBCFMAT1 **********************************06420718 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 06430718 +C**** 06440718 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06450718 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 06460718 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 06470718 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 06480718 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06490718 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06500718 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06510718 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06520718 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06530718 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 06540718 + 2"(",F12.5,", ",F12.5,")") 06550718 +CBE** ********************** BBCFMAT1 **********************************06560718 +CBB** ********************** BBCFMT0B **********************************06570718 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 06580718 +C**** 06590718 +90002 FORMAT ("1") 06600718 +90004 FORMAT (" ") 06610718 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )06620718 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06630718 +90008 FORMAT (" ",21X,A13,A17) 06640718 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 06650718 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 06660718 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 06670718 + 1 7X,"REMARKS",24X) 06680718 +90014 FORMAT (" ","----------------------------------------------" , 06690718 + 1 "---------------------------------" ) 06700718 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 06710718 +C**** 06720718 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 06730718 +C**** 06740718 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 06750718 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 06760718 + 1 A13) 06770718 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 06780718 +C**** 06790718 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 06800718 +C**** 06810718 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 06820718 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 06830718 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 06840718 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 06850718 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 06860718 +CBE** ********************** BBCFMT0B **********************************06870718 + END 06880718 diff --git a/Fortran/UnitTests/fcvs21_f95/FM718.reference_output b/Fortran/UnitTests/fcvs21_f95/FM718.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM718.reference_output @@ -0,0 +1,57 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM718BEGIN* TEST RESULTS - FM718 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 29 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + + ------------------------------------------------------------------------------- + + 29 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 29 OF 29 TESTS EXECUTED + + *FM718END* END OF TEST - FM718 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM722.f b/Fortran/UnitTests/fcvs21_f95/FM722.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM722.f @@ -0,0 +1,504 @@ + PROGRAM FM722 00010722 +C 00020722 +C ************************************************************* 00030722 +C THE FULL LANGUAGE SET ALLOWS DATA TYPES TO BE DECLARED DOUBLE 00040722 +C PRECISION AND COMPLEX. 00050722 +C (NIST TEST/PROGRAM IDENTIFICATION S04AF-2P) 00060722 +C ************************************************************* 00070722 +C REFERENCES. 00080722 +C AMERICAN NATIONAL STANDARD PROGRAMMING LANGUAGE FORTRAN, 00090722 +C X3.9-1978 00100722 +C 00110722 +C SECTION 4 DATA TYPES AND CONSTANTS 00120722 +C PARAGRAPHS: 00130722 +C 00140722 +C 4.1 00150722 +C 4.1.2 00160722 +C 00170722 +C SECTION 8 SPECIFICATION STATEMENTS 00180722 +C PARAGRAPHS: 00190722 +C 8.4.1 00200722 +C 8.6 00210722 +C 00220722 +C TEST DATA TYPES DOUBLE PRECISION AND COMPLEX USING: 00230722 +C 00240722 +C TYP V [,V1] 00250722 +C 00260722 +C TYP = DOUBLE PRECISION OR COMPLEX 00270722 +C V = VARIABLE NAME, ARRAY NAME, ARRAY DECLARATOR, 00280722 +C SYMBOLIC NAME OF A CONSTANT, FUNCTION NAME, 00290722 +C OR DUMMY PROCEDURE NAME 00300722 +C 00310722 +C FM722 USES FUNCTIONS DF723, ZF724 AND SUBROUTINE SN725 00320722 +C **************************************************************** 00330722 +C 00340722 +CBB** ********************** BBCCOMNT **********************************00350722 +C**** 00360722 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00370722 +C**** VERSION 2.1 00380722 +C**** 00390722 +C**** 00400722 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00410722 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00420722 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00430722 +C**** BUILDING 225 RM A266 00440722 +C**** GAITHERSBURG, MD 20899 00450722 +C**** 00460722 +C**** 00470722 +C**** 00480722 +CBE** ********************** BBCCOMNT **********************************00490722 + IMPLICIT DOUBLE PRECISION (D), COMPLEX (Z), LOGICAL (L) 00500722 + IMPLICIT CHARACTER*27 (C) 00510722 +C 00520722 +CBB** ********************** BBCINITA **********************************00530722 +C**** SPECIFICATION STATEMENTS 00540722 +C**** 00550722 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00560722 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00570722 +CBE** ********************** BBCINITA **********************************00580722 + DOUBLE PRECISION NVCOMP,DF723 00590722 + COMPLEX ICP001,I2N002(2),ZF724 00600722 + REAL R2NN02(2) 00610722 + EQUIVALENCE (ZVCOMP,R2NN02) 00620722 + PARAMETER (DPN001=5.834D6,IPN001=2,DCN004=1.456D3) 00630722 + PARAMETER (ICP001=(3.2, 2.3)) 00640722 + DIMENSION D2N001(IPN001) 00650722 + EXTERNAL DF723,ZF724 00660722 + COMMON /BVN001/ DVC006 00670722 + DATA D2N001(1),D2N001(2) / IPN001*DCN004 / 00680722 + DATA I2N002(1),I2N002(2) / IPN001*(3.2, 2.3) / 00690722 + DSN001(DVN003,DVN004) = DVN003 + DVN004 00700722 + DSN006(DVN007,DVN008) = (DSN001(DVN007,DVN007) + DVN008) 00710722 + ZSN001(RVN001,RVN002) = CMPLX(RVN001,RVN002) + 00720722 + 1CMPLX(RVN002,RVN002) 00730722 +C 00740722 +C 00750722 +CBB** ********************** BBCINITB **********************************00760722 +C**** INITIALIZE SECTION 00770722 + DATA ZVERS, ZVERSD, ZDATE 00780722 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00790722 + DATA ZCOMPL, ZNAME, ZTAPE 00800722 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00810722 + DATA ZPROJ, ZTAPED, ZPROG 00820722 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00830722 + DATA REMRKS /' '/ 00840722 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00850722 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00860722 +C**** 00870722 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00880722 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00890722 +CZ03 ZPROG = 'PROGRAM NAME' 00900722 +CZ04 ZDATE = 'DATE OF TEST' 00910722 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00920722 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00930722 +CZ07 ZNAME = 'NAME OF USER' 00940722 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00950722 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00960722 +C 00970722 + IVPASS = 0 00980722 + IVFAIL = 0 00990722 + IVDELE = 0 01000722 + IVINSP = 0 01010722 + IVTOTL = 0 01020722 + IVTOTN = 0 01030722 + ICZERO = 0 01040722 +C 01050722 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01060722 + I01 = 05 01070722 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01080722 + I02 = 06 01090722 +C 01100722 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01110722 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01120722 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01130722 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01140722 +C 01150722 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01160722 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01170722 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01180722 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01190722 +C 01200722 +CBE** ********************** BBCINITB **********************************01210722 + ZPROG='FM722' 01220722 + IVTOTL = 12 01230722 +CBB** ********************** BBCHED0A **********************************01240722 +C**** 01250722 +C**** WRITE REPORT TITLE 01260722 +C**** 01270722 + WRITE (I02, 90002) 01280722 + WRITE (I02, 90006) 01290722 + WRITE (I02, 90007) 01300722 + WRITE (I02, 90008) ZVERS, ZVERSD 01310722 + WRITE (I02, 90009) ZPROG, ZPROG 01320722 + WRITE (I02, 90010) ZDATE, ZCOMPL 01330722 +CBE** ********************** BBCHED0A **********************************01340722 +CBB** ********************** BBCHED0B **********************************01350722 +C**** WRITE DETAIL REPORT HEADERS 01360722 +C**** 01370722 + WRITE (I02,90004) 01380722 + WRITE (I02,90004) 01390722 + WRITE (I02,90013) 01400722 + WRITE (I02,90014) 01410722 + WRITE (I02,90015) IVTOTL 01420722 +CBE** ********************** BBCHED0B **********************************01430722 +C 01440722 +CT001* TEST 001 **** FCVS PROGRAM 722 **** 01450722 +C 01460722 +C TEST 001 IS DESIGNED TO TEST A DOUBLE PRECISION CONSTANT 01470722 +C VALUE SET WITH PARAMETER STATEMENT 01480722 +C 01490722 + IVTNUM = 1 01500722 + DVCOMP=0.0D0 01510722 + DVCOMP=DPN001 01520722 + DVCORR=5.834D6 01530722 + IF (DPN001 - 5.833999997D6) 20010,10010,40010 01540722 +40010 IF (DPN001 - 5.834000003D6) 10010,10010,20010 01550722 +10010 IVPASS = IVPASS + 1 01560722 + WRITE (I02,80002) IVTNUM 01570722 + GO TO 0011 01580722 +20010 IVFAIL = IVFAIL + 1 01590722 + WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 01600722 + 0011 CONTINUE 01610722 +C 01620722 +CT002* TEST 002 **** FCVS PROGRAM 722 **** 01630722 +C 01640722 +C TEST 002 IS DESIGNED TO TEST A DOUBLE PRECISION VARIABLE 01650722 +C 01660722 + IVTNUM = 2 01670722 + DVCOMP=0.0D0 01680722 + NVCOMP=.1212345D2 01690722 + DVCOMP=NVCOMP 01700722 + DVCORR=.1212345D2 01710722 + IF (NVCOMP - .1212344999D2) 20020,40021,40020 01720722 +40020 IF (NVCOMP - .1212345001D2) 40021,40021,20020 01730722 +40021 DVCOMP = DVCOMP + .1212345D2 01740722 + DVCORR=.2424690D2 01750722 + IF (DVCOMP - .2424689998D2) 20020,10020,40022 01760722 +40022 IF (DVCOMP - .2424690002D2) 10020,10020,20020 01770722 +10020 IVPASS = IVPASS + 1 01780722 + WRITE (I02,80002) IVTNUM 01790722 + GO TO 0021 01800722 +20020 IVFAIL = IVFAIL + 1 01810722 + WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 01820722 + 0021 CONTINUE 01830722 +C 01840722 +CT003* TEST 003 **** FCVS PROGRAM 722 **** 01850722 +C 01860722 +C TEST 003 A DOUBLE PRECISION ARRAY 01870722 +C 01880722 + IVTNUM = 3 01890722 + DVCOMP=0.0D0 01900722 + DVCORR=2.912D3 01910722 + DVCOMP=D2N001(1) + D2N001(2) 01920722 + IF (DVCOMP - 2.911999998D3) 20030,10030,40030 01930722 +40030 IF (DVCOMP - 2.912000002D3) 10030,10030,20030 01940722 +10030 IVPASS = IVPASS + 1 01950722 + WRITE (I02,80002) IVTNUM 01960722 + GO TO 0031 01970722 +20030 IVFAIL = IVFAIL + 1 01980722 + WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 01990722 + 0031 CONTINUE 02000722 +C 02010722 +CT004* TEST 004 **** FCVS PROGRAM 722 **** 02020722 +C 02030722 +C TEST 004 IS DESIGNED TO TEST A DOUBLE PRECISION FUNCTION 02040722 +C DF723 02050722 +C 02060722 + IVTNUM = 4 02070722 + DVCOMP=0.0D0 02080722 + DVN009=.1211D2 02090722 + DVCOMP=DF723(DVN009) 02100722 + DVCORR=1.001211D4 02110722 + IF (DVCOMP - 1.001210999D4) 20040,10040,40040 02120722 +40040 IF (DVCOMP - 1.001211001D4) 10040,10040,20040 02130722 +10040 IVPASS = IVPASS + 1 02140722 + WRITE (I02,80002) IVTNUM 02150722 + GO TO 0041 02160722 +20040 IVFAIL = IVFAIL + 1 02170722 + WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 02180722 + 0041 CONTINUE 02190722 +C 02200722 +CT005* TEST 005 **** FCVS PROGRAM 722 **** 02210722 +C 02220722 +C TEST 005 IS DESIGNED TO TEST A DOUBLE PRECISION DUMMY 02230722 +C PROCEDURE (DF723 USED AS DUMMY ARGUMENT FOR SUBROUTINE 02240722 +C FS528 02250722 +C 02260722 + IVTNUM = 5 02270722 + DVCOMP=0.0D0 02280722 + DVCORR=1200000.0D-2 02290722 + DVN009=0.0D0 02300722 + DVN009=10D2 02310722 + CALL SN725(DF723,DVN009) 02320722 + DVCOMP=DVC006 02330722 + IF (DVCOMP - .1199999999D5) 20050,10050,40050 02340722 +40050 IF (DVCOMP - .1200000001D5) 10050,10050,20050 02350722 +10050 IVPASS = IVPASS + 1 02360722 + WRITE (I02,80002) IVTNUM 02370722 + GO TO 0051 02380722 +20050 IVFAIL = IVFAIL + 1 02390722 + WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 02400722 + 0051 CONTINUE 02410722 +C 02420722 +CT006* TEST 006 **** FCVS PROGRAM 722 **** 02430722 +C 02440722 +C TEST 006 DOUBLE PRECISION FUNCTION NAME USING 02450722 +C STATEMENT FUNCTION STATEMENT 02460722 +C 02470722 + IVTNUM = 6 02480722 + DVCOMP=0.0D0 02490722 + DVCORR=20D2 02500722 + DVN009=10D2 02510722 + DVN010=10D2 02520722 + DVCOMP=DSN001(DVN009,DVN010) 02530722 + IF (DVCOMP - 19.99999999D2) 20060,10060,40060 02540722 +40060 IF (DVCOMP - 20.00000001D2) 10060,10060,20060 02550722 +10060 IVPASS = IVPASS + 1 02560722 + WRITE (I02,80002) IVTNUM 02570722 + GO TO 0061 02580722 +20060 IVFAIL = IVFAIL + 1 02590722 + WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 02600722 + 0061 CONTINUE 02610722 +C 02620722 +CT007* TEST 007 **** FCVS PROGRAM 722 **** 02630722 +C 02640722 +C TEST 007 DOUBLE PRECISION FUNCTION NAME USED IN 02650722 +C A STATEMENT FUNCTION STATEMENT AS A DUMMY ARGUMENT 02660722 +C 02670722 + IVTNUM = 7 02680722 + DVCOMP=0.0D0 02690722 + DVCORR=30D2 02700722 + DVN009=10D2 02710722 + DVN010=10D2 02720722 + DVCOMP=DSN006(DVN009,DVN010) 02730722 + IF (DVCOMP - 29.99999998D2) 20070,10070,40070 02740722 +40070 IF (DVCOMP - 30.00000002D2) 10070,10070,20070 02750722 +10070 IVPASS = IVPASS + 1 02760722 + WRITE (I02,80002) IVTNUM 02770722 + GO TO 0071 02780722 +20070 IVFAIL = IVFAIL + 1 02790722 + WRITE (I02,80031) IVTNUM, DVCOMP, DVCORR 02800722 + 0071 CONTINUE 02810722 +C 02820722 +C THE FOLLOWING GROUP OF TESTS ARE DESIGNED TO 02830722 +C TEST COMPLEX DATA TYPES 02840722 +C 02850722 +C 02860722 +CT008* TEST 008 **** FCVS PROGRAM 722 **** 02870722 +C 02880722 +C TEST 008 DATA TYPE CAN BE A COMPLEX VARIABLE 02890722 +C 02900722 + IVTNUM = 8 02910722 + ZVCOMP=(0.0, 0.0) 02920722 + ZVCORR=(1.0, 1.0) 02930722 + ZVN001=(6.5, 2.2) 02940722 + ZVN002=(5.5, 1.2) 02950722 + ZVCOMP=ZVN001-ZVN002 02960722 + IF (R2NN02(1) - 0.9995) 20080,40081,40080 02970722 +40080 IF (R2NN02(1) - 1.0001) 40081,40081,20080 02980722 +40081 IF (R2NN02(2) - 0.9995) 20080,10080,40082 02990722 +40082 IF (R2NN02(2) - 1.0001) 10080,10080,20080 03000722 +10080 IVPASS = IVPASS + 1 03010722 + WRITE (I02,80002) IVTNUM 03020722 + GO TO 0081 03030722 +20080 IVFAIL = IVFAIL + 1 03040722 + WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR 03050722 + 0081 CONTINUE 03060722 +C 03070722 +CT009* TEST 009 **** FCVS PROGRAM 722 **** 03080722 +C 03090722 +C TEST 009 COMPLEX CONSTANT 03100722 +C 03110722 + IVTNUM = 9 03120722 + ZVCOMP=(0.0, 0.0) 03130722 + ZVCORR=(6.4, 4.6) 03140722 + ZVCOMP=ICP001+ICP001 03150722 + IF (R2NN02(1) - 6.3996) 20090,10090,40090 03160722 +40090 IF (R2NN02(1) - 6.4004) 40091,40091,20090 03170722 +40091 IF (R2NN02(2) - 4.5997) 20090,10090,40092 03180722 +40092 IF (R2NN02(2) - 4.6003) 10090,10090,20090 03190722 +10090 IVPASS = IVPASS + 1 03200722 + WRITE (I02,80002) IVTNUM 03210722 + GO TO 0091 03220722 +20090 IVFAIL = IVFAIL + 1 03230722 + WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR 03240722 + 0091 CONTINUE 03250722 +C 03260722 +CT010* TEST 010 **** FCVS PROGRAM 722 **** 03270722 +C 03280722 +C TEST 010 COMPLEX ARRAY 03290722 +C 03300722 + IVTNUM = 10 03310722 + ZVCOMP=(0.0, 0.0) 03320722 + ZVCORR=(6.4, 4.6) 03330722 + ZVCOMP=I2N002(1)+I2N002(2) 03340722 + IF (R2NN02(1) - 6.3996) 20100,10100,40100 03350722 +40100 IF (R2NN02(1) - 6.4004) 40101,40101,20100 03360722 +40101 IF (R2NN02(2) - 4.5997) 20100,10100,40102 03370722 +40102 IF (R2NN02(2) - 4.6003) 10100,10100,20100 03380722 +10100 IVPASS = IVPASS + 1 03390722 + WRITE (I02,80002) IVTNUM 03400722 + GO TO 0101 03410722 +20100 IVFAIL = IVFAIL + 1 03420722 + WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR 03430722 + 0101 CONTINUE 03440722 +C 03450722 +CT011* TEST 011 **** FCVS PROGRAM 722 **** 03460722 +C 03470722 +C TEST 011 COMPLEX FUNCTION NAME (USING STATEMENT FUNCTION) 03480722 +C FUNCTION NAME CAN BE COMPLEX 03490722 +C 03500722 + IVTNUM = 11 03510722 + ZVCORR=(3.0, 4.0) 03520722 + ZVCOMP=(0.0, 0.0) 03530722 + RVN004=1.0 03540722 + RVN005=2.0 03550722 + ZVCOMP=(ZSN001(RVN004,RVN005)) 03560722 + IF (R2NN02(1) - 2.9998) 20110,10110,40110 03570722 +40110 IF (R2NN02(1) - 3.0002) 40111,40111,20110 03580722 +40111 IF (R2NN02(2) - 3.9998) 20110,10110,40112 03590722 +40112 IF (R2NN02(2) - 4.0002) 10110,10110,20110 03600722 +10110 IVPASS = IVPASS + 1 03610722 + WRITE (I02,80002) IVTNUM 03620722 + GO TO 0111 03630722 +20110 IVFAIL = IVFAIL + 1 03640722 + WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR 03650722 + 0111 CONTINUE 03660722 +C 03670722 +CT012* TEST 012 **** FCVS PROGRAM 722 **** 03680722 +C 03690722 +C TEST 012 TEST COMPLEX FUNCTION NAME IN A FUNCTION SUBPROGRAM 03700722 +C 03710722 + IVTNUM = 12 03720722 + ZVCORR=(3.0, 4.0) 03730722 + ZVCOMP=(0.0, 0.0) 03740722 + RVN004=1.0 03750722 + RVN005=2.0 03760722 + ZVCOMP=ZF724(RVN004,RVN005) 03770722 + IF (R2NN02(1) - 2.9998) 20120,10120,40120 03780722 +40120 IF (R2NN02(1) - 3.0002) 40121,40121,20120 03790722 +40121 IF (R2NN02(2) - 3.9998) 20120,10120,40122 03800722 +40122 IF (R2NN02(2) - 4.0002) 10120,10120,20120 03810722 +10120 IVPASS = IVPASS + 1 03820722 + WRITE (I02,80002) IVTNUM 03830722 + GO TO 0121 03840722 +20120 IVFAIL = IVFAIL + 1 03850722 + WRITE (I02,80045) IVTNUM, ZVCOMP, ZVCORR 03860722 + 0121 CONTINUE 03870722 +C 03880722 +CBB** ********************** BBCSUM0 **********************************03890722 +C**** WRITE OUT TEST SUMMARY 03900722 +C**** 03910722 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03920722 + WRITE (I02, 90004) 03930722 + WRITE (I02, 90014) 03940722 + WRITE (I02, 90004) 03950722 + WRITE (I02, 90020) IVPASS 03960722 + WRITE (I02, 90022) IVFAIL 03970722 + WRITE (I02, 90024) IVDELE 03980722 + WRITE (I02, 90026) IVINSP 03990722 + WRITE (I02, 90028) IVTOTN, IVTOTL 04000722 +CBE** ********************** BBCSUM0 **********************************04010722 +CBB** ********************** BBCFOOT0 **********************************04020722 +C**** WRITE OUT REPORT FOOTINGS 04030722 +C**** 04040722 + WRITE (I02,90016) ZPROG, ZPROG 04050722 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04060722 + WRITE (I02,90019) 04070722 +CBE** ********************** BBCFOOT0 **********************************04080722 +90001 FORMAT (" ",56X,"FM722") 04090722 +90000 FORMAT (" ",50X,"END OF PROGRAM FM722" ) 04100722 +CBB** ********************** BBCFMT0A **********************************04110722 +C**** FORMATS FOR TEST DETAIL LINES 04120722 +C**** 04130722 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04140722 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04150722 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04160722 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04170722 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04180722 + 1I6,/," ",15X,"CORRECT= " ,I6) 04190722 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04200722 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04210722 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04220722 + 1A21,/," ",16X,"CORRECT= " ,A21) 04230722 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04240722 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04250722 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04260722 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04270722 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04280722 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04290722 +80050 FORMAT (" ",48X,A31) 04300722 +CBE** ********************** BBCFMT0A **********************************04310722 +CBB** ********************** BBCFMAT1 **********************************04320722 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04330722 +C**** 04340722 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04350722 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04360722 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04370722 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04380722 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04390722 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04400722 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04410722 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04420722 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04430722 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04440722 + 2"(",F12.5,", ",F12.5,")") 04450722 +CBE** ********************** BBCFMAT1 **********************************04460722 +CBB** ********************** BBCFMT0B **********************************04470722 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04480722 +C**** 04490722 +90002 FORMAT ("1") 04500722 +90004 FORMAT (" ") 04510722 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04520722 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04530722 +90008 FORMAT (" ",21X,A13,A17) 04540722 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04550722 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04560722 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04570722 + 1 7X,"REMARKS",24X) 04580722 +90014 FORMAT (" ","----------------------------------------------" , 04590722 + 1 "---------------------------------" ) 04600722 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04610722 +C**** 04620722 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04630722 +C**** 04640722 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04650722 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04660722 + 1 A13) 04670722 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04680722 +C**** 04690722 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04700722 +C**** 04710722 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04720722 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04730722 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04740722 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04750722 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04760722 +CBE** ********************** BBCFMT0B **********************************04770722 + END 04780722 + + DOUBLE PRECISION FUNCTION DF723(DVN008) 00010723 +C THIS FUNCTION IS USED BY PROGRAM FM722 TO TEST 00020723 +C DOUBLE PRECISION FUNCTIONS 00030723 + IMPLICIT DOUBLE PRECISION (D) 00040723 + DF723=DVN008 + 100D2 00050723 + RETURN 00060723 + END 00070723 + + COMPLEX FUNCTION ZF724(RVN006,RVN007) 00010724 +C THIS FUNCTION IS USED BY PROGRAM FM722 TO TEST 00020724 +C COMPLEX FUNCTION NAME 00030724 + IMPLICIT COMPLEX (Z) 00040724 + ZF724= CMPLX(RVN006,RVN007) + CMPLX(RVN007,RVN007) 00050724 + RETURN 00060724 + END 00070724 + + SUBROUTINE SN725(DTINT, DVN008) 00010725 +C THIS ROUTINE IS USED BY PROGRAM FM722 00020725 +C TO TEST A DOUBLE PRECISION FUNCTION NAME USED AS AN 00030725 +C ACTUAL ARGUMENT 00040725 + IMPLICIT DOUBLE PRECISION (D) 00050725 + COMMON /BVN001/ DVC006 00060725 + DVC006=DTINT(DVN008) + 10D2 00070725 + RETURN 00080725 + END 00090725 diff --git a/Fortran/UnitTests/fcvs21_f95/FM722.reference_output b/Fortran/UnitTests/fcvs21_f95/FM722.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM722.reference_output @@ -0,0 +1,40 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM722BEGIN* TEST RESULTS - FM722 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 12 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ------------------------------------------------------------------------------- + + 12 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 12 OF 12 TESTS EXECUTED + + *FM722END* END OF TEST - FM722 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM800.f b/Fortran/UnitTests/fcvs21_f95/FM800.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM800.f @@ -0,0 +1,349 @@ + PROGRAM FM800 + +C***********************************************************************00010800 +C***** FORTRAN 77 00020800 +C***** FM800 YIDINT - (151) 00030800 +C***** 00040800 +C***********************************************************************00050800 +C***** GENERAL PURPOSE ANS REF 00060800 +C***** TEST INTRINSIC FUNCTION IDINT -- 15.3 00070800 +C***** TRUNCATION (SIGN OF A * LARGEST INTEGER LE ABS(A) ) (TABLE 5)00080800 +C***** 00090800 +CBB** ********************** BBCCOMNT **********************************00100800 +C**** 00110800 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120800 +C**** VERSION 2.1 00130800 +C**** 00140800 +C**** 00150800 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160800 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170800 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180800 +C**** BUILDING 225 RM A266 00190800 +C**** GAITHERSBURG, MD 20899 00200800 +C**** 00210800 +C**** 00220800 +C**** 00230800 +CBE** ********************** BBCCOMNT **********************************00240800 +C***** S P E C I F I C A T I O N S SEGMENT 151 00250800 +C***** 00260800 + DOUBLE PRECISION DLAVD, DLBVD 00270800 +C***** 00280800 +CBB** ********************** BBCINITA **********************************00290800 +C**** SPECIFICATION STATEMENTS 00300800 +C**** 00310800 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320800 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330800 +CBE** ********************** BBCINITA **********************************00340800 +CBB** ********************** BBCINITB **********************************00350800 +C**** INITIALIZE SECTION 00360800 + DATA ZVERS, ZVERSD, ZDATE 00370800 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380800 + DATA ZCOMPL, ZNAME, ZTAPE 00390800 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400800 + DATA ZPROJ, ZTAPED, ZPROG 00410800 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420800 + DATA REMRKS /' '/ 00430800 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440800 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450800 +C**** 00460800 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470800 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480800 +CZ03 ZPROG = 'PROGRAM NAME' 00490800 +CZ04 ZDATE = 'DATE OF TEST' 00500800 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510800 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520800 +CZ07 ZNAME = 'NAME OF USER' 00530800 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540800 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550800 +C 00560800 + IVPASS = 0 00570800 + IVFAIL = 0 00580800 + IVDELE = 0 00590800 + IVINSP = 0 00600800 + IVTOTL = 0 00610800 + IVTOTN = 0 00620800 + ICZERO = 0 00630800 +C 00640800 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650800 + I01 = 05 00660800 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670800 + I02 = 06 00680800 +C 00690800 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700800 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710800 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720800 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730800 +C 00740800 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750800 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760800 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770800 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780800 +C 00790800 +CBE** ********************** BBCINITB **********************************00800800 + NUVI = I02 00810800 + IVTOTL = 12 00820800 + ZPROG = 'FM800' 00830800 +CBB** ********************** BBCHED0A **********************************00840800 +C**** 00850800 +C**** WRITE REPORT TITLE 00860800 +C**** 00870800 + WRITE (I02, 90002) 00880800 + WRITE (I02, 90006) 00890800 + WRITE (I02, 90007) 00900800 + WRITE (I02, 90008) ZVERS, ZVERSD 00910800 + WRITE (I02, 90009) ZPROG, ZPROG 00920800 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930800 +CBE** ********************** BBCHED0A **********************************00940800 +C***** 00950800 +C***** HEADER FOR SEGMENT 151 WRITTEN 00960800 + WRITE (NUVI,15101) 00970800 +15101 FORMAT (" ", // 1X,"YIDINT - (151) INTRINSIC FUNCTION--" //17X, 00980800 + 1 "IDINT (TYPE CONVERSION)" //" ANS REF. - 15.3" ) 00990800 +CBB** ********************** BBCHED0B **********************************01000800 +C**** WRITE DETAIL REPORT HEADERS 01010800 +C**** 01020800 + WRITE (I02,90004) 01030800 + WRITE (I02,90004) 01040800 + WRITE (I02,90013) 01050800 + WRITE (I02,90014) 01060800 + WRITE (I02,90015) IVTOTL 01070800 +CBE** ********************** BBCHED0B **********************************01080800 +C***** 01090800 +CT001* TEST 1 THE VALUE ZERO 01100800 + IVTNUM = 1 01110800 + DLBVD = 0.0D0 01120800 + ILAVI = IDINT(DLBVD) 01130800 + IF (ILAVI - 0) 20010, 10010, 20010 01140800 +10010 IVPASS = IVPASS + 1 01150800 + WRITE (NUVI, 80002) IVTNUM 01160800 + GO TO 0011 01170800 +20010 IVFAIL = IVFAIL + 1 01180800 + IVCORR = 0 01190800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01200800 + 0011 CONTINUE 01210800 +CT002* TEST 2 A VALUE IN (0,1) 01220800 + IVTNUM = 2 01230800 + DLBVD = 3.57D-1 01240800 + ILAVI = IDINT(DLBVD) 01250800 + IF (ILAVI - 0) 20020, 10020, 20020 01260800 +10020 IVPASS = IVPASS + 1 01270800 + WRITE (NUVI, 80002) IVTNUM 01280800 + GO TO 0021 01290800 +20020 IVFAIL = IVFAIL + 1 01300800 + IVCORR = 0 01310800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01320800 + 0021 CONTINUE 01330800 +CT003* TEST 3 THE VALUE ONE 01340800 + IVTNUM = 3 01350800 + DLBVD = 1.00001D0 01360800 + ILAVI = IDINT(DLBVD) 01370800 + IF (ILAVI - 1) 20030, 10030, 20030 01380800 +10030 IVPASS = IVPASS + 1 01390800 + WRITE (NUVI, 80002) IVTNUM 01400800 + GO TO 0031 01410800 +20030 IVFAIL = IVFAIL + 1 01420800 + IVCORR = 1 01430800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01440800 + 0031 CONTINUE 01450800 +CT004* TEST 4 A INTEGRAL VALUE OTHER THAN O, 1 01460800 + IVTNUM = 4 01470800 + DLBVD = 6.00001D0 01480800 + ILAVI = IDINT(DLBVD) 01490800 + IF (ILAVI - 6) 20040, 10040, 20040 01500800 +10040 IVPASS = IVPASS + 1 01510800 + WRITE (NUVI, 80002) IVTNUM 01520800 + GO TO 0041 01530800 +20040 IVFAIL = IVFAIL + 1 01540800 + IVCORR = 6 01550800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01560800 + 0041 CONTINUE 01570800 +CT005* TEST 5 A VALUE IN (X,X+1) 01580800 + IVTNUM = 5 01590800 + DLBVD = 0.375D1 01600800 + ILAVI = IDINT(DLBVD) 01610800 + IF (ILAVI - 3) 20050, 10050, 20050 01620800 +10050 IVPASS = IVPASS + 1 01630800 + WRITE (NUVI, 80002) IVTNUM 01640800 + GO TO 0051 01650800 +20050 IVFAIL = IVFAIL + 1 01660800 + IVCORR = 3 01670800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01680800 + 0051 CONTINUE 01690800 +CT006* TEST 6 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1) 01700800 + IVTNUM = 6 01710800 + DLBVD = -0.375D0 01720800 + ILAVI = IDINT(DLBVD) 01730800 + IF (ILAVI - 0) 20060, 10060, 20060 01740800 +10060 IVPASS = IVPASS + 1 01750800 + WRITE (NUVI, 80002) IVTNUM 01760800 + GO TO 0061 01770800 +20060 IVFAIL = IVFAIL + 1 01780800 + IVCORR = 0 01790800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01800800 + 0061 CONTINUE 01810800 +CT007* TEST 7 THE VALUE -1 01820800 + IVTNUM = 7 01830800 + DLBVD = -0.100001D1 01840800 + ILAVI = IDINT(DLBVD) 01850800 + IF (ILAVI + 1) 20070, 10070, 20070 01860800 +10070 IVPASS = IVPASS + 1 01870800 + WRITE (NUVI, 80002) IVTNUM 01880800 + GO TO 0071 01890800 +20070 IVFAIL = IVFAIL + 1 01900800 + IVCORR = -1 01910800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 01920800 + 0071 CONTINUE 01930800 +CT008* TEST 8 A NEGATIVE INTEGRAL VALUE 01940800 + IVTNUM = 8 01950800 + DLBVD = -6.00001D0 01960800 + ILAVI = IDINT(DLBVD) 01970800 + IF (ILAVI + 6) 20080, 10080, 20080 01980800 +10080 IVPASS = IVPASS + 1 01990800 + WRITE (NUVI, 80002) IVTNUM 02000800 + GO TO 0081 02010800 +20080 IVFAIL = IVFAIL + 1 02020800 + IVCORR = -6 02030800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 02040800 + 0081 CONTINUE 02050800 +CT009* TEST 9 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1) 02060800 + IVTNUM = 9 02070800 + DLBVD = -0.375D1 02080800 + ILAVI = IDINT(DLBVD) 02090800 + IF (ILAVI + 3) 20090, 10090, 20090 02100800 +10090 IVPASS = IVPASS + 1 02110800 + WRITE (NUVI, 80002) IVTNUM 02120800 + GO TO 0091 02130800 +20090 IVFAIL = IVFAIL + 1 02140800 + IVCORR = -3 02150800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 02160800 + 0091 CONTINUE 02170800 +CT010* TEST 10 ZERO PREFIXED WITH A MINUS SIGN 02180800 + IVTNUM = 10 02190800 + DLAVD = 0.0D0 02200800 + ILAVI = IDINT(-DLAVD) 02210800 + IF (ILAVI + 0) 20100, 10100, 20100 02220800 +10100 IVPASS = IVPASS + 1 02230800 + WRITE (NUVI, 80002) IVTNUM 02240800 + GO TO 0101 02250800 +20100 IVFAIL = IVFAIL + 1 02260800 + IVCORR = 0 02270800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 02280800 + 0101 CONTINUE 02290800 +CT011* TEST 11 AN ARITHMETIC EXPRESSION PRESENTED TO IDINT 02300800 + IVTNUM = 11 02310800 + DLAVD = 0.375D1 02320800 + DLBVD = 3.5D0 02330800 + ILAVI = (IDINT(DLAVD + DLBVD * 0.5D1)) 02340800 + IF (ILAVI - 21) 20110, 10110, 20110 02350800 +10110 IVPASS = IVPASS + 1 02360800 + WRITE (NUVI, 80002) IVTNUM 02370800 + GO TO 0111 02380800 +20110 IVFAIL = IVFAIL + 1 02390800 + IVCORR = 21 02400800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 02410800 + 0111 CONTINUE 02420800 +CT012* TEST 12 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 02430800 + IVTNUM = 12 02440800 + DLAVD = 3.5D0 02450800 + ILAVI = IDINT(DLAVD ** 2.5) 02460800 + ILBVI = DLAVD ** 2.5 02470800 + IF (ILAVI - ILBVI) 20120, 10120, 20120 02480800 +10120 IVPASS = IVPASS + 1 02490800 + WRITE (NUVI, 80002) IVTNUM 02500800 + GO TO 0121 02510800 +20120 IVFAIL = IVFAIL + 1 02520800 + IVCORR = ILBVI 02530800 + WRITE (NUVI, 80010) IVTNUM, ILAVI, IVCORR 02540800 + 0121 CONTINUE 02550800 +CBB** ********************** BBCSUM0 **********************************02560800 +C**** WRITE OUT TEST SUMMARY 02570800 +C**** 02580800 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02590800 + WRITE (I02, 90004) 02600800 + WRITE (I02, 90014) 02610800 + WRITE (I02, 90004) 02620800 + WRITE (I02, 90020) IVPASS 02630800 + WRITE (I02, 90022) IVFAIL 02640800 + WRITE (I02, 90024) IVDELE 02650800 + WRITE (I02, 90026) IVINSP 02660800 + WRITE (I02, 90028) IVTOTN, IVTOTL 02670800 +CBE** ********************** BBCSUM0 **********************************02680800 +CBB** ********************** BBCFOOT0 **********************************02690800 +C**** WRITE OUT REPORT FOOTINGS 02700800 +C**** 02710800 + WRITE (I02,90016) ZPROG, ZPROG 02720800 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02730800 + WRITE (I02,90019) 02740800 +CBE** ********************** BBCFOOT0 **********************************02750800 +CBB** ********************** BBCFMT0A **********************************02760800 +C**** FORMATS FOR TEST DETAIL LINES 02770800 +C**** 02780800 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02790800 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02800800 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02810800 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02820800 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02830800 + 1I6,/," ",15X,"CORRECT= " ,I6) 02840800 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02850800 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02860800 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02870800 + 1A21,/," ",16X,"CORRECT= " ,A21) 02880800 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02890800 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02900800 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02910800 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02920800 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02930800 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02940800 +80050 FORMAT (" ",48X,A31) 02950800 +CBE** ********************** BBCFMT0A **********************************02960800 +CBB** ********************** BBCFMAT1 **********************************02970800 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02980800 +C**** 02990800 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03000800 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03010800 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03020800 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03030800 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03040800 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03050800 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03060800 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03070800 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03080800 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03090800 + 2"(",F12.5,", ",F12.5,")") 03100800 +CBE** ********************** BBCFMAT1 **********************************03110800 +CBB** ********************** BBCFMT0B **********************************03120800 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03130800 +C**** 03140800 +90002 FORMAT ("1") 03150800 +90004 FORMAT (" ") 03160800 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03170800 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03180800 +90008 FORMAT (" ",21X,A13,A17) 03190800 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03200800 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03210800 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03220800 + 1 7X,"REMARKS",24X) 03230800 +90014 FORMAT (" ","----------------------------------------------" , 03240800 + 1 "---------------------------------" ) 03250800 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03260800 +C**** 03270800 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03280800 +C**** 03290800 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03300800 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03310800 + 1 A13) 03320800 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03330800 +C**** 03340800 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03350800 +C**** 03360800 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03370800 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03380800 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03390800 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03400800 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03410800 +CBE** ********************** BBCFMT0B **********************************03420800 +C***** 03430800 +C***** END OF TEST SEGMENT 151 03440800 + STOP 03450800 + END 03460800 + 03470800 diff --git a/Fortran/UnitTests/fcvs21_f95/FM800.reference_output b/Fortran/UnitTests/fcvs21_f95/FM800.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM800.reference_output @@ -0,0 +1,47 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM800BEGIN* TEST RESULTS - FM800 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YIDINT - (151) INTRINSIC FUNCTION-- + + IDINT (TYPE CONVERSION) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 12 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ------------------------------------------------------------------------------- + + 12 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 12 OF 12 TESTS EXECUTED + + *FM800END* END OF TEST - FM800 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM801.f b/Fortran/UnitTests/fcvs21_f95/FM801.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM801.f @@ -0,0 +1,801 @@ + PROGRAM FM801 + +C***********************************************************************00010801 +C***** FORTRAN 77 00020801 +C***** FM801 YDINT - (155) 00030801 +C***** 00040801 +C***********************************************************************00050801 +C***** GENERAL PURPOSE ANS REF 00060801 +C***** TEST INTRINSIC FUNCTIONS DINT, DNINT, IDNINT 15.3 00070801 +C***** TRUNCATION (SIGN OF A * LARGEST INTEGER LE ABS(A) ) (TABLE 5)00080801 +C***** 00090801 +C***** GENERAL COMMENTS 00100801 +C***** FLOAT FUNCTION ASSUMED WORKING 00110801 +C***** 00120801 +CBB** ********************** BBCCOMNT **********************************00130801 +C**** 00140801 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150801 +C**** VERSION 2.1 00160801 +C**** 00170801 +C**** 00180801 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190801 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200801 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00210801 +C**** BUILDING 225 RM A266 00220801 +C**** GAITHERSBURG, MD 20899 00230801 +C**** 00240801 +C**** 00250801 +C**** 00260801 +CBE** ********************** BBCCOMNT **********************************00270801 +C***** 00280801 +C***** S P E C I F I C A T I O N S SEGMENT 155 00290801 + DOUBLE PRECISION DNAVD, DNBVD, DNDVD 00300801 +C***** 00310801 +CBB** ********************** BBCINITA **********************************00320801 +C**** SPECIFICATION STATEMENTS 00330801 +C**** 00340801 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350801 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360801 +CBE** ********************** BBCINITA **********************************00370801 +CBB** ********************** BBCINITB **********************************00380801 +C**** INITIALIZE SECTION 00390801 + DATA ZVERS, ZVERSD, ZDATE 00400801 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410801 + DATA ZCOMPL, ZNAME, ZTAPE 00420801 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430801 + DATA ZPROJ, ZTAPED, ZPROG 00440801 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450801 + DATA REMRKS /' '/ 00460801 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470801 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480801 +C**** 00490801 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500801 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510801 +CZ03 ZPROG = 'PROGRAM NAME' 00520801 +CZ04 ZDATE = 'DATE OF TEST' 00530801 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540801 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550801 +CZ07 ZNAME = 'NAME OF USER' 00560801 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570801 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580801 +C 00590801 + IVPASS = 0 00600801 + IVFAIL = 0 00610801 + IVDELE = 0 00620801 + IVINSP = 0 00630801 + IVTOTL = 0 00640801 + IVTOTN = 0 00650801 + ICZERO = 0 00660801 +C 00670801 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680801 + I01 = 05 00690801 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700801 + I02 = 06 00710801 +C 00720801 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730801 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740801 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750801 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760801 +C 00770801 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780801 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790801 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800801 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810801 +C 00820801 +CBE** ********************** BBCINITB **********************************00830801 + NUVI = I02 00840801 + IVTOTL = 45 00850801 + ZPROG = 'FM801' 00860801 +CBB** ********************** BBCHED0A **********************************00870801 +C**** 00880801 +C**** WRITE REPORT TITLE 00890801 +C**** 00900801 + WRITE (I02, 90002) 00910801 + WRITE (I02, 90006) 00920801 + WRITE (I02, 90007) 00930801 + WRITE (I02, 90008) ZVERS, ZVERSD 00940801 + WRITE (I02, 90009) ZPROG, ZPROG 00950801 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960801 +CBE** ********************** BBCHED0A **********************************00970801 +C***** 00980801 +C***** HEADER FOR SEGMENT 155 00990801 + WRITE (NUVI,15501) 01000801 +15501 FORMAT (" ", // 1X,"YDINT - (155) INTRINSIC FUNCTIONS--" //16X, 01010801 + 1 "DINT, DNINT, IDNINT (TYPE CONVERSION) " // 01020801 + 2 " ANS REF. - 15.3" ) 01030801 +CBB** ********************** BBCHED0B **********************************01040801 +C**** WRITE DETAIL REPORT HEADERS 01050801 +C**** 01060801 + WRITE (I02,90004) 01070801 + WRITE (I02,90004) 01080801 + WRITE (I02,90013) 01090801 + WRITE (I02,90014) 01100801 + WRITE (I02,90015) IVTOTL 01110801 +CBE** ********************** BBCHED0B **********************************01120801 +C***** 01130801 +C***** TEST OF DINT 01140801 +C***** 01150801 + WRITE(NUVI, 15502) 01160801 +15502 FORMAT(// 8X, "TEST OF DINT" ) 01170801 +CT001* TEST 1 THE VALUE ZERO 01180801 + IVTNUM = 1 01190801 + DNBVD = 0.0D0 01200801 + DNAVD = DINT(DNBVD) 01210801 + IF (DNAVD + 5.0D-10) 20010, 10010, 40010 01220801 +40010 IF (DNAVD - 5.0D-10) 10010, 10010, 20010 01230801 +10010 IVPASS = IVPASS + 1 01240801 + WRITE (NUVI, 80002) IVTNUM 01250801 + GO TO 0011 01260801 +20010 IVFAIL = IVFAIL + 1 01270801 + DVCORR = 0.0D0 01280801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01290801 + 0011 CONTINUE 01300801 +CT002* TEST 2 A VALUE IN (0,1) 01310801 + IVTNUM = 2 01320801 + DNBVD = 0.375D0 01330801 + DNAVD = DINT(DNBVD) 01340801 + IF (DNAVD + 5.0D-10) 20020, 10020, 40020 01350801 +40020 IF (DNAVD - 5.0D-10) 10020, 10020, 20020 01360801 +10020 IVPASS = IVPASS + 1 01370801 + WRITE (NUVI, 80002) IVTNUM 01380801 + GO TO 0021 01390801 +20020 IVFAIL = IVFAIL + 1 01400801 + DVCORR = 0.0D0 01410801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01420801 + 0021 CONTINUE 01430801 +CT003* TEST 3 THE VALUE 1 01440801 + IVTNUM = 3 01450801 + DNBVD = FLOAT(1) 01460801 + DNAVD = DINT(DNBVD) 01470801 + IF (DNAVD - 0.9999999995D0) 20030, 10030, 40030 01480801 +40030 IF (DNAVD - 1.000000001D0) 10030, 10030, 20030 01490801 +10030 IVPASS = IVPASS + 1 01500801 + WRITE (NUVI, 80002) IVTNUM 01510801 + GO TO 0031 01520801 +20030 IVFAIL = IVFAIL + 1 01530801 + DVCORR = 1.0D0 01540801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01550801 + 0031 CONTINUE 01560801 +CT004* TEST 4 AN INTEGRAL VALUE OTHER THAN 0, 1 01570801 + IVTNUM = 4 01580801 + DNBVD = FLOAT(6) 01590801 + DNAVD = DINT(DNBVD) 01600801 + IF (DNAVD - 5.999999997D0) 20040, 10040, 40040 01610801 +40040 IF (DNAVD - 6.000000003D0) 10040, 10040, 20040 01620801 +10040 IVPASS = IVPASS + 1 01630801 + WRITE (NUVI, 80002) IVTNUM 01640801 + GO TO 0041 01650801 +20040 IVFAIL = IVFAIL + 1 01660801 + DVCORR = 6.0D0 01670801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01680801 + 0041 CONTINUE 01690801 +CT005* TEST 5 A VALUE IN (X,X+1) 01700801 + IVTNUM = 5 01710801 + DNBVD = 0.375D1 01720801 + DNAVD = DINT(DNBVD) 01730801 + IF (DNAVD - 2.999999998D0) 20050, 10050, 40050 01740801 +40050 IF (DNAVD - 3.000000002D0) 10050, 10050, 20050 01750801 +10050 IVPASS = IVPASS + 1 01760801 + WRITE (NUVI, 80002) IVTNUM 01770801 + GO TO 0051 01780801 +20050 IVFAIL = IVFAIL + 1 01790801 + DVCORR = 0.3D1 01800801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01810801 + 0051 CONTINUE 01820801 +CT006* TEST 6 A NEGATIVE VALUE WITH MAGNITUDE IN (0,1) 01830801 + IVTNUM = 6 01840801 + DNBVD = -0.375D0 01850801 + DNAVD = DINT(DNBVD) 01860801 + IF (DNAVD + 5.0D-10) 20060, 10060, 40060 01870801 +40060 IF (DNAVD - 5.0D-10) 10060, 10060, 20060 01880801 +10060 IVPASS = IVPASS + 1 01890801 + WRITE (NUVI, 80002) IVTNUM 01900801 + GO TO 0061 01910801 +20060 IVFAIL = IVFAIL + 1 01920801 + DVCORR = 0.0D0 01930801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 01940801 + 0061 CONTINUE 01950801 +CT007* TEST 7 THE VALUE -1 01960801 + IVTNUM = 7 01970801 + DNBVD = FLOAT(-1) 01980801 + DNAVD = DINT(DNBVD) 01990801 + IF (DNAVD + 1.000000001D0) 20070, 10070, 40070 02000801 +40070 IF (DNAVD + 0.9999999995D0) 10070, 10070, 20070 02010801 +10070 IVPASS = IVPASS + 1 02020801 + WRITE (NUVI, 80002) IVTNUM 02030801 + GO TO 0071 02040801 +20070 IVFAIL = IVFAIL + 1 02050801 + DVCORR = -1.0D0 02060801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02070801 + 0071 CONTINUE 02080801 +CT008* TEST 8 A NEGATIVE INTEGRAL VALUE 02090801 + IVTNUM = 8 02100801 + DNBVD = FLOAT(-6) 02110801 + DNAVD = DINT(DNBVD) 02120801 + IF (DNAVD + 6.000000003D0) 20080, 10080, 40080 02130801 +40080 IF (DNAVD + 5.999999997D0) 10080, 10080, 20080 02140801 +10080 IVPASS = IVPASS + 1 02150801 + WRITE (NUVI, 80002) IVTNUM 02160801 + GO TO 0081 02170801 +20080 IVFAIL = IVFAIL + 1 02180801 + DVCORR = -6.0D0 02190801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02200801 + 0081 CONTINUE 02210801 +CT009* TEST 9 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+1) 02220801 + IVTNUM = 9 02230801 + DNBVD = -0.375D1 02240801 + DNAVD = DINT(DNBVD) 02250801 + IF (DNAVD + 3.000000002D0) 20090, 10090, 40090 02260801 +40090 IF (DNAVD + 2.999999998D0) 10090, 10090, 20090 02270801 +10090 IVPASS = IVPASS + 1 02280801 + WRITE (NUVI, 80002) IVTNUM 02290801 + GO TO 0091 02300801 +20090 IVFAIL = IVFAIL + 1 02310801 + DVCORR = -0.3D1 02320801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02330801 + 0091 CONTINUE 02340801 +CT010* TEST 10 ZERO PREFIXED WITH A MINUS SIGN 02350801 + IVTNUM = 10 02360801 + DNBVD = 0.0D0 02370801 + DNAVD = DINT(-DNBVD) 02380801 + IF (DNAVD + 5.0D-10) 20100, 10100, 40100 02390801 +40100 IF (DNAVD - 5.0D-10) 10100, 10100, 20100 02400801 +10100 IVPASS = IVPASS + 1 02410801 + WRITE (NUVI, 80002) IVTNUM 02420801 + GO TO 0101 02430801 +20100 IVFAIL = IVFAIL + 1 02440801 + DVCORR = 0.0D0 02450801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02460801 + 0101 CONTINUE 02470801 +CT011* TEST 11 AN ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 02480801 + IVTNUM = 11 02490801 + DNBVD = 0.375D1 02500801 + DNAVD = DINT(DNBVD/0.375D0) 02510801 + IF (DNAVD - 0.9000000000D1) 20110, 10110, 40110 02520801 +40110 IF (DNAVD - 1.000000001D1) 10110, 10110, 20110 02530801 +10110 IVPASS = IVPASS + 1 02540801 + WRITE (NUVI, 80002) IVTNUM 02550801 + GO TO 0111 02560801 +20110 IVFAIL = IVFAIL + 1 02570801 + DVCORR = 1.0D1 02580801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02590801 + 0111 CONTINUE 02600801 +C***** 02610801 + WRITE (NUVI, 90002) 02620801 + WRITE (NUVI, 90013) 02630801 + WRITE (NUVI, 90014) 02640801 +C***** 02650801 +C***** TEST OF DNINT 02660801 +C***** 02670801 + WRITE(NUVI, 15504) 02680801 +15504 FORMAT( // 8X, "TEST OF DNINT" ) 02690801 +CT012* TEST 12 THE VALUE ZERO 02700801 + IVTNUM = 12 02710801 + DNBVD = 0.0D0 02720801 + DNAVD = DNINT(DNBVD) 02730801 + IF (DNAVD + 5.0D-10) 20120, 10120, 40120 02740801 +40120 IF (DNAVD - 5.0D-10) 10120, 10120, 20120 02750801 +10120 IVPASS = IVPASS + 1 02760801 + WRITE (NUVI, 80002) IVTNUM 02770801 + GO TO 0121 02780801 +20120 IVFAIL = IVFAIL + 1 02790801 + DVCORR = 0.0D0 02800801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02810801 + 0121 CONTINUE 02820801 +CT013* TEST 13 A VALUE IN (0,.5) 02830801 + IVTNUM = 13 02840801 + DNBVD = 0.25D0 02850801 + DNAVD = DNINT(DNBVD) 02860801 + IF (DNAVD + 5.0D-10) 20130, 10130, 40130 02870801 +40130 IF (DNAVD - 5.0D-10) 10130, 10130, 20130 02880801 +10130 IVPASS = IVPASS + 1 02890801 + WRITE (NUVI, 80002) IVTNUM 02900801 + GO TO 0131 02910801 +20130 IVFAIL = IVFAIL + 1 02920801 + DVCORR = 0.0D0 02930801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 02940801 + 0131 CONTINUE 02950801 +CT014* TEST 14 THE VALUE 0.5 02960801 + IVTNUM = 14 02970801 + DNBVD = FLOAT(1) / FLOAT(2) 02980801 + DNAVD = DNINT(DNBVD) 02990801 + IF (DNAVD - 0.9999999995D0) 20140, 10140, 40140 03000801 +40140 IF (DNAVD - 1.000000001D0) 10140, 10140, 20140 03010801 +10140 IVPASS = IVPASS + 1 03020801 + WRITE (NUVI, 80002) IVTNUM 03030801 + GO TO 0141 03040801 +20140 IVFAIL = IVFAIL + 1 03050801 + DVCORR = 1.0D0 03060801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03070801 + 0141 CONTINUE 03080801 +CT015* TEST 15 A VALUE IN (.5,1) 03090801 + IVTNUM = 15 03100801 + DNBVD = 0.75D0 03110801 + DNAVD = DNINT(DNBVD) 03120801 + IF (DNAVD - 0.9999999995D0) 20150, 10150, 40150 03130801 +40150 IF (DNAVD - 1.000000001D0) 10150, 10150, 20150 03140801 +10150 IVPASS = IVPASS + 1 03150801 + WRITE (NUVI, 80002) IVTNUM 03160801 + GO TO 0151 03170801 +20150 IVFAIL = IVFAIL + 1 03180801 + DVCORR = 1.0D0 03190801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03200801 + 0151 CONTINUE 03210801 +CT016* TEST 16 AN INTEGRAL VALUE OTHER THAN 0, 1 03220801 + IVTNUM = 16 03230801 + DNBVD = FLOAT(5) 03240801 + DNAVD = DNINT(DNBVD) 03250801 + IF (DNAVD - 4.999999997D0) 20160, 10160, 40160 03260801 +40160 IF (DNAVD - 5.000000003D0) 10160, 10160, 20160 03270801 +10160 IVPASS = IVPASS + 1 03280801 + WRITE (NUVI, 80002) IVTNUM 03290801 + GO TO 0161 03300801 +20160 IVFAIL = IVFAIL + 1 03310801 + DVCORR = 5.0D0 03320801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03330801 + 0161 CONTINUE 03340801 +CT017* TEST 17 A VALUE IN (X,X+.5) 03350801 + IVTNUM = 17 03360801 + DNBVD = 10.46875D0 03370801 + DNAVD = DNINT(DNBVD) 03380801 + IF (DNAVD - 9.999999995D0) 20170, 10170, 40170 03390801 +40170 IF (DNAVD - 10.00000001D0) 10170, 10170, 20170 03400801 +10170 IVPASS = IVPASS + 1 03410801 + WRITE (NUVI, 80002) IVTNUM 03420801 + GO TO 0171 03430801 +20170 IVFAIL = IVFAIL + 1 03440801 + DVCORR = 10.0D0 03450801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03460801 + 0171 CONTINUE 03470801 +CT018* TEST 18 A VALUE WITH FRACTIONAL COMPONENT 0.5 03480801 + IVTNUM = 18 03490801 + DNBVD = FLOAT(15) + FLOAT(1) / FLOAT(2) 03500801 + DNAVD = DNINT(DNBVD) 03510801 + IF (DNAVD - 15.99999999D0) 20180, 10180, 40180 03520801 +40180 IF (DNAVD - 16.00000001D0) 10180, 10180, 20180 03530801 +10180 IVPASS = IVPASS + 1 03540801 + WRITE (NUVI, 80002) IVTNUM 03550801 + GO TO 0181 03560801 +20180 IVFAIL = IVFAIL + 1 03570801 + DVCORR = 16.0D0 03580801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03590801 + 0181 CONTINUE 03600801 +CT019* TEST 19 A VALUE IN (X+.5,X+1) 03610801 + IVTNUM = 19 03620801 + DNBVD = 27.96875D0 03630801 + DNAVD = DNINT(DNBVD) 03640801 + IF (DNAVD - 27.99999998D0) 20190, 10190, 40190 03650801 +40190 IF (DNAVD - 28.00000002D0) 10190, 10190, 20190 03660801 +10190 IVPASS = IVPASS + 1 03670801 + WRITE (NUVI, 80002) IVTNUM 03680801 + GO TO 0191 03690801 +20190 IVFAIL = IVFAIL + 1 03700801 + DVCORR = 28.0D0 03710801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03720801 + 0191 CONTINUE 03730801 +CT020* TEST 20 A NEGATIVE VALUE WITH MAGNITUDE IN (0,.5) 03740801 + IVTNUM = 20 03750801 + DNBVD = -0.25D0 03760801 + DNAVD = DNINT(DNBVD) 03770801 + IF (DNAVD + 5.0D-10) 20200, 10200, 40200 03780801 +40200 IF (DNAVD - 5.0D-10) 10200, 10200, 20200 03790801 +10200 IVPASS = IVPASS + 1 03800801 + WRITE (NUVI, 80002) IVTNUM 03810801 + GO TO 0201 03820801 +20200 IVFAIL = IVFAIL + 1 03830801 + DVCORR = 0.0D0 03840801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03850801 + 0201 CONTINUE 03860801 +CT021* TEST 21 THE VALUE -0.5 03870801 + IVTNUM = 21 03880801 + DNBVD = -FLOAT(1) / FLOAT(2) 03890801 + DNAVD = DNINT(DNBVD) 03900801 + IF (DNAVD + 1.000000001D0) 20210, 10210, 40210 03910801 +40210 IF (DNAVD + 0.9999999995D0) 10210, 10210, 20210 03920801 +10210 IVPASS = IVPASS + 1 03930801 + WRITE (NUVI, 80002) IVTNUM 03940801 + GO TO 0211 03950801 +20210 IVFAIL = IVFAIL + 1 03960801 + DVCORR = -1.0D0 03970801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 03980801 + 0211 CONTINUE 03990801 +CT022* TEST 22 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1) 04000801 + IVTNUM = 22 04010801 + DNBVD = -0.75D0 04020801 + DNAVD = DNINT(DNBVD) 04030801 + IF (DNAVD + 1.000000001D0) 20220, 10220, 40220 04040801 +40220 IF (DNAVD + 0.9999999995D0) 10220, 10220, 20220 04050801 +10220 IVPASS = IVPASS + 1 04060801 + WRITE (NUVI, 80002) IVTNUM 04070801 + GO TO 0221 04080801 +20220 IVFAIL = IVFAIL + 1 04090801 + DVCORR = -1.0D0 04100801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04110801 + 0221 CONTINUE 04120801 +CT023* TEST 23 A NEGATIVE INTEGRAL VALUE 04130801 + IVTNUM = 23 04140801 + DNBVD = -FLOAT(5) 04150801 + DNAVD = DNINT(DNBVD) 04160801 + IF (DNAVD + 5.000000003D0) 20230, 10230, 40230 04170801 +40230 IF (DNAVD + 4.999999997D0) 10230, 10230, 20230 04180801 +10230 IVPASS = IVPASS + 1 04190801 + WRITE (NUVI, 80002) IVTNUM 04200801 + GO TO 0231 04210801 +20230 IVFAIL = IVFAIL + 1 04220801 + DVCORR = -5.0D0 04230801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04240801 + 0231 CONTINUE 04250801 +CT024* TEST 24 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5) 04260801 + IVTNUM = 24 04270801 + DNBVD = -10.46875D0 04280801 + DNAVD = DNINT(DNBVD) 04290801 + IF (DNAVD + 10.00000001D0) 20240, 10240, 40240 04300801 +40240 IF (DNAVD + 9.999999995D0) 10240, 10240, 20240 04310801 +10240 IVPASS = IVPASS + 1 04320801 + WRITE (NUVI, 80002) IVTNUM 04330801 + GO TO 0241 04340801 +20240 IVFAIL = IVFAIL + 1 04350801 + DVCORR = -10.0D0 04360801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04370801 + 0241 CONTINUE 04380801 +CT025* TEST 25 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT 0.5 04390801 + IVTNUM = 25 04400801 + DNBVD = FLOAT(-15) - FLOAT(1) / FLOAT(2) 04410801 + DNAVD = DNINT(DNBVD) 04420801 + IF (DNAVD + 16.00000001D0) 20250, 10250, 40250 04430801 +40250 IF (DNAVD + 15.99999999D0) 10250, 10250, 20250 04440801 +10250 IVPASS = IVPASS + 1 04450801 + WRITE (NUVI, 80002) IVTNUM 04460801 + GO TO 0251 04470801 +20250 IVFAIL = IVFAIL + 1 04480801 + DVCORR = -16.0D0 04490801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04500801 + 0251 CONTINUE 04510801 +CT026* TEST 26 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1) 04520801 + IVTNUM = 26 04530801 + DNBVD = -27.96875D0 04540801 + DNAVD = DNINT(DNBVD) 04550801 + IF (DNAVD + 28.00000002D0) 20260, 10260, 40260 04560801 +40260 IF (DNAVD + 27.99999998D0) 10260, 10260, 20260 04570801 +10260 IVPASS = IVPASS + 1 04580801 + WRITE (NUVI, 80002) IVTNUM 04590801 + GO TO 0261 04600801 +20260 IVFAIL = IVFAIL + 1 04610801 + DVCORR = -28.0D0 04620801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04630801 + 0261 CONTINUE 04640801 +CT027* TEST 27 ZERO PREFIXED WITH A MINUS SIGN 04650801 + IVTNUM = 27 04660801 + DNBVD = 0.0D0 04670801 + DNAVD = DNINT(-DNBVD) 04680801 + IF (DNAVD + 5.0D-10) 20270, 10270, 40270 04690801 +40270 IF (DNAVD - 5.0D-10) 10270, 10270, 20270 04700801 +10270 IVPASS = IVPASS + 1 04710801 + WRITE (NUVI, 80002) IVTNUM 04720801 + GO TO 0271 04730801 +20270 IVFAIL = IVFAIL + 1 04740801 + DVCORR = 0.0D0 04750801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04760801 + 0271 CONTINUE 04770801 +CT028* TEST 28 AN ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 04780801 + IVTNUM = 28 04790801 + DNBVD = 8.00D0 04800801 + DNDVD = 7.25D0 04810801 + DNAVD = DNINT(DNBVD - DNDVD) 04820801 + IF (DNAVD - 0.9999999995D0) 20280, 10280, 40280 04830801 +40280 IF (DNAVD - 1.000000001D0) 10280, 10280, 20280 04840801 +10280 IVPASS = IVPASS + 1 04850801 + WRITE (NUVI, 80002) IVTNUM 04860801 + GO TO 0281 04870801 +20280 IVFAIL = IVFAIL + 1 04880801 + DVCORR = 1.0D0 04890801 + WRITE (NUVI, 80031) IVTNUM, DNAVD, DVCORR 04900801 + 0281 CONTINUE 04910801 +C***** 04920801 + WRITE (NUVI, 90002) 04930801 + WRITE (NUVI, 90013) 04940801 + WRITE (NUVI, 90014) 04950801 +C***** 04960801 +C***** TEST OF IDNINT 04970801 +C***** 04980801 +C***** 04990801 + WRITE(NUVI, 15506) 05000801 +15506 FORMAT( // 8X, "TEST OF IDNINT" ) 05010801 +CT029* TEST 29 THE VALUE ZERO 05020801 + IVTNUM = 29 05030801 + DNBVD = 0.0D0 05040801 + INAVI = IDNINT(DNBVD) 05050801 + IF (INAVI - 0) 20290, 10290, 20290 05060801 +10290 IVPASS = IVPASS + 1 05070801 + WRITE (NUVI, 80002) IVTNUM 05080801 + GO TO 0291 05090801 +20290 IVFAIL = IVFAIL + 1 05100801 + IVCORR = 0 05110801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05120801 + 0291 CONTINUE 05130801 +CT030* TEST 30 A VALUE IN (0.,5) 05140801 + IVTNUM = 30 05150801 + DNBVD = 0.25D0 05160801 + INAVI = IDNINT(DNBVD) 05170801 + IF (INAVI - 0) 20300, 10300, 20300 05180801 +10300 IVPASS = IVPASS + 1 05190801 + WRITE (NUVI, 80002) IVTNUM 05200801 + GO TO 0301 05210801 +20300 IVFAIL = IVFAIL + 1 05220801 + IVCORR = 0 05230801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05240801 + 0301 CONTINUE 05250801 +CT031* TEST 31 THE VALUE 0.5 05260801 + IVTNUM = 31 05270801 + DNBVD = FLOAT(1) / FLOAT(2) 05280801 + INAVI = IDNINT(DNBVD) 05290801 + IF (INAVI - 1) 20310, 10310, 20310 05300801 +10310 IVPASS = IVPASS + 1 05310801 + WRITE (NUVI, 80002) IVTNUM 05320801 + GO TO 0311 05330801 +20310 IVFAIL = IVFAIL + 1 05340801 + IVCORR = 1 05350801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05360801 + 0311 CONTINUE 05370801 +CT032* TEST 32 A VALUE IN (.5,1) 05380801 + IVTNUM = 32 05390801 + DNBVD = 0.75D0 05400801 + INAVI = IDNINT(DNBVD) 05410801 + IF (INAVI - 1) 20320, 10320, 20320 05420801 +10320 IVPASS = IVPASS + 1 05430801 + WRITE (NUVI, 80002) IVTNUM 05440801 + GO TO 0321 05450801 +20320 IVFAIL = IVFAIL + 1 05460801 + IVCORR = 1 05470801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05480801 + 0321 CONTINUE 05490801 +CT033* TEST 33 AN INTEGRAL VALUE OTHER THAN 0, 1 05500801 + IVTNUM = 33 05510801 + DNBVD = FLOAT(5) 05520801 + INAVI = IDNINT(DNBVD) 05530801 + IF (INAVI - 5) 20330, 10330, 20330 05540801 +10330 IVPASS = IVPASS + 1 05550801 + WRITE (NUVI, 80002) IVTNUM 05560801 + GO TO 0331 05570801 +20330 IVFAIL = IVFAIL + 1 05580801 + IVCORR = 5 05590801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05600801 + 0331 CONTINUE 05610801 +CT034* TEST 34 A VALUE IN (X,X+.5) 05620801 + IVTNUM = 34 05630801 + DNBVD = 10.46875D0 05640801 + INAVI = IDNINT(DNBVD) 05650801 + IF (INAVI - 10) 20340, 10340, 20340 05660801 +10340 IVPASS = IVPASS + 1 05670801 + WRITE (NUVI, 80002) IVTNUM 05680801 + GO TO 0341 05690801 +20340 IVFAIL = IVFAIL + 1 05700801 + IVCORR = 10 05710801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05720801 + 0341 CONTINUE 05730801 +CT035* TEST 35 A VALUE WITH FRACTIONAL COMPONENT 0.5 05740801 + IVTNUM = 35 05750801 + DNBVD = FLOAT(15) + FLOAT(1) / FLOAT(2) 05760801 + INAVI = IDNINT(DNBVD) 05770801 + IF (INAVI - 16) 20350, 10350, 20350 05780801 +10350 IVPASS = IVPASS + 1 05790801 + WRITE (NUVI, 80002) IVTNUM 05800801 + GO TO 0351 05810801 +20350 IVFAIL = IVFAIL + 1 05820801 + IVCORR = 16 05830801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05840801 + 0351 CONTINUE 05850801 +CT036* TEST 36 A VALUE IN (X+.5,X+1) 05860801 + IVTNUM = 36 05870801 + DNBVD = 27.96875D0 05880801 + INAVI = IDNINT(DNBVD) 05890801 + IF (INAVI - 28) 20360, 10360, 20360 05900801 +10360 IVPASS = IVPASS + 1 05910801 + WRITE (NUVI, 80002) IVTNUM 05920801 + GO TO 0361 05930801 +20360 IVFAIL = IVFAIL + 1 05940801 + IVCORR = 28 05950801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 05960801 + 0361 CONTINUE 05970801 +CT037* TEST 37 A NEGATIVE VALUE WITH MAGNITUDE IN (0,.5) 05980801 + IVTNUM = 37 05990801 + DNBVD = -0.25D0 06000801 + INAVI = IDNINT(DNBVD) 06010801 + IF (INAVI - 0) 20370, 10370, 20370 06020801 +10370 IVPASS = IVPASS + 1 06030801 + WRITE (NUVI, 80002) IVTNUM 06040801 + GO TO 0371 06050801 +20370 IVFAIL = IVFAIL + 1 06060801 + IVCORR = 0 06070801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06080801 + 0371 CONTINUE 06090801 +CT038* TEST 38 THE VALUE -0.5 06100801 + IVTNUM = 38 06110801 + DNBVD = -FLOAT(1) / FLOAT(2) 06120801 + INAVI = IDNINT(DNBVD) 06130801 + IF (INAVI + 1) 20380, 10380, 20380 06140801 +10380 IVPASS = IVPASS + 1 06150801 + WRITE (NUVI, 80002) IVTNUM 06160801 + GO TO 0381 06170801 +20380 IVFAIL = IVFAIL + 1 06180801 + IVCORR = -1 06190801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06200801 + 0381 CONTINUE 06210801 +CT039* TEST 39 A NEGATIVE VALUE WITH MAGNITUDE IN (.5,1) 06220801 + IVTNUM = 39 06230801 + DNBVD = -0.75D0 06240801 + INAVI = IDNINT(DNBVD) 06250801 + IF (INAVI + 1) 20390, 10390, 20390 06260801 +10390 IVPASS = IVPASS + 1 06270801 + WRITE (NUVI, 80002) IVTNUM 06280801 + GO TO 0391 06290801 +20390 IVFAIL = IVFAIL + 1 06300801 + IVCORR = -1 06310801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06320801 + 0391 CONTINUE 06330801 +CT040* TEST 40 A NEGATIVE INTEGRAL VALUE 06340801 + IVTNUM = 40 06350801 + DNBVD = -FLOAT(5) 06360801 + INAVI = IDNINT(DNBVD) 06370801 + IF (INAVI + 5) 20400, 10400, 20400 06380801 +10400 IVPASS = IVPASS + 1 06390801 + WRITE (NUVI, 80002) IVTNUM 06400801 + GO TO 0401 06410801 +20400 IVFAIL = IVFAIL + 1 06420801 + IVCORR = -5 06430801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06440801 + 0401 CONTINUE 06450801 +CT041* TEST 41 A NEGATIVE VALUE WITH MAGNITUDE IN (X,X+.5) 06460801 + IVTNUM = 41 06470801 + DNBVD = -10.46875D0 06480801 + INAVI = IDNINT(DNBVD) 06490801 + IF (INAVI + 10) 20410, 10410, 20410 06500801 +10410 IVPASS = IVPASS + 1 06510801 + WRITE (NUVI, 80002) IVTNUM 06520801 + GO TO 0411 06530801 +20410 IVFAIL = IVFAIL + 1 06540801 + IVCORR = -10 06550801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06560801 + 0411 CONTINUE 06570801 +CT042* TEST 42 A NEGATIVE VALUE WITH FRACTIONAL COMPONENT 0.5 06580801 + IVTNUM = 42 06590801 + DNBVD = FLOAT(-15) - FLOAT(1) /FLOAT(2) 06600801 + INAVI = IDNINT(DNBVD) 06610801 + IF (INAVI + 16) 20420, 10420, 20420 06620801 +10420 IVPASS = IVPASS + 1 06630801 + WRITE (NUVI, 80002) IVTNUM 06640801 + GO TO 0421 06650801 +20420 IVFAIL = IVFAIL + 1 06660801 + IVCORR = -16 06670801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06680801 + 0421 CONTINUE 06690801 +CT043* TEST 43 A NEGATIVE VALUE WITH MAGNITUDE IN (X+.5,X+1) 06700801 + IVTNUM = 43 06710801 + DNBVD = -27.96875D0 06720801 + INAVI = IDNINT(DNBVD) 06730801 + IF (INAVI + 28) 20430, 10430, 20430 06740801 +10430 IVPASS = IVPASS + 1 06750801 + WRITE (NUVI, 80002) IVTNUM 06760801 + GO TO 0431 06770801 +20430 IVFAIL = IVFAIL + 1 06780801 + IVCORR = -28 06790801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06800801 + 0431 CONTINUE 06810801 +CT044* TEST 44 ZERO PREFIXED WITH A MINUS SIGN 06820801 + IVTNUM = 44 06830801 + DNBVD = 0.0D0 06840801 + INAVI = IDNINT(-DNBVD) 06850801 + IF (INAVI - 0) 20440, 10440, 20440 06860801 +10440 IVPASS = IVPASS + 1 06870801 + WRITE (NUVI, 80002) IVTNUM 06880801 + GO TO 0441 06890801 +20440 IVFAIL = IVFAIL + 1 06900801 + IVCORR = 0 06910801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 06920801 + 0441 CONTINUE 06930801 +CT045* TEST 45 AN ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 06940801 + IVTNUM = 45 06950801 + DNBVD = 8.00D0 06960801 + DNDVD = 7.25D0 06970801 + INAVI = IDNINT(DNBVD - DNDVD) 06980801 + IF (INAVI - 1) 20450, 10450, 20450 06990801 +10450 IVPASS = IVPASS + 1 07000801 + WRITE (NUVI, 80002) IVTNUM 07010801 + GO TO 0451 07020801 +20450 IVFAIL = IVFAIL + 1 07030801 + IVCORR = 1 07040801 + WRITE (NUVI, 80010) IVTNUM, INAVI, IVCORR 07050801 + 0451 CONTINUE 07060801 +C***** 07070801 +CBB** ********************** BBCSUM0 **********************************07080801 +C**** WRITE OUT TEST SUMMARY 07090801 +C**** 07100801 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 07110801 + WRITE (I02, 90004) 07120801 + WRITE (I02, 90014) 07130801 + WRITE (I02, 90004) 07140801 + WRITE (I02, 90020) IVPASS 07150801 + WRITE (I02, 90022) IVFAIL 07160801 + WRITE (I02, 90024) IVDELE 07170801 + WRITE (I02, 90026) IVINSP 07180801 + WRITE (I02, 90028) IVTOTN, IVTOTL 07190801 +CBE** ********************** BBCSUM0 **********************************07200801 +CBB** ********************** BBCFOOT0 **********************************07210801 +C**** WRITE OUT REPORT FOOTINGS 07220801 +C**** 07230801 + WRITE (I02,90016) ZPROG, ZPROG 07240801 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 07250801 + WRITE (I02,90019) 07260801 +CBE** ********************** BBCFOOT0 **********************************07270801 +CBB** ********************** BBCFMT0A **********************************07280801 +C**** FORMATS FOR TEST DETAIL LINES 07290801 +C**** 07300801 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 07310801 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 07320801 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 07330801 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 07340801 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 07350801 + 1I6,/," ",15X,"CORRECT= " ,I6) 07360801 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07370801 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 07380801 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07390801 + 1A21,/," ",16X,"CORRECT= " ,A21) 07400801 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 07410801 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 07420801 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 07430801 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 07440801 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 07450801 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 07460801 +80050 FORMAT (" ",48X,A31) 07470801 +CBE** ********************** BBCFMT0A **********************************07480801 +CBB** ********************** BBCFMAT1 **********************************07490801 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 07500801 +C**** 07510801 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07520801 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 07530801 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 07540801 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 07550801 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 07560801 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 07570801 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 07580801 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 07590801 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07600801 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 07610801 + 2"(",F12.5,", ",F12.5,")") 07620801 +CBE** ********************** BBCFMAT1 **********************************07630801 +CBB** ********************** BBCFMT0B **********************************07640801 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 07650801 +C**** 07660801 +90002 FORMAT ("1") 07670801 +90004 FORMAT (" ") 07680801 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )07690801 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07700801 +90008 FORMAT (" ",21X,A13,A17) 07710801 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 07720801 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 07730801 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 07740801 + 1 7X,"REMARKS",24X) 07750801 +90014 FORMAT (" ","----------------------------------------------" , 07760801 + 1 "---------------------------------" ) 07770801 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 07780801 +C**** 07790801 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 07800801 +C**** 07810801 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 07820801 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 07830801 + 1 A13) 07840801 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 07850801 +C**** 07860801 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 07870801 +C**** 07880801 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 07890801 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 07900801 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 07910801 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 07920801 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 07930801 +CBE** ********************** BBCFMT0B **********************************07940801 +C***** 07950801 +C***** END OF TEST SEGMENT 155 07960801 + STOP 07970801 + END 07980801 + 07990801 diff --git a/Fortran/UnitTests/fcvs21_f95/FM801.reference_output b/Fortran/UnitTests/fcvs21_f95/FM801.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM801.reference_output @@ -0,0 +1,95 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM801BEGIN* TEST RESULTS - FM801 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YDINT - (155) INTRINSIC FUNCTIONS-- + + DINT, DNINT, IDNINT (TYPE CONVERSION) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 45 TESTS + + + + TEST OF DINT + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + + TEST OF DNINT + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + + TEST OF IDNINT + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + 36 PASS + 37 PASS + 38 PASS + 39 PASS + 40 PASS + 41 PASS + 42 PASS + 43 PASS + 44 PASS + 45 PASS + + ------------------------------------------------------------------------------- + + 45 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 45 OF 45 TESTS EXECUTED + + *FM801END* END OF TEST - FM801 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM802.f b/Fortran/UnitTests/fcvs21_f95/FM802.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM802.f @@ -0,0 +1,283 @@ + PROGRAM FM802 + +C***********************************************************************00010802 +C***** FORTRAN 77 00020802 +C***** FM802 YDABS - (157) 00030802 +C***** 00040802 +C***********************************************************************00050802 +C***** GENERAL PURPOSE ANS REF 00060802 +C***** TEST INTRINSIC FUNCTION DABS (ABSOLUTE VALUE OF 15.3 00070802 +C***** A DOUBLE PRECISION ARGUMENT) (TABLE 5)00080802 +CBB** ********************** BBCCOMNT **********************************00090802 +C**** 00100802 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00110802 +C**** VERSION 2.1 00120802 +C**** 00130802 +C**** 00140802 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00150802 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00160802 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00170802 +C**** BUILDING 225 RM A266 00180802 +C**** GAITHERSBURG, MD 20899 00190802 +C**** 00200802 +C**** 00210802 +C**** 00220802 +CBE** ********************** BBCCOMNT **********************************00230802 +C***** 00240802 +C***** S P E C I F I C A T I O N S SEGMENT 157 00250802 + DOUBLE PRECISION DOAVD, DOBVD, DODVD, DOEVD, DVCORR 00260802 +C***** 00270802 +CBB** ********************** BBCINITA **********************************00280802 +C**** SPECIFICATION STATEMENTS 00290802 +C**** 00300802 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310802 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320802 +CBE** ********************** BBCINITA **********************************00330802 +CBB** ********************** BBCINITB **********************************00340802 +C**** INITIALIZE SECTION 00350802 + DATA ZVERS, ZVERSD, ZDATE 00360802 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00370802 + DATA ZCOMPL, ZNAME, ZTAPE 00380802 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00390802 + DATA ZPROJ, ZTAPED, ZPROG 00400802 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00410802 + DATA REMRKS /' '/ 00420802 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00430802 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00440802 +C**** 00450802 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00460802 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00470802 +CZ03 ZPROG = 'PROGRAM NAME' 00480802 +CZ04 ZDATE = 'DATE OF TEST' 00490802 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00500802 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00510802 +CZ07 ZNAME = 'NAME OF USER' 00520802 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00530802 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00540802 +C 00550802 + IVPASS = 0 00560802 + IVFAIL = 0 00570802 + IVDELE = 0 00580802 + IVINSP = 0 00590802 + IVTOTL = 0 00600802 + IVTOTN = 0 00610802 + ICZERO = 0 00620802 +C 00630802 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640802 + I01 = 05 00650802 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660802 + I02 = 06 00670802 +C 00680802 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690802 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700802 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00710802 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00720802 +C 00730802 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00740802 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00750802 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00760802 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00770802 +C 00780802 +CBE** ********************** BBCINITB **********************************00790802 + NUVI = I02 00800802 + IVTOTL = 6 00810802 + ZPROG = 'FM802' 00820802 +CBB** ********************** BBCHED0A **********************************00830802 +C**** 00840802 +C**** WRITE REPORT TITLE 00850802 +C**** 00860802 + WRITE (I02, 90002) 00870802 + WRITE (I02, 90006) 00880802 + WRITE (I02, 90007) 00890802 + WRITE (I02, 90008) ZVERS, ZVERSD 00900802 + WRITE (I02, 90009) ZPROG, ZPROG 00910802 + WRITE (I02, 90010) ZDATE, ZCOMPL 00920802 +CBE** ********************** BBCHED0A **********************************00930802 +C***** 00940802 +C***** HEADER FOR SEGMENT 157 WRITTEN 00950802 + WRITE (NUVI,15701) 00960802 +15701 FORMAT (" "//1X,"YDABS - (157) INTRINSIC FUNCTION--" //16X, 00970802 + 1 "DABS (ABSOLUTE VALUE ) " // 2X, 00980802 + 2 "ANS REF. - 15.3" ) 00990802 +CBB** ********************** BBCHED0B **********************************01000802 +C**** WRITE DETAIL REPORT HEADERS 01010802 +C**** 01020802 + WRITE (I02,90004) 01030802 + WRITE (I02,90004) 01040802 + WRITE (I02,90013) 01050802 + WRITE (I02,90014) 01060802 + WRITE (I02,90015) IVTOTL 01070802 +CBE** ********************** BBCHED0B **********************************01080802 +C***** 01090802 +CT001* TEST 1 THE VALUE ZERO 01100802 + IVTNUM = 1 01110802 + DOBVD = 0.0D0 01120802 + DOAVD = DABS(DOBVD) 01130802 + IF (DOAVD + 5.0D-10) 20010, 10010, 40010 01140802 +40010 IF (DOAVD - 5.0D-10) 10010, 10010, 20010 01150802 +10010 IVPASS = IVPASS + 1 01160802 + WRITE (NUVI, 80002) IVTNUM 01170802 + GO TO 0011 01180802 +20010 IVFAIL = IVFAIL + 1 01190802 + DVCORR = 0.0D0 01200802 + WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01210802 + 0011 CONTINUE 01220802 +CT002* TEST 2 ZERO PREFIXED WITH A MINUS SIGN 01230802 + IVTNUM = 2 01240802 + DOBVD = 0.0D0 01250802 + DOAVD = DABS(-DOBVD) 01260802 + IF (DOAVD + 5.0D-10) 20020, 10020, 40020 01270802 +40020 IF (DOAVD - 5.0D-10) 10020, 10020, 20020 01280802 +10020 IVPASS = IVPASS + 1 01290802 + WRITE (NUVI, 80002) IVTNUM 01300802 + GO TO 0021 01310802 +20020 IVFAIL = IVFAIL + 1 01320802 + DVCORR = 0.0D1 01330802 + WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01340802 + 0021 CONTINUE 01350802 +CT003* TEST 3 A POSITIVE NON-INTEGRAL VALUE 01360802 + IVTNUM = 3 01370802 + DOBVD = 0.35875D2 01380802 + DOAVD = DABS(DOBVD) 01390802 + IF (DOAVD - 0.3587499998D2) 20030, 10030, 40030 01400802 +40030 IF (DOAVD - 0.3587500002D2) 10030, 10030, 20030 01410802 +10030 IVPASS = IVPASS + 1 01420802 + WRITE (NUVI, 80002) IVTNUM 01430802 + GO TO 0031 01440802 +20030 IVFAIL = IVFAIL + 1 01450802 + DVCORR = 0.35875D2 01460802 + WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01470802 + 0031 CONTINUE 01480802 +CT004* TEST 4 A NEGATIVE NON-INTEGRAL VALUE 01490802 + IVTNUM = 4 01500802 + DOBVD = -0.35875D2 01510802 + DOAVD = DABS(DOBVD) 01520802 + IF (DOAVD - 0.3587499998D2) 20040, 10040, 40040 01530802 +40040 IF (DOAVD - 0.3587500002D2) 10040, 10040, 20040 01540802 +10040 IVPASS = IVPASS + 1 01550802 + WRITE (NUVI, 80002) IVTNUM 01560802 + GO TO 0041 01570802 +20040 IVFAIL = IVFAIL + 1 01580802 + DVCORR = 0.35875D2 01590802 + WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01600802 + 0041 CONTINUE 01610802 +CT005* TEST 5 A POSITIVE INTEGRAL VALUE 01620802 + IVTNUM = 5 01630802 + DOBVD = 7.0D1 01640802 + DOAVD = DABS(DOBVD) 01650802 + IF (DOAVD - 6.999999996D1) 20050, 10050, 40050 01660802 +40050 IF (DOAVD - 7.000000004D1) 10050, 10050, 20050 01670802 +10050 IVPASS = IVPASS + 1 01680802 + WRITE (NUVI, 80002) IVTNUM 01690802 + GO TO 0051 01700802 +20050 IVFAIL = IVFAIL + 1 01710802 + DVCORR = 7.0D1 01720802 + WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01730802 + 0051 CONTINUE 01740802 +CT006* TEST 6 ARITHMETIC EXPRESSION PRESENTED TO FUNCTION 01750802 + IVTNUM = 6 01760802 + DODVD = 2.625D0 01770802 + DOEVD = 3.0D0 01780802 + DOAVD = DABS((-DODVD) - DOEVD ** 3) 01790802 + IF (DOAVD - 29.62499998D0) 20060, 10060, 40060 01800802 +40060 IF (DOAVD - 29.62500002D0) 10060, 10060, 20060 01810802 +10060 IVPASS = IVPASS + 1 01820802 + WRITE (NUVI, 80002) IVTNUM 01830802 + GO TO 0061 01840802 +20060 IVFAIL = IVFAIL + 1 01850802 + DVCORR = 29.625D0 01860802 + WRITE(NUVI, 80031) IVTNUM, DOAVD, DVCORR 01870802 + 0061 CONTINUE 01880802 +C***** 01890802 +CBB** ********************** BBCSUM0 **********************************01900802 +C**** WRITE OUT TEST SUMMARY 01910802 +C**** 01920802 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01930802 + WRITE (I02, 90004) 01940802 + WRITE (I02, 90014) 01950802 + WRITE (I02, 90004) 01960802 + WRITE (I02, 90020) IVPASS 01970802 + WRITE (I02, 90022) IVFAIL 01980802 + WRITE (I02, 90024) IVDELE 01990802 + WRITE (I02, 90026) IVINSP 02000802 + WRITE (I02, 90028) IVTOTN, IVTOTL 02010802 +CBE** ********************** BBCSUM0 **********************************02020802 +CBB** ********************** BBCFOOT0 **********************************02030802 +C**** WRITE OUT REPORT FOOTINGS 02040802 +C**** 02050802 + WRITE (I02,90016) ZPROG, ZPROG 02060802 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02070802 + WRITE (I02,90019) 02080802 +CBE** ********************** BBCFOOT0 **********************************02090802 +CBB** ********************** BBCFMT0A **********************************02100802 +C**** FORMATS FOR TEST DETAIL LINES 02110802 +C**** 02120802 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02130802 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02140802 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02150802 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02160802 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02170802 + 1I6,/," ",15X,"CORRECT= " ,I6) 02180802 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02190802 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02200802 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02210802 + 1A21,/," ",16X,"CORRECT= " ,A21) 02220802 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02230802 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02240802 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02250802 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02260802 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02270802 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02280802 +80050 FORMAT (" ",48X,A31) 02290802 +CBE** ********************** BBCFMT0A **********************************02300802 +CBB** ********************** BBCFMAT1 **********************************02310802 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02320802 +C**** 02330802 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02340802 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02350802 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02360802 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02370802 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02380802 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02390802 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02400802 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02410802 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02420802 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02430802 + 2"(",F12.5,", ",F12.5,")") 02440802 +CBE** ********************** BBCFMAT1 **********************************02450802 +CBB** ********************** BBCFMT0B **********************************02460802 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02470802 +C**** 02480802 +90002 FORMAT ("1") 02490802 +90004 FORMAT (" ") 02500802 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02510802 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02520802 +90008 FORMAT (" ",21X,A13,A17) 02530802 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02540802 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02550802 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02560802 + 1 7X,"REMARKS",24X) 02570802 +90014 FORMAT (" ","----------------------------------------------" , 02580802 + 1 "---------------------------------" ) 02590802 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02600802 +C**** 02610802 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02620802 +C**** 02630802 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02640802 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02650802 + 1 A13) 02660802 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02670802 +C**** 02680802 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02690802 +C**** 02700802 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02710802 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02720802 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02730802 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02740802 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02750802 +CBE** ********************** BBCFMT0B **********************************02760802 +C***** 02770802 +C***** END OF TEST SEGMENT 157 02780802 + STOP 02790802 + END 02800802 + 02810802 diff --git a/Fortran/UnitTests/fcvs21_f95/FM802.reference_output b/Fortran/UnitTests/fcvs21_f95/FM802.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM802.reference_output @@ -0,0 +1,41 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM802BEGIN* TEST RESULTS - FM802 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YDABS - (157) INTRINSIC FUNCTION-- + + DABS (ABSOLUTE VALUE ) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 6 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + + ------------------------------------------------------------------------------- + + 6 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 6 OF 6 TESTS EXECUTED + + *FM802END* END OF TEST - FM802 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM803.f b/Fortran/UnitTests/fcvs21_f95/FM803.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM803.f @@ -0,0 +1,315 @@ + PROGRAM FM803 + +C***********************************************************************00010803 +C***** FORTRAN 77 00020803 +C***** FM803 YCABS - (158) 00030803 +C***** 00040803 +C***********************************************************************00050803 +C***** GENERAL PURPOSE ANS REF 00060803 +C***** TEST INTRINSIC FUNCTION CABS (ABSOLUTE VALUE OF 15.3 00070803 +C***** A COMPLEX ARGUMENT) (TABLE 5)00080803 +C***** 00090803 +CBB** ********************** BBCCOMNT **********************************00100803 +C**** 00110803 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120803 +C**** VERSION 2.1 00130803 +C**** 00140803 +C**** 00150803 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160803 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170803 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180803 +C**** BUILDING 225 RM A266 00190803 +C**** GAITHERSBURG, MD 20899 00200803 +C**** 00210803 +C**** 00220803 +C**** 00230803 +CBE** ********************** BBCCOMNT **********************************00240803 +C***** 00250803 +C***** S P E C I F I C A T I O N S SEGMENT 158 00260803 + COMPLEX CPAVC 00270803 +C***** 00280803 +CBB** ********************** BBCINITA **********************************00290803 +C**** SPECIFICATION STATEMENTS 00300803 +C**** 00310803 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320803 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330803 +CBE** ********************** BBCINITA **********************************00340803 +CBB** ********************** BBCINITB **********************************00350803 +C**** INITIALIZE SECTION 00360803 + DATA ZVERS, ZVERSD, ZDATE 00370803 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380803 + DATA ZCOMPL, ZNAME, ZTAPE 00390803 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400803 + DATA ZPROJ, ZTAPED, ZPROG 00410803 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420803 + DATA REMRKS /' '/ 00430803 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440803 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450803 +C**** 00460803 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470803 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480803 +CZ03 ZPROG = 'PROGRAM NAME' 00490803 +CZ04 ZDATE = 'DATE OF TEST' 00500803 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510803 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520803 +CZ07 ZNAME = 'NAME OF USER' 00530803 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540803 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550803 +C 00560803 + IVPASS = 0 00570803 + IVFAIL = 0 00580803 + IVDELE = 0 00590803 + IVINSP = 0 00600803 + IVTOTL = 0 00610803 + IVTOTN = 0 00620803 + ICZERO = 0 00630803 +C 00640803 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650803 + I01 = 05 00660803 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670803 + I02 = 06 00680803 +C 00690803 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700803 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710803 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720803 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730803 +C 00740803 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750803 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760803 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770803 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780803 +C 00790803 +CBE** ********************** BBCINITB **********************************00800803 + NUVI = I02 00810803 + IVTOTL = 9 00820803 + ZPROG = 'FM803' 00830803 +CBB** ********************** BBCHED0A **********************************00840803 +C**** 00850803 +C**** WRITE REPORT TITLE 00860803 +C**** 00870803 + WRITE (I02, 90002) 00880803 + WRITE (I02, 90006) 00890803 + WRITE (I02, 90007) 00900803 + WRITE (I02, 90008) ZVERS, ZVERSD 00910803 + WRITE (I02, 90009) ZPROG, ZPROG 00920803 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930803 +CBE** ********************** BBCHED0A **********************************00940803 +C***** 00950803 +C***** HEADER FOR SEGMENT 158 WRITTEN 00960803 + WRITE (NUVI,15801) 00970803 +15801 FORMAT (" ", //1X,"YCABS - (158) INTRINSIC FUNCTION--" //16X, 00980803 + 1 "CABS (ABSOLUTE VALUE)" //2X, 00990803 + 2 "ANS REF. - 15.3" ) 01000803 +CBB** ********************** BBCHED0B **********************************01010803 +C**** WRITE DETAIL REPORT HEADERS 01020803 +C**** 01030803 + WRITE (I02,90004) 01040803 + WRITE (I02,90004) 01050803 + WRITE (I02,90013) 01060803 + WRITE (I02,90014) 01070803 + WRITE (I02,90015) IVTOTL 01080803 +CBE** ********************** BBCHED0B **********************************01090803 +C***** 01100803 +CT001* TEST 1 COMPLEX VALUE ZERO (0,0) 01110803 + IVTNUM = 1 01120803 + RPAVS = CABS((0.0, 0.0)) 01130803 + IF (RPAVS + .00005) 20010, 10010, 40010 01140803 +40010 IF (RPAVS - .00005) 10010, 10010, 20010 01150803 +10010 IVPASS = IVPASS + 1 01160803 + WRITE (NUVI, 80002) IVTNUM 01170803 + GO TO 0011 01180803 +20010 IVFAIL = IVFAIL + 1 01190803 + RVCORR = 0.0 01200803 + WRITE (NUVI, 80012) IVTNUM, RPAVS, RVCORR 01210803 + 0011 CONTINUE 01220803 +CT002* TEST 2 COMPLEX VALUE HAVING ONLY REAL COMPONENT 01230803 + IVTNUM = 2 01240803 + RPAVS = CABS((3.0, 0.0)) 01250803 + IF (RPAVS - 2.9998) 20020, 10020, 40020 01260803 +40020 IF (RPAVS - 3.0002) 10020, 10020, 20020 01270803 +10020 IVPASS = IVPASS + 1 01280803 + WRITE (NUVI, 80002) IVTNUM 01290803 + GO TO 0021 01300803 +20020 IVFAIL = IVFAIL + 1 01310803 + RVCORR = 3.0 01320803 + WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR 01330803 + 0021 CONTINUE 01340803 +CT003* TEST 3 COMPLEX VALUE HAVING ONLY IMAGINARY COMPONENT 01350803 + IVTNUM = 3 01360803 + RPAVS = CABS((0.0, 3.0)) 01370803 + IF (RPAVS - 2.9998) 20030, 10030, 40030 01380803 +40030 IF (RPAVS - 3.0002) 10030, 10030, 20030 01390803 +10030 IVPASS = IVPASS + 1 01400803 + WRITE (NUVI, 80002) IVTNUM 01410803 + GO TO 0031 01420803 +20030 IVFAIL = IVFAIL + 1 01430803 + RVCORR = 3.0 01440803 + WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR 01450803 + 0031 CONTINUE 01460803 +CT004* TEST 4 ARBITRARY COMPLEX VALUE 01470803 + IVTNUM = 4 01480803 + RPAVS = CABS((3.0, 4.0)) 01490803 + IF (RPAVS - 4.9997) 20040, 10040, 40040 01500803 +40040 IF (RPAVS - 5.0003) 10040, 10040, 20040 01510803 +10040 IVPASS = IVPASS + 1 01520803 + WRITE (NUVI, 80002) IVTNUM 01530803 + GO TO 0041 01540803 +20040 IVFAIL = IVFAIL + 1 01550803 + RVCORR = 5.0 01560803 + WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR 01570803 + 0041 CONTINUE 01580803 +CT005* TEST 5 NEGATIVE REAL COMPONENT, NO IMAGINARY COMPONENT 01590803 + IVTNUM = 5 01600803 + RPAVS = CABS((-3.0, 0.0)) 01610803 + IF (RPAVS - 2.9998) 20050, 10050, 40050 01620803 +40050 IF (RPAVS - 3.0002) 10050, 10050, 20050 01630803 +10050 IVPASS = IVPASS + 1 01640803 + WRITE (NUVI, 80002) IVTNUM 01650803 + GO TO 0051 01660803 +20050 IVFAIL = IVFAIL + 1 01670803 + RVCORR = 3.0 01680803 + WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR 01690803 + 0051 CONTINUE 01700803 +CT006* TEST 6 NO REAL COMPONENT, NEGATIVE IMAGINARY COMPONENT 01710803 + IVTNUM = 6 01720803 + RPAVS = CABS((0.0, -3.0)) 01730803 + IF (RPAVS - 2.9998) 20060, 10060, 40060 01740803 +40060 IF (RPAVS - 3.0002) 10060, 10060, 20060 01750803 +10060 IVPASS = IVPASS + 1 01760803 + WRITE (NUVI, 80002) IVTNUM 01770803 + GO TO 0061 01780803 +20060 IVFAIL = IVFAIL + 1 01790803 + RVCORR = 3.0 01800803 + WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR 01810803 + 0061 CONTINUE 01820803 +CT007* TEST 7 ARBITRARY COMPLEX VALUE WITH NEGATIVE COMPONENTS 01830803 + IVTNUM = 7 01840803 + RPAVS = CABS((-3.0, -4.0)) 01850803 + IF (RPAVS - 4.9997) 20070, 10070, 40070 01860803 +40070 IF (RPAVS - 5.0003) 10070, 10070, 20070 01870803 +10070 IVPASS = IVPASS + 1 01880803 + WRITE (NUVI, 80002) IVTNUM 01890803 + GO TO 0071 01900803 +20070 IVFAIL = IVFAIL + 1 01910803 + RVCORR = 5.0 01920803 + WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR 01930803 + 0071 CONTINUE 01940803 +CT008* TEST 8 COMPLEX VALUE ZERO PRECEDED BY MINUS SIGN 01950803 + IVTNUM = 8 01960803 + CPAVC = (0.0, 0.0) 01970803 + RPAVS = CABS(-CPAVC) 01980803 + IF (RPAVS + 0.00005) 20080, 10080, 40080 01990803 +40080 IF (RPAVS - 0.00005) 10080, 10080, 20080 02000803 +10080 IVPASS = IVPASS + 1 02010803 + WRITE (NUVI, 80002) IVTNUM 02020803 + GO TO 0081 02030803 +20080 IVFAIL = IVFAIL + 1 02040803 + RVCORR = 0.0 02050803 + WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR 02060803 + 0081 CONTINUE 02070803 +CT009* TEST 9 COMPLEX EXPRESSION PRESENTED AS ARGUMENT 02080803 + IVTNUM = 9 02090803 + CPAVC = (3.0, 4.0) 02100803 + RPAVS = CABS(CPAVC - (3.0, 4.0)) 02110803 + IF (RPAVS + 0.00005) 20090, 10090, 40090 02120803 +40090 IF (RPAVS - 0.00005) 10090, 10090, 20090 02130803 +10090 IVPASS = IVPASS + 1 02140803 + WRITE (NUVI, 80002) IVTNUM 02150803 + GO TO 0091 02160803 +20090 IVFAIL = IVFAIL + 1 02170803 + RVCORR = 0.0 02180803 + WRITE(NUVI, 80012) IVTNUM, RPAVS, RVCORR 02190803 + 0091 CONTINUE 02200803 +C***** 02210803 +CBB** ********************** BBCSUM0 **********************************02220803 +C**** WRITE OUT TEST SUMMARY 02230803 +C**** 02240803 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02250803 + WRITE (I02, 90004) 02260803 + WRITE (I02, 90014) 02270803 + WRITE (I02, 90004) 02280803 + WRITE (I02, 90020) IVPASS 02290803 + WRITE (I02, 90022) IVFAIL 02300803 + WRITE (I02, 90024) IVDELE 02310803 + WRITE (I02, 90026) IVINSP 02320803 + WRITE (I02, 90028) IVTOTN, IVTOTL 02330803 +CBE** ********************** BBCSUM0 **********************************02340803 +CBB** ********************** BBCFOOT0 **********************************02350803 +C**** WRITE OUT REPORT FOOTINGS 02360803 +C**** 02370803 + WRITE (I02,90016) ZPROG, ZPROG 02380803 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02390803 + WRITE (I02,90019) 02400803 +CBE** ********************** BBCFOOT0 **********************************02410803 +CBB** ********************** BBCFMT0A **********************************02420803 +C**** FORMATS FOR TEST DETAIL LINES 02430803 +C**** 02440803 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02450803 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02460803 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02470803 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02480803 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02490803 + 1I6,/," ",15X,"CORRECT= " ,I6) 02500803 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02510803 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02520803 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02530803 + 1A21,/," ",16X,"CORRECT= " ,A21) 02540803 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02550803 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02560803 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02570803 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02580803 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02590803 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02600803 +80050 FORMAT (" ",48X,A31) 02610803 +CBE** ********************** BBCFMT0A **********************************02620803 +CBB** ********************** BBCFMAT1 **********************************02630803 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02640803 +C**** 02650803 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02660803 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02670803 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02680803 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02690803 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02700803 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02710803 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02720803 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02730803 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02740803 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02750803 + 2"(",F12.5,", ",F12.5,")") 02760803 +CBE** ********************** BBCFMAT1 **********************************02770803 +CBB** ********************** BBCFMT0B **********************************02780803 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02790803 +C**** 02800803 +90002 FORMAT ("1") 02810803 +90004 FORMAT (" ") 02820803 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02830803 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02840803 +90008 FORMAT (" ",21X,A13,A17) 02850803 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02860803 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02870803 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02880803 + 1 7X,"REMARKS",24X) 02890803 +90014 FORMAT (" ","----------------------------------------------" , 02900803 + 1 "---------------------------------" ) 02910803 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02920803 +C**** 02930803 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02940803 +C**** 02950803 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02960803 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02970803 + 1 A13) 02980803 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02990803 +C**** 03000803 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03010803 +C**** 03020803 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03030803 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03040803 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03050803 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03060803 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03070803 +CBE** ********************** BBCFMT0B **********************************03080803 +C***** 03090803 +C***** END OF TEST SEGMENT 158 03100803 + STOP 03110803 + END 03120803 + 03130803 diff --git a/Fortran/UnitTests/fcvs21_f95/FM803.reference_output b/Fortran/UnitTests/fcvs21_f95/FM803.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM803.reference_output @@ -0,0 +1,44 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM803BEGIN* TEST RESULTS - FM803 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YCABS - (158) INTRINSIC FUNCTION-- + + CABS (ABSOLUTE VALUE) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 9 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + + ------------------------------------------------------------------------------- + + 9 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 9 OF 9 TESTS EXECUTED + + *FM803END* END OF TEST - FM803 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM804.f b/Fortran/UnitTests/fcvs21_f95/FM804.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM804.f @@ -0,0 +1,360 @@ + PROGRAM FM804 + +C***********************************************************************00010804 +C***** FORTRAN 77 00020804 +C***** FM804 YDMOD - (160) 00030804 +C***** 00040804 +C***********************************************************************00050804 +C***** GENERAL PURPOSE ANS REF 00060804 +C***** TO TEST INTRINSIC FUNCTION - DMOD - 15.3 00070804 +C***** (REMAINDERING -TYPE DOUBLE PRECISION) (TABLE 5)00080804 +CBB** ********************** BBCCOMNT **********************************00090804 +C**** 00100804 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00110804 +C**** VERSION 2.1 00120804 +C**** 00130804 +C**** 00140804 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00150804 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00160804 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00170804 +C**** BUILDING 225 RM A266 00180804 +C**** GAITHERSBURG, MD 20899 00190804 +C**** 00200804 +C**** 00210804 +C**** 00220804 +CBE** ********************** BBCCOMNT **********************************00230804 +C***** 00240804 +C***** S P E C I F I C A T I O N S SEGMENT 160 00250804 +C***** 00260804 + DOUBLE PRECISION DQAVD, DQBVD, DQDVD, DQEVD, DQFVD 00270804 +C***** 00280804 +CBB** ********************** BBCINITA **********************************00290804 +C**** SPECIFICATION STATEMENTS 00300804 +C**** 00310804 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320804 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330804 +CBE** ********************** BBCINITA **********************************00340804 +CBB** ********************** BBCINITB **********************************00350804 +C**** INITIALIZE SECTION 00360804 + DATA ZVERS, ZVERSD, ZDATE 00370804 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380804 + DATA ZCOMPL, ZNAME, ZTAPE 00390804 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400804 + DATA ZPROJ, ZTAPED, ZPROG 00410804 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420804 + DATA REMRKS /' '/ 00430804 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440804 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450804 +C**** 00460804 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470804 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480804 +CZ03 ZPROG = 'PROGRAM NAME' 00490804 +CZ04 ZDATE = 'DATE OF TEST' 00500804 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510804 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520804 +CZ07 ZNAME = 'NAME OF USER' 00530804 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540804 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550804 +C 00560804 + IVPASS = 0 00570804 + IVFAIL = 0 00580804 + IVDELE = 0 00590804 + IVINSP = 0 00600804 + IVTOTL = 0 00610804 + IVTOTN = 0 00620804 + ICZERO = 0 00630804 +C 00640804 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650804 + I01 = 05 00660804 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670804 + I02 = 06 00680804 +C 00690804 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700804 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710804 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720804 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730804 +C 00740804 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750804 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760804 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770804 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780804 +C 00790804 +CBE** ********************** BBCINITB **********************************00800804 + NUVI = I02 00810804 + IVTOTL = 11 00820804 + ZPROG = 'FM804' 00830804 +CBB** ********************** BBCHED0A **********************************00840804 +C**** 00850804 +C**** WRITE REPORT TITLE 00860804 +C**** 00870804 + WRITE (I02, 90002) 00880804 + WRITE (I02, 90006) 00890804 + WRITE (I02, 90007) 00900804 + WRITE (I02, 90008) ZVERS, ZVERSD 00910804 + WRITE (I02, 90009) ZPROG, ZPROG 00920804 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930804 +CBE** ********************** BBCHED0A **********************************00940804 +C***** 00950804 +C***** HEADER FOR SEGMENT 160 00960804 + WRITE (NUVI, 16001) 00970804 +16001 FORMAT( " ", //" YDMOD - (160) INTRINSIC FUNCTION--" // 00980804 + 1 16X,"DMOD (REMAINDERING)" // 00990804 + 2 " ANS REF. - 15.3 " ) 01000804 +CBB** ********************** BBCHED0B **********************************01010804 +C**** WRITE DETAIL REPORT HEADERS 01020804 +C**** 01030804 + WRITE (I02,90004) 01040804 + WRITE (I02,90004) 01050804 + WRITE (I02,90013) 01060804 + WRITE (I02,90014) 01070804 + WRITE (I02,90015) IVTOTL 01080804 +CBE** ********************** BBCHED0B **********************************01090804 +C***** 01100804 +CT001* TEST 1 FIRST VALUE ZERO, SECOND NON-ZERO 01110804 + IVTNUM = 1 01120804 + DQBVD = 0.0D0 01130804 + DQDVD = 4.5D0 01140804 + DQAVD = DMOD(DQBVD, DQDVD) 01150804 + IF (DQAVD + 5.0D-10) 20010, 10010, 40010 01160804 +40010 IF (DQAVD - 5.0D-10) 10010, 10010, 20010 01170804 +10010 IVPASS = IVPASS + 1 01180804 + WRITE (NUVI, 80002) IVTNUM 01190804 + GO TO 0011 01200804 +20010 IVFAIL = IVFAIL + 1 01210804 + DVCORR = 0.0D0 01220804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01230804 + 0011 CONTINUE 01240804 +CT002* TEST 2 BOTH VALUES EQUAL 01250804 + IVTNUM = 2 01260804 + DQBVD = 0.35D1 01270804 + DQDVD = 0.35D1 01280804 + DQAVD = DMOD(DQBVD, DQDVD) 01290804 + IF (DQAVD + 5.0D-10) 20020, 10020, 40020 01300804 +40020 IF (DQAVD - 5.0D-10) 10020, 10020, 20020 01310804 +10020 IVPASS = IVPASS + 1 01320804 + WRITE (NUVI, 80002) IVTNUM 01330804 + GO TO 0021 01340804 +20020 IVFAIL = IVFAIL + 1 01350804 + DVCORR = 0.0D0 01360804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01370804 + 0021 CONTINUE 01380804 +CT003* TEST 3 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 01390804 + IVTNUM = 3 01400804 + DQBVD = -0.10D2 01410804 + DQDVD = -0.3D1 01420804 + DQAVD = DMOD(DQBVD, DQDVD) 01430804 + IF (DQAVD + 1.000000001D0) 20030, 10030, 40030 01440804 +40030 IF (DQAVD + 0.9999999995D0) 10030, 10030, 20030 01450804 +10030 IVPASS = IVPASS + 1 01460804 + WRITE (NUVI, 80002) IVTNUM 01470804 + GO TO 0031 01480804 +20030 IVFAIL = IVFAIL + 1 01490804 + DVCORR = -1.0D0 01500804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01510804 + 0031 CONTINUE 01520804 +CT004* TEST 4 FIRST MAGNITUDE LARGER, MULTIPLE OF SECOND 01530804 + IVTNUM = 4 01540804 + DQDVD = 1.5D0 01550804 + DQBVD = 1.5D0 + DQDVD + 1.5D0 01560804 + DQAVD = DMOD(DQBVD, DQDVD) 01570804 + IF (DQAVD + 5.0D-10) 20040, 10040, 40040 01580804 +40040 IF (DQAVD - 5.0D-10) 10040, 10040, 20040 01590804 +10040 IVPASS = IVPASS + 1 01600804 + WRITE (NUVI, 80002) IVTNUM 01610804 + GO TO 0041 01620804 +20040 IVFAIL = IVFAIL + 1 01630804 + DVCORR = 0.0D0 01640804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01650804 + 0041 CONTINUE 01660804 +CT005* TEST 5 FIRST MAGNITUDE LARGER, NOT MULTIPLE OF SECOND 01670804 + IVTNUM = 5 01680804 + DQBVD = 7.625D0 01690804 + DQDVD = 2.125D0 01700804 + DQAVD = DMOD(DQBVD, DQDVD) 01710804 + IF (DQAVD - 1.249999999D0) 20050, 10050, 40050 01720804 +40050 IF (DQAVD - 1.250000001D0) 10050, 10050, 20050 01730804 +10050 IVPASS = IVPASS + 1 01740804 + WRITE (NUVI, 80002) IVTNUM 01750804 + GO TO 0051 01760804 +20050 IVFAIL = IVFAIL + 1 01770804 + DVCORR = 1.25D0 01780804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01790804 + 0051 CONTINUE 01800804 +CT006* TEST 6 FIRST VALUE ZERO, SECOND NEGATIVE 01810804 + IVTNUM = 6 01820804 + DQBVD = 0.0D0 01830804 + DQDVD = -0.45D1 01840804 + DQAVD = DMOD(DQBVD, DQDVD) 01850804 + IF (DQAVD + 5.0D-10) 20060, 10060, 40060 01860804 +40060 IF (DQAVD - 5.0D-10) 10060, 10060, 20060 01870804 +10060 IVPASS = IVPASS + 1 01880804 + WRITE (NUVI, 80002) IVTNUM 01890804 + GO TO 0061 01900804 +20060 IVFAIL = IVFAIL + 1 01910804 + DVCORR = 0.0D0 01920804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 01930804 + 0061 CONTINUE 01940804 +CT007* TEST 7 BOTH VALUES EQUAL, BOTH NEGATIVE 01950804 + IVTNUM = 7 01960804 + DQBVD = -3.5D1 01970804 + DQDVD = -3.5D1 01980804 + DQAVD = DMOD(DQBVD, DQDVD) 01990804 + IF (DQAVD + 5.0D-10) 20070, 10070, 40070 02000804 +40070 IF (DQAVD - 5.0D-10) 10070, 10070, 20070 02010804 +10070 IVPASS = IVPASS + 1 02020804 + WRITE (NUVI, 80002) IVTNUM 02030804 + GO TO 0071 02040804 +20070 IVFAIL = IVFAIL + 1 02050804 + DVCORR = 0.0D0 02060804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 02070804 + 0071 CONTINUE 02080804 +CT008* TEST 8 FIRST MAGNITUDE LARGER, MULIPLES, BOTH NEGATIVE 02090804 + IVTNUM = 8 02100804 + DQDVD = 3.5D0 02110804 + DQBVD = -(3.5D0 + DQDVD + 3.5D0) 02120804 + DQAVD = DMOD(DQBVD, -DQDVD) 02130804 + IF (DQAVD + 5.0D-10) 20080, 10080, 40080 02140804 +40080 IF (DQAVD - 5.0D-10) 10080, 10080, 20080 02150804 +10080 IVPASS = IVPASS + 1 02160804 + WRITE (NUVI, 80002) IVTNUM 02170804 + GO TO 0081 02180804 +20080 IVFAIL = IVFAIL + 1 02190804 + DVCORR = 0.0D0 02200804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 02210804 + 0081 CONTINUE 02220804 +CT009* TEST 9 FIRST VALUE POSITIVE, SECOND NEGATIVE, MULTIPLE 02230804 + IVTNUM = 9 02240804 + DQBVD = 10.5D0 02250804 + DQDVD = -3.5D0 02260804 + DQAVD = DMOD(DQBVD, DQDVD) 02270804 + IF (DQAVD + 5.0D-10) 20090, 10090, 40090 02280804 +40090 IF (DQAVD - 5.0D-10) 10090, 10090, 20090 02290804 +10090 IVPASS = IVPASS + 1 02300804 + WRITE (NUVI, 80002) IVTNUM 02310804 + GO TO 0091 02320804 +20090 IVFAIL = IVFAIL + 1 02330804 + DVCORR = 0.0D0 02340804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 02350804 + 0091 CONTINUE 02360804 +CT010* TEST 10 FIRST VALUE ZERO PRECEDED BY MINUS SIGN 02370804 + IVTNUM = 10 02380804 + DQDVD = 0.0D0 02390804 + DQEVD = 4.5D0 02400804 + DQAVD = DMOD(-DQDVD, DQEVD) 02410804 + IF (DQAVD + 5.0D-10) 20100, 10100, 40100 02420804 +40100 IF (DQAVD - 5.0D-10) 10100, 10100, 20100 02430804 +10100 IVPASS = IVPASS + 1 02440804 + WRITE (NUVI, 80002) IVTNUM 02450804 + GO TO 0101 02460804 +20100 IVFAIL = IVFAIL + 1 02470804 + DVCORR = 0.0D0 02480804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 02490804 + 0101 CONTINUE 02500804 +CT011* TEST 11 PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT 02510804 + IVTNUM = 11 02520804 + DQDVD = 0.7625D1 02530804 + DQEVD = 0.2125D1 02540804 + DQFVD = 0.2D1 02550804 + DQAVD = DMOD(DQDVD - DQFVD, DQEVD + DQFVD) 02560804 + IF (DQAVD - 0.1499999999D1) 20110, 10110, 40110 02570804 +40110 IF (DQAVD - 0.1500000001D1) 10110, 10110, 20110 02580804 +10110 IVPASS = IVPASS + 1 02590804 + WRITE (NUVI, 80002) IVTNUM 02600804 + GO TO 0111 02610804 +20110 IVFAIL = IVFAIL + 1 02620804 + DVCORR = 0.15D1 02630804 + WRITE (NUVI, 80031) IVTNUM, DQAVD, DVCORR 02640804 + 0111 CONTINUE 02650804 +C***** 02660804 +CBB** ********************** BBCSUM0 **********************************02670804 +C**** WRITE OUT TEST SUMMARY 02680804 +C**** 02690804 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02700804 + WRITE (I02, 90004) 02710804 + WRITE (I02, 90014) 02720804 + WRITE (I02, 90004) 02730804 + WRITE (I02, 90020) IVPASS 02740804 + WRITE (I02, 90022) IVFAIL 02750804 + WRITE (I02, 90024) IVDELE 02760804 + WRITE (I02, 90026) IVINSP 02770804 + WRITE (I02, 90028) IVTOTN, IVTOTL 02780804 +CBE** ********************** BBCSUM0 **********************************02790804 +CBB** ********************** BBCFOOT0 **********************************02800804 +C**** WRITE OUT REPORT FOOTINGS 02810804 +C**** 02820804 + WRITE (I02,90016) ZPROG, ZPROG 02830804 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02840804 + WRITE (I02,90019) 02850804 +CBE** ********************** BBCFOOT0 **********************************02860804 +CBB** ********************** BBCFMT0A **********************************02870804 +C**** FORMATS FOR TEST DETAIL LINES 02880804 +C**** 02890804 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02900804 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02910804 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02920804 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02930804 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02940804 + 1I6,/," ",15X,"CORRECT= " ,I6) 02950804 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02960804 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02970804 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02980804 + 1A21,/," ",16X,"CORRECT= " ,A21) 02990804 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03000804 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03010804 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03020804 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03030804 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03040804 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03050804 +80050 FORMAT (" ",48X,A31) 03060804 +CBE** ********************** BBCFMT0A **********************************03070804 +CBB** ********************** BBCFMAT1 **********************************03080804 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03090804 +C**** 03100804 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03110804 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03120804 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03130804 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03140804 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03150804 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03160804 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03170804 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03180804 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03190804 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03200804 + 2"(",F12.5,", ",F12.5,")") 03210804 +CBE** ********************** BBCFMAT1 **********************************03220804 +CBB** ********************** BBCFMT0B **********************************03230804 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03240804 +C**** 03250804 +90002 FORMAT ("1") 03260804 +90004 FORMAT (" ") 03270804 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03280804 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03290804 +90008 FORMAT (" ",21X,A13,A17) 03300804 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03310804 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03320804 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03330804 + 1 7X,"REMARKS",24X) 03340804 +90014 FORMAT (" ","----------------------------------------------" , 03350804 + 1 "---------------------------------" ) 03360804 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03370804 +C**** 03380804 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03390804 +C**** 03400804 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03410804 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03420804 + 1 A13) 03430804 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03440804 +C**** 03450804 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03460804 +C**** 03470804 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03480804 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03490804 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03500804 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03510804 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03520804 +CBE** ********************** BBCFMT0B **********************************03530804 +C***** 03540804 +C***** END OF TEST SEGMENT 160 03550804 + STOP 03560804 + END 03570804 + 03580804 diff --git a/Fortran/UnitTests/fcvs21_f95/FM804.reference_output b/Fortran/UnitTests/fcvs21_f95/FM804.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM804.reference_output @@ -0,0 +1,46 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM804BEGIN* TEST RESULTS - FM804 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YDMOD - (160) INTRINSIC FUNCTION-- + + DMOD (REMAINDERING) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 11 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + + ------------------------------------------------------------------------------- + + 11 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 11 OF 11 TESTS EXECUTED + + *FM804END* END OF TEST - FM804 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM805.f b/Fortran/UnitTests/fcvs21_f95/FM805.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM805.f @@ -0,0 +1,486 @@ + PROGRAM FM805 + +C***********************************************************************00010805 +C***** FORTRAN 77 00020805 +C***** FM805 YDDIM - (164) 00030805 +C***** 00040805 +C***********************************************************************00050805 +C***** GENERAL PURPOSE ANS REF 00060805 +C***** TEST INTRINSIC FUNCTION DDIM AND PROD--POSITIVE 15.3 00070805 +C***** DIFFERENCE AND DOUBLE PRECISION PRODUCT, RESP. (TABLE 5)00080805 +C***** 00090805 +CBB** ********************** BBCCOMNT **********************************00100805 +C**** 00110805 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120805 +C**** VERSION 2.1 00130805 +C**** 00140805 +C**** 00150805 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160805 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170805 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180805 +C**** BUILDING 225 RM A266 00190805 +C**** GAITHERSBURG, MD 20899 00200805 +C**** 00210805 +C**** 00220805 +C**** 00230805 +CBE** ********************** BBCCOMNT **********************************00240805 +C***** 00250805 +C***** S P E C I F I C A T I O N S SEGMENT 164 00260805 + DOUBLE PRECISION DSAVD, DSBVD, DSDVD, DSEVD, DVCORR 00270805 +C***** 00280805 +CBB** ********************** BBCINITA **********************************00290805 +C**** SPECIFICATION STATEMENTS 00300805 +C**** 00310805 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320805 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330805 +CBE** ********************** BBCINITA **********************************00340805 +CBB** ********************** BBCINITB **********************************00350805 +C**** INITIALIZE SECTION 00360805 + DATA ZVERS, ZVERSD, ZDATE 00370805 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380805 + DATA ZCOMPL, ZNAME, ZTAPE 00390805 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400805 + DATA ZPROJ, ZTAPED, ZPROG 00410805 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420805 + DATA REMRKS /' '/ 00430805 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440805 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450805 +C**** 00460805 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470805 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480805 +CZ03 ZPROG = 'PROGRAM NAME' 00490805 +CZ04 ZDATE = 'DATE OF TEST' 00500805 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510805 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520805 +CZ07 ZNAME = 'NAME OF USER' 00530805 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540805 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550805 +C 00560805 + IVPASS = 0 00570805 + IVFAIL = 0 00580805 + IVDELE = 0 00590805 + IVINSP = 0 00600805 + IVTOTL = 0 00610805 + IVTOTN = 0 00620805 + ICZERO = 0 00630805 +C 00640805 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650805 + I01 = 05 00660805 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670805 + I02 = 06 00680805 +C 00690805 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700805 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710805 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720805 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730805 +C 00740805 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750805 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760805 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770805 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780805 +C 00790805 +CBE** ********************** BBCINITB **********************************00800805 + NUVI = I02 00810805 + IVTOTL = 18 00820805 + ZPROG = 'FM805' 00830805 +CBB** ********************** BBCHED0A **********************************00840805 +C**** 00850805 +C**** WRITE REPORT TITLE 00860805 +C**** 00870805 + WRITE (I02, 90002) 00880805 + WRITE (I02, 90006) 00890805 + WRITE (I02, 90007) 00900805 + WRITE (I02, 90008) ZVERS, ZVERSD 00910805 + WRITE (I02, 90009) ZPROG, ZPROG 00920805 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930805 +CBE** ********************** BBCHED0A **********************************00940805 +C***** 00950805 +C***** HEADER FOR SEGMENT 164 00960805 + WRITE (NUVI,16401) 00970805 +16401 FORMAT (" ",// 1X,"YDDIM - (164) INTRINSIC FUNCTIONS-- " //16X, 00980805 + 1 "DDIM (POSITIVE DIFFERENCE)" /,16X, 00990805 + 2 "DPROD (D.P. PRODUCT)" // 01000805 + 3 2X,"ANS REF. - 15.3" ) 01010805 +CBB** ********************** BBCHED0B **********************************01020805 +C**** WRITE DETAIL REPORT HEADERS 01030805 +C**** 01040805 + WRITE (I02,90004) 01050805 + WRITE (I02,90004) 01060805 + WRITE (I02,90013) 01070805 + WRITE (I02,90014) 01080805 + WRITE (I02,90015) IVTOTL 01090805 +CBE** ********************** BBCHED0B **********************************01100805 +C***** 01110805 +C***** TEST OF DDIM 01120805 +C***** 01130805 + WRITE(NUVI, 16402) 01140805 +16402 FORMAT(/ 8X, "TEST OF DDIM" ) 01150805 +CT001* TEST 1 BOTH VALUES EQUAL 01160805 + IVTNUM = 1 01170805 + DSBVD = 0.25D0 01180805 + DSDVD = 0.25D0 01190805 + DSAVD = DDIM(DSBVD, DSDVD) 01200805 + IF (DSAVD + 5.0D-10) 20010, 10010, 40010 01210805 +40010 IF (DSAVD - 5.0D-10) 10010, 10010, 20010 01220805 +10010 IVPASS = IVPASS + 1 01230805 + WRITE (NUVI, 80002) IVTNUM 01240805 + GO TO 0011 01250805 +20010 IVFAIL = IVFAIL + 1 01260805 + DVCORR = 0.0D0 01270805 + WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01280805 + 0011 CONTINUE 01290805 +CT002* TEST 2 BOTH VALUES EQUAL, INTEGRAL VALUES 01300805 + IVTNUM = 2 01310805 + DSBVD = 2.0D0 01320805 + DSDVD = 2.0D0 01330805 + DSAVD = DDIM(DSBVD, DSDVD) 01340805 + IF (DSAVD + 5.0D-10) 20020, 10020, 40020 01350805 +40020 IF (DSAVD - 5.0D-10) 10020, 10020, 20020 01360805 +10020 IVPASS = IVPASS + 1 01370805 + WRITE (NUVI, 80002) IVTNUM 01380805 + GO TO 0021 01390805 +20020 IVFAIL = IVFAIL + 1 01400805 + DVCORR = 0.0D0 01410805 + WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01420805 + 0021 CONTINUE 01430805 +CT003* TEST 3 FIRST VALUE LESS THAN SECOND 01440805 + IVTNUM = 3 01450805 + DSBVD = 0.25D1 01460805 + DSDVD = 0.55D1 01470805 + DSAVD = DDIM(DSBVD, DSDVD) 01480805 + IF (DSAVD + 5.0D-10) 20030, 10030, 40030 01490805 +40030 IF (DSAVD - 5.0D-10) 10030, 10030, 20030 01500805 +10030 IVPASS = IVPASS + 1 01510805 + WRITE (NUVI, 80002) IVTNUM 01520805 + GO TO 0031 01530805 +20030 IVFAIL = IVFAIL + 1 01540805 + DVCORR = 0.0D0 01550805 + WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01560805 + 0031 CONTINUE 01570805 +CT004* TEST 4 FIRST VALUE GREATER THAN SECOND 01580805 + IVTNUM = 4 01590805 + DSBVD = 0.55D1 01600805 + DSDVD = 0.25D1 01610805 + DSAVD = DDIM(DSBVD, DSDVD) 01620805 + IF (DSAVD - 2.999999998D0) 20040, 10040, 40040 01630805 +40040 IF (DSAVD - 3.000000002D0) 10040, 10040, 20040 01640805 +10040 IVPASS = IVPASS + 1 01650805 + WRITE (NUVI, 80002) IVTNUM 01660805 + GO TO 0041 01670805 +20040 IVFAIL = IVFAIL + 1 01680805 + DVCORR = 3.0D0 01690805 + WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01700805 + 0041 CONTINUE 01710805 +CT005* TEST 5 BOTH VALUES EQUAL, BOTH NEGATIVE 01720805 + IVTNUM = 5 01730805 + DSBVD = -0.25D1 01740805 + DSDVD = -0.25D1 01750805 + DSAVD = DDIM(DSBVD, DSDVD) 01760805 + IF (DSAVD + 5.0D-10) 20050, 10050, 40050 01770805 +40050 IF (DSAVD - 5.0D-10) 10050, 10050, 20050 01780805 +10050 IVPASS = IVPASS + 1 01790805 + WRITE (NUVI, 80002) IVTNUM 01800805 + GO TO 0051 01810805 +20050 IVFAIL = IVFAIL + 1 01820805 + DVCORR = 0.0D0 01830805 + WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01840805 + 0051 CONTINUE 01850805 +CT006* TEST 6 FIRST VALUE GREATER THAN SECOND, BOTH NEGATIVE 01860805 + IVTNUM = 6 01870805 + DSBVD = -0.25D1 01880805 + DSDVD = -0.55D1 01890805 + DSAVD = DDIM(DSBVD, DSDVD) 01900805 + IF (DSAVD - 2.999999998D0) 20060, 10060, 40060 01910805 +40060 IF (DSAVD - 3.000000002D0) 10060, 10060, 20060 01920805 +10060 IVPASS = IVPASS + 1 01930805 + WRITE (NUVI, 80002) IVTNUM 01940805 + GO TO 0061 01950805 +20060 IVFAIL = IVFAIL + 1 01960805 + DVCORR = 3.0D0 01970805 + WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 01980805 + 0061 CONTINUE 01990805 +CT007* TEST 7 FIRST VALUE POSITIVE, SECOND NEGATIVE 02000805 + IVTNUM = 7 02010805 + DSBVD = 0.55D1 02020805 + DSDVD = -0.25D1 02030805 + DSAVD = DDIM(DSBVD, DSDVD) 02040805 + IF (DSAVD - 7.999999996D0) 20070, 10070, 40070 02050805 +40070 IF (DSAVD - 8.000000004D0) 10070, 10070, 20070 02060805 +10070 IVPASS = IVPASS + 1 02070805 + WRITE (NUVI, 80002) IVTNUM 02080805 + GO TO 0071 02090805 +20070 IVFAIL = IVFAIL + 1 02100805 + DVCORR = 8.0D0 02110805 + WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 02120805 + 0071 CONTINUE 02130805 +CT008* TEST 8 ARITHMETIC EXPRESSION PRESENTED TO DDIM 02140805 + IVTNUM = 8 02150805 + DSDVD = 0.25D1 02160805 + DSEVD = 0.125D1 02170805 + DSAVD = DDIM(DSDVD / DSEVD, DSDVD * DSEVD) 02180805 + IF (DSAVD + 5.0D-10) 20080, 10080, 40080 02190805 +40080 IF (DSAVD - 5.0D-10) 10080, 10080, 20080 02200805 +10080 IVPASS = IVPASS + 1 02210805 + WRITE (NUVI, 80002) IVTNUM 02220805 + GO TO 0081 02230805 +20080 IVFAIL = IVFAIL + 1 02240805 + DVCORR = 0.0D0 02250805 + WRITE (NUVI, 80031) IVTNUM, DSAVD, DVCORR 02260805 + 0081 CONTINUE 02270805 +C***** 02280805 +C***** TEST OF DPROD 02290805 +C***** 02300805 + WRITE(NUVI, 16404) 02310805 + REMRKS = '+ OR - 0.00005' 02320805 +16404 FORMAT(// 8X, "TEST OF DPROD" ) 02330805 +CT009* TEST 9 PAIR OF VALUES, ONE OF WHICH IS ZERO 02340805 + IVTNUM = 9 02350805 + RSAVS = 0.0 02360805 + RSBVS = 2.0 02370805 + DSAVD = DPROD(RSAVS, RSBVS) 02380805 + IF (DSAVD + 5.0D-5) 20090, 10090, 40090 02390805 +40090 IF (DSAVD - 5.0D-5) 10090, 10090, 20090 02400805 +10090 IVPASS = IVPASS + 1 02410805 + WRITE (NUVI, 80002) IVTNUM 02420805 + GO TO 0091 02430805 +20090 IVFAIL = IVFAIL + 1 02440805 + DVCORR = 0.0D0 02450805 + WRITE (NUVI, 80008) IVTNUM 02460805 + WRITE (NUVI, 80033) DSAVD 02470805 + WRITE (NUVI, 80035) DVCORR, REMRKS 02480805 + 0091 CONTINUE 02490805 +CT010* TEST 10 PAIR OF VALUES, ONE OF WHICH IS ONE 02500805 + IVTNUM = 10 02510805 + RSAVS = 1.0 02520805 + RSBVS = 2.0 02530805 + DSAVD = DPROD(RSAVS, RSBVS) 02540805 + IF (DSAVD - 1.9999D0) 20100, 10100, 40100 02550805 +40100 IF (DSAVD - 2.0001D0) 10100, 10100, 20100 02560805 +10100 IVPASS = IVPASS + 1 02570805 + WRITE (NUVI, 80002) IVTNUM 02580805 + GO TO 0101 02590805 +20100 IVFAIL = IVFAIL + 1 02600805 + DVCORR = 2.0D0 02610805 + WRITE (NUVI, 80008) IVTNUM 02620805 + WRITE (NUVI, 80033) DSAVD 02630805 + WRITE (NUVI, 80035) DVCORR, REMRKS 02640805 + 0101 CONTINUE 02650805 +CT011* TEST 11 PAIR OF NON-ZERO VALUES 02660805 + IVTNUM = 11 02670805 + RSAVS = 3.333333 02680805 + RSBVS = 2.3948094 02690805 + DSAVD = DPROD(RSAVS, RSBVS) 02700805 + IF (DSAVD - 7.9823D0) 20110, 10110, 40110 02710805 +40110 IF (DSAVD - 7.9831D0) 10110, 10110, 20110 02720805 +10110 IVPASS = IVPASS + 1 02730805 + WRITE (NUVI, 80002) IVTNUM 02740805 + GO TO 0111 02750805 +20110 IVFAIL = IVFAIL + 1 02760805 + DVCORR = 7.982697202D0 02770805 + WRITE (NUVI, 80008) IVTNUM 02780805 + WRITE (NUVI, 80033) DSAVD 02790805 + WRITE (NUVI, 80035) DVCORR, REMRKS 02800805 + 0111 CONTINUE 02810805 +CT012* TEST 12 ONE POSITIVE, ONE NEGATIVE 02820805 + IVTNUM = 12 02830805 + RSAVS = 0.123456 02840805 + RSBVS = -2.98765 02850805 + DSAVD = DPROD(RSAVS, RSBVS) 02860805 + IF (DSAVD + 3.6887D-1) 20120, 10120, 40120 02870805 +40120 IF (DSAVD + 3.6882D-1) 10120, 10120, 20120 02880805 +10120 IVPASS = IVPASS + 1 02890805 + WRITE (NUVI, 80002) IVTNUM 02900805 + GO TO 0121 02910805 +20120 IVFAIL = IVFAIL + 1 02920805 + DVCORR = -3.688433184D-1 02930805 + WRITE (NUVI, 80008) IVTNUM 02940805 + WRITE (NUVI, 80033) DSAVD 02950805 + WRITE (NUVI, 80035) DVCORR, REMRKS 02960805 + 0121 CONTINUE 02970805 +CT013* TEST 13 ONE VALUE ONE(1), ONE NEGATIVE 02980805 + IVTNUM = 13 02990805 + RSAVS = 1.0834001 03000805 + RSBVS = -2.034985 03010805 + DSAVD = DPROD(RSAVS, RSBVS) 03020805 + IF (DSAVD + 2.2049D0) 20130, 10130, 40130 03030805 +40130 IF (DSAVD + 2.2045D0) 10130, 10130, 20130 03040805 +10130 IVPASS = IVPASS + 1 03050805 + WRITE (NUVI, 80002) IVTNUM 03060805 + GO TO 0131 03070805 +20130 IVFAIL = IVFAIL + 1 03080805 + DVCORR = -2.204702953D0 03090805 + WRITE (NUVI, 80008) IVTNUM 03100805 + WRITE (NUVI, 80033) DSAVD 03110805 + WRITE (NUVI, 80035) DVCORR, REMRKS 03120805 + 0131 CONTINUE 03130805 +CT014* TEST 14 PAIR OF NEGATIVE VALUES 03140805 + IVTNUM = 14 03150805 + RSAVS = -3.077734 03160805 + RSBVS = -2.348343 03170805 + DSAVD = DPROD(RSAVS, RSBVS) 03180805 + IF (DSAVD - 7.2272D0) 20140, 10140, 40140 03190805 +40140 IF (DSAVD - 7.2280D0) 10140, 10140, 20140 03200805 +10140 IVPASS = IVPASS + 1 03210805 + WRITE (NUVI, 80002) IVTNUM 03220805 + GO TO 0141 03230805 +20140 IVFAIL = IVFAIL + 1 03240805 + DVCORR = 7.227575095D0 03250805 + WRITE (NUVI, 80008) IVTNUM 03260805 + WRITE (NUVI, 80033) DSAVD 03270805 + WRITE (NUVI, 80035) DVCORR, REMRKS 03280805 + 0141 CONTINUE 03290805 +CT015* TEST 15 ONE POSITIVE VALUE, ONE NEGATIVE VALUE 03300805 + IVTNUM = 15 03310805 + RSAVS = 3.3333324 03320805 + RSBVS = -2.343953 03330805 + DSAVD = DPROD(RSAVS, RSBVS) 03340805 + IF (DSAVD + 7.8136D0) 20150, 10150, 40150 03350805 +40150 IF (DSAVD + 7.8127D0) 10150, 10150, 20150 03360805 +10150 IVPASS = IVPASS + 1 03370805 + WRITE (NUVI, 80002) IVTNUM 03380805 + GO TO 0151 03390805 +20150 IVFAIL = IVFAIL + 1 03400805 + DVCORR = -7.813174479D0 03410805 + WRITE (NUVI, 80008) IVTNUM 03420805 + WRITE (NUVI, 80033) DSAVD 03430805 + WRITE (NUVI, 80035) DVCORR, REMRKS 03440805 + 0151 CONTINUE 03450805 +CT016* TEST 16 ARITHMETIC EXPRESSION PRESENTED TO DPROD 03460805 + IVTNUM = 16 03470805 + RSAVS = 1.555674 03480805 + RSBVS = 2.00012 03490805 + DSAVD = DPROD(RSAVS - RSBVS, RSAVS + RSBVS) 03500805 + IF (DSAVD + 1.5805D0) 20160, 10160, 40160 03510805 +40160 IF (DSAVD + 1.5802D0) 10160, 10160, 20160 03520805 +10160 IVPASS = IVPASS + 1 03530805 + WRITE (NUVI, 80002) IVTNUM 03540805 + GO TO 0161 03550805 +20160 IVFAIL = IVFAIL + 1 03560805 + DVCORR = -1.580358420D0 03570805 + WRITE (NUVI, 80008) IVTNUM 03580805 + WRITE (NUVI, 80033) DSAVD 03590805 + WRITE (NUVI, 80035) DVCORR, REMRKS 03600805 + 0161 CONTINUE 03610805 +CT017* TEST 17 DPROD FORMS THE ARGUMENTS TO DDIM 03620805 + IVTNUM = 17 03630805 + DSAVD = DDIM(DPROD(0.4, 2.0), DPROD(3.0, 0.1)) 03640805 + IF (DSAVD - 0.49997D0) 20170, 10170, 40170 03650805 +40170 IF (DSAVD - 0.50003D0) 10170, 10170, 20170 03660805 +10170 IVPASS = IVPASS + 1 03670805 + WRITE (NUVI, 80002) IVTNUM 03680805 + GO TO 0171 03690805 +20170 IVFAIL = IVFAIL + 1 03700805 + DVCORR = 0.5D0 03710805 + WRITE (NUVI, 80008) IVTNUM 03720805 + WRITE (NUVI, 80033) DSAVD 03730805 + WRITE (NUVI, 80035) DVCORR, REMRKS 03740805 + 0171 CONTINUE 03750805 +CT018* TEST 18 ARGUMENTS WITH HIGH AND LOW MAGNITUDES 03760805 + IVTNUM = 18 03770805 + RSAVS = 1.23456E-33 03780805 + RSBVS = 1.23456E+34 03790805 + DSAVD = DPROD(RSAVS, RSBVS) 03800805 + IF (DSAVD - 1.5240D1) 20180, 10180, 40180 03810805 +40180 IF (DSAVD - 1.5242D1) 10180, 10180, 20180 03820805 +10180 IVPASS = IVPASS + 1 03830805 + WRITE (NUVI, 80002) IVTNUM 03840805 + GO TO 0181 03850805 +20180 IVFAIL = IVFAIL + 1 03860805 + DVCORR = 1.524138394D1 03870805 + WRITE (NUVI, 80008) IVTNUM 03880805 + WRITE (NUVI, 80033) DSAVD 03890805 + WRITE (NUVI, 80035) DVCORR, REMRKS 03900805 + 0181 CONTINUE 03910805 +C***** 03920805 +CBB** ********************** BBCSUM0 **********************************03930805 +C**** WRITE OUT TEST SUMMARY 03940805 +C**** 03950805 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03960805 + WRITE (I02, 90004) 03970805 + WRITE (I02, 90014) 03980805 + WRITE (I02, 90004) 03990805 + WRITE (I02, 90020) IVPASS 04000805 + WRITE (I02, 90022) IVFAIL 04010805 + WRITE (I02, 90024) IVDELE 04020805 + WRITE (I02, 90026) IVINSP 04030805 + WRITE (I02, 90028) IVTOTN, IVTOTL 04040805 +CBE** ********************** BBCSUM0 **********************************04050805 +CBB** ********************** BBCFOOT0 **********************************04060805 +C**** WRITE OUT REPORT FOOTINGS 04070805 +C**** 04080805 + WRITE (I02,90016) ZPROG, ZPROG 04090805 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04100805 + WRITE (I02,90019) 04110805 +CBE** ********************** BBCFOOT0 **********************************04120805 +CBB** ********************** BBCFMT0A **********************************04130805 +C**** FORMATS FOR TEST DETAIL LINES 04140805 +C**** 04150805 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04160805 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04170805 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04180805 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04190805 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04200805 + 1I6,/," ",15X,"CORRECT= " ,I6) 04210805 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04220805 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04230805 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04240805 + 1A21,/," ",16X,"CORRECT= " ,A21) 04250805 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04260805 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04270805 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04280805 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04290805 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04300805 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04310805 +80050 FORMAT (" ",48X,A31) 04320805 +CBE** ********************** BBCFMT0A **********************************04330805 +CBB** ********************** BBCFMAT1 **********************************04340805 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04350805 +C**** 04360805 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04370805 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04380805 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04390805 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04400805 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04410805 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04420805 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04430805 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04440805 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04450805 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04460805 + 2"(",F12.5,", ",F12.5,")") 04470805 +CBE** ********************** BBCFMAT1 **********************************04480805 +CBB** ********************** BBCFMT0B **********************************04490805 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04500805 +C**** 04510805 +90002 FORMAT ("1") 04520805 +90004 FORMAT (" ") 04530805 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04540805 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04550805 +90008 FORMAT (" ",21X,A13,A17) 04560805 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04570805 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04580805 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04590805 + 1 7X,"REMARKS",24X) 04600805 +90014 FORMAT (" ","----------------------------------------------" , 04610805 + 1 "---------------------------------" ) 04620805 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04630805 +C**** 04640805 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04650805 +C**** 04660805 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04670805 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04680805 + 1 A13) 04690805 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04700805 +C**** 04710805 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04720805 +C**** 04730805 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04740805 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04750805 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04760805 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04770805 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04780805 +CBE** ********************** BBCFMT0B **********************************04790805 +C***** 04800805 +C***** END OF TEST SEGMENT 164 04810805 + STOP 04820805 + END 04830805 + 04840805 diff --git a/Fortran/UnitTests/fcvs21_f95/FM805.reference_output b/Fortran/UnitTests/fcvs21_f95/FM805.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM805.reference_output @@ -0,0 +1,59 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM805BEGIN* TEST RESULTS - FM805 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YDDIM - (164) INTRINSIC FUNCTIONS-- + + DDIM (POSITIVE DIFFERENCE) + DPROD (D.P. PRODUCT) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 18 TESTS + + + TEST OF DDIM + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + + + TEST OF DPROD + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + + ------------------------------------------------------------------------------- + + 18 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 18 OF 18 TESTS EXECUTED + + *FM805END* END OF TEST - FM805 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM806.f b/Fortran/UnitTests/fcvs21_f95/FM806.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM806.f @@ -0,0 +1,372 @@ + PROGRAM FM806 + +C***********************************************************************00010806 +C***** FORTRAN 77 00020806 +C***** FM806 YDMAX1 - (166) 00030806 +C***** 00040806 +C***********************************************************************00050806 +C***** GENERAL PURPOSE ANS REF 00060806 +C***** TEST OF INTRINSIC FUNCTION -- 15.3 00070806 +C***** DMAX1 -- CHOOSING LARGEST VALUE (TABLE 5)00080806 +C***** 00090806 +CBB** ********************** BBCCOMNT **********************************00100806 +C**** 00110806 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120806 +C**** VERSION 2.1 00130806 +C**** 00140806 +C**** 00150806 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160806 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170806 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180806 +C**** BUILDING 225 RM A266 00190806 +C**** GAITHERSBURG, MD 20899 00200806 +C**** 00210806 +C**** 00220806 +C**** 00230806 +CBE** ********************** BBCCOMNT **********************************00240806 +C***** S P E C I F I C A T I O N S SEGMENT 166 00250806 + DOUBLE PRECISION DTAVD, DTBVD, DTCVD, DTDVD, DTEVD, DVCORR 00260806 +C***** 00270806 +CBB** ********************** BBCINITA **********************************00280806 +C**** SPECIFICATION STATEMENTS 00290806 +C**** 00300806 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00310806 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00320806 +CBE** ********************** BBCINITA **********************************00330806 +CBB** ********************** BBCINITB **********************************00340806 +C**** INITIALIZE SECTION 00350806 + DATA ZVERS, ZVERSD, ZDATE 00360806 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00370806 + DATA ZCOMPL, ZNAME, ZTAPE 00380806 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00390806 + DATA ZPROJ, ZTAPED, ZPROG 00400806 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00410806 + DATA REMRKS /' '/ 00420806 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00430806 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00440806 +C**** 00450806 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00460806 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00470806 +CZ03 ZPROG = 'PROGRAM NAME' 00480806 +CZ04 ZDATE = 'DATE OF TEST' 00490806 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00500806 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00510806 +CZ07 ZNAME = 'NAME OF USER' 00520806 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00530806 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00540806 +C 00550806 + IVPASS = 0 00560806 + IVFAIL = 0 00570806 + IVDELE = 0 00580806 + IVINSP = 0 00590806 + IVTOTL = 0 00600806 + IVTOTN = 0 00610806 + ICZERO = 0 00620806 +C 00630806 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00640806 + I01 = 05 00650806 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00660806 + I02 = 06 00670806 +C 00680806 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00690806 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00700806 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00710806 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00720806 +C 00730806 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00740806 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00750806 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00760806 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00770806 +C 00780806 +CBE** ********************** BBCINITB **********************************00790806 + NUVI = I02 00800806 + IVTOTL = 12 00810806 + ZPROG = 'FM806' 00820806 +CBB** ********************** BBCHED0A **********************************00830806 +C**** 00840806 +C**** WRITE REPORT TITLE 00850806 +C**** 00860806 + WRITE (I02, 90002) 00870806 + WRITE (I02, 90006) 00880806 + WRITE (I02, 90007) 00890806 + WRITE (I02, 90008) ZVERS, ZVERSD 00900806 + WRITE (I02, 90009) ZPROG, ZPROG 00910806 + WRITE (I02, 90010) ZDATE, ZCOMPL 00920806 +CBE** ********************** BBCHED0A **********************************00930806 +C***** 00940806 + WRITE (NUVI,16601) 00950806 +16601 FORMAT (" ", // 1X,"YDMAX1 - (166) INTRINSIC FUNCTION-- " //17X,00960806 + 1 "DMAX1 (CHOOSING LARGEST VALUE)" //2X, 00970806 + 2 "ANS REF. - 15.3" ) 00980806 +CBB** ********************** BBCHED0B **********************************00990806 +C**** WRITE DETAIL REPORT HEADERS 01000806 +C**** 01010806 + WRITE (I02,90004) 01020806 + WRITE (I02,90004) 01030806 + WRITE (I02,90013) 01040806 + WRITE (I02,90014) 01050806 + WRITE (I02,90015) IVTOTL 01060806 +CBE** ********************** BBCHED0B **********************************01070806 +C***** 01080806 +CT001* TEST 1 BOTH ZEROES 01090806 + IVTNUM = 1 01100806 + DTBVD = 0.0D0 01110806 + DTDVD = 0.0D0 01120806 + DTAVD = DMAX1(DTBVD, DTDVD) 01130806 + IF (DTAVD + 5.0D-10) 20010, 10010, 40010 01140806 +40010 IF (DTAVD - 5.0D-10) 10010, 10010, 20010 01150806 +10010 IVPASS = IVPASS + 1 01160806 + WRITE (NUVI, 80002) IVTNUM 01170806 + GO TO 0011 01180806 +20010 IVFAIL = IVFAIL + 1 01190806 + DVCORR = 0.0D0 01200806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 01210806 + 0011 CONTINUE 01220806 +CT002* TEST 2 ONE NON-ZERO, ONE ZERO 01230806 + IVTNUM = 2 01240806 + DTBVD = 5.625D0 01250806 + DTDVD = 0.0D0 01260806 + DTAVD = DMAX1(DTBVD, DTDVD) 01270806 + IF (DTAVD - 5.624999997D0) 20020, 10020, 40020 01280806 +40020 IF (DTAVD - 5.625000003D0) 10020, 10020, 20020 01290806 +10020 IVPASS = IVPASS + 1 01300806 + WRITE (NUVI, 80002) IVTNUM 01310806 + GO TO 0021 01320806 +20020 IVFAIL = IVFAIL + 1 01330806 + DVCORR = 5.625D0 01340806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 01350806 + 0021 CONTINUE 01360806 +CT003* TEST 3 BOTH VALUES EQUAL 01370806 + IVTNUM = 3 01380806 + DTBVD = 6.5D0 01390806 + DTDVD = 6.5D0 01400806 + DTAVD = DMAX1(DTBVD, DTDVD) 01410806 + IF (DTAVD - 6.499999996D0) 20030, 10030, 40030 01420806 +40030 IF (DTAVD - 6.500000004D0) 10030, 10030, 20030 01430806 +10030 IVPASS = IVPASS + 1 01440806 + WRITE (NUVI, 80002) IVTNUM 01450806 + GO TO 0031 01460806 +20030 IVFAIL = IVFAIL + 1 01470806 + DVCORR = 6.5D0 01480806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 01490806 + 0031 CONTINUE 01500806 +CT004* TEST 4 VALUES NOT EQUAL 01510806 + IVTNUM = 4 01520806 + DTBVD = 7.125D0 01530806 + DTDVD = 5.125D0 01540806 + DTAVD = DMAX1(DTBVD, DTDVD) 01550806 + IF (DTAVD - 7.124999996D0) 20040, 10040, 40040 01560806 +40040 IF (DTAVD - 7.125000004D0) 10040, 10040, 20040 01570806 +10040 IVPASS = IVPASS + 1 01580806 + WRITE (NUVI, 80002) IVTNUM 01590806 + GO TO 0041 01600806 +20040 IVFAIL = IVFAIL + 1 01610806 + DVCORR = 7.125D0 01620806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 01630806 + 0041 CONTINUE 01640806 +CT005* TEST 5 ONE VALUE ZERO, ONE NEGATIVE 01650806 + IVTNUM = 5 01660806 + DTBVD = -5.625D0 01670806 + DTDVD = 0.0D0 01680806 + DTAVD = DMAX1(DTBVD, DTDVD) 01690806 + IF (DTAVD + 5.0D-10) 20050, 10050, 40050 01700806 +40050 IF (DTAVD - 5.0D-10) 10050, 10050, 20050 01710806 +10050 IVPASS = IVPASS + 1 01720806 + WRITE (NUVI, 80002) IVTNUM 01730806 + GO TO 0051 01740806 +20050 IVFAIL = IVFAIL + 1 01750806 + DVCORR = 0.0D0 01760806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 01770806 + 0051 CONTINUE 01780806 +CT006* TEST 6 BOTH VALUES EQUAL, BOTH NEGATIVE 01790806 + IVTNUM = 6 01800806 + DTBVD = -6.5D0 01810806 + DTDVD = -6.5D0 01820806 + DTAVD = DMAX1(DTBVD, DTDVD) 01830806 + IF (DTAVD + 6.500000004D0) 20060, 10060, 40060 01840806 +40060 IF (DTAVD + 6.499999996D0) 10060, 10060, 20060 01850806 +10060 IVPASS = IVPASS + 1 01860806 + WRITE (NUVI, 80002) IVTNUM 01870806 + GO TO 0061 01880806 +20060 IVFAIL = IVFAIL + 1 01890806 + DVCORR = -6.5D0 01900806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 01910806 + 0061 CONTINUE 01920806 +CT007* TEST 7 VALUES NOT EQUAL, BOTH NEGATIVE 01930806 + IVTNUM = 7 01940806 + DTBVD = -7.125D0 01950806 + DTDVD = -5.125D0 01960806 + DTAVD = DMAX1(DTBVD, DTDVD) 01970806 + IF (DTAVD + 5.125000003D0) 20070, 10070, 40070 01980806 +40070 IF (DTAVD + 5.124999997D0) 10070, 10070, 20070 01990806 +10070 IVPASS = IVPASS + 1 02000806 + WRITE (NUVI, 80002) IVTNUM 02010806 + GO TO 0071 02020806 +20070 IVFAIL = IVFAIL + 1 02030806 + DVCORR = -5.125D0 02040806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 02050806 + 0071 CONTINUE 02060806 +CT008* TEST 8 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN 02070806 + IVTNUM = 8 02080806 + DTDVD = 5.625D0 02090806 + DTEVD = 0.0D0 02100806 + DTAVD = DMAX1(DTDVD, -DTEVD) 02110806 + IF (DTAVD - 5.624999997D0) 20080, 10080, 40080 02120806 +40080 IF (DTAVD - 5.625000003D0) 10080, 10080, 20080 02130806 +10080 IVPASS = IVPASS + 1 02140806 + WRITE (NUVI, 80002) IVTNUM 02150806 + GO TO 0081 02160806 +20080 IVFAIL = IVFAIL + 1 02170806 + DVCORR = 5.625D0 02180806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 02190806 + 0081 CONTINUE 02200806 +CT009* TEST 9 ARITHMETIC EXPRESSIONS PRESENTED TO FUNCTION 02210806 + IVTNUM = 9 02220806 + DTDVD = 3.5D0 02230806 + DTEVD = 4.0D0 02240806 + DTAVD = DMAX1(DTDVD + DTEVD, -DTEVD - DTDVD) 02250806 + IF (DTAVD - 7.499999996D0) 20090, 10090, 40090 02260806 +40090 IF (DTAVD - 7.500000004D0) 10090, 10090, 20090 02270806 +10090 IVPASS = IVPASS + 1 02280806 + WRITE (NUVI, 80002) IVTNUM 02290806 + GO TO 0091 02300806 +20090 IVFAIL = IVFAIL + 1 02310806 + DVCORR = 7.5D0 02320806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 02330806 + 0091 CONTINUE 02340806 +CT010* TEST 10 3 ARGUMENTS 02350806 + IVTNUM = 10 02360806 + DTBVD = 0.0D0 02370806 + DTCVD = -1.99D0 02380806 + DTAVD = DMAX1(DTCVD, DTBVD, -DTCVD) 02390806 + IF (DTAVD - 1.98999999D0) 20100, 10100, 40100 02400806 +40100 IF (DTAVD - 1.99000001D0) 10100, 10100, 20100 02410806 +10100 IVPASS = IVPASS + 1 02420806 + WRITE (NUVI, 80002) IVTNUM 02430806 + GO TO 0101 02440806 +20100 IVFAIL = IVFAIL + 1 02450806 + DVCORR = 1.99D0 02460806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 02470806 + 0101 CONTINUE 02480806 +CT011* TEST 11 4 ARGUMENTS 02490806 + IVTNUM = 11 02500806 +C***** ARGUMENTS OF HIGH AND LOW MAGNITUDES 02510806 + DTAVD = 1.0D-34 02520806 + DTBVD = -1.0D-34 02530806 + DTCVD = 1.0D+34 02540806 + DTAVD = DMAX1(DTAVD, DTBVD, DTCVD, -DTCVD) 02550806 + IF (DTAVD - 0.9999999995D34) 20110, 10110, 40110 02560806 +40110 IF (DTAVD - 1.000000001D34) 10110, 10110, 20110 02570806 +10110 IVPASS = IVPASS + 1 02580806 + WRITE (NUVI, 80002) IVTNUM 02590806 + GO TO 0111 02600806 +20110 IVFAIL = IVFAIL + 1 02610806 + DVCORR = 1.0D+34 02620806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 02630806 + 0111 CONTINUE 02640806 +CT012* TEST 12 5 ARGUMENTS 02650806 + IVTNUM = 12 02660806 + DTDVD = 3.5D0 02670806 + DTEVD = 4.5D0 02680806 + DTAVD = DMAX1(DTDVD, -DTDVD, -DTEVD, +DTDVD, DTEVD) 02690806 + IF (DTAVD - 4.499999997D0) 20120, 10120, 40120 02700806 +40120 IF (DTAVD - 4.500000003D0) 10120, 10120, 20120 02710806 +10120 IVPASS = IVPASS + 1 02720806 + WRITE (NUVI, 80002) IVTNUM 02730806 + GO TO 0121 02740806 +20120 IVFAIL = IVFAIL + 1 02750806 + DVCORR = 4.5D0 02760806 + WRITE (NUVI, 80031) IVTNUM, DTAVD, DVCORR 02770806 + 0121 CONTINUE 02780806 +C***** 02790806 +CBB** ********************** BBCSUM0 **********************************02800806 +C**** WRITE OUT TEST SUMMARY 02810806 +C**** 02820806 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02830806 + WRITE (I02, 90004) 02840806 + WRITE (I02, 90014) 02850806 + WRITE (I02, 90004) 02860806 + WRITE (I02, 90020) IVPASS 02870806 + WRITE (I02, 90022) IVFAIL 02880806 + WRITE (I02, 90024) IVDELE 02890806 + WRITE (I02, 90026) IVINSP 02900806 + WRITE (I02, 90028) IVTOTN, IVTOTL 02910806 +CBE** ********************** BBCSUM0 **********************************02920806 +CBB** ********************** BBCFOOT0 **********************************02930806 +C**** WRITE OUT REPORT FOOTINGS 02940806 +C**** 02950806 + WRITE (I02,90016) ZPROG, ZPROG 02960806 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02970806 + WRITE (I02,90019) 02980806 +CBE** ********************** BBCFOOT0 **********************************02990806 +CBB** ********************** BBCFMT0A **********************************03000806 +C**** FORMATS FOR TEST DETAIL LINES 03010806 +C**** 03020806 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03030806 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03040806 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03050806 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03060806 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03070806 + 1I6,/," ",15X,"CORRECT= " ,I6) 03080806 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03090806 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03100806 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03110806 + 1A21,/," ",16X,"CORRECT= " ,A21) 03120806 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03130806 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03140806 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03150806 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03160806 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03170806 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03180806 +80050 FORMAT (" ",48X,A31) 03190806 +CBE** ********************** BBCFMT0A **********************************03200806 +CBB** ********************** BBCFMAT1 **********************************03210806 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03220806 +C**** 03230806 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03240806 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03250806 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03260806 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03270806 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03280806 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03290806 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03300806 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03310806 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03320806 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03330806 + 2"(",F12.5,", ",F12.5,")") 03340806 +CBE** ********************** BBCFMAT1 **********************************03350806 +CBB** ********************** BBCFMT0B **********************************03360806 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03370806 +C**** 03380806 +90002 FORMAT ("1") 03390806 +90004 FORMAT (" ") 03400806 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03410806 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03420806 +90008 FORMAT (" ",21X,A13,A17) 03430806 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03440806 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03450806 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03460806 + 1 7X,"REMARKS",24X) 03470806 +90014 FORMAT (" ","----------------------------------------------" , 03480806 + 1 "---------------------------------" ) 03490806 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03500806 +C**** 03510806 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03520806 +C**** 03530806 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03540806 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03550806 + 1 A13) 03560806 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03570806 +C**** 03580806 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03590806 +C**** 03600806 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03610806 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03620806 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03630806 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03640806 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03650806 +CBE** ********************** BBCFMT0B **********************************03660806 +C***** END OF TEST SEGMENT 166 03670806 + STOP 03680806 + END 03690806 + 03700806 diff --git a/Fortran/UnitTests/fcvs21_f95/FM806.reference_output b/Fortran/UnitTests/fcvs21_f95/FM806.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM806.reference_output @@ -0,0 +1,47 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM806BEGIN* TEST RESULTS - FM806 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YDMAX1 - (166) INTRINSIC FUNCTION-- + + DMAX1 (CHOOSING LARGEST VALUE) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 12 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ------------------------------------------------------------------------------- + + 12 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 12 OF 12 TESTS EXECUTED + + *FM806END* END OF TEST - FM806 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM807.f b/Fortran/UnitTests/fcvs21_f95/FM807.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM807.f @@ -0,0 +1,373 @@ + PROGRAM FM807 + +C***********************************************************************00010807 +C***** FORTRAN 77 00020807 +C***** FM807 YDMIN1 - (168) 00030807 +C***** 00040807 +C***********************************************************************00050807 +C***** GENERAL PURPOSE ANS REF 00060807 +C***** TEST OF INTRINSIC FUNCTION -- 15.3 00070807 +C***** DMIN1 -- CHOOSING SMALLEST VALUE (TABLE 5)00080807 +C***** 00090807 +CBB** ********************** BBCCOMNT **********************************00100807 +C**** 00110807 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120807 +C**** VERSION 2.1 00130807 +C**** 00140807 +C**** 00150807 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160807 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170807 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180807 +C**** BUILDING 225 RM A266 00190807 +C**** GAITHERSBURG, MD 20899 00200807 +C**** 00210807 +C**** 00220807 +C**** 00230807 +CBE** ********************** BBCCOMNT **********************************00240807 +C***** S P E C I F I C A T I O N S SEGMENT 168 00250807 + DOUBLE PRECISION DUAVD, DUBVD, DUCVD, DUDVD, DUEVD, DVCORR 00260807 +CBB** ********************** BBCINITA **********************************00270807 +C**** SPECIFICATION STATEMENTS 00280807 +C**** 00290807 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00300807 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00310807 +CBE** ********************** BBCINITA **********************************00320807 +CBB** ********************** BBCINITB **********************************00330807 +C**** INITIALIZE SECTION 00340807 + DATA ZVERS, ZVERSD, ZDATE 00350807 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00360807 + DATA ZCOMPL, ZNAME, ZTAPE 00370807 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00380807 + DATA ZPROJ, ZTAPED, ZPROG 00390807 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00400807 + DATA REMRKS /' '/ 00410807 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00420807 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00430807 +C**** 00440807 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00450807 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00460807 +CZ03 ZPROG = 'PROGRAM NAME' 00470807 +CZ04 ZDATE = 'DATE OF TEST' 00480807 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00490807 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00500807 +CZ07 ZNAME = 'NAME OF USER' 00510807 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00520807 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00530807 +C 00540807 + IVPASS = 0 00550807 + IVFAIL = 0 00560807 + IVDELE = 0 00570807 + IVINSP = 0 00580807 + IVTOTL = 0 00590807 + IVTOTN = 0 00600807 + ICZERO = 0 00610807 +C 00620807 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00630807 + I01 = 05 00640807 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00650807 + I02 = 06 00660807 +C 00670807 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00680807 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00690807 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00700807 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00710807 +C 00720807 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00730807 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00740807 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00750807 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00760807 +C 00770807 +CBE** ********************** BBCINITB **********************************00780807 + NUVI = I02 00790807 + IVTOTL = 12 00800807 + ZPROG = 'FM807' 00810807 +CBB** ********************** BBCHED0A **********************************00820807 +C**** 00830807 +C**** WRITE REPORT TITLE 00840807 +C**** 00850807 + WRITE (I02, 90002) 00860807 + WRITE (I02, 90006) 00870807 + WRITE (I02, 90007) 00880807 + WRITE (I02, 90008) ZVERS, ZVERSD 00890807 + WRITE (I02, 90009) ZPROG, ZPROG 00900807 + WRITE (I02, 90010) ZDATE, ZCOMPL 00910807 +CBE** ********************** BBCHED0A **********************************00920807 +C***** 00930807 +C***** 00940807 + WRITE (NUVI,16801) 00950807 +16801 FORMAT (" ", // 1X,"YDMIN1 - (168) INTRINSIC FUNCTION-- " //17X,00960807 + 1 "DMIN1 (CHOOSING SMALLEST VALUE) " //2X, 00970807 + 2 "ANS REF. - 15.3" ) 00980807 +CBB** ********************** BBCHED0B **********************************00990807 +C**** WRITE DETAIL REPORT HEADERS 01000807 +C**** 01010807 + WRITE (I02,90004) 01020807 + WRITE (I02,90004) 01030807 + WRITE (I02,90013) 01040807 + WRITE (I02,90014) 01050807 + WRITE (I02,90015) IVTOTL 01060807 +CBE** ********************** BBCHED0B **********************************01070807 +C***** 01080807 +CT001* TEST 1 BOTH VALUES EQUAL 01090807 + IVTNUM = 1 01100807 + DUBVD = 0.0D0 01110807 + DUDVD = 0.0D0 01120807 + DUAVD = DMIN1(DUBVD, DUDVD) 01130807 + IF (DUAVD + 5.0D-10) 20010, 10010, 40010 01140807 +40010 IF (DUAVD - 5.0D-10) 10010, 10010, 20010 01150807 +10010 IVPASS = IVPASS + 1 01160807 + WRITE (NUVI, 80002) IVTNUM 01170807 + GO TO 0011 01180807 +20010 IVFAIL = IVFAIL + 1 01190807 + DVCORR = 0.0D0 01200807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01210807 + 0011 CONTINUE 01220807 +CT002* TEST 2 FIRST VALUE NON-ZERO, SECOND ZERO 01230807 + IVTNUM = 2 01240807 + DUBVD = 5.625D0 01250807 + DUDVD = 0.0D0 01260807 + DUAVD = DMIN1(DUBVD, DUDVD) 01270807 + IF (DUAVD + 5.0D-10) 20020, 10020, 40020 01280807 +40020 IF (DUAVD - 5.0D-10) 10020, 10020, 20020 01290807 +10020 IVPASS = IVPASS + 1 01300807 + WRITE (NUVI, 80002) IVTNUM 01310807 + GO TO 0021 01320807 +20020 IVFAIL = IVFAIL + 1 01330807 + DVCORR = 0.0D0 01340807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01350807 + 0021 CONTINUE 01360807 +CT003* TEST 3 BOTH VALUES EQUAL 01370807 + IVTNUM = 3 01380807 + DUBVD = 6.5D0 01390807 + DUDVD = 6.5D0 01400807 + DUAVD = DMIN1(DUBVD, DUDVD) 01410807 + IF (DUAVD - 6.499999996D0) 20030, 10030, 40030 01420807 +40030 IF (DUAVD - 6.500000004D0) 10030, 10030, 20030 01430807 +10030 IVPASS = IVPASS + 1 01440807 + WRITE (NUVI, 80002) IVTNUM 01450807 + GO TO 0031 01460807 +20030 IVFAIL = IVFAIL + 1 01470807 + DVCORR = 6.5D0 01480807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01490807 + 0031 CONTINUE 01500807 +CT004* TEST 4 VALUES NOT EQUAL 01510807 + IVTNUM = 4 01520807 + DUBVD = 7.125D0 01530807 + DUDVD = 5.125D0 01540807 + DUAVD = DMIN1(DUBVD, DUDVD) 01550807 + IF (DUAVD - 5.124999997D0) 20040, 10040, 40040 01560807 +40040 IF (DUAVD - 5.125000003D0) 10040, 10040, 20040 01570807 +10040 IVPASS = IVPASS + 1 01580807 + WRITE (NUVI, 80002) IVTNUM 01590807 + GO TO 0041 01600807 +20040 IVFAIL = IVFAIL + 1 01610807 + DVCORR = 5.125D0 01620807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01630807 + 0041 CONTINUE 01640807 +CT005* TEST 5 FIRST VALUE NEGATIVE, SECOND ZERO 01650807 + IVTNUM = 5 01660807 + DUBVD = -5.625D0 01670807 + DUDVD = 0.0D0 01680807 + DUAVD = DMIN1(DUBVD, DUDVD) 01690807 + IF (DUAVD + 5.625000003D0) 20050, 10050, 40050 01700807 +40050 IF (DUAVD + 5.624999997D0) 10050, 10050, 20050 01710807 +10050 IVPASS = IVPASS + 1 01720807 + WRITE (NUVI, 80002) IVTNUM 01730807 + GO TO 0051 01740807 +20050 IVFAIL = IVFAIL + 1 01750807 + DVCORR = -5.625D0 01760807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01770807 + 0051 CONTINUE 01780807 +CT006* TEST 6 BOTH VALUES EQUAL, BOTH NEGATIVE 01790807 + IVTNUM = 6 01800807 + DUBVD = -6.5D0 01810807 + DUDVD = -6.5D0 01820807 + DUAVD = DMIN1(DUBVD, DUDVD) 01830807 + IF (DUAVD + 6.500000004D0) 20060, 10060, 40060 01840807 +40060 IF (DUAVD + 6.499999996D0) 10060, 10060, 20060 01850807 +10060 IVPASS = IVPASS + 1 01860807 + WRITE (NUVI, 80002) IVTNUM 01870807 + GO TO 0061 01880807 +20060 IVFAIL = IVFAIL + 1 01890807 + DVCORR = -6.5D0 01900807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 01910807 + 0061 CONTINUE 01920807 +CT007* TEST 7 VALUES NOT EQUAL, BOTH NEGATIVE 01930807 + IVTNUM = 7 01940807 + DUBVD = -7.125D0 01950807 + DUDVD = -5.125D0 01960807 + DUAVD = DMIN1(DUBVD, DUDVD) 01970807 + IF (DUAVD + 7.125000004D0) 20070, 10070, 40070 01980807 +40070 IF (DUAVD + 7.124999996D0) 10070, 10070, 20070 01990807 +10070 IVPASS = IVPASS + 1 02000807 + WRITE (NUVI, 80002) IVTNUM 02010807 + GO TO 0071 02020807 +20070 IVFAIL = IVFAIL + 1 02030807 + DVCORR = -7.125D0 02040807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02050807 + 0071 CONTINUE 02060807 +CT008* TEST 8 1ST VALUE NON-ZERO, 2ND ZERO PRECEDED BY MINUS SIGN 02070807 + IVTNUM = 8 02080807 + DUDVD = 5.625D0 02090807 + DUEVD = 0.0D0 02100807 + DUAVD = DMIN1(DUDVD, -DUEVD) 02110807 + IF (DUAVD + 5.0D-10) 20080, 10080, 40080 02120807 +40080 IF (DUAVD - 5.0D-10) 10080, 10080, 20080 02130807 +10080 IVPASS = IVPASS + 1 02140807 + WRITE (NUVI, 80002) IVTNUM 02150807 + GO TO 0081 02160807 +20080 IVFAIL = IVFAIL + 1 02170807 + DVCORR = 0.0D0 02180807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02190807 + 0081 CONTINUE 02200807 +CT009* TEST 9 ARITHMETIC EXPRESSIONS PRESENTED TO FUNCTION 02210807 + IVTNUM = 9 02220807 + DUDVD = 3.5D0 02230807 + DUEVD = 4.0D0 02240807 + DUAVD = DMIN1(DUDVD + DUEVD, -DUEVD - DUDVD) 02250807 + IF (DUAVD + 7.500000004D0) 20090, 10090, 40090 02260807 +40090 IF (DUAVD + 7.499999996D0) 10090, 10090, 20090 02270807 +10090 IVPASS = IVPASS + 1 02280807 + WRITE (NUVI, 80002) IVTNUM 02290807 + GO TO 0091 02300807 +20090 IVFAIL = IVFAIL + 1 02310807 + DVCORR = -7.5D0 02320807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02330807 + 0091 CONTINUE 02340807 +CT010* TEST 10 3 ARGUMENTS 02350807 + IVTNUM = 10 02360807 + DUBVD = 0.0D0 02370807 + DUCVD = 1.0D0 02380807 + DUDVD = 2.0D0 02390807 + DUAVD = DMIN1(DUBVD, DUCVD, DUDVD) 02400807 + IF (DUAVD + 5.0D-10) 20100, 10100, 40100 02410807 +40100 IF (DUAVD - 5.0D-10) 10100, 10100, 20100 02420807 +10100 IVPASS = IVPASS + 1 02430807 + WRITE (NUVI, 80002) IVTNUM 02440807 + GO TO 0101 02450807 +20100 IVFAIL = IVFAIL + 1 02460807 + DVCORR = 0.0D0 02470807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02480807 + 0101 CONTINUE 02490807 +CT011* TEST 11 4 ARGUMENTS 02500807 + IVTNUM = 11 02510807 +C***** ARGUMENTS OF HIGH AND LOW MAGNITUDES 02520807 + DUAVD = 1.0D+14 02530807 + DUBVD = -1.0D+14 02540807 + DUCVD = 1.0D-14 02550807 + DUAVD = DMIN1(DUAVD, DUBVD, DUCVD, -DUCVD) 02560807 + IF (DUAVD + 1.000000001D14) 20110, 10110, 40110 02570807 +40110 IF (DUAVD + 0.9999999995D14) 10110, 10110, 20110 02580807 +10110 IVPASS = IVPASS + 1 02590807 + WRITE (NUVI, 80002) IVTNUM 02600807 + GO TO 0111 02610807 +20110 IVFAIL = IVFAIL + 1 02620807 + DVCORR = -1.0D14 02630807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02640807 + 0111 CONTINUE 02650807 +CT012* TEST 12 5 ARGUMENTS 02660807 + IVTNUM = 12 02670807 + DUDVD = 3.5D0 02680807 + DUEVD = 4.5D0 02690807 + DUAVD = DMIN1(DUDVD, -DUDVD, -DUEVD, +DUDVD, DUEVD) 02700807 + IF (DUAVD + 4.500000003D0) 20120, 10120, 40120 02710807 +40120 IF (DUAVD + 4.499999997D0) 10120, 10120, 20120 02720807 +10120 IVPASS = IVPASS + 1 02730807 + WRITE (NUVI, 80002) IVTNUM 02740807 + GO TO 0121 02750807 +20120 IVFAIL = IVFAIL + 1 02760807 + DVCORR = -4.5D0 02770807 + WRITE (NUVI, 80031) IVTNUM, DUAVD, DVCORR 02780807 + 0121 CONTINUE 02790807 +C***** 02800807 +CBB** ********************** BBCSUM0 **********************************02810807 +C**** WRITE OUT TEST SUMMARY 02820807 +C**** 02830807 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02840807 + WRITE (I02, 90004) 02850807 + WRITE (I02, 90014) 02860807 + WRITE (I02, 90004) 02870807 + WRITE (I02, 90020) IVPASS 02880807 + WRITE (I02, 90022) IVFAIL 02890807 + WRITE (I02, 90024) IVDELE 02900807 + WRITE (I02, 90026) IVINSP 02910807 + WRITE (I02, 90028) IVTOTN, IVTOTL 02920807 +CBE** ********************** BBCSUM0 **********************************02930807 +CBB** ********************** BBCFOOT0 **********************************02940807 +C**** WRITE OUT REPORT FOOTINGS 02950807 +C**** 02960807 + WRITE (I02,90016) ZPROG, ZPROG 02970807 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02980807 + WRITE (I02,90019) 02990807 +CBE** ********************** BBCFOOT0 **********************************03000807 +CBB** ********************** BBCFMT0A **********************************03010807 +C**** FORMATS FOR TEST DETAIL LINES 03020807 +C**** 03030807 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03040807 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03050807 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03060807 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03070807 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03080807 + 1I6,/," ",15X,"CORRECT= " ,I6) 03090807 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03100807 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03110807 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03120807 + 1A21,/," ",16X,"CORRECT= " ,A21) 03130807 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03140807 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03150807 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03160807 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03170807 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03180807 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03190807 +80050 FORMAT (" ",48X,A31) 03200807 +CBE** ********************** BBCFMT0A **********************************03210807 +CBB** ********************** BBCFMAT1 **********************************03220807 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03230807 +C**** 03240807 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03250807 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03260807 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03270807 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03280807 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03290807 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03300807 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03310807 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03320807 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03330807 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03340807 + 2"(",F12.5,", ",F12.5,")") 03350807 +CBE** ********************** BBCFMAT1 **********************************03360807 +CBB** ********************** BBCFMT0B **********************************03370807 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03380807 +C**** 03390807 +90002 FORMAT ("1") 03400807 +90004 FORMAT (" ") 03410807 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03420807 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03430807 +90008 FORMAT (" ",21X,A13,A17) 03440807 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03450807 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03460807 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03470807 + 1 7X,"REMARKS",24X) 03480807 +90014 FORMAT (" ","----------------------------------------------" , 03490807 + 1 "---------------------------------" ) 03500807 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03510807 +C**** 03520807 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03530807 +C**** 03540807 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03550807 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03560807 + 1 A13) 03570807 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03580807 +C**** 03590807 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03600807 +C**** 03610807 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03620807 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03630807 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03640807 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03650807 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03660807 +CBE** ********************** BBCFMT0B **********************************03670807 +C***** END OF TEST SEGMENT 168 03680807 + STOP 03690807 + END 03700807 + 03710807 diff --git a/Fortran/UnitTests/fcvs21_f95/FM807.reference_output b/Fortran/UnitTests/fcvs21_f95/FM807.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM807.reference_output @@ -0,0 +1,47 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM807BEGIN* TEST RESULTS - FM807 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YDMIN1 - (168) INTRINSIC FUNCTION-- + + DMIN1 (CHOOSING SMALLEST VALUE) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 12 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ------------------------------------------------------------------------------- + + 12 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 12 OF 12 TESTS EXECUTED + + *FM807END* END OF TEST - FM807 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM808.f b/Fortran/UnitTests/fcvs21_f95/FM808.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM808.f @@ -0,0 +1,309 @@ + PROGRAM FM808 + +C***********************************************************************00010808 +C***** FORTRAN 77 00020808 +C***** FM808 YDBLE - (169) 00030808 +C***** 00040808 +C***********************************************************************00050808 +C***** GENERAL PURPOSE ANS REF 00060808 +C***** TEST INTRINSIC FUNCTION DBLE (EXPRESS S.P. ARGUMENT 15.3 00070808 +C***** IN DOUBLE PRECISION FORM ) (TABLE 5)00080808 +C***** 00090808 +CBB** ********************** BBCCOMNT **********************************00100808 +C**** 00110808 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120808 +C**** VERSION 2.1 00130808 +C**** 00140808 +C**** 00150808 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160808 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170808 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180808 +C**** BUILDING 225 RM A266 00190808 +C**** GAITHERSBURG, MD 20899 00200808 +C**** 00210808 +C**** 00220808 +C**** 00230808 +CBE** ********************** BBCCOMNT **********************************00240808 +C***** 00250808 +C***** S P E C I F I C A T I O N S SEGMENT 169 00260808 + DOUBLE PRECISION DVAVD, DVBVD, DVCORR, DVAVD1 00270808 +C***** 00280808 +CBB** ********************** BBCINITA **********************************00290808 +C**** SPECIFICATION STATEMENTS 00300808 +C**** 00310808 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320808 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330808 +CBE** ********************** BBCINITA **********************************00340808 +CBB** ********************** BBCINITB **********************************00350808 +C**** INITIALIZE SECTION 00360808 + DATA ZVERS, ZVERSD, ZDATE 00370808 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380808 + DATA ZCOMPL, ZNAME, ZTAPE 00390808 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400808 + DATA ZPROJ, ZTAPED, ZPROG 00410808 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420808 + DATA REMRKS /' '/ 00430808 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440808 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450808 +C**** 00460808 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470808 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480808 +CZ03 ZPROG = 'PROGRAM NAME' 00490808 +CZ04 ZDATE = 'DATE OF TEST' 00500808 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510808 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520808 +CZ07 ZNAME = 'NAME OF USER' 00530808 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540808 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550808 +C 00560808 + IVPASS = 0 00570808 + IVFAIL = 0 00580808 + IVDELE = 0 00590808 + IVINSP = 0 00600808 + IVTOTL = 0 00610808 + IVTOTN = 0 00620808 + ICZERO = 0 00630808 +C 00640808 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650808 + I01 = 05 00660808 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670808 + I02 = 06 00680808 +C 00690808 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700808 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710808 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720808 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730808 +C 00740808 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750808 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760808 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770808 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780808 +C 00790808 +CBE** ********************** BBCINITB **********************************00800808 + NUVI = I02 00810808 + IVTOTL = 8 00820808 + ZPROG = 'FM808' 00830808 +CBB** ********************** BBCHED0A **********************************00840808 +C**** 00850808 +C**** WRITE REPORT TITLE 00860808 +C**** 00870808 + WRITE (I02, 90002) 00880808 + WRITE (I02, 90006) 00890808 + WRITE (I02, 90007) 00900808 + WRITE (I02, 90008) ZVERS, ZVERSD 00910808 + WRITE (I02, 90009) ZPROG, ZPROG 00920808 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930808 +CBE** ********************** BBCHED0A **********************************00940808 +C***** 00950808 + WRITE (NUVI,16901) 00960808 +16901 FORMAT(" ",//1X,"YDBLE - (169) INTRINSIC FUNCTION--" // 00970808 + 1 16X,"DBLE (TYPE CONVERSION)" // 2X, 00980808 + 2 "ANS REF. - 15.3" ) 00990808 +CBB** ********************** BBCHED0B **********************************01000808 +C**** WRITE DETAIL REPORT HEADERS 01010808 +C**** 01020808 + WRITE (I02,90004) 01030808 + WRITE (I02,90004) 01040808 + WRITE (I02,90013) 01050808 + WRITE (I02,90014) 01060808 + WRITE (I02,90015) IVTOTL 01070808 +CBE** ********************** BBCHED0B **********************************01080808 +C***** 01090808 +CT001* TEST 1 THE VALUE ZERO 01100808 + IVTNUM = 1 01110808 + RVAVS = 0.0 01120808 + DVAVD = DBLE(RVAVS) 01130808 + IF (DVAVD + 5.0D-5) 20010, 10010, 40010 01140808 +40010 IF (DVAVD - 5.0D-5) 10010, 10010, 20010 01150808 +10010 IVPASS = IVPASS + 1 01160808 + WRITE (NUVI, 80002) IVTNUM 01170808 + GO TO 0011 01180808 +20010 IVFAIL = IVFAIL + 1 01190808 + DVCORR = 0.0D0 01200808 + WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01210808 + 0011 CONTINUE 01220808 +CT002* TEST 2 A D.P. CONSTANT WITH 6 SIGNIFICANT DIGITS 01230808 + IVTNUM = 2 01240808 + RVAVS = 0.015625 01250808 + DVAVD = DBLE(RVAVS) 01260808 + IF (DVAVD - 1.5624D-2) 20020, 10020, 40020 01270808 +40020 IF (DVAVD - 1.5626D-2) 10020, 10020, 20020 01280808 +10020 IVPASS = IVPASS + 1 01290808 + WRITE (NUVI, 80002) IVTNUM 01300808 + GO TO 0021 01310808 +20020 IVFAIL = IVFAIL + 1 01320808 + DVCORR = 1.5625D-2 01330808 + WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01340808 + 0021 CONTINUE 01350808 +CT003* TEST 3 A NEGATIVE INTEGRAL VALUE 01360808 + IVTNUM = 3 01370808 + RVAVS = -321.0 01380808 + DVAVD = DBLE(RVAVS) 01390808 + IF (DVAVD + 3.2102D2) 20030, 10030, 40030 01400808 +40030 IF (DVAVD + 3.2098D2) 10030, 10030, 20030 01410808 +10030 IVPASS = IVPASS + 1 01420808 + WRITE (NUVI, 80002) IVTNUM 01430808 + GO TO 0031 01440808 +20030 IVFAIL = IVFAIL + 1 01450808 + DVCORR = -3.210D2 01460808 + WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01470808 + 0031 CONTINUE 01480808 +CT004* TEST 4 A NEGATIVE D.P. CONSTANT WITH 6 SIGNIFICANT DIGITS 01490808 + IVTNUM = 4 01500808 + RVAVS = -0.015625 01510808 + DVAVD = DBLE(RVAVS) 01520808 + IF (DVAVD + 1.5626D-2) 20040, 10040, 40040 01530808 +40040 IF (DVAVD + 1.5624D-2) 10040, 10040, 20040 01540808 +10040 IVPASS = IVPASS + 1 01550808 + WRITE (NUVI, 80002) IVTNUM 01560808 + GO TO 0041 01570808 +20040 IVFAIL = IVFAIL + 1 01580808 + DVCORR = -0.015625D0 01590808 + WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01600808 + 0041 CONTINUE 01610808 +CT005* TEST 5 THE VALUE ZERO PRECEDED BY A MINUS SIGN 01620808 + IVTNUM = 5 01630808 + RVAVS = 0.0 01640808 + DVAVD = DBLE(-RVAVS) 01650808 + IF (DVAVD + 5.0D-5) 20050, 10050, 40050 01660808 +40050 IF (DVAVD - 5.0D-5) 10050, 10050, 20050 01670808 +10050 IVPASS = IVPASS + 1 01680808 + WRITE (NUVI, 80002) IVTNUM 01690808 + GO TO 0051 01700808 +20050 IVFAIL = IVFAIL + 1 01710808 + DVCORR = -0.0D0 01720808 + WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01730808 + 0051 CONTINUE 01740808 +CT006* TEST 6 A POSITIVE INTEGRAL VALUE 01750808 + IVTNUM = 6 01760808 + RVAVS = 321.0 01770808 + DVAVD = DBLE(RVAVS) 01780808 + IF (DVAVD - 3.2098D2) 20060, 10060, 40060 01790808 +40060 IF (DVAVD - 3.2102D2) 10060, 10060, 20060 01800808 +10060 IVPASS = IVPASS + 1 01810808 + WRITE (NUVI, 80002) IVTNUM 01820808 + GO TO 0061 01830808 +20060 IVFAIL = IVFAIL + 1 01840808 + DVCORR = 3.21D2 01850808 + WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 01860808 + 0061 CONTINUE 01870808 +CT007* TEST 7 AN ARITHMETIC EXPRESSION IS USED AS ARGUMENT 01880808 + IVTNUM = 7 01890808 + RVAVS = 6.25 01900808 + RVBVS = 2.5 01910808 + DVAVD = DBLE(RVBVS ** 2) 01920808 + IF (DVAVD - 6.2496D0) 20070, 10070, 40070 01930808 +40070 IF (DVAVD - 6.2504D0) 10070, 10070, 20070 01940808 +10070 IVPASS = IVPASS + 1 01950808 + WRITE (NUVI, 80002) IVTNUM 01960808 + GO TO 0071 01970808 +20070 IVFAIL = IVFAIL + 1 01980808 + DVCORR = 6.25D0 01990808 + WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 02000808 + 0071 CONTINUE 02010808 +CT008* TEST 8 COMPARE AUTOMATIC TYPE CONVERSION TO EXPLICIT 02020808 + IVTNUM = 8 02030808 + RVBVS = 2.5 02040808 + DVBVD = RVBVS ** 3 02050808 + DVAVD = DBLE(RVBVS ** 3) 02060808 + IF (DVAVD - 1.5624D1) 20080, 10080, 40080 02070808 +40080 IF (DVAVD - 1.5626D1) 10080, 10080, 20080 02080808 +10080 IVPASS = IVPASS + 1 02090808 + WRITE (NUVI, 80002) IVTNUM 02100808 + GO TO 0081 02110808 +20080 IVFAIL = IVFAIL + 1 02120808 + DVCORR = 1.5625D1 02130808 + WRITE (NUVI, 80031) IVTNUM, DVAVD, DVCORR 02140808 + 0081 CONTINUE 02150808 +CBB** ********************** BBCSUM0 **********************************02160808 +C**** WRITE OUT TEST SUMMARY 02170808 +C**** 02180808 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02190808 + WRITE (I02, 90004) 02200808 + WRITE (I02, 90014) 02210808 + WRITE (I02, 90004) 02220808 + WRITE (I02, 90020) IVPASS 02230808 + WRITE (I02, 90022) IVFAIL 02240808 + WRITE (I02, 90024) IVDELE 02250808 + WRITE (I02, 90026) IVINSP 02260808 + WRITE (I02, 90028) IVTOTN, IVTOTL 02270808 +CBE** ********************** BBCSUM0 **********************************02280808 +CBB** ********************** BBCFOOT0 **********************************02290808 +C**** WRITE OUT REPORT FOOTINGS 02300808 +C**** 02310808 + WRITE (I02,90016) ZPROG, ZPROG 02320808 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02330808 + WRITE (I02,90019) 02340808 +CBE** ********************** BBCFOOT0 **********************************02350808 +CBB** ********************** BBCFMT0A **********************************02360808 +C**** FORMATS FOR TEST DETAIL LINES 02370808 +C**** 02380808 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02390808 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02400808 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02410808 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02420808 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02430808 + 1I6,/," ",15X,"CORRECT= " ,I6) 02440808 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02450808 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02460808 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02470808 + 1A21,/," ",16X,"CORRECT= " ,A21) 02480808 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02490808 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02500808 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02510808 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02520808 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02530808 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02540808 +80050 FORMAT (" ",48X,A31) 02550808 +CBE** ********************** BBCFMT0A **********************************02560808 +CBB** ********************** BBCFMAT1 **********************************02570808 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02580808 +C**** 02590808 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02600808 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02610808 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02620808 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02630808 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02640808 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02650808 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02660808 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02670808 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02680808 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02690808 + 2"(",F12.5,", ",F12.5,")") 02700808 +CBE** ********************** BBCFMAT1 **********************************02710808 +CBB** ********************** BBCFMT0B **********************************02720808 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02730808 +C**** 02740808 +90002 FORMAT ("1") 02750808 +90004 FORMAT (" ") 02760808 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02770808 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02780808 +90008 FORMAT (" ",21X,A13,A17) 02790808 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02800808 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02810808 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02820808 + 1 7X,"REMARKS",24X) 02830808 +90014 FORMAT (" ","----------------------------------------------" , 02840808 + 1 "---------------------------------" ) 02850808 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02860808 +C**** 02870808 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02880808 +C**** 02890808 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02900808 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02910808 + 1 A13) 02920808 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02930808 +C**** 02940808 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02950808 +C**** 02960808 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02970808 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02980808 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02990808 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03000808 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03010808 +CBE** ********************** BBCFMT0B **********************************03020808 +C***** 03030808 +C***** END OF TEST SEGMENT 169 03040808 + STOP 03050808 + END 03060808 + 03070808 diff --git a/Fortran/UnitTests/fcvs21_f95/FM808.reference_output b/Fortran/UnitTests/fcvs21_f95/FM808.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM808.reference_output @@ -0,0 +1,43 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM808BEGIN* TEST RESULTS - FM808 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YDBLE - (169) INTRINSIC FUNCTION-- + + DBLE (TYPE CONVERSION) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 8 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + + ------------------------------------------------------------------------------- + + 8 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 8 OF 8 TESTS EXECUTED + + *FM808END* END OF TEST - FM808 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM809.f b/Fortran/UnitTests/fcvs21_f95/FM809.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM809.f @@ -0,0 +1,594 @@ + PROGRAM FM809 + +C***********************************************************************00010809 +C***** FORTRAN 77 00020809 +C***** FM809 YCONJG - (170) 00030809 +C***** 00040809 +C***********************************************************************00050809 +C***** GENERAL PURPOSE ANS REF 00060809 +C***** TEST INTRINSIC FUNCTION CMPLX (CONVERT TO COMPLEX), 15.3 00070809 +C***** AIMAG (IMAGINARY PART), AND CONJG (CONJUGATE) (TABLE 5)00080809 +C***** 00090809 +C***** S P E C I F I C A T I O N S SEGMENT 170 00100809 +CBB** ********************** BBCCOMNT **********************************00110809 +C**** 00120809 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130809 +C**** VERSION 2.1 00140809 +C**** 00150809 +C**** 00160809 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170809 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180809 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190809 +C**** BUILDING 225 RM A266 00200809 +C**** GAITHERSBURG, MD 20899 00210809 +C**** 00220809 +C**** 00230809 +C**** 00240809 +CBE** ********************** BBCCOMNT **********************************00250809 +C***** 00260809 + COMPLEX CWAVC, CWBVC, CWDVC, CWEVC, ZVCORR 00270809 + REAL R2E(2) 00280809 + EQUIVALENCE (CWAVC,R2E) 00290809 +C***** 00300809 +CBB** ********************** BBCINITA **********************************00310809 +C**** SPECIFICATION STATEMENTS 00320809 +C**** 00330809 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00340809 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00350809 +CBE** ********************** BBCINITA **********************************00360809 +CBB** ********************** BBCINITB **********************************00370809 +C**** INITIALIZE SECTION 00380809 + DATA ZVERS, ZVERSD, ZDATE 00390809 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00400809 + DATA ZCOMPL, ZNAME, ZTAPE 00410809 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00420809 + DATA ZPROJ, ZTAPED, ZPROG 00430809 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00440809 + DATA REMRKS /' '/ 00450809 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00460809 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00470809 +C**** 00480809 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00490809 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00500809 +CZ03 ZPROG = 'PROGRAM NAME' 00510809 +CZ04 ZDATE = 'DATE OF TEST' 00520809 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00530809 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00540809 +CZ07 ZNAME = 'NAME OF USER' 00550809 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00560809 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00570809 +C 00580809 + IVPASS = 0 00590809 + IVFAIL = 0 00600809 + IVDELE = 0 00610809 + IVINSP = 0 00620809 + IVTOTL = 0 00630809 + IVTOTN = 0 00640809 + ICZERO = 0 00650809 +C 00660809 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00670809 + I01 = 05 00680809 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00690809 + I02 = 06 00700809 +C 00710809 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00720809 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00730809 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00740809 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00750809 +C 00760809 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00770809 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00780809 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00790809 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00800809 +C 00810809 +CBE** ********************** BBCINITB **********************************00820809 + NUVI = I02 00830809 + IVTOTL = 25 00840809 + ZPROG = 'FM809' 00850809 +CBB** ********************** BBCHED0A **********************************00860809 +C**** 00870809 +C**** WRITE REPORT TITLE 00880809 +C**** 00890809 + WRITE (I02, 90002) 00900809 + WRITE (I02, 90006) 00910809 + WRITE (I02, 90007) 00920809 + WRITE (I02, 90008) ZVERS, ZVERSD 00930809 + WRITE (I02, 90009) ZPROG, ZPROG 00940809 + WRITE (I02, 90010) ZDATE, ZCOMPL 00950809 +CBE** ********************** BBCHED0A **********************************00960809 +C***** 00970809 +C***** HEADER FOR SEGMENT 170 WRITTEN 00980809 + WRITE (NUVI,17001) 00990809 +17001 FORMAT(" ", //1X,"YCONJG - (170) INTRINSIC FUNCTION--" //17X, 01000809 + 1 "CMPLX (CONVERT TO COMPLEX)," /17X, 01010809 + 2 "AIMAG (IMAG. PART)," /17X, 01020809 + 3 "CONJG (CONJUGATE)" //,2X, 01030809 + 4 "ANS REF. - 15.3" ) 01040809 +CBB** ********************** BBCHED0B **********************************01050809 +C**** WRITE DETAIL REPORT HEADERS 01060809 +C**** 01070809 + WRITE (I02,90004) 01080809 + WRITE (I02,90004) 01090809 + WRITE (I02,90013) 01100809 + WRITE (I02,90014) 01110809 + WRITE (I02,90015) IVTOTL 01120809 +CBE** ********************** BBCHED0B **********************************01130809 +C***** 01140809 +C***** TEST OF CMPLX 01150809 +C***** 01160809 + WRITE(NUVI, 17002) 01170809 +17002 FORMAT(/ 8X, "TEST OF CMPLX" ) 01180809 +CT001* TEST 1 PAIR OF ZEROES 01190809 + IVTNUM = 1 01200809 + RWBVS = 0.0 01210809 + RWDVS = 0.0 01220809 + CWAVC = CMPLX(RWBVS, RWDVS) 01230809 + IF (R2E(1) + 0.00005) 20010, 40012, 40011 01240809 +40011 IF (R2E(1) - 0.00005) 40012, 40012, 20010 01250809 +40012 IF (R2E(2) + 0.00005) 20010, 10010, 40010 01260809 +40010 IF (R2E(2) - 0.00005) 10010, 10010, 20010 01270809 +10010 IVPASS = IVPASS + 1 01280809 + WRITE (NUVI, 80002) IVTNUM 01290809 + GO TO 0011 01300809 +20010 IVFAIL = IVFAIL + 1 01310809 + ZVCORR = (0.0 , 0.0) 01320809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 01330809 + 0011 CONTINUE 01340809 +CT002* TEST 2 FIRST VALUE NON-ZERO, SECOND ZERO 01350809 + IVTNUM = 2 01360809 + RWBVS = 3.0 01370809 + RWDVS = 0.0 01380809 + CWAVC = CMPLX(RWBVS, RWDVS) 01390809 + IF (R2E(1) - 2.9998) 20020, 40022, 40021 01400809 +40021 IF (R2E(1) - 3.0002) 40022, 40022, 20020 01410809 +40022 IF (R2E(2) + 0.00005) 20020, 10020, 40020 01420809 +40020 IF (R2E(2) - 0.00005) 10020, 10020, 20020 01430809 +10020 IVPASS = IVPASS + 1 01440809 + WRITE (NUVI, 80002) IVTNUM 01450809 + GO TO 0021 01460809 +20020 IVFAIL = IVFAIL + 1 01470809 + ZVCORR = (3.0 , 0.0) 01480809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 01490809 + 0021 CONTINUE 01500809 +CT003* TEST 3 FIRST VALUE ZERO, SECOND NON-ZERO 01510809 + IVTNUM = 3 01520809 + RWBVS = 0.0 01530809 + RWDVS = 4.0 01540809 + CWAVC = CMPLX(RWBVS, RWDVS) 01550809 + IF (R2E(1) + 0.00005) 20030, 40032, 40031 01560809 +40031 IF (R2E(1) - 0.00005) 40032, 40032, 20030 01570809 +40032 IF (R2E(2) - 3.9998) 20030, 10030, 40030 01580809 +40030 IF (R2E(2) - 4.0002) 10030, 10030, 20030 01590809 +10030 IVPASS = IVPASS + 1 01600809 + WRITE (NUVI, 80002) IVTNUM 01610809 + GO TO 0031 01620809 +20030 IVFAIL = IVFAIL + 1 01630809 + ZVCORR = (0.0 , 4.0) 01640809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 01650809 + 0031 CONTINUE 01660809 +CT004* TEST 4 PAIR OF NON-ZERO VALUES 01670809 + IVTNUM = 4 01680809 + RWBVS = 3.0 01690809 + RWDVS = 4.0 01700809 + CWAVC = CMPLX(RWBVS, RWDVS) 01710809 + IF (R2E(1) - 2.9998) 20040, 40042, 40041 01720809 +40041 IF (R2E(1) - 3.0002) 40042, 40042, 20040 01730809 +40042 IF (R2E(2) - 3.9998) 20040, 10040, 40040 01740809 +40040 IF (R2E(2) - 4.0002) 10040, 10040, 20040 01750809 +10040 IVPASS = IVPASS + 1 01760809 + WRITE (NUVI, 80002) IVTNUM 01770809 + GO TO 0041 01780809 +20040 IVFAIL = IVFAIL + 1 01790809 + ZVCORR = (3.0 , 4.0) 01800809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 01810809 + 0041 CONTINUE 01820809 +CT005* TEST 5 FIRST VALUE NEGATIVE, SECOND ZERO 01830809 + IVTNUM = 5 01840809 + RWBVS = -3.0 01850809 + RWDVS = 0.0 01860809 + CWAVC = CMPLX(RWBVS, RWDVS) 01870809 + IF (R2E(1) + 3.0002) 20050, 40052, 40051 01880809 +40051 IF (R2E(1) + 2.9998) 40052, 40052, 20050 01890809 +40052 IF (R2E(2) + 0.00005) 20050, 10050, 40050 01900809 +40050 IF (R2E(2) - 0.00005) 10050, 10050, 20050 01910809 +10050 IVPASS = IVPASS + 1 01920809 + WRITE (NUVI, 80002) IVTNUM 01930809 + GO TO 0051 01940809 +20050 IVFAIL = IVFAIL + 1 01950809 + ZVCORR = (-3.0, 0.0) 01960809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 01970809 + 0051 CONTINUE 01980809 +CT006* TEST 6 FIRST VALUE ZERO, SECOND NEGATIVE 01990809 + IVTNUM = 6 02000809 + RWBVS = 0.0 02010809 + RWDVS = -4.0 02020809 + CWAVC = CMPLX(RWBVS, RWDVS) 02030809 + IF (R2E(1) + 0.00005) 20060, 40062, 40061 02040809 +40061 IF (R2E(1) - 0.00005) 40062, 40062, 20060 02050809 +40062 IF (R2E(2) + 4.0002) 20060, 10060, 40060 02060809 +40060 IF (R2E(2) + 3.9998) 10060, 10060, 20060 02070809 +10060 IVPASS = IVPASS + 1 02080809 + WRITE (NUVI, 80002) IVTNUM 02090809 + GO TO 0061 02100809 +20060 IVFAIL = IVFAIL + 1 02110809 + ZVCORR = (0.0, -4.0) 02120809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 02130809 + 0061 CONTINUE 02140809 +CT007* TEST 7 PAIR OF NEGATIVE VALUES 02150809 + IVTNUM = 7 02160809 + RWBVS = -3.0 02170809 + RWDVS = -4.0 02180809 + CWAVC = CMPLX(RWBVS, RWDVS) 02190809 + IF (R2E(1) + 3.0002) 20070, 40072, 40071 02200809 +40071 IF (R2E(1) + 2.9998) 40072, 40072, 20070 02210809 +40072 IF (R2E(2) + 4.0002) 20070, 10070, 40070 02220809 +40070 IF (R2E(2) + 3.9998) 10070, 10070, 20070 02230809 +10070 IVPASS = IVPASS + 1 02240809 + WRITE (NUVI, 80002) IVTNUM 02250809 + GO TO 0071 02260809 +20070 IVFAIL = IVFAIL + 1 02270809 + ZVCORR = (-3.0, -4.0) 02280809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 02290809 + 0071 CONTINUE 02300809 +CT008* TEST 8 FIRST VALUE PRECEDED BY A MINUS SIGN 02310809 + IVTNUM = 8 02320809 + RWAVS = 3.0 02330809 + RWBVS = 0.0 02340809 + CWAVC = CMPLX(-RWAVS, RWBVS) 02350809 + IF (R2E(1) + 3.0002) 20080, 40082, 40081 02360809 +40081 IF (R2E(1) + 2.9998) 40082, 40082, 20080 02370809 +40082 IF (R2E(2) + 0.00005) 20080, 10080, 40080 02380809 +40080 IF (R2E(2) - 0.00005) 10080, 10080, 20080 02390809 +10080 IVPASS = IVPASS + 1 02400809 + WRITE (NUVI, 80002) IVTNUM 02410809 + GO TO 0081 02420809 +20080 IVFAIL = IVFAIL + 1 02430809 + ZVCORR = (-3.0, 0.0) 02440809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 02450809 + 0081 CONTINUE 02460809 +CT009* TEST 9 ONE ARGUMENT A CONSTANT, OTHER A VARIABLE 02470809 + IVTNUM = 9 02480809 + RWAVS = 4.0 02490809 + CWAVC = CMPLX(0.0, RWAVS) 02500809 + IF (R2E(1) + 0.00005) 20090, 40092, 40091 02510809 +40091 IF (R2E(1) - 0.00005) 40092, 40092, 20090 02520809 +40092 IF (R2E(2) - 3.9998) 20090, 10090, 40090 02530809 +40090 IF (R2E(2) - 4.0002) 10090, 10090, 20090 02540809 +10090 IVPASS = IVPASS + 1 02550809 + WRITE (NUVI, 80002) IVTNUM 02560809 + GO TO 0091 02570809 +20090 IVFAIL = IVFAIL + 1 02580809 + ZVCORR = (0.0, 4.0) 02590809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 02600809 + 0091 CONTINUE 02610809 +CT010* TEST 10 PAIR OF ARITHMETIC EXPRESSIONS USED AS ARGUMENT 02620809 + IVTNUM = 10 02630809 + RWAVS = 1.5 02640809 + RWBVS = 2.0 02650809 + RWCVS = 3.5 02660809 + CWAVC = CMPLX((RWCVS + RWAVS)/ RWBVS, (RWCVS - RWAVS) / RWBVS) 02670809 + IF (R2E(1) - 2.4998) 20100, 40102, 40101 02680809 +40101 IF (R2E(1) - 2.5002) 40102, 40102, 20100 02690809 +40102 IF (R2E(2) - 0.99995) 20100, 10100, 40100 02700809 +40100 IF (R2E(2) - 1.0001) 10100, 10100, 20100 02710809 +10100 IVPASS = IVPASS + 1 02720809 + WRITE (NUVI, 80002) IVTNUM 02730809 + GO TO 0101 02740809 +20100 IVFAIL = IVFAIL + 1 02750809 + ZVCORR = (2.5, 1.0) 02760809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 02770809 + 0101 CONTINUE 02780809 +C***** 02790809 + WRITE(NUVI, 90002) 02800809 + WRITE(NUVI, 90013) 02810809 + WRITE(NUVI, 90014) 02820809 +C***** 02830809 +C***** TEST OF AIMAG 02840809 +C***** 02850809 + WRITE(NUVI, 17004) 02860809 +17004 FORMAT(/ 8X, "TEST OF AIMAG" ) 02870809 +CT011* TEST 11 THE COMPLEX VALUE ZERO (0,0) 02880809 + IVTNUM = 11 02890809 + RWAVS = AIMAG((0.0, 0.0)) 02900809 + IF (RWAVS + 0.00005) 20110, 10110, 40110 02910809 +40110 IF (RWAVS - 0.00005) 10110, 10110, 20110 02920809 +10110 IVPASS = IVPASS + 1 02930809 + WRITE (NUVI, 80002) IVTNUM 02940809 + GO TO 0111 02950809 +20110 IVFAIL = IVFAIL + 1 02960809 + RVCORR = 0.0 02970809 + WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 02980809 + 0111 CONTINUE 02990809 +CT012* TEST 12 COMPLEX VALUE HAVING ONLY A REAL COMPONENT 03000809 + IVTNUM = 12 03010809 + RWAVS = AIMAG((3.0, 0.0)) 03020809 + IF (RWAVS + 0.00005) 20120, 10120, 40120 03030809 +40120 IF (RWAVS - 0.00005) 10120, 10120, 20120 03040809 +10120 IVPASS = IVPASS + 1 03050809 + WRITE (NUVI, 80002) IVTNUM 03060809 + GO TO 0121 03070809 +20120 IVFAIL = IVFAIL + 1 03080809 + RVCORR = 0.0 03090809 + WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03100809 + 0121 CONTINUE 03110809 +CT013* TEST 13 ARBITRARY COMPLEX VALUE 03120809 + IVTNUM = 13 03130809 + RWAVS = AIMAG((3.0, 4.0)) 03140809 + IF (RWAVS - 3.9998) 20130, 10130, 40130 03150809 +40130 IF (RWAVS - 4.0002) 10130, 10130, 20130 03160809 +10130 IVPASS = IVPASS + 1 03170809 + WRITE (NUVI, 80002) IVTNUM 03180809 + GO TO 0131 03190809 +20130 IVFAIL = IVFAIL + 1 03200809 + RVCORR = 4.0 03210809 + WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03220809 + 0131 CONTINUE 03230809 +CT014* TEST 14 IMAGINARY COMPONENT A ZERO PRECEDED BY MINUS SIGN 03240809 + IVTNUM = 14 03250809 + RWAVS = AIMAG((-3.0, -0.0)) 03260809 + IF (RWAVS + 0.00005) 20140, 10140, 40140 03270809 +40140 IF (RWAVS - 0.00005) 10140, 10140, 20140 03280809 +10140 IVPASS = IVPASS + 1 03290809 + WRITE (NUVI, 80002) IVTNUM 03300809 + GO TO 0141 03310809 +20140 IVFAIL = IVFAIL + 1 03320809 + RVCORR = 0.0 03330809 + WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03340809 + 0141 CONTINUE 03350809 +CT015* TEST 15 ARBITRARY COMPLEX VALUE WITH NEGATIVE COMPONENTS 03360809 + IVTNUM = 15 03370809 + RWAVS = AIMAG((-3.0, -4.0)) 03380809 + IF (RWAVS + 4.0002) 20150, 10150, 40150 03390809 +40150 IF (RWAVS + 3.9998) 10150, 10150, 20150 03400809 +10150 IVPASS = IVPASS + 1 03410809 + WRITE (NUVI, 80002) IVTNUM 03420809 + GO TO 0151 03430809 +20150 IVFAIL = IVFAIL + 1 03440809 + RVCORR = -4.0 03450809 + WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03460809 + 0151 CONTINUE 03470809 +CT016* TEST 16 COMPLEX VALUE ZERO (0,0) PRECEDED BY MINUS SIGN 03480809 + IVTNUM = 16 03490809 + CWDVC = (0.0, 0.0) 03500809 + RWAVS = AIMAG(-CWDVC) 03510809 + IF (RWAVS + 0.00005) 20160, 10160, 40160 03520809 +40160 IF (RWAVS - 0.00005) 10160, 10160, 20160 03530809 +10160 IVPASS = IVPASS + 1 03540809 + WRITE (NUVI, 80002) IVTNUM 03550809 + GO TO 0161 03560809 +20160 IVFAIL = IVFAIL + 1 03570809 + RVCORR = 0.0 03580809 + WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03590809 + 0161 CONTINUE 03600809 +CT017* TEST 17 ARGUMENT IS A COMPLEX EXPRESSION 03610809 + IVTNUM = 17 03620809 + CWDVC = (3.5, 4.5) 03630809 + CWEVC = (4.0, 5.0) 03640809 + RWAVS = AIMAG(CWDVC - CWEVC) 03650809 + IF (RWAVS + 0.50003) 20170, 10170, 40170 03660809 +40170 IF (RWAVS + 0.49997) 10170, 10170, 20170 03670809 +10170 IVPASS = IVPASS + 1 03680809 + WRITE (NUVI, 80002) IVTNUM 03690809 + GO TO 0171 03700809 +20170 IVFAIL = IVFAIL + 1 03710809 + RVCORR = -0.5 03720809 + WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03730809 + 0171 CONTINUE 03740809 +CT018* TEST 18 CONJG FORMS ARGUMENT TO AIMAG 03750809 + IVTNUM = 18 03760809 + CWDVC = (3.0, 4.0) 03770809 + RWAVS = AIMAG(CONJG(CWDVC)) 03780809 + IF (RWAVS + 4.0002) 20180, 10180, 40180 03790809 +40180 IF (RWAVS + 3.9998) 10180, 10180, 20180 03800809 +10180 IVPASS = IVPASS + 1 03810809 + WRITE (NUVI, 80002) IVTNUM 03820809 + GO TO 0181 03830809 +20180 IVFAIL = IVFAIL + 1 03840809 + RVCORR = -4.0 03850809 + WRITE (NUVI, 80012) IVTNUM, RWAVS, RVCORR 03860809 + 0181 CONTINUE 03870809 +C***** 03880809 + WRITE(NUVI, 90002) 03890809 + WRITE(NUVI, 90013) 03900809 + WRITE(NUVI, 90014) 03910809 +C***** 03920809 +C***** TEST OF CONJG 03930809 +C***** 03940809 + WRITE (NUVI,17006) 03950809 +17006 FORMAT (/ 8X, "TEST OF CONJG" ) 03960809 +CT019* TEST 19 COMPLEX VALUE ZERO (0,0) 03970809 + IVTNUM = 19 03980809 + CWAVC = CONJG((0.0, 0.0)) 03990809 + IF (R2E(1) + 0.00005) 20190, 40192, 40191 04000809 +40191 IF (R2E(1) - 0.00005) 40192, 40192, 20190 04010809 +40192 IF (R2E(2) + 0.00005) 20190, 10190, 40190 04020809 +40190 IF (R2E(2) - 0.00005) 10190, 10190, 20190 04030809 +10190 IVPASS = IVPASS + 1 04040809 + WRITE (NUVI, 80002) IVTNUM 04050809 + GO TO 0191 04060809 +20190 IVFAIL = IVFAIL + 1 04070809 + ZVCORR = (0.0, 0.0) 04080809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04090809 + 0191 CONTINUE 04100809 +CT020* TEST 20 COMPLEX VALUE HAVING ONLY REAL COMPONENT 04110809 + IVTNUM = 20 04120809 + CWAVC = CONJG((3.0, 0.0)) 04130809 + IF (R2E(1) - 2.9998) 20200, 40202, 40201 04140809 +40201 IF (R2E(1) - 3.0002) 40202, 40202, 20200 04150809 +40202 IF (R2E(2) + 0.00005) 20200, 10200, 40200 04160809 +40200 IF (R2E(2) - 0.00005) 10200, 10200, 20200 04170809 +10200 IVPASS = IVPASS + 1 04180809 + WRITE (NUVI, 80002) IVTNUM 04190809 + GO TO 0201 04200809 +20200 IVFAIL = IVFAIL + 1 04210809 + ZVCORR = (3.0, 0.0) 04220809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04230809 + 0201 CONTINUE 04240809 +CT021* TEST 21 ARBITRARY COMPLEX VALUE 04250809 + IVTNUM = 21 04260809 + CWAVC = CONJG((3.0, 4.0)) 04270809 + IF (R2E(1) - 2.9998) 20210, 40212, 40211 04280809 +40211 IF (R2E(1) - 3.0002) 40212, 40212, 20210 04290809 +40212 IF (R2E(2) + 4.0002) 20210, 10210, 40210 04300809 +40210 IF (R2E(2) + 3.9998) 10210, 10210, 20210 04310809 +10210 IVPASS = IVPASS + 1 04320809 + WRITE (NUVI, 80002) IVTNUM 04330809 + GO TO 0211 04340809 +20210 IVFAIL = IVFAIL + 1 04350809 + ZVCORR = (3.0, -4.0) 04360809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04370809 + 0211 CONTINUE 04380809 + CWBVC = (3.0, -4.0) 04390809 +CT022* TEST 22 SECOND ARGUMENT IS A ZERO PRECEDED BY MINUS SIGN 04400809 + IVTNUM = 22 04410809 + CWAVC = CONJG((-3.0, -0.0)) 04420809 + IF (R2E(1) + 3.0002) 20220, 40222, 40221 04430809 +40221 IF (R2E(1) + 2.9998) 40222, 40222, 20220 04440809 +40222 IF (R2E(2) + 0.00005) 20220, 10220, 40220 04450809 +40220 IF (R2E(2) - 0.00005) 10220, 10220, 20220 04460809 +10220 IVPASS = IVPASS + 1 04470809 + WRITE (NUVI, 80002) IVTNUM 04480809 + GO TO 0221 04490809 +20220 IVFAIL = IVFAIL + 1 04500809 + ZVCORR = (-3.0, 0.0) 04510809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04520809 + 0221 CONTINUE 04530809 +CT023* TEST 23 ABITRARY COMPLEX VALUE WITH NEGATIVE COMPONENTS 04540809 + IVTNUM = 23 04550809 + CWAVC = CONJG((-3.0, -4.0)) 04560809 + IF (R2E(1) + 3.0002) 20230, 40232, 40231 04570809 +40231 IF (R2E(1) + 2.9998) 40232, 40232, 20230 04580809 +40232 IF (R2E(2) - 3.9998) 20230, 10230, 40230 04590809 +40230 IF (R2E(2) - 4.0002) 10230, 10230, 20230 04600809 +10230 IVPASS = IVPASS + 1 04610809 + WRITE (NUVI, 80002) IVTNUM 04620809 + GO TO 0231 04630809 +20230 IVFAIL = IVFAIL + 1 04640809 + ZVCORR = (-3.0, 4.0) 04650809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04660809 + 0231 CONTINUE 04670809 + CWBVC = (-3.0, 4.0) 04680809 +CT024* TEST 24 COMPLEX ZERO PRECEDED BY A MINUS SIGN 04690809 + IVTNUM = 24 04700809 + CWDVC = (0.0, 0.0) 04710809 + CWAVC = CONJG(-CWDVC) 04720809 + IF (R2E(1) + 0.00005) 20240, 40242, 40241 04730809 +40241 IF (R2E(1) - 0.00005) 40242, 40242, 20240 04740809 +40242 IF (R2E(2) + 0.00005) 20240, 10240, 40240 04750809 +40240 IF (R2E(2) - 0.00005) 10240, 10240, 20240 04760809 +10240 IVPASS = IVPASS + 1 04770809 + WRITE (NUVI, 80002) IVTNUM 04780809 + GO TO 0241 04790809 +20240 IVFAIL = IVFAIL + 1 04800809 + ZVCORR = (0.0, 0.0) 04810809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04820809 + 0241 CONTINUE 04830809 +CT025* TEST 25 COMPLEX EXPRESSION PRESENTED AS ARGUMENT 04840809 + IVTNUM = 25 04850809 + CWDVC = (3.5, 4.5) 04860809 + CWEVC = (4.0, 5.0) 04870809 + CWAVC = CONJG(CWDVC - CWEVC) 04880809 + IF (R2E(1) + 0.50003) 20250, 40252, 40251 04890809 +40251 IF (R2E(1) + 0.49997) 40252, 40252, 20250 04900809 +40252 IF (R2E(2) - 0.49997) 20250, 10250, 40250 04910809 +40250 IF (R2E(2) - 0.50003) 10250, 10250, 20250 04920809 +10250 IVPASS = IVPASS + 1 04930809 + WRITE (NUVI, 80002) IVTNUM 04940809 + GO TO 0251 04950809 +20250 IVFAIL = IVFAIL + 1 04960809 + ZVCORR = (-0.5, 0.5) 04970809 + WRITE (NUVI, 80045) IVTNUM, CWAVC, ZVCORR 04980809 + 0251 CONTINUE 04990809 +C***** 05000809 +CBB** ********************** BBCSUM0 **********************************05010809 +C**** WRITE OUT TEST SUMMARY 05020809 +C**** 05030809 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 05040809 + WRITE (I02, 90004) 05050809 + WRITE (I02, 90014) 05060809 + WRITE (I02, 90004) 05070809 + WRITE (I02, 90020) IVPASS 05080809 + WRITE (I02, 90022) IVFAIL 05090809 + WRITE (I02, 90024) IVDELE 05100809 + WRITE (I02, 90026) IVINSP 05110809 + WRITE (I02, 90028) IVTOTN, IVTOTL 05120809 +CBE** ********************** BBCSUM0 **********************************05130809 +CBB** ********************** BBCFOOT0 **********************************05140809 +C**** WRITE OUT REPORT FOOTINGS 05150809 +C**** 05160809 + WRITE (I02,90016) ZPROG, ZPROG 05170809 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 05180809 + WRITE (I02,90019) 05190809 +CBE** ********************** BBCFOOT0 **********************************05200809 +CBB** ********************** BBCFMT0A **********************************05210809 +C**** FORMATS FOR TEST DETAIL LINES 05220809 +C**** 05230809 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 05240809 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 05250809 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 05260809 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 05270809 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 05280809 + 1I6,/," ",15X,"CORRECT= " ,I6) 05290809 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05300809 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 05310809 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05320809 + 1A21,/," ",16X,"CORRECT= " ,A21) 05330809 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 05340809 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 05350809 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 05360809 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 05370809 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 05380809 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 05390809 +80050 FORMAT (" ",48X,A31) 05400809 +CBE** ********************** BBCFMT0A **********************************05410809 +CBB** ********************** BBCFMAT1 **********************************05420809 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 05430809 +C**** 05440809 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05450809 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 05460809 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 05470809 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 05480809 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05490809 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05500809 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 05510809 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 05520809 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05530809 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 05540809 + 2"(",F12.5,", ",F12.5,")") 05550809 +CBE** ********************** BBCFMAT1 **********************************05560809 +CBB** ********************** BBCFMT0B **********************************05570809 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 05580809 +C**** 05590809 +90002 FORMAT ("1") 05600809 +90004 FORMAT (" ") 05610809 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )05620809 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05630809 +90008 FORMAT (" ",21X,A13,A17) 05640809 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 05650809 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 05660809 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 05670809 + 1 7X,"REMARKS",24X) 05680809 +90014 FORMAT (" ","----------------------------------------------" , 05690809 + 1 "---------------------------------" ) 05700809 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 05710809 +C**** 05720809 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 05730809 +C**** 05740809 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 05750809 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 05760809 + 1 A13) 05770809 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 05780809 +C**** 05790809 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 05800809 +C**** 05810809 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 05820809 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 05830809 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 05840809 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 05850809 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 05860809 +CBE** ********************** BBCFMT0B **********************************05870809 +C***** 05880809 +C***** END OF TEST SEGMENT 170 05890809 + STOP 05900809 + END 05910809 + 05920809 diff --git a/Fortran/UnitTests/fcvs21_f95/FM809.reference_output b/Fortran/UnitTests/fcvs21_f95/FM809.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM809.reference_output @@ -0,0 +1,74 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM809BEGIN* TEST RESULTS - FM809 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YCONJG - (170) INTRINSIC FUNCTION-- + + CMPLX (CONVERT TO COMPLEX), + AIMAG (IMAG. PART), + CONJG (CONJUGATE) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 25 TESTS + + + TEST OF CMPLX + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF AIMAG + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF CONJG + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + + ------------------------------------------------------------------------------- + + 25 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 25 OF 25 TESTS EXECUTED + + *FM809END* END OF TEST - FM809 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM810.f b/Fortran/UnitTests/fcvs21_f95/FM810.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM810.f @@ -0,0 +1,357 @@ + PROGRAM FM810 + +C***********************************************************************00010810 +C***** FORTRAN 77 00020810 +C***** FM810 YDMMX - (173) 00030810 +C***** 00040810 +C***********************************************************************00050810 +C***** GENERAL PURPOSE ANS REF 00060810 +C***** TESTS THE USE OF INTEGER, REAL, DOUBLE PRECISION, 15.3 00070810 +C***** AND MIXED MODE EXPRESSIONS CONTAINING REFERENCES TO 15.10 00080810 +C***** THE INTRINSIC FUNCTIONS OF THE FULL LANGUAGE 6.1.4 00090810 +C***** 00100810 +C***** GENERAL COMMENTS 00110810 +C***** SEGMENTS TESTING XINT, XREAL, XAINT, XABS, XAMOD, 00120810 +C***** XSIGN, XDIM, XMAX, XMIN, YIDINT, YSNGL 00130810 +C***** YDINT, YDABS, YCABS, YDMOD, YDSIGN, 00140810 +C***** YDMAX1, YDMIN1, YDBLE, YCONJG ASSUMED WORKING 00150810 +CBB** ********************** BBCCOMNT **********************************00160810 +C**** 00170810 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00180810 +C**** VERSION 2.1 00190810 +C**** 00200810 +C**** 00210810 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00220810 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00230810 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00240810 +C**** BUILDING 225 RM A266 00250810 +C**** GAITHERSBURG, MD 20899 00260810 +C**** 00270810 +C**** 00280810 +C**** 00290810 +CBE** ********************** BBCCOMNT **********************************00300810 +C***** 00310810 +C***** S P E C I F I C A T I O N S SEGMENT 173 00320810 + DOUBLE PRECISION DXAVD,DXBVD,DXDVD,DXEVD,DXFVD,DXGVD,DVCORR 00330810 +CBB** ********************** BBCINITA **********************************00340810 +C**** SPECIFICATION STATEMENTS 00350810 +C**** 00360810 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00370810 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00380810 +CBE** ********************** BBCINITA **********************************00390810 +CBB** ********************** BBCINITB **********************************00400810 +C**** INITIALIZE SECTION 00410810 + DATA ZVERS, ZVERSD, ZDATE 00420810 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00430810 + DATA ZCOMPL, ZNAME, ZTAPE 00440810 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00450810 + DATA ZPROJ, ZTAPED, ZPROG 00460810 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00470810 + DATA REMRKS /' '/ 00480810 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00490810 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00500810 +C**** 00510810 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00520810 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00530810 +CZ03 ZPROG = 'PROGRAM NAME' 00540810 +CZ04 ZDATE = 'DATE OF TEST' 00550810 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00560810 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00570810 +CZ07 ZNAME = 'NAME OF USER' 00580810 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00590810 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00600810 +C 00610810 + IVPASS = 0 00620810 + IVFAIL = 0 00630810 + IVDELE = 0 00640810 + IVINSP = 0 00650810 + IVTOTL = 0 00660810 + IVTOTN = 0 00670810 + ICZERO = 0 00680810 +C 00690810 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00700810 + I01 = 05 00710810 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00720810 + I02 = 06 00730810 +C 00740810 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00750810 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00760810 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00770810 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00780810 +C 00790810 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00800810 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00810810 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00820810 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00830810 +C 00840810 +CBE** ********************** BBCINITB **********************************00850810 + NUVI = I02 00860810 + IVTOTL = 10 00870810 + ZPROG = 'FM810' 00880810 +CBB** ********************** BBCHED0A **********************************00890810 +C**** 00900810 +C**** WRITE REPORT TITLE 00910810 +C**** 00920810 + WRITE (I02, 90002) 00930810 + WRITE (I02, 90006) 00940810 + WRITE (I02, 90007) 00950810 + WRITE (I02, 90008) ZVERS, ZVERSD 00960810 + WRITE (I02, 90009) ZPROG, ZPROG 00970810 + WRITE (I02, 90010) ZDATE, ZCOMPL 00980810 +CBE** ********************** BBCHED0A **********************************00990810 +C***** 01000810 +C***** 01010810 +C***** HEADER FOR SEGMENT 173 WRITTEN 01020810 + WRITE (NUVI,17301) 01030810 +17301 FORMAT(" ", //1X, "YDMMX - (173) INTRINSIC FUNCTIONS--" // 01040810 + 1 16X, "INTEGER, REAL AND D.P." /, 01050810 + 2 16X, "AND MIXED MODE EXPRESSIONS" // 01060810 + 3 2X, "ANS REF. - 15.3, 15.10, 6.1.4" ) 01070810 +CBB** ********************** BBCHED0B **********************************01080810 +C**** WRITE DETAIL REPORT HEADERS 01090810 +C**** 01100810 + WRITE (I02,90004) 01110810 + WRITE (I02,90004) 01120810 + WRITE (I02,90013) 01130810 + WRITE (I02,90014) 01140810 + WRITE (I02,90015) IVTOTL 01150810 +CBE** ********************** BBCHED0B **********************************01160810 +C***** 01170810 +CT001* TEST 1 01180810 + IVTNUM = 1 01190810 + DXBVD = 3.5D0 01200810 + IXAVI = IDINT(DXBVD) + 2 01210810 + IF (IXAVI - 5) 20010, 10010, 20010 01220810 +10010 IVPASS = IVPASS + 1 01230810 + WRITE (NUVI, 80002) IVTNUM 01240810 + GO TO 0011 01250810 +20010 IVFAIL = IVFAIL + 1 01260810 + IVCORR = 5 01270810 + WRITE (NUVI, 80010) IVTNUM, IXAVI, IVCORR 01280810 + 0011 CONTINUE 01290810 +CT002* TEST 2 01300810 + IVTNUM = 2 01310810 + DXBVD = 5.25D0 01320810 + RXAVS = SNGL(DXBVD) * 3.0 01330810 + IF (RXAVS - 15.749) 20020, 10020, 40020 01340810 +40020 IF (RXAVS - 15.751) 10020, 10020, 20020 01350810 +10020 IVPASS = IVPASS + 1 01360810 + WRITE (NUVI, 80002) IVTNUM 01370810 + GO TO 0021 01380810 +20020 IVFAIL = IVFAIL + 1 01390810 + RVCORR = 15.75 01400810 + WRITE (NUVI, 80012) IVTNUM, RXAVS, RVCORR 01410810 + 0021 CONTINUE 01420810 +CT003* TEST 3 01430810 + IVTNUM = 3 01440810 + DXBVD = 3.2D0 01450810 + DXAVD = DINT(DXBVD) ** 2.0 01460810 + IF (DXAVD - 8.999999995D0) 20030, 10030, 40030 01470810 +40030 IF (DXAVD - 9.000000005D0) 10030, 10030, 20030 01480810 +10030 IVPASS = IVPASS + 1 01490810 + WRITE (NUVI, 80002) IVTNUM 01500810 + GO TO 0031 01510810 +20030 IVFAIL = IVFAIL + 1 01520810 + DVCORR = 9.0D0 01530810 + WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR 01540810 + 0031 CONTINUE 01550810 +CT004* TEST 4 01560810 + IVTNUM = 4 01570810 + DXBVD = 3.2D0 01580810 + DXAVD = DNINT(DXBVD) + 2.5 01590810 + IF (DXAVD - 5.499999997D0) 20040, 10040, 40040 01600810 +40040 IF (DXAVD - 5.500000003D0) 10040, 10040, 20040 01610810 +10040 IVPASS = IVPASS + 1 01620810 + WRITE (NUVI, 80002) IVTNUM 01630810 + GO TO 0041 01640810 +20040 IVFAIL = IVFAIL + 1 01650810 + DVCORR = 5.5D0 01660810 + WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR 01670810 + 0041 CONTINUE 01680810 +CT005* TEST 5 01690810 + IVTNUM = 5 01700810 + DXBVD = 3.5D0 01710810 + RXAVS = IDINT(DXBVD) * 2.5 01720810 + IF (RXAVS - 7.4996) 20050, 10050, 40050 01730810 +40050 IF (RXAVS - 7.5004) 10050, 10050, 20050 01740810 +10050 IVPASS = IVPASS + 1 01750810 + WRITE (NUVI, 80002) IVTNUM 01760810 + GO TO 0051 01770810 +20050 IVFAIL = IVFAIL + 1 01780810 + RVCORR = 7.5 01790810 + WRITE (NUVI, 80012) IVTNUM, RXAVS, RVCORR 01800810 + 0051 CONTINUE 01810810 +CT006* TEST 6 01820810 + IVTNUM = 6 01830810 + DXBVD = -2.5D0 01840810 + DXAVD = DABS(DXBVD) * 2 01850810 + IF (DXAVD - 4.999999997D0) 20060, 10060, 40060 01860810 +40060 IF (DXAVD - 5.000000003D0) 10060, 10060, 20060 01870810 +10060 IVPASS = IVPASS + 1 01880810 + WRITE (NUVI, 80002) IVTNUM 01890810 + GO TO 0061 01900810 +20060 IVFAIL = IVFAIL + 1 01910810 + DVCORR = 5.0D0 01920810 + WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR 01930810 + 0061 CONTINUE 01940810 +CT007* TEST 7 01950810 + IVTNUM = 7 01960810 + DXBVD = 5.0D0 01970810 + DXDVD = 2.0D0 01980810 + DXEVD = 3.0D0 01990810 + DXFVD = -1.0D0 02000810 + DXAVD = DMOD(DXBVD, DXDVD) * 3 + DSIGN(DXEVD, DXFVD) 02010810 + IF (DXAVD + 5.0D-10) 20070, 10070, 40070 02020810 +40070 IF (DXAVD - 5.0D-10) 10070, 10070, 20070 02030810 +10070 IVPASS = IVPASS + 1 02040810 + WRITE (NUVI, 80002) IVTNUM 02050810 + GO TO 0071 02060810 +20070 IVFAIL = IVFAIL + 1 02070810 + DVCORR = 0.0D0 02080810 + WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR 02090810 + 0071 CONTINUE 02100810 +CT008* TEST 8 02110810 + IVTNUM = 8 02120810 + DXBVD = 1.5D1 02130810 + DXDVD = 0.5D1 02140810 + RXBVS = 5.0 02150810 + RXDVS = 2.0 02160810 + DXAVD = DDIM(DXBVD, DXDVD) / DPROD(RXBVS, RXDVS) 02170810 + IF (DXAVD - 0.9999999995D0) 20080, 10080, 40080 02180810 +40080 IF (DXAVD - 1.000000001D0) 10080, 10080, 20080 02190810 +10080 IVPASS = IVPASS + 1 02200810 + WRITE (NUVI, 80002) IVTNUM 02210810 + GO TO 0081 02220810 +20080 IVFAIL = IVFAIL + 1 02230810 + DVCORR = 1.0D0 02240810 + WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR 02250810 + 0081 CONTINUE 02260810 +CT009* TEST 9 02270810 + IVTNUM = 9 02280810 + DXBVD = 5.5D0 02290810 + DXDVD = 2.5D0 02300810 + DXEVD = 1.0D0 02310810 + RXBVS = 1.0 02320810 + DXAVD = (10 - DMAX1(DXBVD, DXDVD)) * (DMIN1(DXEVD, DXDVD) 02330810 + 1 + DBLE(RXBVS)) 02340810 + IF (DXAVD - 8.999999995D0) 20090, 10090, 40090 02350810 +40090 IF (DXAVD - 9.000000005D0) 10090, 10090, 20090 02360810 +10090 IVPASS = IVPASS + 1 02370810 + WRITE (NUVI, 80002) IVTNUM 02380810 + GO TO 0091 02390810 +20090 IVFAIL = IVFAIL + 1 02400810 + DVCORR = 9.0D0 02410810 + WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR 02420810 + 0091 CONTINUE 02430810 +CT010* TEST 10 02440810 + IVTNUM = 10 02450810 + DXBVD = 0.635D2 02460810 + RXBVS = 5.0 02470810 + DXDVD = 5.7D0 02480810 + DXEVD = -6.0D0 02490810 + DXFVD = 1.0D0 02500810 + DXGVD = 3.0D0 02510810 + DXAVD = (IDINT(DXBVD) + 1.0) / (7 - DBLE(RXBVS)) - 02520810 + 1 (DINT(DXDVD) + 5 + 5.5) * (DSIGN(DXEVD, DXFVD) / 02530810 + 2 SNGL(DXGVD)) 02540810 + IF (DXAVD - 0.9999999995D0) 20100, 10100, 40100 02550810 +40100 IF (DXAVD - 1.000000001D0) 10100, 10100, 20100 02560810 +10100 IVPASS = IVPASS + 1 02570810 + WRITE (NUVI, 80002) IVTNUM 02580810 + GO TO 0101 02590810 +20100 IVFAIL = IVFAIL + 1 02600810 + DVCORR = 1.0D0 02610810 + WRITE (NUVI, 80031) IVTNUM, DXAVD, DVCORR 02620810 + 0101 CONTINUE 02630810 +C***** 02640810 +CBB** ********************** BBCSUM0 **********************************02650810 +C**** WRITE OUT TEST SUMMARY 02660810 +C**** 02670810 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02680810 + WRITE (I02, 90004) 02690810 + WRITE (I02, 90014) 02700810 + WRITE (I02, 90004) 02710810 + WRITE (I02, 90020) IVPASS 02720810 + WRITE (I02, 90022) IVFAIL 02730810 + WRITE (I02, 90024) IVDELE 02740810 + WRITE (I02, 90026) IVINSP 02750810 + WRITE (I02, 90028) IVTOTN, IVTOTL 02760810 +CBE** ********************** BBCSUM0 **********************************02770810 +CBB** ********************** BBCFOOT0 **********************************02780810 +C**** WRITE OUT REPORT FOOTINGS 02790810 +C**** 02800810 + WRITE (I02,90016) ZPROG, ZPROG 02810810 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02820810 + WRITE (I02,90019) 02830810 +CBE** ********************** BBCFOOT0 **********************************02840810 +CBB** ********************** BBCFMT0A **********************************02850810 +C**** FORMATS FOR TEST DETAIL LINES 02860810 +C**** 02870810 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02880810 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02890810 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02900810 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02910810 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02920810 + 1I6,/," ",15X,"CORRECT= " ,I6) 02930810 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02940810 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02950810 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02960810 + 1A21,/," ",16X,"CORRECT= " ,A21) 02970810 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02980810 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02990810 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03000810 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03010810 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03020810 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03030810 +80050 FORMAT (" ",48X,A31) 03040810 +CBE** ********************** BBCFMT0A **********************************03050810 +CBB** ********************** BBCFMAT1 **********************************03060810 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03070810 +C**** 03080810 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03090810 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03100810 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03110810 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03120810 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03130810 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03140810 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03150810 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03160810 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03170810 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03180810 + 2"(",F12.5,", ",F12.5,")") 03190810 +CBE** ********************** BBCFMAT1 **********************************03200810 +CBB** ********************** BBCFMT0B **********************************03210810 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03220810 +C**** 03230810 +90002 FORMAT ("1") 03240810 +90004 FORMAT (" ") 03250810 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03260810 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03270810 +90008 FORMAT (" ",21X,A13,A17) 03280810 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03290810 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03300810 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03310810 + 1 7X,"REMARKS",24X) 03320810 +90014 FORMAT (" ","----------------------------------------------" , 03330810 + 1 "---------------------------------" ) 03340810 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03350810 +C**** 03360810 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03370810 +C**** 03380810 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03390810 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03400810 + 1 A13) 03410810 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03420810 +C**** 03430810 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03440810 +C**** 03450810 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03460810 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03470810 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03480810 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03490810 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03500810 +CBE** ********************** BBCFMT0B **********************************03510810 +C***** END OF TEST SEGMENT 173 03520810 + STOP 03530810 + END 03540810 + 03550810 diff --git a/Fortran/UnitTests/fcvs21_f95/FM810.reference_output b/Fortran/UnitTests/fcvs21_f95/FM810.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM810.reference_output @@ -0,0 +1,46 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM810BEGIN* TEST RESULTS - FM810 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YDMMX - (173) INTRINSIC FUNCTIONS-- + + INTEGER, REAL AND D.P. + AND MIXED MODE EXPRESSIONS + + ANS REF. - 15.3, 15.10, 6.1.4 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 10 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + + ------------------------------------------------------------------------------- + + 10 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 10 OF 10 TESTS EXECUTED + + *FM810END* END OF TEST - FM810 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM811.f b/Fortran/UnitTests/fcvs21_f95/FM811.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM811.f @@ -0,0 +1,366 @@ + PROGRAM FM811 + +C***********************************************************************00010811 +C***** FORTRAN 77 00020811 +C***** FM811 YCMMX - (174) 00030811 +C***** 00040811 +C***********************************************************************00050811 +C***** GENERAL PURPOSE ANS REF 00060811 +C***** TESTS THE USE OF INTEGER, REAL, DOUBLE PRECISION, 15.10 00070811 +C***** AND COMPLEX EXPRESSIONS CONTAINING REFERENCE (TABLE 5)00080811 +C***** TO THE INTRINSIC FUNCTIONS OF THE FULL LANGUAGE 6.1.4 00090811 +C***** 00100811 +C***** GENERAL COMMENTS 00110811 +C***** SEGMENTS TESTING XINT, XREAL, XAINT, XABS, XAMOD, 00120811 +C***** XSIGN, XDIM, XMAX, XMIN, YIDINT, YSNGL 00130811 +C***** YDINT, YDABS, YCABS, YDMOD, YDSIGN, 00140811 +C***** YDMAX1, YDMIN1, YDBLE, YCONJG ASSUMED WORKING 00150811 +C***** 00160811 +CBB** ********************** BBCCOMNT **********************************00170811 +C**** 00180811 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00190811 +C**** VERSION 2.1 00200811 +C**** 00210811 +C**** 00220811 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00230811 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00240811 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00250811 +C**** BUILDING 225 RM A266 00260811 +C**** GAITHERSBURG, MD 20899 00270811 +C**** 00280811 +C**** 00290811 +C**** 00300811 +CBE** ********************** BBCCOMNT **********************************00310811 +C***** 00320811 +C***** S P E C I F I C A T I O N S SEGMENT 174 00330811 + DOUBLE PRECISION DYAVD, DYBVD, DYDVD, DVCORR 00340811 + COMPLEX CYAVC, CYDVC, ZVCORR 00350811 + REAL R2E(2) 00360811 + EQUIVALENCE (CYAVC,R2E) 00370811 +C***** 00380811 +CBB** ********************** BBCINITA **********************************00390811 +C**** SPECIFICATION STATEMENTS 00400811 +C**** 00410811 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00420811 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00430811 +CBE** ********************** BBCINITA **********************************00440811 +CBB** ********************** BBCINITB **********************************00450811 +C**** INITIALIZE SECTION 00460811 + DATA ZVERS, ZVERSD, ZDATE 00470811 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00480811 + DATA ZCOMPL, ZNAME, ZTAPE 00490811 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00500811 + DATA ZPROJ, ZTAPED, ZPROG 00510811 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00520811 + DATA REMRKS /' '/ 00530811 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00540811 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00550811 +C**** 00560811 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00570811 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00580811 +CZ03 ZPROG = 'PROGRAM NAME' 00590811 +CZ04 ZDATE = 'DATE OF TEST' 00600811 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00610811 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00620811 +CZ07 ZNAME = 'NAME OF USER' 00630811 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00640811 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00650811 +C 00660811 + IVPASS = 0 00670811 + IVFAIL = 0 00680811 + IVDELE = 0 00690811 + IVINSP = 0 00700811 + IVTOTL = 0 00710811 + IVTOTN = 0 00720811 + ICZERO = 0 00730811 +C 00740811 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00750811 + I01 = 05 00760811 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00770811 + I02 = 06 00780811 +C 00790811 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00800811 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00810811 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00820811 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00830811 +C 00840811 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00850811 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00860811 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00870811 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00880811 +C 00890811 +CBE** ********************** BBCINITB **********************************00900811 + NUVI = I02 00910811 + IVTOTL = 10 00920811 + ZPROG = 'FM811' 00930811 +CBB** ********************** BBCHED0A **********************************00940811 +C**** 00950811 +C**** WRITE REPORT TITLE 00960811 +C**** 00970811 + WRITE (I02, 90002) 00980811 + WRITE (I02, 90006) 00990811 + WRITE (I02, 90007) 01000811 + WRITE (I02, 90008) ZVERS, ZVERSD 01010811 + WRITE (I02, 90009) ZPROG, ZPROG 01020811 + WRITE (I02, 90010) ZDATE, ZCOMPL 01030811 +CBE** ********************** BBCHED0A **********************************01040811 +C***** 01050811 +C***** HEADER FOR SEGMENT 174 WRITTEN 01060811 + WRITE (NUVI,17401) 01070811 +17401 FORMAT( " ", //1X, "YCMMX - (174) INTRINSIC FUNCTIONS--" // 01080811 + 1 16X, "INTEGER, REAL, D.P." / 01090811 + 2 16X, "AND COMPLEX IN MIXED MODE EXPRESSIONS" // 01100811 + 3 2X, "ANS REF. - 15.10" ) 01110811 +CBB** ********************** BBCHED0B **********************************01120811 +C**** WRITE DETAIL REPORT HEADERS 01130811 +C**** 01140811 + WRITE (I02,90004) 01150811 + WRITE (I02,90004) 01160811 + WRITE (I02,90013) 01170811 + WRITE (I02,90014) 01180811 + WRITE (I02,90015) IVTOTL 01190811 +CBE** ********************** BBCHED0B **********************************01200811 +C***** 01210811 +CT001* TEST 1 IDINT 01220811 + IVTNUM = 1 01230811 + DYBVD = 5.2D0 01240811 + CYAVC = IDINT(DYBVD) + (1.0, 2.0) 01250811 + IF (R2E(1) - 5.9997) 20010, 40012, 40011 01260811 +40011 IF (R2E(1) - 6.0003) 40012, 40012, 20010 01270811 +40012 IF (R2E(2) - 1.9999) 20010, 10010, 40010 01280811 +40010 IF (R2E(2) - 2.0001) 10010, 10010, 20010 01290811 +10010 IVPASS = IVPASS + 1 01300811 + WRITE (NUVI, 80002) IVTNUM 01310811 + GO TO 0011 01320811 +20010 IVFAIL = IVFAIL + 1 01330811 + ZVCORR = (6.0, 2.0) 01340811 + WRITE (NUVI, 80045) IVTNUM, CYAVC, ZVCORR 01350811 + 0011 CONTINUE 01360811 +CT002* TEST 2 SNGL 01370811 + IVTNUM = 2 01380811 + DYAVD = 5.5D0 01390811 + CYAVC = SNGL(DYAVD) - (3.0, 4.0) 01400811 + IF (R2E(1) - 2.4998) 20020, 40022, 40021 01410811 +40021 IF (R2E(1) - 2.5002) 40022, 40022, 20020 01420811 +40022 IF (R2E(2) + 4.0002) 20020, 10020, 40020 01430811 +40020 IF (R2E(2) + 3.9998) 10020, 10020, 20020 01440811 +10020 IVPASS = IVPASS + 1 01450811 + WRITE (NUVI, 80002) IVTNUM 01460811 + GO TO 0021 01470811 +20020 IVFAIL = IVFAIL + 1 01480811 + ZVCORR = (2.5, -4.0) 01490811 + WRITE (NUVI, 80045) IVTNUM, CYAVC, ZVCORR 01500811 + 0021 CONTINUE 01510811 +CT003* TEST 3 SNGL, DINT, DNINT, CABS 01520811 + IVTNUM = 3 01530811 + DYBVD = 5.8D0 01540811 + RYAVS = SNGL(DINT(DYBVD) + DNINT(DYBVD)) * CABS((3.0, 4.0)) 01550811 + IF (RYAVS - 54.997) 20030, 10030, 40030 01560811 +40030 IF (RYAVS - 55.003) 10030, 10030, 20030 01570811 +10030 IVPASS = IVPASS + 1 01580811 + WRITE (NUVI, 80002) IVTNUM 01590811 + GO TO 0031 01600811 +20030 IVFAIL = IVFAIL + 1 01610811 + RVCORR = 55.0 01620811 + WRITE (NUVI, 80012) IVTNUM, RYAVS, RVCORR 01630811 + 0031 CONTINUE 01640811 +CT004* TEST 4 IDNINT, AIMAG 01650811 + IVTNUM = 4 01660811 + CYDVC = (3.0, 4.0) 01670811 + DYBVD = 5.8D0 01680811 + CYAVC = ((IDNINT(DYBVD) - CYDVC)) * AIMAG((4.0, 3.0)) 01690811 + IF (R2E(1) - 8.9995) 20040, 40042, 40041 01700811 +40041 IF (R2E(1) - 9.0005) 40042, 40042, 20040 01710811 +40042 IF (R2E(2) + 12.001) 20040, 10040, 40040 01720811 +40040 IF (R2E(2) + 11.999) 10040, 10040, 20040 01730811 +10040 IVPASS = IVPASS + 1 01740811 + WRITE (NUVI, 80002) IVTNUM 01750811 + GO TO 0041 01760811 +20040 IVFAIL = IVFAIL + 1 01770811 + ZVCORR = (9.0, -12.0) 01780811 + WRITE (NUVI, 80045) IVTNUM, CYAVC, ZVCORR 01790811 + 0041 CONTINUE 01800811 +CT005* TEST 5 CABS, CMPLX 01810811 + IVTNUM = 5 01820811 + IYAVI = 5 01830811 + RYAVS = CABS(CMPLX(3.0, 4.0)) / IYAVI 01840811 + IF (RYAVS - 0.99995) 20050, 10050, 40050 01850811 +40050 IF (RYAVS - 1.0001) 10050, 10050, 20050 01860811 +10050 IVPASS = IVPASS + 1 01870811 + WRITE (NUVI, 80002) IVTNUM 01880811 + GO TO 0051 01890811 +20050 IVFAIL = IVFAIL + 1 01900811 + RVCORR = 1.0 01910811 + WRITE (NUVI, 80012) IVTNUM, RYAVS, RVCORR 01920811 + 0051 CONTINUE 01930811 +CT006* TEST 6 CONJG, SNGL, DMOD 01940811 + IVTNUM = 6 01950811 + DYBVD = 5.0D0 01960811 + DYDVD = 3.0D0 01970811 + CYAVC = CONJG((3.0, 4.0)) * SNGL(DMOD(DYBVD, DYDVD)) 01980811 + IF (R2E(1) - 5.9997) 20060, 40062, 40061 01990811 +40061 IF (R2E(1) - 6.0003) 40062, 40062, 20060 02000811 +40062 IF (R2E(2) + 8.0004) 20060, 10060, 40060 02010811 +40060 IF (R2E(2) + 7.9996) 10060, 10060, 20060 02020811 +10060 IVPASS = IVPASS + 1 02030811 + WRITE (NUVI, 80002) IVTNUM 02040811 + GO TO 0061 02050811 +20060 IVFAIL = IVFAIL + 1 02060811 + ZVCORR = (6.0, -8.0) 02070811 + WRITE (NUVI, 80045) IVTNUM, CYAVC, ZVCORR 02080811 + 0061 CONTINUE 02090811 +CT007* TEST 7 DSIGN, AIMAG, CONJG 02100811 + IVTNUM = 7 02110811 + CYDVC = (-3.0, -4.0) 02120811 + DYBVD = 4.0D0 02130811 + DYDVD = 1.0D0 02140811 + DYAVD = DSIGN(DYBVD, DYDVD) / AIMAG(CONJG(CYDVC)) 02150811 + IF (DYAVD - 0.9999999995D0) 20070, 10070, 40070 02160811 +40070 IF (DYAVD - 1.000000001D0) 10070, 10070, 20070 02170811 +10070 IVPASS = IVPASS + 1 02180811 + WRITE (NUVI, 80002) IVTNUM 02190811 + GO TO 0071 02200811 +20070 IVFAIL = IVFAIL + 1 02210811 + DVCORR = 1.0D0 02220811 + WRITE (NUVI, 80031) IVTNUM, DYAVD, DVCORR 02230811 + 0071 CONTINUE 02240811 +CT008* TEST 8 DPROD, CABS, AIMAG, SNGL, DDIM 02250811 + IVTNUM = 8 02260811 + CYDVC = (3.0, 4.0) 02270811 + DYBVD = -7.0D0 02280811 + DYDVD = 3.0D0 02290811 + DYAVD = DPROD(CABS(CYDVC + (-3.0, 3.0)), 02300811 + 1 AIMAG(CYDVC) + (SNGL(DDIM(DYBVD, DYDVD)))) 02310811 + IF (DYAVD - 27.99999998D0) 20080, 10080, 40080 02320811 +40080 IF (DYAVD - 28.00000002D0) 10080, 10080, 20080 02330811 +10080 IVPASS = IVPASS + 1 02340811 + WRITE (NUVI, 80002) IVTNUM 02350811 + GO TO 0081 02360811 +20080 IVFAIL = IVFAIL + 1 02370811 + DVCORR = 28.0D0 02380811 + WRITE (NUVI, 80031) IVTNUM, DYAVD, DVCORR 02390811 + 0081 CONTINUE 02400811 +CT009* TEST 9 AMAX1, CABS, AIMAG 02410811 + IVTNUM = 9 02420811 + CYDVC = (3.0, 4.0) 02430811 + DYAVD = AMAX1(CABS(CYDVC), AIMAG(CYDVC * CYDVC)) 02440811 + IF (DYAVD - 23.99999998D0) 20090, 10090, 40090 02450811 +40090 IF (DYAVD - 24.00000002D0) 10090, 10090, 20090 02460811 +10090 IVPASS = IVPASS + 1 02470811 + WRITE (NUVI, 80002) IVTNUM 02480811 + GO TO 0091 02490811 +20090 IVFAIL = IVFAIL + 1 02500811 + DVCORR = 24.0D0 02510811 + WRITE (NUVI, 80031) IVTNUM, DYAVD, DVCORR 02520811 + 0091 CONTINUE 02530811 +CT010* TEST 10 AIMAG, ABS, AMIN0 02540811 + IVTNUM = 10 02550811 + CYDVC = (3.0, -3.) 02560811 + IYBVI = 4 02570811 + IYDVI = -3 02580811 + CYAVC = ((3.0, 4.0) + AIMAG((3.0, 4.0))) * 02590811 + 1 (ABS(AMIN0(IYBVI, IYDVI)) - CYDVC) 02600811 + IF (R2E(1) + 12.001) 20100, 40102, 40101 02610811 +40101 IF (R2E(1) + 11.999) 40102, 40102, 20100 02620811 +40102 IF (R2E(2) - 20.999) 20100, 10100, 40100 02630811 +40100 IF (R2E(2) - 21.001) 10100, 10100, 20100 02640811 +10100 IVPASS = IVPASS + 1 02650811 + WRITE (NUVI, 80002) IVTNUM 02660811 + GO TO 0101 02670811 +20100 IVFAIL = IVFAIL + 1 02680811 + ZVCORR = (-12.0, 21.0) 02690811 + WRITE (NUVI, 80045) IVTNUM, CYAVC, ZVCORR 02700811 + 0101 CONTINUE 02710811 +C***** 02720811 +CBB** ********************** BBCSUM0 **********************************02730811 +C**** WRITE OUT TEST SUMMARY 02740811 +C**** 02750811 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02760811 + WRITE (I02, 90004) 02770811 + WRITE (I02, 90014) 02780811 + WRITE (I02, 90004) 02790811 + WRITE (I02, 90020) IVPASS 02800811 + WRITE (I02, 90022) IVFAIL 02810811 + WRITE (I02, 90024) IVDELE 02820811 + WRITE (I02, 90026) IVINSP 02830811 + WRITE (I02, 90028) IVTOTN, IVTOTL 02840811 +CBE** ********************** BBCSUM0 **********************************02850811 +CBB** ********************** BBCFOOT0 **********************************02860811 +C**** WRITE OUT REPORT FOOTINGS 02870811 +C**** 02880811 + WRITE (I02,90016) ZPROG, ZPROG 02890811 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02900811 + WRITE (I02,90019) 02910811 +CBE** ********************** BBCFOOT0 **********************************02920811 +CBB** ********************** BBCFMT0A **********************************02930811 +C**** FORMATS FOR TEST DETAIL LINES 02940811 +C**** 02950811 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02960811 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02970811 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02980811 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02990811 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03000811 + 1I6,/," ",15X,"CORRECT= " ,I6) 03010811 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03020811 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03030811 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03040811 + 1A21,/," ",16X,"CORRECT= " ,A21) 03050811 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03060811 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03070811 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03080811 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03090811 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03100811 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03110811 +80050 FORMAT (" ",48X,A31) 03120811 +CBE** ********************** BBCFMT0A **********************************03130811 +CBB** ********************** BBCFMAT1 **********************************03140811 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03150811 +C**** 03160811 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03170811 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03180811 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03190811 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03200811 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03210811 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03220811 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03230811 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03240811 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03250811 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03260811 + 2"(",F12.5,", ",F12.5,")") 03270811 +CBE** ********************** BBCFMAT1 **********************************03280811 +CBB** ********************** BBCFMT0B **********************************03290811 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03300811 +C**** 03310811 +90002 FORMAT ("1") 03320811 +90004 FORMAT (" ") 03330811 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03340811 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03350811 +90008 FORMAT (" ",21X,A13,A17) 03360811 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03370811 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03380811 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03390811 + 1 7X,"REMARKS",24X) 03400811 +90014 FORMAT (" ","----------------------------------------------" , 03410811 + 1 "---------------------------------" ) 03420811 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03430811 +C**** 03440811 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03450811 +C**** 03460811 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03470811 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03480811 + 1 A13) 03490811 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03500811 +C**** 03510811 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03520811 +C**** 03530811 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03540811 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03550811 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03560811 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03570811 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03580811 +CBE** ********************** BBCFMT0B **********************************03590811 +C***** 03600811 +C***** END OF TEST SEGMENT 174 03610811 + STOP 03620811 + END 03630811 + 03640811 diff --git a/Fortran/UnitTests/fcvs21_f95/FM811.reference_output b/Fortran/UnitTests/fcvs21_f95/FM811.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM811.reference_output @@ -0,0 +1,46 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM811BEGIN* TEST RESULTS - FM811 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + + YCMMX - (174) INTRINSIC FUNCTIONS-- + + INTEGER, REAL, D.P. + AND COMPLEX IN MIXED MODE EXPRESSIONS + + ANS REF. - 15.10 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 10 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + + ------------------------------------------------------------------------------- + + 10 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 10 OF 10 TESTS EXECUTED + + *FM811END* END OF TEST - FM811 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM812.f b/Fortran/UnitTests/fcvs21_f95/FM812.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM812.f @@ -0,0 +1,365 @@ + PROGRAM FM812 + +C***********************************************************************00010812 +C***** FORTRAN 77 00020812 +C***** FM812 00030812 +C***** YDSQRT - (176) 00040812 +C***** 00050812 +C***********************************************************************00060812 +C***** GENERAL PURPOSE ANS REF 00070812 +C***** TEST INTRINSIC FUNCTION DSQRT 15.3 00080812 +C***** TABLE 5 00090812 +C***** 00100812 +CBB** ********************** BBCCOMNT **********************************00110812 +C**** 00120812 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130812 +C**** VERSION 2.1 00140812 +C**** 00150812 +C**** 00160812 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170812 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180812 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190812 +C**** BUILDING 225 RM A266 00200812 +C**** GAITHERSBURG, MD 20899 00210812 +C**** 00220812 +C**** 00230812 +C**** 00240812 +CBE** ********************** BBCCOMNT **********************************00250812 +C***** S P E C I F I C A T I O N S SEGMENT 176 00260812 + DOUBLE PRECISION AVD, BVD, DVCORR 00270812 +C***** 00280812 +CBB** ********************** BBCINITA **********************************00290812 +C**** SPECIFICATION STATEMENTS 00300812 +C**** 00310812 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320812 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330812 +CBE** ********************** BBCINITA **********************************00340812 +CBB** ********************** BBCINITB **********************************00350812 +C**** INITIALIZE SECTION 00360812 + DATA ZVERS, ZVERSD, ZDATE 00370812 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380812 + DATA ZCOMPL, ZNAME, ZTAPE 00390812 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400812 + DATA ZPROJ, ZTAPED, ZPROG 00410812 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420812 + DATA REMRKS /' '/ 00430812 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440812 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450812 +C**** 00460812 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470812 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480812 +CZ03 ZPROG = 'PROGRAM NAME' 00490812 +CZ04 ZDATE = 'DATE OF TEST' 00500812 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510812 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520812 +CZ07 ZNAME = 'NAME OF USER' 00530812 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540812 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550812 +C 00560812 + IVPASS = 0 00570812 + IVFAIL = 0 00580812 + IVDELE = 0 00590812 + IVINSP = 0 00600812 + IVTOTL = 0 00610812 + IVTOTN = 0 00620812 + ICZERO = 0 00630812 +C 00640812 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650812 + I01 = 05 00660812 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670812 + I02 = 06 00680812 +C 00690812 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700812 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710812 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720812 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730812 +C 00740812 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750812 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760812 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770812 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780812 +C 00790812 +CBE** ********************** BBCINITB **********************************00800812 + NUVI = I02 00810812 + IVTOTL = 13 00820812 + ZPROG = 'FM812' 00830812 +CBB** ********************** BBCHED0A **********************************00840812 +C**** 00850812 +C**** WRITE REPORT TITLE 00860812 +C**** 00870812 + WRITE (I02, 90002) 00880812 + WRITE (I02, 90006) 00890812 + WRITE (I02, 90007) 00900812 + WRITE (I02, 90008) ZVERS, ZVERSD 00910812 + WRITE (I02, 90009) ZPROG, ZPROG 00920812 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930812 +CBE** ********************** BBCHED0A **********************************00940812 +C***** 00950812 +C***** HEADER FOR SEGMENT 176 00960812 + WRITE(NUVI,17600) 00970812 +17600 FORMAT(" ", / " YDSQRT - (176) INTRINSIC FUNCTIONS" // 00980812 + 1 " DSQRT (DOUBLE PRECISION SQUARE ROOT)" // 00990812 + 2 " ANS REF. - 15.3" ) 01000812 +CBB** ********************** BBCHED0B **********************************01010812 +C**** WRITE DETAIL REPORT HEADERS 01020812 +C**** 01030812 + WRITE (I02,90004) 01040812 + WRITE (I02,90004) 01050812 + WRITE (I02,90013) 01060812 + WRITE (I02,90014) 01070812 + WRITE (I02,90015) IVTOTL 01080812 +CBE** ********************** BBCHED0B **********************************01090812 +C***** 01100812 +CT001* TEST 1 FIXED POINT OF FUNCTION 01110812 + IVTNUM = 1 01120812 + BVD = 0.0D0 01130812 + AVD = DSQRT(BVD) 01140812 + IF (AVD + 0.5000000000D-09) 20010, 10010, 40010 01150812 +40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010 01160812 +10010 IVPASS = IVPASS + 1 01170812 + WRITE (NUVI, 80002) IVTNUM 01180812 + GO TO 0011 01190812 +20010 IVFAIL = IVFAIL + 1 01200812 + DVCORR = 0.00000000000000000000D0 01210812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01220812 + 0011 CONTINUE 01230812 +CT002* TEST 2 FIXED POINT OF FUNCTION 01240812 + IVTNUM = 2 01250812 + AVD = DSQRT(1.0D0) 01260812 + IF (AVD - 0.9999999995D+00) 20020, 10020, 40020 01270812 +40020 IF (AVD - 0.1000000001D+01) 10020, 10020, 20020 01280812 +10020 IVPASS = IVPASS + 1 01290812 + WRITE (NUVI, 80002) IVTNUM 01300812 + GO TO 0021 01310812 +20020 IVFAIL = IVFAIL + 1 01320812 + DVCORR = 1.0000000000000000000D0 01330812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01340812 + 0021 CONTINUE 01350812 +CT003* TEST 3 CONSTANT OF VALUE 2.0D0 01360812 + IVTNUM = 3 01370812 + AVD = DSQRT(2.0D0) 01380812 + IF (AVD - 0.1414213561D+01) 20030, 10030, 40030 01390812 +40030 IF (AVD - 0.1414213563D+01) 10030, 10030, 20030 01400812 +10030 IVPASS = IVPASS + 1 01410812 + WRITE (NUVI, 80002) IVTNUM 01420812 + GO TO 0031 01430812 +20030 IVFAIL = IVFAIL + 1 01440812 + DVCORR = 1.4142135623730950488D0 01450812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01460812 + 0031 CONTINUE 01470812 +CT004* TEST 4 CONSTANT OF VALUE 4.0D0 01480812 + IVTNUM = 4 01490812 + AVD = DSQRT(4.0D0) 01500812 + IF (AVD - 0.1999999999D+01) 20040, 10040, 40040 01510812 +40040 IF (AVD - 0.2000000001D+01) 10040, 10040, 20040 01520812 +10040 IVPASS = IVPASS + 1 01530812 + WRITE (NUVI, 80002) IVTNUM 01540812 + GO TO 0041 01550812 +20040 IVFAIL = IVFAIL + 1 01560812 + DVCORR = 2.0000000000000000000D0 01570812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01580812 + 0041 CONTINUE 01590812 +CT005* TEST 5 CONSTANT OF VALUE 15.0D0 01600812 + IVTNUM = 5 01610812 + AVD = DSQRT(15.0D0) 01620812 + IF (AVD - 0.3872983344D+01) 20050, 10050, 40050 01630812 +40050 IF (AVD - 0.3872983348D+01) 10050, 10050, 20050 01640812 +10050 IVPASS = IVPASS + 1 01650812 + WRITE (NUVI, 80002) IVTNUM 01660812 + GO TO 0051 01670812 +20050 IVFAIL = IVFAIL + 1 01680812 + DVCORR = 3.8729833462074168852D0 01690812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01700812 + 0051 CONTINUE 01710812 +CT006* TEST 6 CONSTANT OF VALUE 31.0D0 01720812 + IVTNUM = 6 01730812 + AVD = DSQRT(31.0D0) 01740812 + IF (AVD - 0.5567764360D+01) 20060, 10060, 40060 01750812 +40060 IF (AVD - 0.5567764366D+01) 10060, 10060, 20060 01760812 +10060 IVPASS = IVPASS + 1 01770812 + WRITE (NUVI, 80002) IVTNUM 01780812 + GO TO 0061 01790812 +20060 IVFAIL = IVFAIL + 1 01800812 + DVCORR = 5.5677643628300219221D0 01810812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01820812 + 0061 CONTINUE 01830812 +CT007* TEST 7 VARIABLE PRESENTED TO DSQRT 01840812 + IVTNUM = 7 01850812 + BVD = 2.0D0 / 4.0D0 01860812 + AVD = DSQRT(BVD) 01870812 + IF (AVD - 0.7071067808D+00) 20070, 10070, 40070 01880812 +40070 IF (AVD - 0.7071067816D+00) 10070, 10070, 20070 01890812 +10070 IVPASS = IVPASS + 1 01900812 + WRITE (NUVI, 80002) IVTNUM 01910812 + GO TO 0071 01920812 +20070 IVFAIL = IVFAIL + 1 01930812 + DVCORR = 0.70710678118654752440D0 01940812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01950812 + 0071 CONTINUE 01960812 +CT008* TEST 8 EXPRESSION PRESENTED TO DSQRT 01970812 + IVTNUM = 8 01980812 + BVD = 25.0D0 01990812 + AVD = DSQRT(BVD / 100.0D0) 02000812 + IF (AVD - 0.4999999997D+00) 20080, 10080, 40080 02010812 +40080 IF (AVD - 0.5000000003D+00) 10080, 10080, 20080 02020812 +10080 IVPASS = IVPASS + 1 02030812 + WRITE (NUVI, 80002) IVTNUM 02040812 + GO TO 0081 02050812 +20080 IVFAIL = IVFAIL + 1 02060812 + DVCORR = 0.50000000000000000000D0 02070812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02080812 + 0081 CONTINUE 02090812 +CT009* TEST 9 EXPRESSION PRESENTED TO DSQRT 02100812 + IVTNUM = 9 02110812 + BVD = 0.0875D0 02120812 + AVD = DSQRT(BVD * 10.0D0) 02130812 + IF (AVD - 0.9354143462D+00) 20090, 10090, 40090 02140812 +40090 IF (AVD - 0.9354143472D+00) 10090, 10090, 20090 02150812 +10090 IVPASS = IVPASS + 1 02160812 + WRITE (NUVI, 80002) IVTNUM 02170812 + GO TO 0091 02180812 +20090 IVFAIL = IVFAIL + 1 02190812 + DVCORR = 0.93541434669348534640D0 02200812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02210812 + 0091 CONTINUE 02220812 +CT010* TEST 10 AN EXPRESSION WITH VALUE CLOSE TO ONE 02230812 + IVTNUM = 10 02240812 + AVD = DSQRT(31.0D0 / 32.0D0) 02250812 + IF (AVD - 0.9842509837D+00) 20100, 10100, 40100 02260812 +40100 IF (AVD - 0.9842509848D+00) 10100, 10100, 20100 02270812 +10100 IVPASS = IVPASS + 1 02280812 + WRITE (NUVI, 80002) IVTNUM 02290812 + GO TO 0101 02300812 +20100 IVFAIL = IVFAIL + 1 02310812 + DVCORR = 0.98425098425147637746D0 02320812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02330812 + 0101 CONTINUE 02340812 +CT011* TEST 11 AN ARGUMENT OF LOW MAGNITUDE 02350812 + IVTNUM = 11 02360812 + AVD = DSQRT(1.6D-35) 02370812 + IF (AVD - 0.3999999998D-17) 20110, 10110, 40110 02380812 +40110 IF (AVD - 0.4000000002D-17) 10110, 10110, 20110 02390812 +10110 IVPASS = IVPASS + 1 02400812 + WRITE (NUVI, 80002) IVTNUM 02410812 + GO TO 0111 02420812 +20110 IVFAIL = IVFAIL + 1 02430812 + DVCORR = 0.40000000000000000000D-17 02440812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02450812 + 0111 CONTINUE 02460812 +CT012* TEST 12 AN ARGUMENT OF HIGH MAGNITUDE 02470812 + IVTNUM = 12 02480812 + AVD = DSQRT(1.0D+35) 02490812 + IF (AVD - 0.3162277658D+18) 20120, 10120, 40120 02500812 +40120 IF (AVD - 0.3162277662D+18) 10120, 10120, 20120 02510812 +10120 IVPASS = IVPASS + 1 02520812 + WRITE (NUVI, 80002) IVTNUM 02530812 + GO TO 0121 02540812 +20120 IVFAIL = IVFAIL + 1 02550812 + DVCORR = 0.31622776601683793320D+18 02560812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02570812 + 0121 CONTINUE 02580812 +CT013* TEST 13 THE FUNCTION APPLIED TWICE 02590812 + IVTNUM = 13 02600812 + BVD = DSQRT(1.6D0) 02610812 + AVD = DSQRT(0.625D0) * BVD 02620812 + IF (AVD - 0.9999999995D+00) 20130, 10130, 40130 02630812 +40130 IF (AVD - 0.1000000001D+01) 10130, 10130, 20130 02640812 +10130 IVPASS = IVPASS + 1 02650812 + WRITE (NUVI, 80002) IVTNUM 02660812 + GO TO 0131 02670812 +20130 IVFAIL = IVFAIL + 1 02680812 + DVCORR = 1.00000000000000D0 02690812 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02700812 + 0131 CONTINUE 02710812 +C***** 02720812 +CBB** ********************** BBCSUM0 **********************************02730812 +C**** WRITE OUT TEST SUMMARY 02740812 +C**** 02750812 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02760812 + WRITE (I02, 90004) 02770812 + WRITE (I02, 90014) 02780812 + WRITE (I02, 90004) 02790812 + WRITE (I02, 90020) IVPASS 02800812 + WRITE (I02, 90022) IVFAIL 02810812 + WRITE (I02, 90024) IVDELE 02820812 + WRITE (I02, 90026) IVINSP 02830812 + WRITE (I02, 90028) IVTOTN, IVTOTL 02840812 +CBE** ********************** BBCSUM0 **********************************02850812 +CBB** ********************** BBCFOOT0 **********************************02860812 +C**** WRITE OUT REPORT FOOTINGS 02870812 +C**** 02880812 + WRITE (I02,90016) ZPROG, ZPROG 02890812 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02900812 + WRITE (I02,90019) 02910812 +CBE** ********************** BBCFOOT0 **********************************02920812 +CBB** ********************** BBCFMT0A **********************************02930812 +C**** FORMATS FOR TEST DETAIL LINES 02940812 +C**** 02950812 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02960812 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02970812 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02980812 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02990812 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03000812 + 1I6,/," ",15X,"CORRECT= " ,I6) 03010812 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03020812 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03030812 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03040812 + 1A21,/," ",16X,"CORRECT= " ,A21) 03050812 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03060812 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03070812 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03080812 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03090812 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03100812 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03110812 +80050 FORMAT (" ",48X,A31) 03120812 +CBE** ********************** BBCFMT0A **********************************03130812 +CBB** ********************** BBCFMAT1 **********************************03140812 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03150812 +C**** 03160812 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03170812 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03180812 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03190812 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03200812 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03210812 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03220812 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03230812 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03240812 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03250812 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03260812 + 2"(",F12.5,", ",F12.5,")") 03270812 +CBE** ********************** BBCFMAT1 **********************************03280812 +CBB** ********************** BBCFMT0B **********************************03290812 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03300812 +C**** 03310812 +90002 FORMAT ("1") 03320812 +90004 FORMAT (" ") 03330812 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03340812 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03350812 +90008 FORMAT (" ",21X,A13,A17) 03360812 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03370812 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03380812 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03390812 + 1 7X,"REMARKS",24X) 03400812 +90014 FORMAT (" ","----------------------------------------------" , 03410812 + 1 "---------------------------------" ) 03420812 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03430812 +C**** 03440812 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03450812 +C**** 03460812 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03470812 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03480812 + 1 A13) 03490812 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03500812 +C**** 03510812 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03520812 +C**** 03530812 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03540812 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03550812 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03560812 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03570812 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03580812 +CBE** ********************** BBCFMT0B **********************************03590812 +C***** END OF TEST SEGMENT 176 03600812 + STOP 03610812 + END 03620812 + 03630812 diff --git a/Fortran/UnitTests/fcvs21_f95/FM812.reference_output b/Fortran/UnitTests/fcvs21_f95/FM812.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM812.reference_output @@ -0,0 +1,47 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM812BEGIN* TEST RESULTS - FM812 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDSQRT - (176) INTRINSIC FUNCTIONS + + DSQRT (DOUBLE PRECISION SQUARE ROOT) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 13 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + + ------------------------------------------------------------------------------- + + 13 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 13 OF 13 TESTS EXECUTED + + *FM812END* END OF TEST - FM812 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM813.f b/Fortran/UnitTests/fcvs21_f95/FM813.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM813.f @@ -0,0 +1,404 @@ + PROGRAM FM813 + +C***********************************************************************00010813 +C***** FORTRAN 77 00020813 +C***** FM813 00030813 +C***** YCSQRT - (177) 00040813 +C***** 00050813 +C***********************************************************************00060813 +C***** GENERAL PURPOSE ANS REF 00070813 +C***** TEST INTRINSIC FUNCTION CSQRT 15.3 00080813 +C***** TABLE 5 00090813 +C***** 00100813 +CBB** ********************** BBCCOMNT **********************************00110813 +C**** 00120813 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130813 +C**** VERSION 2.1 00140813 +C**** 00150813 +C**** 00160813 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170813 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180813 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190813 +C**** BUILDING 225 RM A266 00200813 +C**** GAITHERSBURG, MD 20899 00210813 +C**** 00220813 +C**** 00230813 +C**** 00240813 +CBE** ********************** BBCCOMNT **********************************00250813 +C***** 00260813 +C***** S P E C F I C A T I O N S SEGMENT 177 00270813 + COMPLEX AVC, BVC, CVC, ZVCORR 00280813 + REAL R2E(2) 00290813 + EQUIVALENCE (AVC, R2E) 00300813 +C***** 00310813 +CBB** ********************** BBCINITA **********************************00320813 +C**** SPECIFICATION STATEMENTS 00330813 +C**** 00340813 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350813 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360813 +CBE** ********************** BBCINITA **********************************00370813 +CBB** ********************** BBCINITB **********************************00380813 +C**** INITIALIZE SECTION 00390813 + DATA ZVERS, ZVERSD, ZDATE 00400813 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410813 + DATA ZCOMPL, ZNAME, ZTAPE 00420813 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430813 + DATA ZPROJ, ZTAPED, ZPROG 00440813 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450813 + DATA REMRKS /' '/ 00460813 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470813 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480813 +C**** 00490813 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500813 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510813 +CZ03 ZPROG = 'PROGRAM NAME' 00520813 +CZ04 ZDATE = 'DATE OF TEST' 00530813 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540813 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550813 +CZ07 ZNAME = 'NAME OF USER' 00560813 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570813 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580813 +C 00590813 + IVPASS = 0 00600813 + IVFAIL = 0 00610813 + IVDELE = 0 00620813 + IVINSP = 0 00630813 + IVTOTL = 0 00640813 + IVTOTN = 0 00650813 + ICZERO = 0 00660813 +C 00670813 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680813 + I01 = 05 00690813 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700813 + I02 = 06 00710813 +C 00720813 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730813 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740813 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750813 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760813 +C 00770813 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780813 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790813 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800813 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810813 +C 00820813 +CBE** ********************** BBCINITB **********************************00830813 + NUVI = I02 00840813 + IVTOTL = 13 00850813 + ZPROG = 'FM813' 00860813 +CBB** ********************** BBCHED0A **********************************00870813 +C**** 00880813 +C**** WRITE REPORT TITLE 00890813 +C**** 00900813 + WRITE (I02, 90002) 00910813 + WRITE (I02, 90006) 00920813 + WRITE (I02, 90007) 00930813 + WRITE (I02, 90008) ZVERS, ZVERSD 00940813 + WRITE (I02, 90009) ZPROG, ZPROG 00950813 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960813 +CBE** ********************** BBCHED0A **********************************00970813 +C***** 00980813 +C***** HEADER FOR SEGMENT 177 00990813 + WRITE(NUVI,17700) 01000813 +17700 FORMAT(" ", / " YCSQRT - (177) INTRINSIC FUNCTIONS" // 01010813 + 1 " CSQRT (COMPLEX SQUARE ROOT)" // 01020813 + 2 " ANS REF. - 15.3" ) 01030813 +CBB** ********************** BBCHED0B **********************************01040813 +C**** WRITE DETAIL REPORT HEADERS 01050813 +C**** 01060813 + WRITE (I02,90004) 01070813 + WRITE (I02,90004) 01080813 + WRITE (I02,90013) 01090813 + WRITE (I02,90014) 01100813 + WRITE (I02,90015) IVTOTL 01110813 +CBE** ********************** BBCHED0B **********************************01120813 +C***** 01130813 +CT001* TEST 1 ZERO 01140813 + IVTNUM = 1 01150813 + BVC = (0.0, 0.0) 01160813 + AVC = CSQRT(BVC) 01170813 + IF (R2E(1) + 0.50000E-04) 20010, 40012, 40011 01180813 +40011 IF (R2E(1) - 0.50000E-04) 40012, 40012, 20010 01190813 +40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010 01200813 +40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010 01210813 +10010 IVPASS = IVPASS + 1 01220813 + WRITE (NUVI, 80002) IVTNUM 01230813 + GO TO 0011 01240813 +20010 IVFAIL = IVFAIL + 1 01250813 + ZVCORR = (0.00000000000000, 0.00000000000000) 01260813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01270813 + 0011 CONTINUE 01280813 +CT002* TEST 2 POSITIVE REAL NUMBERS 01290813 + IVTNUM = 2 01300813 + BVC = (4.0, 4.0) 01310813 + AVC = CSQRT(BVC - (0.0, 4.0)) 01320813 + IF (R2E(1) - 0.19999E+01) 20020, 40022, 40021 01330813 +40021 IF (R2E(1) - 0.20001E+01) 40022, 40022, 20020 01340813 +40022 IF (R2E(2) + 0.50000E-04) 20020, 10020, 40020 01350813 +40020 IF (R2E(2) - 0.50000E-04) 10020, 10020, 20020 01360813 +10020 IVPASS = IVPASS + 1 01370813 + WRITE (NUVI, 80002) IVTNUM 01380813 + GO TO 0021 01390813 +20020 IVFAIL = IVFAIL + 1 01400813 + ZVCORR = (2.00000000000000, 0.00000000000000) 01410813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01420813 + 0021 CONTINUE 01430813 +CT003* TEST 3 POSITIVE REAL NUMBERS 01440813 + IVTNUM = 3 01450813 + BVC = (4.0, 4.0) 01460813 + CVC = (4.0, -4.0) 01470813 + AVC = CSQRT(BVC + CVC) 01480813 + IF (R2E(1) - 0.28282E+01) 20030, 40032, 40031 01490813 +40031 IF (R2E(1) - 0.28286E+01) 40032, 40032, 20030 01500813 +40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030 01510813 +40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030 01520813 +10030 IVPASS = IVPASS + 1 01530813 + WRITE (NUVI, 80002) IVTNUM 01540813 + GO TO 0031 01550813 +20030 IVFAIL = IVFAIL + 1 01560813 + ZVCORR = (2.8284271247462, 0.00000000000000) 01570813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01580813 + 0031 CONTINUE 01590813 +CT004* TEST 4 POSITIVE REAL NUMBERS 01600813 + IVTNUM = 4 01610813 + BVC = (4.0, 0.0) 01620813 + CVC = BVC + (5.0, 0.0) 01630813 + AVC = CSQRT(CVC) 01640813 + IF (R2E(1) - 0.29998E+01) 20040, 40042, 40041 01650813 +40041 IF (R2E(1) - 0.30002E+01) 40042, 40042, 20040 01660813 +40042 IF (R2E(2) + 0.50000E-04) 20040, 10040, 40040 01670813 +40040 IF (R2E(2) - 0.50000E-04) 10040, 10040, 20040 01680813 +10040 IVPASS = IVPASS + 1 01690813 + WRITE (NUVI, 80002) IVTNUM 01700813 + GO TO 0041 01710813 +20040 IVFAIL = IVFAIL + 1 01720813 + ZVCORR = (3.00000000000000, 0.00000000000000) 01730813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01740813 + 0041 CONTINUE 01750813 +CT005* TEST 5 NEGATIVE REAL NUMBERS 01760813 + IVTNUM = 5 01770813 + BVC = (-1.0, 0.0) 01780813 + AVC = CSQRT(BVC) 01790813 + IF (R2E(1) + 0.50000E-04) 20050, 40052, 40051 01800813 +40051 IF (R2E(1) - 0.50000E-04) 40052, 40052, 20050 01810813 +40052 IF (R2E(2) - 0.99995E+00) 20050, 10050, 40050 01820813 +40050 IF (R2E(2) - 0.10001E+01) 10050, 10050, 20050 01830813 +10050 IVPASS = IVPASS + 1 01840813 + WRITE (NUVI, 80002) IVTNUM 01850813 + GO TO 0051 01860813 +20050 IVFAIL = IVFAIL + 1 01870813 + ZVCORR = (0.00000000000000, 1.0000000000000) 01880813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01890813 + 0051 CONTINUE 01900813 +CT006* TEST 6 NEGATIVE REAL NUMBERS 01910813 + IVTNUM = 6 01920813 + AVC = CSQRT((-5.0, 0.0)) 01930813 + IF (R2E(1) + 0.50000E-04) 20060, 40062, 40061 01940813 +40061 IF (R2E(1) - 0.50000E-04) 40062, 40062, 20060 01950813 +40062 IF (R2E(2) - 0.22359E+01) 20060, 10060, 40060 01960813 +40060 IF (R2E(2) - 0.22362E+01) 10060, 10060, 20060 01970813 +10060 IVPASS = IVPASS + 1 01980813 + WRITE (NUVI, 80002) IVTNUM 01990813 + GO TO 0061 02000813 +20060 IVFAIL = IVFAIL + 1 02010813 + ZVCORR = (0.00000000000000, 2.2360679774998) 02020813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02030813 + 0061 CONTINUE 02040813 +CT007* TEST 7 NEGATIVE REAL NUMBERS 02050813 + IVTNUM = 7 02060813 + BVC = (-25.0, 0.0) 02070813 + AVC = CSQRT(BVC) 02080813 + IF (R2E(1) + 0.50000E-04) 20070, 40072, 40071 02090813 +40071 IF (R2E(1) - 0.50000E-04) 40072, 40072, 20070 02100813 +40072 IF (R2E(2) - 0.49997E+01) 20070, 10070, 40070 02110813 +40070 IF (R2E(2) - 0.50003E+01) 10070, 10070, 20070 02120813 +10070 IVPASS = IVPASS + 1 02130813 + WRITE (NUVI, 80002) IVTNUM 02140813 + GO TO 0071 02150813 +20070 IVFAIL = IVFAIL + 1 02160813 + ZVCORR = (0.00000000000000, 5.0000000000000) 02170813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02180813 + 0071 CONTINUE 02190813 +CT008* TEST 8 VARIABLES SUPPLIED WITHIN AN EXPRESSION 02200813 + IVTNUM = 8 02210813 + BVC = (0.203125,0.0) 02220813 + CVC = (0.0, 1.3125) 02230813 + AVC = CSQRT(BVC + CVC) 02240813 + IF (R2E(1) - 0.87495E+00) 20080, 40082, 40081 02250813 +40081 IF (R2E(1) - 0.87505E+00) 40082, 40082, 20080 02260813 +40082 IF (R2E(2) - 0.74996E+00) 20080, 10080, 40080 02270813 +40080 IF (R2E(2) - 0.75004E+00) 10080, 10080, 20080 02280813 +10080 IVPASS = IVPASS + 1 02290813 + WRITE (NUVI, 80002) IVTNUM 02300813 + GO TO 0081 02310813 +20080 IVFAIL = IVFAIL + 1 02320813 + ZVCORR = (0.87500000000000, 0.75000000000000) 02330813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02340813 + 0081 CONTINUE 02350813 +CT009* TEST 9 VARIABLES SUPPLIED WITHIN AN EXPRESSION 02360813 + IVTNUM = 9 02370813 + BVC = (1.0,0.0) 02380813 + AVC = CSQRT(BVC - (0.38671875, 0.515625)) 02390813 + IF (R2E(1) - 0.84094E+00) 20090, 40092, 40091 02400813 +40091 IF (R2E(1) - 0.84103E+00) 40092, 40092, 20090 02410813 +40092 IF (R2E(2) + 0.30658E+00) 20090, 10090, 40090 02420813 +40090 IF (R2E(2) + 0.30654E+00) 10090, 10090, 20090 02430813 +10090 IVPASS = IVPASS + 1 02440813 + WRITE (NUVI, 80002) IVTNUM 02450813 + GO TO 0091 02460813 +20090 IVFAIL = IVFAIL + 1 02470813 + ZVCORR = (0.84098742159541, -0.30655928183909) 02480813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02490813 + 0091 CONTINUE 02500813 +CT010* TEST 10 VARIABLES SUPPLIED WITHIN AN EXPRESSION 02510813 + IVTNUM = 10 02520813 + BVC = (-0.375, 0.5) 02530813 + AVC = CSQRT(BVC + BVC) 02540813 + IF (R2E(1) - 0.49997E+00) 20100, 40102, 40101 02550813 +40101 IF (R2E(1) - 0.50003E+00) 40102, 40102, 20100 02560813 +40102 IF (R2E(2) - 0.99995E+00) 20100, 10100, 40100 02570813 +40100 IF (R2E(2) - 0.10001E+01) 10100, 10100, 20100 02580813 +10100 IVPASS = IVPASS + 1 02590813 + WRITE (NUVI, 80002) IVTNUM 02600813 + GO TO 0101 02610813 +20100 IVFAIL = IVFAIL + 1 02620813 + ZVCORR = (0.50000000000000, 1.0000000000000) 02630813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02640813 + 0101 CONTINUE 02650813 +CT011* TEST 11 PURELY IMAGINARY NUMBERS 02660813 + IVTNUM = 11 02670813 + AVC = CSQRT((0.0, 2.0)) 02680813 + IF (R2E(1) - 0.99995E+00) 20110, 40112, 40111 02690813 +40111 IF (R2E(1) - 0.10001E+01) 40112, 40112, 20110 02700813 +40112 IF (R2E(2) - 0.99995E+00) 20110, 10110, 40110 02710813 +40110 IF (R2E(2) - 0.10001E+01) 10110, 10110, 20110 02720813 +10110 IVPASS = IVPASS + 1 02730813 + WRITE (NUVI, 80002) IVTNUM 02740813 + GO TO 0111 02750813 +20110 IVFAIL = IVFAIL + 1 02760813 + ZVCORR = (1.00000000000000, 1.0000000000000) 02770813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02780813 + 0111 CONTINUE 02790813 +CT012* TEST 12 PURELY IMAGINARY NUMBERS 02800813 + IVTNUM = 12 02810813 + AVC = CSQRT((0.0, -8.0)) 02820813 + IF (R2E(1) - 0.19999E+01) 20120, 40122, 40121 02830813 +40121 IF (R2E(1) - 0.20001E+01) 40122, 40122, 20120 02840813 +40122 IF (R2E(2) + 0.20001E+01) 20120, 10120, 40120 02850813 +40120 IF (R2E(2) + 0.19999E+01) 10120, 10120, 20120 02860813 +10120 IVPASS = IVPASS + 1 02870813 + WRITE (NUVI, 80002) IVTNUM 02880813 + GO TO 0121 02890813 +20120 IVFAIL = IVFAIL + 1 02900813 + ZVCORR = (2.00000000000000, -2.0000000000000) 02910813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02920813 + 0121 CONTINUE 02930813 +CT013* TEST 13 (-0.5,SQRT(3)/2) 02940813 + IVTNUM = 13 02950813 + BVC = (-0.5, -0.8660254038) 02960813 + CVC = CSQRT(CSQRT(BVC)) 02970813 + AVC = CVC - BVC * (0.0, 1.0) 02980813 + IF (R2E(1) + 0.50000E-04) 20130, 40132, 40131 02990813 +40131 IF (R2E(1) - 0.50000E-04) 40132, 40132, 20130 03000813 +40132 IF (R2E(2) + 0.50000E-04) 20130, 10130, 40130 03010813 +40130 IF (R2E(2) - 0.50000E-04) 10130, 10130, 20130 03020813 +10130 IVPASS = IVPASS + 1 03030813 + WRITE (NUVI, 80002) IVTNUM 03040813 + GO TO 0131 03050813 +20130 IVFAIL = IVFAIL + 1 03060813 + ZVCORR = (0.00000000000000, 0.00000000000000) 03070813 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 03080813 + 0131 CONTINUE 03090813 +C***** 03100813 +CBB** ********************** BBCSUM0 **********************************03110813 +C**** WRITE OUT TEST SUMMARY 03120813 +C**** 03130813 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03140813 + WRITE (I02, 90004) 03150813 + WRITE (I02, 90014) 03160813 + WRITE (I02, 90004) 03170813 + WRITE (I02, 90020) IVPASS 03180813 + WRITE (I02, 90022) IVFAIL 03190813 + WRITE (I02, 90024) IVDELE 03200813 + WRITE (I02, 90026) IVINSP 03210813 + WRITE (I02, 90028) IVTOTN, IVTOTL 03220813 +CBE** ********************** BBCSUM0 **********************************03230813 +CBB** ********************** BBCFOOT0 **********************************03240813 +C**** WRITE OUT REPORT FOOTINGS 03250813 +C**** 03260813 + WRITE (I02,90016) ZPROG, ZPROG 03270813 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03280813 + WRITE (I02,90019) 03290813 +CBE** ********************** BBCFOOT0 **********************************03300813 +CBB** ********************** BBCFMT0A **********************************03310813 +C**** FORMATS FOR TEST DETAIL LINES 03320813 +C**** 03330813 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03340813 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03350813 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03360813 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03370813 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03380813 + 1I6,/," ",15X,"CORRECT= " ,I6) 03390813 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03400813 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03410813 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03420813 + 1A21,/," ",16X,"CORRECT= " ,A21) 03430813 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03440813 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03450813 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03460813 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03470813 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03480813 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03490813 +80050 FORMAT (" ",48X,A31) 03500813 +CBE** ********************** BBCFMT0A **********************************03510813 +CBB** ********************** BBCFMAT1 **********************************03520813 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03530813 +C**** 03540813 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03550813 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03560813 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03570813 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03580813 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03590813 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03600813 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03610813 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03620813 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03630813 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03640813 + 2"(",F12.5,", ",F12.5,")") 03650813 +CBE** ********************** BBCFMAT1 **********************************03660813 +CBB** ********************** BBCFMT0B **********************************03670813 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03680813 +C**** 03690813 +90002 FORMAT ("1") 03700813 +90004 FORMAT (" ") 03710813 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03720813 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03730813 +90008 FORMAT (" ",21X,A13,A17) 03740813 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03750813 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03760813 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03770813 + 1 7X,"REMARKS",24X) 03780813 +90014 FORMAT (" ","----------------------------------------------" , 03790813 + 1 "---------------------------------" ) 03800813 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03810813 +C**** 03820813 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03830813 +C**** 03840813 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03850813 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03860813 + 1 A13) 03870813 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03880813 +C**** 03890813 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03900813 +C**** 03910813 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03920813 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03930813 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03940813 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03950813 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03960813 +CBE** ********************** BBCFMT0B **********************************03970813 +C***** 03980813 +C***** END OF TEST SEGMENT 177 03990813 + STOP 04000813 + END 04010813 + 04020813 diff --git a/Fortran/UnitTests/fcvs21_f95/FM813.reference_output b/Fortran/UnitTests/fcvs21_f95/FM813.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM813.reference_output @@ -0,0 +1,47 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM813BEGIN* TEST RESULTS - FM813 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YCSQRT - (177) INTRINSIC FUNCTIONS + + CSQRT (COMPLEX SQUARE ROOT) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 13 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + + ------------------------------------------------------------------------------- + + 13 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 13 OF 13 TESTS EXECUTED + + *FM813END* END OF TEST - FM813 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM814.f b/Fortran/UnitTests/fcvs21_f95/FM814.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM814.f @@ -0,0 +1,446 @@ + PROGRAM FM814 + +C***********************************************************************00010814 +C***** FORTRAN 77 00020814 +C***** FM814 00030814 +C***** YDEXP - (179) 00040814 +C***** 00050814 +C***********************************************************************00060814 +C***** GENERAL PURPOSE ANS REF 00070814 +C***** TEST INTRINSIC FUNCTION DEXP 15.3 00080814 +C***** TABLE 5 00090814 +C***** 00100814 +CBB** ********************** BBCCOMNT **********************************00110814 +C**** 00120814 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130814 +C**** VERSION 2.1 00140814 +C**** 00150814 +C**** 00160814 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170814 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180814 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190814 +C**** BUILDING 225 RM A266 00200814 +C**** GAITHERSBURG, MD 20899 00210814 +C**** 00220814 +C**** 00230814 +C**** 00240814 +CBE** ********************** BBCCOMNT **********************************00250814 +C***** 00260814 +C***** S P E C I F I C A T I O N S SEGMENT 179 00270814 + DOUBLE PRECISION AVD, BVD, DVCORR 00280814 +C***** 00290814 +CBB** ********************** BBCINITA **********************************00300814 +C**** SPECIFICATION STATEMENTS 00310814 +C**** 00320814 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330814 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340814 +CBE** ********************** BBCINITA **********************************00350814 +CBB** ********************** BBCINITB **********************************00360814 +C**** INITIALIZE SECTION 00370814 + DATA ZVERS, ZVERSD, ZDATE 00380814 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390814 + DATA ZCOMPL, ZNAME, ZTAPE 00400814 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410814 + DATA ZPROJ, ZTAPED, ZPROG 00420814 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430814 + DATA REMRKS /' '/ 00440814 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450814 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460814 +C**** 00470814 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480814 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490814 +CZ03 ZPROG = 'PROGRAM NAME' 00500814 +CZ04 ZDATE = 'DATE OF TEST' 00510814 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520814 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530814 +CZ07 ZNAME = 'NAME OF USER' 00540814 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00550814 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00560814 +C 00570814 + IVPASS = 0 00580814 + IVFAIL = 0 00590814 + IVDELE = 0 00600814 + IVINSP = 0 00610814 + IVTOTL = 0 00620814 + IVTOTN = 0 00630814 + ICZERO = 0 00640814 +C 00650814 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660814 + I01 = 05 00670814 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680814 + I02 = 06 00690814 +C 00700814 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710814 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720814 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730814 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740814 +C 00750814 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760814 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770814 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780814 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790814 +C 00800814 +CBE** ********************** BBCINITB **********************************00810814 + NUVI = I02 00820814 + IVTOTL = 19 00830814 + ZPROG = 'FM814' 00840814 +CBB** ********************** BBCHED0A **********************************00850814 +C**** 00860814 +C**** WRITE REPORT TITLE 00870814 +C**** 00880814 + WRITE (I02, 90002) 00890814 + WRITE (I02, 90006) 00900814 + WRITE (I02, 90007) 00910814 + WRITE (I02, 90008) ZVERS, ZVERSD 00920814 + WRITE (I02, 90009) ZPROG, ZPROG 00930814 + WRITE (I02, 90010) ZDATE, ZCOMPL 00940814 +CBE** ********************** BBCHED0A **********************************00950814 +C***** 00960814 +C***** HEADER FOR SEGMENT 179 00970814 + WRITE(NUVI,17900) 00980814 +17900 FORMAT(" ", / " YDEXP - (179) INTRINSIC FUNCTIONS" // 00990814 + 1 " DEXP (DOUBLE PRECISION EXPONENTIAL)" // 01000814 + 2 " ANS REF. - 15.3" ) 01010814 +CBB** ********************** BBCHED0B **********************************01020814 +C**** WRITE DETAIL REPORT HEADERS 01030814 +C**** 01040814 + WRITE (I02,90004) 01050814 + WRITE (I02,90004) 01060814 + WRITE (I02,90013) 01070814 + WRITE (I02,90014) 01080814 + WRITE (I02,90015) IVTOTL 01090814 +CBE** ********************** BBCHED0B **********************************01100814 +C***** 01110814 +CT001* TEST 1 ZERO, SINCE EXP(0) = 1 01120814 + IVTNUM = 1 01130814 + BVD = 0.0D0 01140814 + AVD = DEXP(BVD) 01150814 + IF (AVD - 0.9999999995D+00) 20010, 10010, 40010 01160814 +40010 IF (AVD - 0.1000000001D+01) 10010, 10010, 20010 01170814 +10010 IVPASS = IVPASS + 1 01180814 + WRITE (NUVI, 80002) IVTNUM 01190814 + GO TO 0011 01200814 +20010 IVFAIL = IVFAIL + 1 01210814 + DVCORR = 0.10000000000000000000D+01 01220814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01230814 + 0011 CONTINUE 01240814 +CT002* TEST 2 ONE, SINCE EXP(1) = E 01250814 + IVTNUM = 2 01260814 + AVD = DEXP(1.0D0) 01270814 + IF (AVD - 0.2718281827D+01) 20020, 10020, 40020 01280814 +40020 IF (AVD - 0.2718281830D+01) 10020, 10020, 20020 01290814 +10020 IVPASS = IVPASS + 1 01300814 + WRITE (NUVI, 80002) IVTNUM 01310814 + GO TO 0021 01320814 +20020 IVFAIL = IVFAIL + 1 01330814 + DVCORR = 0.27182818284590452354D+01 01340814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01350814 + 0021 CONTINUE 01360814 +CT003* TEST 3 01370814 + IVTNUM = 3 01380814 + AVD = DEXP(2.0D0) 01390814 + IF (AVD - 0.7389056095D+01) 20030, 10030, 40030 01400814 +40030 IF (AVD - 0.7389056103D+01) 10030, 10030, 20030 01410814 +10030 IVPASS = IVPASS + 1 01420814 + WRITE (NUVI, 80002) IVTNUM 01430814 + GO TO 0031 01440814 +20030 IVFAIL = IVFAIL + 1 01450814 + DVCORR = 0.73890560989306502272D+01 01460814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01470814 + 0031 CONTINUE 01480814 +CT004* TEST 4 01490814 + IVTNUM = 4 01500814 + AVD = DEXP(5.125D0) 01510814 + IF (AVD - 0.1681741415D+03) 20040, 10040, 40040 01520814 +40040 IF (AVD - 0.1681741418D+03) 10040, 10040, 20040 01530814 +10040 IVPASS = IVPASS + 1 01540814 + WRITE (NUVI, 80002) IVTNUM 01550814 + GO TO 0041 01560814 +20040 IVFAIL = IVFAIL + 1 01570814 + DVCORR = 0.16817414165184545127D+03 01580814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01590814 + 0041 CONTINUE 01600814 +CT005* TEST 5 01610814 + IVTNUM = 5 01620814 + AVD = DEXP(15.0D0) 01630814 + IF (AVD - 0.3269017370D+07) 20050, 10050, 40050 01640814 +40050 IF (AVD - 0.3269017374D+07) 10050, 10050, 20050 01650814 +10050 IVPASS = IVPASS + 1 01660814 + WRITE (NUVI, 80002) IVTNUM 01670814 + GO TO 0051 01680814 +20050 IVFAIL = IVFAIL + 1 01690814 + DVCORR = 0.32690173724721106393D+07 01700814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01710814 + 0051 CONTINUE 01720814 +CT006* TEST 6 01730814 + IVTNUM = 6 01740814 + BVD = 20.5D0 01750814 + AVD = DEXP(BVD) 01760814 + IF (AVD - 0.7999021770D+09) 20060, 10060, 40060 01770814 +40060 IF (AVD - 0.7999021779D+09) 10060, 10060, 20060 01780814 +10060 IVPASS = IVPASS + 1 01790814 + WRITE (NUVI, 80002) IVTNUM 01800814 + GO TO 0061 01810814 +20060 IVFAIL = IVFAIL + 1 01820814 + DVCORR = 0.79990217747550540670D+09 01830814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01840814 + 0061 CONTINUE 01850814 +CT007* TEST 7 01860814 + IVTNUM = 7 01870814 + BVD = 4.5D0 01880814 + AVD = DEXP(BVD - 7.5D0) 01890814 + IF (AVD - 0.4978706834D-01) 20070, 10070, 40070 01900814 +40070 IF (AVD - 0.4978706840D-01) 10070, 10070, 20070 01910814 +10070 IVPASS = IVPASS + 1 01920814 + WRITE (NUVI, 80002) IVTNUM 01930814 + GO TO 0071 01940814 +20070 IVFAIL = IVFAIL + 1 01950814 + DVCORR = 0.49787068367863942979D-01 01960814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01970814 + 0071 CONTINUE 01980814 +CT008* TEST 8 01990814 + IVTNUM = 8 02000814 + BVD = 0.25D0 02010814 + AVD = DEXP(BVD - 5.0D0) 02020814 + IF (AVD - 0.8651695198D-02) 20080, 10080, 40080 02030814 +40080 IF (AVD - 0.8651695208D-02) 10080, 10080, 20080 02040814 +10080 IVPASS = IVPASS + 1 02050814 + WRITE (NUVI, 80002) IVTNUM 02060814 + GO TO 0081 02070814 +20080 IVFAIL = IVFAIL + 1 02080814 + DVCORR = 0.86516952031206341771D-02 02090814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02100814 + 0081 CONTINUE 02110814 +CT009* TEST 9 02120814 + IVTNUM = 9 02130814 + AVD = DEXP(0.5D0 * (-20.0D0)) 02140814 + IF (AVD - 0.4539992974D-04) 20090, 10090, 40090 02150814 +40090 IF (AVD - 0.4539992979D-04) 10090, 10090, 20090 02160814 +10090 IVPASS = IVPASS + 1 02170814 + WRITE (NUVI, 80002) IVTNUM 02180814 + GO TO 0091 02190814 +20090 IVFAIL = IVFAIL + 1 02200814 + DVCORR = 0.45399929762484851536D-04 02210814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02220814 + 0091 CONTINUE 02230814 +CT010* TEST 10 02240814 + IVTNUM = 10 02250814 + BVD = 30.5D0 02260814 + AVD = DEXP(BVD / (-2.0D0)) 02270814 + IF (AVD - 0.2382369666D-06) 20100, 10100, 40100 02280814 +40100 IF (AVD - 0.2382369669D-06) 10100, 10100, 20100 02290814 +10100 IVPASS = IVPASS + 1 02300814 + WRITE (NUVI, 80002) IVTNUM 02310814 + GO TO 0101 02320814 +20100 IVFAIL = IVFAIL + 1 02330814 + DVCORR = 0.23823696675018179180D-06 02340814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02350814 + 0101 CONTINUE 02360814 +CT011* TEST 11 VALUES CLOSE TO 1.0 02370814 + IVTNUM = 11 02380814 + AVD = DEXP(0.9921875D0) 02390814 + IF (AVD - 0.2697127990D+01) 20110, 10110, 40110 02400814 +40110 IF (AVD - 0.2697127993D+01) 10110, 10110, 20110 02410814 +10110 IVPASS = IVPASS + 1 02420814 + WRITE (NUVI, 80002) IVTNUM 02430814 + GO TO 0111 02440814 +20110 IVFAIL = IVFAIL + 1 02450814 + DVCORR = 0.26971279914439187908D+01 02460814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02470814 + 0111 CONTINUE 02480814 +CT012* TEST 12 02490814 + IVTNUM = 12 02500814 + BVD = 0.9990234375D0 02510814 + AVD = DEXP(BVD) 02520814 + IF (AVD - 0.2715628550D+01) 20120, 10120, 40120 02530814 +40120 IF (AVD - 0.2715628554D+01) 10120, 10120, 20120 02540814 +10120 IVPASS = IVPASS + 1 02550814 + WRITE (NUVI, 80002) IVTNUM 02560814 + GO TO 0121 02570814 +20120 IVFAIL = IVFAIL + 1 02580814 + DVCORR = 0.27156285521168930956D+01 02590814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02600814 + 0121 CONTINUE 02610814 +CT013* TEST 13 02620814 + IVTNUM = 13 02630814 + AVD = DEXP(1.00390625D0) 02640814 + IF (AVD - 0.2728920881D+01) 20130, 10130, 40130 02650814 +40130 IF (AVD - 0.2728920884D+01) 10130, 10130, 20130 02660814 +10130 IVPASS = IVPASS + 1 02670814 + WRITE (NUVI, 80002) IVTNUM 02680814 + GO TO 0131 02690814 +20130 IVFAIL = IVFAIL + 1 02700814 + DVCORR = 0.27289208827260750401D+01 02710814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02720814 + 0131 CONTINUE 02730814 +CT014* TEST 14 02740814 + IVTNUM = 14 02750814 + BVD = 1.001953125D0 02760814 + AVD = DEXP(BVD) 02770814 + IF (AVD - 0.2723596159D+01) 20140, 10140, 40140 02780814 +40140 IF (AVD - 0.2723596162D+01) 10140, 10140, 20140 02790814 +10140 IVPASS = IVPASS + 1 02800814 + WRITE (NUVI, 80002) IVTNUM 02810814 + GO TO 0141 02820814 +20140 IVFAIL = IVFAIL + 1 02830814 + DVCORR = 0.27235961607434952125D+01 02840814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02850814 + 0141 CONTINUE 02860814 +CT015* TEST 15 VALUES CLOSE TO 1/E 02870814 + IVTNUM = 15 02880814 + BVD = 128.0D0 02890814 + AVD = DEXP(44.0D0 / BVD) 02900814 + IF (AVD - 0.1410226034D+01) 20150, 10150, 40150 02910814 +40150 IF (AVD - 0.1410226036D+01) 10150, 10150, 20150 02920814 +10150 IVPASS = IVPASS + 1 02930814 + WRITE (NUVI, 80002) IVTNUM 02940814 + GO TO 0151 02950814 +20150 IVFAIL = IVFAIL + 1 02960814 + DVCORR = 0.14102260349257107057D+01 02970814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02980814 + 0151 CONTINUE 02990814 +CT016* TEST 16 03000814 + IVTNUM = 16 03010814 + BVD = 128.0D0 03020814 + AVD = DEXP(45.0D0 / BVD) 03030814 + IF (AVD - 0.1421286574D+01) 20160, 10160, 40160 03040814 +40160 IF (AVD - 0.1421286576D+01) 10160, 10160, 20160 03050814 +10160 IVPASS = IVPASS + 1 03060814 + WRITE (NUVI, 80002) IVTNUM 03070814 + GO TO 0161 03080814 +20160 IVFAIL = IVFAIL + 1 03090814 + DVCORR = 0.14212865748006967556D+01 03100814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03110814 + 0161 CONTINUE 03120814 +CT017* TEST 17 03130814 + IVTNUM = 17 03140814 + BVD = 128.0D0 03150814 + AVD = DEXP(46.0D0 / BVD) 03160814 + IF (AVD - 0.1432433862D+01) 20170, 10170, 40170 03170814 +40170 IF (AVD - 0.1432433865D+01) 10170, 10170, 20170 03180814 +10170 IVPASS = IVPASS + 1 03190814 + WRITE (NUVI, 80002) IVTNUM 03200814 + GO TO 0171 03210814 +20170 IVFAIL = IVFAIL + 1 03220814 + DVCORR = 0.14324338635650781150D+01 03230814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03240814 + 0171 CONTINUE 03250814 +CT018* TEST 18 03260814 + IVTNUM = 18 03270814 + BVD = 128.0D0 03280814 + AVD = DEXP(47.0D0 / BVD) 03290814 + IF (AVD - 0.1443668580D+01) 20180, 10180, 40180 03300814 +40180 IF (AVD - 0.1443668583D+01) 10180, 10180, 20180 03310814 +10180 IVPASS = IVPASS + 1 03320814 + WRITE (NUVI, 80002) IVTNUM 03330814 + GO TO 0181 03340814 +20180 IVFAIL = IVFAIL + 1 03350814 + DVCORR = 0.14436685815988268628D+01 03360814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03370814 + 0181 CONTINUE 03380814 +CT019* TEST 19 03390814 + IVTNUM = 19 03400814 + BVD = 128.0D0 03410814 + AVD = DEXP(48.0D0 / BVD) 03420814 + IF (AVD - 0.1454991413D+01) 20190, 10190, 40190 03430814 +40190 IF (AVD - 0.1454991416D+01) 10190, 10190, 20190 03440814 +10190 IVPASS = IVPASS + 1 03450814 + WRITE (NUVI, 80002) IVTNUM 03460814 + GO TO 0191 03470814 +20190 IVFAIL = IVFAIL + 1 03480814 + DVCORR = 0.14549914146182013361D+01 03490814 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03500814 + 0191 CONTINUE 03510814 +C***** 03520814 +CBB** ********************** BBCSUM0 **********************************03530814 +C**** WRITE OUT TEST SUMMARY 03540814 +C**** 03550814 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03560814 + WRITE (I02, 90004) 03570814 + WRITE (I02, 90014) 03580814 + WRITE (I02, 90004) 03590814 + WRITE (I02, 90020) IVPASS 03600814 + WRITE (I02, 90022) IVFAIL 03610814 + WRITE (I02, 90024) IVDELE 03620814 + WRITE (I02, 90026) IVINSP 03630814 + WRITE (I02, 90028) IVTOTN, IVTOTL 03640814 +CBE** ********************** BBCSUM0 **********************************03650814 +CBB** ********************** BBCFOOT0 **********************************03660814 +C**** WRITE OUT REPORT FOOTINGS 03670814 +C**** 03680814 + WRITE (I02,90016) ZPROG, ZPROG 03690814 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03700814 + WRITE (I02,90019) 03710814 +CBE** ********************** BBCFOOT0 **********************************03720814 +CBB** ********************** BBCFMT0A **********************************03730814 +C**** FORMATS FOR TEST DETAIL LINES 03740814 +C**** 03750814 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03760814 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03770814 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03780814 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03790814 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03800814 + 1I6,/," ",15X,"CORRECT= " ,I6) 03810814 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03820814 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03830814 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03840814 + 1A21,/," ",16X,"CORRECT= " ,A21) 03850814 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03860814 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03870814 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03880814 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03890814 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03900814 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03910814 +80050 FORMAT (" ",48X,A31) 03920814 +CBE** ********************** BBCFMT0A **********************************03930814 +CBB** ********************** BBCFMAT1 **********************************03940814 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03950814 +C**** 03960814 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03970814 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03980814 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03990814 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04000814 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04010814 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04020814 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04030814 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04040814 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04050814 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04060814 + 2"(",F12.5,", ",F12.5,")") 04070814 +CBE** ********************** BBCFMAT1 **********************************04080814 +CBB** ********************** BBCFMT0B **********************************04090814 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04100814 +C**** 04110814 +90002 FORMAT ("1") 04120814 +90004 FORMAT (" ") 04130814 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04140814 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04150814 +90008 FORMAT (" ",21X,A13,A17) 04160814 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04170814 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04180814 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04190814 + 1 7X,"REMARKS",24X) 04200814 +90014 FORMAT (" ","----------------------------------------------" , 04210814 + 1 "---------------------------------" ) 04220814 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04230814 +C**** 04240814 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04250814 +C**** 04260814 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04270814 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04280814 + 1 A13) 04290814 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04300814 +C**** 04310814 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04320814 +C**** 04330814 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04340814 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04350814 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04360814 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04370814 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04380814 +CBE** ********************** BBCFMT0B **********************************04390814 +C***** 04400814 +C***** END OF TEST SEGMENT 179 04410814 + STOP 04420814 + END 04430814 + 04440814 diff --git a/Fortran/UnitTests/fcvs21_f95/FM814.reference_output b/Fortran/UnitTests/fcvs21_f95/FM814.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM814.reference_output @@ -0,0 +1,53 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM814BEGIN* TEST RESULTS - FM814 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDEXP - (179) INTRINSIC FUNCTIONS + + DEXP (DOUBLE PRECISION EXPONENTIAL) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 19 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + + ------------------------------------------------------------------------------- + + 19 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 19 OF 19 TESTS EXECUTED + + *FM814END* END OF TEST - FM814 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM815.f b/Fortran/UnitTests/fcvs21_f95/FM815.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM815.f @@ -0,0 +1,341 @@ + PROGRAM FM815 + +C***********************************************************************00010815 +C***** FORTRAN 77 00020815 +C***** FM815 00030815 +C***** YCEXP - (180) 00040815 +C***** 00050815 +C***********************************************************************00060815 +C***** GENERAL PURPOSE ANS REF 00070815 +C***** TEST INTRINSIC FUNCTION CEXP 15.3 00080815 +C***** INTRINSIC FUNCTIONS AIMAG AND CABS ASSUMED WORKING TABLE 5 00090815 +C***** 00100815 +CBB** ********************** BBCCOMNT **********************************00110815 +C**** 00120815 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130815 +C**** VERSION 2.1 00140815 +C**** 00150815 +C**** 00160815 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170815 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180815 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190815 +C**** BUILDING 225 RM A266 00200815 +C**** GAITHERSBURG, MD 20899 00210815 +C**** 00220815 +C**** 00230815 +C**** 00240815 +CBE** ********************** BBCCOMNT **********************************00250815 +C***** 00260815 +C***** S P E C I F I C A T I O N S SEGMENT 180 00270815 + COMPLEX AVC, BVC, CVC, ZVCORR 00280815 + REAL R2E(2) 00290815 + EQUIVALENCE (AVC, R2E) 00300815 +C***** 00310815 +CBB** ********************** BBCINITA **********************************00320815 +C**** SPECIFICATION STATEMENTS 00330815 +C**** 00340815 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350815 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360815 +CBE** ********************** BBCINITA **********************************00370815 +CBB** ********************** BBCINITB **********************************00380815 +C**** INITIALIZE SECTION 00390815 + DATA ZVERS, ZVERSD, ZDATE 00400815 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410815 + DATA ZCOMPL, ZNAME, ZTAPE 00420815 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430815 + DATA ZPROJ, ZTAPED, ZPROG 00440815 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450815 + DATA REMRKS /' '/ 00460815 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470815 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480815 +C**** 00490815 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500815 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510815 +CZ03 ZPROG = 'PROGRAM NAME' 00520815 +CZ04 ZDATE = 'DATE OF TEST' 00530815 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540815 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550815 +CZ07 ZNAME = 'NAME OF USER' 00560815 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570815 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580815 +C 00590815 + IVPASS = 0 00600815 + IVFAIL = 0 00610815 + IVDELE = 0 00620815 + IVINSP = 0 00630815 + IVTOTL = 0 00640815 + IVTOTN = 0 00650815 + ICZERO = 0 00660815 +C 00670815 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680815 + I01 = 05 00690815 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700815 + I02 = 06 00710815 +C 00720815 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730815 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740815 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750815 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760815 +C 00770815 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780815 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790815 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800815 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810815 +C 00820815 +CBE** ********************** BBCINITB **********************************00830815 + NUVI = I02 00840815 + IVTOTL = 9 00850815 + ZPROG = 'FM815' 00860815 +CBB** ********************** BBCHED0A **********************************00870815 +C**** 00880815 +C**** WRITE REPORT TITLE 00890815 +C**** 00900815 + WRITE (I02, 90002) 00910815 + WRITE (I02, 90006) 00920815 + WRITE (I02, 90007) 00930815 + WRITE (I02, 90008) ZVERS, ZVERSD 00940815 + WRITE (I02, 90009) ZPROG, ZPROG 00950815 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960815 +CBE** ********************** BBCHED0A **********************************00970815 +C***** 00980815 +C***** HEADER FOR SEGMENT 180 00990815 + WRITE(NUVI,18000) 01000815 +18000 FORMAT(" ", / " YCEXP - (180) INTRINSIC FUNCTIONS" // 01010815 + 1 " CEXP (COMPLEX EXPONENTIAL)" // 01020815 + 2 " ANS REF. - 15.3" ) 01030815 +CBB** ********************** BBCHED0B **********************************01040815 +C**** WRITE DETAIL REPORT HEADERS 01050815 +C**** 01060815 + WRITE (I02,90004) 01070815 + WRITE (I02,90004) 01080815 + WRITE (I02,90013) 01090815 + WRITE (I02,90014) 01100815 + WRITE (I02,90015) IVTOTL 01110815 +CBE** ********************** BBCHED0B **********************************01120815 +C***** 01130815 +CT001* TEST 1 ZERO 01140815 + IVTNUM = 1 01150815 + BVC = (0.0, 0.0) 01160815 + AVC = CEXP(BVC) 01170815 + IF (R2E(1) - 0.99995E+00) 20010, 40012, 40011 01180815 +40011 IF (R2E(1) - 0.10001E+01) 40012, 40012, 20010 01190815 +40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010 01200815 +40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010 01210815 +10010 IVPASS = IVPASS + 1 01220815 + WRITE (NUVI, 80002) IVTNUM 01230815 + GO TO 0011 01240815 +20010 IVFAIL = IVFAIL + 1 01250815 + ZVCORR = (1.0000000000000, 0.00000000000000) 01260815 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01270815 + 0011 CONTINUE 01280815 +CT002* TEST 2 PURELY REAL NUMBERS -- RESULT AGREES WITH EXP 01290815 + IVTNUM = 2 01300815 + AVC = CEXP((1.0, 0.0)) 01310815 + IF (R2E(1) - 0.27181E+01) 20020, 40022, 40021 01320815 +40021 IF (R2E(1) - 0.27185E+01) 40022, 40022, 20020 01330815 +40022 IF (R2E(2) + 0.50000E-04) 20020, 10020, 40020 01340815 +40020 IF (R2E(2) - 0.50000E-04) 10020, 10020, 20020 01350815 +10020 IVPASS = IVPASS + 1 01360815 + WRITE (NUVI, 80002) IVTNUM 01370815 + GO TO 0021 01380815 +20020 IVFAIL = IVFAIL + 1 01390815 + ZVCORR = (2.7182818284590, 0.00000000000000) 01400815 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01410815 + 0021 CONTINUE 01420815 +CT003* TEST 3 PURELY REAL NUMBERS -- RESULT AGREES WITH EXP 01430815 + IVTNUM = 3 01440815 + BVC = (-3.0, 0.0) 01450815 + AVC = CEXP(BVC) 01460815 + IF (R2E(1) - 0.49784E-01) 20030, 40032, 40031 01470815 +40031 IF (R2E(1) - 0.49790E-01) 40032, 40032, 20030 01480815 +40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030 01490815 +40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030 01500815 +10030 IVPASS = IVPASS + 1 01510815 + WRITE (NUVI, 80002) IVTNUM 01520815 + GO TO 0031 01530815 +20030 IVFAIL = IVFAIL + 1 01540815 + ZVCORR = (0.04978706836785, 0.00000000000000) 01550815 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01560815 + 0031 CONTINUE 01570815 +C***** TESTS 4 AND 5 - PURELY IMAGINARY NUMBERS--RESULT LIES 01580815 +C***** ON UNIT CIRCLE 01590815 +CT004* TEST 4 (0,PI) 01600815 + IVTNUM = 4 01610815 + BVC = (0.0, 3.1415926536) 01620815 + AVC = CEXP(BVC * (1.0, 0.0)) 01630815 + IF (R2E(1) + 0.10001E+01) 20040, 40042, 40041 01640815 +40041 IF (R2E(1) + 0.99995E+00) 40042, 40042, 20040 01650815 +40042 IF (R2E(2) + 0.50000E-04) 20040, 10040, 40040 01660815 +40040 IF (R2E(2) - 0.50000E-04) 10040, 10040, 20040 01670815 +10040 IVPASS = IVPASS + 1 01680815 + WRITE (NUVI, 80002) IVTNUM 01690815 + GO TO 0041 01700815 +20040 IVFAIL = IVFAIL + 1 01710815 + ZVCORR = (-1.0000000000000, 0.00000000000000) 01720815 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01730815 + 0041 CONTINUE 01740815 +CT005* TEST 5 (0,-PI/2) 01750815 + IVTNUM = 5 01760815 + BVC = (0.0, -3.1415926536) 01770815 + AVC = CEXP(BVC / (2.0, 0.0)) 01780815 + IF (R2E(1) + 0.50000E-04) 20050, 40052, 40051 01790815 +40051 IF (R2E(1) - 0.50000E-04) 40052, 40052, 20050 01800815 +40052 IF (R2E(2) + 0.10001E+01) 20050, 10050, 40050 01810815 +40050 IF (R2E(2) + 0.99995E+00) 10050, 10050, 20050 01820815 +10050 IVPASS = IVPASS + 1 01830815 + WRITE (NUVI, 80002) IVTNUM 01840815 + GO TO 0051 01850815 +20050 IVFAIL = IVFAIL + 1 01860815 + ZVCORR = (0.00000000000000, -1.0000000000000) 01870815 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01880815 + 0051 CONTINUE 01890815 +CT006* TEST 6 (2.5,PI/4) 01900815 + IVTNUM = 6 01910815 + AVC = CEXP((1.0, 2.0)) 01920815 + IF (R2E(1) + 0.11313E+01) 20060, 40062, 40061 01930815 +40061 IF (R2E(1) + 0.11311E+01) 40062, 40062, 20060 01940815 +40062 IF (R2E(2) - 0.24716E+01) 20060, 10060, 40060 01950815 +40060 IF (R2E(2) - 0.24719E+01) 10060, 10060, 20060 01960815 +10060 IVPASS = IVPASS + 1 01970815 + WRITE (NUVI, 80002) IVTNUM 01980815 + GO TO 0061 01990815 +20060 IVFAIL = IVFAIL + 1 02000815 + ZVCORR = (-1.1312043837568, 2.4717266720048) 02010815 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02020815 + 0061 CONTINUE 02030815 +CT007* TEST 7 A VARIABLE SUPPLIED TO CEXP 02040815 + IVTNUM = 7 02050815 + BVC = (-1.75, 4.625) 02060815 + AVC = CEXP(BVC) 02070815 + IF (R2E(1) + 0.15168E-01) 20070, 40072, 40071 02080815 +40071 IF (R2E(1) + 0.15165E-01) 40072, 40072, 20070 02090815 +40072 IF (R2E(2) + 0.17312E+00) 20070, 10070, 40070 02100815 +40070 IF (R2E(2) + 0.17310E+00) 10070, 10070, 20070 02110815 +10070 IVPASS = IVPASS + 1 02120815 + WRITE (NUVI, 80002) IVTNUM 02130815 + GO TO 0071 02140815 +20070 IVFAIL = IVFAIL + 1 02150815 + ZVCORR = (-0.01516660638013, -0.17311082425206) 02160815 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02170815 + 0071 CONTINUE 02180815 +CT008* TEST 8 POSITIVE REAL, NEGATIVE IMAGINARY ARGUMENT 02190815 + IVTNUM = 8 02200815 + AVC = CEXP((5.5, -1.015625)) 02210815 + IF (R2E(1) - 0.12896E+03) 20080, 40082, 40081 02220815 +40081 IF (R2E(1) - 0.12898E+03) 40082, 40082, 20080 02230815 +40082 IF (R2E(2) + 0.20796E+03) 20080, 10080, 40080 02240815 +40080 IF (R2E(2) + 0.20793E+03) 10080, 10080, 20080 02250815 +10080 IVPASS = IVPASS + 1 02260815 + WRITE (NUVI, 80002) IVTNUM 02270815 + GO TO 0081 02280815 +20080 IVFAIL = IVFAIL + 1 02290815 + ZVCORR = (128.97440219594, -207.94168724284) 02300815 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02310815 + 0081 CONTINUE 02320815 +CT009* TEST 9 THE FUNCTION TOGETHER WITH AIMAG AND CABS 02330815 + IVTNUM = 9 02340815 + BVC = (10.0, 3.1415926536) 02350815 + CVC = CEXP(BVC / (4.0, 0.0)) 02360815 + AVS = (AIMAG(CVC) / CABS(CVC)) ** 2 02370815 + IF (AVS - 0.49997E+00) 20090, 10090, 40090 02380815 +40090 IF (AVS - 0.50003E+00) 10090, 10090, 20090 02390815 +10090 IVPASS = IVPASS + 1 02400815 + WRITE (NUVI, 80002) IVTNUM 02410815 + GO TO 0091 02420815 +20090 IVFAIL = IVFAIL + 1 02430815 + RVCORR = 0.5000000 02440815 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02450815 + 0091 CONTINUE 02460815 +C***** 02470815 +CBB** ********************** BBCSUM0 **********************************02480815 +C**** WRITE OUT TEST SUMMARY 02490815 +C**** 02500815 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02510815 + WRITE (I02, 90004) 02520815 + WRITE (I02, 90014) 02530815 + WRITE (I02, 90004) 02540815 + WRITE (I02, 90020) IVPASS 02550815 + WRITE (I02, 90022) IVFAIL 02560815 + WRITE (I02, 90024) IVDELE 02570815 + WRITE (I02, 90026) IVINSP 02580815 + WRITE (I02, 90028) IVTOTN, IVTOTL 02590815 +CBE** ********************** BBCSUM0 **********************************02600815 +CBB** ********************** BBCFOOT0 **********************************02610815 +C**** WRITE OUT REPORT FOOTINGS 02620815 +C**** 02630815 + WRITE (I02,90016) ZPROG, ZPROG 02640815 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02650815 + WRITE (I02,90019) 02660815 +CBE** ********************** BBCFOOT0 **********************************02670815 +CBB** ********************** BBCFMT0A **********************************02680815 +C**** FORMATS FOR TEST DETAIL LINES 02690815 +C**** 02700815 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02710815 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02720815 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02730815 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02740815 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02750815 + 1I6,/," ",15X,"CORRECT= " ,I6) 02760815 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02770815 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02780815 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02790815 + 1A21,/," ",16X,"CORRECT= " ,A21) 02800815 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02810815 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02820815 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02830815 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02840815 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02850815 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02860815 +80050 FORMAT (" ",48X,A31) 02870815 +CBE** ********************** BBCFMT0A **********************************02880815 +CBB** ********************** BBCFMAT1 **********************************02890815 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02900815 +C**** 02910815 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02920815 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02930815 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02940815 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02950815 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02960815 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02970815 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02980815 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02990815 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03000815 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03010815 + 2"(",F12.5,", ",F12.5,")") 03020815 +CBE** ********************** BBCFMAT1 **********************************03030815 +CBB** ********************** BBCFMT0B **********************************03040815 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03050815 +C**** 03060815 +90002 FORMAT ("1") 03070815 +90004 FORMAT (" ") 03080815 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03090815 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03100815 +90008 FORMAT (" ",21X,A13,A17) 03110815 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03120815 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03130815 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03140815 + 1 7X,"REMARKS",24X) 03150815 +90014 FORMAT (" ","----------------------------------------------" , 03160815 + 1 "---------------------------------" ) 03170815 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03180815 +C**** 03190815 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03200815 +C**** 03210815 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03220815 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03230815 + 1 A13) 03240815 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03250815 +C**** 03260815 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03270815 +C**** 03280815 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03290815 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03300815 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03310815 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03320815 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03330815 +CBE** ********************** BBCFMT0B **********************************03340815 +C***** 03350815 +C***** END OF TEST SEGMENT 180 03360815 + STOP 03370815 + END 03380815 + 03390815 diff --git a/Fortran/UnitTests/fcvs21_f95/FM815.reference_output b/Fortran/UnitTests/fcvs21_f95/FM815.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM815.reference_output @@ -0,0 +1,43 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM815BEGIN* TEST RESULTS - FM815 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YCEXP - (180) INTRINSIC FUNCTIONS + + CEXP (COMPLEX EXPONENTIAL) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 9 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + + ------------------------------------------------------------------------------- + + 9 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 9 OF 9 TESTS EXECUTED + + *FM815END* END OF TEST - FM815 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM816.f b/Fortran/UnitTests/fcvs21_f95/FM816.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM816.f @@ -0,0 +1,407 @@ + PROGRAM FM816 + +C***********************************************************************00010816 +C***** FORTRAN 77 00020816 +C***** FM816 00030816 +C***** YDLOG - (182) 00040816 +C***** 00050816 +C***********************************************************************00060816 +C***** GENERAL PURPOSE ANS REF 00070816 +C***** TEST INTRINSIC FUNCTION DLOG 15.3 00080816 +C***** TABLE 5 00090816 +CBB** ********************** BBCCOMNT **********************************00100816 +C**** 00110816 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120816 +C**** VERSION 2.1 00130816 +C**** 00140816 +C**** 00150816 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160816 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170816 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180816 +C**** BUILDING 225 RM A266 00190816 +C**** GAITHERSBURG, MD 20899 00200816 +C**** 00210816 +C**** 00220816 +C**** 00230816 +CBE** ********************** BBCCOMNT **********************************00240816 +C***** 00250816 +C***** S P E C I F I C A T I O N S SEGMENT 182 00260816 + DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00270816 +C***** 00280816 +CBB** ********************** BBCINITA **********************************00290816 +C**** SPECIFICATION STATEMENTS 00300816 +C**** 00310816 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320816 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330816 +CBE** ********************** BBCINITA **********************************00340816 +CBB** ********************** BBCINITB **********************************00350816 +C**** INITIALIZE SECTION 00360816 + DATA ZVERS, ZVERSD, ZDATE 00370816 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380816 + DATA ZCOMPL, ZNAME, ZTAPE 00390816 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400816 + DATA ZPROJ, ZTAPED, ZPROG 00410816 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420816 + DATA REMRKS /' '/ 00430816 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440816 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450816 +C**** 00460816 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470816 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480816 +CZ03 ZPROG = 'PROGRAM NAME' 00490816 +CZ04 ZDATE = 'DATE OF TEST' 00500816 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510816 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520816 +CZ07 ZNAME = 'NAME OF USER' 00530816 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540816 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550816 +C 00560816 + IVPASS = 0 00570816 + IVFAIL = 0 00580816 + IVDELE = 0 00590816 + IVINSP = 0 00600816 + IVTOTL = 0 00610816 + IVTOTN = 0 00620816 + ICZERO = 0 00630816 +C 00640816 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650816 + I01 = 05 00660816 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670816 + I02 = 06 00680816 +C 00690816 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700816 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710816 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720816 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730816 +C 00740816 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750816 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760816 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770816 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780816 +C 00790816 +CBE** ********************** BBCINITB **********************************00800816 + NUVI = I02 00810816 + IVTOTL = 16 00820816 + ZPROG = 'FM816' 00830816 +CBB** ********************** BBCHED0A **********************************00840816 +C**** 00850816 +C**** WRITE REPORT TITLE 00860816 +C**** 00870816 + WRITE (I02, 90002) 00880816 + WRITE (I02, 90006) 00890816 + WRITE (I02, 90007) 00900816 + WRITE (I02, 90008) ZVERS, ZVERSD 00910816 + WRITE (I02, 90009) ZPROG, ZPROG 00920816 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930816 +CBE** ********************** BBCHED0A **********************************00940816 +C***** 00950816 +C***** HEADER FOR SEGMENT 182 00960816 + WRITE(NUVI,18200) 00970816 +18200 FORMAT(" ", / " YDLOG - (182) INTRINSIC FUNCTIONS" // 00980816 + 1 " DLOG (DOUBLE PRECISION NATURAL LOGARITHM)" // 00990816 + 2 " ANS REF. - 15.3" ) 01000816 +CBB** ********************** BBCHED0B **********************************01010816 +C**** WRITE DETAIL REPORT HEADERS 01020816 +C**** 01030816 + WRITE (I02,90004) 01040816 + WRITE (I02,90004) 01050816 + WRITE (I02,90013) 01060816 + WRITE (I02,90014) 01070816 + WRITE (I02,90015) IVTOTL 01080816 +CBE** ********************** BBCHED0B **********************************01090816 +C***** 01100816 +CT001* TEST 1 ONE, SINCE LN(1.0) = 0.0 01110816 + IVTNUM = 1 01120816 + BVD = 1.0D0 01130816 + AVD = DLOG(BVD) 01140816 + IF (AVD + 0.5000000000D-09) 20010, 10010, 40010 01150816 +40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010 01160816 +10010 IVPASS = IVPASS + 1 01170816 + WRITE (NUVI, 80002) IVTNUM 01180816 + GO TO 0011 01190816 +20010 IVFAIL = IVFAIL + 1 01200816 + DVCORR = 0.00000000000000000000D+00 01210816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01220816 + 0011 CONTINUE 01230816 +CT002* TEST 2 VALUE CLOSE TO E 01240816 + IVTNUM = 2 01250816 + AVD = DLOG(2.6875D0) 01260816 + IF (AVD - 0.9886113929D+00) 20020, 10020, 40020 01270816 +40020 IF (AVD - 0.9886113940D+00) 10020, 10020, 20020 01280816 +10020 IVPASS = IVPASS + 1 01290816 + WRITE (NUVI, 80002) IVTNUM 01300816 + GO TO 0021 01310816 +20020 IVFAIL = IVFAIL + 1 01320816 + DVCORR = 0.98861139345378118580D+00 01330816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01340816 + 0021 CONTINUE 01350816 +CT003* TEST 3 01360816 + IVTNUM = 3 01370816 + AVD = DLOG(5.125D0) 01380816 + IF (AVD - 0.1634130524D+01) 20030, 10030, 40030 01390816 +40030 IF (AVD - 0.1634130526D+01) 10030, 10030, 20030 01400816 +10030 IVPASS = IVPASS + 1 01410816 + WRITE (NUVI, 80002) IVTNUM 01420816 + GO TO 0031 01430816 +20030 IVFAIL = IVFAIL + 1 01440816 + DVCORR = 1.6341305250244718756D+00 01450816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01460816 + 0031 CONTINUE 01470816 +CT004* TEST 4 01480816 + IVTNUM = 4 01490816 + AVD = DLOG(10.0D0) 01500816 + IF (AVD - 0.2302585091D+01) 20040, 10040, 40040 01510816 +40040 IF (AVD - 0.2302585095D+01) 10040, 10040, 20040 01520816 +10040 IVPASS = IVPASS + 1 01530816 + WRITE (NUVI, 80002) IVTNUM 01540816 + GO TO 0041 01550816 +20040 IVFAIL = IVFAIL + 1 01560816 + DVCORR = 2.3025850929940456840D+00 01570816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01580816 + 0041 CONTINUE 01590816 +CT005* TEST 5 01600816 + IVTNUM = 5 01610816 + AVD = DLOG(100.0D0) 01620816 + IF (AVD - 0.4605170183D+01) 20050, 10050, 40050 01630816 +40050 IF (AVD - 0.4605170189D+01) 10050, 10050, 20050 01640816 +10050 IVPASS = IVPASS + 1 01650816 + WRITE (NUVI, 80002) IVTNUM 01660816 + GO TO 0051 01670816 +20050 IVFAIL = IVFAIL + 1 01680816 + DVCORR = 4.6051701859880913680D+00 01690816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01700816 + 0051 CONTINUE 01710816 +CT006* TEST 6 01720816 + IVTNUM = 6 01730816 + BVD = 1.0D0 01740816 + AVD = DLOG(BVD / 4.D0) 01750816 + IF (AVD + 0.1386294362D+01) 20060, 10060, 40060 01760816 +40060 IF (AVD + 0.1386294360D+01) 10060, 10060, 20060 01770816 +10060 IVPASS = IVPASS + 1 01780816 + WRITE (NUVI, 80002) IVTNUM 01790816 + GO TO 0061 01800816 +20060 IVFAIL = IVFAIL + 1 01810816 + DVCORR = -1.3862943611198906188D+00 01820816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01830816 + 0061 CONTINUE 01840816 +CT007* TEST 7 01850816 + IVTNUM = 7 01860816 + BVD = 1.0D0 01870816 + CVD = 8.0D0 01880816 + AVD = DLOG(3.0D0 * BVD / CVD) 01890816 + IF (AVD + 0.9808292535D+00) 20070, 10070, 40070 01900816 +40070 IF (AVD + 0.9808292525D+00) 10070, 10070, 20070 01910816 +10070 IVPASS = IVPASS + 1 01920816 + WRITE (NUVI, 80002) IVTNUM 01930816 + GO TO 0071 01940816 +20070 IVFAIL = IVFAIL + 1 01950816 + DVCORR = -0.98082925301172623686D+00 01960816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01970816 + 0071 CONTINUE 01980816 +CT008* TEST 8 01990816 + IVTNUM = 8 02000816 + AVD = DLOG(50.0D0 / 100.0D0) 02010816 + IF (AVD + 0.6931471809D+00) 20080, 10080, 40080 02020816 +40080 IF (AVD + 0.6931471802D+00) 10080, 10080, 20080 02030816 +10080 IVPASS = IVPASS + 1 02040816 + WRITE (NUVI, 80002) IVTNUM 02050816 + GO TO 0081 02060816 +20080 IVFAIL = IVFAIL + 1 02070816 + DVCORR = -0.69314718055994530942D+00 02080816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02090816 + 0081 CONTINUE 02100816 +CT009* TEST 9 02110816 + IVTNUM = 9 02120816 + BVD = 68.75D0 02130816 + AVD = DLOG(BVD * 0.01D0) 02140816 + IF (AVD + 0.3746934497D+00) 20090, 10090, 40090 02150816 +40090 IF (AVD + 0.3746934492D+00) 10090, 10090, 20090 02160816 +10090 IVPASS = IVPASS + 1 02170816 + WRITE (NUVI, 80002) IVTNUM 02180816 + GO TO 0091 02190816 +20090 IVFAIL = IVFAIL + 1 02200816 + DVCORR = -0.37469344944141069361D+00 02210816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02220816 + 0091 CONTINUE 02230816 +CT010* TEST 10 VALUES CLOSE TO ONE 02240816 + IVTNUM = 10 02250816 + AVD = DLOG(0.96875D0) 02260816 + IF (AVD + 0.3174869833D-01) 20100, 10100, 40100 02270816 +40100 IF (AVD + 0.3174869829D-01) 10100, 10100, 20100 02280816 +10100 IVPASS = IVPASS + 1 02290816 + WRITE (NUVI, 80002) IVTNUM 02300816 + GO TO 0101 02310816 +20100 IVFAIL = IVFAIL + 1 02320816 + DVCORR = -0.031748698314580301157D+00 02330816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02340816 + 0101 CONTINUE 02350816 +CT011* TEST 11 02360816 + IVTNUM = 11 02370816 + BVD = 1.015625D0 02380816 + AVD = DLOG(BVD) 02390816 + IF (AVD - 0.1550418652D-01) 20110, 10110, 40110 02400816 +40110 IF (AVD - 0.1550418655D-01) 10110, 10110, 20110 02410816 +10110 IVPASS = IVPASS + 1 02420816 + WRITE (NUVI, 80002) IVTNUM 02430816 + GO TO 0111 02440816 +20110 IVFAIL = IVFAIL + 1 02450816 + DVCORR = 0.015504186535965254150D+00 02460816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02470816 + 0111 CONTINUE 02480816 +CT012* TEST 12 VALUES CLOSE TO ZERO 02490816 + IVTNUM = 12 02500816 + BVD = 128.0D0 02510816 + AVD = DLOG(1.0D0 / BVD) 02520816 + IF (AVD + 0.4852030267D+01) 20120, 10120, 40120 02530816 +40120 IF (AVD + 0.4852030261D+01) 10120, 10120, 20120 02540816 +10120 IVPASS = IVPASS + 1 02550816 + WRITE (NUVI, 80002) IVTNUM 02560816 + GO TO 0121 02570816 +20120 IVFAIL = IVFAIL + 1 02580816 + DVCORR = -4.8520302639196171659D+00 02590816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02600816 + 0121 CONTINUE 02610816 +CT013* TEST 13 02620816 + IVTNUM = 13 02630816 + BVD = 128.0D0 02640816 + AVD = DLOG(1.0D0 / (BVD * 4.0D0)) 02650816 + IF (AVD + 0.6238324629D+01) 20130, 10130, 40130 02660816 +40130 IF (AVD + 0.6238324622D+01) 10130, 10130, 20130 02670816 +10130 IVPASS = IVPASS + 1 02680816 + WRITE (NUVI, 80002) IVTNUM 02690816 + GO TO 0131 02700816 +20130 IVFAIL = IVFAIL + 1 02710816 + DVCORR = -6.2383246250395077848D+00 02720816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02730816 + 0131 CONTINUE 02740816 +CT014* TEST 14 AN ARGUMENT OF HIGH MAGNITUDE 02750816 + IVTNUM = 14 02760816 + BVD = 1.0D+37 02770816 + AVD = DLOG(BVD) 02780816 + IF (AVD - 0.8519564839D+02) 20140, 10140, 40140 02790816 +40140 IF (AVD - 0.8519564849D+02) 10140, 10140, 20140 02800816 +10140 IVPASS = IVPASS + 1 02810816 + WRITE (NUVI, 80002) IVTNUM 02820816 + GO TO 0141 02830816 +20140 IVFAIL = IVFAIL + 1 02840816 + DVCORR = 85.195648440779690309D+00 02850816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02860816 + 0141 CONTINUE 02870816 +CT015* TEST 15 AN ARGUMENT OF LOW MAGNITUDE 02880816 + IVTNUM = 15 02890816 + BVD = 1.0D-37 02900816 + AVD = DLOG(BVD) 02910816 + IF (AVD + 0.8519564849D+02) 20150, 10150, 40150 02920816 +40150 IF (AVD + 0.8519564840D+02) 10150, 10150, 20150 02930816 +10150 IVPASS = IVPASS + 1 02940816 + WRITE (NUVI, 80002) IVTNUM 02950816 + GO TO 0151 02960816 +20150 IVFAIL = IVFAIL + 1 02970816 + DVCORR = -85.195648440779690309D+00 02980816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02990816 + 0151 CONTINUE 03000816 +CT016* TEST 16 03010816 + IVTNUM = 16 03020816 + AVD = DLOG(8.0D0) + DLOG(0.125D0) 03030816 + IF (AVD + 0.5000000000D-09) 20160, 10160, 40160 03040816 +40160 IF (AVD - 0.5000000000D-09) 10160, 10160, 20160 03050816 +10160 IVPASS = IVPASS + 1 03060816 + WRITE (NUVI, 80002) IVTNUM 03070816 + GO TO 0161 03080816 +20160 IVFAIL = IVFAIL + 1 03090816 + DVCORR = 0.00000000000000D+00 03100816 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03110816 + 0161 CONTINUE 03120816 +C***** 03130816 +CBB** ********************** BBCSUM0 **********************************03140816 +C**** WRITE OUT TEST SUMMARY 03150816 +C**** 03160816 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03170816 + WRITE (I02, 90004) 03180816 + WRITE (I02, 90014) 03190816 + WRITE (I02, 90004) 03200816 + WRITE (I02, 90020) IVPASS 03210816 + WRITE (I02, 90022) IVFAIL 03220816 + WRITE (I02, 90024) IVDELE 03230816 + WRITE (I02, 90026) IVINSP 03240816 + WRITE (I02, 90028) IVTOTN, IVTOTL 03250816 +CBE** ********************** BBCSUM0 **********************************03260816 +CBB** ********************** BBCFOOT0 **********************************03270816 +C**** WRITE OUT REPORT FOOTINGS 03280816 +C**** 03290816 + WRITE (I02,90016) ZPROG, ZPROG 03300816 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03310816 + WRITE (I02,90019) 03320816 +CBE** ********************** BBCFOOT0 **********************************03330816 +CBB** ********************** BBCFMT0A **********************************03340816 +C**** FORMATS FOR TEST DETAIL LINES 03350816 +C**** 03360816 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03370816 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03380816 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03390816 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03400816 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03410816 + 1I6,/," ",15X,"CORRECT= " ,I6) 03420816 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03430816 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03440816 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03450816 + 1A21,/," ",16X,"CORRECT= " ,A21) 03460816 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03470816 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03480816 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03490816 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03500816 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03510816 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03520816 +80050 FORMAT (" ",48X,A31) 03530816 +CBE** ********************** BBCFMT0A **********************************03540816 +CBB** ********************** BBCFMAT1 **********************************03550816 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03560816 +C**** 03570816 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03580816 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03590816 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03600816 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03610816 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03620816 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03630816 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03640816 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03650816 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03660816 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03670816 + 2"(",F12.5,", ",F12.5,")") 03680816 +CBE** ********************** BBCFMAT1 **********************************03690816 +CBB** ********************** BBCFMT0B **********************************03700816 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03710816 +C**** 03720816 +90002 FORMAT ("1") 03730816 +90004 FORMAT (" ") 03740816 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03750816 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03760816 +90008 FORMAT (" ",21X,A13,A17) 03770816 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03780816 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03790816 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03800816 + 1 7X,"REMARKS",24X) 03810816 +90014 FORMAT (" ","----------------------------------------------" , 03820816 + 1 "---------------------------------" ) 03830816 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03840816 +C**** 03850816 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03860816 +C**** 03870816 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03880816 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03890816 + 1 A13) 03900816 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03910816 +C**** 03920816 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03930816 +C**** 03940816 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03950816 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03960816 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03970816 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03980816 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03990816 +CBE** ********************** BBCFMT0B **********************************04000816 +C***** 04010816 +C***** END OF TEST SEGMENT 182 04020816 + STOP 04030816 + END 04040816 + 04050816 diff --git a/Fortran/UnitTests/fcvs21_f95/FM816.reference_output b/Fortran/UnitTests/fcvs21_f95/FM816.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM816.reference_output @@ -0,0 +1,50 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM816BEGIN* TEST RESULTS - FM816 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDLOG - (182) INTRINSIC FUNCTIONS + + DLOG (DOUBLE PRECISION NATURAL LOGARITHM) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 16 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + + ------------------------------------------------------------------------------- + + 16 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 16 OF 16 TESTS EXECUTED + + *FM816END* END OF TEST - FM816 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM817.f b/Fortran/UnitTests/fcvs21_f95/FM817.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM817.f @@ -0,0 +1,374 @@ + PROGRAM FM817 + +C***********************************************************************00010817 +C***** FORTRAN 77 00020817 +C***** FM817 00030817 +C***** YCLOG - (183) 00040817 +C***** 00050817 +C***********************************************************************00060817 +C***** GENERAL PURPOSE ANS REF 00070817 +C***** TEST INTRINSIC FUNCTION CLOG 15.3 00080817 +C***** INTRINSIC FUNCTIONS AIMAG AND CMPLX ASSUMED WORKING TABLE 5 00090817 +C***** 00100817 +CBB** ********************** BBCCOMNT **********************************00110817 +C**** 00120817 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130817 +C**** VERSION 2.1 00140817 +C**** 00150817 +C**** 00160817 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170817 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180817 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190817 +C**** BUILDING 225 RM A266 00200817 +C**** GAITHERSBURG, MD 20899 00210817 +C**** 00220817 +C**** 00230817 +C**** 00240817 +CBE** ********************** BBCCOMNT **********************************00250817 +C***** 00260817 +C***** S P E C I F I C A T I O N S SEGMENT 183 00270817 + COMPLEX AVC, BVC, CVC, ZVCORR 00280817 + REAL R2E(2) 00290817 + EQUIVALENCE (AVC, R2E) 00300817 +C***** 00310817 +CBB** ********************** BBCINITA **********************************00320817 +C**** SPECIFICATION STATEMENTS 00330817 +C**** 00340817 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350817 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360817 +CBE** ********************** BBCINITA **********************************00370817 +CBB** ********************** BBCINITB **********************************00380817 +C**** INITIALIZE SECTION 00390817 + DATA ZVERS, ZVERSD, ZDATE 00400817 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410817 + DATA ZCOMPL, ZNAME, ZTAPE 00420817 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430817 + DATA ZPROJ, ZTAPED, ZPROG 00440817 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450817 + DATA REMRKS /' '/ 00460817 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470817 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480817 +C**** 00490817 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500817 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510817 +CZ03 ZPROG = 'PROGRAM NAME' 00520817 +CZ04 ZDATE = 'DATE OF TEST' 00530817 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540817 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550817 +CZ07 ZNAME = 'NAME OF USER' 00560817 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570817 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580817 +C 00590817 + IVPASS = 0 00600817 + IVFAIL = 0 00610817 + IVDELE = 0 00620817 + IVINSP = 0 00630817 + IVTOTL = 0 00640817 + IVTOTN = 0 00650817 + ICZERO = 0 00660817 +C 00670817 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680817 + I01 = 05 00690817 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700817 + I02 = 06 00710817 +C 00720817 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730817 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740817 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750817 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760817 +C 00770817 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780817 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790817 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800817 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810817 +C 00820817 +CBE** ********************** BBCINITB **********************************00830817 + NUVI = I02 00840817 + IVTOTL = 11 00850817 + ZPROG = 'FM817' 00860817 +CBB** ********************** BBCHED0A **********************************00870817 +C**** 00880817 +C**** WRITE REPORT TITLE 00890817 +C**** 00900817 + WRITE (I02, 90002) 00910817 + WRITE (I02, 90006) 00920817 + WRITE (I02, 90007) 00930817 + WRITE (I02, 90008) ZVERS, ZVERSD 00940817 + WRITE (I02, 90009) ZPROG, ZPROG 00950817 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960817 +CBE** ********************** BBCHED0A **********************************00970817 +C***** 00980817 +C***** HEADER FOR SEGMENT 183 00990817 + WRITE(NUVI,18300) 01000817 +18300 FORMAT(" ", / " YCLOG - (183) INTRINSIC FUNCTIONS" // 01010817 + 1 " CLOG (COMPLEX NATURAL LOGARITHM)" // 01020817 + 2 " ANS REF. - 15.3" ) 01030817 +CBB** ********************** BBCHED0B **********************************01040817 +C**** WRITE DETAIL REPORT HEADERS 01050817 +C**** 01060817 + WRITE (I02,90004) 01070817 + WRITE (I02,90004) 01080817 + WRITE (I02,90013) 01090817 + WRITE (I02,90014) 01100817 + WRITE (I02,90015) IVTOTL 01110817 +CBE** ********************** BBCHED0B **********************************01120817 +C***** 01130817 + PIVS = 3.1415926535897932384626434 01140817 +C***** TESTS 1 THRU 3 - POSITIVE REAL NUMBERS--CLOG, ALOG AGREE ON 01150817 +C***** REAL LINE 01160817 +CT001* TEST 1 01170817 + IVTNUM = 1 01180817 + AVC = CLOG((1.0, 0.0)) 01190817 + IF (R2E(1) + 0.50000E-04) 20010, 40012, 40011 01200817 +40011 IF (R2E(1) - 0.50000E-04) 40012, 40012, 20010 01210817 +40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010 01220817 +40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010 01230817 +10010 IVPASS = IVPASS + 1 01240817 + WRITE (NUVI, 80002) IVTNUM 01250817 + GO TO 0011 01260817 +20010 IVFAIL = IVFAIL + 1 01270817 + ZVCORR = (0.00000000000000, 0.00000000000000) 01280817 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01290817 + 0011 CONTINUE 01300817 +CT002* TEST 2 01310817 + IVTNUM = 2 01320817 + AVC = CLOG((5.125, 0.0)) 01330817 + IF (R2E(1) - 0.16340E+01) 20020, 40022, 40021 01340817 +40021 IF (R2E(1) - 0.16343E+01) 40022, 40022, 20020 01350817 +40022 IF (R2E(2) + 0.50000E-04) 20020, 10020, 40020 01360817 +40020 IF (R2E(2) - 0.50000E-04) 10020, 10020, 20020 01370817 +10020 IVPASS = IVPASS + 1 01380817 + WRITE (NUVI, 80002) IVTNUM 01390817 + GO TO 0021 01400817 +20020 IVFAIL = IVFAIL + 1 01410817 + ZVCORR = (1.6341305250245, 0.00000000000000) 01420817 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01430817 + 0021 CONTINUE 01440817 +CT003* TEST 3 01450817 + IVTNUM = 3 01460817 + AVC = CLOG((100.0, 0.0)) 01470817 + IF (R2E(1) - 0.46049E+01) 20030, 40032, 40031 01480817 +40031 IF (R2E(1) - 0.46054E+01) 40032, 40032, 20030 01490817 +40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030 01500817 +40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030 01510817 +10030 IVPASS = IVPASS + 1 01520817 + WRITE (NUVI, 80002) IVTNUM 01530817 + GO TO 0031 01540817 +20030 IVFAIL = IVFAIL + 1 01550817 + ZVCORR = (4.6051701859881, 0.00000000000000) 01560817 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01570817 + 0031 CONTINUE 01580817 +CT004* TEST 4 AN EXPRESSION PRESENTED TO CLOG 01590817 + IVTNUM = 4 01600817 + AVC = CLOG((2.6875, 0.0) * (-1.0, 0.0)) 01610817 + IF (R2E(1) - 0.98856E+00) 20040, 40042, 40041 01620817 +40041 IF (R2E(1) - 0.98866E+00) 40042, 40042, 20040 01630817 +40042 IF (R2E(2) - 0.31414E+01) 20040, 10040, 40040 01640817 +40040 IF (R2E(2) - 0.31418E+01) 10040, 10040, 20040 01650817 +10040 IVPASS = IVPASS + 1 01660817 + WRITE (NUVI, 80002) IVTNUM 01670817 + GO TO 0041 01680817 +20040 IVFAIL = IVFAIL + 1 01690817 + ZVCORR = (0.98861139345378, 3.1415926535898) 01700817 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01710817 + 0041 CONTINUE 01720817 +C***** TESTS 5 AND 6 - NEGATIVE REAL NUMBERS--CHECK RIGHT BRANCH AT 01730817 +C***** ENDPOINTS 01740817 +CT005* TEST 5 01750817 + IVTNUM = 5 01760817 + BVC = (-2.5, 0.0) 01770817 + AVC = CLOG(BVC + BVC) 01780817 + IF (R2E(1) - 0.16093E+01) 20050, 40052, 40051 01790817 +40051 IF (R2E(1) - 0.16096E+01) 40052, 40052, 20050 01800817 +40052 IF (R2E(2) - 0.31414E+01) 20050, 10050, 40050 01810817 +40050 IF (R2E(2) - 0.31418E+01) 10050, 10050, 20050 01820817 +10050 IVPASS = IVPASS + 1 01830817 + WRITE (NUVI, 80002) IVTNUM 01840817 + GO TO 0051 01850817 +20050 IVFAIL = IVFAIL + 1 01860817 + ZVCORR = (1.6094379124341, 3.1415926535898) 01870817 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01880817 + 0051 CONTINUE 01890817 +CT006* TEST 6 01900817 + IVTNUM = 6 01910817 + BVC = (-10.0, 0.0) + (-10.25, 0.0) 01920817 + AVC = CLOG(BVC) 01930817 + IF (R2E(1) - 0.30080E+01) 20060, 40062, 40061 01940817 +40061 IF (R2E(1) - 0.30083E+01) 40062, 40062, 20060 01950817 +40062 IF (R2E(2) - 0.31414E+01) 20060, 10060, 40060 01960817 +40060 IF (R2E(2) - 0.31418E+01) 10060, 10060, 20060 01970817 +10060 IVPASS = IVPASS + 1 01980817 + WRITE (NUVI, 80002) IVTNUM 01990817 + GO TO 0061 02000817 +20060 IVFAIL = IVFAIL + 1 02010817 + ZVCORR = (3.0081547935525, 3.1415926535898) 02020817 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02030817 + 0061 CONTINUE 02040817 +CT007* TEST 7 POSITIVE REAL, POSITIVE IMAGINARY ARGUMENTS 02050817 + IVTNUM = 7 02060817 + BVC = (2.0, 1.5) 02070817 + AVC = CLOG(BVC) 02080817 + IF (R2E(1) - 0.91624E+00) 20070, 40072, 40071 02090817 +40071 IF (R2E(1) - 0.91634E+00) 40072, 40072, 20070 02100817 +40072 IF (R2E(2) - 0.64346E+00) 20070, 10070, 40070 02110817 +40070 IF (R2E(2) - 0.64354E+00) 10070, 10070, 20070 02120817 +10070 IVPASS = IVPASS + 1 02130817 + WRITE (NUVI, 80002) IVTNUM 02140817 + GO TO 0071 02150817 +20070 IVFAIL = IVFAIL + 1 02160817 + ZVCORR = (0.91629073187416, 0.64350110879328) 02170817 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02180817 + 0071 CONTINUE 02190817 +CT008* TEST 8 NEGATIVE REAL, POSITIVE IMAGINARY ARGUMENTS 02200817 + IVTNUM = 8 02210817 + BVC = (-2.75, 1.375) 02220817 + AVC = CLOG(BVC) 02230817 + IF (R2E(1) - 0.11231E+01) 20080, 40082, 40081 02240817 +40081 IF (R2E(1) - 0.11233E+01) 40082, 40082, 20080 02250817 +40082 IF (R2E(2) - 0.26778E+01) 20080, 10080, 40080 02260817 +40080 IF (R2E(2) - 0.26781E+01) 10080, 10080, 20080 02270817 +10080 IVPASS = IVPASS + 1 02280817 + WRITE (NUVI, 80002) IVTNUM 02290817 + GO TO 0081 02300817 +20080 IVFAIL = IVFAIL + 1 02310817 + ZVCORR = (1.1231726873356, 2.6779450445890) 02320817 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02330817 + 0081 CONTINUE 02340817 +CT009* TEST 9 NEGATIVE REAL, NEGATIVE IMAGINARY ARGUMENTS 02350817 + IVTNUM = 9 02360817 + BVC = (-10.0, -10.0) 02370817 + AVC = CLOG(BVC) 02380817 + IF (R2E(1) - 0.26490E+01) 20090, 40092, 40091 02390817 +40091 IF (R2E(1) - 0.26493E+01) 40092, 40092, 20090 02400817 +40092 IF (R2E(2) + 0.23564E+01) 20090, 10090, 40090 02410817 +40090 IF (R2E(2) + 0.23560E+01) 10090, 10090, 20090 02420817 +10090 IVPASS = IVPASS + 1 02430817 + WRITE (NUVI, 80002) IVTNUM 02440817 + GO TO 0091 02450817 +20090 IVFAIL = IVFAIL + 1 02460817 + ZVCORR = (2.6491586832740, -2.3561944901923) 02470817 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02480817 + 0091 CONTINUE 02490817 +CT010* TEST 10 CLOG USED TOGETHER WITH AIMAG 02500817 + IVTNUM = 10 02510817 + AVS = (AIMAG(CLOG((3.0, 1.75))) + AIMAG(CLOG((-3.0, 1.75)))) 02520817 + 1 - PIVS 02530817 + IF (AVS + 0.50000E-04) 20100, 10100, 40100 02540817 +40100 IF (AVS - 0.50000E-04) 10100, 10100, 20100 02550817 +10100 IVPASS = IVPASS + 1 02560817 + WRITE (NUVI, 80002) IVTNUM 02570817 + GO TO 0101 02580817 +20100 IVFAIL = IVFAIL + 1 02590817 + RVCORR = 0.00000000000000 02600817 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02610817 + 0101 CONTINUE 02620817 +CT011* TEST 11 CLOG USED TOGETHER WITH CMPLX AND AIMAG 02630817 + IVTNUM = 11 02640817 + BVC = CLOG((4.5, -3.75)) 02650817 + CVC = CLOG((-4.5, -3.75)) 02660817 + AVC = (BVC - CMPLX(0.0, AIMAG(BVC))) - 02670817 + 1 (CVC - CMPLX(0.0, AIMAG(CVC))) 02680817 + IF (R2E(1) + 0.50000E-04) 20110, 40112, 40111 02690817 +40111 IF (R2E(1) - 0.50000E-04) 40112, 40112, 20110 02700817 +40112 IF (R2E(2) + 0.50000E-04) 20110, 10110, 40110 02710817 +40110 IF (R2E(2) - 0.50000E-04) 10110, 10110, 20110 02720817 +10110 IVPASS = IVPASS + 1 02730817 + WRITE (NUVI, 80002) IVTNUM 02740817 + GO TO 0111 02750817 +20110 IVFAIL = IVFAIL + 1 02760817 + ZVCORR = (0.00000000000000, 0.00000000000000) 02770817 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02780817 + 0111 CONTINUE 02790817 +C***** 02800817 +CBB** ********************** BBCSUM0 **********************************02810817 +C**** WRITE OUT TEST SUMMARY 02820817 +C**** 02830817 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02840817 + WRITE (I02, 90004) 02850817 + WRITE (I02, 90014) 02860817 + WRITE (I02, 90004) 02870817 + WRITE (I02, 90020) IVPASS 02880817 + WRITE (I02, 90022) IVFAIL 02890817 + WRITE (I02, 90024) IVDELE 02900817 + WRITE (I02, 90026) IVINSP 02910817 + WRITE (I02, 90028) IVTOTN, IVTOTL 02920817 +CBE** ********************** BBCSUM0 **********************************02930817 +CBB** ********************** BBCFOOT0 **********************************02940817 +C**** WRITE OUT REPORT FOOTINGS 02950817 +C**** 02960817 + WRITE (I02,90016) ZPROG, ZPROG 02970817 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02980817 + WRITE (I02,90019) 02990817 +CBE** ********************** BBCFOOT0 **********************************03000817 +CBB** ********************** BBCFMT0A **********************************03010817 +C**** FORMATS FOR TEST DETAIL LINES 03020817 +C**** 03030817 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03040817 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03050817 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03060817 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03070817 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03080817 + 1I6,/," ",15X,"CORRECT= " ,I6) 03090817 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03100817 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03110817 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03120817 + 1A21,/," ",16X,"CORRECT= " ,A21) 03130817 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03140817 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03150817 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03160817 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03170817 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03180817 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03190817 +80050 FORMAT (" ",48X,A31) 03200817 +CBE** ********************** BBCFMT0A **********************************03210817 +CBB** ********************** BBCFMAT1 **********************************03220817 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03230817 +C**** 03240817 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03250817 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03260817 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03270817 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03280817 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03290817 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03300817 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03310817 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03320817 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03330817 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03340817 + 2"(",F12.5,", ",F12.5,")") 03350817 +CBE** ********************** BBCFMAT1 **********************************03360817 +CBB** ********************** BBCFMT0B **********************************03370817 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03380817 +C**** 03390817 +90002 FORMAT ("1") 03400817 +90004 FORMAT (" ") 03410817 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03420817 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03430817 +90008 FORMAT (" ",21X,A13,A17) 03440817 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03450817 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03460817 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03470817 + 1 7X,"REMARKS",24X) 03480817 +90014 FORMAT (" ","----------------------------------------------" , 03490817 + 1 "---------------------------------" ) 03500817 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03510817 +C**** 03520817 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03530817 +C**** 03540817 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03550817 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03560817 + 1 A13) 03570817 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03580817 +C**** 03590817 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03600817 +C**** 03610817 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03620817 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03630817 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03640817 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03650817 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03660817 +CBE** ********************** BBCFMT0B **********************************03670817 +C***** 03680817 +C***** END OF TEST SEGMENT 183 03690817 + STOP 03700817 + END 03710817 + 03720817 diff --git a/Fortran/UnitTests/fcvs21_f95/FM817.reference_output b/Fortran/UnitTests/fcvs21_f95/FM817.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM817.reference_output @@ -0,0 +1,45 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM817BEGIN* TEST RESULTS - FM817 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YCLOG - (183) INTRINSIC FUNCTIONS + + CLOG (COMPLEX NATURAL LOGARITHM) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 11 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + + ------------------------------------------------------------------------------- + + 11 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 11 OF 11 TESTS EXECUTED + + *FM817END* END OF TEST - FM817 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM818.f b/Fortran/UnitTests/fcvs21_f95/FM818.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM818.f @@ -0,0 +1,395 @@ + PROGRAM FM818 + +C***********************************************************************00010818 +C***** FORTRAN 77 00020818 +C***** FM818 00030818 +C***** YDLG10 - (185) 00040818 +C***** 00050818 +C***********************************************************************00060818 +C***** GENERAL PURPOSE ANS REF 00070818 +C***** TEST INTRINSIC FUNCTION DLOG10 15.3 00080818 +C***** TABLE 5 00090818 +C***** 00100818 +CBB** ********************** BBCCOMNT **********************************00110818 +C**** 00120818 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130818 +C**** VERSION 2.1 00140818 +C**** 00150818 +C**** 00160818 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170818 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180818 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190818 +C**** BUILDING 225 RM A266 00200818 +C**** GAITHERSBURG, MD 20899 00210818 +C**** 00220818 +C**** 00230818 +C**** 00240818 +CBE** ********************** BBCCOMNT **********************************00250818 +C***** S P E C I F I C A T I O N S SEGMENT 185 00260818 + DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00270818 +C***** 00280818 +CBB** ********************** BBCINITA **********************************00290818 +C**** SPECIFICATION STATEMENTS 00300818 +C**** 00310818 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320818 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330818 +CBE** ********************** BBCINITA **********************************00340818 +CBB** ********************** BBCINITB **********************************00350818 +C**** INITIALIZE SECTION 00360818 + DATA ZVERS, ZVERSD, ZDATE 00370818 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380818 + DATA ZCOMPL, ZNAME, ZTAPE 00390818 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400818 + DATA ZPROJ, ZTAPED, ZPROG 00410818 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420818 + DATA REMRKS /' '/ 00430818 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440818 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450818 +C**** 00460818 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470818 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480818 +CZ03 ZPROG = 'PROGRAM NAME' 00490818 +CZ04 ZDATE = 'DATE OF TEST' 00500818 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510818 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520818 +CZ07 ZNAME = 'NAME OF USER' 00530818 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540818 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550818 +C 00560818 + IVPASS = 0 00570818 + IVFAIL = 0 00580818 + IVDELE = 0 00590818 + IVINSP = 0 00600818 + IVTOTL = 0 00610818 + IVTOTN = 0 00620818 + ICZERO = 0 00630818 +C 00640818 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650818 + I01 = 05 00660818 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670818 + I02 = 06 00680818 +C 00690818 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700818 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710818 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720818 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730818 +C 00740818 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750818 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760818 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770818 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780818 +C 00790818 +CBE** ********************** BBCINITB **********************************00800818 + NUVI = I02 00810818 + IVTOTL = 15 00820818 + ZPROG = 'FM818' 00830818 +CBB** ********************** BBCHED0A **********************************00840818 +C**** 00850818 +C**** WRITE REPORT TITLE 00860818 +C**** 00870818 + WRITE (I02, 90002) 00880818 + WRITE (I02, 90006) 00890818 + WRITE (I02, 90007) 00900818 + WRITE (I02, 90008) ZVERS, ZVERSD 00910818 + WRITE (I02, 90009) ZPROG, ZPROG 00920818 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930818 +CBE** ********************** BBCHED0A **********************************00940818 +C***** 00950818 +C***** HEADER FOR SEGMENT 185 00960818 + WRITE(NUVI,18500) 00970818 +18500 FORMAT(" ", / " YDLG10 - (185) INTRINSIC FUNCTIONS" // 00980818 + 1 " DLOG10 (DOUBLE PRECISION COMMON LOGARITHM)" // 00990818 + 2 " ANS REF. - 15.3" ) 01000818 +CBB** ********************** BBCHED0B **********************************01010818 +C**** WRITE DETAIL REPORT HEADERS 01020818 +C**** 01030818 + WRITE (I02,90004) 01040818 + WRITE (I02,90004) 01050818 + WRITE (I02,90013) 01060818 + WRITE (I02,90014) 01070818 + WRITE (I02,90015) IVTOTL 01080818 +CBE** ********************** BBCHED0B **********************************01090818 +C***** 01100818 +CT001* TEST 1 ONE, SINCE LN(1.0) = 0.0 01110818 + IVTNUM = 1 01120818 + BVD = 1.0D0 01130818 + AVD = DLOG10(BVD) 01140818 + IF (AVD + 0.5000000000D-09) 20010, 10010, 40010 01150818 +40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010 01160818 +10010 IVPASS = IVPASS + 1 01170818 + WRITE (NUVI, 80002) IVTNUM 01180818 + GO TO 0011 01190818 +20010 IVFAIL = IVFAIL + 1 01200818 + DVCORR = 0.00000000000000000000D+00 01210818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01220818 + 0011 CONTINUE 01230818 +CT002* TEST 2 A VALUE CLOSE TO 10 01240818 + IVTNUM = 2 01250818 + AVD = DLOG10(9.875D0) 01260818 + IF (AVD - 0.9945371038D+00) 20020, 10020, 40020 01270818 +40020 IF (AVD - 0.9945371048D+00) 10020, 10020, 20020 01280818 +10020 IVPASS = IVPASS + 1 01290818 + WRITE (NUVI, 80002) IVTNUM 01300818 + GO TO 0021 01310818 +20020 IVFAIL = IVFAIL + 1 01320818 + DVCORR = 0.99453710429849784235D+00 01330818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01340818 + 0021 CONTINUE 01350818 +CT003* TEST 3 THE VALUE 10.D0 01360818 + IVTNUM = 3 01370818 + AVD = DLOG10(10.0D0) 01380818 + IF (AVD - 0.9999999995D+00) 20030, 10030, 40030 01390818 +40030 IF (AVD - 0.1000000001D+01) 10030, 10030, 20030 01400818 +10030 IVPASS = IVPASS + 1 01410818 + WRITE (NUVI, 80002) IVTNUM 01420818 + GO TO 0031 01430818 +20030 IVFAIL = IVFAIL + 1 01440818 + DVCORR = 1.0000000000000000000D+00 01450818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01460818 + 0031 CONTINUE 01470818 +CT004* TEST 4 THE VALUE 20.5D0 01480818 + IVTNUM = 4 01490818 + AVD = DLOG10(20.5D0) 01500818 + IF (AVD - 0.1311753860D+01) 20040, 10040, 40040 01510818 +40040 IF (AVD - 0.1311753862D+01) 10040, 10040, 20040 01520818 +10040 IVPASS = IVPASS + 1 01530818 + WRITE (NUVI, 80002) IVTNUM 01540818 + GO TO 0041 01550818 +20040 IVFAIL = IVFAIL + 1 01560818 + DVCORR = 1.3117538610557542993D+00 01570818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01580818 + 0041 CONTINUE 01590818 +CT005* TEST 5 THE VALUE 99.0D0 01600818 + IVTNUM = 5 01610818 + AVD = DLOG10(99.0D0) 01620818 + IF (AVD - 0.1995635193D+01) 20050, 10050, 40050 01630818 +40050 IF (AVD - 0.1995635196D+01) 10050, 10050, 20050 01640818 +10050 IVPASS = IVPASS + 1 01650818 + WRITE (NUVI, 80002) IVTNUM 01660818 + GO TO 0051 01670818 +20050 IVFAIL = IVFAIL + 1 01680818 + DVCORR = 1.9956351945975499153D+00 01690818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01700818 + 0051 CONTINUE 01710818 +CT006* TEST 6 VARIABLE WITHIN AN EXPRESSION 01720818 + IVTNUM = 6 01730818 + BVD = 1.0D0 01740818 + CVD = 8.0D0 01750818 + AVD = DLOG10(3.0D0 * BVD / CVD) 01760818 + IF (AVD + 0.4259687325D+00) 20060, 10060, 40060 01770818 +40060 IF (AVD + 0.4259687320D+00) 10060, 10060, 20060 01780818 +10060 IVPASS = IVPASS + 1 01790818 + WRITE (NUVI, 80002) IVTNUM 01800818 + GO TO 0061 01810818 +20060 IVFAIL = IVFAIL + 1 01820818 + DVCORR = -0.42596873227228114835D+00 01830818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01840818 + 0061 CONTINUE 01850818 +CT007* TEST 7 VARIABLE WITHIN AN EXPRESSION 01860818 + IVTNUM = 7 01870818 + BVD = 1.0D0 01880818 + CVD = 8.0D0 01890818 + AVD = DLOG10(5.0D0 * BVD / CVD) 01900818 + IF (AVD + 0.2041199828D+00) 20070, 10070, 40070 01910818 +40070 IF (AVD + 0.2041199825D+00) 10070, 10070, 20070 01920818 +10070 IVPASS = IVPASS + 1 01930818 + WRITE (NUVI, 80002) IVTNUM 01940818 + GO TO 0071 01950818 +20070 IVFAIL = IVFAIL + 1 01960818 + DVCORR = -0.20411998265592478085D+00 01970818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01980818 + 0071 CONTINUE 01990818 +CT008* TEST 8 AN EXPRESSION SUPPLIED TO DLOG10 02000818 + IVTNUM = 8 02010818 + AVD = DLOG10(75.D0 / 100.0D0) 02020818 + IF (AVD + 0.1249387367D+00) 20080, 10080, 40080 02030818 +40080 IF (AVD + 0.1249387365D+00) 10080, 10080, 20080 02040818 +10080 IVPASS = IVPASS + 1 02050818 + WRITE (NUVI, 80002) IVTNUM 02060818 + GO TO 0081 02070818 +20080 IVFAIL = IVFAIL + 1 02080818 + DVCORR = -0.12493873660829995313D+00 02090818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02100818 + 0081 CONTINUE 02110818 +CT009* TEST 9 VARIABLE WITHIN AN EXPRESSION 02120818 + IVTNUM = 9 02130818 + BVD = 1.0D0 02140818 + CVD = 8.0D0 02150818 + AVD = DLOG10(7.0D0 * BVD / CVD) 02160818 + IF (AVD + 0.5799194701D-01) 20090, 10090, 40090 02170818 +40090 IF (AVD + 0.5799194694D-01) 10090, 10090, 20090 02180818 +10090 IVPASS = IVPASS + 1 02190818 + WRITE (NUVI, 80002) IVTNUM 02200818 + GO TO 0091 02210818 +20090 IVFAIL = IVFAIL + 1 02220818 + DVCORR = -0.057991946977686754929D+00 02230818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02240818 + 0091 CONTINUE 02250818 +CT010* TEST 10 A VALUE CLOSE TO ONE 02260818 + IVTNUM = 10 02270818 + AVD = DLOG10(0.9921875D0) 02280818 + IF (AVD + 0.3406248694D-02) 20100, 10100, 40100 02290818 +40100 IF (AVD + 0.3406248690D-02) 10100, 10100, 20100 02300818 +10100 IVPASS = IVPASS + 1 02310818 + WRITE (NUVI, 80002) IVTNUM 02320818 + GO TO 0101 02330818 +20100 IVFAIL = IVFAIL + 1 02340818 + DVCORR = -0.0034062486919115022492D+00 02350818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02360818 + 0101 CONTINUE 02370818 +CT012* TEST 11 A VALUE CLOSE TO ZERO 02510818 + IVTNUM = 11 02520818 + BVD = 256.0D0 02530818 + AVD = DLOG10(1.0D0 / BVD) 02540818 + IF (AVD + 0.2408239967D+01) 20120, 10120, 40120 02550818 +40120 IF (AVD + 0.2408239964D+01) 10120, 10120, 20120 02560818 +10120 IVPASS = IVPASS + 1 02570818 + WRITE (NUVI, 80002) IVTNUM 02580818 + GO TO 0121 02590818 +20120 IVFAIL = IVFAIL + 1 02600818 + DVCORR = -2.4082399653118495617D+00 02610818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02620818 + 0121 CONTINUE 02630818 +CT013* TEST 12 A VALUE CLOSE TO ZERO 02640818 + IVTNUM = 12 02650818 + BVD = 128.0D0 02660818 + AVD = DLOG10(1.0D0 / (BVD * 8D0)) 02670818 + IF (AVD + 0.3010299959D+01) 20130, 10130, 40130 02680818 +40130 IF (AVD + 0.3010299955D+01) 10130, 10130, 20130 02690818 +10130 IVPASS = IVPASS + 1 02700818 + WRITE (NUVI, 80002) IVTNUM 02710818 + GO TO 0131 02720818 +20130 IVFAIL = IVFAIL + 1 02730818 + DVCORR = -3.0102999566398119521D+00 02740818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02750818 + 0131 CONTINUE 02760818 +CT014* TEST 13 AN ARGUMENT OF HIGH MAGNITUDE 02770818 + IVTNUM = 13 02780818 + BVD = 2.0D+35 02790818 + AVD = DLOG10(BVD) 02800818 + IF (AVD - 0.3530102997D+01) 20140, 10140, 40140 02810818 +40140 IF (AVD - 0.3530103002D+02) 10140, 10140, 20140 02820818 +10140 IVPASS = IVPASS + 1 02830818 + WRITE (NUVI, 80002) IVTNUM 02840818 + GO TO 0141 02850818 +20140 IVFAIL = IVFAIL + 1 02860818 + DVCORR = 35.301029995663981195D+00 02870818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02880818 + 0141 CONTINUE 02890818 +CT015* TEST 14 AN ARGUMENT OF LOW MAGNITUDE 02900818 + IVTNUM = 14 02910818 + BVD = 2.0D-35 02920818 + AVD = DLOG10(BVD) 02930818 + IF (AVD + 0.3469897003D+02) 20150, 10150, 40150 02940818 +40150 IF (AVD + 0.3469896998D+02) 10150, 10150, 20150 02950818 +10150 IVPASS = IVPASS + 1 02960818 + WRITE (NUVI, 80002) IVTNUM 02970818 + GO TO 0151 02980818 +20150 IVFAIL = IVFAIL + 1 02990818 + DVCORR = -34.698970004336018805D+00 03000818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03010818 + 0151 CONTINUE 03020818 +CT016* TEST 15 THE FUNCTION APPIED TWICE 03030818 + IVTNUM = 15 03040818 + AVD = DLOG10(20.0D0) - DLOG10(2.0D0) 03050818 + IF (AVD - 0.9999999995D+00) 20160, 10160, 40160 03060818 +40160 IF (AVD - 0.1000000001D+01) 10160, 10160, 20160 03070818 +10160 IVPASS = IVPASS + 1 03080818 + WRITE (NUVI, 80002) IVTNUM 03090818 + GO TO 0161 03100818 +20160 IVFAIL = IVFAIL + 1 03110818 + DVCORR = 1.00000000000000D+00 03120818 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03130818 + 0161 CONTINUE 03140818 +C***** 03150818 +CBB** ********************** BBCSUM0 **********************************03160818 +C**** WRITE OUT TEST SUMMARY 03170818 +C**** 03180818 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03190818 + WRITE (I02, 90004) 03200818 + WRITE (I02, 90014) 03210818 + WRITE (I02, 90004) 03220818 + WRITE (I02, 90020) IVPASS 03230818 + WRITE (I02, 90022) IVFAIL 03240818 + WRITE (I02, 90024) IVDELE 03250818 + WRITE (I02, 90026) IVINSP 03260818 + WRITE (I02, 90028) IVTOTN, IVTOTL 03270818 +CBE** ********************** BBCSUM0 **********************************03280818 +CBB** ********************** BBCFOOT0 **********************************03290818 +C**** WRITE OUT REPORT FOOTINGS 03300818 +C**** 03310818 + WRITE (I02,90016) ZPROG, ZPROG 03320818 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03330818 + WRITE (I02,90019) 03340818 +CBE** ********************** BBCFOOT0 **********************************03350818 +CBB** ********************** BBCFMT0A **********************************03360818 +C**** FORMATS FOR TEST DETAIL LINES 03370818 +C**** 03380818 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03390818 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03400818 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03410818 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03420818 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03430818 + 1I6,/," ",15X,"CORRECT= " ,I6) 03440818 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03450818 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03460818 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03470818 + 1A21,/," ",16X,"CORRECT= " ,A21) 03480818 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03490818 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03500818 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03510818 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03520818 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03530818 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03540818 +80050 FORMAT (" ",48X,A31) 03550818 +CBE** ********************** BBCFMT0A **********************************03560818 +CBB** ********************** BBCFMAT1 **********************************03570818 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03580818 +C**** 03590818 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03600818 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03610818 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03620818 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03630818 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03640818 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03650818 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03660818 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03670818 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03680818 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03690818 + 2"(",F12.5,", ",F12.5,")") 03700818 +CBE** ********************** BBCFMAT1 **********************************03710818 +CBB** ********************** BBCFMT0B **********************************03720818 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03730818 +C**** 03740818 +90002 FORMAT ("1") 03750818 +90004 FORMAT (" ") 03760818 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03770818 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03780818 +90008 FORMAT (" ",21X,A13,A17) 03790818 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03800818 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03810818 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03820818 + 1 7X,"REMARKS",24X) 03830818 +90014 FORMAT (" ","----------------------------------------------" , 03840818 + 1 "---------------------------------" ) 03850818 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03860818 +C**** 03870818 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03880818 +C**** 03890818 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03900818 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03910818 + 1 A13) 03920818 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03930818 +C**** 03940818 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03950818 +C**** 03960818 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03970818 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03980818 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03990818 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04000818 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04010818 +CBE** ********************** BBCFMT0B **********************************04020818 +C***** END OF TEST SEGMENT 185 04030818 + STOP 04040818 + END 04050818 + 04060818 diff --git a/Fortran/UnitTests/fcvs21_f95/FM818.reference_output b/Fortran/UnitTests/fcvs21_f95/FM818.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM818.reference_output @@ -0,0 +1,49 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM818BEGIN* TEST RESULTS - FM818 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDLG10 - (185) INTRINSIC FUNCTIONS + + DLOG10 (DOUBLE PRECISION COMMON LOGARITHM) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 15 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + + ------------------------------------------------------------------------------- + + 15 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 15 OF 15 TESTS EXECUTED + + *FM818END* END OF TEST - FM818 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM819.f b/Fortran/UnitTests/fcvs21_f95/FM819.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM819.f @@ -0,0 +1,448 @@ + PROGRAM FM819 + +C***********************************************************************00010819 +C***** FORTRAN 77 00020819 +C***** FM819 00030819 +C***** YDSIN - (187) 00040819 +C***** 00050819 +C***********************************************************************00060819 +C***** GENERAL PURPOSE ANS REF 00070819 +C***** TEST INTRINSIC FUNCTION DSIN 15.3 00080819 +C***** TABLE 5 00090819 +C***** 00100819 +CBB** ********************** BBCCOMNT **********************************00110819 +C**** 00120819 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130819 +C**** VERSION 2.1 00140819 +C**** 00150819 +C**** 00160819 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170819 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180819 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190819 +C**** BUILDING 225 RM A266 00200819 +C**** GAITHERSBURG, MD 20899 00210819 +C**** 00220819 +C**** 00230819 +C**** 00240819 +CBE** ********************** BBCCOMNT **********************************00250819 +C***** S P E C I F I C A T I O N S SEGMENT 187 00260819 + DOUBLE PRECISION AVD, BVD, PIVD, DVCORR 00270819 +C***** 00280819 +CBB** ********************** BBCINITA **********************************00290819 +C**** SPECIFICATION STATEMENTS 00300819 +C**** 00310819 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320819 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330819 +CBE** ********************** BBCINITA **********************************00340819 +CBB** ********************** BBCINITB **********************************00350819 +C**** INITIALIZE SECTION 00360819 + DATA ZVERS, ZVERSD, ZDATE 00370819 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380819 + DATA ZCOMPL, ZNAME, ZTAPE 00390819 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400819 + DATA ZPROJ, ZTAPED, ZPROG 00410819 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420819 + DATA REMRKS /' '/ 00430819 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440819 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450819 +C**** 00460819 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470819 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480819 +CZ03 ZPROG = 'PROGRAM NAME' 00490819 +CZ04 ZDATE = 'DATE OF TEST' 00500819 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510819 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520819 +CZ07 ZNAME = 'NAME OF USER' 00530819 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540819 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550819 +C 00560819 + IVPASS = 0 00570819 + IVFAIL = 0 00580819 + IVDELE = 0 00590819 + IVINSP = 0 00600819 + IVTOTL = 0 00610819 + IVTOTN = 0 00620819 + ICZERO = 0 00630819 +C 00640819 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650819 + I01 = 05 00660819 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670819 + I02 = 06 00680819 +C 00690819 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700819 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710819 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720819 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730819 +C 00740819 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750819 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760819 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770819 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780819 +C 00790819 +CBE** ********************** BBCINITB **********************************00800819 + NUVI = I02 00810819 + IVTOTL = 19 00820819 + ZPROG = 'FM819' 00830819 +CBB** ********************** BBCHED0A **********************************00840819 +C**** 00850819 +C**** WRITE REPORT TITLE 00860819 +C**** 00870819 + WRITE (I02, 90002) 00880819 + WRITE (I02, 90006) 00890819 + WRITE (I02, 90007) 00900819 + WRITE (I02, 90008) ZVERS, ZVERSD 00910819 + WRITE (I02, 90009) ZPROG, ZPROG 00920819 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930819 +CBE** ********************** BBCHED0A **********************************00940819 +C***** 00950819 +C***** HEADER FOR SEGMENT 187 00960819 + WRITE(NUVI,18700) 00970819 +18700 FORMAT(" "/" YDSIN - (187) INTRINSIC FUNCTIONS" // 00980819 + 1 " DSIN - (DOUBLE PRECISION SINE)" // 00990819 + 2 " ANS REF. - 15.3" ) 01000819 +CBB** ********************** BBCHED0B **********************************01010819 +C**** WRITE DETAIL REPORT HEADERS 01020819 +C**** 01030819 + WRITE (I02,90004) 01040819 + WRITE (I02,90004) 01050819 + WRITE (I02,90013) 01060819 + WRITE (I02,90014) 01070819 + WRITE (I02,90015) IVTOTL 01080819 +CBE** ********************** BBCHED0B **********************************01090819 +C***** 01100819 + PIVD = 3.1415926535897932384626434D0 01110819 +C***** 01120819 +CT001* TEST 1 ZERO (0.0) SINCE SIN(0)=0 01130819 + IVTNUM = 1 01140819 + BVD = 0.0D0 01150819 + AVD = DSIN(BVD) 01160819 + IF (AVD + 0.5000000000D-09) 20010, 10010, 40010 01170819 +40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010 01180819 +10010 IVPASS = IVPASS + 1 01190819 + WRITE (NUVI, 80002) IVTNUM 01200819 + GO TO 0011 01210819 +20010 IVFAIL = IVFAIL + 1 01220819 + DVCORR = 0.00000000000000000000D+00 01230819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01240819 + 0011 CONTINUE 01250819 +CT002* TEST 2 PI 01260819 + IVTNUM = 2 01270819 + AVD = DSIN(PIVD) 01280819 + IF (AVD + 0.5000000000D-09) 20020, 10020, 40020 01290819 +40020 IF (AVD - 0.5000000000D-09) 10020, 10020, 20020 01300819 +10020 IVPASS = IVPASS + 1 01310819 + WRITE (NUVI, 80002) IVTNUM 01320819 + GO TO 0021 01330819 +20020 IVFAIL = IVFAIL + 1 01340819 + DVCORR = 0.00000000000000000000D+00 01350819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01360819 + 0021 CONTINUE 01370819 +CT003* TEST 3 PI - 1/8 01380819 + IVTNUM = 3 01390819 + BVD = 3.01659265358979323846D0 01400819 + AVD = DSIN(BVD) 01410819 + IF (AVD - 0.1246747333D+00) 20030, 10030, 40030 01420819 +40030 IF (AVD - 0.1246747335D+00) 10030, 10030, 20030 01430819 +10030 IVPASS = IVPASS + 1 01440819 + WRITE (NUVI, 80002) IVTNUM 01450819 + GO TO 0031 01460819 +20030 IVFAIL = IVFAIL + 1 01470819 + DVCORR = 0.12467473338522768996D+00 01480819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01490819 + 0031 CONTINUE 01500819 +CT004* TEST 4 PI - 1/16 01510819 + IVTNUM = 4 01520819 + AVD = DSIN(3.204092653589793238D0) 01530819 + IF (AVD + 0.6245931788D-01) 20040, 10040, 40040 01540819 +40040 IF (AVD + 0.6245931781D-01) 10040, 10040, 20040 01550819 +10040 IVPASS = IVPASS + 1 01560819 + WRITE (NUVI, 80002) IVTNUM 01570819 + GO TO 0041 01580819 +20040 IVFAIL = IVFAIL + 1 01590819 + DVCORR = -0.062459317842380198585D+00 01600819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01610819 + 0041 CONTINUE 01620819 +CT005* TEST 5 2*PI 01630819 + IVTNUM = 5 01640819 + BVD = PIVD * 2.0D0 01650819 + AVD = DSIN(BVD) 01660819 + IF (AVD + 0.5000000000D-09) 20050, 10050, 40050 01670819 +40050 IF (AVD - 0.5000000000D-09) 10050, 10050, 20050 01680819 +10050 IVPASS = IVPASS + 1 01690819 + WRITE (NUVI, 80002) IVTNUM 01700819 + GO TO 0051 01710819 +20050 IVFAIL = IVFAIL + 1 01720819 + DVCORR = 0.00000000000000000000D+00 01730819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01740819 + 0051 CONTINUE 01750819 +CT006* TEST 6 2*PI - 1/128 01760819 + IVTNUM = 6 01770819 + BVD = (2.0D0 * PIVD) - 1.0D0 / 128.0D0 01780819 + AVD = DSIN(BVD) 01790819 + IF (AVD + 0.7812420532D-02) 20060, 10060, 40060 01800819 +40060 IF (AVD + 0.7812420523D-02) 10060, 10060, 20060 01810819 +10060 IVPASS = IVPASS + 1 01820819 + WRITE (NUVI, 80002) IVTNUM 01830819 + GO TO 0061 01840819 +20060 IVFAIL = IVFAIL + 1 01850819 + DVCORR = -0.0078124205273828310472D+00 01860819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01870819 + 0061 CONTINUE 01880819 +CT007* TEST 7 2*PI - 1/256 01890819 + IVTNUM = 7 01900819 + BVD = (2.0D0 * PIVD) + 1.0D0 / 256.0D0 01910819 + AVD = DSIN(BVD) 01920819 + IF (AVD - 0.3906240064D-02) 20070, 10070, 40070 01930819 +40070 IF (AVD - 0.3906240068D-02) 10070, 10070, 20070 01940819 +10070 IVPASS = IVPASS + 1 01950819 + WRITE (NUVI, 80002) IVTNUM 01960819 + GO TO 0071 01970819 +20070 IVFAIL = IVFAIL + 1 01980819 + DVCORR = 0.0039062400659001165547D+00 01990819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02000819 + 0071 CONTINUE 02010819 +CT008* TEST 8 AN EXPRESSION SUPPLIED TO DSIN 02020819 + IVTNUM = 8 02030819 + BVD = 2000.0D0 02040819 + AVD = DSIN(BVD / 10.0D2) 02050819 + IF (AVD - 0.9092974263D+00) 20080, 10080, 40080 02060819 +40080 IF (AVD - 0.9092974273D+00) 10080, 10080, 20080 02070819 +10080 IVPASS = IVPASS + 1 02080819 + WRITE (NUVI, 80002) IVTNUM 02090819 + GO TO 0081 02100819 +20080 IVFAIL = IVFAIL + 1 02110819 + DVCORR = 0.90929742682568169540D+00 02120819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02130819 + 0081 CONTINUE 02140819 +CT009* TEST 9 THE VALUE -2.0D0 02150819 + IVTNUM = 9 02160819 + BVD = -2.0D0 02170819 + AVD = DSIN(BVD) 02180819 + IF (AVD + 0.9092974273D+00) 20090, 10090, 40090 02190819 +40090 IF (AVD + 0.9092974263D+00) 10090, 10090, 20090 02200819 +10090 IVPASS = IVPASS + 1 02210819 + WRITE (NUVI, 80002) IVTNUM 02220819 + GO TO 0091 02230819 +20090 IVFAIL = IVFAIL + 1 02240819 + DVCORR = -0.90929742682568169540D+00 02250819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02260819 + 0091 CONTINUE 02270819 +CT010* TEST 10 A LARGE VALUE TO TEST ARGUMENT REDUCTION 02280819 + IVTNUM = 10 02290819 + AVD = DSIN(100.0D0) 02300819 + IF (AVD + 0.5063656414D+00) 20100, 10100, 40100 02310819 +40100 IF (AVD + 0.5063656408D+00) 10100, 10100, 20100 02320819 +10100 IVPASS = IVPASS + 1 02330819 + WRITE (NUVI, 80002) IVTNUM 02340819 + GO TO 0101 02350819 +20100 IVFAIL = IVFAIL + 1 02360819 + DVCORR = -0.50636564110975879366D+00 02370819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02380819 + 0101 CONTINUE 02390819 +CT011* TEST 11 A VERY LARGE VALUE 02400819 + IVTNUM = 11 02410819 + AVD = DSIN(-1000.0D0) 02420819 + IF (AVD + 0.8268795410D+00) 20110, 10110, 40110 02430819 +40110 IF (AVD + 0.8268795401D+00) 10110, 10110, 20110 02440819 +10110 IVPASS = IVPASS + 1 02450819 + WRITE (NUVI, 80002) IVTNUM 02460819 + GO TO 0111 02470819 +20110 IVFAIL = IVFAIL + 1 02480819 + DVCORR = -0.82687954053200256026D+00 02490819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02500819 + 0111 CONTINUE 02510819 +CT012* TEST 12 PI/2 02520819 + IVTNUM = 12 02530819 + AVD = DSIN(1.57079632679489661923D0) 02540819 + IF (AVD - 0.9999999995D+00) 20120, 10120, 40120 02550819 +40120 IF (AVD - 0.1000000001D+01) 10120, 10120, 20120 02560819 +10120 IVPASS = IVPASS + 1 02570819 + WRITE (NUVI, 80002) IVTNUM 02580819 + GO TO 0121 02590819 +20120 IVFAIL = IVFAIL + 1 02600819 + DVCORR = 1.0000000000000000000D+00 02610819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02620819 + 0121 CONTINUE 02630819 +CT013* TEST 13 (PI / 2) - 1/32 02640819 + IVTNUM = 13 02650819 + BVD = 1.53954632679489661923D0 02660819 + AVD = DSIN(BVD) 02670819 + IF (AVD - 0.9995117579D+00) 20130, 10130, 40130 02680819 +40130 IF (AVD - 0.9995117590D+00) 10130, 10130, 20130 02690819 +10130 IVPASS = IVPASS + 1 02700819 + WRITE (NUVI, 80002) IVTNUM 02710819 + GO TO 0131 02720819 +20130 IVFAIL = IVFAIL + 1 02730819 + DVCORR = 0.99951175848513636924D+00 02740819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02750819 + 0131 CONTINUE 02760819 +CT014* TEST 14 (PI / 2) + 1/64 02770819 + IVTNUM = 14 02780819 + BVD = 1.58642132679489661923D0 02790819 + AVD = DSIN(BVD) 02800819 + IF (AVD - 0.9998779316D+00) 20140, 10140, 40140 02810819 +40140 IF (AVD - 0.9998779327D+00) 10140, 10140, 20140 02820819 +10140 IVPASS = IVPASS + 1 02830819 + WRITE (NUVI, 80002) IVTNUM 02840819 + GO TO 0141 02850819 +20140 IVFAIL = IVFAIL + 1 02860819 + DVCORR = 0.99987793217100665474D+00 02870819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02880819 + 0141 CONTINUE 02890819 +CT015* TEST 15 3*PI/2 02900819 + IVTNUM = 15 02910819 + BVD = 3.0D0 * PIVD / 2.0D0 02920819 + AVD = DSIN(BVD) 02930819 + IF (AVD + 0.1000000001D+01) 20150, 10150, 40150 02940819 +40150 IF (AVD + 0.9999999995D+00) 10150, 10150, 20150 02950819 +10150 IVPASS = IVPASS + 1 02960819 + WRITE (NUVI, 80002) IVTNUM 02970819 + GO TO 0151 02980819 +20150 IVFAIL = IVFAIL + 1 02990819 + DVCORR = -1.000000000000000000D+00 03000819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03010819 + 0151 CONTINUE 03020819 +CT016* TEST 16 3*PI/2 - 1/16 03030819 + IVTNUM = 16 03040819 + BVD = (3.0D0 * PIVD / 2.0D0) - 1.0D0 / 16.0D0 03050819 + AVD = DSIN(BVD) 03060819 + IF (AVD + 0.9980475112D+00) 20160, 10160, 40160 03070819 +40160 IF (AVD + 0.9980475102D+00) 10160, 10160, 20160 03080819 +10160 IVPASS = IVPASS + 1 03090819 + WRITE (NUVI, 80002) IVTNUM 03100819 + GO TO 0161 03110819 +20160 IVFAIL = IVFAIL + 1 03120819 + DVCORR = -0.99804751070009914963D+00 03130819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03140819 + 0161 CONTINUE 03150819 +CT017* TEST 17 3*PI - 1/512 03160819 + IVTNUM = 17 03170819 + BVD = (3.0D0 * PIVD / 2.0D0) + 1.0D0 / 512.0D0 03180819 + AVD = DSIN(BVD) 03190819 + IF (AVD + 0.9999980932D+00) 20170, 10170, 40170 03200819 +40170 IF (AVD + 0.9999980921D+00) 10170, 10170, 20170 03210819 +10170 IVPASS = IVPASS + 1 03220819 + WRITE (NUVI, 80002) IVTNUM 03230819 + GO TO 0171 03240819 +20170 IVFAIL = IVFAIL + 1 03250819 + DVCORR = -0.99999809265197351722D+00 03260819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03270819 + 0171 CONTINUE 03280819 +CT018* TEST 18 ARGUMENT OF LOW MAGNITUDE 03290819 + IVTNUM = 18 03300819 + BVD = PIVD * 1.0D-17 03310819 + AVD = DSIN(BVD) 03320819 + IF (AVD - 0.3141592652D-16) 20180, 10180, 40180 03330819 +40180 IF (AVD - 0.3141592655D-16) 10180, 10180, 20180 03340819 +10180 IVPASS = IVPASS + 1 03350819 + WRITE (NUVI, 80002) IVTNUM 03360819 + GO TO 0181 03370819 +20180 IVFAIL = IVFAIL + 1 03380819 + DVCORR = 3.1415926535897932385D-17 03390819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03400819 + 0181 CONTINUE 03410819 +CT019* TEST 19 THE FUNCTION APPLIED TWICE 03420819 + IVTNUM = 19 03430819 + AVD = DSIN(PIVD / 4.0D0) * DSIN(3.0D0 * PIVD / 4.0D0) 03440819 + IF (AVD - 0.4999999997D+00) 20190, 10190, 40190 03450819 +40190 IF (AVD - 0.5000000003D+00) 10190, 10190, 20190 03460819 +10190 IVPASS = IVPASS + 1 03470819 + WRITE (NUVI, 80002) IVTNUM 03480819 + GO TO 0191 03490819 +20190 IVFAIL = IVFAIL + 1 03500819 + DVCORR = 0.50000000000000000000D+00 03510819 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03520819 + 0191 CONTINUE 03530819 +C***** 03540819 +CBB** ********************** BBCSUM0 **********************************03550819 +C**** WRITE OUT TEST SUMMARY 03560819 +C**** 03570819 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03580819 + WRITE (I02, 90004) 03590819 + WRITE (I02, 90014) 03600819 + WRITE (I02, 90004) 03610819 + WRITE (I02, 90020) IVPASS 03620819 + WRITE (I02, 90022) IVFAIL 03630819 + WRITE (I02, 90024) IVDELE 03640819 + WRITE (I02, 90026) IVINSP 03650819 + WRITE (I02, 90028) IVTOTN, IVTOTL 03660819 +CBE** ********************** BBCSUM0 **********************************03670819 +CBB** ********************** BBCFOOT0 **********************************03680819 +C**** WRITE OUT REPORT FOOTINGS 03690819 +C**** 03700819 + WRITE (I02,90016) ZPROG, ZPROG 03710819 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03720819 + WRITE (I02,90019) 03730819 +CBE** ********************** BBCFOOT0 **********************************03740819 +CBB** ********************** BBCFMT0A **********************************03750819 +C**** FORMATS FOR TEST DETAIL LINES 03760819 +C**** 03770819 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03780819 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03790819 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03800819 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03810819 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03820819 + 1I6,/," ",15X,"CORRECT= " ,I6) 03830819 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03840819 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03850819 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03860819 + 1A21,/," ",16X,"CORRECT= " ,A21) 03870819 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03880819 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03890819 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03900819 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03910819 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03920819 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03930819 +80050 FORMAT (" ",48X,A31) 03940819 +CBE** ********************** BBCFMT0A **********************************03950819 +CBB** ********************** BBCFMAT1 **********************************03960819 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03970819 +C**** 03980819 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03990819 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04000819 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04010819 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04020819 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04030819 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04040819 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04050819 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04060819 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04070819 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04080819 + 2"(",F12.5,", ",F12.5,")") 04090819 +CBE** ********************** BBCFMAT1 **********************************04100819 +CBB** ********************** BBCFMT0B **********************************04110819 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04120819 +C**** 04130819 +90002 FORMAT ("1") 04140819 +90004 FORMAT (" ") 04150819 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04160819 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04170819 +90008 FORMAT (" ",21X,A13,A17) 04180819 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04190819 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04200819 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04210819 + 1 7X,"REMARKS",24X) 04220819 +90014 FORMAT (" ","----------------------------------------------" , 04230819 + 1 "---------------------------------" ) 04240819 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04250819 +C**** 04260819 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04270819 +C**** 04280819 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04290819 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04300819 + 1 A13) 04310819 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04320819 +C**** 04330819 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04340819 +C**** 04350819 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04360819 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04370819 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04380819 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04390819 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04400819 +CBE** ********************** BBCFMT0B **********************************04410819 +C***** 04420819 +C***** END OF TEST SEGMENT 187 04430819 + STOP 04440819 + END 04450819 + 04460819 diff --git a/Fortran/UnitTests/fcvs21_f95/FM819.reference_output b/Fortran/UnitTests/fcvs21_f95/FM819.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM819.reference_output @@ -0,0 +1,53 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM819BEGIN* TEST RESULTS - FM819 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDSIN - (187) INTRINSIC FUNCTIONS + + DSIN - (DOUBLE PRECISION SINE) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 19 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + + ------------------------------------------------------------------------------- + + 19 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 19 OF 19 TESTS EXECUTED + + *FM819END* END OF TEST - FM819 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM820.f b/Fortran/UnitTests/fcvs21_f95/FM820.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM820.f @@ -0,0 +1,480 @@ + PROGRAM FM820 + +C***********************************************************************00010820 +C***** FORTRAN 77 00020820 +C***** FM820 00030820 +C***** YCSIN - (188) 00040820 +C***** 00050820 +C***********************************************************************00060820 +C***** GENERAL PURPOSE ANS REF 00070820 +C***** TEST INTRINSIC FUNCTION CSIN 15.3 00080820 +C***** INTRINSIC FUNCTION CABS ASSUMED WORKING TABLE 5 00090820 +C***** 00100820 +CBB** ********************** BBCCOMNT **********************************00110820 +C**** 00120820 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130820 +C**** VERSION 2.1 00140820 +C**** 00150820 +C**** 00160820 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170820 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180820 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190820 +C**** BUILDING 225 RM A266 00200820 +C**** GAITHERSBURG, MD 20899 00210820 +C**** 00220820 +C**** 00230820 +C**** 00240820 +CBE** ********************** BBCCOMNT **********************************00250820 +C***** 00260820 +C***** S P E C I F I C A T I O N S SEGMENT 188 00270820 + COMPLEX AVC, BVC, ZVCORR 00280820 + REAL R2E(2) 00290820 + EQUIVALENCE (AVC, R2E) 00300820 +C***** 00310820 +CBB** ********************** BBCINITA **********************************00320820 +C**** SPECIFICATION STATEMENTS 00330820 +C**** 00340820 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350820 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360820 +CBE** ********************** BBCINITA **********************************00370820 +CBB** ********************** BBCINITB **********************************00380820 +C**** INITIALIZE SECTION 00390820 + DATA ZVERS, ZVERSD, ZDATE 00400820 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410820 + DATA ZCOMPL, ZNAME, ZTAPE 00420820 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430820 + DATA ZPROJ, ZTAPED, ZPROG 00440820 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450820 + DATA REMRKS /' '/ 00460820 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470820 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480820 +C**** 00490820 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500820 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510820 +CZ03 ZPROG = 'PROGRAM NAME' 00520820 +CZ04 ZDATE = 'DATE OF TEST' 00530820 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540820 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550820 +CZ07 ZNAME = 'NAME OF USER' 00560820 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570820 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580820 +C 00590820 + IVPASS = 0 00600820 + IVFAIL = 0 00610820 + IVDELE = 0 00620820 + IVINSP = 0 00630820 + IVTOTL = 0 00640820 + IVTOTN = 0 00650820 + ICZERO = 0 00660820 +C 00670820 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680820 + I01 = 05 00690820 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700820 + I02 = 06 00710820 +C 00720820 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730820 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740820 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750820 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760820 +C 00770820 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780820 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790820 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800820 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810820 +C 00820820 +CBE** ********************** BBCINITB **********************************00830820 + NUVI = I02 00840820 + IVTOTL = 18 00850820 + ZPROG = 'FM820' 00860820 +CBB** ********************** BBCHED0A **********************************00870820 +C**** 00880820 +C**** WRITE REPORT TITLE 00890820 +C**** 00900820 + WRITE (I02, 90002) 00910820 + WRITE (I02, 90006) 00920820 + WRITE (I02, 90007) 00930820 + WRITE (I02, 90008) ZVERS, ZVERSD 00940820 + WRITE (I02, 90009) ZPROG, ZPROG 00950820 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960820 +CBE** ********************** BBCHED0A **********************************00970820 +C***** 00980820 +C***** HEADER FOR SEGMENT 188 00990820 + WRITE(NUVI,18800) 01000820 +18800 FORMAT(" "/" YCSIN - (188) INTRINSIC FUNCTIONS" // 01010820 + 1 " CSIN, CCOS (COMPLEX SINE, COSINE)" // 01020820 + 2 " ANS REF. - 15.3" ) 01030820 +CBB** ********************** BBCHED0B **********************************01040820 +C**** WRITE DETAIL REPORT HEADERS 01050820 +C**** 01060820 + WRITE (I02,90004) 01070820 + WRITE (I02,90004) 01080820 + WRITE (I02,90013) 01090820 + WRITE (I02,90014) 01100820 + WRITE (I02,90015) IVTOTL 01110820 +CBE** ********************** BBCHED0B **********************************01120820 +C***** 01130820 + WRITE(NUVI, 18801) 01140820 +18801 FORMAT(/ 8X, "TEST OF CSIN" ) 01150820 +C***** 01160820 +CT001* TEST 1 TEST AT ZERO (0.0, 0.0) 01170820 + IVTNUM = 1 01180820 + AVC = CSIN(( 0.0, 0.0)) 01190820 + IF (R2E(1) + 0.50000E-04) 20010, 40012, 40011 01200820 +40011 IF (R2E(1) - 0.50000E-04) 40012, 40012, 20010 01210820 +40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010 01220820 +40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010 01230820 +10010 IVPASS = IVPASS + 1 01240820 + WRITE (NUVI, 80002) IVTNUM 01250820 + GO TO 0011 01260820 +20010 IVFAIL = IVFAIL + 1 01270820 + ZVCORR = (0.00000000000000, 0.00000000000000) 01280820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01290820 + 0011 CONTINUE 01300820 +CT002* TEST 2 TEST SIN ON THE REAL LINE, CSIN SAME AS SIN 01310820 + IVTNUM = 2 01320820 + AVC = CSIN(( 2.0, 0.0)) 01330820 + IF (R2E(1) - 0.90925E+00) 20020, 40022, 40021 01340820 +40021 IF (R2E(1) - 0.90935E+00) 40022, 40022, 20020 01350820 +40022 IF (R2E(2) + 0.50000E-04) 20020, 10020, 40020 01360820 +40020 IF (R2E(2) - 0.50000E-04) 10020, 10020, 20020 01370820 +10020 IVPASS = IVPASS + 1 01380820 + WRITE (NUVI, 80002) IVTNUM 01390820 + GO TO 0021 01400820 +20020 IVFAIL = IVFAIL + 1 01410820 + ZVCORR = (0.90929742682568, 0.00000000000000) 01420820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01430820 + 0021 CONTINUE 01440820 +CT003* TEST 3 TEST SIN ON THE REAL LINE, CSIN SAME AS SIN 01450820 + IVTNUM = 3 01460820 + AVC = CSIN(( -1000.0, 0.0)) 01470820 + IF (R2E(1) + 0.82692E+00) 20030, 40032, 40031 01480820 +40031 IF (R2E(1) + 0.82683E+00) 40032, 40032, 20030 01490820 +40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030 01500820 +40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030 01510820 +10030 IVPASS = IVPASS + 1 01520820 + WRITE (NUVI, 80002) IVTNUM 01530820 + GO TO 0031 01540820 +20030 IVFAIL = IVFAIL + 1 01550820 + ZVCORR = (-0.82687954053200, 0.00000000000000) 01560820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01570820 + 0031 CONTINUE 01580820 +CT004* TEST 4 EXPRESSION PRESENTED TO CSIN 01590820 + IVTNUM = 4 01600820 + AVC = CSIN(( 150.0, 350.0) / (100.0, 0.0)) 01610820 + IF (R2E(1) - 0.16530E+02) 20040, 40042, 40041 01620820 +40041 IF (R2E(1) - 0.16533E+02) 40042, 40042, 20040 01630820 +40042 IF (R2E(2) - 0.11701E+01) 20040, 10040, 40040 01640820 +40040 IF (R2E(2) - 0.11703E+01) 10040, 10040, 20040 01650820 +10040 IVPASS = IVPASS + 1 01660820 + WRITE (NUVI, 80002) IVTNUM 01670820 + GO TO 0041 01680820 +20040 IVFAIL = IVFAIL + 1 01690820 + ZVCORR = (16.531309523248, 1.1701791625591) 01700820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01710820 + 0041 CONTINUE 01720820 +CT005* TEST 5 VARIABLE PRESENTED TO CSIN 01730820 + IVTNUM = 5 01740820 + BVC = ( 4.75, 2.50) - (9.50, 1.25) 01750820 + AVC = CSIN(BVC) 01760820 + IF (R2E(1) - 0.18870E+01) 20050, 40052, 40051 01770820 +40051 IF (R2E(1) - 0.18872E+01) 40052, 40052, 20050 01780820 +40052 IF (R2E(2) - 0.60232E-01) 20050, 10050, 40050 01790820 +40050 IF (R2E(2) - 0.60239E-01) 10050, 10050, 20050 01800820 +10050 IVPASS = IVPASS + 1 01810820 + WRITE (NUVI, 80002) IVTNUM 01820820 + GO TO 0051 01830820 +20050 IVFAIL = IVFAIL + 1 01840820 + ZVCORR = (1.8870883629759, 0.060235606171638) 01850820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01860820 + 0051 CONTINUE 01870820 +CT006* TEST 6 VARIABLE PRESENTED TO CSIN 01880820 + IVTNUM = 6 01890820 + BVC = ( 0.125, 2.0) * (10.0, 0.0) 01900820 + AVC = CSIN(BVC) 01910820 + IF (R2E(1) - 0.23019E+09) 20060, 40062, 40061 01920820 +40061 IF (R2E(1) - 0.23022E+09) 40062, 40062, 20060 01930820 +40062 IF (R2E(2) - 0.76487E+08) 20060, 10060, 40060 01940820 +40060 IF (R2E(2) - 0.76496E+08) 10060, 10060, 20060 01950820 +10060 IVPASS = IVPASS + 1 01960820 + WRITE (NUVI, 80002) IVTNUM 01970820 + GO TO 0061 01980820 +20060 IVFAIL = IVFAIL + 1 01990820 + ZVCORR = (230207154.14527, 76491717.784289) 02000820 + WRITE (NUVI, 80145) IVTNUM, AVC, ZVCORR 02010820 +80145 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED: " , 02020820 + 1 "(",E12.5,", ",E12.5,")"/," ",16X,"CORRECT: " , 02030820 + 2 "(",E12.5,", ",E12.5,")") 02040820 + 0061 CONTINUE 02050820 +CT007* TEST 7 TEST WHERE REAL IS ZERO 02060820 + IVTNUM = 7 02070820 + BVC = ( 0.0, 1.0) 02080820 + AVC = CSIN(BVC) 02090820 + IF (R2E(1) + 0.50000E-04) 20070, 40072, 40071 02100820 +40071 IF (R2E(1) - 0.50000E-04) 40072, 40072, 20070 02110820 +40072 IF (R2E(2) - 0.11751E+01) 20070, 10070, 40070 02120820 +40070 IF (R2E(2) - 0.11753E+01) 10070, 10070, 20070 02130820 +10070 IVPASS = IVPASS + 1 02140820 + WRITE (NUVI, 80002) IVTNUM 02150820 + GO TO 0071 02160820 +20070 IVFAIL = IVFAIL + 1 02170820 + ZVCORR = (0.00000000000000, 1.1752011936438) 02180820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02190820 + 0071 CONTINUE 02200820 +CT008* TEST 8 TEST WHERE REAL IS ZERO 02210820 + IVTNUM = 8 02220820 + BVC = ( 0.0, -4.75) 02230820 + AVC = CSIN(BVC) 02240820 + IF (R2E(1) + 0.50000E-04) 20080, 40082, 40081 02250820 +40081 IF (R2E(1) - 0.50000E-04) 40082, 40082, 20080 02260820 +40082 IF (R2E(2) + 0.57791E+02) 20080, 10080, 40080 02270820 +40080 IF (R2E(2) + 0.57785E+02) 10080, 10080, 20080 02280820 +10080 IVPASS = IVPASS + 1 02290820 + WRITE (NUVI, 80002) IVTNUM 02300820 + GO TO 0081 02310820 +20080 IVFAIL = IVFAIL + 1 02320820 + ZVCORR = (0.00000000000000, -57.787816415992) 02330820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02340820 + 0081 CONTINUE 02350820 +CT009* TEST 9 TEST WHERE REAL IS ZERO 02360820 + IVTNUM = 9 02370820 + AVC = CSIN(( 0.0, -10.0)) 02380820 + IF (R2E(1) + 0.50000E-04) 20090, 40092, 40091 02390820 +40091 IF (R2E(1) - 0.50000E-04) 40092, 40092, 20090 02400820 +40092 IF (R2E(2) + 0.11014E+05) 20090, 10090, 40090 02410820 +40090 IF (R2E(2) + 0.11012E+05) 10090, 10090, 20090 02420820 +10090 IVPASS = IVPASS + 1 02430820 + WRITE (NUVI, 80002) IVTNUM 02440820 + GO TO 0091 02450820 +20090 IVFAIL = IVFAIL + 1 02460820 + ZVCORR = (0.00000000000000, -11013.232874703) 02470820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02480820 + 0091 CONTINUE 02490820 +C***** 02500820 + WRITE (NUVI, 90002) 02510820 + WRITE (NUVI, 90013) 02520820 + WRITE (NUVI, 90014) 02530820 +C***** 02540820 + WRITE(NUVI, 18811) 02550820 +18811 FORMAT(/ 08X, "TEST OF CCOS" ) 02560820 +CT010* TEST 10 TEST FOR ZERO (0.0, 0.0) 02570820 + IVTNUM = 10 02580820 + AVC = CCOS(( 0.0, 0.0)) 02590820 + IF (R2E(1) - 0.99995E+00) 20100, 40102, 40101 02600820 +40101 IF (R2E(1) - 0.10001E+01) 40102, 40102, 20100 02610820 +40102 IF (R2E(2) + 0.50000E-04) 20100, 10100, 40100 02620820 +40100 IF (R2E(2) - 0.50000E-04) 10100, 10100, 20100 02630820 +10100 IVPASS = IVPASS + 1 02640820 + WRITE (NUVI, 80002) IVTNUM 02650820 + GO TO 0101 02660820 +20100 IVFAIL = IVFAIL + 1 02670820 + ZVCORR = (1.00000000000000, 0.00000000000000) 02680820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02690820 + 0101 CONTINUE 02700820 +CT011* TEST 11 TEST WITH ZERO IMAGINARY, CCOS = COS 02710820 + IVTNUM = 11 02720820 + AVC = CCOS((3.5, 1.0) - (0.0, 1.0)) 02730820 + IF (R2E(1) + 0.93651E+00) 20110, 40112, 40111 02740820 +40111 IF (R2E(1) + 0.93641E+00) 40112, 40112, 20110 02750820 +40112 IF (R2E(2) + 0.50000E-04) 20110, 10110, 40110 02760820 +40110 IF (R2E(2) - 0.50000E-04) 10110, 10110, 20110 02770820 +10110 IVPASS = IVPASS + 1 02780820 + WRITE (NUVI, 80002) IVTNUM 02790820 + GO TO 0111 02800820 +20110 IVFAIL = IVFAIL + 1 02810820 + ZVCORR = (-0.93645668729080, 0.00000000000000) 02820820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02830820 + 0111 CONTINUE 02840820 +CT013* TEST 12 EXPRESSION PRESENTED TO CCOS 02990820 + IVTNUM = 12 03000820 + AVC = CCOS(( 3.5, 5.5) - (2.0, 2.0)) 03010820 + IF (R2E(1) - 0.11722E+01) 20130, 40132, 40131 03020820 +40131 IF (R2E(1) - 0.11724E+01) 40132, 40132, 20130 03030820 +40132 IF (R2E(2) + 0.16502E+02) 20130, 10130, 40130 03040820 +40130 IF (R2E(2) + 0.16500E+02) 10130, 10130, 20130 03050820 +10130 IVPASS = IVPASS + 1 03060820 + WRITE (NUVI, 80002) IVTNUM 03070820 + GO TO 0131 03080820 +20130 IVFAIL = IVFAIL + 1 03090820 + ZVCORR = (1.1723152409601, -16.501187784675) 03100820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 03110820 + 0131 CONTINUE 03120820 +CT014* TEST 13 VARIABLE WITHIN AN EXPRESSION 03130820 + IVTNUM = 13 03140820 + BVC = ( 4.75, 1.25) 03150820 + AVC = CCOS(BVC - (9.50, 0.0)) 03160820 + IF (R2E(1) - 0.71005E-01) 20140, 40142, 40141 03170820 +40141 IF (R2E(1) - 0.71013E-01) 40142, 40142, 20140 03180820 +40142 IF (R2E(2) + 0.16009E+01) 20140, 10140, 40140 03190820 +40140 IF (R2E(2) + 0.16007E+01) 10140, 10140, 20140 03200820 +10140 IVPASS = IVPASS + 1 03210820 + WRITE (NUVI, 80002) IVTNUM 03220820 + GO TO 0141 03230820 +20140 IVFAIL = IVFAIL + 1 03240820 + ZVCORR = (0.071008803346314, -1.6007861854666) 03250820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 03260820 + 0141 CONTINUE 03270820 +CT015* TEST 14 VARIABLE WITHIN AN EXPRESSION 03280820 + IVTNUM = 14 03290820 + BVC = ( 1.00, 10.0) 03300820 + AVC = CCOS(BVC + ( 0.25, 10.0)) 03310820 + IF (R2E(1) - 0.76487E+08) 20150, 40152, 40151 03320820 +40151 IF (R2E(1) - 0.76496E+08) 40152, 40152, 20150 03330820 +40152 IF (R2E(2) + 0.23022E+09) 20150, 10150, 40150 03340820 +40150 IF (R2E(2) + 0.23019E+09) 10150, 10150, 20150 03350820 +10150 IVPASS = IVPASS + 1 03360820 + WRITE (NUVI, 80002) IVTNUM 03370820 + GO TO 0151 03380820 +20150 IVFAIL = IVFAIL + 1 03390820 + ZVCORR = (76491717.784289, -230207154.14527) 03400820 + WRITE (NUVI, 80145) IVTNUM, AVC, ZVCORR 03410820 + 0151 CONTINUE 03420820 +CT016* TEST 15 TEST WITH ZERO REAL PART 03430820 + IVTNUM = 15 03440820 + BVC = ( 0.0, 1.0) 03450820 + AVC = CCOS(BVC) 03460820 + IF (R2E(1) - 0.15430E+01) 20160, 40162, 40161 03470820 +40161 IF (R2E(1) - 0.15432E+01) 40162, 40162, 20160 03480820 +40162 IF (R2E(2) + 0.50000E-04) 20160, 10160, 40160 03490820 +40160 IF (R2E(2) - 0.50000E-04) 10160, 10160, 20160 03500820 +10160 IVPASS = IVPASS + 1 03510820 + WRITE (NUVI, 80002) IVTNUM 03520820 + GO TO 0161 03530820 +20160 IVFAIL = IVFAIL + 1 03540820 + ZVCORR = (1.5430806348152, 0.00000000000000) 03550820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 03560820 + 0161 CONTINUE 03570820 +CT017* TEST 16 TEST WITH ZERO REAL PART 03580820 + IVTNUM = 16 03590820 + BVC = ( 0.0, -4.75) 03600820 + AVC = CCOS(BVC) 03610820 + IF (R2E(1) - 0.57793E+02) 20170, 40172, 40171 03620820 +40171 IF (R2E(1) - 0.57800E+02) 40172, 40172, 20170 03630820 +40172 IF (R2E(2) + 0.50000E-04) 20170, 10170, 40170 03640820 +40170 IF (R2E(2) - 0.50000E-04) 10170, 10170, 20170 03650820 +10170 IVPASS = IVPASS + 1 03660820 + WRITE (NUVI, 80002) IVTNUM 03670820 + GO TO 0171 03680820 +20170 IVFAIL = IVFAIL + 1 03690820 + ZVCORR = (57.796468111195, 0.00000000000000) 03700820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 03710820 + 0171 CONTINUE 03720820 +CT018* TEST 17 TEST WITH ZERO REAL PART 03730820 + IVTNUM = 17 03740820 + AVC = CCOS(( 0.0, -10.0)) 03750820 + IF (R2E(1) - 0.11012E+05) 20180, 40182, 40181 03760820 +40181 IF (R2E(1) - 0.11014E+05) 40182, 40182, 20180 03770820 +40182 IF (R2E(2) + 0.50000E-04) 20180, 10180, 40180 03780820 +40180 IF (R2E(2) - 0.50000E-04) 10180, 10180, 20180 03790820 +10180 IVPASS = IVPASS + 1 03800820 + WRITE (NUVI, 80002) IVTNUM 03810820 + GO TO 0181 03820820 +20180 IVFAIL = IVFAIL + 1 03830820 + ZVCORR = (11013.232920103, 0.00000000000000) 03840820 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 03850820 + 0181 CONTINUE 03860820 +CT019* TEST 18 THE FUNCTION TOGETHER WITH CSIN AND CABS 03870820 + IVTNUM = 18 03880820 + DVS = (CABS(CCOS((-2.25, 0.0))) ** 2) + 03890820 + 1 (CABS(CSIN((-2.25, 0.0))) ** 2) 03900820 + IF (DVS - 0.99995E+00) 20190, 10190, 40190 03910820 +40190 IF (DVS - 0.10001E+01) 10190, 10190, 20190 03920820 +10190 IVPASS = IVPASS + 1 03930820 + WRITE (NUVI, 80002) IVTNUM 03940820 + GO TO 0191 03950820 +20190 IVFAIL = IVFAIL + 1 03960820 + RVCORR = 1.00000000000000 03970820 + WRITE (NUVI, 80012) IVTNUM, DVS, RVCORR 03980820 + 0191 CONTINUE 03990820 +C***** 04000820 +CBB** ********************** BBCSUM0 **********************************04010820 +C**** WRITE OUT TEST SUMMARY 04020820 +C**** 04030820 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04040820 + WRITE (I02, 90004) 04050820 + WRITE (I02, 90014) 04060820 + WRITE (I02, 90004) 04070820 + WRITE (I02, 90020) IVPASS 04080820 + WRITE (I02, 90022) IVFAIL 04090820 + WRITE (I02, 90024) IVDELE 04100820 + WRITE (I02, 90026) IVINSP 04110820 + WRITE (I02, 90028) IVTOTN, IVTOTL 04120820 +CBE** ********************** BBCSUM0 **********************************04130820 +CBB** ********************** BBCFOOT0 **********************************04140820 +C**** WRITE OUT REPORT FOOTINGS 04150820 +C**** 04160820 + WRITE (I02,90016) ZPROG, ZPROG 04170820 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04180820 + WRITE (I02,90019) 04190820 +CBE** ********************** BBCFOOT0 **********************************04200820 +CBB** ********************** BBCFMT0A **********************************04210820 +C**** FORMATS FOR TEST DETAIL LINES 04220820 +C**** 04230820 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04240820 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04250820 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04260820 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04270820 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04280820 + 1I6,/," ",15X,"CORRECT= " ,I6) 04290820 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04300820 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04310820 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04320820 + 1A21,/," ",16X,"CORRECT= " ,A21) 04330820 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04340820 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04350820 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04360820 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04370820 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04380820 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04390820 +80050 FORMAT (" ",48X,A31) 04400820 +CBE** ********************** BBCFMT0A **********************************04410820 +CBB** ********************** BBCFMAT1 **********************************04420820 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04430820 +C**** 04440820 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04450820 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04460820 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04470820 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04480820 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04490820 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04500820 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04510820 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04520820 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04530820 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04540820 + 2"(",F12.5,", ",F12.5,")") 04550820 +CBE** ********************** BBCFMAT1 **********************************04560820 +CBB** ********************** BBCFMT0B **********************************04570820 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04580820 +C**** 04590820 +90002 FORMAT ("1") 04600820 +90004 FORMAT (" ") 04610820 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04620820 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04630820 +90008 FORMAT (" ",21X,A13,A17) 04640820 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04650820 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04660820 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04670820 + 1 7X,"REMARKS",24X) 04680820 +90014 FORMAT (" ","----------------------------------------------" , 04690820 + 1 "---------------------------------" ) 04700820 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04710820 +C**** 04720820 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04730820 +C**** 04740820 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04750820 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04760820 + 1 A13) 04770820 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04780820 +C**** 04790820 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04800820 +C**** 04810820 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04820820 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04830820 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04840820 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04850820 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04860820 +CBE** ********************** BBCFMT0B **********************************04870820 +C***** 04880820 +C***** END OF TEST SEGMENT 188 04890820 + STOP 04900820 + END 04910820 + 04920820 diff --git a/Fortran/UnitTests/fcvs21_f95/FM820.reference_output b/Fortran/UnitTests/fcvs21_f95/FM820.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM820.reference_output @@ -0,0 +1,59 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM820BEGIN* TEST RESULTS - FM820 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YCSIN - (188) INTRINSIC FUNCTIONS + + CSIN, CCOS (COMPLEX SINE, COSINE) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 18 TESTS + + + TEST OF CSIN + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF CCOS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + + ------------------------------------------------------------------------------- + + 18 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 18 OF 18 TESTS EXECUTED + + *FM820END* END OF TEST - FM820 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM821.f b/Fortran/UnitTests/fcvs21_f95/FM821.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM821.f @@ -0,0 +1,448 @@ + PROGRAM FM821 + +C***********************************************************************00010821 +C***** FORTRAN 77 00020821 +C***** FM821 00030821 +C***** YDCOS - (190) 00040821 +C***** 00050821 +C***********************************************************************00060821 +C***** GENERAL PURPOSE ANS REF 00070821 +C***** TEST INTRINSIC FUNCTION DCOS 15.3 00080821 +C***** TABLE 5 00090821 +C***** 00100821 +CBB** ********************** BBCCOMNT **********************************00110821 +C**** 00120821 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130821 +C**** VERSION 2.1 00140821 +C**** 00150821 +C**** 00160821 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170821 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180821 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190821 +C**** BUILDING 225 RM A266 00200821 +C**** GAITHERSBURG, MD 20899 00210821 +C**** 00220821 +C**** 00230821 +C**** 00240821 +CBE** ********************** BBCCOMNT **********************************00250821 +C***** 00260821 +C***** S P E C I F I C A T I O N S SEGMENT 190 00270821 + DOUBLE PRECISION AVD, BVD, PIVD, DVCORR 00280821 +C***** 00290821 +CBB** ********************** BBCINITA **********************************00300821 +C**** SPECIFICATION STATEMENTS 00310821 +C**** 00320821 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330821 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340821 +CBE** ********************** BBCINITA **********************************00350821 +CBB** ********************** BBCINITB **********************************00360821 +C**** INITIALIZE SECTION 00370821 + DATA ZVERS, ZVERSD, ZDATE 00380821 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390821 + DATA ZCOMPL, ZNAME, ZTAPE 00400821 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410821 + DATA ZPROJ, ZTAPED, ZPROG 00420821 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430821 + DATA REMRKS /' '/ 00440821 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450821 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460821 +C**** 00470821 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480821 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490821 +CZ03 ZPROG = 'PROGRAM NAME' 00500821 +CZ04 ZDATE = 'DATE OF TEST' 00510821 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520821 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530821 +CZ07 ZNAME = 'NAME OF USER' 00540821 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00550821 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00560821 +C 00570821 + IVPASS = 0 00580821 + IVFAIL = 0 00590821 + IVDELE = 0 00600821 + IVINSP = 0 00610821 + IVTOTL = 0 00620821 + IVTOTN = 0 00630821 + ICZERO = 0 00640821 +C 00650821 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660821 + I01 = 05 00670821 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680821 + I02 = 06 00690821 +C 00700821 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710821 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720821 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730821 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740821 +C 00750821 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760821 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770821 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780821 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790821 +C 00800821 +CBE** ********************** BBCINITB **********************************00810821 + NUVI = I02 00820821 + IVTOTL = 19 00830821 + ZPROG = 'FM821' 00840821 +CBB** ********************** BBCHED0A **********************************00850821 +C**** 00860821 +C**** WRITE REPORT TITLE 00870821 +C**** 00880821 + WRITE (I02, 90002) 00890821 + WRITE (I02, 90006) 00900821 + WRITE (I02, 90007) 00910821 + WRITE (I02, 90008) ZVERS, ZVERSD 00920821 + WRITE (I02, 90009) ZPROG, ZPROG 00930821 + WRITE (I02, 90010) ZDATE, ZCOMPL 00940821 +CBE** ********************** BBCHED0A **********************************00950821 +C***** 00960821 +C***** HEADER FOR SEGMENT 190 00970821 + WRITE(NUVI,19000) 00980821 +19000 FORMAT(" "/" YDCOS - (190) INTRINSIC FUNCTIONS" // 00990821 + 1 " DCOS (DOUBLE PRECISION COSINE)" // 01000821 + 2 " ANS REF. - 15.3" ) 01010821 +CBB** ********************** BBCHED0B **********************************01020821 +C**** WRITE DETAIL REPORT HEADERS 01030821 +C**** 01040821 + WRITE (I02,90004) 01050821 + WRITE (I02,90004) 01060821 + WRITE (I02,90013) 01070821 + WRITE (I02,90014) 01080821 + WRITE (I02,90015) IVTOTL 01090821 +CBE** ********************** BBCHED0B **********************************01100821 +C***** 01110821 + PIVD = 3.1415926535897932384626434D0 01120821 +C***** 01130821 +CT001* TEST 1 ZERO (0.0), SINCE COS(0)=1 01140821 + IVTNUM = 1 01150821 + BVD = 0.0D0 01160821 + AVD = DCOS(BVD) 01170821 + IF (AVD - 0.9999999995D+00) 20010, 10010, 40010 01180821 +40010 IF (AVD - 0.1000000001D+01) 10010, 10010, 20010 01190821 +10010 IVPASS = IVPASS + 1 01200821 + WRITE (NUVI, 80002) IVTNUM 01210821 + GO TO 0011 01220821 +20010 IVFAIL = IVFAIL + 1 01230821 + DVCORR = 1.00000000000000000000D+00 01240821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01250821 + 0011 CONTINUE 01260821 +CT002* TEST 2 VALUES NEAR PI 01270821 + IVTNUM = 2 01280821 + AVD = DCOS(PIVD) 01290821 + IF (AVD + 0.1000000001D+01) 20020, 10020, 40020 01300821 +40020 IF (AVD + 0.9999999995D+00) 10020, 10020, 20020 01310821 +10020 IVPASS = IVPASS + 1 01320821 + WRITE (NUVI, 80002) IVTNUM 01330821 + GO TO 0021 01340821 +20020 IVFAIL = IVFAIL + 1 01350821 + DVCORR = -1.00000000000000000000D+00 01360821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01370821 + 0021 CONTINUE 01380821 +CT003* TEST 3 PI - 1/16 01390821 + IVTNUM = 3 01400821 + BVD = 3.07909265358979323846D0 01410821 + AVD = DCOS(BVD) 01420821 + IF (AVD + 0.9980475112D+00) 20030, 10030, 40030 01430821 +40030 IF (AVD + 0.9980475102D+00) 10030, 10030, 20030 01440821 +10030 IVPASS = IVPASS + 1 01450821 + WRITE (NUVI, 80002) IVTNUM 01460821 + GO TO 0031 01470821 +20030 IVFAIL = IVFAIL + 1 01480821 + DVCORR = -0.99804751070009914963D+00 01490821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01500821 + 0031 CONTINUE 01510821 +CT004* TEST 4 PI + 1/32 01520821 + IVTNUM = 4 01530821 + AVD = DCOS(3.17284265358979323846D0) 01540821 + IF (AVD + 0.9995117590D+00) 20040, 10040, 40040 01550821 +40040 IF (AVD + 0.9995117580D+00) 10040, 10040, 20040 01560821 +10040 IVPASS = IVPASS + 1 01570821 + WRITE (NUVI, 80002) IVTNUM 01580821 + GO TO 0041 01590821 +20040 IVFAIL = IVFAIL + 1 01600821 + DVCORR = -0.99951175848513636924D+00 01610821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01620821 + 0041 CONTINUE 01630821 +CT005* TEST 5 VALUES NEAR 2*PI 01640821 + IVTNUM = 5 01650821 + BVD = PIVD * 2.0D0 01660821 + AVD = DCOS(BVD) 01670821 + IF (AVD - 0.9999999995D+00) 20050, 10050, 40050 01680821 +40050 IF (AVD - 0.1000000001D+01) 10050, 10050, 20050 01690821 +10050 IVPASS = IVPASS + 1 01700821 + WRITE (NUVI, 80002) IVTNUM 01710821 + GO TO 0051 01720821 +20050 IVFAIL = IVFAIL + 1 01730821 + DVCORR = 1.00000000000000000000D+00 01740821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01750821 + 0051 CONTINUE 01760821 +CT006* TEST 6 VALUES NEAR 2*PI 01770821 + IVTNUM = 6 01780821 + BVD = (2.0D0 * PIVD) - 1.0D0 / 64.0D0 01790821 + AVD = DCOS(BVD) 01800821 + IF (AVD - 0.9998779316D+00) 20060, 10060, 40060 01810821 +40060 IF (AVD - 0.9998779327D+00) 10060, 10060, 20060 01820821 +10060 IVPASS = IVPASS + 1 01830821 + WRITE (NUVI, 80002) IVTNUM 01840821 + GO TO 0061 01850821 +20060 IVFAIL = IVFAIL + 1 01860821 + DVCORR = 0.99987793217100665474D+00 01870821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01880821 + 0061 CONTINUE 01890821 +CT007* TEST 7 VALUES NEAR 2*PI 01900821 + IVTNUM = 7 01910821 + BVD = (2.0D0 * PIVD) + 1.0D0 / 128.0D0 01920821 + AVD = DCOS(BVD) 01930821 + IF (AVD - 0.9999694820D+00) 20070, 10070, 40070 01940821 +40070 IF (AVD - 0.9999694831D+00) 10070, 10070, 20070 01950821 +10070 IVPASS = IVPASS + 1 01960821 + WRITE (NUVI, 80002) IVTNUM 01970821 + GO TO 0071 01980821 +20070 IVFAIL = IVFAIL + 1 01990821 + DVCORR = 0.99996948257709511331D+00 02000821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02010821 + 0071 CONTINUE 02020821 +CT008* TEST 8 AN EXPRESSION PRESENTED TO DCOS 02030821 + IVTNUM = 8 02040821 + BVD = 350.0D1 02050821 + AVD = DCOS(BVD / 100.0D1) 02060821 + IF (AVD + 0.9364566878D+00) 20080, 10080, 40080 02070821 +40080 IF (AVD + 0.9364566868D+00) 10080, 10080, 20080 02080821 +10080 IVPASS = IVPASS + 1 02090821 + WRITE (NUVI, 80002) IVTNUM 02100821 + GO TO 0081 02110821 +20080 IVFAIL = IVFAIL + 1 02120821 + DVCORR = -0.93645668729079633770D+00 02130821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02140821 + 0081 CONTINUE 02150821 +CT009* TEST 9 A NEGATIVE ARGUMENT 02160821 + IVTNUM = 9 02170821 + BVD = -1.5D0 02180821 + AVD = DCOS(BVD) 02190821 + IF (AVD - 0.7073720163D-01) 20090, 10090, 40090 02200821 +40090 IF (AVD - 0.7073720171D-01) 10090, 10090, 20090 02210821 +10090 IVPASS = IVPASS + 1 02220821 + WRITE (NUVI, 80002) IVTNUM 02230821 + GO TO 0091 02240821 +20090 IVFAIL = IVFAIL + 1 02250821 + DVCORR = 0.070737201667702910088D+00 02260821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02270821 + 0091 CONTINUE 02280821 +CT010* TEST 10 LARGE VALUES TO CHECK ARGUMENT REDUCTION 02290821 + IVTNUM = 10 02300821 + AVD = DCOS(200.0D0) 02310821 + IF (AVD - 0.4871876747D+00) 20100, 10100, 40100 02320821 +40100 IF (AVD - 0.4871876753D+00) 10100, 10100, 20100 02330821 +10100 IVPASS = IVPASS + 1 02340821 + WRITE (NUVI, 80002) IVTNUM 02350821 + GO TO 0101 02360821 +20100 IVFAIL = IVFAIL + 1 02370821 + DVCORR = 0.48718767500700591035D+00 02380821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02390821 + 0101 CONTINUE 02400821 +CT011* TEST 11 LARGE VALUES TO CHECK ARGUMENT REDUCTION 02410821 + IVTNUM = 11 02420821 + AVD = DCOS(-31416.0D0) 02430821 + IF (AVD - 0.9973027257D+00) 20110, 10110, 40110 02440821 +40110 IF (AVD - 0.9973027268D+00) 10110, 10110, 20110 02450821 +10110 IVPASS = IVPASS + 1 02460821 + WRITE (NUVI, 80002) IVTNUM 02470821 + GO TO 0111 02480821 +20110 IVFAIL = IVFAIL + 1 02490821 + DVCORR = 0.99730272627420107808D+00 02500821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02510821 + 0111 CONTINUE 02520821 +CT012* TEST 12 VALUES NEAR PI/2 02530821 + IVTNUM = 12 02540821 + AVD = DCOS(1.57079632679489661923D0) 02550821 + IF (AVD + 0.5000000000D-09) 20120, 10120, 40120 02560821 +40120 IF (AVD - 0.5000000000D-09) 10120, 10120, 20120 02570821 +10120 IVPASS = IVPASS + 1 02580821 + WRITE (NUVI, 80002) IVTNUM 02590821 + GO TO 0121 02600821 +20120 IVFAIL = IVFAIL + 1 02610821 + DVCORR = 0.00000000000000000000D+00 02620821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02630821 + 0121 CONTINUE 02640821 +CT013* TEST 13 (PI / 2) - 1/32 02650821 + IVTNUM = 13 02660821 + BVD = (1.53954632679489661923D0) 02670821 + AVD = DCOS(BVD) 02680821 + IF (AVD - 0.3124491397D-01) 20130, 10130, 40130 02690821 +40130 IF (AVD - 0.3124491400D-01) 10130, 10130, 20130 02700821 +10130 IVPASS = IVPASS + 1 02710821 + WRITE (NUVI, 80002) IVTNUM 02720821 + GO TO 0131 02730821 +20130 IVFAIL = IVFAIL + 1 02740821 + DVCORR = 0.031244913985326078739D+00 02750821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02760821 + 0131 CONTINUE 02770821 +CT014* TEST 14 (PI / 2) + 1/16 02780821 + IVTNUM = 14 02790821 + AVD = DCOS(1.63329632679489661923D0) 02800821 + IF (AVD + 0.6245931788D-01) 20140, 10140, 40140 02810821 +40140 IF (AVD + 0.6245931781D-01) 10140, 10140, 20140 02820821 +10140 IVPASS = IVPASS + 1 02830821 + WRITE (NUVI, 80002) IVTNUM 02840821 + GO TO 0141 02850821 +20140 IVFAIL = IVFAIL + 1 02860821 + DVCORR = -0.062459317842380198585D+00 02870821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02880821 + 0141 CONTINUE 02890821 +CT015* TEST 15 VALUES NEAR 3*PI/2 02900821 + IVTNUM = 15 02910821 + BVD = 3.0D0 * PIVD / 2.0D0 02920821 + AVD = DCOS(BVD) 02930821 + IF (AVD + 0.5000000000D-09) 20150, 10150, 40150 02940821 +40150 IF (AVD - 0.5000000000D-09) 10150, 10150, 20150 02950821 +10150 IVPASS = IVPASS + 1 02960821 + WRITE (NUVI, 80002) IVTNUM 02970821 + GO TO 0151 02980821 +20150 IVFAIL = IVFAIL + 1 02990821 + DVCORR = 0.00000000000000000000D+00 03000821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03010821 + 0151 CONTINUE 03020821 +CT016* TEST 16 VALUES NEAR 3*PI/2 03030821 + IVTNUM = 16 03040821 + BVD = (3.0D0 * PIVD / 2.0D0) + 1.0D0 / 16.0D0 03050821 + AVD = DCOS(BVD) 03060821 + IF (AVD - 0.6245931781D-01) 20160, 10160, 40160 03070821 +40160 IF (AVD - 0.6245931788D-01) 10160, 10160, 20160 03080821 +10160 IVPASS = IVPASS + 1 03090821 + WRITE (NUVI, 80002) IVTNUM 03100821 + GO TO 0161 03110821 +20160 IVFAIL = IVFAIL + 1 03120821 + DVCORR = 0.062459317842380198585D+00 03130821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03140821 + 0161 CONTINUE 03150821 +CT017* TEST 17 VALUES NEAR 3*PI/2 03160821 + IVTNUM = 17 03170821 + BVD = (3.0D0 * PIVD / 2.0D0) - 1.0D0 / 512.0D0 03180821 + AVD = DCOS(BVD) 03190821 + IF (AVD + 0.1953123760D-02) 20170, 10170, 40170 03200821 +40170 IF (AVD + 0.1953123757D-02) 10170, 10170, 20170 03210821 +10170 IVPASS = IVPASS + 1 03220821 + WRITE (NUVI, 80002) IVTNUM 03230821 + GO TO 0171 03240821 +20170 IVFAIL = IVFAIL + 1 03250821 + DVCORR = -0.0019531237582368040269D+00 03260821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03270821 + 0171 CONTINUE 03280821 +CT018* TEST 18 ARGUMENT OF LOW MAGNITUDE 03290821 + IVTNUM = 18 03300821 + BVD = -3.1415926535898D-35 03310821 + AVD = DCOS(BVD) 03320821 + IF (AVD - 0.9999999995D+00) 20180, 10180, 40180 03330821 +40180 IF (AVD - 0.1000000001D+01) 10180, 10180, 20180 03340821 +10180 IVPASS = IVPASS + 1 03350821 + WRITE (NUVI, 80002) IVTNUM 03360821 + GO TO 0181 03370821 +20180 IVFAIL = IVFAIL + 1 03380821 + DVCORR = 1.00000000000000000000D+00 03390821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03400821 + 0181 CONTINUE 03410821 +CT019* TEST 19 THE FUNCTION APPLIED TWICE 03420821 + IVTNUM = 19 03430821 + AVD = DCOS(PIVD / 4.0D0) * DCOS(3.0D0 * PIVD / 4.0D0) 03440821 + IF (AVD + 0.5000000003D+00) 20190, 10190, 40190 03450821 +40190 IF (AVD + 0.4999999997D+00) 10190, 10190, 20190 03460821 +10190 IVPASS = IVPASS + 1 03470821 + WRITE (NUVI, 80002) IVTNUM 03480821 + GO TO 0191 03490821 +20190 IVFAIL = IVFAIL + 1 03500821 + DVCORR = -0.5000000000000000000000D+00 03510821 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03520821 + 0191 CONTINUE 03530821 +C***** 03540821 +CBB** ********************** BBCSUM0 **********************************03550821 +C**** WRITE OUT TEST SUMMARY 03560821 +C**** 03570821 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03580821 + WRITE (I02, 90004) 03590821 + WRITE (I02, 90014) 03600821 + WRITE (I02, 90004) 03610821 + WRITE (I02, 90020) IVPASS 03620821 + WRITE (I02, 90022) IVFAIL 03630821 + WRITE (I02, 90024) IVDELE 03640821 + WRITE (I02, 90026) IVINSP 03650821 + WRITE (I02, 90028) IVTOTN, IVTOTL 03660821 +CBE** ********************** BBCSUM0 **********************************03670821 +CBB** ********************** BBCFOOT0 **********************************03680821 +C**** WRITE OUT REPORT FOOTINGS 03690821 +C**** 03700821 + WRITE (I02,90016) ZPROG, ZPROG 03710821 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03720821 + WRITE (I02,90019) 03730821 +CBE** ********************** BBCFOOT0 **********************************03740821 +CBB** ********************** BBCFMT0A **********************************03750821 +C**** FORMATS FOR TEST DETAIL LINES 03760821 +C**** 03770821 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03780821 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03790821 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03800821 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03810821 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03820821 + 1I6,/," ",15X,"CORRECT= " ,I6) 03830821 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03840821 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03850821 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03860821 + 1A21,/," ",16X,"CORRECT= " ,A21) 03870821 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03880821 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03890821 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03900821 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03910821 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03920821 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03930821 +80050 FORMAT (" ",48X,A31) 03940821 +CBE** ********************** BBCFMT0A **********************************03950821 +CBB** ********************** BBCFMAT1 **********************************03960821 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03970821 +C**** 03980821 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03990821 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04000821 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04010821 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04020821 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04030821 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04040821 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04050821 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04060821 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04070821 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04080821 + 2"(",F12.5,", ",F12.5,")") 04090821 +CBE** ********************** BBCFMAT1 **********************************04100821 +CBB** ********************** BBCFMT0B **********************************04110821 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04120821 +C**** 04130821 +90002 FORMAT ("1") 04140821 +90004 FORMAT (" ") 04150821 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04160821 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04170821 +90008 FORMAT (" ",21X,A13,A17) 04180821 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04190821 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04200821 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04210821 + 1 7X,"REMARKS",24X) 04220821 +90014 FORMAT (" ","----------------------------------------------" , 04230821 + 1 "---------------------------------" ) 04240821 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04250821 +C**** 04260821 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04270821 +C**** 04280821 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04290821 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04300821 + 1 A13) 04310821 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04320821 +C**** 04330821 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04340821 +C**** 04350821 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04360821 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04370821 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04380821 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04390821 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04400821 +CBE** ********************** BBCFMT0B **********************************04410821 +C***** 04420821 +C***** END OF TEST SEGMENT 190 04430821 + STOP 04440821 + END 04450821 + 04460821 diff --git a/Fortran/UnitTests/fcvs21_f95/FM821.reference_output b/Fortran/UnitTests/fcvs21_f95/FM821.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM821.reference_output @@ -0,0 +1,53 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM821BEGIN* TEST RESULTS - FM821 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDCOS - (190) INTRINSIC FUNCTIONS + + DCOS (DOUBLE PRECISION COSINE) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 19 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + + ------------------------------------------------------------------------------- + + 19 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 19 OF 19 TESTS EXECUTED + + *FM821END* END OF TEST - FM821 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM822.f b/Fortran/UnitTests/fcvs21_f95/FM822.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM822.f @@ -0,0 +1,385 @@ + PROGRAM FM822 + +C***********************************************************************00010822 +C***** FORTRAN 77 00020822 +C***** FM822 00030822 +C***** YDTAN - (192) 00040822 +C***** 00050822 +C***********************************************************************00060822 +C***** GENERAL PURPOSE ANS REF 00070822 +C***** TEST INTRINSIC FUNCTION DTAN 15.3 00080822 +C***** TABLE 5 00090822 +C***** 00100822 +CBB** ********************** BBCCOMNT **********************************00110822 +C**** 00120822 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130822 +C**** VERSION 2.1 00140822 +C**** 00150822 +C**** 00160822 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170822 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180822 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190822 +C**** BUILDING 225 RM A266 00200822 +C**** GAITHERSBURG, MD 20899 00210822 +C**** 00220822 +C**** 00230822 +C**** 00240822 +CBE** ********************** BBCCOMNT **********************************00250822 +C***** 00260822 +C***** S P E C I F I C A T I O N S SEGMENT 192 00270822 + DOUBLE PRECISION AVD, BVD, PIVD, DVCORR 00280822 +C***** 00290822 +CBB** ********************** BBCINITA **********************************00300822 +C**** SPECIFICATION STATEMENTS 00310822 +C**** 00320822 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330822 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340822 +CBE** ********************** BBCINITA **********************************00350822 +CBB** ********************** BBCINITB **********************************00360822 +C**** INITIALIZE SECTION 00370822 + DATA ZVERS, ZVERSD, ZDATE 00380822 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390822 + DATA ZCOMPL, ZNAME, ZTAPE 00400822 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410822 + DATA ZPROJ, ZTAPED, ZPROG 00420822 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430822 + DATA REMRKS /' '/ 00440822 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450822 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460822 +C**** 00470822 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480822 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490822 +CZ03 ZPROG = 'PROGRAM NAME' 00500822 +CZ04 ZDATE = 'DATE OF TEST' 00510822 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520822 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530822 +CZ07 ZNAME = 'NAME OF USER' 00540822 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00550822 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00560822 +C 00570822 + IVPASS = 0 00580822 + IVFAIL = 0 00590822 + IVDELE = 0 00600822 + IVINSP = 0 00610822 + IVTOTL = 0 00620822 + IVTOTN = 0 00630822 + ICZERO = 0 00640822 +C 00650822 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660822 + I01 = 05 00670822 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680822 + I02 = 06 00690822 +C 00700822 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710822 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720822 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730822 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740822 +C 00750822 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760822 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770822 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780822 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790822 +C 00800822 +CBE** ********************** BBCINITB **********************************00810822 + NUVI = I02 00820822 + IVTOTL = 14 00830822 + ZPROG = 'FM822' 00840822 +CBB** ********************** BBCHED0A **********************************00850822 +C**** 00860822 +C**** WRITE REPORT TITLE 00870822 +C**** 00880822 + WRITE (I02, 90002) 00890822 + WRITE (I02, 90006) 00900822 + WRITE (I02, 90007) 00910822 + WRITE (I02, 90008) ZVERS, ZVERSD 00920822 + WRITE (I02, 90009) ZPROG, ZPROG 00930822 + WRITE (I02, 90010) ZDATE, ZCOMPL 00940822 +CBE** ********************** BBCHED0A **********************************00950822 +C***** 00960822 +C***** HEADER FOR SEGMENT 192 00970822 + WRITE(NUVI,19200) 00980822 +19200 FORMAT(" ", / " YDTAN - (192) INTRINSIC FUNCTIONS" // 00990822 + 1 " DTAN (DOUBLE PRECISION TANGENT)" // 01000822 + 2 " ANS REF. - 15.3" ) 01010822 +CBB** ********************** BBCHED0B **********************************01020822 +C**** WRITE DETAIL REPORT HEADERS 01030822 +C**** 01040822 + WRITE (I02,90004) 01050822 + WRITE (I02,90004) 01060822 + WRITE (I02,90013) 01070822 + WRITE (I02,90014) 01080822 + WRITE (I02,90015) IVTOTL 01090822 +CBE** ********************** BBCHED0B **********************************01100822 +C***** 01110822 + PIVD = 3.1415926535897932384626434D0 01120822 +C***** 01130822 +CT001* TEST 1 ZERO (0.0), SINCE TAN(0) = 0. 01140822 + IVTNUM = 1 01150822 + BVD = 0.0D0 01160822 + AVD = DTAN(BVD) 01170822 + IF (AVD + 0.5000000000D-09) 20010, 10010, 40010 01180822 +40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010 01190822 +10010 IVPASS = IVPASS + 1 01200822 + WRITE (NUVI, 80002) IVTNUM 01210822 + GO TO 0011 01220822 +20010 IVFAIL = IVFAIL + 1 01230822 + DVCORR = 0.00000000000000000000D+00 01240822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01250822 + 0011 CONTINUE 01260822 +CT002* TEST 2 2*PI 01270822 + IVTNUM = 2 01280822 + BVD = 6.28318530717958647692D0 01290822 + AVD = DTAN(BVD) 01300822 + IF (AVD + 0.5000000000D-09) 20020, 10020, 40020 01310822 +40020 IF (AVD - 0.5000000000D-09) 10020, 10020, 20020 01320822 +10020 IVPASS = IVPASS + 1 01330822 + WRITE (NUVI, 80002) IVTNUM 01340822 + GO TO 0021 01350822 +20020 IVFAIL = IVFAIL + 1 01360822 + DVCORR = 0.00000000000000000000D+00 01370822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01380822 + 0021 CONTINUE 01390822 +CT003* TEST 3 3*PI 01400822 + IVTNUM = 3 01410822 + BVD = 9.42477796076937971538D0 01420822 + AVD = DTAN(BVD) 01430822 + IF (AVD + 0.5000000000D-09) 20030, 10030, 40030 01440822 +40030 IF (AVD - 0.5000000000D-09) 10030, 10030, 20030 01450822 +10030 IVPASS = IVPASS + 1 01460822 + WRITE (NUVI, 80002) IVTNUM 01470822 + GO TO 0031 01480822 +20030 IVFAIL = IVFAIL + 1 01490822 + DVCORR = 0.00000000000000000000D+00 01500822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01510822 + 0031 CONTINUE 01520822 +CT004* TEST 4 PI/4 01530822 + IVTNUM = 4 01540822 + AVD = DTAN(PIVD / 4.0D0) 01550822 + IF (AVD - 0.9999999995D+00) 20040, 10040, 40040 01560822 +40040 IF (AVD - 0.1000000001D+01) 10040, 10040, 20040 01570822 +10040 IVPASS = IVPASS + 1 01580822 + WRITE (NUVI, 80002) IVTNUM 01590822 + GO TO 0041 01600822 +20040 IVFAIL = IVFAIL + 1 01610822 + DVCORR = 1.00000000000000000000D+00 01620822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01630822 + 0041 CONTINUE 01640822 +CT005* TEST 5 5*PI/4 01650822 + IVTNUM = 5 01660822 + BVD = 5.0D0 * PIVD / 4.0D0 01670822 + AVD = DTAN(BVD) 01680822 + IF (AVD - 0.9999999995D+00) 20050, 10050, 40050 01690822 +40050 IF (AVD - 0.1000000001D+01) 10050, 10050, 20050 01700822 +10050 IVPASS = IVPASS + 1 01710822 + WRITE (NUVI, 80002) IVTNUM 01720822 + GO TO 0051 01730822 +20050 IVFAIL = IVFAIL + 1 01740822 + DVCORR = 1.00000000000000000000D+00 01750822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01760822 + 0051 CONTINUE 01770822 +CT006* TEST 6 A NEGATIVE VALUE 01780822 + IVTNUM = 6 01790822 + BVD = -2.0D0 / 1.0D0 01800822 + AVD = DTAN(BVD) 01810822 + IF (AVD - 0.2185039862D+01) 20060, 10060, 40060 01820822 +40060 IF (AVD - 0.2185039865D+01) 10060, 10060, 20060 01830822 +10060 IVPASS = IVPASS + 1 01840822 + WRITE (NUVI, 80002) IVTNUM 01850822 + GO TO 0061 01860822 +20060 IVFAIL = IVFAIL + 1 01870822 + DVCORR = 2.1850398632615189916D+00 01880822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01890822 + 0061 CONTINUE 01900822 +CT007* TEST 7 A POSITIVE VALUE 01910822 + IVTNUM = 7 01920822 + BVD = 350.0D0 / 100.0D0 01930822 + AVD = DTAN(BVD) 01940822 + IF (AVD - 0.3745856399D+00) 20070, 10070, 40070 01950822 +40070 IF (AVD - 0.3745856404D+00) 10070, 10070, 20070 01960822 +10070 IVPASS = IVPASS + 1 01970822 + WRITE (NUVI, 80002) IVTNUM 01980822 + GO TO 0071 01990822 +20070 IVFAIL = IVFAIL + 1 02000822 + DVCORR = 0.37458564015859466633D+00 02010822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02020822 + 0071 CONTINUE 02030822 +CT008* TEST 8 (PI / 2) - 1/8 02040822 + IVTNUM = 8 02050822 + BVD = 1.44579632679489661923D0 02060822 + AVD = DTAN(BVD) 02070822 + IF (AVD - 0.7958289861D+01) 20080, 10080, 40080 02080822 +40080 IF (AVD - 0.7958289870D+01) 10080, 10080, 20080 02090822 +10080 IVPASS = IVPASS + 1 02100822 + WRITE (NUVI, 80002) IVTNUM 02110822 + GO TO 0081 02120822 +20080 IVFAIL = IVFAIL + 1 02130822 + DVCORR = 7.9582898658670111779D+00 02140822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02150822 + 0081 CONTINUE 02160822 +CT009* TEST 9 (PI / 2) + 1/256 02170822 + IVTNUM = 9 02180822 + BVD = 1.57470257679489661923D0 02190822 + AVD = DTAN(BVD) 02200822 + IF (AVD + 0.2559986981D+03) 20090, 10090, 40090 02210822 +40090 IF (AVD + 0.2559986977D+03) 10090, 10090, 20090 02220822 +10090 IVPASS = IVPASS + 1 02230822 + WRITE (NUVI, 80002) IVTNUM 02240822 + GO TO 0091 02250822 +20090 IVFAIL = IVFAIL + 1 02260822 + DVCORR = -255.99869791534211708D+00 02270822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02280822 + 0091 CONTINUE 02290822 +CT010* TEST 10 3*PI/2 - 1/1024 02300822 + IVTNUM = 10 02310822 + AVD = DTAN((3.0D0 * PIVD / 2.0D0) - 1.0D0 / 1024.0D0) 02320822 + IF (AVD - 0.1023999674D+04) 20100, 10100, 40100 02330822 +40100 IF (AVD - 0.1023999675D+04) 10100, 10100, 20100 02340822 +10100 IVPASS = IVPASS + 1 02350822 + WRITE (NUVI, 80002) IVTNUM 02360822 + GO TO 0101 02370822 +20100 IVFAIL = IVFAIL + 1 02380822 + DVCORR = 1023.9996744791459706D+00 02390822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02400822 + 0101 CONTINUE 02410822 +CT011* TEST 11 3*PI + 1/64 02420822 + IVTNUM = 11 02430822 + BVD = (3.0D0 * PIVD / 2.0D0) + 1.0D0 / 64.0D0 02440822 + AVD = DTAN(BVD) 02450822 + IF (AVD + 0.6399479162D+02) 20110, 10110, 40110 02460822 +40110 IF (AVD + 0.6399479155D+02) 10110, 10110, 20110 02470822 +10110 IVPASS = IVPASS + 1 02480822 + WRITE (NUVI, 80002) IVTNUM 02490822 + GO TO 0111 02500822 +20110 IVFAIL = IVFAIL + 1 02510822 + DVCORR = -63.994791581893645218D+00 02520822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02530822 + 0111 CONTINUE 02540822 +CT012* TEST 12 LARGE VALUE TO TEST ARGUMENT REDUCTION 02550822 + IVTNUM = 12 02560822 + AVD = DTAN(2000.0D0) 02570822 + IF (AVD + 0.2530998330D+01) 20120, 10120, 40120 02580822 +40120 IF (AVD + 0.2530998326D+01) 10120, 10120, 20120 02590822 +10120 IVPASS = IVPASS + 1 02600822 + WRITE (NUVI, 80002) IVTNUM 02610822 + GO TO 0121 02620822 +20120 IVFAIL = IVFAIL + 1 02630822 + DVCORR = -2.5309983280933409104D+00 02640822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02650822 + 0121 CONTINUE 02660822 +CT013* TEST 13 ARGUMENT OF LOW MAGNITUDE 02670822 + IVTNUM = 13 02680822 + BVD = PIVD * 1.0D-15 02690822 + AVD = DTAN(BVD) 02700822 + IF (AVD - 0.3141592652D-14) 20130, 10130, 40130 02710822 +40130 IF (AVD - 0.3141592655D-14) 10130, 10130, 20130 02720822 +10130 IVPASS = IVPASS + 1 02730822 + WRITE (NUVI, 80002) IVTNUM 02740822 + GO TO 0131 02750822 +20130 IVFAIL = IVFAIL + 1 02760822 + DVCORR = 3.1415926535897932385D-15 02770822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02780822 + 0131 CONTINUE 02790822 +CT014* TEST 14 THE FUNCTION APPLIED TWICE 02800822 + IVTNUM = 14 02810822 + AVD = DTAN(PIVD / 6.0D0) * DTAN(PIVD / 6.0D0) 02820822 + IF (AVD - 0.3333333331D+00) 20140, 10140, 40140 02830822 +40140 IF (AVD - 0.3333333335D+00) 10140, 10140, 20140 02840822 +10140 IVPASS = IVPASS + 1 02850822 + WRITE (NUVI, 80002) IVTNUM 02860822 + GO TO 0141 02870822 +20140 IVFAIL = IVFAIL + 1 02880822 + DVCORR = 0.33333333333333333333D+00 02890822 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02900822 + 0141 CONTINUE 02910822 +C***** 02920822 +CBB** ********************** BBCSUM0 **********************************02930822 +C**** WRITE OUT TEST SUMMARY 02940822 +C**** 02950822 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02960822 + WRITE (I02, 90004) 02970822 + WRITE (I02, 90014) 02980822 + WRITE (I02, 90004) 02990822 + WRITE (I02, 90020) IVPASS 03000822 + WRITE (I02, 90022) IVFAIL 03010822 + WRITE (I02, 90024) IVDELE 03020822 + WRITE (I02, 90026) IVINSP 03030822 + WRITE (I02, 90028) IVTOTN, IVTOTL 03040822 +CBE** ********************** BBCSUM0 **********************************03050822 +CBB** ********************** BBCFOOT0 **********************************03060822 +C**** WRITE OUT REPORT FOOTINGS 03070822 +C**** 03080822 + WRITE (I02,90016) ZPROG, ZPROG 03090822 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03100822 + WRITE (I02,90019) 03110822 +CBE** ********************** BBCFOOT0 **********************************03120822 +CBB** ********************** BBCFMT0A **********************************03130822 +C**** FORMATS FOR TEST DETAIL LINES 03140822 +C**** 03150822 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03160822 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03170822 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03180822 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03190822 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03200822 + 1I6,/," ",15X,"CORRECT= " ,I6) 03210822 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03220822 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03230822 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03240822 + 1A21,/," ",16X,"CORRECT= " ,A21) 03250822 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03260822 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03270822 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03280822 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03290822 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03300822 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03310822 +80050 FORMAT (" ",48X,A31) 03320822 +CBE** ********************** BBCFMT0A **********************************03330822 +CBB** ********************** BBCFMAT1 **********************************03340822 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03350822 +C**** 03360822 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03370822 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03380822 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03390822 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03400822 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03410822 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03420822 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03430822 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03440822 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03450822 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03460822 + 2"(",F12.5,", ",F12.5,")") 03470822 +CBE** ********************** BBCFMAT1 **********************************03480822 +CBB** ********************** BBCFMT0B **********************************03490822 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03500822 +C**** 03510822 +90002 FORMAT ("1") 03520822 +90004 FORMAT (" ") 03530822 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03540822 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03550822 +90008 FORMAT (" ",21X,A13,A17) 03560822 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03570822 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03580822 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03590822 + 1 7X,"REMARKS",24X) 03600822 +90014 FORMAT (" ","----------------------------------------------" , 03610822 + 1 "---------------------------------" ) 03620822 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03630822 +C**** 03640822 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03650822 +C**** 03660822 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03670822 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03680822 + 1 A13) 03690822 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03700822 +C**** 03710822 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03720822 +C**** 03730822 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03740822 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03750822 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03760822 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03770822 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03780822 +CBE** ********************** BBCFMT0B **********************************03790822 +C***** 03800822 +C***** END OF TEST SEGMENT 192 03810822 + STOP 03820822 + END 03830822 diff --git a/Fortran/UnitTests/fcvs21_f95/FM822.reference_output b/Fortran/UnitTests/fcvs21_f95/FM822.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM822.reference_output @@ -0,0 +1,48 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM822BEGIN* TEST RESULTS - FM822 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDTAN - (192) INTRINSIC FUNCTIONS + + DTAN (DOUBLE PRECISION TANGENT) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 14 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + + ------------------------------------------------------------------------------- + + 14 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 14 OF 14 TESTS EXECUTED + + *FM822END* END OF TEST - FM822 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM823.f b/Fortran/UnitTests/fcvs21_f95/FM823.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM823.f @@ -0,0 +1,362 @@ + PROGRAM FM823 + +C***********************************************************************00010823 +C***** FORTRAN 77 00020823 +C***** FM823 00030823 +C***** YDASIN - (194) 00040823 +C***** 00050823 +C***********************************************************************00060823 +C***** GENERAL PURPOSE ANS REF 00070823 +C***** TEST INTRINSIC FUNCTION DASIN, DACOS 15.3 00080823 +C***** TABLE 5 00090823 +C***** 00100823 +CBB** ********************** BBCCOMNT **********************************00110823 +C**** 00120823 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130823 +C**** VERSION 2.1 00140823 +C**** 00150823 +C**** 00160823 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170823 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180823 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190823 +C**** BUILDING 225 RM A266 00200823 +C**** GAITHERSBURG, MD 20899 00210823 +C**** 00220823 +C**** 00230823 +C**** 00240823 +CBE** ********************** BBCCOMNT **********************************00250823 +C***** 00260823 +C***** S P E C I F I C A T I O N S SEGMENT 194 00270823 + DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00280823 +C***** 00290823 +CBB** ********************** BBCINITA **********************************00300823 +C**** SPECIFICATION STATEMENTS 00310823 +C**** 00320823 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330823 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340823 +CBE** ********************** BBCINITA **********************************00350823 +CBB** ********************** BBCINITB **********************************00360823 +C**** INITIALIZE SECTION 00370823 + DATA ZVERS, ZVERSD, ZDATE 00380823 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390823 + DATA ZCOMPL, ZNAME, ZTAPE 00400823 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410823 + DATA ZPROJ, ZTAPED, ZPROG 00420823 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430823 + DATA REMRKS /' '/ 00440823 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450823 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460823 +C**** 00470823 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480823 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490823 +CZ03 ZPROG = 'PROGRAM NAME' 00500823 +CZ04 ZDATE = 'DATE OF TEST' 00510823 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520823 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530823 +CZ07 ZNAME = 'NAME OF USER' 00540823 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00550823 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00560823 +C 00570823 + IVPASS = 0 00580823 + IVFAIL = 0 00590823 + IVDELE = 0 00600823 + IVINSP = 0 00610823 + IVTOTL = 0 00620823 + IVTOTN = 0 00630823 + ICZERO = 0 00640823 +C 00650823 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660823 + I01 = 05 00670823 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680823 + I02 = 06 00690823 +C 00700823 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710823 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720823 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730823 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740823 +C 00750823 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760823 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770823 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780823 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790823 +C 00800823 +CBE** ********************** BBCINITB **********************************00810823 + NUVI = I02 00820823 + IVTOTL = 12 00830823 + ZPROG = 'FM823' 00840823 +CBB** ********************** BBCHED0A **********************************00850823 +C**** 00860823 +C**** WRITE REPORT TITLE 00870823 +C**** 00880823 + WRITE (I02, 90002) 00890823 + WRITE (I02, 90006) 00900823 + WRITE (I02, 90007) 00910823 + WRITE (I02, 90008) ZVERS, ZVERSD 00920823 + WRITE (I02, 90009) ZPROG, ZPROG 00930823 + WRITE (I02, 90010) ZDATE, ZCOMPL 00940823 +CBE** ********************** BBCHED0A **********************************00950823 +C***** 00960823 +C***** HEADER FOR SEGMENT 194 00970823 + WRITE(NUVI,19400) 00980823 +19400 FORMAT(" ", / " YDASIN - (194) INTRINSIC FUNCTIONS" // 00990823 + 1 " DASIN, DACOS (DOUBLE PRECISION ARCSINE, ARCCOSINE)" //01000823 + 2 " ANS REF. - 15.3" ) 01010823 +CBB** ********************** BBCHED0B **********************************01020823 +C**** WRITE DETAIL REPORT HEADERS 01030823 +C**** 01040823 + WRITE (I02,90004) 01050823 + WRITE (I02,90004) 01060823 + WRITE (I02,90013) 01070823 + WRITE (I02,90014) 01080823 + WRITE (I02,90015) IVTOTL 01090823 +CBE** ********************** BBCHED0B **********************************01100823 +C***** 01110823 + WRITE(NUVI,19401) 01120823 +19401 FORMAT("0",8X,"TEST OF DASIN" ) 01130823 +C***** 01140823 +CT001* TEST 1 -1.0D0 FOR PRINCIPAL VALUE AT ENDPOINTS 01150823 + IVTNUM = 1 01160823 + BVD = -1.0D0 01170823 + AVD = DASIN(BVD) 01180823 + IF (AVD + 0.1570796328D+01) 20010, 10010, 40010 01190823 +40010 IF (AVD + 0.1570796326D+01) 10010, 10010, 20010 01200823 +10010 IVPASS = IVPASS + 1 01210823 + WRITE (NUVI, 80002) IVTNUM 01220823 + GO TO 0011 01230823 +20010 IVFAIL = IVFAIL + 1 01240823 + DVCORR = -1.5707963267948966192D+00 01250823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01260823 + 0011 CONTINUE 01270823 +CT002* TEST 2 +1.0D0 FOR PRINCIPAL VALUE AT ENDPOINTS 01280823 + IVTNUM = 2 01290823 + AVD = DASIN(1.0D0) 01300823 + IF (AVD - 0.1570796326D+01) 20020, 10020, 40020 01310823 +40020 IF (AVD - 0.1570796328D+01) 10020, 10020, 20020 01320823 +10020 IVPASS = IVPASS + 1 01330823 + WRITE (NUVI, 80002) IVTNUM 01340823 + GO TO 0021 01350823 +20020 IVFAIL = IVFAIL + 1 01360823 + DVCORR = 1.5707963267948966192D+00 01370823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01380823 + 0021 CONTINUE 01390823 +CT003* TEST 3 THE VALUE -DSQRT(0.5D0) 01400823 + IVTNUM = 3 01410823 + BVD = -(DSQRT(2.0D0) / 2.0D0) 01420823 + AVD = DASIN(BVD) 01430823 + IF (AVD + 0.7853981638D+00) 20030, 10030, 40030 01440823 +40030 IF (AVD + 0.7853981630D+00) 10030, 10030, 20030 01450823 +10030 IVPASS = IVPASS + 1 01460823 + WRITE (NUVI, 80002) IVTNUM 01470823 + GO TO 0031 01480823 +20030 IVFAIL = IVFAIL + 1 01490823 + DVCORR = -0.78539816339744830962D+00 01500823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01510823 + 0031 CONTINUE 01520823 +CT004* TEST 4 THE VALUE 0.5D0 01530823 + IVTNUM = 4 01540823 + AVD = DASIN(1.0D0 / 2.0D0) 01550823 + IF (AVD - 0.5235987753D+00) 20040, 10040, 40040 01560823 +40040 IF (AVD - 0.5235987759D+00) 10040, 10040, 20040 01570823 +10040 IVPASS = IVPASS + 1 01580823 + WRITE (NUVI, 80002) IVTNUM 01590823 + GO TO 0041 01600823 +20040 IVFAIL = IVFAIL + 1 01610823 + DVCORR = 0.52359877559829887308D+00 01620823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01630823 + 0041 CONTINUE 01640823 +CT005* TEST 5 AN ARGUMENT OF LOW MAGNITUDE 01650823 + IVTNUM = 5 01660823 + AVD = DASIN(-1.0D-13) 01670823 + IF (AVD + 0.1000000001D-12) 20050, 10050, 40050 01680823 +40050 IF (AVD + 0.9999999995D-13) 10050, 10050, 20050 01690823 +10050 IVPASS = IVPASS + 1 01700823 + WRITE (NUVI, 80002) IVTNUM 01710823 + GO TO 0051 01720823 +20050 IVFAIL = IVFAIL + 1 01730823 + DVCORR = -1.0000000000000000000D-13 01740823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01750823 + 0051 CONTINUE 01760823 +C***** 01770823 + WRITE(NUVI,19407) 01780823 +19407 FORMAT("0",8X,"TEST OF DACOS" ) 01790823 +C***** 01800823 +CT006* TEST 6 -1.0D0 FOR PRINCIPAL VALUE AT ENDPOINTS 01810823 + IVTNUM = 6 01820823 + BVD = -1.0D0 01830823 + AVD = DACOS(BVD) 01840823 + IF (AVD - 0.3141592652D+01) 20060, 10060, 40060 01850823 +40060 IF (AVD - 0.3141592655D+01) 10060, 10060, 20060 01860823 +10060 IVPASS = IVPASS + 1 01870823 + WRITE (NUVI, 80002) IVTNUM 01880823 + GO TO 0061 01890823 +20060 IVFAIL = IVFAIL + 1 01900823 + DVCORR = 3.1415926535897932384D+00 01910823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01920823 + 0061 CONTINUE 01930823 +CT007* TEST 7 +1.0D0 TO TEST PRINCIPAL VALUE AT ENDPOINTS 01940823 + IVTNUM = 7 01950823 + AVD = DACOS(1.0D0) 01960823 + IF (AVD + 0.5000000000D-09) 20070, 10070, 40070 01970823 +40070 IF (AVD - 0.5000000000D-09) 10070, 10070, 20070 01980823 +10070 IVPASS = IVPASS + 1 01990823 + WRITE (NUVI, 80002) IVTNUM 02000823 + GO TO 0071 02010823 +20070 IVFAIL = IVFAIL + 1 02020823 + DVCORR = 0.00000000000000000000D+00 02030823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02040823 + 0071 CONTINUE 02050823 +CT008* TEST 8 THE VALUE -DSQRT(0.5D0) 02060823 + IVTNUM = 8 02070823 + BVD = -(DSQRT(2.0D0) / 2.0D0) 02080823 + AVD = DACOS(BVD) 02090823 + IF (AVD - 0.2356194489D+01) 20080, 10080, 40080 02100823 +40080 IF (AVD - 0.2356194492D+01) 10080, 10080, 20080 02110823 +10080 IVPASS = IVPASS + 1 02120823 + WRITE (NUVI, 80002) IVTNUM 02130823 + GO TO 0081 02140823 +20080 IVFAIL = IVFAIL + 1 02150823 + DVCORR = 2.3561944901923449288D+00 02160823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02170823 + 0081 CONTINUE 02180823 +CT009* TEST 9 THE VALUE 0.5D0 02190823 + IVTNUM = 9 02200823 + AVD = DACOS(1.0D0 / 2.0D0) 02210823 + IF (AVD - 0.1047197550D+01) 20090, 10090, 40090 02220823 +40090 IF (AVD - 0.1047197552D+01) 10090, 10090, 20090 02230823 +10090 IVPASS = IVPASS + 1 02240823 + WRITE (NUVI, 80002) IVTNUM 02250823 + GO TO 0091 02260823 +20090 IVFAIL = IVFAIL + 1 02270823 + DVCORR = 1.0471975511965977461D+00 02280823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02290823 + 0091 CONTINUE 02300823 +CT010* TEST 10 AN ARGUMENT OF LOW MAGNITUDE 02310823 + IVTNUM = 10 02320823 + AVD = DACOS(-1.0D-33) 02330823 + IF (AVD - 0.1570796326D+01) 20100, 10100, 40100 02340823 +40100 IF (AVD - 0.1570796328D+01) 10100, 10100, 20100 02350823 +10100 IVPASS = IVPASS + 1 02360823 + WRITE (NUVI, 80002) IVTNUM 02370823 + GO TO 0101 02380823 +20100 IVFAIL = IVFAIL + 1 02390823 + DVCORR = 1.5707963267948966192D+00 02400823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02410823 + 0101 CONTINUE 02420823 +CT011* TEST 11 COMPARISON OF DASIN AND DACOS FOR RIGHT RELATIONSHIP 02430823 + IVTNUM = 11 02440823 + BVD = DASIN(DSQRT(3.0D0) / 3.0D0) 02450823 + CVD = DACOS(DSQRT(3.0D0) / 3.0D0) 02460823 + AVD = (BVD + CVD) * 2.0D0 02470823 + IF (AVD - 0.3141592652D+01) 20110, 10110, 40110 02480823 +40110 IF (AVD - 0.3141592655D+01) 10110, 10110, 20110 02490823 +10110 IVPASS = IVPASS + 1 02500823 + WRITE (NUVI, 80002) IVTNUM 02510823 + GO TO 0111 02520823 +20110 IVFAIL = IVFAIL + 1 02530823 + DVCORR = 3.1415926535897932384D+00 02540823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02550823 + 0111 CONTINUE 02560823 +CT012* TEST 12 COMPARISON OF DASIN AND DACOS TO TEST RELATIONSHIP 02570823 + IVTNUM = 12 02580823 + AVD = (DASIN(+0.25D0) + DACOS(+0.25D0)) * 2.0D0 02590823 + IF (AVD - 0.3141592652D+01) 20120, 10120, 40120 02600823 +40120 IF (AVD - 0.3141592655D+01) 10120, 10120, 20120 02610823 +10120 IVPASS = IVPASS + 1 02620823 + WRITE (NUVI, 80002) IVTNUM 02630823 + GO TO 0121 02640823 +20120 IVFAIL = IVFAIL + 1 02650823 + DVCORR = 3.1415926535897932384D+00 02660823 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02670823 + 0121 CONTINUE 02680823 +C***** 02690823 +CBB** ********************** BBCSUM0 **********************************02700823 +C**** WRITE OUT TEST SUMMARY 02710823 +C**** 02720823 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02730823 + WRITE (I02, 90004) 02740823 + WRITE (I02, 90014) 02750823 + WRITE (I02, 90004) 02760823 + WRITE (I02, 90020) IVPASS 02770823 + WRITE (I02, 90022) IVFAIL 02780823 + WRITE (I02, 90024) IVDELE 02790823 + WRITE (I02, 90026) IVINSP 02800823 + WRITE (I02, 90028) IVTOTN, IVTOTL 02810823 +CBE** ********************** BBCSUM0 **********************************02820823 +CBB** ********************** BBCFOOT0 **********************************02830823 +C**** WRITE OUT REPORT FOOTINGS 02840823 +C**** 02850823 + WRITE (I02,90016) ZPROG, ZPROG 02860823 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02870823 + WRITE (I02,90019) 02880823 +CBE** ********************** BBCFOOT0 **********************************02890823 +CBB** ********************** BBCFMT0A **********************************02900823 +C**** FORMATS FOR TEST DETAIL LINES 02910823 +C**** 02920823 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02930823 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02940823 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02950823 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02960823 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02970823 + 1I6,/," ",15X,"CORRECT= " ,I6) 02980823 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02990823 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03000823 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03010823 + 1A21,/," ",16X,"CORRECT= " ,A21) 03020823 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03030823 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03040823 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03050823 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03060823 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03070823 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03080823 +80050 FORMAT (" ",48X,A31) 03090823 +CBE** ********************** BBCFMT0A **********************************03100823 +CBB** ********************** BBCFMAT1 **********************************03110823 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03120823 +C**** 03130823 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03140823 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03150823 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03160823 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03170823 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03180823 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03190823 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03200823 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03210823 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03220823 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03230823 + 2"(",F12.5,", ",F12.5,")") 03240823 +CBE** ********************** BBCFMAT1 **********************************03250823 +CBB** ********************** BBCFMT0B **********************************03260823 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03270823 +C**** 03280823 +90002 FORMAT ("1") 03290823 +90004 FORMAT (" ") 03300823 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03310823 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03320823 +90008 FORMAT (" ",21X,A13,A17) 03330823 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03340823 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03350823 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03360823 + 1 7X,"REMARKS",24X) 03370823 +90014 FORMAT (" ","----------------------------------------------" , 03380823 + 1 "---------------------------------" ) 03390823 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03400823 +C**** 03410823 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03420823 +C**** 03430823 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03440823 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03450823 + 1 A13) 03460823 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03470823 +C**** 03480823 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03490823 +C**** 03500823 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03510823 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03520823 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03530823 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03540823 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03550823 +CBE** ********************** BBCFMT0B **********************************03560823 +C***** 03570823 +C***** END OF TEST SEGMENT 194 03580823 + STOP 03590823 + END 03600823 diff --git a/Fortran/UnitTests/fcvs21_f95/FM823.reference_output b/Fortran/UnitTests/fcvs21_f95/FM823.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM823.reference_output @@ -0,0 +1,48 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM823BEGIN* TEST RESULTS - FM823 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDASIN - (194) INTRINSIC FUNCTIONS + + DASIN, DACOS (DOUBLE PRECISION ARCSINE, ARCCOSINE) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 12 TESTS + +0 TEST OF DASIN + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS +0 TEST OF DACOS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ------------------------------------------------------------------------------- + + 12 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 12 OF 12 TESTS EXECUTED + + *FM823END* END OF TEST - FM823 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM824.f b/Fortran/UnitTests/fcvs21_f95/FM824.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM824.f @@ -0,0 +1,382 @@ + PROGRAM FM824 + +C***********************************************************************00010824 +C***** FORTRAN 77 00020824 +C***** FM824 00030824 +C***** YDATAN - (196) 00040824 +C***** 00050824 +C***********************************************************************00060824 +C***** GENERAL PURPOSE ANS REF 00070824 +C***** TEST INTRINSIC FUNCTION DATAN, DATAN2 15.3 00080824 +C***** INTRINSIC FUNCTION DSQRT ASSUMED WORKING TABLE 5 00090824 +C***** 00100824 +CBB** ********************** BBCCOMNT **********************************00110824 +C**** 00120824 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130824 +C**** VERSION 2.1 00140824 +C**** 00150824 +C**** 00160824 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170824 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180824 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190824 +C**** BUILDING 225 RM A266 00200824 +C**** GAITHERSBURG, MD 20899 00210824 +C**** 00220824 +C**** 00230824 +C**** 00240824 +CBE** ********************** BBCCOMNT **********************************00250824 +C***** 00260824 +C***** S P E C I F I C A T I O N S SEGMENT 196 00270824 + DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00280824 +C***** 00290824 +CBB** ********************** BBCINITA **********************************00300824 +C**** SPECIFICATION STATEMENTS 00310824 +C**** 00320824 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330824 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340824 +CBE** ********************** BBCINITA **********************************00350824 +CBB** ********************** BBCINITB **********************************00360824 +C**** INITIALIZE SECTION 00370824 + DATA ZVERS, ZVERSD, ZDATE 00380824 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390824 + DATA ZCOMPL, ZNAME, ZTAPE 00400824 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410824 + DATA ZPROJ, ZTAPED, ZPROG 00420824 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430824 + DATA REMRKS /' '/ 00440824 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450824 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460824 +C**** 00470824 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480824 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490824 +CZ03 ZPROG = 'PROGRAM NAME' 00500824 +CZ04 ZDATE = 'DATE OF TEST' 00510824 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520824 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530824 +CZ07 ZNAME = 'NAME OF USER' 00540824 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00550824 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00560824 +C 00570824 + IVPASS = 0 00580824 + IVFAIL = 0 00590824 + IVDELE = 0 00600824 + IVINSP = 0 00610824 + IVTOTL = 0 00620824 + IVTOTN = 0 00630824 + ICZERO = 0 00640824 +C 00650824 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660824 + I01 = 05 00670824 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680824 + I02 = 06 00690824 +C 00700824 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710824 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720824 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730824 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740824 +C 00750824 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760824 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770824 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780824 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790824 +C 00800824 +CBE** ********************** BBCINITB **********************************00810824 + NUVI = I02 00820824 + IVTOTL = 13 00830824 + ZPROG = 'FM824' 00840824 +CBB** ********************** BBCHED0A **********************************00850824 +C**** 00860824 +C**** WRITE REPORT TITLE 00870824 +C**** 00880824 + WRITE (I02, 90002) 00890824 + WRITE (I02, 90006) 00900824 + WRITE (I02, 90007) 00910824 + WRITE (I02, 90008) ZVERS, ZVERSD 00920824 + WRITE (I02, 90009) ZPROG, ZPROG 00930824 + WRITE (I02, 90010) ZDATE, ZCOMPL 00940824 +CBE** ********************** BBCHED0A **********************************00950824 +C***** 00960824 +C***** HEADER FOR SEGMENT 196 00970824 + WRITE(NUVI,19600) 00980824 +19600 FORMAT(" ", / " YDATAN - (196) INTRINSIC FUNCTIONS" // 00990824 + 1 " DATAN, DATAN2 (DOUBLE PRECISION ARCTANGENT)" // 01000824 + 2 " ANS REF. - 15.3" ) 01010824 +CBB** ********************** BBCHED0B **********************************01020824 +C**** WRITE DETAIL REPORT HEADERS 01030824 +C**** 01040824 + WRITE (I02,90004) 01050824 + WRITE (I02,90004) 01060824 + WRITE (I02,90013) 01070824 + WRITE (I02,90014) 01080824 + WRITE (I02,90015) IVTOTL 01090824 +CBE** ********************** BBCHED0B **********************************01100824 +C***** 01110824 + WRITE(NUVI,19601) 01120824 +19601 FORMAT(/ 8X, "TEST OF DATAN" ) 01130824 +C***** 01140824 +CT001* TEST 1 LARGE ARGUMENT VALUES TO TEST SINGULARITY 01150824 + IVTNUM = 1 01160824 + BVD = 500.0D0 01170824 + AVD = DATAN(BVD) 01180824 + IF (AVD - 0.1568796328D+01) 20010, 10010, 40010 01190824 +40010 IF (AVD - 0.1568796331D+01) 10010, 10010, 20010 01200824 +10010 IVPASS = IVPASS + 1 01210824 + WRITE (NUVI, 80002) IVTNUM 01220824 + GO TO 0011 01230824 +20010 IVFAIL = IVFAIL + 1 01240824 + DVCORR = 1.5687963294632946155D+00 01250824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01260824 + 0011 CONTINUE 01270824 +CT002* TEST 2 LARGE ARGUMENT VALUES TO TEST SINGULARITY 01280824 + IVTNUM = 2 01290824 + AVD = DATAN(-1000.0D0) 01300824 + IF (AVD + 0.1569796328D+01) 20020, 10020, 40020 01310824 +40020 IF (AVD + 0.1569796326D+01) 10020, 10020, 20020 01320824 +10020 IVPASS = IVPASS + 1 01330824 + WRITE (NUVI, 80002) IVTNUM 01340824 + GO TO 0021 01350824 +20020 IVFAIL = IVFAIL + 1 01360824 + DVCORR = -1.5697963271282297525D+00 01370824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01380824 + 0021 CONTINUE 01390824 +CT003* TEST 3 AN EXPRESSION PRESENTED TO DATAN 01400824 + IVTNUM = 3 01410824 + AVD = DATAN(100.0D0 / 100.0D0) 01420824 + IF (AVD - 0.7853981630D+00) 20030, 10030, 40030 01430824 +40030 IF (AVD - 0.7853981638D+00) 10030, 10030, 20030 01440824 +10030 IVPASS = IVPASS + 1 01450824 + WRITE (NUVI, 80002) IVTNUM 01460824 + GO TO 0031 01470824 +20030 IVFAIL = IVFAIL + 1 01480824 + DVCORR = 0.78539816339744830962D+00 01490824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01500824 + 0031 CONTINUE 01510824 +CT004* TEST 4 THE FUNCTION DSQRT EVALUATED AND PRESENTED 01520824 +C***** AS AN ARGUMENT 01530824 + IVTNUM = 4 01540824 + BVD = -DSQRT(3.0D0) 01550824 + AVD = DATAN(BVD) 01560824 + IF (AVD + 0.1047197552D+01) 20040, 10040, 40040 01570824 +40040 IF (AVD + 0.1047197550D+01) 10040, 10040, 20040 01580824 +10040 IVPASS = IVPASS + 1 01590824 + WRITE (NUVI, 80002) IVTNUM 01600824 + GO TO 0041 01610824 +20040 IVFAIL = IVFAIL + 1 01620824 + DVCORR = -1.0471975511965977461D+00 01630824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01640824 + 0041 CONTINUE 01650824 +CT005* TEST 5 AN ARGUMENT OF LOW MAGNITUDE 01660824 + IVTNUM = 5 01670824 + AVD = DATAN(1.0D-16) 01680824 + IF (AVD - 0.9999999995D-16) 20050, 10050, 40050 01690824 +40050 IF (AVD - 0.1000000001D-15) 10050, 10050, 20050 01700824 +10050 IVPASS = IVPASS + 1 01710824 + WRITE (NUVI, 80002) IVTNUM 01720824 + GO TO 0051 01730824 +20050 IVFAIL = IVFAIL + 1 01740824 + DVCORR = 1.0000000000000000000D-16 01750824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01760824 + 0051 CONTINUE 01770824 +CT006* TEST 6 AN ARGUMENT OF HIGH MAGNITUDE 01780824 + IVTNUM = 6 01790824 + AVD = DATAN(-2.0D+34) 01800824 + IF (AVD + 0.1570796328D+01) 20060, 10060, 40060 01810824 +40060 IF (AVD + 0.1570796326D+01) 10060, 10060, 20060 01820824 +10060 IVPASS = IVPASS + 1 01830824 + WRITE (NUVI, 80002) IVTNUM 01840824 + GO TO 0061 01850824 +20060 IVFAIL = IVFAIL + 1 01860824 + DVCORR = -1.5707963267948966192D+00 01870824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01880824 + 0061 CONTINUE 01890824 +C***** 01900824 + WRITE(NUVI,19608) 01910824 +19608 FORMAT(/ 08X, "TEST OF DATAN2" ) 01920824 +CT007* TEST 7 TEST (0,POSITIVE) TO TEST DISCONTINUITY 01930824 + IVTNUM = 7 01940824 + BVD = 10.0D0 / 10.0D0 01950824 + CVD = 0.0D0 01960824 + AVD = DATAN2(CVD, BVD) 01970824 + IF (AVD + 0.5000000000D-09) 20070, 10070, 40070 01980824 +40070 IF (AVD - 0.5000000000D-09) 10070, 10070, 20070 01990824 +10070 IVPASS = IVPASS + 1 02000824 + WRITE (NUVI, 80002) IVTNUM 02010824 + GO TO 0071 02020824 +20070 IVFAIL = IVFAIL + 1 02030824 + DVCORR = 0.00000000000000000000D+00 02040824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02050824 + 0071 CONTINUE 02060824 +CT008* TEST 8 TEST (0,NEGATIVE) TO TEST DISCONTINUITY 02070824 + IVTNUM = 8 02080824 + BVD = 0.0D0 02090824 + CVD = -25.0D0 / 2.0D0 02100824 + AVD = DATAN2(BVD, CVD) 02110824 + IF (AVD - 0.3141592652D+01) 20080, 10080, 40080 02120824 +40080 IF (AVD - 0.3141592655D+01) 10080, 10080, 20080 02130824 +10080 IVPASS = IVPASS + 1 02140824 + WRITE (NUVI, 80002) IVTNUM 02150824 + GO TO 0081 02160824 +20080 IVFAIL = IVFAIL + 1 02170824 + DVCORR = 3.1415926535897932384D+00 02180824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02190824 + 0081 CONTINUE 02200824 +CT009* TEST 9 AN EXPRESSION PRESENTED TO DATAN2 02210824 + IVTNUM = 9 02220824 + BVD = 1.0D0 02230824 + CVD = BVD + BVD 02240824 + AVD = DATAN2(BVD * 2.0D0, CVD) 02250824 + IF (AVD - 0.7853981630D+00) 20090, 10090, 40090 02260824 +40090 IF (AVD - 0.7853981638D+00) 10090, 10090, 20090 02270824 +10090 IVPASS = IVPASS + 1 02280824 + WRITE (NUVI, 80002) IVTNUM 02290824 + GO TO 0091 02300824 +20090 IVFAIL = IVFAIL + 1 02310824 + DVCORR = 0.78539816339744830962D+00 02320824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02330824 + 0091 CONTINUE 02340824 +CT010* TEST 10 ARGUMENTS WHERE (X,Y) X IS NEAR ZERO 02350824 + IVTNUM = 10 02360824 + BVD = DASIN(0.6D0) 02370824 + CVD = DACOS(0.8D0) 02380824 + AVD = DATAN2(BVD, CVD) 02390824 + IF (AVD - 0.7853981630D+00) 20100, 10100, 40100 02400824 +40100 IF (AVD - 0.7853981638D+00) 10100, 10100, 20100 02410824 +10100 IVPASS = IVPASS + 1 02420824 + WRITE (NUVI, 80002) IVTNUM 02430824 + GO TO 0101 02440824 +20100 IVFAIL = IVFAIL + 1 02450824 + DVCORR = 0.78539816339744830962D+00 02460824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02470824 + 0101 CONTINUE 02480824 +CT011* TEST 11 WHERE ARGUMENT (X,Y) Y IS NEAR ZERO 02490824 + IVTNUM = 11 02500824 + AVD = DATAN2(1.2D0, 0.0D0) 02510824 + IF (AVD - 0.1570796326D+01) 20110, 10110, 40110 02520824 +40110 IF (AVD - 0.1570796328D+01) 10110, 10110, 20110 02530824 +10110 IVPASS = IVPASS + 1 02540824 + WRITE (NUVI, 80002) IVTNUM 02550824 + GO TO 0111 02560824 +20110 IVFAIL = IVFAIL + 1 02570824 + DVCORR = 1.5707963267948966192D+00 02580824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02590824 + 0111 CONTINUE 02600824 +CT012* TEST 12 WHERE ARGUMENT (X,Y) Y IS NEAR ZERO 02610824 + IVTNUM = 12 02620824 + BVD = -2.5D0 02630824 + CVD = 0.0D0 02640824 + AVD = DATAN2(BVD, CVD) 02650824 + IF (AVD + 0.1570796328D+01) 20120, 10120, 40120 02660824 +40120 IF (AVD + 0.1570796326D+01) 10120, 10120, 20120 02670824 +10120 IVPASS = IVPASS + 1 02680824 + WRITE (NUVI, 80002) IVTNUM 02690824 + GO TO 0121 02700824 +20120 IVFAIL = IVFAIL + 1 02710824 + DVCORR = -1.5707963267948966192D+00 02720824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02730824 + 0121 CONTINUE 02740824 +CT013* TEST 13 COMPARISON OF DATAN AND DATAN2 02750824 + IVTNUM = 13 02760824 + AVD = (DATAN(DSQRT(3.0D0) / 3.0D0) * 2.0D0) + 02770824 + 1 DATAN2(-DSQRT(3.0D0) / 2.0D0, 1.0D0 / 2.0D0) 02780824 + IF (AVD + 0.5000000000D-09) 20130, 10130, 40130 02790824 +40130 IF (AVD - 0.5000000000D-09) 10130, 10130, 20130 02800824 +10130 IVPASS = IVPASS + 1 02810824 + WRITE (NUVI, 80002) IVTNUM 02820824 + GO TO 0131 02830824 +20130 IVFAIL = IVFAIL + 1 02840824 + DVCORR = 0.00000000000000000000D+00 02850824 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02860824 + 0131 CONTINUE 02870824 +C***** 02880824 +CBB** ********************** BBCSUM0 **********************************02890824 +C**** WRITE OUT TEST SUMMARY 02900824 +C**** 02910824 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02920824 + WRITE (I02, 90004) 02930824 + WRITE (I02, 90014) 02940824 + WRITE (I02, 90004) 02950824 + WRITE (I02, 90020) IVPASS 02960824 + WRITE (I02, 90022) IVFAIL 02970824 + WRITE (I02, 90024) IVDELE 02980824 + WRITE (I02, 90026) IVINSP 02990824 + WRITE (I02, 90028) IVTOTN, IVTOTL 03000824 +CBE** ********************** BBCSUM0 **********************************03010824 +CBB** ********************** BBCFOOT0 **********************************03020824 +C**** WRITE OUT REPORT FOOTINGS 03030824 +C**** 03040824 + WRITE (I02,90016) ZPROG, ZPROG 03050824 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03060824 + WRITE (I02,90019) 03070824 +CBE** ********************** BBCFOOT0 **********************************03080824 +CBB** ********************** BBCFMT0A **********************************03090824 +C**** FORMATS FOR TEST DETAIL LINES 03100824 +C**** 03110824 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03120824 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03130824 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03140824 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03150824 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03160824 + 1I6,/," ",15X,"CORRECT= " ,I6) 03170824 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03180824 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03190824 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03200824 + 1A21,/," ",16X,"CORRECT= " ,A21) 03210824 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03220824 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03230824 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03240824 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03250824 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03260824 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03270824 +80050 FORMAT (" ",48X,A31) 03280824 +CBE** ********************** BBCFMT0A **********************************03290824 +CBB** ********************** BBCFMAT1 **********************************03300824 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03310824 +C**** 03320824 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03330824 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03340824 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03350824 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03360824 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03370824 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03380824 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03390824 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03400824 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03410824 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03420824 + 2"(",F12.5,", ",F12.5,")") 03430824 +CBE** ********************** BBCFMAT1 **********************************03440824 +CBB** ********************** BBCFMT0B **********************************03450824 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03460824 +C**** 03470824 +90002 FORMAT ("1") 03480824 +90004 FORMAT (" ") 03490824 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03500824 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03510824 +90008 FORMAT (" ",21X,A13,A17) 03520824 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03530824 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03540824 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03550824 + 1 7X,"REMARKS",24X) 03560824 +90014 FORMAT (" ","----------------------------------------------" , 03570824 + 1 "---------------------------------" ) 03580824 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03590824 +C**** 03600824 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03610824 +C**** 03620824 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03630824 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03640824 + 1 A13) 03650824 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03660824 +C**** 03670824 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03680824 +C**** 03690824 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03700824 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03710824 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03720824 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03730824 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03740824 +CBE** ********************** BBCFMT0B **********************************03750824 +C***** 03760824 +C***** END OF TEST SEGMENT 196 03770824 + STOP 03780824 + END 03790824 + 03800824 diff --git a/Fortran/UnitTests/fcvs21_f95/FM824.reference_output b/Fortran/UnitTests/fcvs21_f95/FM824.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM824.reference_output @@ -0,0 +1,51 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM824BEGIN* TEST RESULTS - FM824 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDATAN - (196) INTRINSIC FUNCTIONS + + DATAN, DATAN2 (DOUBLE PRECISION ARCTANGENT) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 13 TESTS + + + TEST OF DATAN + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + + TEST OF DATAN2 + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + + ------------------------------------------------------------------------------- + + 13 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 13 OF 13 TESTS EXECUTED + + *FM824END* END OF TEST - FM824 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM825.f b/Fortran/UnitTests/fcvs21_f95/FM825.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM825.f @@ -0,0 +1,417 @@ + PROGRAM FM825 + +C***********************************************************************00010825 +C***** FORTRAN 77 00020825 +C***** FM825 00030825 +C***** YDSINH - (198) 00040825 +C***** 00050825 +C***********************************************************************00060825 +C***** GENERAL PURPOSE ANS REF 00070825 +C***** TEST INTRINSIC FUNCTION DSINH, DCOSH 15.3 00080825 +C***** TABLE 5 00090825 +CBB** ********************** BBCCOMNT **********************************00100825 +C**** 00110825 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120825 +C**** VERSION 2.1 00130825 +C**** 00140825 +C**** 00150825 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160825 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170825 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180825 +C**** BUILDING 225 RM A266 00190825 +C**** GAITHERSBURG, MD 20899 00200825 +C**** 00210825 +C**** 00220825 +C**** 00230825 +CBE** ********************** BBCCOMNT **********************************00240825 +C***** 00250825 +C***** S P E C I F I C A T I O N S SEGMENT 198 00260825 + DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00270825 +C***** 00280825 +CBB** ********************** BBCINITA **********************************00290825 +C**** SPECIFICATION STATEMENTS 00300825 +C**** 00310825 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320825 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330825 +CBE** ********************** BBCINITA **********************************00340825 +CBB** ********************** BBCINITB **********************************00350825 +C**** INITIALIZE SECTION 00360825 + DATA ZVERS, ZVERSD, ZDATE 00370825 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380825 + DATA ZCOMPL, ZNAME, ZTAPE 00390825 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400825 + DATA ZPROJ, ZTAPED, ZPROG 00410825 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420825 + DATA REMRKS /' '/ 00430825 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440825 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450825 +C**** 00460825 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470825 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480825 +CZ03 ZPROG = 'PROGRAM NAME' 00490825 +CZ04 ZDATE = 'DATE OF TEST' 00500825 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510825 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520825 +CZ07 ZNAME = 'NAME OF USER' 00530825 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540825 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550825 +C 00560825 + IVPASS = 0 00570825 + IVFAIL = 0 00580825 + IVDELE = 0 00590825 + IVINSP = 0 00600825 + IVTOTL = 0 00610825 + IVTOTN = 0 00620825 + ICZERO = 0 00630825 +C 00640825 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650825 + I01 = 05 00660825 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670825 + I02 = 06 00680825 +C 00690825 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700825 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710825 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720825 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730825 +C 00740825 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750825 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760825 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770825 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780825 +C 00790825 +CBE** ********************** BBCINITB **********************************00800825 + NUVI = I02 00810825 + IVTOTL = 16 00820825 + ZPROG = 'FM825' 00830825 +CBB** ********************** BBCHED0A **********************************00840825 +C**** 00850825 +C**** WRITE REPORT TITLE 00860825 +C**** 00870825 + WRITE (I02, 90002) 00880825 + WRITE (I02, 90006) 00890825 + WRITE (I02, 90007) 00900825 + WRITE (I02, 90008) ZVERS, ZVERSD 00910825 + WRITE (I02, 90009) ZPROG, ZPROG 00920825 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930825 +CBE** ********************** BBCHED0A **********************************00940825 +C***** 00950825 +C***** HEADER FOR SEGMENT 198 00960825 + WRITE(NUVI,19800) 00970825 +19800 FORMAT(" ", / " YDSINH - (198) INTRINSIC FUNCTIONS" // 00980825 + 1 " DSINH, DCOSH (DOUBLE PRECISION HYPERBOLIC SINE, COSINE)" // 00990825 + 2 " ANS REF. - 15.3" ) 01000825 +CBB** ********************** BBCHED0B **********************************01010825 +C**** WRITE DETAIL REPORT HEADERS 01020825 +C**** 01030825 + WRITE (I02,90004) 01040825 + WRITE (I02,90004) 01050825 + WRITE (I02,90013) 01060825 + WRITE (I02,90014) 01070825 + WRITE (I02,90015) IVTOTL 01080825 +CBE** ********************** BBCHED0B **********************************01090825 +C***** 01100825 + WRITE(NUVI,19801) 01110825 +19801 FORMAT(/ 8X, "TEST OF DSINH" ) 01120825 +C***** 01130825 +CT001* TEST 1 TEST AT ZERO (0.0D0) 01140825 + IVTNUM = 1 01150825 + BVD = 0.0D0 01160825 + AVD = DSINH(BVD) 01170825 + IF (AVD + 0.5000000000D-09) 20010, 10010, 40010 01180825 +40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010 01190825 +10010 IVPASS = IVPASS + 1 01200825 + WRITE (NUVI, 80002) IVTNUM 01210825 + GO TO 0011 01220825 +20010 IVFAIL = IVFAIL + 1 01230825 + DVCORR = 0.00000000000000000000D+00 01240825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01250825 + 0011 CONTINUE 01260825 +CT002* TEST 2 TEST ARGUMENTS CLOSE TO 1.0D0 01270825 + IVTNUM = 2 01280825 + AVD = DSINH(15.0D0 / 16.0D0) 01290825 + IF (AVD - 0.1080991915D+01) 20020, 10020, 40020 01300825 +40020 IF (AVD - 0.1080991917D+01) 10020, 10020, 20020 01310825 +10020 IVPASS = IVPASS + 1 01320825 + WRITE (NUVI, 80002) IVTNUM 01330825 + GO TO 0021 01340825 +20020 IVFAIL = IVFAIL + 1 01350825 + DVCORR = 1.0809919156930639401D+00 01360825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01370825 + 0021 CONTINUE 01380825 +CT003* TEST 3 TEST AT 1.0D0 01390825 + IVTNUM = 3 01400825 + BVD = 1.0D0 01410825 + AVD = DSINH(BVD) 01420825 + IF (AVD - 0.1175201193D+01) 20030, 10030, 40030 01430825 +40030 IF (AVD - 0.1175201195D+01) 10030, 10030, 20030 01440825 +10030 IVPASS = IVPASS + 1 01450825 + WRITE (NUVI, 80002) IVTNUM 01460825 + GO TO 0031 01470825 +20030 IVFAIL = IVFAIL + 1 01480825 + DVCORR = 1.1752011936438014569D+00 01490825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01500825 + 0031 CONTINUE 01510825 +CT004* TEST 4 TEST ARGUMENTS CLOSE TO 1.0D0 01520825 + IVTNUM = 4 01530825 + AVD = DSINH(33.0D0 / 32.0D0) 01540825 + IF (AVD - 0.1224004187D+01) 20040, 10040, 40040 01550825 +40040 IF (AVD - 0.1224004189D+01) 10040, 10040, 20040 01560825 +10040 IVPASS = IVPASS + 1 01570825 + WRITE (NUVI, 80002) IVTNUM 01580825 + GO TO 0041 01590825 +20040 IVFAIL = IVFAIL + 1 01600825 + DVCORR = 1.2240041877866398138D+00 01610825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01620825 + 0041 CONTINUE 01630825 +CT005* TEST 5 TEST AT 2.0D0 01640825 + IVTNUM = 5 01650825 + BVD = 2.0D0 01660825 + AVD = DSINH(BVD) 01670825 + IF (AVD - 0.3626860406D+01) 20050, 10050, 40050 01680825 +40050 IF (AVD - 0.3626860410D+01) 10050, 10050, 20050 01690825 +10050 IVPASS = IVPASS + 1 01700825 + WRITE (NUVI, 80002) IVTNUM 01710825 + GO TO 0051 01720825 +20050 IVFAIL = IVFAIL + 1 01730825 + DVCORR = 3.6268604078470187677D+00 01740825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01750825 + 0051 CONTINUE 01760825 +CT006* TEST 6 A NEGATIVE ARGUMENT 01770825 + IVTNUM = 6 01780825 + AVD = DSINH(-2.0D0) 01790825 + IF (AVD + 0.3626860410D+01) 20060, 10060, 40060 01800825 +40060 IF (AVD + 0.3626860406D+01) 10060, 10060, 20060 01810825 +10060 IVPASS = IVPASS + 1 01820825 + WRITE (NUVI, 80002) IVTNUM 01830825 + GO TO 0061 01840825 +20060 IVFAIL = IVFAIL + 1 01850825 + DVCORR = -3.6268604078470187677D+00 01860825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01870825 + 0061 CONTINUE 01880825 +CT007* TEST 7 AN ARGUMENT OF LOW MAGNITUDE 01890825 + IVTNUM = 7 01900825 + AVD = DSINH(1.0D-14) 01910825 + IF (AVD - 0.9999999995D-14) 20070, 10070, 40070 01920825 +40070 IF (AVD - 0.1000000001D-13) 10070, 10070, 20070 01930825 +10070 IVPASS = IVPASS + 1 01940825 + WRITE (NUVI, 80002) IVTNUM 01950825 + GO TO 0071 01960825 +20070 IVFAIL = IVFAIL + 1 01970825 + DVCORR = 1.0000000000000000000D-14 01980825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01990825 + 0071 CONTINUE 02000825 +C***** 02010825 + WRITE (NUVI, 90002) 02020825 + WRITE (NUVI, 90013) 02030825 + WRITE (NUVI, 90014) 02040825 +C***** 02050825 + WRITE(NUVI,19809) 02060825 +19809 FORMAT(/ 08X, "TEST OF DCOSH" ) 02070825 +C***** 02080825 +CT008* TEST 8 TEST AT ZERO (0.0D0) 02090825 + IVTNUM = 8 02100825 + BVD = 0.0D0 02110825 + AVD = DCOSH(BVD) 02120825 + IF (AVD - 0.9999999995D+00) 20080, 10080, 40080 02130825 +40080 IF (AVD - 0.1000000001D+01) 10080, 10080, 20080 02140825 +10080 IVPASS = IVPASS + 1 02150825 + WRITE (NUVI, 80002) IVTNUM 02160825 + GO TO 0081 02170825 +20080 IVFAIL = IVFAIL + 1 02180825 + DVCORR = 1.0000000000000000000D+00 02190825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02200825 + 0081 CONTINUE 02210825 +CT009* TEST 9 VALUES CLOSE TO 1.0D0 02220825 + IVTNUM = 9 02230825 + AVD = DCOSH(15.0D0 / 16.0D0) 02240825 + IF (AVD - 0.1472597541D+01) 20090, 10090, 40090 02250825 +40090 IF (AVD - 0.1472597543D+01) 10090, 10090, 20090 02260825 +10090 IVPASS = IVPASS + 1 02270825 + WRITE (NUVI, 80002) IVTNUM 02280825 + GO TO 0091 02290825 +20090 IVFAIL = IVFAIL + 1 02300825 + DVCORR = 1.4725975423698629333D+00 02310825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02320825 + 0091 CONTINUE 02330825 +CT010* TEST 10 TEST ARGUMENTS CLOSE TO 1.0D0 02340825 + IVTNUM = 10 02350825 + BVD = 1.0D0 02360825 + AVD = DCOSH(BVD) 02370825 + IF (AVD - 0.1543080634D+01) 20100, 10100, 40100 02380825 +40100 IF (AVD - 0.1543080636D+01) 10100, 10100, 20100 02390825 +10100 IVPASS = IVPASS + 1 02400825 + WRITE (NUVI, 80002) IVTNUM 02410825 + GO TO 0101 02420825 +20100 IVFAIL = IVFAIL + 1 02430825 + DVCORR = 1.5430806348152437785D+00 02440825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02450825 + 0101 CONTINUE 02460825 +CT011* TEST 11 TEST ARGUMENTS CLOSE TO 1.0D0 02470825 + IVTNUM = 11 02480825 + AVD = DCOSH(33.0D0 / 32.0D0) 02490825 + IF (AVD - 0.1580565167D+01) 20110, 10110, 40110 02500825 +40110 IF (AVD - 0.1580565170D+01) 10110, 10110, 20110 02510825 +10110 IVPASS = IVPASS + 1 02520825 + WRITE (NUVI, 80002) IVTNUM 02530825 + GO TO 0111 02540825 +20110 IVFAIL = IVFAIL + 1 02550825 + DVCORR = 1.5805651684505867982D+00 02560825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02570825 + 0111 CONTINUE 02580825 +CT012* TEST 12 TEST AT 2.0D0 02590825 + IVTNUM = 12 02600825 + BVD = 2.0D0 02610825 + AVD = DCOSH(BVD) 02620825 + IF (AVD - 0.3762195689D+01) 20120, 10120, 40120 02630825 +40120 IF (AVD - 0.3762195693D+01) 10120, 10120, 20120 02640825 +10120 IVPASS = IVPASS + 1 02650825 + WRITE (NUVI, 80002) IVTNUM 02660825 + GO TO 0121 02670825 +20120 IVFAIL = IVFAIL + 1 02680825 + DVCORR = 3.7621956910836314596D+00 02690825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02700825 + 0121 CONTINUE 02710825 +CT013* TEST 13 A NEGATIVE ARGUMENT 02720825 + IVTNUM = 13 02730825 + AVD = DCOSH(-2.0D0) 02740825 + IF (AVD - 0.3762195689D+01) 20130, 10130, 40130 02750825 +40130 IF (AVD - 0.3762195693D+01) 10130, 10130, 20130 02760825 +10130 IVPASS = IVPASS + 1 02770825 + WRITE (NUVI, 80002) IVTNUM 02780825 + GO TO 0131 02790825 +20130 IVFAIL = IVFAIL + 1 02800825 + DVCORR = 3.7621956910836314596D+00 02810825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02820825 + 0131 CONTINUE 02830825 +CT014* TEST 14 AN ARGUMENT OF LOW MAGNITUDE 02840825 + IVTNUM = 14 02850825 + AVD = DCOSH(-1.0D-14) 02860825 + IF (AVD - 0.9999999995D+00) 20140, 10140, 40140 02870825 +40140 IF (AVD - 0.1000000001D+01) 10140, 10140, 20140 02880825 +10140 IVPASS = IVPASS + 1 02890825 + WRITE (NUVI, 80002) IVTNUM 02900825 + GO TO 0141 02910825 +20140 IVFAIL = IVFAIL + 1 02920825 + DVCORR = 1.0000000000000000000D+00 02930825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02940825 + 0141 CONTINUE 02950825 +CT015* TEST 15 NEGATIVE VALUES SUPPLIED AS ARGUMENTS 02960825 +C***** TO BOTH FUNCTIONS IN AN EXPRESSION 02970825 + IVTNUM = 15 02980825 + BVD = DSINH(-3.145D0) ** 2 02990825 + CVD = DCOSH(-3.145D0) ** 2 03000825 + AVD = CVD - BVD 03010825 + IF (AVD - 0.9999999990D+00) 20150, 10150, 40150 03020825 +40150 IF (AVD - 0.1000000001D+01) 10150, 10150, 20150 03030825 +10150 IVPASS = IVPASS + 1 03040825 + WRITE (NUVI, 80002) IVTNUM 03050825 + GO TO 0151 03060825 +20150 IVFAIL = IVFAIL + 1 03070825 + DVCORR = 1.0000000000000000000D+00 03080825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03090825 + 0151 CONTINUE 03100825 +CT016* TEST 16 POSITIVE VALUES SUPPLIED AS ARGUMENTS 03110825 +C***** TO BOTH FUNCTIONS IN AN EXPRESSION 03120825 + IVTNUM = 16 03130825 + AVD = DSINH(3.25D0) + DCOSH(3.25D0) 03140825 + IF (AVD - 0.2579033990D+02) 20160, 10160, 40160 03150825 +40160 IF (AVD - 0.2579033993D+02) 10160, 10160, 20160 03160825 +10160 IVPASS = IVPASS + 1 03170825 + WRITE (NUVI, 80002) IVTNUM 03180825 + GO TO 0161 03190825 +20160 IVFAIL = IVFAIL + 1 03200825 + DVCORR = 25.790339917193062089D+00 03210825 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03220825 + 0161 CONTINUE 03230825 +C***** 03240825 +CBB** ********************** BBCSUM0 **********************************03250825 +C**** WRITE OUT TEST SUMMARY 03260825 +C**** 03270825 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03280825 + WRITE (I02, 90004) 03290825 + WRITE (I02, 90014) 03300825 + WRITE (I02, 90004) 03310825 + WRITE (I02, 90020) IVPASS 03320825 + WRITE (I02, 90022) IVFAIL 03330825 + WRITE (I02, 90024) IVDELE 03340825 + WRITE (I02, 90026) IVINSP 03350825 + WRITE (I02, 90028) IVTOTN, IVTOTL 03360825 +CBE** ********************** BBCSUM0 **********************************03370825 +CBB** ********************** BBCFOOT0 **********************************03380825 +C**** WRITE OUT REPORT FOOTINGS 03390825 +C**** 03400825 + WRITE (I02,90016) ZPROG, ZPROG 03410825 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 03420825 + WRITE (I02,90019) 03430825 +CBE** ********************** BBCFOOT0 **********************************03440825 +CBB** ********************** BBCFMT0A **********************************03450825 +C**** FORMATS FOR TEST DETAIL LINES 03460825 +C**** 03470825 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03480825 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03490825 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03500825 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03510825 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03520825 + 1I6,/," ",15X,"CORRECT= " ,I6) 03530825 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03540825 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03550825 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03560825 + 1A21,/," ",16X,"CORRECT= " ,A21) 03570825 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03580825 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03590825 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03600825 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03610825 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03620825 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03630825 +80050 FORMAT (" ",48X,A31) 03640825 +CBE** ********************** BBCFMT0A **********************************03650825 +CBB** ********************** BBCFMAT1 **********************************03660825 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03670825 +C**** 03680825 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03690825 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03700825 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03710825 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03720825 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03730825 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03740825 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03750825 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03760825 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03770825 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03780825 + 2"(",F12.5,", ",F12.5,")") 03790825 +CBE** ********************** BBCFMAT1 **********************************03800825 +CBB** ********************** BBCFMT0B **********************************03810825 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03820825 +C**** 03830825 +90002 FORMAT ("1") 03840825 +90004 FORMAT (" ") 03850825 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03860825 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03870825 +90008 FORMAT (" ",21X,A13,A17) 03880825 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03890825 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03900825 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03910825 + 1 7X,"REMARKS",24X) 03920825 +90014 FORMAT (" ","----------------------------------------------" , 03930825 + 1 "---------------------------------" ) 03940825 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03950825 +C**** 03960825 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03970825 +C**** 03980825 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03990825 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04000825 + 1 A13) 04010825 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04020825 +C**** 04030825 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04040825 +C**** 04050825 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04060825 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04070825 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04080825 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04090825 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04100825 +CBE** ********************** BBCFMT0B **********************************04110825 +C***** 04120825 +C***** END OF TEST SEGMENT 198 04130825 + STOP 04140825 + END 04150825 diff --git a/Fortran/UnitTests/fcvs21_f95/FM825.reference_output b/Fortran/UnitTests/fcvs21_f95/FM825.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM825.reference_output @@ -0,0 +1,57 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM825BEGIN* TEST RESULTS - FM825 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDSINH - (198) INTRINSIC FUNCTIONS + + DSINH, DCOSH (DOUBLE PRECISION HYPERBOLIC SINE, COSINE) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 16 TESTS + + + TEST OF DSINH + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST OF DCOSH + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + + ------------------------------------------------------------------------------- + + 16 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 16 OF 16 TESTS EXECUTED + + *FM825END* END OF TEST - FM825 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM826.f b/Fortran/UnitTests/fcvs21_f95/FM826.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM826.f @@ -0,0 +1,320 @@ + PROGRAM FM826 + +C***********************************************************************00010826 +C***** FORTRAN 77 00020826 +C***** FM826 00030826 +C***** YDTANH - (200) 00040826 +C***** 00050826 +C***********************************************************************00060826 +C***** GENERAL PURPOSE ANS REF 00070826 +C***** TEST INTRINSIC FUNCTION DTANH 15.3 00080826 +C***** TABLE 5 00090826 +C***** 00100826 +CBB** ********************** BBCCOMNT **********************************00110826 +C**** 00120826 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130826 +C**** VERSION 2.1 00140826 +C**** 00150826 +C**** 00160826 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170826 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180826 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190826 +C**** BUILDING 225 RM A266 00200826 +C**** GAITHERSBURG, MD 20899 00210826 +C**** 00220826 +C**** 00230826 +C**** 00240826 +CBE** ********************** BBCCOMNT **********************************00250826 +C***** 00260826 +C***** S P E C I F I C A T I O N S SEGMENT 200 00270826 + DOUBLE PRECISION AVD, BVD, DVCORR 00280826 +C***** 00290826 +CBB** ********************** BBCINITA **********************************00300826 +C**** SPECIFICATION STATEMENTS 00310826 +C**** 00320826 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330826 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340826 +CBE** ********************** BBCINITA **********************************00350826 +CBB** ********************** BBCINITB **********************************00360826 +C**** INITIALIZE SECTION 00370826 + DATA ZVERS, ZVERSD, ZDATE 00380826 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390826 + DATA ZCOMPL, ZNAME, ZTAPE 00400826 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410826 + DATA ZPROJ, ZTAPED, ZPROG 00420826 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430826 + DATA REMRKS /' '/ 00440826 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450826 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460826 +C**** 00470826 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480826 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490826 +CZ03 ZPROG = 'PROGRAM NAME' 00500826 +CZ04 ZDATE = 'DATE OF TEST' 00510826 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520826 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530826 +CZ07 ZNAME = 'NAME OF USER' 00540826 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00550826 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00560826 +C 00570826 + IVPASS = 0 00580826 + IVFAIL = 0 00590826 + IVDELE = 0 00600826 + IVINSP = 0 00610826 + IVTOTL = 0 00620826 + IVTOTN = 0 00630826 + ICZERO = 0 00640826 +C 00650826 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660826 + I01 = 05 00670826 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680826 + I02 = 06 00690826 +C 00700826 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710826 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720826 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730826 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740826 +C 00750826 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760826 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770826 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780826 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790826 +C 00800826 +CBE** ********************** BBCINITB **********************************00810826 + NUVI = I02 00820826 + IVTOTL = 9 00830826 + ZPROG = 'FM826' 00840826 +CBB** ********************** BBCHED0A **********************************00850826 +C**** 00860826 +C**** WRITE REPORT TITLE 00870826 +C**** 00880826 + WRITE (I02, 90002) 00890826 + WRITE (I02, 90006) 00900826 + WRITE (I02, 90007) 00910826 + WRITE (I02, 90008) ZVERS, ZVERSD 00920826 + WRITE (I02, 90009) ZPROG, ZPROG 00930826 + WRITE (I02, 90010) ZDATE, ZCOMPL 00940826 +CBE** ********************** BBCHED0A **********************************00950826 +C***** 00960826 +C***** HEADER FOR SEGMENT 200 00970826 + WRITE(NUVI,20000) 00980826 +20000 FORMAT(" ", / " YDTANH - (200) INTRINSIC FUNCTIONS" // 00990826 + 1 " DTANH (DOUBLE PRECISION HYPERBOLIC TANGENT)" // 01000826 + 2 " ANS REF. - 15.3" ) 01010826 +CBB** ********************** BBCHED0B **********************************01020826 +C**** WRITE DETAIL REPORT HEADERS 01030826 +C**** 01040826 + WRITE (I02,90004) 01050826 + WRITE (I02,90004) 01060826 + WRITE (I02,90013) 01070826 + WRITE (I02,90014) 01080826 + WRITE (I02,90015) IVTOTL 01090826 +CBE** ********************** BBCHED0B **********************************01100826 +C***** 01110826 +CT001* TEST 1 TEST AT ZERO (0.0) 01120826 + IVTNUM = 1 01130826 + BVD = 0.0D0 01140826 + AVD = DTANH(BVD) 01150826 + IF (AVD + 0.5000000000D-09) 20010, 10010, 40010 01160826 +40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010 01170826 +10010 IVPASS = IVPASS + 1 01180826 + WRITE (NUVI, 80002) IVTNUM 01190826 + GO TO 0011 01200826 +20010 IVFAIL = IVFAIL + 1 01210826 + DVCORR = 0.00000000000000000000D+00 01220826 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01230826 + 0011 CONTINUE 01240826 +CT002* TEST 2 A NEGATIVE ARGUMENT 01250826 + IVTNUM = 2 01260826 + AVD = DTANH(-2.5D0) 01270826 + IF (AVD + 0.9866142987D+00) 20020, 10020, 40020 01280826 +40020 IF (AVD + 0.9866142976D+00) 10020, 10020, 20020 01290826 +10020 IVPASS = IVPASS + 1 01300826 + WRITE (NUVI, 80002) IVTNUM 01310826 + GO TO 0021 01320826 +20020 IVFAIL = IVFAIL + 1 01330826 + DVCORR = -0.98661429815143028888D+00 01340826 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01350826 + 0021 CONTINUE 01360826 +CT003* TEST 3 A VARIABLE SUPPLIED AS AN ARGUMENT 01370826 + IVTNUM = 3 01380826 + BVD = 4.75D0 01390826 + AVD = DTANH(BVD) 01400826 + IF (AVD - 0.9998503070D+00) 20030, 10030, 40030 01410826 +40030 IF (AVD - 0.9998503081D+00) 10030, 10030, 20030 01420826 +10030 IVPASS = IVPASS + 1 01430826 + WRITE (NUVI, 80002) IVTNUM 01440826 + GO TO 0031 01450826 +20030 IVFAIL = IVFAIL + 1 01460826 + DVCORR = 0.99985030754497877538D+00 01470826 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01480826 + 0031 CONTINUE 01490826 +CT004* TEST 4 A POSITIVE REAL NUMBER SUPPLIED AS AN ARGUMENT 01500826 + IVTNUM = 4 01510826 + AVD = DTANH(15.125D0) 01520826 + IF (AVD - 0.9999999995D+00) 20040, 10040, 40040 01530826 +40040 IF (AVD - 0.1000000001D+01) 10040, 10040, 20040 01540826 +10040 IVPASS = IVPASS + 1 01550826 + WRITE (NUVI, 80002) IVTNUM 01560826 + GO TO 0041 01570826 +20040 IVFAIL = IVFAIL + 1 01580826 + DVCORR = 0.99999999999985424552D+00 01590826 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01600826 + 0041 CONTINUE 01610826 +CT005* TEST 5 TEST WITH LARGE VALUES 01620826 + IVTNUM = 5 01630826 + BVD = 10.0D0 ** 2 01640826 + AVD = DTANH(BVD) 01650826 + IF (AVD - 0.9999999995D+00) 20050, 10050, 40050 01660826 +40050 IF (AVD - 0.1000000001D+01) 10050, 10050, 20050 01670826 +10050 IVPASS = IVPASS + 1 01680826 + WRITE (NUVI, 80002) IVTNUM 01690826 + GO TO 0051 01700826 +20050 IVFAIL = IVFAIL + 1 01710826 + DVCORR = 1.0000000000000000000D+00 01720826 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01730826 + 0051 CONTINUE 01740826 +CT006* TEST 6 TEST WITH LARGE VALUES 01750826 + IVTNUM = 6 01760826 + BVD = -100.0D0 * 10.0D0 01770826 + AVD = DTANH(BVD) 01780826 + IF (AVD + 0.1000000001D+01) 20060, 10060, 40060 01790826 +40060 IF (AVD + 0.9999999995D+00) 10060, 10060, 20060 01800826 +10060 IVPASS = IVPASS + 1 01810826 + WRITE (NUVI, 80002) IVTNUM 01820826 + GO TO 0061 01830826 +20060 IVFAIL = IVFAIL + 1 01840826 + DVCORR = -1.0000000000000000000D+00 01850826 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01860826 + 0061 CONTINUE 01870826 +CT007* TEST 7 AN ARGUMENT OF HIGH MAGNITUDE 01880826 + IVTNUM = 7 01890826 + BVD = 3.0D+36 01900826 + AVD = DTANH(BVD) 01910826 + IF (AVD - 0.9999999995D+00) 20070, 10070, 40070 01920826 +40070 IF (AVD - 0.1000000001D+01) 10070, 10070, 20070 01930826 +10070 IVPASS = IVPASS + 1 01940826 + WRITE (NUVI, 80002) IVTNUM 01950826 + GO TO 0071 01960826 +20070 IVFAIL = IVFAIL + 1 01970826 + DVCORR = 1.0000000000000000000D+00 01980826 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01990826 + 0071 CONTINUE 02000826 +CT008* TEST 8 AN ARGUMENT OF LOW MAGNITUDE 02010826 + IVTNUM = 8 02020826 + BVD = -1.0D-15 02030826 + AVD = DTANH(BVD) 02040826 + IF (AVD + 0.1000000001D-14) 20080, 10080, 40080 02050826 +40080 IF (AVD + 0.9999999995D-15) 10080, 10080, 20080 02060826 +10080 IVPASS = IVPASS + 1 02070826 + WRITE (NUVI, 80002) IVTNUM 02080826 + GO TO 0081 02090826 +20080 IVFAIL = IVFAIL + 1 02100826 + DVCORR = -1.0000000000000000000D-15 02110826 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02120826 + 0081 CONTINUE 02130826 +CT009* TEST 9 THE FUNCTION APPLIED TWICE 02140826 + IVTNUM = 9 02150826 + AVD = DTANH(0.5D0) * DTANH(0.75D0) 02160826 + IF (AVD - 0.2935132281D+00) 20090, 10090, 40090 02170826 +40090 IF (AVD - 0.2935132285D+00) 10090, 10090, 20090 02180826 +10090 IVPASS = IVPASS + 1 02190826 + WRITE (NUVI, 80002) IVTNUM 02200826 + GO TO 0091 02210826 +20090 IVFAIL = IVFAIL + 1 02220826 + DVCORR = 0.293513228313886504621D+00 02230826 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02240826 + 0091 CONTINUE 02250826 +C***** 02260826 +CBB** ********************** BBCSUM0 **********************************02270826 +C**** WRITE OUT TEST SUMMARY 02280826 +C**** 02290826 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02300826 + WRITE (I02, 90004) 02310826 + WRITE (I02, 90014) 02320826 + WRITE (I02, 90004) 02330826 + WRITE (I02, 90020) IVPASS 02340826 + WRITE (I02, 90022) IVFAIL 02350826 + WRITE (I02, 90024) IVDELE 02360826 + WRITE (I02, 90026) IVINSP 02370826 + WRITE (I02, 90028) IVTOTN, IVTOTL 02380826 +CBE** ********************** BBCSUM0 **********************************02390826 +CBB** ********************** BBCFOOT0 **********************************02400826 +C**** WRITE OUT REPORT FOOTINGS 02410826 +C**** 02420826 + WRITE (I02,90016) ZPROG, ZPROG 02430826 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02440826 + WRITE (I02,90019) 02450826 +CBE** ********************** BBCFOOT0 **********************************02460826 +CBB** ********************** BBCFMT0A **********************************02470826 +C**** FORMATS FOR TEST DETAIL LINES 02480826 +C**** 02490826 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02500826 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02510826 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02520826 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02530826 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02540826 + 1I6,/," ",15X,"CORRECT= " ,I6) 02550826 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02560826 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02570826 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02580826 + 1A21,/," ",16X,"CORRECT= " ,A21) 02590826 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02600826 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02610826 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02620826 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02630826 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02640826 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02650826 +80050 FORMAT (" ",48X,A31) 02660826 +CBE** ********************** BBCFMT0A **********************************02670826 +CBB** ********************** BBCFMAT1 **********************************02680826 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02690826 +C**** 02700826 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02710826 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02720826 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02730826 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02740826 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02750826 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02760826 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02770826 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02780826 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02790826 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02800826 + 2"(",F12.5,", ",F12.5,")") 02810826 +CBE** ********************** BBCFMAT1 **********************************02820826 +CBB** ********************** BBCFMT0B **********************************02830826 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02840826 +C**** 02850826 +90002 FORMAT ("1") 02860826 +90004 FORMAT (" ") 02870826 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02880826 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02890826 +90008 FORMAT (" ",21X,A13,A17) 02900826 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02910826 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02920826 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02930826 + 1 7X,"REMARKS",24X) 02940826 +90014 FORMAT (" ","----------------------------------------------" , 02950826 + 1 "---------------------------------" ) 02960826 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02970826 +C**** 02980826 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02990826 +C**** 03000826 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03010826 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03020826 + 1 A13) 03030826 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03040826 +C**** 03050826 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03060826 +C**** 03070826 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03080826 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03090826 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03100826 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03110826 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03120826 +CBE** ********************** BBCFMT0B **********************************03130826 +C***** 03140826 +C***** END OF TEST SEGMENT 200 03150826 + STOP 03160826 + END 03170826 + 03180826 diff --git a/Fortran/UnitTests/fcvs21_f95/FM826.reference_output b/Fortran/UnitTests/fcvs21_f95/FM826.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM826.reference_output @@ -0,0 +1,43 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM826BEGIN* TEST RESULTS - FM826 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDTANH - (200) INTRINSIC FUNCTIONS + + DTANH (DOUBLE PRECISION HYPERBOLIC TANGENT) + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 9 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + + ------------------------------------------------------------------------------- + + 9 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 9 OF 9 TESTS EXECUTED + + *FM826END* END OF TEST - FM826 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM827.f b/Fortran/UnitTests/fcvs21_f95/FM827.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM827.f @@ -0,0 +1,345 @@ + PROGRAM FM827 + +C***********************************************************************00010827 +C***** FORTRAN 77 00020827 +C***** FM827 00030827 +C***** YDFOR - (202) 00040827 +C***** 00050827 +C***********************************************************************00060827 +C***** GENERAL PURPOSE ANS REF 00070827 +C***** TEST DOUBLE PRECISION TRIGONOMETRIC FORMULA 15.3 00080827 +C***** TABLE 5 00090827 +CBB** ********************** BBCCOMNT **********************************00100827 +C**** 00110827 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120827 +C**** VERSION 2.1 00130827 +C**** 00140827 +C**** 00150827 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160827 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170827 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180827 +C**** BUILDING 225 RM A266 00190827 +C**** GAITHERSBURG, MD 20899 00200827 +C**** 00210827 +C**** 00220827 +C**** 00230827 +CBE** ********************** BBCCOMNT **********************************00240827 +C***** 00250827 +C***** S P E C I F I C A T I O N S SEGMENT 202 00260827 + DOUBLE PRECISION AVD, BVD, CVD, DVD, PIVD, DVCORR 00270827 +C***** 00280827 +CBB** ********************** BBCINITA **********************************00290827 +C**** SPECIFICATION STATEMENTS 00300827 +C**** 00310827 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00320827 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00330827 +CBE** ********************** BBCINITA **********************************00340827 +CBB** ********************** BBCINITB **********************************00350827 +C**** INITIALIZE SECTION 00360827 + DATA ZVERS, ZVERSD, ZDATE 00370827 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00380827 + DATA ZCOMPL, ZNAME, ZTAPE 00390827 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00400827 + DATA ZPROJ, ZTAPED, ZPROG 00410827 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00420827 + DATA REMRKS /' '/ 00430827 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00440827 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00450827 +C**** 00460827 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00470827 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00480827 +CZ03 ZPROG = 'PROGRAM NAME' 00490827 +CZ04 ZDATE = 'DATE OF TEST' 00500827 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00510827 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00520827 +CZ07 ZNAME = 'NAME OF USER' 00530827 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00540827 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00550827 +C 00560827 + IVPASS = 0 00570827 + IVFAIL = 0 00580827 + IVDELE = 0 00590827 + IVINSP = 0 00600827 + IVTOTL = 0 00610827 + IVTOTN = 0 00620827 + ICZERO = 0 00630827 +C 00640827 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00650827 + I01 = 05 00660827 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00670827 + I02 = 06 00680827 +C 00690827 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00700827 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00710827 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00720827 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00730827 +C 00740827 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00750827 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00760827 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00770827 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00780827 +C 00790827 +CBE** ********************** BBCINITB **********************************00800827 + NUVI = I02 00810827 + IVTOTL = 10 00820827 + ZPROG = 'FM827' 00830827 +CBB** ********************** BBCHED0A **********************************00840827 +C**** 00850827 +C**** WRITE REPORT TITLE 00860827 +C**** 00870827 + WRITE (I02, 90002) 00880827 + WRITE (I02, 90006) 00890827 + WRITE (I02, 90007) 00900827 + WRITE (I02, 90008) ZVERS, ZVERSD 00910827 + WRITE (I02, 90009) ZPROG, ZPROG 00920827 + WRITE (I02, 90010) ZDATE, ZCOMPL 00930827 +CBE** ********************** BBCHED0A **********************************00940827 +C***** 00950827 +C***** HEADER FOR SEGMENT 202 00960827 + WRITE(NUVI,20200) 00970827 +20200 FORMAT(" ", / " YDFOR - (202) INTRINSIC FUNCTIONS" // 00980827 + 1 " DOUBLE PRECISION TRIGONOMETRIC FORMULAE" // 00990827 + 2 " ANS REF. - 15.3" ) 01000827 +CBB** ********************** BBCHED0B **********************************01010827 +C**** WRITE DETAIL REPORT HEADERS 01020827 +C**** 01030827 + WRITE (I02,90004) 01040827 + WRITE (I02,90004) 01050827 + WRITE (I02,90013) 01060827 + WRITE (I02,90014) 01070827 + WRITE (I02,90015) IVTOTL 01080827 +CBE** ********************** BBCHED0B **********************************01090827 +C***** 01100827 + PIVD = 3.1415926535897932384626434D0 01110827 +C***** 01120827 +CT001* TEST 1 LN(EXP(X)) = X 01130827 + IVTNUM = 1 01140827 + BVD = 17.5D0 01150827 + AVD = DLOG(DEXP(1.75D0)) - BVD / 10.0D0 01160827 + IF (AVD + 0.5000000000D-09) 20010, 10010, 40010 01170827 +40010 IF (AVD - 0.5000000000D-09) 10010, 10010, 20010 01180827 +10010 IVPASS = IVPASS + 1 01190827 + WRITE (NUVI, 80002) IVTNUM 01200827 + GO TO 0011 01210827 +20010 IVFAIL = IVFAIL + 1 01220827 + DVCORR = 0.0D+00 01230827 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01240827 + 0011 CONTINUE 01250827 +CT002* TEST 2 SIN**2 + COS**2 = 1 01260827 + IVTNUM = 2 01270827 + BVD = 10.0D0 / 4.0D0 01280827 + CVD = DSIN(BVD) ** 2 01290827 + DVD = DCOS(BVD) ** 2 01300827 + AVD = CVD + DVD - 1.0D0 01310827 + IF (AVD + 0.5000000000D-09) 20020, 10020, 40020 01320827 +40020 IF (AVD - 0.5000000000D-09) 10020, 10020, 20020 01330827 +10020 IVPASS = IVPASS + 1 01340827 + WRITE (NUVI, 80002) IVTNUM 01350827 + GO TO 0021 01360827 +20020 IVFAIL = IVFAIL + 1 01370827 + DVCORR = 0.0D+00 01380827 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01390827 + 0021 CONTINUE 01400827 +CT003* TEST 3 SIN(2X) = 2*SIN(X)*COS(X) 01410827 + IVTNUM = 3 01420827 + BVD = 8.5D0 01430827 + CVD = BVD * (-0.5D0) 01440827 + AVD = (DSIN(-4.25D0) * DCOS(CVD)) * 2.0D0 - DSIN(-8.5D0) 01450827 + IF (AVD + 0.5000000000D-09) 20030, 10030, 40030 01460827 +40030 IF (AVD - 0.5000000000D-09) 10030, 10030, 20030 01470827 +10030 IVPASS = IVPASS + 1 01480827 + WRITE (NUVI, 80002) IVTNUM 01490827 + GO TO 0031 01500827 +20030 IVFAIL = IVFAIL + 1 01510827 + DVCORR = 0.0D+00 01520827 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01530827 + 0031 CONTINUE 01540827 +CT004* TEST 4 ARCSIN(X) = ARCCOS(1 - X**2) 01550827 + IVTNUM = 4 01560827 + AVD = DASIN(-0.875D0) + DACOS(DSQRT(1.0D0 - (0.875D0) ** 2)) 01570827 + IF (AVD + 0.5000000000D-09) 20040, 10040, 40040 01580827 +40040 IF (AVD - 0.5000000000D-09) 10040, 10040, 20040 01590827 +10040 IVPASS = IVPASS + 1 01600827 + WRITE (NUVI, 80002) IVTNUM 01610827 + GO TO 0041 01620827 +20040 IVFAIL = IVFAIL + 1 01630827 + DVCORR = 0.0D+00 01640827 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01650827 + 0041 CONTINUE 01660827 +CT005* TEST 5 TAN(X)**2 - 1 = -COS(2X)/COS(X)**2 01670827 + IVTNUM = 5 01680827 + BVD = 7.0D0 01690827 + AVD = DCOS(1.75D0) / DCOS(BVD / 8.0D0) ** 2 01700827 + 1 + DTAN(0.875D0) ** 2 - 1.0D0 01710827 + IF (AVD + 0.5000000000D-09) 20050, 10050, 40050 01720827 +40050 IF (AVD - 0.5000000000D-09) 10050, 10050, 20050 01730827 +10050 IVPASS = IVPASS + 1 01740827 + WRITE (NUVI, 80002) IVTNUM 01750827 + GO TO 0051 01760827 +20050 IVFAIL = IVFAIL + 1 01770827 + DVCORR = 0.0D+00 01780827 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01790827 + 0051 CONTINUE 01800827 +CT006* TEST 6 ATAN(X/Y) = ATAN2(X,Y), Y>0 01810827 + IVTNUM = 6 01820827 + BVD = 12.0D0 01830827 + CVD = DATAN2(BVD / 4.0D0, BVD / 3.0D0) 01840827 + AVD = CVD - DATAN(0.75D0) 01850827 + IF (AVD + 0.5000000000D-09) 20060, 10060, 40060 01860827 +40060 IF (AVD - 0.5000000000D-09) 10060, 10060, 20060 01870827 +10060 IVPASS = IVPASS + 1 01880827 + WRITE (NUVI, 80002) IVTNUM 01890827 + GO TO 0061 01900827 +20060 IVFAIL = IVFAIL + 1 01910827 + DVCORR = 0.0D+00 01920827 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01930827 + 0061 CONTINUE 01940827 +CT007* TEST 7 SQRT(X)**2 = X 01950827 + IVTNUM = 7 01960827 + AVD = DSQRT(9.125D0) ** 2 - 9.125D0 01970827 + IF (AVD + 0.5000000000D-09) 20070, 10070, 40070 01980827 +40070 IF (AVD - 0.5000000000D-09) 10070, 10070, 20070 01990827 +10070 IVPASS = IVPASS + 1 02000827 + WRITE (NUVI, 80002) IVTNUM 02010827 + GO TO 0071 02020827 +20070 IVFAIL = IVFAIL + 1 02030827 + DVCORR = 0.0D+00 02040827 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02050827 + 0071 CONTINUE 02060827 +CT008* TEST 8 LN(X) = LN(10) * LOG10(X) 02070827 + IVTNUM = 8 02080827 + BVD = 62.5D0 / 1000.0D0 02090827 + AVD = DLOG10(BVD) * DLOG(10.0D0) - DLOG(0.0625D0) 02100827 + IF (AVD + 0.5000000000D-09) 20080, 10080, 40080 02110827 +40080 IF (AVD - 0.5000000000D-09) 10080, 10080, 20080 02120827 +10080 IVPASS = IVPASS + 1 02130827 + WRITE (NUVI, 80002) IVTNUM 02140827 + GO TO 0081 02150827 +20080 IVFAIL = IVFAIL + 1 02160827 + DVCORR = 0.0D+00 02170827 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02180827 + 0081 CONTINUE 02190827 +CT009* TEST 9 COSH**2 - SINH**2 = 1 02200827 + IVTNUM = 9 02210827 + BVD = 0.125D0 02220827 + CVD = DSINH(2.125D0) 02230827 + DVD = DCOSH(2.0D0 + BVD) 02240827 + AVD = DVD ** 2 - CVD ** 2 - DCOSH(0.0D0) 02250827 + IF (AVD + 0.5000000000D-09) 20090, 10090, 40090 02260827 +40090 IF (AVD - 0.5000000000D-09) 10090, 10090, 20090 02270827 +10090 IVPASS = IVPASS + 1 02280827 + WRITE (NUVI, 80002) IVTNUM 02290827 + GO TO 0091 02300827 +20090 IVFAIL = IVFAIL + 1 02310827 + DVCORR = 0.0D+00 02320827 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02330827 + 0091 CONTINUE 02340827 +CT010* TEST 10 TANH(X) = 1 - 2/(EXP(2X)+1) 02350827 + IVTNUM = 10 02360827 + BVD = 5.0D0 02370827 + CVD = 2.0D0 02380827 + DVD = DLOG10(BVD * CVD) - DSQRT(4.0D0) / 02390827 + 1 (DEXP(2.0D0 * (BVD - CVD)) + DCOS(0.0D0)) 02400827 + AVD = DVD - DTANH(3.0D0) 02410827 + IF (AVD + 0.5000000000D-09) 20100, 10100, 40100 02420827 +40100 IF (AVD - 0.5000000000D-09) 10100, 10100, 20100 02430827 +10100 IVPASS = IVPASS + 1 02440827 + WRITE (NUVI, 80002) IVTNUM 02450827 + GO TO 0101 02460827 +20100 IVFAIL = IVFAIL + 1 02470827 + DVCORR = 0.0D+00 02480827 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02490827 + 0101 CONTINUE 02500827 +C***** 02510827 +CBB** ********************** BBCSUM0 **********************************02520827 +C**** WRITE OUT TEST SUMMARY 02530827 +C**** 02540827 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02550827 + WRITE (I02, 90004) 02560827 + WRITE (I02, 90014) 02570827 + WRITE (I02, 90004) 02580827 + WRITE (I02, 90020) IVPASS 02590827 + WRITE (I02, 90022) IVFAIL 02600827 + WRITE (I02, 90024) IVDELE 02610827 + WRITE (I02, 90026) IVINSP 02620827 + WRITE (I02, 90028) IVTOTN, IVTOTL 02630827 +CBE** ********************** BBCSUM0 **********************************02640827 +CBB** ********************** BBCFOOT0 **********************************02650827 +C**** WRITE OUT REPORT FOOTINGS 02660827 +C**** 02670827 + WRITE (I02,90016) ZPROG, ZPROG 02680827 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02690827 + WRITE (I02,90019) 02700827 +CBE** ********************** BBCFOOT0 **********************************02710827 +CBB** ********************** BBCFMT0A **********************************02720827 +C**** FORMATS FOR TEST DETAIL LINES 02730827 +C**** 02740827 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02750827 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02760827 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02770827 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02780827 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02790827 + 1I6,/," ",15X,"CORRECT= " ,I6) 02800827 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02810827 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02820827 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02830827 + 1A21,/," ",16X,"CORRECT= " ,A21) 02840827 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02850827 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02860827 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02870827 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02880827 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02890827 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02900827 +80050 FORMAT (" ",48X,A31) 02910827 +CBE** ********************** BBCFMT0A **********************************02920827 +CBB** ********************** BBCFMAT1 **********************************02930827 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02940827 +C**** 02950827 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02960827 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02970827 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02980827 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02990827 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03000827 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03010827 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03020827 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03030827 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03040827 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03050827 + 2"(",F12.5,", ",F12.5,")") 03060827 +CBE** ********************** BBCFMAT1 **********************************03070827 +CBB** ********************** BBCFMT0B **********************************03080827 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03090827 +C**** 03100827 +90002 FORMAT ("1") 03110827 +90004 FORMAT (" ") 03120827 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03130827 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03140827 +90008 FORMAT (" ",21X,A13,A17) 03150827 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03160827 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03170827 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03180827 + 1 7X,"REMARKS",24X) 03190827 +90014 FORMAT (" ","----------------------------------------------" , 03200827 + 1 "---------------------------------" ) 03210827 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03220827 +C**** 03230827 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03240827 +C**** 03250827 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03260827 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03270827 + 1 A13) 03280827 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03290827 +C**** 03300827 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03310827 +C**** 03320827 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03330827 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03340827 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03350827 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03360827 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03370827 +CBE** ********************** BBCFMT0B **********************************03380827 +C***** 03390827 +C***** END OF TEST SEGMENT 202 03400827 + STOP 03410827 + END 03420827 + 03430827 diff --git a/Fortran/UnitTests/fcvs21_f95/FM827.reference_output b/Fortran/UnitTests/fcvs21_f95/FM827.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM827.reference_output @@ -0,0 +1,44 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM827BEGIN* TEST RESULTS - FM827 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YDFOR - (202) INTRINSIC FUNCTIONS + + DOUBLE PRECISION TRIGONOMETRIC FORMULAE + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 10 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + + ------------------------------------------------------------------------------- + + 10 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 10 OF 10 TESTS EXECUTED + + *FM827END* END OF TEST - FM827 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM828.f b/Fortran/UnitTests/fcvs21_f95/FM828.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM828.f @@ -0,0 +1,345 @@ + PROGRAM FM828 + +C***********************************************************************00010828 +C***** FORTRAN 77 00020828 +C***** FM828 00030828 +C***** YCFOR - (203) 00040828 +C***** 00050828 +C***********************************************************************00060828 +C***** GENERAL PURPOSE ANS REF 00070828 +C***** TEST COMPLEX TRIGONOMETRIC FORMULAE 15.3 00080828 +C***** TABLE 5 00090828 +CBB** ********************** BBCCOMNT **********************************00100828 +C**** 00110828 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120828 +C**** VERSION 2.1 00130828 +C**** 00140828 +C**** 00150828 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160828 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170828 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180828 +C**** BUILDING 225 RM A266 00190828 +C**** GAITHERSBURG, MD 20899 00200828 +C**** 00210828 +C**** 00220828 +C**** 00230828 +CBE** ********************** BBCCOMNT **********************************00240828 +C***** 00250828 +C***** S P E C I F I C A T I O N S SEGMENT 203 00260828 + COMPLEX AVC, BVC, CVC, DVC, ZVCORR 00270828 + REAL R2E(2) 00280828 + EQUIVALENCE (AVC, R2E) 00290828 +C***** 00300828 +CBB** ********************** BBCINITA **********************************00310828 +C**** SPECIFICATION STATEMENTS 00320828 +C**** 00330828 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00340828 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00350828 +CBE** ********************** BBCINITA **********************************00360828 +CBB** ********************** BBCINITB **********************************00370828 +C**** INITIALIZE SECTION 00380828 + DATA ZVERS, ZVERSD, ZDATE 00390828 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00400828 + DATA ZCOMPL, ZNAME, ZTAPE 00410828 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00420828 + DATA ZPROJ, ZTAPED, ZPROG 00430828 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00440828 + DATA REMRKS /' '/ 00450828 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00460828 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00470828 +C**** 00480828 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00490828 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00500828 +CZ03 ZPROG = 'PROGRAM NAME' 00510828 +CZ04 ZDATE = 'DATE OF TEST' 00520828 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00530828 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00540828 +CZ07 ZNAME = 'NAME OF USER' 00550828 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00560828 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00570828 +C 00580828 + IVPASS = 0 00590828 + IVFAIL = 0 00600828 + IVDELE = 0 00610828 + IVINSP = 0 00620828 + IVTOTL = 0 00630828 + IVTOTN = 0 00640828 + ICZERO = 0 00650828 +C 00660828 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00670828 + I01 = 05 00680828 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00690828 + I02 = 06 00700828 +C 00710828 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00720828 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00730828 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00740828 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00750828 +C 00760828 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00770828 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00780828 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00790828 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00800828 +C 00810828 +CBE** ********************** BBCINITB **********************************00820828 + NUVI = I02 00830828 + IVTOTL = 9 00840828 + ZPROG = 'FM828' 00850828 +CBB** ********************** BBCHED0A **********************************00860828 +C**** 00870828 +C**** WRITE REPORT TITLE 00880828 +C**** 00890828 + WRITE (I02, 90002) 00900828 + WRITE (I02, 90006) 00910828 + WRITE (I02, 90007) 00920828 + WRITE (I02, 90008) ZVERS, ZVERSD 00930828 + WRITE (I02, 90009) ZPROG, ZPROG 00940828 + WRITE (I02, 90010) ZDATE, ZCOMPL 00950828 +CBE** ********************** BBCHED0A **********************************00960828 +C***** 00970828 +C***** HEADER FOR SEGMENT 203 00980828 + WRITE(NUVI,20300) 00990828 +20300 FORMAT(" ", / " YCFOR - (203) INTRINSIC FUNCTIONS" // 01000828 + 1 " COMPLEX TRIGONOMETRIC FORMULAE" // 01010828 + 2 " ANS REF. - 15.3" ) 01020828 +CBB** ********************** BBCHED0B **********************************01030828 +C**** WRITE DETAIL REPORT HEADERS 01040828 +C**** 01050828 + WRITE (I02,90004) 01060828 + WRITE (I02,90004) 01070828 + WRITE (I02,90013) 01080828 + WRITE (I02,90014) 01090828 + WRITE (I02,90015) IVTOTL 01100828 +CBE** ********************** BBCHED0B **********************************01110828 +C***** 01120828 + PIVS = 3.1415926535897932384626434 01130828 +C***** 01140828 +CT001* TEST 1 SQRT(Z)**2 = Z 01150828 + IVTNUM = 1 01160828 + BVC = (1.0, 0.0) + (0.0, -2.5) 01170828 + AVC = CSQRT((1.0, -2.5)) ** 2 - BVC 01180828 + IF (R2E(1) + 0.50000E-04) 20010, 40012, 40011 01190828 +40011 IF (R2E(1) - 0.50000E-04) 40012, 40012, 20010 01200828 +40012 IF (R2E(2) + 0.50000E-04) 20010, 10010, 40010 01210828 +40010 IF (R2E(2) - 0.50000E-04) 10010, 10010, 20010 01220828 +10010 IVPASS = IVPASS + 1 01230828 + WRITE (NUVI, 80002) IVTNUM 01240828 + GO TO 0011 01250828 +20010 IVFAIL = IVFAIL + 1 01260828 + ZVCORR = (0.0000, 0.0000) 01270828 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01280828 + 0011 CONTINUE 01290828 +CT002* TEST 2 ANGLE SUBTENDED BY SQRT(Z) IS 1/2 ANGLE SUBTENDED BY Z 01300828 + IVTNUM = 2 01310828 + BVC = CSQRT((2.0, 3.25)) 01320828 + CVS = AIMAG(BVC) 01330828 + DVS = CABS((BVC + CONJG(BVC)) / (2.0, 0.0)) 01340828 + AVS = ATAN2(3.0 + 0.25, 1.0 * 2.0) - 2.0 * ATAN2(CVS, DVS) 01350828 + IF (AVS + 0.50000E-04) 20020, 10020, 40020 01360828 +40020 IF (AVS - 0.50000E-04) 10020, 10020, 20020 01370828 +10020 IVPASS = IVPASS + 1 01380828 + WRITE (NUVI, 80002) IVTNUM 01390828 + GO TO 0021 01400828 +20020 IVFAIL = IVFAIL + 1 01410828 + RVCORR = 0.0000 01420828 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01430828 + 0021 CONTINUE 01440828 +CT003* TEST 3 EXP(LOG(Z)) = Z 01450828 + IVTNUM = 3 01460828 + BVC = (0.0, 0.0) - (1.5, 0.75) 01470828 + AVC = CEXP(CLOG(BVC)) + (1.5, 0.75) 01480828 + IF (R2E(1) + 0.50000E-04) 20030, 40032, 40031 01490828 +40031 IF (R2E(1) - 0.50000E-04) 40032, 40032, 20030 01500828 +40032 IF (R2E(2) + 0.50000E-04) 20030, 10030, 40030 01510828 +40030 IF (R2E(2) - 0.50000E-04) 10030, 10030, 20030 01520828 +10030 IVPASS = IVPASS + 1 01530828 + WRITE (NUVI, 80002) IVTNUM 01540828 + GO TO 0031 01550828 +20030 IVFAIL = IVFAIL + 1 01560828 + ZVCORR = (0.0000, 0.0000) 01570828 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01580828 + 0031 CONTINUE 01590828 +CT004* TEST 4 ABS(EXP(Z)) = EXP(REAL(Z)) 01600828 + IVTNUM = 4 01610828 + AVS = CABS(CEXP((-2.5, 1.375))) - EXP(5.0 / (-2.0)) 01620828 + IF (AVS + 0.50000E-04) 20040, 10040, 40040 01630828 +40040 IF (AVS - 0.50000E-04) 10040, 10040, 20040 01640828 +10040 IVPASS = IVPASS + 1 01650828 + WRITE (NUVI, 80002) IVTNUM 01660828 + GO TO 0041 01670828 +20040 IVFAIL = IVFAIL + 1 01680828 + RVCORR = 0.0000 01690828 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01700828 + 0041 CONTINUE 01710828 +CT005* TEST 5 ANGLE SUBTENDED BY EXP(Z) IS IMAG(Z) MOD 2 PI 01720828 + IVTNUM = 5 01730828 + BVC = (0.0625, 0.0) 01740828 + CVC = CEXP(BVC + (0.0, 1.125)) 01750828 + DVS = ATAN2(AIMAG(CVC), CABS((CVC + CONJG(CVC)) / (2.0, 0.0))) 01760828 + AVS = DVS - AMOD(AIMAG((0.0625, 1.125)), 2.0 * PIVS) 01770828 + IF (AVS + 0.50000E-04) 20050, 10050, 40050 01780828 +40050 IF (AVS - 0.50000E-04) 10050, 10050, 20050 01790828 +10050 IVPASS = IVPASS + 1 01800828 + WRITE (NUVI, 80002) IVTNUM 01810828 + GO TO 0051 01820828 +20050 IVFAIL = IVFAIL + 1 01830828 + RVCORR = 0.0000 01840828 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01850828 + 0051 CONTINUE 01860828 +CT006* TEST 6 EXP(IY) = COS(Y) + I SIN(Y) 01870828 + IVTNUM = 6 01880828 + AVC = CEXP(CMPLX(0.0, 37.5 / 10.0)) 01890828 + 1 - CMPLX(COS(3.75), SIN(2.75 + 1.0)) 01900828 + IF (R2E(1) + 0.50000E-04) 20060, 40062, 40061 01910828 +40061 IF (R2E(1) - 0.50000E-04) 40062, 40062, 20060 01920828 +40062 IF (R2E(2) + 0.50000E-04) 20060, 10060, 40060 01930828 +40060 IF (R2E(2) - 0.50000E-04) 10060, 10060, 20060 01940828 +10060 IVPASS = IVPASS + 1 01950828 + WRITE (NUVI, 80002) IVTNUM 01960828 + GO TO 0061 01970828 +20060 IVFAIL = IVFAIL + 1 01980828 + ZVCORR = (0.0000, 0.0000) 01990828 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02000828 + 0061 CONTINUE 02010828 +CT007* TEST 7 COS(Z) = 0.5 * (EXP(I*Z) + EXP(-I*Z)) 02020828 + IVTNUM = 7 02030828 + BVC = CEXP((-1.5, -2.75)) 02040828 + CVC = (BVC + 1 / BVC) / (2.0, 0.0) 02050828 + DVC = (2.75, -1.5) 02060828 + AVC = CVC - CCOS(DVC * (-1.0, 0.0)) 02070828 + IF (R2E(1) + 0.50000E-04) 20070, 40072, 40071 02080828 +40071 IF (R2E(1) - 0.50000E-04) 40072, 40072, 20070 02090828 +40072 IF (R2E(2) + 0.50000E-04) 20070, 10070, 40070 02100828 +40070 IF (R2E(2) - 0.50000E-04) 10070, 10070, 20070 02110828 +10070 IVPASS = IVPASS + 1 02120828 + WRITE (NUVI, 80002) IVTNUM 02130828 + GO TO 0071 02140828 +20070 IVFAIL = IVFAIL + 1 02150828 + ZVCORR = (0.0000, 0.0000) 02160828 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02170828 + 0071 CONTINUE 02180828 +CT008* TEST 8 ABS(EXP(IY)) = 1.0 02190828 + IVTNUM = 8 02200828 + BVC = (3.25, 3.25) 02210828 + CVC = (3.25, 0.0) 02220828 + AVC = CABS(CEXP(BVC - CVC)) - COS(0.0) 02230828 + IF (R2E(1) + 0.50000E-04) 20080, 40082, 40081 02240828 +40081 IF (R2E(1) - 0.50000E-04) 40082, 40082, 20080 02250828 +40082 IF (R2E(2) + 0.50000E-04) 20080, 10080, 40080 02260828 +40080 IF (R2E(2) - 0.50000E-04) 10080, 10080, 20080 02270828 +10080 IVPASS = IVPASS + 1 02280828 + WRITE (NUVI, 80002) IVTNUM 02290828 + GO TO 0081 02300828 +20080 IVFAIL = IVFAIL + 1 02310828 + ZVCORR = (0.0000, 0.0000) 02320828 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02330828 + 0081 CONTINUE 02340828 +CT009* TEST 9 DEMOIVRE THEOREM FOR N = 3 02350828 + IVTNUM = 9 02360828 + BVS = 3.0/2.0 02370828 + BVC = CMPLX(COS(1.5), SIN(BVS)) ** 3 02380828 + AVC = BVC - CMPLX(COS(4.5), -SIN(4.5 + PIVS)) 02390828 + IF (R2E(1) + 0.50000E-04) 20090, 40092, 40091 02400828 +40091 IF (R2E(1) - 0.50000E-04) 40092, 40092, 20090 02410828 +40092 IF (R2E(2) + 0.50000E-04) 20090, 10090, 40090 02420828 +40090 IF (R2E(2) - 0.50000E-04) 10090, 10090, 20090 02430828 +10090 IVPASS = IVPASS + 1 02440828 + WRITE (NUVI, 80002) IVTNUM 02450828 + GO TO 0091 02460828 +20090 IVFAIL = IVFAIL + 1 02470828 + ZVCORR = (0.0000, 0.0000) 02480828 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02490828 + 0091 CONTINUE 02500828 +C***** 02510828 +CBB** ********************** BBCSUM0 **********************************02520828 +C**** WRITE OUT TEST SUMMARY 02530828 +C**** 02540828 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02550828 + WRITE (I02, 90004) 02560828 + WRITE (I02, 90014) 02570828 + WRITE (I02, 90004) 02580828 + WRITE (I02, 90020) IVPASS 02590828 + WRITE (I02, 90022) IVFAIL 02600828 + WRITE (I02, 90024) IVDELE 02610828 + WRITE (I02, 90026) IVINSP 02620828 + WRITE (I02, 90028) IVTOTN, IVTOTL 02630828 +CBE** ********************** BBCSUM0 **********************************02640828 +CBB** ********************** BBCFOOT0 **********************************02650828 +C**** WRITE OUT REPORT FOOTINGS 02660828 +C**** 02670828 + WRITE (I02,90016) ZPROG, ZPROG 02680828 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02690828 + WRITE (I02,90019) 02700828 +CBE** ********************** BBCFOOT0 **********************************02710828 +CBB** ********************** BBCFMT0A **********************************02720828 +C**** FORMATS FOR TEST DETAIL LINES 02730828 +C**** 02740828 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02750828 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02760828 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02770828 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02780828 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02790828 + 1I6,/," ",15X,"CORRECT= " ,I6) 02800828 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02810828 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02820828 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02830828 + 1A21,/," ",16X,"CORRECT= " ,A21) 02840828 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02850828 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02860828 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02870828 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02880828 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02890828 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02900828 +80050 FORMAT (" ",48X,A31) 02910828 +CBE** ********************** BBCFMT0A **********************************02920828 +CBB** ********************** BBCFMAT1 **********************************02930828 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02940828 +C**** 02950828 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02960828 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02970828 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02980828 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02990828 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03000828 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03010828 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03020828 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03030828 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03040828 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03050828 + 2"(",F12.5,", ",F12.5,")") 03060828 +CBE** ********************** BBCFMAT1 **********************************03070828 +CBB** ********************** BBCFMT0B **********************************03080828 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03090828 +C**** 03100828 +90002 FORMAT ("1") 03110828 +90004 FORMAT (" ") 03120828 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03130828 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03140828 +90008 FORMAT (" ",21X,A13,A17) 03150828 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03160828 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03170828 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03180828 + 1 7X,"REMARKS",24X) 03190828 +90014 FORMAT (" ","----------------------------------------------" , 03200828 + 1 "---------------------------------" ) 03210828 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03220828 +C**** 03230828 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03240828 +C**** 03250828 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03260828 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03270828 + 1 A13) 03280828 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03290828 +C**** 03300828 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03310828 +C**** 03320828 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03330828 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03340828 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03350828 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03360828 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03370828 +CBE** ********************** BBCFMT0B **********************************03380828 +C***** 03390828 +C***** END OF TEST SEGMENT 203 03400828 + STOP 03410828 + END 03420828 + 03430828 diff --git a/Fortran/UnitTests/fcvs21_f95/FM828.reference_output b/Fortran/UnitTests/fcvs21_f95/FM828.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM828.reference_output @@ -0,0 +1,43 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM828BEGIN* TEST RESULTS - FM828 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YCFOR - (203) INTRINSIC FUNCTIONS + + COMPLEX TRIGONOMETRIC FORMULAE + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 9 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + + ------------------------------------------------------------------------------- + + 9 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 9 OF 9 TESTS EXECUTED + + *FM828END* END OF TEST - FM828 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM829.f b/Fortran/UnitTests/fcvs21_f95/FM829.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM829.f @@ -0,0 +1,700 @@ + PROGRAM FM829 + +C***********************************************************************00010829 +C***** FORTRAN 77 00020829 +C***** FM829 00030829 +C***** YGEN1 - (206) 00040829 +C***** 00050829 +C***********************************************************************00060829 +C***** TESTING OF GENERIC FUNCTIONS ANS REF 00070829 +C***** INT, REAL, DBLE, CMPLX 15.3 00080829 +C***** TABLE 5 00090829 +CBB** ********************** BBCCOMNT **********************************00100829 +C**** 00110829 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120829 +C**** VERSION 2.1 00130829 +C**** 00140829 +C**** 00150829 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160829 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170829 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180829 +C**** BUILDING 225 RM A266 00190829 +C**** GAITHERSBURG, MD 20899 00200829 +C**** 00210829 +C**** 00220829 +C**** 00230829 +CBE** ********************** BBCCOMNT **********************************00240829 +C***** 00250829 +C***** S P E C I F I C A T I O N S SEGMENT 206 00260829 + DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00270829 + COMPLEX AVC, BVC, CVC, ZVCORR 00280829 + REAL R2E(2) 00290829 + EQUIVALENCE (BVC, R2E) 00300829 +C***** 00310829 +CBB** ********************** BBCINITA **********************************00320829 +C**** SPECIFICATION STATEMENTS 00330829 +C**** 00340829 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350829 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360829 +CBE** ********************** BBCINITA **********************************00370829 +CBB** ********************** BBCINITB **********************************00380829 +C**** INITIALIZE SECTION 00390829 + DATA ZVERS, ZVERSD, ZDATE 00400829 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410829 + DATA ZCOMPL, ZNAME, ZTAPE 00420829 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430829 + DATA ZPROJ, ZTAPED, ZPROG 00440829 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450829 + DATA REMRKS /' '/ 00460829 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470829 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480829 +C**** 00490829 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500829 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510829 +CZ03 ZPROG = 'PROGRAM NAME' 00520829 +CZ04 ZDATE = 'DATE OF TEST' 00530829 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540829 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550829 +CZ07 ZNAME = 'NAME OF USER' 00560829 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570829 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580829 +C 00590829 + IVPASS = 0 00600829 + IVFAIL = 0 00610829 + IVDELE = 0 00620829 + IVINSP = 0 00630829 + IVTOTL = 0 00640829 + IVTOTN = 0 00650829 + ICZERO = 0 00660829 +C 00670829 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680829 + I01 = 05 00690829 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700829 + I02 = 06 00710829 +C 00720829 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730829 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740829 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750829 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760829 +C 00770829 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780829 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790829 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800829 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810829 +C 00820829 +CBE** ********************** BBCINITB **********************************00830829 + NUVI = I02 00840829 + IVTOTL = 35 00850829 + ZPROG = 'FM829' 00860829 +CBB** ********************** BBCHED0A **********************************00870829 +C**** 00880829 +C**** WRITE REPORT TITLE 00890829 +C**** 00900829 + WRITE (I02, 90002) 00910829 + WRITE (I02, 90006) 00920829 + WRITE (I02, 90007) 00930829 + WRITE (I02, 90008) ZVERS, ZVERSD 00940829 + WRITE (I02, 90009) ZPROG, ZPROG 00950829 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960829 +CBE** ********************** BBCHED0A **********************************00970829 +C***** 00980829 +C***** HEADER FOR SEGMENT 206 00990829 + WRITE(NUVI,20600) 01000829 +20600 FORMAT( " ", / " YGEN1 - (206) GENERIC FUNCTIONS --" // 01010829 + 1 " INT, REAL, DBLE, CMPLX" // 01020829 + 2 " ANS REF. - 15.3" ) 01030829 +CBB** ********************** BBCHED0B **********************************01040829 +C**** WRITE DETAIL REPORT HEADERS 01050829 +C**** 01060829 + WRITE (I02,90004) 01070829 + WRITE (I02,90004) 01080829 + WRITE (I02,90013) 01090829 + WRITE (I02,90014) 01100829 + WRITE (I02,90015) IVTOTL 01110829 +CBE** ********************** BBCHED0B **********************************01120829 +C***** 01130829 +CT001* TEST 1 TEST OF INT 01140829 +C***** WITH INTEGER ARG 01150829 + IVTNUM = 1 01160829 + LVI = INT(485) 01170829 + IF (LVI - 485) 20010, 10010, 20010 01180829 +10010 IVPASS = IVPASS + 1 01190829 + WRITE (NUVI, 80002) IVTNUM 01200829 + GO TO 0011 01210829 +20010 IVFAIL = IVFAIL + 1 01220829 + IVCORR = 485 01230829 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01240829 + 0011 CONTINUE 01250829 +CT002* TEST 2 WITH DOUBLE PREC ARG 01260829 + IVTNUM = 2 01270829 + LVI = INT(1.375D0) 01280829 + IF (LVI - 1) 20020, 10020, 20020 01290829 +10020 IVPASS = IVPASS + 1 01300829 + WRITE (NUVI, 80002) IVTNUM 01310829 + GO TO 0021 01320829 +20020 IVFAIL = IVFAIL + 1 01330829 + IVCORR = 1 01340829 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01350829 + 0021 CONTINUE 01360829 +CT003* TEST 3 WITH COMPLEX ARG 01370829 + IVTNUM = 3 01380829 + LVI = INT((1.24, 5.67)) 01390829 + IF (LVI - 1) 20030, 10030, 20030 01400829 +10030 IVPASS = IVPASS + 1 01410829 + WRITE (NUVI, 80002) IVTNUM 01420829 + GO TO 0031 01430829 +20030 IVFAIL = IVFAIL + 1 01440829 + IVCORR = 1 01450829 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01460829 + 0031 CONTINUE 01470829 +CT004* TEST 4 TEST OF INT AND IFIX 01480829 +C***** WITH REAL ARGS 01490829 + IVTNUM = 4 01500829 + LVI = INT(6.0001) + IFIX(-1.750) 01510829 + IF (LVI - 5) 20040, 10040, 20040 01520829 +10040 IVPASS = IVPASS + 1 01530829 + WRITE (NUVI, 80002) IVTNUM 01540829 + GO TO 0041 01550829 +20040 IVFAIL = IVFAIL + 1 01560829 + IVCORR = 5 01570829 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01580829 + 0041 CONTINUE 01590829 +CT005* TEST 5 TEST OF INT AND IDINT 01600829 +C***** WITH DOUBLE PREC ARGS 01610829 + IVTNUM = 5 01620829 + AVD = -1.11D1 01630829 + LVI = INT(AVD) * IDINT(3.5D0) 01640829 + IF (LVI + 33) 20050, 10050, 20050 01650829 +10050 IVPASS = IVPASS + 1 01660829 + WRITE (NUVI, 80002) IVTNUM 01670829 + GO TO 0051 01680829 +20050 IVFAIL = IVFAIL + 1 01690829 + IVCORR = -33 01700829 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01710829 + 0051 CONTINUE 01720829 +CT006* TEST 6 INTEGER, REAL, DOUBLE PRECISION, AND COMPLEX 01730829 +C***** ARGUMENTS 01740829 + IVTNUM = 6 01750829 + LVI = INT(-327) + INT(6.75) * INT(123) - INT(6.0001D0) 01760829 + 1 / IFIX(13.3) + INT((2.4, 3.5)) + IDINT(-3.375D0) 01770829 + IF (LVI - 410) 20060, 10060, 20060 01780829 +10060 IVPASS = IVPASS + 1 01790829 + WRITE (NUVI, 80002) IVTNUM 01800829 + GO TO 0061 01810829 +20060 IVFAIL = IVFAIL + 1 01820829 + IVCORR = 410 01830829 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01840829 + 0061 CONTINUE 01850829 +CT007* TEST 7 TEST OF REAL 01860829 +C***** WITH REAL ARG 01870829 + IVTNUM = 7 01880829 + AVS = -3.0 01890829 + BVS = REAL(AVS) 01900829 + IF (BVS + 0.30002E+01) 20070, 10070, 40070 01910829 +40070 IF (BVS + 0.29998E+01) 10070, 10070, 20070 01920829 +10070 IVPASS = IVPASS + 1 01930829 + WRITE (NUVI, 80002) IVTNUM 01940829 + GO TO 0071 01950829 +20070 IVFAIL = IVFAIL + 1 01960829 + RVCORR = -3.0 01970829 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 01980829 + 0071 CONTINUE 01990829 +CT008* TEST 8 WITH DOUBLE PRECISION 02000829 + IVTNUM = 8 02010829 + AVD = 0.96875D0 02020829 + BVS = REAL(AVD) 02030829 + IF (BVS - 0.96870E+00) 20080, 10080, 40080 02040829 +40080 IF (BVS - 0.96880E+00) 10080, 10080, 20080 02050829 +10080 IVPASS = IVPASS + 1 02060829 + WRITE (NUVI, 80002) IVTNUM 02070829 + GO TO 0081 02080829 +20080 IVFAIL = IVFAIL + 1 02090829 + RVCORR = 0.96875 02100829 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 02110829 + 0081 CONTINUE 02120829 +CT009* TEST 9 WITH COMPLEX 02130829 + IVTNUM = 9 02140829 + BVS = REAL((2.5, -3.0)) 02150829 + IF (BVS - 0.24998E+01) 20090, 10090, 40090 02160829 +40090 IF (BVS - 0.25002E+01) 10090, 10090, 20090 02170829 +10090 IVPASS = IVPASS + 1 02180829 + WRITE (NUVI, 80002) IVTNUM 02190829 + GO TO 0091 02200829 +20090 IVFAIL = IVFAIL + 1 02210829 + RVCORR = 2.5 02220829 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 02230829 + 0091 CONTINUE 02240829 +CT010* TEST 10 TEST OF REAL AND FLOAT 02250829 + IVTNUM = 10 02260829 + BVS = REAL(6) + FLOAT(8) 02270829 + IF (BVS - 0.13999E+02) 20100, 10100, 40100 02280829 +40100 IF (BVS - 0.14001E+02) 10100, 10100, 20100 02290829 +10100 IVPASS = IVPASS + 1 02300829 + WRITE (NUVI, 80002) IVTNUM 02310829 + GO TO 0101 02320829 +20100 IVFAIL = IVFAIL + 1 02330829 + RVCORR = 14.0 02340829 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 02350829 + 0101 CONTINUE 02360829 +CT011* TEST 11 TEST OF REAL AND SNGL 02370829 + IVTNUM = 11 02380829 + AVD = 2.5D0 02390829 + BVS = REAL(AVD) + SNGL(0.35875D2) 02400829 + IF (BVS - 0.38373E+02) 20110, 10110, 40110 02410829 +40110 IF (BVS - 0.38377E+02) 10110, 10110, 20110 02420829 +10110 IVPASS = IVPASS + 1 02430829 + WRITE (NUVI, 80002) IVTNUM 02440829 + GO TO 0111 02450829 +20110 IVFAIL = IVFAIL + 1 02460829 + RVCORR = 38.375 02470829 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 02480829 + 0111 CONTINUE 02490829 +CT012* TEST 12 TEST OF REAL, FLOAT, AND SNGL 02500829 + IVTNUM = 12 02510829 + BVS = REAL(13) + FLOAT(9) * SNGL(0.7625D1) - REAL(2.625D0) + 02520829 + 1 REAL(3.5) / REAL((2.0, 4.0)) 02530829 + IF (BVS - 0.80746E+02) 20120, 10120, 40120 02540829 +40120 IF (BVS - 0.80754E+02) 10120, 10120, 20120 02550829 +10120 IVPASS = IVPASS + 1 02560829 + WRITE (NUVI, 80002) IVTNUM 02570829 + GO TO 0121 02580829 +20120 IVFAIL = IVFAIL + 1 02590829 + RVCORR = 80.75 02600829 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 02610829 + 0121 CONTINUE 02620829 +CT013* TEST 13 TEST OF DBLE 02630829 +C***** WITH INTEGER ARG 02640829 + IVTNUM = 13 02650829 + LVI = 9 02660829 + BVD = DBLE(LVI) 02670829 + IF (BVD - 0.89995D+01) 20130, 10130, 40130 02680829 +40130 IF (BVD - 0.90005D+01) 10130, 10130, 20130 02690829 +10130 IVPASS = IVPASS + 1 02700829 + WRITE (NUVI, 80002) IVTNUM 02710829 + GO TO 0131 02720829 +20130 IVFAIL = IVFAIL + 1 02730829 + DVCORR = 9.0D0 02740829 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02750829 + 0131 CONTINUE 02760829 +CT014* TEST 14 WITH REAL ARG 02770829 + IVTNUM = 14 02780829 + AVS = 10.5 02790829 + BVD = DBLE(AVS) 02800829 + IF (BVD - 0.10499D+02) 20140, 10140, 40140 02810829 +40140 IF (BVD - 0.10501D+02) 10140, 10140, 20140 02820829 +10140 IVPASS = IVPASS + 1 02830829 + WRITE (NUVI, 80002) IVTNUM 02840829 + GO TO 0141 02850829 +20140 IVFAIL = IVFAIL + 1 02860829 + DVCORR = 10.5D0 02870829 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02880829 + 0141 CONTINUE 02890829 +CT015* TEST 15 WITH DOUBLE PREC ARG 02900829 + IVTNUM = 15 02910829 + AVD = 9.9D0 02920829 + BVD = DBLE(AVD) 02930829 + IF (BVD - 0.9899999995D+01) 20150, 10150, 40150 02940829 +40150 IF (BVD - 0.9900000005D+01) 10150, 10150, 20150 02950829 +10150 IVPASS = IVPASS + 1 02960829 + WRITE (NUVI, 80002) IVTNUM 02970829 + GO TO 0151 02980829 +20150 IVFAIL = IVFAIL + 1 02990829 + DVCORR = 9.9D0 03000829 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03010829 + 0151 CONTINUE 03020829 +CT016* TEST 16 WITH COMPLEX ARG 03030829 + IVTNUM = 16 03040829 + AVC = (2.5, 5.5) 03050829 + BVD = DBLE(AVC) 03060829 + IF (BVD - 0.24998D+01) 20160, 10160, 40160 03070829 +40160 IF (BVD - 0.25002D+01) 10160, 10160, 20160 03080829 +10160 IVPASS = IVPASS + 1 03090829 + WRITE (NUVI, 80002) IVTNUM 03100829 + GO TO 0161 03110829 +20160 IVFAIL = IVFAIL + 1 03120829 + DVCORR = 2.5D0 03130829 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03140829 + 0161 CONTINUE 03150829 +CT017* TEST 17 TEST OF CMPLX WITH ONE ARG 03160829 +C***** WITH INTEGER ARG 03170829 + IVTNUM = 17 03180829 + BVC = CMPLX(9) 03190829 + IF (R2E(1) - 0.89995E+01) 20170, 40172, 40171 03200829 +40171 IF (R2E(1) - 0.90005E+01) 40172, 40172, 20170 03210829 +40172 IF (R2E(2) + 0.50000E-04) 20170, 10170, 40170 03220829 +40170 IF (R2E(2) - 0.50000E-04) 10170, 10170, 20170 03230829 +10170 IVPASS = IVPASS + 1 03240829 + WRITE (NUVI, 80002) IVTNUM 03250829 + GO TO 0171 03260829 +20170 IVFAIL = IVFAIL + 1 03270829 + ZVCORR = (9,0) 03280829 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03290829 + 0171 CONTINUE 03300829 +CT018* TEST 18 WITH REAL 03310829 + IVTNUM = 18 03320829 + BVC = CMPLX(4.093) 03330829 + IF (R2E(1) - 0.40928E+01) 20180, 40182, 40181 03340829 +40181 IF (R2E(1) - 0.40932E+01) 40182, 40182, 20180 03350829 +40182 IF (R2E(2) + 0.50000E-04) 20180, 10180, 40180 03360829 +40180 IF (R2E(2) - 0.50000E-04) 10180, 10180, 20180 03370829 +10180 IVPASS = IVPASS + 1 03380829 + WRITE (NUVI, 80002) IVTNUM 03390829 + GO TO 0181 03400829 +20180 IVFAIL = IVFAIL + 1 03410829 + ZVCORR = (4.093,0.0) 03420829 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03430829 + 0181 CONTINUE 03440829 +CT019* TEST 19 WITH DOUBLE PREC ARG 03450829 + IVTNUM = 19 03460829 + AVD = 0.375D-3 03470829 + BVC = CMPLX(AVD) 03480829 + IF (R2E(1) - 0.37498E-03) 20190, 40192, 40191 03490829 +40191 IF (R2E(1) - 0.37502E-03) 40192, 40192, 20190 03500829 +40192 IF (R2E(2) + 0.50000E-04) 20190, 10190, 40190 03510829 +40190 IF (R2E(2) - 0.50000E-04) 10190, 10190, 20190 03520829 +10190 IVPASS = IVPASS + 1 03530829 + WRITE (NUVI, 80002) IVTNUM 03540829 + GO TO 0191 03550829 +20190 IVFAIL = IVFAIL + 1 03560829 + ZVCORR = (0.375E-3, 0.0E0) 03570829 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03580829 + 0191 CONTINUE 03590829 +CT020* TEST 20 WITH COMPLEX 03600829 + IVTNUM = 20 03610829 + AVC = (4.5, 1.2) 03620829 + BVC = CMPLX(AVC) 03630829 + IF (R2E(1) - 0.44997E+01) 20200, 40202, 40201 03640829 +40201 IF (R2E(1) - 0.45003E+01) 40202, 40202, 20200 03650829 +40202 IF (R2E(2) - 0.11999E+01) 20200, 10200, 40200 03660829 +40200 IF (R2E(2) - 0.12001E+01) 10200, 10200, 20200 03670829 +10200 IVPASS = IVPASS + 1 03680829 + WRITE (NUVI, 80002) IVTNUM 03690829 + GO TO 0201 03700829 +20200 IVFAIL = IVFAIL + 1 03710829 + ZVCORR = (4.5, 1.2) 03720829 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03730829 + 0201 CONTINUE 03740829 +CT021* TEST 21 TEST OF CMPLX WITH TWO ARGS 03750829 +C***** WITH INTEGER ARGS 03760829 + IVTNUM = 21 03770829 + BVC = CMPLX(3, 1) 03780829 + IF (R2E(1) - 0.29998E+01) 20210, 40212, 40211 03790829 +40211 IF (R2E(1) - 0.30002E+01) 40212, 40212, 20210 03800829 +40212 IF (R2E(2) - 0.99995E+00) 20210, 10210, 40210 03810829 +40210 IF (R2E(2) - 0.10001E+01) 10210, 10210, 20210 03820829 +10210 IVPASS = IVPASS + 1 03830829 + WRITE (NUVI, 80002) IVTNUM 03840829 + GO TO 0211 03850829 +20210 IVFAIL = IVFAIL + 1 03860829 + ZVCORR = (3.0, 1.0) 03870829 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03880829 + 0211 CONTINUE 03890829 +CT022* TEST 22 WITH REAL ARGS 03900829 + IVTNUM = 22 03910829 + BVC = CMPLX(8.34, 634.3) 03920829 + IF (R2E(1) - 0.83395E+01) 20220, 40222, 40221 03930829 +40221 IF (R2E(1) - 0.83405E+01) 40222, 40222, 20220 03940829 +40222 IF (R2E(2) - 0.63426E+03) 20220, 10220, 40220 03950829 +40220 IF (R2E(2) - 0.63434E+03) 10220, 10220, 20220 03960829 +10220 IVPASS = IVPASS + 1 03970829 + WRITE (NUVI, 80002) IVTNUM 03980829 + GO TO 0221 03990829 +20220 IVFAIL = IVFAIL + 1 04000829 + ZVCORR = (8.34, 634.3) 04010829 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 04020829 + 0221 CONTINUE 04030829 +CT023* TEST 23 WITH DOUBLE PREC ARGS 04040829 + IVTNUM = 23 04050829 + AVD = 0.96875D0 04060829 + BVD = 3.5D-1 04070829 + BVC = CMPLX(AVD, BVD) 04080829 + IF (R2E(1) - 0.96870E+00) 20230, 40232, 40231 04090829 +40231 IF (R2E(1) - 0.96880E+00) 40232, 40232, 20230 04100829 +40232 IF (R2E(2) - 0.34998E+00) 20230, 10230, 40230 04110829 +40230 IF (R2E(2) - 0.35002E+00) 10230, 10230, 20230 04120829 +10230 IVPASS = IVPASS + 1 04130829 + WRITE (NUVI, 80002) IVTNUM 04140829 + GO TO 0231 04150829 +20230 IVFAIL = IVFAIL + 1 04160829 + ZVCORR = (0.96875, 0.35) 04170829 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 04180829 + 0231 CONTINUE 04190829 +CT024* TEST 24 TEST OF INT AND = 04200829 +C***** WITH REAL EXPR 04210829 + IVTNUM = 24 04220829 + CVS = 0.0 04230829 + CVD = 0.0D0 04240829 + CVC = (0.0,0.0) 04250829 + LVI = 0 04260829 + AVS = 5.0 04270829 + IVI = 1.0 * 5.0 + 6.0 04280829 + KVI = LVI + INT(1.0 * AVS + 6.0) 04290829 + IF (KVI - 11) 20240, 10240, 20240 04300829 +10240 IVPASS = IVPASS + 1 04310829 + WRITE (NUVI, 80002) IVTNUM 04320829 + GO TO 0241 04330829 +20240 IVFAIL = IVFAIL + 1 04340829 + IVCORR = 11 04350829 + WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 04360829 + 0241 CONTINUE 04370829 +CT025* TEST 25 WITH DOUBLE PREC EXPR 04380829 + IVTNUM = 25 04390829 + AVD = 3.48D0 04400829 + IVI = 3.48D0 * 47.98D0 04410829 + KVI = LVI + INT(AVD * 47.98D0) 04420829 + IF (KVI - 166) 20250, 10250, 20250 04430829 +10250 IVPASS = IVPASS + 1 04440829 + WRITE (NUVI, 80002) IVTNUM 04450829 + GO TO 0251 04460829 +20250 IVFAIL = IVFAIL + 1 04470829 + IVCORR = 166 04480829 + WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 04490829 + 0251 CONTINUE 04500829 +CT026* TEST 26 WITH COMPLEX EXPR 04510829 + IVTNUM = 26 04520829 + AVC = (3.9, 5.0) 04530829 + IVI = (3.4, 4.5) + (3.9, 5.0) 04540829 + KVI = LVI + INT((3.4, 4.5) + AVC) 04550829 + IF (KVI - 7) 20260, 10260, 20260 04560829 +10260 IVPASS = IVPASS + 1 04570829 + WRITE (NUVI, 80002) IVTNUM 04580829 + GO TO 0261 04590829 +20260 IVFAIL = IVFAIL + 1 04600829 + IVCORR = 7 04610829 + WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 04620829 + 0261 CONTINUE 04630829 +CT027* TEST 27 TEST OF REAL AND = 04640829 +C***** WITH INT EXPR 04650829 + IVTNUM = 27 04660829 + IVI = 20 04670829 + AVS = 20 + 34 / 20 04680829 + BVS = CVS + REAL(IVI + 34 / IVI) 04690829 + IF (BVS - 0.20999E+02) 20270, 10270, 40270 04700829 +40270 IF (BVS - 0.21001E+02) 10270, 10270, 20270 04710829 +10270 IVPASS = IVPASS + 1 04720829 + WRITE (NUVI, 80002) IVTNUM 04730829 + GO TO 0271 04740829 +20270 IVFAIL = IVFAIL + 1 04750829 + RVCORR = 21.0 04760829 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 04770829 + 0271 CONTINUE 04780829 +CT028* TEST 28 WITH DOUBLE PREC EXPR 04790829 + IVTNUM = 28 04800829 + JVI = 28 04810829 + AVD = 0.9834D0 04820829 + AVS = 3.0748D0 / 0.9834D0 04830829 + BVS = CVS + REAL(3.0748D0 / AVD) 04840829 + IF (BVS - 0.31265E+01) 20280, 10280, 40280 04850829 +40280 IF (BVS - 0.31269E+01) 10280, 10280, 20280 04860829 +10280 IVPASS = IVPASS + 1 04870829 + WRITE (NUVI, 80002) IVTNUM 04880829 + GO TO 0281 04890829 +20280 IVFAIL = IVFAIL + 1 04900829 + RVCORR = 3.1267033 04910829 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 04920829 + 0281 CONTINUE 04930829 +CT029* TEST 29 WITH COMPLEX 04940829 + IVTNUM = 29 04950829 + JVI = 29 04960829 + AVC = (1.0, 384.9) 04970829 + AVS = (3.495, 98.734) * (1.0, 384.9) 04980829 + BVS = CVS + REAL((3.495, 98.734) * AVC) 04990829 + IF (BVS + 0.38001E+05) 20290, 10290, 40290 05000829 +40290 IF (BVS + 0.37997E+05) 10290, 10290, 20290 05010829 +10290 IVPASS = IVPASS + 1 05020829 + WRITE (NUVI, 80002) IVTNUM 05030829 + GO TO 0291 05040829 +20290 IVFAIL = IVFAIL + 1 05050829 + RVCORR = -37999.222 05060829 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 05070829 + 0291 CONTINUE 05080829 +CT030* TEST 30 TEST OF DBLE AND = 05090829 +C***** WITH INTEGER EXPR 05100829 + IVTNUM = 30 05110829 + JVI = 30 05120829 + IVI = 5 05130829 + AVD = 1 * 5 + 6 05140829 + BVD = CVD + DBLE(1 * IVI + 6) 05150829 + IF (BVD - 0.10999D+02) 20300, 10300, 40300 05160829 +40300 IF (BVD - 0.11001D+02) 10300, 10300, 20300 05170829 +10300 IVPASS = IVPASS + 1 05180829 + WRITE (NUVI, 80002) IVTNUM 05190829 + GO TO 0301 05200829 +20300 IVFAIL = IVFAIL + 1 05210829 + DVCORR = .11000000D+02 05220829 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 05230829 + 0301 CONTINUE 05240829 +CT031* TEST 31 WITH REAL EXPR 05250829 + IVTNUM = 31 05260829 + JVI = 31 05270829 + AVS = -4.5 05280829 + AVD = 1.3 / (-4.5) 05290829 + BVD = CVD + DBLE(1.3 / AVS) 05300829 + IF (BVD + 0.28891D+00) 20310, 10310, 40310 05310829 +40310 IF (BVD + 0.28887D+00) 10310, 10310, 20310 05320829 +10310 IVPASS = IVPASS + 1 05330829 + WRITE (NUVI, 80002) IVTNUM 05340829 + GO TO 0311 05350829 +20310 IVFAIL = IVFAIL + 1 05360829 + DVCORR = -0.288888888888888889D+00 05370829 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 05380829 + 0311 CONTINUE 05390829 +CT032* TEST 32 WITH COMPLEX EXPR 05400829 + IVTNUM = 32 05410829 + JVI = 32 05420829 + AVC = (3.9, 5.0) 05430829 + AVD = (3.4, 4.5) + (3.9, 5.0) 05440829 + BVD = CVD + DBLE((3.4, 4.5) + AVC) 05450829 + IF (BVD - 0.72996D+01) 20320, 10320, 40320 05460829 +40320 IF (BVD - 0.73004D+01) 10320, 10320, 20320 05470829 +10320 IVPASS = IVPASS + 1 05480829 + WRITE (NUVI, 80002) IVTNUM 05490829 + GO TO 0321 05500829 +20320 IVFAIL = IVFAIL + 1 05510829 + DVCORR = .73000000D+01 05520829 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 05530829 + 0321 CONTINUE 05540829 +CT033* TEST 33 TEST OF CMPLX AND = 05550829 +C***** WITH INTEGER EXPR 05560829 + IVTNUM = 33 05570829 + JVI = 33 05580829 + IVI = 673 05590829 + AVC = 394 - 673 05600829 + BVC = CVC + CMPLX(394 - IVI) 05610829 + IF (R2E(1) + 0.27902E+03) 20330, 40332, 40331 05620829 +40331 IF (R2E(1) + 0.27898E+03) 40332, 40332, 20330 05630829 +40332 IF (R2E(2) + 0.50000E-04) 20330, 10330, 40330 05640829 +40330 IF (R2E(2) - 0.50000E-04) 10330, 10330, 20330 05650829 +10330 IVPASS = IVPASS + 1 05660829 + WRITE (NUVI, 80002) IVTNUM 05670829 + GO TO 0331 05680829 +20330 IVFAIL = IVFAIL + 1 05690829 + ZVCORR = (-279.00000, .00000000) 05700829 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 05710829 + 0331 CONTINUE 05720829 +CT034* TEST 34 WITH REAL EXPR 05730829 + IVTNUM = 34 05740829 + JVI = 34 05750829 + AVS = 3.48 05760829 + AVC = 3.48 * 47.98 05770829 + BVC = CVC + CMPLX(AVS * 47.98) 05780829 + IF (R2E(1) - 0.16696E+03) 20340, 40342, 40341 05790829 +40341 IF (R2E(1) - 0.16698E+03) 40342, 40342, 20340 05800829 +40342 IF (R2E(2) + 0.50000E-04) 20340, 10340, 40340 05810829 +40340 IF (R2E(2) - 0.50000E-04) 10340, 10340, 20340 05820829 +10340 IVPASS = IVPASS + 1 05830829 + WRITE (NUVI, 80002) IVTNUM 05840829 + GO TO 0341 05850829 +20340 IVFAIL = IVFAIL + 1 05860829 + ZVCORR = (166.97040, .00000000) 05870829 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 05880829 + 0341 CONTINUE 05890829 +CT035* TEST 35 05900829 + IVTNUM = 35 05910829 + JVI = 35 05920829 + AVD = 0.94D1 05930829 + AVC = 3.0283D3 / 0.94D1 05940829 + BVC = CVC + CMPLX(3.0283D3 / AVD) 05950829 + IF (R2E(1) - 0.32214E+03) 20350, 40352, 40351 05960829 +40351 IF (R2E(1) - 0.32218E+03) 40352, 40352, 20350 05970829 +40352 IF (R2E(2) + 0.50000E-04) 20350, 10350, 40350 05980829 +40350 IF (R2E(2) - 0.50000E-04) 10350, 10350, 20350 05990829 +10350 IVPASS = IVPASS + 1 06000829 + WRITE (NUVI, 80002) IVTNUM 06010829 + GO TO 0351 06020829 +20350 IVFAIL = IVFAIL + 1 06030829 + ZVCORR = (322.15957, .000000000) 06040829 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 06050829 + 0351 CONTINUE 06060829 +C***** 06070829 +CBB** ********************** BBCSUM0 **********************************06080829 +C**** WRITE OUT TEST SUMMARY 06090829 +C**** 06100829 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 06110829 + WRITE (I02, 90004) 06120829 + WRITE (I02, 90014) 06130829 + WRITE (I02, 90004) 06140829 + WRITE (I02, 90020) IVPASS 06150829 + WRITE (I02, 90022) IVFAIL 06160829 + WRITE (I02, 90024) IVDELE 06170829 + WRITE (I02, 90026) IVINSP 06180829 + WRITE (I02, 90028) IVTOTN, IVTOTL 06190829 +CBE** ********************** BBCSUM0 **********************************06200829 +CBB** ********************** BBCFOOT0 **********************************06210829 +C**** WRITE OUT REPORT FOOTINGS 06220829 +C**** 06230829 + WRITE (I02,90016) ZPROG, ZPROG 06240829 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 06250829 + WRITE (I02,90019) 06260829 +CBE** ********************** BBCFOOT0 **********************************06270829 +CBB** ********************** BBCFMT0A **********************************06280829 +C**** FORMATS FOR TEST DETAIL LINES 06290829 +C**** 06300829 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 06310829 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 06320829 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 06330829 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 06340829 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 06350829 + 1I6,/," ",15X,"CORRECT= " ,I6) 06360829 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06370829 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 06380829 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06390829 + 1A21,/," ",16X,"CORRECT= " ,A21) 06400829 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 06410829 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 06420829 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 06430829 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 06440829 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 06450829 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 06460829 +80050 FORMAT (" ",48X,A31) 06470829 +CBE** ********************** BBCFMT0A **********************************06480829 +CBB** ********************** BBCFMAT1 **********************************06490829 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 06500829 +C**** 06510829 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06520829 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 06530829 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 06540829 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 06550829 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06560829 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 06570829 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06580829 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 06590829 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 06600829 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 06610829 + 2"(",F12.5,", ",F12.5,")") 06620829 +CBE** ********************** BBCFMAT1 **********************************06630829 +CBB** ********************** BBCFMT0B **********************************06640829 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 06650829 +C**** 06660829 +90002 FORMAT ("1") 06670829 +90004 FORMAT (" ") 06680829 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )06690829 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 06700829 +90008 FORMAT (" ",21X,A13,A17) 06710829 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 06720829 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 06730829 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 06740829 + 1 7X,"REMARKS",24X) 06750829 +90014 FORMAT (" ","----------------------------------------------" , 06760829 + 1 "---------------------------------" ) 06770829 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 06780829 +C**** 06790829 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 06800829 +C**** 06810829 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 06820829 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 06830829 + 1 A13) 06840829 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 06850829 +C**** 06860829 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 06870829 +C**** 06880829 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 06890829 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 06900829 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 06910829 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 06920829 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 06930829 +CBE** ********************** BBCFMT0B **********************************06940829 +C***** 06950829 +C***** END OF TEST SEGMENT 206 06960829 + STOP 06970829 + END 06980829 diff --git a/Fortran/UnitTests/fcvs21_f95/FM829.reference_output b/Fortran/UnitTests/fcvs21_f95/FM829.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM829.reference_output @@ -0,0 +1,69 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM829BEGIN* TEST RESULTS - FM829 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YGEN1 - (206) GENERIC FUNCTIONS -- + + INT, REAL, DBLE, CMPLX + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 35 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + + ------------------------------------------------------------------------------- + + 35 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 35 OF 35 TESTS EXECUTED + + *FM829END* END OF TEST - FM829 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM830.f b/Fortran/UnitTests/fcvs21_f95/FM830.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM830.f @@ -0,0 +1,322 @@ + PROGRAM FM830 + +C***********************************************************************00010830 +C***** FORTRAN 77 00020830 +C***** FM830 00030830 +C***** YGEN2 - (207) 00040830 +C***** 00050830 +C***********************************************************************00060830 +C***** GENERAL PURPOSE ANS REF 00070830 +C***** TEST GENERIC FUNCTIONS 15.3 00080830 +C***** AINT, ANINT, NINT, SQRT, EXP, LOG, LOG10 TABLE 5 00090830 +C***** 00100830 +CBB** ********************** BBCCOMNT **********************************00110830 +C**** 00120830 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130830 +C**** VERSION 2.1 00140830 +C**** 00150830 +C**** 00160830 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170830 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180830 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190830 +C**** BUILDING 225 RM A266 00200830 +C**** GAITHERSBURG, MD 20899 00210830 +C**** 00220830 +C**** 00230830 +C**** 00240830 +CBE** ********************** BBCCOMNT **********************************00250830 +C***** 00260830 +C***** S P E C I F I C A T I O N S SEGMENT 207 00270830 + DOUBLE PRECISION AVD, DVCORR 00280830 + COMPLEX AVC, ZVCORR 00290830 + REAL R2E(2) 00300830 + EQUIVALENCE (AVC, R2E) 00310830 +C***** 00320830 +CBB** ********************** BBCINITA **********************************00330830 +C**** SPECIFICATION STATEMENTS 00340830 +C**** 00350830 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00360830 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00370830 +CBE** ********************** BBCINITA **********************************00380830 +CBB** ********************** BBCINITB **********************************00390830 +C**** INITIALIZE SECTION 00400830 + DATA ZVERS, ZVERSD, ZDATE 00410830 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00420830 + DATA ZCOMPL, ZNAME, ZTAPE 00430830 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00440830 + DATA ZPROJ, ZTAPED, ZPROG 00450830 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00460830 + DATA REMRKS /' '/ 00470830 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00480830 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00490830 +C**** 00500830 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00510830 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00520830 +CZ03 ZPROG = 'PROGRAM NAME' 00530830 +CZ04 ZDATE = 'DATE OF TEST' 00540830 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00550830 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00560830 +CZ07 ZNAME = 'NAME OF USER' 00570830 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00580830 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00590830 +C 00600830 + IVPASS = 0 00610830 + IVFAIL = 0 00620830 + IVDELE = 0 00630830 + IVINSP = 0 00640830 + IVTOTL = 0 00650830 + IVTOTN = 0 00660830 + ICZERO = 0 00670830 +C 00680830 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00690830 + I01 = 05 00700830 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00710830 + I02 = 06 00720830 +C 00730830 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00740830 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750830 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00760830 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00770830 +C 00780830 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00790830 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00800830 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00810830 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00820830 +C 00830830 +CBE** ********************** BBCINITB **********************************00840830 + NUVI = I02 00850830 + IVTOTL = 9 00860830 + ZPROG = 'FM830' 00870830 +CBB** ********************** BBCHED0A **********************************00880830 +C**** 00890830 +C**** WRITE REPORT TITLE 00900830 +C**** 00910830 + WRITE (I02, 90002) 00920830 + WRITE (I02, 90006) 00930830 + WRITE (I02, 90007) 00940830 + WRITE (I02, 90008) ZVERS, ZVERSD 00950830 + WRITE (I02, 90009) ZPROG, ZPROG 00960830 + WRITE (I02, 90010) ZDATE, ZCOMPL 00970830 +CBE** ********************** BBCHED0A **********************************00980830 +C***** 00990830 +C***** HEADER FOR SEGMENT 207 01000830 + WRITE(NUVI,20700) 01010830 +20700 FORMAT( " ", / " YGEN2 - (207) GENERIC FUNCTIONS --" // 01020830 + 1 " AINT, ANINT, NINT, SQRT, EXP, LOG, LOG10" // 01030830 + 2 " ANS REF. - 15.3" ) 01040830 +CBB** ********************** BBCHED0B **********************************01050830 +C**** WRITE DETAIL REPORT HEADERS 01060830 +C**** 01070830 + WRITE (I02,90004) 01080830 + WRITE (I02,90004) 01090830 + WRITE (I02,90013) 01100830 + WRITE (I02,90014) 01110830 + WRITE (I02,90015) IVTOTL 01120830 +CBE** ********************** BBCHED0B **********************************01130830 +C***** 01140830 +CT001* TEST 1 TEST OF NINT WITH DOUBLE PREC 01150830 + IVTNUM = 1 01160830 + LVI = NINT(27.96875D0) 01170830 + IF (LVI - 28) 20010, 10010, 20010 01180830 +10010 IVPASS = IVPASS + 1 01190830 + WRITE (NUVI, 80002) IVTNUM 01200830 + GO TO 0011 01210830 +20010 IVFAIL = IVFAIL + 1 01220830 + IVCORR = 28 01230830 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01240830 + 0011 CONTINUE 01250830 +CT002* TEST 2 TEST OF AINT AND ANINT WITH DOUBLE PREC 01260830 + IVTNUM = 2 01270830 + AVD = AINT(-1.375D0) + ANINT(-27.96875D0) 01280830 + IF (AVD + 0.2900000002D+02) 20020, 10020, 40020 01290830 +40020 IF (AVD + 0.2899999998D+02) 10020, 10020, 20020 01300830 +10020 IVPASS = IVPASS + 1 01310830 + WRITE (NUVI, 80002) IVTNUM 01320830 + GO TO 0021 01330830 +20020 IVFAIL = IVFAIL + 1 01340830 + DVCORR = -29.0D0 01350830 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01360830 + 0021 CONTINUE 01370830 +CT003* TEST 3 TEST OF SQRT AND EXP WITH DOUBLE PREC 01380830 + IVTNUM = 3 01390830 + AVD = SQRT(16.0D0) - EXP(5.125D0) 01400830 + IF (AVD + 0.1641741418D+03) 20030, 10030, 40030 01410830 +40030 IF (AVD + 0.1641741415D+03) 10030, 10030, 20030 01420830 +10030 IVPASS = IVPASS + 1 01430830 + WRITE (NUVI, 80002) IVTNUM 01440830 + GO TO 0031 01450830 +20030 IVFAIL = IVFAIL + 1 01460830 + DVCORR = -0.16417414165D+03 01470830 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01480830 + 0031 CONTINUE 01490830 +CT004* TEST 4 TEST OF LOG AND LOG10 WITH DOUBLE PREC 01500830 + IVTNUM = 4 01510830 + AVD = LOG(9.5D0) * LOG10(25.25D0) 01520830 + IF (AVD - 0.3156899548D+01) 20040, 10040, 40040 01530830 +40040 IF (AVD - 0.3156899552D+01) 10040, 10040, 20040 01540830 +10040 IVPASS = IVPASS + 1 01550830 + WRITE (NUVI, 80002) IVTNUM 01560830 + GO TO 0041 01570830 +20040 IVFAIL = IVFAIL + 1 01580830 + DVCORR = 0.31568995498D+01 01590830 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01600830 + 0041 CONTINUE 01610830 +CT005* TEST 5 TEST OF AINT, SQRT AND LOG10 01620830 + IVTNUM = 5 01630830 + AVD = (AINT(2.75D0) + SQRT(17.125D0)) * LOG10(10.0D0) 01640830 + IF (AVD - 0.6138236337D+01) 20050, 10050, 40050 01650830 +40050 IF (AVD - 0.6138236343D+01) 10050, 10050, 20050 01660830 +10050 IVPASS = IVPASS + 1 01670830 + WRITE (NUVI, 80002) IVTNUM 01680830 + GO TO 0051 01690830 +20050 IVFAIL = IVFAIL + 1 01700830 + DVCORR = 0.613823634D+01 01710830 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01720830 + 0051 CONTINUE 01730830 +CT006* TEST 6 TEST OF AINT AND NINT WITH DOUBLE PREC 01740830 + IVTNUM = 6 01750830 + AVD = AINT(72.375D0) * NINT(-4.25D0) 01760830 + IF (AVD + 0.2880000002D+03) 20060, 10060, 40060 01770830 +40060 IF (AVD + 0.2879999998D+03) 10060, 10060, 20060 01780830 +10060 IVPASS = IVPASS + 1 01790830 + WRITE (NUVI, 80002) IVTNUM 01800830 + GO TO 0061 01810830 +20060 IVFAIL = IVFAIL + 1 01820830 + DVCORR = -288.0D0 01830830 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01840830 + 0061 CONTINUE 01850830 +CT007* TEST 7 TEST OF SQRT, EXP AND LOG WITH COMPLEX 01860830 + IVTNUM = 7 01870830 + AVC = SQRT((-4.0,2.0)) + EXP((2.125,6.75)) * LOG((17.375,2.5)) 01880830 + IF (R2E(1) - 0.21370E+02) 20070, 40072, 40071 01890830 +40071 IF (R2E(1) - 0.21373E+02) 40072, 40072, 20070 01900830 +40072 IF (R2E(2) - 0.13922E+02) 20070, 10070, 40070 01910830 +40070 IF (R2E(2) - 0.13925E+02) 10070, 10070, 20070 01920830 +10070 IVPASS = IVPASS + 1 01930830 + WRITE (NUVI, 80002) IVTNUM 01940830 + GO TO 0071 01950830 +20070 IVFAIL = IVFAIL + 1 01960830 + ZVCORR = (21.3712104, 13.9235362) 01970830 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01980830 + 0071 CONTINUE 01990830 +CT008* TEST 8 TEST OF SQRT WITH REAL AND COMPLEX 02000830 + IVTNUM = 8 02010830 + AVC = SQRT(77.76953) - SQRT((-22.125, 7.0)) 02020830 + IF (R2E(1) - 0.80831E+01) 20080, 40082, 40081 02030830 +40081 IF (R2E(1) - 0.80840E+01) 40082, 40082, 20080 02040830 +40082 IF (R2E(2) + 0.47611E+01) 20080, 10080, 40080 02050830 +40080 IF (R2E(2) + 0.47605E+01) 10080, 10080, 20080 02060830 +10080 IVPASS = IVPASS + 1 02070830 + WRITE (NUVI, 80002) IVTNUM 02080830 + GO TO 0081 02090830 +20080 IVFAIL = IVFAIL + 1 02100830 + ZVCORR = (8.0835370, -4.7608266) 02110830 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02120830 + 0081 CONTINUE 02130830 +CT009* TEST 9 TEST OF AINT, NINT, EXP AND LOG 02140830 +C***** WITH REAL AND COMPLEX 02150830 + IVTNUM = 9 02160830 + AVC = AINT(2.25) * NINT(1.50) + EXP((1.0, 2.0)) - LOG(5.125) 02170830 + IF (R2E(1) - 0.12346E+01) 20090, 40092, 40091 02180830 +40091 IF (R2E(1) - 0.12348E+01) 40092, 40092, 20090 02190830 +40092 IF (R2E(2) - 0.24716E+01) 20090, 10090, 40090 02200830 +40090 IF (R2E(2) - 0.24719E+01) 10090, 10090, 20090 02210830 +10090 IVPASS = IVPASS + 1 02220830 + WRITE (NUVI, 80002) IVTNUM 02230830 + GO TO 0091 02240830 +20090 IVFAIL = IVFAIL + 1 02250830 + ZVCORR = (1.234665192, 2.471726672) 02260830 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02270830 + 0091 CONTINUE 02280830 +C***** 02290830 +CBB** ********************** BBCSUM0 **********************************02300830 +C**** WRITE OUT TEST SUMMARY 02310830 +C**** 02320830 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02330830 + WRITE (I02, 90004) 02340830 + WRITE (I02, 90014) 02350830 + WRITE (I02, 90004) 02360830 + WRITE (I02, 90020) IVPASS 02370830 + WRITE (I02, 90022) IVFAIL 02380830 + WRITE (I02, 90024) IVDELE 02390830 + WRITE (I02, 90026) IVINSP 02400830 + WRITE (I02, 90028) IVTOTN, IVTOTL 02410830 +CBE** ********************** BBCSUM0 **********************************02420830 +CBB** ********************** BBCFOOT0 **********************************02430830 +C**** WRITE OUT REPORT FOOTINGS 02440830 +C**** 02450830 + WRITE (I02,90016) ZPROG, ZPROG 02460830 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02470830 + WRITE (I02,90019) 02480830 +CBE** ********************** BBCFOOT0 **********************************02490830 +CBB** ********************** BBCFMT0A **********************************02500830 +C**** FORMATS FOR TEST DETAIL LINES 02510830 +C**** 02520830 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02530830 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02540830 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02550830 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02560830 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02570830 + 1I6,/," ",15X,"CORRECT= " ,I6) 02580830 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02590830 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02600830 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02610830 + 1A21,/," ",16X,"CORRECT= " ,A21) 02620830 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02630830 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02640830 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02650830 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02660830 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02670830 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02680830 +80050 FORMAT (" ",48X,A31) 02690830 +CBE** ********************** BBCFMT0A **********************************02700830 +CBB** ********************** BBCFMAT1 **********************************02710830 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02720830 +C**** 02730830 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02740830 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02750830 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02760830 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02770830 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02780830 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02790830 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02800830 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02810830 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02820830 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02830830 + 2"(",F12.5,", ",F12.5,")") 02840830 +CBE** ********************** BBCFMAT1 **********************************02850830 +CBB** ********************** BBCFMT0B **********************************02860830 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02870830 +C**** 02880830 +90002 FORMAT ("1") 02890830 +90004 FORMAT (" ") 02900830 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02910830 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02920830 +90008 FORMAT (" ",21X,A13,A17) 02930830 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02940830 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02950830 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02960830 + 1 7X,"REMARKS",24X) 02970830 +90014 FORMAT (" ","----------------------------------------------" , 02980830 + 1 "---------------------------------" ) 02990830 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03000830 +C**** 03010830 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03020830 +C**** 03030830 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03040830 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03050830 + 1 A13) 03060830 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03070830 +C**** 03080830 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03090830 +C**** 03100830 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03110830 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03120830 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03130830 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03140830 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03150830 +CBE** ********************** BBCFMT0B **********************************03160830 +C***** 03170830 +C***** END OF TEST SEGMENT 207 03180830 + STOP 03190830 + END 03200830 diff --git a/Fortran/UnitTests/fcvs21_f95/FM830.reference_output b/Fortran/UnitTests/fcvs21_f95/FM830.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM830.reference_output @@ -0,0 +1,43 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM830BEGIN* TEST RESULTS - FM830 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YGEN2 - (207) GENERIC FUNCTIONS -- + + AINT, ANINT, NINT, SQRT, EXP, LOG, LOG10 + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 9 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + + ------------------------------------------------------------------------------- + + 9 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 9 OF 9 TESTS EXECUTED + + *FM830END* END OF TEST - FM830 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM831.f b/Fortran/UnitTests/fcvs21_f95/FM831.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM831.f @@ -0,0 +1,371 @@ + PROGRAM FM831 + +C***********************************************************************00010831 +C***** FORTRAN 77 00020831 +C***** FM831 00030831 +C***** YGEN3 - (208) 00040831 +C***** 00050831 +C***********************************************************************00060831 +C***** GENERAL PURPOSE ANS REF 00070831 +C***** TEST GENERIC FUNCTIONS 15.3 00080831 +C***** ABS, MOD, SIGN, SIN, COS, TAN, SINH, COSH, TANH TABLE 5 00090831 +C***** 00100831 +CBB** ********************** BBCCOMNT **********************************00110831 +C**** 00120831 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130831 +C**** VERSION 2.1 00140831 +C**** 00150831 +C**** 00160831 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170831 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180831 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190831 +C**** BUILDING 225 RM A266 00200831 +C**** GAITHERSBURG, MD 20899 00210831 +C**** 00220831 +C**** 00230831 +C**** 00240831 +CBE** ********************** BBCCOMNT **********************************00250831 +C***** 00260831 +C***** S P E C I F I C A T I O N S SEGMENT 208 00270831 + DOUBLE PRECISION AVD, CVD, DVD, DVCORR 00280831 + COMPLEX AVC, CVC, ZVCORR 00290831 + REAL R2E(2) 00300831 + EQUIVALENCE (AVC, R2E) 00310831 +C***** 00320831 +CBB** ********************** BBCINITA **********************************00330831 +C**** SPECIFICATION STATEMENTS 00340831 +C**** 00350831 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00360831 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00370831 +CBE** ********************** BBCINITA **********************************00380831 +CBB** ********************** BBCINITB **********************************00390831 +C**** INITIALIZE SECTION 00400831 + DATA ZVERS, ZVERSD, ZDATE 00410831 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00420831 + DATA ZCOMPL, ZNAME, ZTAPE 00430831 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00440831 + DATA ZPROJ, ZTAPED, ZPROG 00450831 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00460831 + DATA REMRKS /' '/ 00470831 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00480831 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00490831 +C**** 00500831 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00510831 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00520831 +CZ03 ZPROG = 'PROGRAM NAME' 00530831 +CZ04 ZDATE = 'DATE OF TEST' 00540831 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00550831 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00560831 +CZ07 ZNAME = 'NAME OF USER' 00570831 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00580831 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00590831 +C 00600831 + IVPASS = 0 00610831 + IVFAIL = 0 00620831 + IVDELE = 0 00630831 + IVINSP = 0 00640831 + IVTOTL = 0 00650831 + IVTOTN = 0 00660831 + ICZERO = 0 00670831 +C 00680831 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00690831 + I01 = 05 00700831 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00710831 + I02 = 06 00720831 +C 00730831 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00740831 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00750831 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00760831 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00770831 +C 00780831 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00790831 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00800831 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00810831 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00820831 +C 00830831 +CBE** ********************** BBCINITB **********************************00840831 + NUVI = I02 00850831 + IVTOTL = 12 00860831 + ZPROG = 'FM831' 00870831 +CBB** ********************** BBCHED0A **********************************00880831 +C**** 00890831 +C**** WRITE REPORT TITLE 00900831 +C**** 00910831 + WRITE (I02, 90002) 00920831 + WRITE (I02, 90006) 00930831 + WRITE (I02, 90007) 00940831 + WRITE (I02, 90008) ZVERS, ZVERSD 00950831 + WRITE (I02, 90009) ZPROG, ZPROG 00960831 + WRITE (I02, 90010) ZDATE, ZCOMPL 00970831 +CBE** ********************** BBCHED0A **********************************00980831 +C***** 00990831 +C***** HEADER FOR SEGMENT 208 01000831 + WRITE(NUVI,20800) 01010831 +20800 FORMAT( " ", / " YGEN3 - (208) GENERIC FUNCTIONS --" // 01020831 + 1 " ABS, MOD, SIGN, SIN, COS, TAN, SINH, COSH, TANH" // 01030831 + 2 " ANS REF. - 15.3" ) 01040831 +CBB** ********************** BBCHED0B **********************************01050831 +C**** WRITE DETAIL REPORT HEADERS 01060831 +C**** 01070831 + WRITE (I02,90004) 01080831 + WRITE (I02,90004) 01090831 + WRITE (I02,90013) 01100831 + WRITE (I02,90014) 01110831 + WRITE (I02,90015) IVTOTL 01120831 +CBE** ********************** BBCHED0B **********************************01130831 +C***** 01140831 +CT001* TEST 1 TEST OF ABS AND SIGN WITH INTEGERS 01150831 + IVTNUM = 1 01160831 + LVI = ABS(-25) - SIGN(2, -15) 01170831 + IF (LVI - 27) 20010, 10010, 20010 01180831 +10010 IVPASS = IVPASS + 1 01190831 + WRITE (NUVI, 80002) IVTNUM 01200831 + GO TO 0011 01210831 +20010 IVFAIL = IVFAIL + 1 01220831 + IVCORR = 27 01230831 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01240831 + 0011 CONTINUE 01250831 +CT002* TEST 2 TEST OF MOD, SIGN AND ABS WITH REALS 01260831 + IVTNUM = 2 01270831 + AVS = MOD(24.5, 2.5) + SIGN(-1.50, -5.125) - ABS(-63.5) 01280831 + IF (AVS + 0.63004E+02) 20020, 10020, 40020 01290831 +40020 IF (AVS + 0.62996E+02) 10020, 10020, 20020 01300831 +10020 IVPASS = IVPASS + 1 01310831 + WRITE (NUVI, 80002) IVTNUM 01320831 + GO TO 0021 01330831 +20020 IVFAIL = IVFAIL + 1 01340831 + RVCORR = -63.0 01350831 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01360831 + 0021 CONTINUE 01370831 +CT003* TEST 3 TEST OF SIN AND COS WITH DOUBLE PREC 01380831 + IVTNUM = 3 01390831 + CVD = 1.125D0 01400831 + AVD = (SIN(CVD)) ** 2 + (COS(CVD)) ** 2 01410831 + IF (AVD - 0.9999999995D+00) 20030, 10030, 40030 01420831 +40030 IF (AVD - 0.1000000001D+01) 10030, 10030, 20030 01430831 +10030 IVPASS = IVPASS + 1 01440831 + WRITE (NUVI, 80002) IVTNUM 01450831 + GO TO 0031 01460831 +20030 IVFAIL = IVFAIL + 1 01470831 + DVCORR = 1.0D0 01480831 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01490831 + 0031 CONTINUE 01500831 +CT004* TEST 4 TEST OF TAN AND MOD WITH DOUBLE PREC 01510831 + IVTNUM = 4 01520831 + AVD = TAN(3.5D0) * MOD(32.5D0, 5.0D0) 01530831 + IF (AVD - 0.9364640999D+00) 20040, 10040, 40040 01540831 +40040 IF (AVD - 0.9364641009D+00) 10040, 10040, 20040 01550831 +10040 IVPASS = IVPASS + 1 01560831 + WRITE (NUVI, 80002) IVTNUM 01570831 + GO TO 0041 01580831 +20040 IVFAIL = IVFAIL + 1 01590831 + DVCORR = 0.9364641003965D0 01600831 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01610831 + 0041 CONTINUE 01620831 +CT005* TEST 5 TEST OF SINH AND COSH WITH DOUBLE PREC 01630831 + IVTNUM = 5 01640831 + CVD = 3.25D0 01650831 + AVD = (SINH(CVD)) ** 2 - (COSH(CVD)) ** 2 01660831 + IF (AVD + 0.1000000001D+01) 20050, 10050, 40050 01670831 +40050 IF (AVD + 0.9999999995D+00) 10050, 10050, 20050 01680831 +10050 IVPASS = IVPASS + 1 01690831 + WRITE (NUVI, 80002) IVTNUM 01700831 + GO TO 0051 01710831 +20050 IVFAIL = IVFAIL + 1 01720831 + DVCORR = -1.0D0 01730831 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01740831 + 0051 CONTINUE 01750831 +CT006* TEST 6 TEST OF TANH WITH DOUBLE PREC 01760831 + IVTNUM = 6 01770831 + AVD = TANH(0.5D0) * TANH(0.75D0) 01780831 + IF (AVD - 0.2935132281D+00) 20060, 10060, 40060 01790831 +40060 IF (AVD - 0.2935132285D+00) 10060, 10060, 20060 01800831 +10060 IVPASS = IVPASS + 1 01810831 + WRITE (NUVI, 80002) IVTNUM 01820831 + GO TO 0061 01830831 +20060 IVFAIL = IVFAIL + 1 01840831 + DVCORR = 0.29351322831389D0 01850831 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01860831 + 0061 CONTINUE 01870831 +CT007* TEST 7 TEST OF ABS AND SIN WITH DOUBLE PREC 01880831 + IVTNUM = 7 01890831 + AVD = ABS(4.57812500D0) * SIN(1.125D0) 01900831 + IF (AVD - 0.4130693827D+01) 20070, 10070, 40070 01910831 +40070 IF (AVD - 0.4130693832D+01) 10070, 10070, 20070 01920831 +10070 IVPASS = IVPASS + 1 01930831 + WRITE (NUVI, 80002) IVTNUM 01940831 + GO TO 0071 01950831 +20070 IVFAIL = IVFAIL + 1 01960831 + DVCORR = 4.130693829235D0 01970831 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01980831 + 0071 CONTINUE 01990831 +CT008* TEST 8 TEST OF ABS, MOD AND SIGN 02000831 +C***** WITH INTEGER, REAL AND DOUBLE PREC 02010831 + IVTNUM = 8 02020831 + LVI = -25 02030831 + AVS = 32.750 02040831 + BVS = 1.375 02050831 + CVD = 0.75D0 02060831 + DVD = 1.125D0 02070831 + AVD = ABS(LVI) - (MOD(AVS, BVS) * SIGN(CVD, DVD)) 02080831 + IF (AVD - 0.2415624998D+02) 20080, 10080, 40080 02090831 +40080 IF (AVD - 0.2415625002D+02) 10080, 10080, 20080 02100831 +10080 IVPASS = IVPASS + 1 02110831 + WRITE (NUVI, 80002) IVTNUM 02120831 + GO TO 0081 02130831 +20080 IVFAIL = IVFAIL + 1 02140831 + DVCORR = 24.15625D0 02150831 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02160831 + 0081 CONTINUE 02170831 +CT009* TEST 9 TEST OF ABS WITH COMPLEX 02180831 + IVTNUM = 9 02190831 + AVS = ABS((-2.125, 5.0)) 02200831 + IF (AVS - 0.54325E+01) 20090, 10090, 40090 02210831 +40090 IF (AVS - 0.54331E+01) 10090, 10090, 20090 02220831 +10090 IVPASS = IVPASS + 1 02230831 + WRITE (NUVI, 80002) IVTNUM 02240831 + GO TO 0091 02250831 +20090 IVFAIL = IVFAIL + 1 02260831 + RVCORR = 5.4328279 02270831 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02280831 + 0091 CONTINUE 02290831 +CT010* TEST 10 TEST OF SIN AND COS WITH COMPLEX 02300831 + IVTNUM = 10 02310831 + AVC = SIN((2.5, 3.5)) * COS((-4.75, 1.25)) 02320831 + IF (R2E(1) + 0.20512E+02) 20100, 40102, 40101 02330831 +40101 IF (R2E(1) + 0.20510E+02) 40102, 40102, 20100 02340831 +40102 IF (R2E(2) + 0.16820E+02) 20100, 10100, 40100 02350831 +40100 IF (R2E(2) + 0.16817E+02) 10100, 10100, 20100 02360831 +10100 IVPASS = IVPASS + 1 02370831 + WRITE (NUVI, 80002) IVTNUM 02380831 + GO TO 0101 02390831 +20100 IVFAIL = IVFAIL + 1 02400831 + ZVCORR = (-20.5109598, -16.8182771) 02410831 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02420831 + 0101 CONTINUE 02430831 +CT011* TEST 11 TEST OF SIN, COS AND TAN 02440831 +C***** WITH REAL AND COMPLEX 02450831 + IVTNUM = 11 02460831 + AVS = 2.0 02470831 + CVC = (3.125, 1.5) 02480831 + BVS = 3.5 02490831 + AVC = SIN(AVS) + COS(CVC) + TAN(BVS) 02500831 + IF (R2E(1) + 0.10683E+01) 20110, 40112, 40111 02510831 +40111 IF (R2E(1) + 0.10681E+01) 40112, 40112, 20110 02520831 +40112 IF (R2E(2) + 0.35331E-01) 20110, 10110, 40110 02530831 +40110 IF (R2E(2) + 0.35327E-01) 10110, 10110, 20110 02540831 +10110 IVPASS = IVPASS + 1 02550831 + WRITE (NUVI, 80002) IVTNUM 02560831 + GO TO 0111 02570831 +20110 IVFAIL = IVFAIL + 1 02580831 + ZVCORR = (-1.068203, -0.0353288) 02590831 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02600831 + 0111 CONTINUE 02610831 +CT012* TEST 12 TEST OF ABS, MOD, SIN AND COS 02620831 +C***** WITH INTEGER, REAL AND COMPLEX 02630831 + IVTNUM = 12 02640831 + AVC = ABS(-2) * MOD(17.250, 3.125) + SIN(3.125) - 02650831 + 1 COS((-0.375, 1.625)) 02660831 + IF (R2E(1) - 0.81218E+00) 20120, 40122, 40121 02670831 +40121 IF (R2E(1) - 0.81227E+00) 40122, 40122, 20120 02680831 +40122 IF (R2E(2) + 0.89403E+00) 20120, 10120, 40120 02690831 +40120 IF (R2E(2) + 0.89393E+00) 10120, 10120, 20120 02700831 +10120 IVPASS = IVPASS + 1 02710831 + WRITE (NUVI, 80002) IVTNUM 02720831 + GO TO 0121 02730831 +20120 IVFAIL = IVFAIL + 1 02740831 + ZVCORR = (0.8122242, -0.893981) 02750831 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02760831 + 0121 CONTINUE 02770831 +C***** 02780831 +CBB** ********************** BBCSUM0 **********************************02790831 +C**** WRITE OUT TEST SUMMARY 02800831 +C**** 02810831 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02820831 + WRITE (I02, 90004) 02830831 + WRITE (I02, 90014) 02840831 + WRITE (I02, 90004) 02850831 + WRITE (I02, 90020) IVPASS 02860831 + WRITE (I02, 90022) IVFAIL 02870831 + WRITE (I02, 90024) IVDELE 02880831 + WRITE (I02, 90026) IVINSP 02890831 + WRITE (I02, 90028) IVTOTN, IVTOTL 02900831 +CBE** ********************** BBCSUM0 **********************************02910831 +CBB** ********************** BBCFOOT0 **********************************02920831 +C**** WRITE OUT REPORT FOOTINGS 02930831 +C**** 02940831 + WRITE (I02,90016) ZPROG, ZPROG 02950831 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02960831 + WRITE (I02,90019) 02970831 +CBE** ********************** BBCFOOT0 **********************************02980831 +CBB** ********************** BBCFMT0A **********************************02990831 +C**** FORMATS FOR TEST DETAIL LINES 03000831 +C**** 03010831 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03020831 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03030831 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03040831 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03050831 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03060831 + 1I6,/," ",15X,"CORRECT= " ,I6) 03070831 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03080831 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03090831 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03100831 + 1A21,/," ",16X,"CORRECT= " ,A21) 03110831 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03120831 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03130831 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03140831 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03150831 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03160831 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03170831 +80050 FORMAT (" ",48X,A31) 03180831 +CBE** ********************** BBCFMT0A **********************************03190831 +CBB** ********************** BBCFMAT1 **********************************03200831 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03210831 +C**** 03220831 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03230831 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03240831 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03250831 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03260831 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03270831 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03280831 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03290831 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03300831 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03310831 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03320831 + 2"(",F12.5,", ",F12.5,")") 03330831 +CBE** ********************** BBCFMAT1 **********************************03340831 +CBB** ********************** BBCFMT0B **********************************03350831 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03360831 +C**** 03370831 +90002 FORMAT ("1") 03380831 +90004 FORMAT (" ") 03390831 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03400831 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03410831 +90008 FORMAT (" ",21X,A13,A17) 03420831 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03430831 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03440831 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03450831 + 1 7X,"REMARKS",24X) 03460831 +90014 FORMAT (" ","----------------------------------------------" , 03470831 + 1 "---------------------------------" ) 03480831 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03490831 +C**** 03500831 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03510831 +C**** 03520831 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03530831 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03540831 + 1 A13) 03550831 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03560831 +C**** 03570831 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03580831 +C**** 03590831 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03600831 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03610831 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03620831 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03630831 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03640831 +CBE** ********************** BBCFMT0B **********************************03650831 +C***** 03660831 +C***** END OF TEST SEGMENT 208 03670831 + STOP 03680831 + END 03690831 diff --git a/Fortran/UnitTests/fcvs21_f95/FM831.reference_output b/Fortran/UnitTests/fcvs21_f95/FM831.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM831.reference_output @@ -0,0 +1,46 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM831BEGIN* TEST RESULTS - FM831 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YGEN3 - (208) GENERIC FUNCTIONS -- + + ABS, MOD, SIGN, SIN, COS, TAN, SINH, COSH, TANH + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 12 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + + ------------------------------------------------------------------------------- + + 12 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 12 OF 12 TESTS EXECUTED + + *FM831END* END OF TEST - FM831 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM832.f b/Fortran/UnitTests/fcvs21_f95/FM832.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM832.f @@ -0,0 +1,484 @@ + PROGRAM FM832 + +C***********************************************************************00010832 +C***** FORTRAN 77 00020832 +C***** FM832 00030832 +C***** YGEN5 - (210) 00040832 +C***** 00050832 +C***********************************************************************00060832 +C***** GENERAL PURPOSE ANS REF 00070832 +C***** TEST GENERIC FUNCTIONS 15.3 00080832 +C***** SQRT,EXP,LOG,LOG10,COS,SINH,TANH,ASIN,ATAN,ATAN2 TABLE 5 00090832 +C***** EACH FUNCTION IS FIRST CALLED WITH A REAL VALUE 00100832 +C***** AND THEN WITH A DOUBLE PRECISION VALUE 00110832 +C***** 00120832 +CBB** ********************** BBCCOMNT **********************************00130832 +C**** 00140832 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150832 +C**** VERSION 2.1 00160832 +C**** 00170832 +C**** 00180832 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190832 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200832 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00210832 +C**** BUILDING 225 RM A266 00220832 +C**** GAITHERSBURG, MD 20899 00230832 +C**** 00240832 +C**** 00250832 +C**** 00260832 +CBE** ********************** BBCCOMNT **********************************00270832 +C***** 00280832 +C***** S P E C I F I C A T I O N S SEGMENT 210 00290832 + DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00300832 +C***** 00310832 +CBB** ********************** BBCINITA **********************************00320832 +C**** SPECIFICATION STATEMENTS 00330832 +C**** 00340832 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350832 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360832 +CBE** ********************** BBCINITA **********************************00370832 +CBB** ********************** BBCINITB **********************************00380832 +C**** INITIALIZE SECTION 00390832 + DATA ZVERS, ZVERSD, ZDATE 00400832 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410832 + DATA ZCOMPL, ZNAME, ZTAPE 00420832 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430832 + DATA ZPROJ, ZTAPED, ZPROG 00440832 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450832 + DATA REMRKS /' '/ 00460832 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470832 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480832 +C**** 00490832 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500832 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510832 +CZ03 ZPROG = 'PROGRAM NAME' 00520832 +CZ04 ZDATE = 'DATE OF TEST' 00530832 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540832 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550832 +CZ07 ZNAME = 'NAME OF USER' 00560832 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570832 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580832 +C 00590832 + IVPASS = 0 00600832 + IVFAIL = 0 00610832 + IVDELE = 0 00620832 + IVINSP = 0 00630832 + IVTOTL = 0 00640832 + IVTOTN = 0 00650832 + ICZERO = 0 00660832 +C 00670832 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680832 + I01 = 05 00690832 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700832 + I02 = 06 00710832 +C 00720832 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730832 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740832 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750832 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760832 +C 00770832 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780832 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790832 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800832 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810832 +C 00820832 +CBE** ********************** BBCINITB **********************************00830832 + NUVI = I02 00840832 + IVTOTL = 20 00850832 + ZPROG = 'FM832' 00860832 +CBB** ********************** BBCHED0A **********************************00870832 +C**** 00880832 +C**** WRITE REPORT TITLE 00890832 +C**** 00900832 + WRITE (I02, 90002) 00910832 + WRITE (I02, 90006) 00920832 + WRITE (I02, 90007) 00930832 + WRITE (I02, 90008) ZVERS, ZVERSD 00940832 + WRITE (I02, 90009) ZPROG, ZPROG 00950832 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960832 +CBE** ********************** BBCHED0A **********************************00970832 +C***** 00980832 +C***** HEADER FOR SEGMENT 210 00990832 + WRITE(NUVI,21000) 01000832 +21000 FORMAT( " ", / " YGEN5 - (210) GENERIC FUNCTIONS --" // 01010832 + 1 " SQRT,EXP,LOG,LOG10,COS,SINH,TANH,ASIN,ATAN,ATAN2" // 01020832 + 2 " ANS REF. - 15.3" ) 01030832 +CBB** ********************** BBCHED0B **********************************01040832 +C**** WRITE DETAIL REPORT HEADERS 01050832 +C**** 01060832 + WRITE (I02,90004) 01070832 + WRITE (I02,90004) 01080832 + WRITE (I02,90013) 01090832 + WRITE (I02,90014) 01100832 + WRITE (I02,90015) IVTOTL 01110832 +CBE** ********************** BBCHED0B **********************************01120832 +C***** 01130832 +C***** TEST WITH REAL ARGUMENTS 01140832 +C***** 01150832 + WRITE(NUVI, 21001) 01160832 +21001 FORMAT (/ 8X, "TEST WITH REAL ARGUMENTS" ) 01170832 +CT001* TEST 1 TEST OF SQRT 01180832 + IVTNUM = 1 01190832 + AVS = 2.0 01200832 + BVS = 1.0 01210832 + AVD = SQRT(AVS*BVS) 01220832 + IF (AVD - 0.14141E+01) 20010, 10010, 40010 01230832 +40010 IF (AVD - 0.14143E+01) 10010, 10010, 20010 01240832 +10010 IVPASS = IVPASS + 1 01250832 + WRITE (NUVI, 80002) IVTNUM 01260832 + GO TO 0011 01270832 +20010 IVFAIL = IVFAIL + 1 01280832 + RVCORR = 0.14142135381699E+01 01290832 + WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR 01300832 + 0011 CONTINUE 01310832 +CT002* TEST 2 TEST OF EXP 01320832 + IVTNUM = 2 01330832 + AVS = 10.0 01340832 + AVD = EXP(AVS / 10.0) 01350832 + IF (AVD - 0.27181E+01) 20020, 10020, 40020 01360832 +40020 IF (AVD - 0.27185E+01) 10020, 10020, 20020 01370832 +10020 IVPASS = IVPASS + 1 01380832 + WRITE (NUVI, 80002) IVTNUM 01390832 + GO TO 0021 01400832 +20020 IVFAIL = IVFAIL + 1 01410832 + RVCORR = 0.27182817459106E+01 01420832 + WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR 01430832 + 0021 CONTINUE 01440832 +CT003* TEST 3 TEST OF LOG 01450832 + IVTNUM = 3 01460832 + AVS = 0.1234 01470832 + BVS = .0000567 01480832 + AVD = LOG(AVS + BVS) 01490832 + IF (AVD + 0.20920E+01) 20030, 10030, 40030 01500832 +40030 IF (AVD + 0.20917E+01) 10030, 10030, 20030 01510832 +10030 IVPASS = IVPASS + 1 01520832 + WRITE (NUVI, 80002) IVTNUM 01530832 + GO TO 0031 01540832 +20030 IVFAIL = IVFAIL + 1 01550832 + RVCORR = -0.20918648242950E+01 01560832 + WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR 01570832 + 0031 CONTINUE 01580832 +CT004* TEST 4 TEST OF LOG10 01590832 + IVTNUM = 4 01600832 + AVS = 0.375 01610832 + BVD = 3.75D0 01620832 + AVD = LOG10(AVS) 01630832 + IF (AVD + 0.42599E+00) 20040, 10040, 40040 01640832 +40040 IF (AVD + 0.42594E+00) 10040, 10040, 20040 01650832 +10040 IVPASS = IVPASS + 1 01660832 + WRITE (NUVI, 80002) IVTNUM 01670832 + GO TO 0041 01680832 +20040 IVFAIL = IVFAIL + 1 01690832 + RVCORR = -0.42596873641014E+00 01700832 + WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR 01710832 + 0041 CONTINUE 01720832 +CT005* TEST 5 TEST OF COS 01730832 + IVTNUM = 5 01740832 + AVS = .25 01750832 + AVD = COS(AVS*2) 01760832 + IF (AVD - 0.87753E+00) 20050, 10050, 40050 01770832 +40050 IF (AVD - 0.87763E+00) 10050, 10050, 20050 01780832 +10050 IVPASS = IVPASS + 1 01790832 + WRITE (NUVI, 80002) IVTNUM 01800832 + GO TO 0051 01810832 +20050 IVFAIL = IVFAIL + 1 01820832 + RVCORR = 0.87758255004883E+00 01830832 + WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR 01840832 + 0051 CONTINUE 01850832 +CT006* TEST 6 TEST OF SINH 01860832 + IVTNUM = 6 01870832 + AVD = SINH(AVS+3.0) 01880832 + IF (AVD - 0.12875E+02) 20060, 10060, 40060 01890832 +40060 IF (AVD - 0.12877E+02) 10060, 10060, 20060 01900832 +10060 IVPASS = IVPASS + 1 01910832 + WRITE (NUVI, 80002) IVTNUM 01920832 + GO TO 0061 01930832 +20060 IVFAIL = IVFAIL + 1 01940832 + RVCORR = 0.12875782966614E+02 01950832 + WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR 01960832 + 0061 CONTINUE 01970832 +CT007* TEST 7 TEST OF TANH 01980832 + IVTNUM = 7 01990832 + CVD = 0.5D1 02000832 + AVD = TANH(AVS*20.0) 02010832 + IF (AVD - 0.99986E+00) 20070, 10070, 40070 02020832 +40070 IF (AVD - 0.99996E+00) 10070, 10070, 20070 02030832 +10070 IVPASS = IVPASS + 1 02040832 + WRITE (NUVI, 80002) IVTNUM 02050832 + GO TO 0071 02060832 +20070 IVFAIL = IVFAIL + 1 02070832 + RVCORR = 0.99990922212601E+00 02080832 + WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR 02090832 + 0071 CONTINUE 02100832 +CT008* TEST 8 TEST OF ASIN 02110832 + IVTNUM = 8 02120832 + AVD = ASIN(AVS*4.0) 02130832 + IF (AVD - 0.15707E+01) 20080, 10080, 40080 02140832 +40080 IF (AVD - 0.15709E+01) 10080, 10080, 20080 02150832 +10080 IVPASS = IVPASS + 1 02160832 + WRITE (NUVI, 80002) IVTNUM 02170832 + GO TO 0081 02180832 +20080 IVFAIL = IVFAIL + 1 02190832 + RVCORR = 0.15707963705063E+01 02200832 + WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR 02210832 + 0081 CONTINUE 02220832 +CT009* TEST 9 TEST OF ATAN 02230832 + IVTNUM = 9 02240832 + AVS = 500.0 02250832 + AVD = ATAN(-2.0*AVS) 02260832 + IF (AVD + 0.15699E+01) 20090, 10090, 40090 02270832 +40090 IF (AVD + 0.15697E+01) 10090, 10090, 20090 02280832 +10090 IVPASS = IVPASS + 1 02290832 + WRITE (NUVI, 80002) IVTNUM 02300832 + GO TO 0091 02310832 +20090 IVFAIL = IVFAIL + 1 02320832 + RVCORR = -0.15697963237762E+01 02330832 + WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR 02340832 + 0091 CONTINUE 02350832 +CT010* TEST 10 TEST OF ATAN2 02360832 + IVTNUM = 10 02370832 + AVS = 0.0 02380832 + BVS = -5.0 02390832 + AVD = ATAN2(AVS, BVS) 02400832 + IF (AVD - 0.31414E+01) 20100, 10100, 40100 02410832 +40100 IF (AVD - 0.31418E+01) 10100, 10100, 20100 02420832 +10100 IVPASS = IVPASS + 1 02430832 + WRITE (NUVI, 80002) IVTNUM 02440832 + GO TO 0101 02450832 +20100 IVFAIL = IVFAIL + 1 02460832 + RVCORR = 0.31415927410126E+01 02470832 + WRITE (NUVI, 80012) IVTNUM, AVD, RVCORR 02480832 + 0101 CONTINUE 02490832 +C***** 02500832 + WRITE (NUVI, 90002) 02510832 + WRITE (NUVI, 90013) 02520832 + WRITE (NUVI, 90014) 02530832 +C***** 02540832 +C***** TEST WITH DOUBLE PRECISION ARGUMENTS 02550832 +C***** 02560832 + WRITE (NUVI, 21002) 02570832 +21002 FORMAT (/ 08X, "TEST WITH DOUBLE PRECISION ARGUMENTS" ) 02580832 +CT011* TEST 11 TEST OF SQRT 02590832 + IVTNUM = 11 02600832 + AVS = 2.0 02610832 + BVS = 1.0 02620832 + BVD = SQRT(DBLE(AVS)) 02630832 + IF (BVD - 0.1414213561D+01) 20110, 10110, 40110 02640832 +40110 IF (BVD - 0.1414213563D+01) 10110, 10110, 20110 02650832 +10110 IVPASS = IVPASS + 1 02660832 + WRITE (NUVI, 80002) IVTNUM 02670832 + GO TO 0111 02680832 +20110 IVFAIL = IVFAIL + 1 02690832 + DVCORR = 0.14142135623731D+01 02700832 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02710832 + 0111 CONTINUE 02720832 +CT012* TEST 12 TEST OF EXP 02730832 + IVTNUM = 12 02740832 + AVS = 10.0 02750832 + BVD = EXP(1.0D0) 02760832 + IF (BVD - 0.2718281827D+01) 20120, 10120, 40120 02770832 +40120 IF (BVD - 0.2718281830D+01) 10120, 10120, 20120 02780832 +10120 IVPASS = IVPASS + 1 02790832 + WRITE (NUVI, 80002) IVTNUM 02800832 + GO TO 0121 02810832 +20120 IVFAIL = IVFAIL + 1 02820832 + DVCORR = 0.27182818284590D+01 02830832 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02840832 + 0121 CONTINUE 02850832 +CT013* TEST 13 TEST OF LOG 02860832 + IVTNUM = 13 02870832 + AVS = 0.1234 02880832 + BVS = .0000567 02890832 + BVD = LOG(0.1234567D0) 02900832 + IF (BVD + 0.2091864793D+01) 20130, 10130, 40130 02910832 +40130 IF (BVD + 0.2091864790D+01) 10130, 10130, 20130 02920832 +10130 IVPASS = IVPASS + 1 02930832 + WRITE (NUVI, 80002) IVTNUM 02940832 + GO TO 0131 02950832 +20130 IVFAIL = IVFAIL + 1 02960832 + DVCORR = -0.20918647916786D+01 02970832 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02980832 + 0131 CONTINUE 02990832 +CT014* TEST 14 TEST OF LOG10 03000832 + IVTNUM = 14 03010832 + AVS = 0.375 03020832 + BVD = 3.75D0 03030832 + BVD = LOG10(BVD / 1.0D1) 03040832 + IF (BVD + 0.4259687325D+00) 20140, 10140, 40140 03050832 +40140 IF (BVD + 0.4259687320D+00) 10140, 10140, 20140 03060832 +10140 IVPASS = IVPASS + 1 03070832 + WRITE (NUVI, 80002) IVTNUM 03080832 + GO TO 0141 03090832 +20140 IVFAIL = IVFAIL + 1 03100832 + DVCORR = -0.42596873227228D+00 03110832 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03120832 + 0141 CONTINUE 03130832 +CT015* TEST 15 TEST OF COS 03140832 + IVTNUM = 15 03150832 + AVS = .25 03160832 + BVD = COS(0.5D0) 03170832 + IF (BVD - 0.8775825614D+00) 20150, 10150, 40150 03180832 +40150 IF (BVD - 0.8775825624D+00) 10150, 10150, 20150 03190832 +10150 IVPASS = IVPASS + 1 03200832 + WRITE (NUVI, 80002) IVTNUM 03210832 + GO TO 0151 03220832 +20150 IVFAIL = IVFAIL + 1 03230832 + DVCORR = 0.87758256189037D+00 03240832 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03250832 + 0151 CONTINUE 03260832 +CT016* TEST 16 TEST OF SINH 03270832 + IVTNUM = 16 03280832 + BVD = SINH(3.25D0) 03290832 + IF (BVD - 0.1287578284D+02) 20160, 10160, 40160 03300832 +40160 IF (BVD - 0.1287578286D+02) 10160, 10160, 20160 03310832 +10160 IVPASS = IVPASS + 1 03320832 + WRITE (NUVI, 80002) IVTNUM 03330832 + GO TO 0161 03340832 +20160 IVFAIL = IVFAIL + 1 03350832 + DVCORR = 0.12875782854681D+02 03360832 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03370832 + 0161 CONTINUE 03380832 +CT017* TEST 17 TEST OF TANH 03390832 + IVTNUM = 17 03400832 + CVD = 0.5D1 03410832 + BVD = TANH(CVD) 03420832 + IF (BVD - 0.9999092037D+00) 20170, 10170, 40170 03430832 +40170 IF (BVD - 0.9999092048D+00) 10170, 10170, 20170 03440832 +10170 IVPASS = IVPASS + 1 03450832 + WRITE (NUVI, 80002) IVTNUM 03460832 + GO TO 0171 03470832 +20170 IVFAIL = IVFAIL + 1 03480832 + DVCORR = 0.99990920426260D+00 03490832 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03500832 + 0171 CONTINUE 03510832 +CT018* TEST 18 TEST OF ASIN 03520832 + IVTNUM = 18 03530832 + BVD = ASIN(100.0D0 / 1.0D2) 03540832 + IF (BVD - 0.1570796326D+01) 20180, 10180, 40180 03550832 +40180 IF (BVD - 0.1570796328D+01) 10180, 10180, 20180 03560832 +10180 IVPASS = IVPASS + 1 03570832 + WRITE (NUVI, 80002) IVTNUM 03580832 + GO TO 0181 03590832 +20180 IVFAIL = IVFAIL + 1 03600832 + DVCORR = 0.15707963267949D+01 03610832 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03620832 + 0181 CONTINUE 03630832 +CT019* TEST 19 TEST OF ATAN 03640832 + IVTNUM = 19 03650832 + AVS = 500.0 03660832 + BVD = ATAN(-1.0D3) 03670832 + IF (BVD + 0.1569796328D+01) 20190, 10190, 40190 03680832 +40190 IF (BVD + 0.1569796326D+01) 10190, 10190, 20190 03690832 +10190 IVPASS = IVPASS + 1 03700832 + WRITE (NUVI, 80002) IVTNUM 03710832 + GO TO 0191 03720832 +20190 IVFAIL = IVFAIL + 1 03730832 + DVCORR = -0.15697963271282D+01 03740832 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03750832 + 0191 CONTINUE 03760832 +CT020* TEST 20 TEST OF ATAN2 03770832 + IVTNUM = 20 03780832 + AVS = 0.0 03790832 + BVS = -5.0 03800832 + BVD = ATAN2(0.0D0, -5.0D0) 03810832 + IF (BVD - 0.3141592652D+01) 20200, 10200, 40200 03820832 +40200 IF (BVD - 0.3141592655D+01) 10200, 10200, 20200 03830832 +10200 IVPASS = IVPASS + 1 03840832 + WRITE (NUVI, 80002) IVTNUM 03850832 + GO TO 0201 03860832 +20200 IVFAIL = IVFAIL + 1 03870832 + DVCORR = 0.31415926535898D+01 03880832 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03890832 + 0201 CONTINUE 03900832 +C***** 03910832 +CBB** ********************** BBCSUM0 **********************************03920832 +C**** WRITE OUT TEST SUMMARY 03930832 +C**** 03940832 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 03950832 + WRITE (I02, 90004) 03960832 + WRITE (I02, 90014) 03970832 + WRITE (I02, 90004) 03980832 + WRITE (I02, 90020) IVPASS 03990832 + WRITE (I02, 90022) IVFAIL 04000832 + WRITE (I02, 90024) IVDELE 04010832 + WRITE (I02, 90026) IVINSP 04020832 + WRITE (I02, 90028) IVTOTN, IVTOTL 04030832 +CBE** ********************** BBCSUM0 **********************************04040832 +CBB** ********************** BBCFOOT0 **********************************04050832 +C**** WRITE OUT REPORT FOOTINGS 04060832 +C**** 04070832 + WRITE (I02,90016) ZPROG, ZPROG 04080832 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04090832 + WRITE (I02,90019) 04100832 +CBE** ********************** BBCFOOT0 **********************************04110832 +CBB** ********************** BBCFMT0A **********************************04120832 +C**** FORMATS FOR TEST DETAIL LINES 04130832 +C**** 04140832 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04150832 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04160832 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04170832 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04180832 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04190832 + 1I6,/," ",15X,"CORRECT= " ,I6) 04200832 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04210832 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04220832 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04230832 + 1A21,/," ",16X,"CORRECT= " ,A21) 04240832 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04250832 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04260832 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04270832 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04280832 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04290832 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04300832 +80050 FORMAT (" ",48X,A31) 04310832 +CBE** ********************** BBCFMT0A **********************************04320832 +CBB** ********************** BBCFMAT1 **********************************04330832 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04340832 +C**** 04350832 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04360832 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04370832 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04380832 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04390832 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04400832 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04410832 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04420832 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04430832 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04440832 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04450832 + 2"(",F12.5,", ",F12.5,")") 04460832 +CBE** ********************** BBCFMAT1 **********************************04470832 +CBB** ********************** BBCFMT0B **********************************04480832 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04490832 +C**** 04500832 +90002 FORMAT ("1") 04510832 +90004 FORMAT (" ") 04520832 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04530832 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04540832 +90008 FORMAT (" ",21X,A13,A17) 04550832 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04560832 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04570832 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04580832 + 1 7X,"REMARKS",24X) 04590832 +90014 FORMAT (" ","----------------------------------------------" , 04600832 + 1 "---------------------------------" ) 04610832 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04620832 +C**** 04630832 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04640832 +C**** 04650832 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04660832 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04670832 + 1 A13) 04680832 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04690832 +C**** 04700832 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04710832 +C**** 04720832 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04730832 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04740832 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04750832 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04760832 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04770832 +CBE** ********************** BBCFMT0B **********************************04780832 +C***** 04790832 +C***** END OF TEST SEGMENT 210 04800832 + STOP 04810832 + END 04820832 diff --git a/Fortran/UnitTests/fcvs21_f95/FM832.reference_output b/Fortran/UnitTests/fcvs21_f95/FM832.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM832.reference_output @@ -0,0 +1,61 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM832BEGIN* TEST RESULTS - FM832 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YGEN5 - (210) GENERIC FUNCTIONS -- + + SQRT,EXP,LOG,LOG10,COS,SINH,TANH,ASIN,ATAN,ATAN2 + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 20 TESTS + + + TEST WITH REAL ARGUMENTS + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST WITH DOUBLE PRECISION ARGUMENTS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + + ------------------------------------------------------------------------------- + + 20 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 20 OF 20 TESTS EXECUTED + + *FM832END* END OF TEST - FM832 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM833.f b/Fortran/UnitTests/fcvs21_f95/FM833.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM833.f @@ -0,0 +1,362 @@ + PROGRAM FM833 + +C***********************************************************************00010833 +C***** FORTRAN 77 00020833 +C***** FM833 00030833 +C***** YGEN6 - (211) 00040833 +C***** 00050833 +C***********************************************************************00060833 +C***** GENERAL PURPOSE ANS REF 00070833 +C***** TEST GENERIC FUNCTIONS 15.3 00080833 +C***** SPECIFIC AND GENERIC NAME OF SAME FUNCTION WITH TABLE 5 00090833 +C***** SAME TYPE OF ARGUMENT IN A STATEMENT 00100833 +C***** 00110833 +CBB** ********************** BBCCOMNT **********************************00120833 +C**** 00130833 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140833 +C**** VERSION 2.1 00150833 +C**** 00160833 +C**** 00170833 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180833 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00190833 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00200833 +C**** BUILDING 225 RM A266 00210833 +C**** GAITHERSBURG, MD 20899 00220833 +C**** 00230833 +C**** 00240833 +C**** 00250833 +CBE** ********************** BBCCOMNT **********************************00260833 +C***** 00270833 +C***** S P E C I F I C A T I O N S SEGMENT 211 00280833 + DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00290833 + COMPLEX AVC, BVC, ZVCORR 00300833 + REAL R2E(2) 00310833 + EQUIVALENCE (AVC, R2E) 00320833 +C***** 00330833 +CBB** ********************** BBCINITA **********************************00340833 +C**** SPECIFICATION STATEMENTS 00350833 +C**** 00360833 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00370833 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00380833 +CBE** ********************** BBCINITA **********************************00390833 +CBB** ********************** BBCINITB **********************************00400833 +C**** INITIALIZE SECTION 00410833 + DATA ZVERS, ZVERSD, ZDATE 00420833 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00430833 + DATA ZCOMPL, ZNAME, ZTAPE 00440833 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00450833 + DATA ZPROJ, ZTAPED, ZPROG 00460833 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00470833 + DATA REMRKS /' '/ 00480833 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00490833 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00500833 +C**** 00510833 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00520833 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00530833 +CZ03 ZPROG = 'PROGRAM NAME' 00540833 +CZ04 ZDATE = 'DATE OF TEST' 00550833 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00560833 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00570833 +CZ07 ZNAME = 'NAME OF USER' 00580833 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00590833 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00600833 +C 00610833 + IVPASS = 0 00620833 + IVFAIL = 0 00630833 + IVDELE = 0 00640833 + IVINSP = 0 00650833 + IVTOTL = 0 00660833 + IVTOTN = 0 00670833 + ICZERO = 0 00680833 +C 00690833 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00700833 + I01 = 05 00710833 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00720833 + I02 = 06 00730833 +C 00740833 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00750833 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00760833 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00770833 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00780833 +C 00790833 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00800833 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00810833 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00820833 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00830833 +C 00840833 +CBE** ********************** BBCINITB **********************************00850833 + NUVI = I02 00860833 + IVTOTL = 11 00870833 + ZPROG = 'FM833' 00880833 +CBB** ********************** BBCHED0A **********************************00890833 +C**** 00900833 +C**** WRITE REPORT TITLE 00910833 +C**** 00920833 + WRITE (I02, 90002) 00930833 + WRITE (I02, 90006) 00940833 + WRITE (I02, 90007) 00950833 + WRITE (I02, 90008) ZVERS, ZVERSD 00960833 + WRITE (I02, 90009) ZPROG, ZPROG 00970833 + WRITE (I02, 90010) ZDATE, ZCOMPL 00980833 +CBE** ********************** BBCHED0A **********************************00990833 +C***** 01000833 +C***** HEADER FOR SEGMENT 211 01010833 + WRITE(NUVI,21100) 01020833 +21100 FORMAT( " ", / " YGEN6 - (211) GENERIC FUNCTIONS --" // 01030833 + 1 " SPECIFIC AND GENERIC NAME OF SAME FUNCTION IN A STATEMENT" //01040833 + 2 " ANS REF. - 15.3" ) 01050833 +CBB** ********************** BBCHED0B **********************************01060833 +C**** WRITE DETAIL REPORT HEADERS 01070833 +C**** 01080833 + WRITE (I02,90004) 01090833 + WRITE (I02,90004) 01100833 + WRITE (I02,90013) 01110833 + WRITE (I02,90014) 01120833 + WRITE (I02,90015) IVTOTL 01130833 +CBE** ********************** BBCHED0B **********************************01140833 +C***** 01150833 +CT001* TEST 1 TEST OF ISIGN AND SIGN WITH INTEGER 01160833 + IVTNUM = 1 01170833 + KVI = 5 01180833 + JVI = -3 01190833 + LVI = ISIGN(KVI, JVI) - SIGN(KVI, JVI) 01200833 + IF (LVI - 0) 20010, 10010, 20010 01210833 +10010 IVPASS = IVPASS + 1 01220833 + WRITE (NUVI, 80002) IVTNUM 01230833 + GO TO 0011 01240833 +20010 IVFAIL = IVFAIL + 1 01250833 + IVCORR = 0 01260833 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01270833 + 0011 CONTINUE 01280833 +CT002* TEST 2 TEST OF AMAX1 AND MAX WITH REALS 01290833 + IVTNUM = 2 01300833 + BVS = 2.5 01310833 + CVS = 3.5 01320833 + AVS = AMAX1(BVS, CVS) - MAX(BVS, CVS) 01330833 + IF (AVS + 0.50000E-04) 20020, 10020, 40020 01340833 +40020 IF (AVS - 0.50000E-04) 10020, 10020, 20020 01350833 +10020 IVPASS = IVPASS + 1 01360833 + WRITE (NUVI, 80002) IVTNUM 01370833 + GO TO 0021 01380833 +20020 IVFAIL = IVFAIL + 1 01390833 + RVCORR = 0.0000 01400833 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01410833 + 0021 CONTINUE 01420833 +CT003* TEST 3 TEST OF DEXP AND EXP WITH DOUBLE PREC 01430833 + IVTNUM = 3 01440833 + BVD = 1.0D0 01450833 + AVD = DEXP(BVD) - EXP(BVD) 01460833 + IF (AVD + 0.5000000000D-09) 20030, 10030, 40030 01470833 +40030 IF (AVD - 0.5000000000D-09) 10030, 10030, 20030 01480833 +10030 IVPASS = IVPASS + 1 01490833 + WRITE (NUVI, 80002) IVTNUM 01500833 + GO TO 0031 01510833 +20030 IVFAIL = IVFAIL + 1 01520833 + DVCORR = 0.00000000D+00 01530833 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01540833 + 0031 CONTINUE 01550833 +CT004* TEST 4 TEST OF DTANH AND TANH WITH DOUBLE PREC 01560833 + IVTNUM = 4 01570833 + BVD = 0.5D0 01580833 + AVD = DTANH(BVD) - TANH(BVD) 01590833 + IF (AVD + 0.5000000000D-09) 20040, 10040, 40040 01600833 +40040 IF (AVD - 0.5000000000D-09) 10040, 10040, 20040 01610833 +10040 IVPASS = IVPASS + 1 01620833 + WRITE (NUVI, 80002) IVTNUM 01630833 + GO TO 0041 01640833 +20040 IVFAIL = IVFAIL + 1 01650833 + DVCORR = 0.00000000D+00 01660833 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01670833 + 0041 CONTINUE 01680833 +CT005* TEST 5 TEST OF DASIN AND ASIN WITH DOUBLE PREC 01690833 + IVTNUM = 5 01700833 + BVD = -1.0D0 01710833 + AVD = DASIN(BVD) - ASIN(BVD) 01720833 + IF (AVD + 0.5000000000D-09) 20050, 10050, 40050 01730833 +40050 IF (AVD - 0.5000000000D-09) 10050, 10050, 20050 01740833 +10050 IVPASS = IVPASS + 1 01750833 + WRITE (NUVI, 80002) IVTNUM 01760833 + GO TO 0051 01770833 +20050 IVFAIL = IVFAIL + 1 01780833 + DVCORR = 0.00000000D+00 01790833 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01800833 + 0051 CONTINUE 01810833 +CT006* TEST 6 TEST OF DNINT AND ANINT WITH DOUBLE PREC 01820833 + IVTNUM = 6 01830833 + BVD = 2.75D0 01840833 + AVD = DNINT(BVD) - ANINT(BVD) 01850833 + IF (AVD + 0.5000000000D-09) 20060, 10060, 40060 01860833 +40060 IF (AVD - 0.5000000000D-09) 10060, 10060, 20060 01870833 +10060 IVPASS = IVPASS + 1 01880833 + WRITE (NUVI, 80002) IVTNUM 01890833 + GO TO 0061 01900833 +20060 IVFAIL = IVFAIL + 1 01910833 + DVCORR = 0.00000000D+00 01920833 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01930833 + 0061 CONTINUE 01940833 +CT007* TEST 7 TEST OF DMOD AND MOD WITH DOUBLE PREC 01950833 + IVTNUM = 7 01960833 + BVD = 6.0D0 01970833 + CVD = 3.0D0 01980833 + AVD = DMOD(BVD, CVD) - MOD(BVD, CVD) 01990833 + IF (AVD + 0.5000000000D-09) 20070, 10070, 40070 02000833 +40070 IF (AVD - 0.5000000000D-09) 10070, 10070, 20070 02010833 +10070 IVPASS = IVPASS + 1 02020833 + WRITE (NUVI, 80002) IVTNUM 02030833 + GO TO 0071 02040833 +20070 IVFAIL = IVFAIL + 1 02050833 + DVCORR = 0.00000000D+00 02060833 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02070833 + 0071 CONTINUE 02080833 +CT008* TEST 8 TEST OF CABS AND ABS WITH COMPLEX 02090833 + IVTNUM = 8 02100833 + BVC = (4.0, 3.0) 02110833 + AVC = CABS(BVC) - ABS(BVC) 02120833 + IF (R2E(1) + 0.50000E-04) 20080, 40082, 40081 02130833 +40081 IF (R2E(1) - 0.50000E-04) 40082, 40082, 20080 02140833 +40082 IF (R2E(2) + 0.50000E-04) 20080, 10080, 40080 02150833 +40080 IF (R2E(2) - 0.50000E-04) 10080, 10080, 20080 02160833 +10080 IVPASS = IVPASS + 1 02170833 + WRITE (NUVI, 80002) IVTNUM 02180833 + GO TO 0081 02190833 +20080 IVFAIL = IVFAIL + 1 02200833 + ZVCORR = ( 0.0000, 0.0000) 02210833 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02220833 + 0081 CONTINUE 02230833 +CT009* TEST 9 TEST OF CSQRT AND SQRT WITH COMPLEX 02240833 + IVTNUM = 9 02250833 + BVC = (3.0, 4.0) 02260833 + AVC = CSQRT(BVC) - SQRT(BVC) 02270833 + IF (R2E(1) + 0.50000E-04) 20090, 40092, 40091 02280833 +40091 IF (R2E(1) - 0.50000E-04) 40092, 40092, 20090 02290833 +40092 IF (R2E(2) + 0.50000E-04) 20090, 10090, 40090 02300833 +40090 IF (R2E(2) - 0.50000E-04) 10090, 10090, 20090 02310833 +10090 IVPASS = IVPASS + 1 02320833 + WRITE (NUVI, 80002) IVTNUM 02330833 + GO TO 0091 02340833 +20090 IVFAIL = IVFAIL + 1 02350833 + ZVCORR = ( 0.0000, 0.0000) 02360833 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02370833 + 0091 CONTINUE 02380833 +CT010* TEST 10 TEST OF CLOG AND LOG WITH COMPLEX 02390833 + IVTNUM = 10 02400833 + BVC = (1.0, 0.0) 02410833 + AVC = CLOG(BVC) - LOG(BVC) 02420833 + IF (R2E(1) + 0.50000E-04) 20100, 40102, 40101 02430833 +40101 IF (R2E(1) - 0.50000E-04) 40102, 40102, 20100 02440833 +40102 IF (R2E(2) + 0.50000E-04) 20100, 10100, 40100 02450833 +40100 IF (R2E(2) - 0.50000E-04) 10100, 10100, 20100 02460833 +10100 IVPASS = IVPASS + 1 02470833 + WRITE (NUVI, 80002) IVTNUM 02480833 + GO TO 0101 02490833 +20100 IVFAIL = IVFAIL + 1 02500833 + ZVCORR = ( 0.0000, 0.0000) 02510833 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02520833 + 0101 CONTINUE 02530833 +CT011* TEST 11 TEST OF CSIN AND SIN WITH COMPLEX 02540833 + IVTNUM = 11 02550833 + BVC = (1.5, 3.5) 02560833 + AVC = CSIN(BVC) - SIN(BVC) 02570833 + IF (R2E(1) + 0.50000E-04) 20110, 40112, 40111 02580833 +40111 IF (R2E(1) - 0.50000E-04) 40112, 40112, 20110 02590833 +40112 IF (R2E(2) + 0.50000E-04) 20110, 10110, 40110 02600833 +40110 IF (R2E(2) - 0.50000E-04) 10110, 10110, 20110 02610833 +10110 IVPASS = IVPASS + 1 02620833 + WRITE (NUVI, 80002) IVTNUM 02630833 + GO TO 0111 02640833 +20110 IVFAIL = IVFAIL + 1 02650833 + ZVCORR = ( 0.0000, 0.0000) 02660833 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02670833 + 0111 CONTINUE 02680833 +C***** 02690833 +CBB** ********************** BBCSUM0 **********************************02700833 +C**** WRITE OUT TEST SUMMARY 02710833 +C**** 02720833 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02730833 + WRITE (I02, 90004) 02740833 + WRITE (I02, 90014) 02750833 + WRITE (I02, 90004) 02760833 + WRITE (I02, 90020) IVPASS 02770833 + WRITE (I02, 90022) IVFAIL 02780833 + WRITE (I02, 90024) IVDELE 02790833 + WRITE (I02, 90026) IVINSP 02800833 + WRITE (I02, 90028) IVTOTN, IVTOTL 02810833 +CBE** ********************** BBCSUM0 **********************************02820833 +CBB** ********************** BBCFOOT0 **********************************02830833 +C**** WRITE OUT REPORT FOOTINGS 02840833 +C**** 02850833 + WRITE (I02,90016) ZPROG, ZPROG 02860833 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02870833 + WRITE (I02,90019) 02880833 +CBE** ********************** BBCFOOT0 **********************************02890833 +CBB** ********************** BBCFMT0A **********************************02900833 +C**** FORMATS FOR TEST DETAIL LINES 02910833 +C**** 02920833 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02930833 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02940833 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02950833 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02960833 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02970833 + 1I6,/," ",15X,"CORRECT= " ,I6) 02980833 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02990833 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03000833 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03010833 + 1A21,/," ",16X,"CORRECT= " ,A21) 03020833 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03030833 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03040833 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03050833 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03060833 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03070833 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03080833 +80050 FORMAT (" ",48X,A31) 03090833 +CBE** ********************** BBCFMT0A **********************************03100833 +CBB** ********************** BBCFMAT1 **********************************03110833 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03120833 +C**** 03130833 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03140833 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03150833 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03160833 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03170833 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03180833 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03190833 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03200833 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03210833 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03220833 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03230833 + 2"(",F12.5,", ",F12.5,")") 03240833 +CBE** ********************** BBCFMAT1 **********************************03250833 +CBB** ********************** BBCFMT0B **********************************03260833 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03270833 +C**** 03280833 +90002 FORMAT ("1") 03290833 +90004 FORMAT (" ") 03300833 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03310833 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03320833 +90008 FORMAT (" ",21X,A13,A17) 03330833 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03340833 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03350833 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03360833 + 1 7X,"REMARKS",24X) 03370833 +90014 FORMAT (" ","----------------------------------------------" , 03380833 + 1 "---------------------------------" ) 03390833 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03400833 +C**** 03410833 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03420833 +C**** 03430833 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03440833 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03450833 + 1 A13) 03460833 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03470833 +C**** 03480833 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03490833 +C**** 03500833 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03510833 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03520833 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03530833 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03540833 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03550833 +CBE** ********************** BBCFMT0B **********************************03560833 +C***** 03570833 +C***** END OF TEST SEGMENT 211 03580833 + STOP 03590833 + END 03600833 diff --git a/Fortran/UnitTests/fcvs21_f95/FM833.reference_output b/Fortran/UnitTests/fcvs21_f95/FM833.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM833.reference_output @@ -0,0 +1,45 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM833BEGIN* TEST RESULTS - FM833 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YGEN6 - (211) GENERIC FUNCTIONS -- + + SPECIFIC AND GENERIC NAME OF SAME FUNCTION IN A STATEMENT + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 11 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + + ------------------------------------------------------------------------------- + + 11 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 11 OF 11 TESTS EXECUTED + + *FM833END* END OF TEST - FM833 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM834.f b/Fortran/UnitTests/fcvs21_f95/FM834.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM834.f @@ -0,0 +1,293 @@ + PROGRAM FM834 + +C***********************************************************************00010834 +C***** FORTRAN 77 00020834 +C***** FM834 00030834 +C***** YGEN7 - (212) 00040834 +C***** 00050834 +C***********************************************************************00060834 +C***** GENERAL PURPOSE ANS REF 00070834 +C***** TEST GENERIC FUNCTIONS 15.3 00080834 +C***** USES GENERIC FUNCTIONS AS ARGUMENTS TO TABLE 5 00090834 +C***** OTHER GENERIC FUNCTIONS 00100834 +C***** 00110834 +CBB** ********************** BBCCOMNT **********************************00120834 +C**** 00130834 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00140834 +C**** VERSION 2.1 00150834 +C**** 00160834 +C**** 00170834 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00180834 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00190834 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00200834 +C**** BUILDING 225 RM A266 00210834 +C**** GAITHERSBURG, MD 20899 00220834 +C**** 00230834 +C**** 00240834 +C**** 00250834 +CBE** ********************** BBCCOMNT **********************************00260834 +C***** 00270834 +C***** S P E C I F I C A T I O N S SEGMENT 212 00280834 + DOUBLE PRECISION AVD, DVCORR 00290834 + COMPLEX AVC, ZVCORR 00300834 + REAL R2E(2) 00310834 + EQUIVALENCE (AVC, R2E) 00320834 +C***** 00330834 +CBB** ********************** BBCINITA **********************************00340834 +C**** SPECIFICATION STATEMENTS 00350834 +C**** 00360834 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00370834 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00380834 +CBE** ********************** BBCINITA **********************************00390834 +CBB** ********************** BBCINITB **********************************00400834 +C**** INITIALIZE SECTION 00410834 + DATA ZVERS, ZVERSD, ZDATE 00420834 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00430834 + DATA ZCOMPL, ZNAME, ZTAPE 00440834 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00450834 + DATA ZPROJ, ZTAPED, ZPROG 00460834 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00470834 + DATA REMRKS /' '/ 00480834 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00490834 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00500834 +C**** 00510834 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00520834 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00530834 +CZ03 ZPROG = 'PROGRAM NAME' 00540834 +CZ04 ZDATE = 'DATE OF TEST' 00550834 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00560834 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00570834 +CZ07 ZNAME = 'NAME OF USER' 00580834 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00590834 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00600834 +C 00610834 + IVPASS = 0 00620834 + IVFAIL = 0 00630834 + IVDELE = 0 00640834 + IVINSP = 0 00650834 + IVTOTL = 0 00660834 + IVTOTN = 0 00670834 + ICZERO = 0 00680834 +C 00690834 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00700834 + I01 = 05 00710834 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00720834 + I02 = 06 00730834 +C 00740834 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00750834 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00760834 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00770834 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00780834 +C 00790834 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00800834 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00810834 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00820834 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00830834 +C 00840834 +CBE** ********************** BBCINITB **********************************00850834 + NUVI = I02 00860834 + IVTOTL = 7 00870834 + ZPROG = 'FM834' 00880834 +CBB** ********************** BBCHED0A **********************************00890834 +C**** 00900834 +C**** WRITE REPORT TITLE 00910834 +C**** 00920834 + WRITE (I02, 90002) 00930834 + WRITE (I02, 90006) 00940834 + WRITE (I02, 90007) 00950834 + WRITE (I02, 90008) ZVERS, ZVERSD 00960834 + WRITE (I02, 90009) ZPROG, ZPROG 00970834 + WRITE (I02, 90010) ZDATE, ZCOMPL 00980834 +CBE** ********************** BBCHED0A **********************************00990834 +C***** 01000834 +C***** HEADER FOR SEGMENT 212 01010834 + WRITE(NUVI,21200) 01020834 +21200 FORMAT( " ", / " YGEN7 - (212) GENERIC FUNCTIONS --" // 01030834 + 1 " AS ARGUMENTS TO OTHER FUNCTIONS" // 01040834 + 2 " ANS REF. - 15.3" ) 01050834 +CBB** ********************** BBCHED0B **********************************01060834 +C**** WRITE DETAIL REPORT HEADERS 01070834 +C**** 01080834 + WRITE (I02,90004) 01090834 + WRITE (I02,90004) 01100834 + WRITE (I02,90013) 01110834 + WRITE (I02,90014) 01120834 + WRITE (I02,90015) IVTOTL 01130834 +CBE** ********************** BBCHED0B **********************************01140834 +C***** 01150834 +CT001* TEST 1 TEST OF ABS AND MIN WITH INTEGERS 01160834 +C***** 01170834 + IVTNUM = 1 01180834 + LVI = 2 - ABS( MIN( -3, -8)) 01190834 + IF (LVI + 6) 20010, 10010, 20010 01200834 +10010 IVPASS = IVPASS + 1 01210834 + WRITE (NUVI, 80002) IVTNUM 01220834 + GO TO 0011 01230834 +20010 IVFAIL = IVFAIL + 1 01240834 + IVCORR = -6 01250834 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01260834 + 0011 CONTINUE 01270834 +CT002* TEST 2 TEST OF MOD AND SIGN WITH INTEGERS 01280834 + IVTNUM = 2 01290834 + LVI = 25 * MOD( SIGN( 14, -2), 3) 01300834 + IF (LVI + 50) 20020, 10020, 20020 01310834 +10020 IVPASS = IVPASS + 1 01320834 + WRITE (NUVI, 80002) IVTNUM 01330834 + GO TO 0021 01340834 +20020 IVFAIL = IVFAIL + 1 01350834 + IVCORR = -50 01360834 + WRITE (NUVI, 80010) IVTNUM, LVI, IVCORR 01370834 + 0021 CONTINUE 01380834 +CT003* TEST 3 TEST OF COS AND SQRT WITH REALS 01390834 + IVTNUM = 3 01400834 + AVS = 2.0 * COS( 1.25 + SQRT( 3.50)) 01410834 + IF (AVS + 0.19997E+01) 20030, 10030, 40030 01420834 +40030 IF (AVS + 0.19994E+01) 10030, 10030, 20030 01430834 +10030 IVPASS = IVPASS + 1 01440834 + WRITE (NUVI, 80002) IVTNUM 01450834 + GO TO 0031 01460834 +20030 IVFAIL = IVFAIL + 1 01470834 + RVCORR = -1.9995689 01480834 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01490834 + 0031 CONTINUE 01500834 +CT004* TEST 4 TEST OF MAX, LOG AND LOG10 WITH REALS 01510834 + IVTNUM = 4 01520834 + AVS = MAX( LOG( 274.125), 4.5 * LOG10( 121.75)) 01530834 + IF (AVS - 0.93841E+01) 20040, 10040, 40040 01540834 +40040 IF (AVS - 0.93851E+01) 10040, 10040, 20040 01550834 +10040 IVPASS = IVPASS + 1 01560834 + WRITE (NUVI, 80002) IVTNUM 01570834 + GO TO 0041 01580834 +20040 IVFAIL = IVFAIL + 1 01590834 + RVCORR = 9.3846103 01600834 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 01610834 + 0041 CONTINUE 01620834 +CT005* TEST 5 TEST OF EXP AND MOD WITH DOUBLE PREC 01630834 + IVTNUM = 5 01640834 + AVD = 1.0D0 - EXP(5.25D0 + MOD(76.0D0, 2.5D0)) 01650834 + IF (AVD + 0.5170128250D+03) 20050, 10050, 40050 01660834 +40050 IF (AVD + 0.5170128244D+03) 10050, 10050, 20050 01670834 +10050 IVPASS = IVPASS + 1 01680834 + WRITE (NUVI, 80002) IVTNUM 01690834 + GO TO 0051 01700834 +20050 IVFAIL = IVFAIL + 1 01710834 + DVCORR = -517.01282466834D0 01720834 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01730834 + 0051 CONTINUE 01740834 +CT006* TEST 6 TEST OF SINH, ABS, TAN AND ATAN 01750834 + IVTNUM = 6 01760834 + AVD = SINH( ABS( TAN( 3.25D0) - ATAN( 1.1D-1)) - 0.01D0) 01770834 + IF (AVD + 0.9274631705D-02) 20060, 10060, 40060 01780834 +40060 IF (AVD + 0.9274631695D-02) 10060, 10060, 20060 01790834 +10060 IVPASS = IVPASS + 1 01800834 + WRITE (NUVI, 80002) IVTNUM 01810834 + GO TO 0061 01820834 +20060 IVFAIL = IVFAIL + 1 01830834 + DVCORR = -0.92746316996764D-2 01840834 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01850834 + 0061 CONTINUE 01860834 +CT007* TEST 7 TEST OF EXP WITH COMPLEX AND COS WITH REAL 01870834 + IVTNUM = 7 01880834 + AVC = EXP( CMPLX(3.5, COS(0.925))) * CMPLX(1.0, 1.50) 01890834 + IF (R2E(1) + 0.82578E+00) 20070, 40072, 40071 01900834 +40071 IF (R2E(1) + 0.82569E+00) 40072, 40072, 20070 01910834 +40072 IF (R2E(2) - 0.59691E+02) 20070, 10070, 40070 01920834 +40070 IF (R2E(2) - 0.59697E+02) 10070, 10070, 20070 01930834 +10070 IVPASS = IVPASS + 1 01940834 + WRITE (NUVI, 80002) IVTNUM 01950834 + GO TO 0071 01960834 +20070 IVFAIL = IVFAIL + 1 01970834 + ZVCORR = (-0.8257397, 59.6940191) 01980834 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01990834 + 0071 CONTINUE 02000834 +CBB** ********************** BBCSUM0 **********************************02010834 +C**** WRITE OUT TEST SUMMARY 02020834 +C**** 02030834 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02040834 + WRITE (I02, 90004) 02050834 + WRITE (I02, 90014) 02060834 + WRITE (I02, 90004) 02070834 + WRITE (I02, 90020) IVPASS 02080834 + WRITE (I02, 90022) IVFAIL 02090834 + WRITE (I02, 90024) IVDELE 02100834 + WRITE (I02, 90026) IVINSP 02110834 + WRITE (I02, 90028) IVTOTN, IVTOTL 02120834 +CBE** ********************** BBCSUM0 **********************************02130834 +CBB** ********************** BBCFOOT0 **********************************02140834 +C**** WRITE OUT REPORT FOOTINGS 02150834 +C**** 02160834 + WRITE (I02,90016) ZPROG, ZPROG 02170834 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02180834 + WRITE (I02,90019) 02190834 +CBE** ********************** BBCFOOT0 **********************************02200834 +CBB** ********************** BBCFMT0A **********************************02210834 +C**** FORMATS FOR TEST DETAIL LINES 02220834 +C**** 02230834 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02240834 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02250834 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02260834 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02270834 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02280834 + 1I6,/," ",15X,"CORRECT= " ,I6) 02290834 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02300834 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02310834 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02320834 + 1A21,/," ",16X,"CORRECT= " ,A21) 02330834 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02340834 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02350834 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02360834 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02370834 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02380834 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02390834 +80050 FORMAT (" ",48X,A31) 02400834 +CBE** ********************** BBCFMT0A **********************************02410834 +CBB** ********************** BBCFMAT1 **********************************02420834 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02430834 +C**** 02440834 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02450834 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02460834 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02470834 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02480834 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02490834 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02500834 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02510834 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02520834 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02530834 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02540834 + 2"(",F12.5,", ",F12.5,")") 02550834 +CBE** ********************** BBCFMAT1 **********************************02560834 +CBB** ********************** BBCFMT0B **********************************02570834 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02580834 +C**** 02590834 +90002 FORMAT ("1") 02600834 +90004 FORMAT (" ") 02610834 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02620834 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02630834 +90008 FORMAT (" ",21X,A13,A17) 02640834 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02650834 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02660834 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02670834 + 1 7X,"REMARKS",24X) 02680834 +90014 FORMAT (" ","----------------------------------------------" , 02690834 + 1 "---------------------------------" ) 02700834 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02710834 +C**** 02720834 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02730834 +C**** 02740834 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02750834 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02760834 + 1 A13) 02770834 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02780834 +C**** 02790834 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02800834 +C**** 02810834 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02820834 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02830834 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02840834 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02850834 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02860834 +CBE** ********************** BBCFMT0B **********************************02870834 +C***** 02880834 +C***** END OF TEST SEGMENT 212 02890834 + STOP 02900834 + END 02910834 diff --git a/Fortran/UnitTests/fcvs21_f95/FM834.reference_output b/Fortran/UnitTests/fcvs21_f95/FM834.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM834.reference_output @@ -0,0 +1,41 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM834BEGIN* TEST RESULTS - FM834 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + YGEN7 - (212) GENERIC FUNCTIONS -- + + AS ARGUMENTS TO OTHER FUNCTIONS + + ANS REF. - 15.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 7 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + + ------------------------------------------------------------------------------- + + 7 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 7 OF 7 TESTS EXECUTED + + *FM834END* END OF TEST - FM834 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM900.f b/Fortran/UnitTests/fcvs21_f95/FM900.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM900.f @@ -0,0 +1,832 @@ + PROGRAM FM900 + +C***********************************************************************00010900 +C***** FORTRAN 77 00020900 +C***** FM900 FMTRWF - (021) 00030900 +C***** 00040900 +C***********************************************************************00050900 +C***** GENERAL PURPOSE ANS REFS00060900 +C***** TO TEST SIMPLE FORMAT AND FORMATTED DATA 12.9.5.200070900 +C***** TRANSFER STATEMENTS IN EXTERNAL SEQUENTIAL I/O SO 13.1.1 00080900 +C***** THAT THESE FEATURES MAY BE USED IN OTHER TEST 12.8.1 00090900 +C***** PROGRAM SEGMENTS FOR DOUBLE PRECISION AND COMPLEX 00100900 +C***** DATA TYPES. 00110900 +C***** RESTRICTIONS OBSERVED 12.8.2 00120900 +C***** * ALL FORMAT STATEMENTS ARE LABELED 13.1.1 00130900 +C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.2.1 00140900 +C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND 00150900 +C***** W IS EQUAL TO OR GREATER THAN D 00160900 +C***** * FIELD WIDTH IS NEVER ZERO 13.2.1 00170900 +C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE LIST ITEM 13.3 00180900 +C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST 00190900 +C***** IN THE FORMAT SPECIFICATION 00200900 +C***** * ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS 13.3 00210900 +C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 13.5.9 00220900 +C***** * FIELD WIDTH NEVER EXCEEDED BY OUTPUT 13.5.9 00230900 +C***** GENERAL COMMENTS 00240900 +C***** PLUS SIGNS FOR INPUT FIELDS ARE USUALLY OMITTED 13.5.9 00250900 +C***** FORMATTED WRITES WITHOUT AN I/O LIST (FORMAT 13.5.2 00260900 +C***** STATEMENTS TEST H AND X DESCRIPTORS AND SLASH 13.5.3 00270900 +C***** RECORD DIVIDERS) 13.5.4 00280900 +C***** 00290900 +CBB** ********************** BBCCOMNT **********************************00300900 +C**** 00310900 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00320900 +C**** VERSION 2.1 00330900 +C**** 00340900 +C**** 00350900 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00360900 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00370900 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00380900 +C**** BUILDING 225 RM A266 00390900 +C**** GAITHERSBURG, MD 20899 00400900 +C**** 00410900 +C**** 00420900 +C**** 00430900 +CBE** ********************** BBCCOMNT **********************************00440900 +C***** 00450900 +C INPUT DATA TO THIS SEGMENT CONSISTS OF 17 CARD IMAGES IN COL. 1 - 80 00460900 +COL. 1----------------------------------------------------------61 00470900 +CARD 1 1.05.522.066.633.123455.0789 00480900 +CARD 2 123.00456.88 0.123E+01 +0.987+1 -0.2345+02 -0.6879E+2+0.7E+0 00490900 +COL 62-----70 00500900 +CARD 2 3 0.4E+03 00510900 +COL. 1----------------------------------------------------------61 00520900 +CARD 3 0.9876543E-04+0.1357913E-04 00530900 +CARD 4 19.34+0.2468E+02 +.765+287.643.96 0.5407E+0243.96+0.5407E+0 00540900 +COL. 62-------------78 00550900 +CARD 4 243.96 0.5407+2 00560900 +COL. 1----------------------------- ----------------------------61 00570900 +CARD 5 +0.1D+06 00580900 +CARD 6 -0.334D-04 -.334-4 +0.7657654D00 0.12345678901D+10 00590900 +CARD 7 +0.98765432109876D-1+0.98765432109876D-01 .98765432109876 00600900 +COL. 62-66 00610900 +CARD 7 -1 00620900 +COL. 1----------------------------------------------------------61 00630900 +CARD 8 -.555555542D+03 -0.555555542+3 00640900 +CARD 9 9.91.19.92.29.93.39.94.49.91.19.92.29.93.39.94.4 00650900 +CARD 10 9.95.59.96.69.97.79.98.89.95.59.96.69.97.79.98.8 00660900 +CARD 11 -0.99D+01-0.98D+01-0.97D+01-0.96D+01-0.99D+01 -.98D+01 -.97+ 00670900 +COL. 62-------72 00680900 +CARD 11 01 -.96+1 00690900 +CARD 12 +0.99D+01 0.98D+01 +.97D01 +.96D1 00700900 +CARD 13 +0.99D+01 0.99D+01 0.99D+01+0.99D+01 .99D1 00710900 +CARD 14 9.95.59.96.69.97.79.98.8 00720900 +CARD 15 123.45678E2 1234.5678 123.45678 12.345678 1.2345678 .123 00730900 +COL. 62-66 00740900 +CARD 15 45678 00750900 +COL. 1----------------------------------------------------------61 00760900 +CARD 16 9876.5498.7654E2 9876.54 987.654864786D-486.4786E286.4786 00770900 +COL. 62---------------80 00780900 +CARD 16 8657.86D0 9876.54 00790900 +COL. 1----------------------------------------------------------61 00800900 +CARD 17 9.8765698.7654E2 9876.54 987.654864786D-386.4786E286.4786 00810900 +COL. 62---------------80 00820900 +CARD 17 8657.86D0 9876.54 00830900 +C***** 00840900 +C***** S P E C I F I C A T I O N S SEGMENT 021 00850900 +C***** 00860900 + DOUBLE PRECISION DPA1D(5),MCA3D(1,4,2),ZZDVD ,A2D(2,2),A3D(2,2,2) 00870900 + 1,AC1D(10),BC2D(7,4),DPAVD,DPBVD 00880900 + COMPLEX BVC,QAVC,CHAVC,CHBVC,CHCVC,CHDVC 00890900 + 1,LL1C(32),LM2C(8,4),A1C(12),A2C(2,2),B3C(2,2,2),B1C(8) 00900900 +C***** 00910900 +CBB** ********************** BBCINITA **********************************00920900 +C**** SPECIFICATION STATEMENTS 00930900 +C**** 00940900 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00950900 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00960900 +CBE** ********************** BBCINITA **********************************00970900 +CBB** ********************** BBCINITB **********************************00980900 +C**** INITIALIZE SECTION 00990900 + DATA ZVERS, ZVERSD, ZDATE 01000900 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 01010900 + DATA ZCOMPL, ZNAME, ZTAPE 01020900 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 01030900 + DATA ZPROJ, ZTAPED, ZPROG 01040900 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 01050900 + DATA REMRKS /' '/ 01060900 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 01070900 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 01080900 +C**** 01090900 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 01100900 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 01110900 +CZ03 ZPROG = 'PROGRAM NAME' 01120900 +CZ04 ZDATE = 'DATE OF TEST' 01130900 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 01140900 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 01150900 +CZ07 ZNAME = 'NAME OF USER' 01160900 +CZ08 ZTAPE = 'TAPE OWNER/ID' 01170900 +CZ09 ZTAPED = 'DATE TAPE COPIED' 01180900 +C 01190900 + IVPASS = 0 01200900 + IVFAIL = 0 01210900 + IVDELE = 0 01220900 + IVINSP = 0 01230900 + IVTOTL = 0 01240900 + IVTOTN = 0 01250900 + ICZERO = 0 01260900 +C 01270900 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01280900 + I01 = 05 01290900 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01300900 + I02 = 06 01310900 +C 01320900 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01330900 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01340900 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01350900 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01360900 +C 01370900 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01380900 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01390900 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01400900 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01410900 +C 01420900 +CBE** ********************** BBCINITB **********************************01430900 + IRVI = I01 01440900 + NUVI = I02 01450900 + IVTOTL = 36 01460900 + ZPROG = 'FM900' 01470900 +CBB** ********************** BBCHED0A **********************************01480900 +C**** 01490900 +C**** WRITE REPORT TITLE 01500900 +C**** 01510900 + WRITE (I02, 90002) 01520900 + WRITE (I02, 90006) 01530900 + WRITE (I02, 90007) 01540900 + WRITE (I02, 90008) ZVERS, ZVERSD 01550900 + WRITE (I02, 90009) ZPROG, ZPROG 01560900 + WRITE (I02, 90010) ZDATE, ZCOMPL 01570900 +CBE** ********************** BBCHED0A **********************************01580900 +C***** HEADER FORMAT STATEMENT 01590900 + WRITE (NUVI,02100) 01600900 +02100 FORMAT (" ",/1X,"FMTRWF - (021) FORMATTED I/O" //2X, 01610900 + 1 "REFS - 12.9.5 13.3 13.5" ) 01620900 +CBB** ********************** BBCHED0B **********************************01630900 +C**** WRITE DETAIL REPORT HEADERS 01640900 +C**** 01650900 + WRITE (I02,90004) 01660900 + WRITE (I02,90004) 01670900 + WRITE (I02,90013) 01680900 + WRITE (I02,90014) 01690900 + WRITE (I02,90015) IVTOTL 01700900 +CBE** ********************** BBCHED0B **********************************01710900 +C***** TESTS 1 THRU 11: 01720900 +C***** FORMATTED READ AND WRITE STATEMENTS WITH COMPLEX 12.8.1 01730900 +C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST. 12.8.2 01740900 +C***** E AND F CONVERSION ARE USED IN THE FORMAT 13.5.9.2.1-201750900 +C***** STATEMENTS. SOME FORMAT DESCRIPTORS ARE REPEATED 13.5.9.2.1 01760900 +C***** 01770900 +02101 FORMAT (/8X,"COMPLEX CONVERSION TEST" /) 01780900 + WRITE (NUVI,02101) 01790900 +C***** INPUT CARD 1 01800900 +02102 FORMAT ( 2(F3.1) , 2(F4.1), 2(F7.4)) 01810900 + READ (IRVI,02102) CHAVC, CHBVC, A1C(2) 01820900 +C***** INPUT CARDS 2, 3 01830900 +02103 FORMAT ( 2F6.2, 2E10.3, 2E11.4, 2E8.1/ 2E14.7) 01840900 + READ (IRVI,02103) A2C(1,2), B3C(2,2,1), CHCVC, A1C(1), CHDVC 01850900 +C***** INPUT CARD 4 01860900 +02104 FORMAT (F5.2, E11.4, E10.3, F4.1, 3(F5.2,E11.4)) 01870900 + READ (IRVI,02104) A2C(2,1), BVC, QAVC, LM2C(1,2), LL1C(2) 01880900 +CT001* TEST 1 01890900 + IVTNUM = 1 01900900 + WRITE (NUVI, 80004) IVTNUM 01910900 + WRITE (NUVI, 80020) 01920900 + WRITE (NUVI, 70010) CHAVC 01930900 +70010 FORMAT (26X,F3.1,2X,F3.1) 01940900 + IVINSP = IVINSP + 1 01950900 + WRITE (NUVI, 80022) 01960900 + WRITE (NUVI, 70011) 01970900 +70011 FORMAT (26X, "1.0 5.5") 01980900 +CT002* TEST 2 01990900 + IVTNUM = 2 02000900 + WRITE (NUVI, 80004) IVTNUM 02010900 + WRITE (NUVI, 80020) 02020900 + WRITE (NUVI, 70020) CHBVC 02030900 +70020 FORMAT (26X,F4.1,2X,F4.1) 02040900 + IVINSP = IVINSP + 1 02050900 + WRITE (NUVI, 80022) 02060900 + WRITE (NUVI, 70021) 02070900 +70021 FORMAT (26X,"22.0 66.6" ) 02080900 +CT003* TEST 3 02090900 + IVTNUM = 3 02100900 + WRITE (NUVI, 80004) IVTNUM 02110900 + WRITE (NUVI, 80020) 02120900 + WRITE (NUVI, 70030) A1C(2) 02130900 +70030 FORMAT (26X,F7.4,2X,F7.4) 02140900 + IVINSP = IVINSP + 1 02150900 + WRITE (NUVI, 80022) 02160900 + WRITE (NUVI, 70031) 02170900 +70031 FORMAT (26X,"33.1234 55.0789" ) 02180900 +CT004* TEST 4 02190900 + IVTNUM = 4 02200900 + WRITE (NUVI, 80004) IVTNUM 02210900 + WRITE (NUVI, 80020) 02220900 + WRITE (NUVI, 70040) A2C(1,2) 02230900 +70040 FORMAT (26X,F6.2,2X,F6.2) 02240900 + IVINSP = IVINSP + 1 02250900 + WRITE (NUVI, 80022) 02260900 + WRITE (NUVI, 70041) 02270900 +70041 FORMAT (26X,"123.00 456.88" ) 02280900 +CT005* TEST 5 02290900 + IVTNUM = 5 02300900 + REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL' 02310900 + WRITE (NUVI, 80004) IVTNUM,REMRKS 02320900 + WRITE (NUVI, 80020) 02330900 + WRITE (NUVI, 70050) B3C(2,2,1) 02340900 +70050 FORMAT (26X,E10.3,2X,E10.3) 02350900 + IVINSP = IVINSP + 1 02360900 + WRITE (NUVI, 70051) 02370900 +70051 FORMAT (" ",16X,"CORRECT: " ,22X, "2 CORRECT ANSWERS POSSIB02380900 + 1LE") 02390900 + WRITE (NUVI, 70052) 02400900 +70052 FORMAT (26X,"+0.123E+01 +0.987E+01" / 02410900 + 1 26X,"+0.123+001 +0.987+001" ) 02420900 +CT006* TEST 6 02430900 + IVTNUM = 6 02440900 + REMRKS = 'LEADING ZERO OPTIONAL' 02450900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 02460900 + WRITE (NUVI, 80020) 02470900 + WRITE (NUVI, 70060) CHCVC 02480900 +70060 FORMAT (26X,E11.4,2X,E11.4) 02490900 + IVINSP = IVINSP + 1 02500900 + WRITE (NUVI, 70051) 02510900 + WRITE (NUVI, 70061) 02520900 +70061 FORMAT (26X,"-0.2345E+02 -0.6879E+02" / 02530900 + 1 26X,"-0.2345+002 -0.6879+002" ) 02540900 +C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER 02550900 + WRITE (NUVI, 90002) 02560900 + WRITE (NUVI, 90013) 02570900 + WRITE (NUVI, 90014) 02580900 +C***** 02590900 +CT007* TEST 7 02600900 + IVTNUM = 7 02610900 + REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL' 02620900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 02630900 + WRITE (NUVI, 80020) 02640900 + WRITE (NUVI, 70070) A1C(1) 02650900 +70070 FORMAT (26X,E8.1,2X,E8.1) 02660900 + IVINSP = IVINSP + 1 02670900 + WRITE (NUVI, 70051) 02680900 + WRITE (NUVI, 70071) 02690900 +70071 FORMAT (26X,"+0.7E+03 +0.4E+03" / 02700900 + 1 26X,"+0.7+003 +0.4+003" ) 02710900 +CT008* TEST 8 02720900 + IVTNUM = 8 02730900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 02740900 + WRITE (NUVI, 80020) 02750900 + WRITE (NUVI, 70080) CHDVC 02760900 +70080 FORMAT (26X,E14.7,2X,E14.7) 02770900 + IVINSP = IVINSP + 1 02780900 + WRITE (NUVI, 70051) 02790900 + WRITE (NUVI, 70081) 02800900 +70081 FORMAT (26X,"+0.9876543E-04 +0.1357913E-04" / 02810900 + 1 26X,"+0.9876543-004 +0.1357913-004" ) 02820900 +CT009* TEST 9 02830900 + IVTNUM = 9 02840900 + WRITE (NUVI, 70090) IVTNUM 02850900 +70090 FORMAT (" ",2X,I3,4X,"INSPECT",32X, "LEADING PLUS SIGN/ZERO 02860900 + 1OPTIONAL"/" ",48X,"FOR THE SECOND NUMBER" ) 02870900 + WRITE (NUVI, 80020) 02880900 + WRITE (NUVI, 70091) A2C(2,1) 02890900 +70091 FORMAT (26X,F5.2,2X,E11.4) 02900900 + IVINSP = IVINSP + 1 02910900 + WRITE (NUVI, 70051) 02920900 + WRITE (NUVI, 70092) 02930900 +70092 FORMAT (26X,"19.34 +0.2468E+02" / 02940900 + 1 26X,"19.34 +0.2468+002" ) 02950900 +CT010* TEST 10 02960900 + IVTNUM = 10 02970900 + WRITE (NUVI, 70100) IVTNUM 02980900 +70100 FORMAT (" ",2X,I3,4X,"INSPECT",32X, "LEADING PLUS SIGN/ZERO 02990900 + 1OPTIONAL"/" ",48X,"FOR THE FIRST NUMBER" ) 03000900 + WRITE (NUVI, 80020) 03010900 + WRITE (NUVI, 70101) BVC 03020900 +70101 FORMAT (26X,E10.3,2X,F4.1) 03030900 + IVINSP = IVINSP + 1 03040900 + WRITE (NUVI, 70051) 03050900 + WRITE (NUVI, 70102) 03060900 +70102 FORMAT (26X,"+0.765E+02 87.6" / 03070900 + 1 26X,"+0.765+002 87.6" ) 03080900 +CT011* TEST 11 03090900 + IVTNUM = 11 03100900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 03110900 + WRITE (NUVI, 70110) 03120900 +70110 FORMAT (" ",16X,"COMPUTED:",23X,"3 COMPUTED LINES EXPECTED" )03130900 + WRITE (NUVI,70111) QAVC, LM2C(1,2), LL1C(2) 03140900 +70111 FORMAT (3(26X,F7.2,E11.4/)) 03150900 + IVINSP = IVINSP + 1 03160900 + WRITE (NUVI, 70112) 03170900 +70112 FORMAT (" ",16X,"CORRECT: " ,22X, "EACH RESULT LINE SHOULD 03180900 + 1MATCH "/" ",48X,"EITHER ONE OF THE 2 POSSIBLE " / 03190900 + 2 " ",48X,"ANSWERS BELOW" ) 03200900 + WRITE (NUVI, 70113) 03210900 +70113 FORMAT (26X," +43.96+0.5407E+02" / 03220900 + 1 26X," +43.96+0.5407+002" ) 03230900 +C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER 03240900 + WRITE (NUVI, 90002) 03250900 + WRITE (NUVI, 90013) 03260900 + WRITE (NUVI, 90014) 03270900 +C***** 03280900 +C***** TESTS 12 THRU 17: 03290900 +C***** FORMATTED READ AND WRITE STATEMENTS WITH 12.8.1 03300900 +C***** DOUBLE PRECISION VARIABLES IN AN I/O LIST. 12.8.2 03310900 +C***** D CONVERSION IS USED IN THE FORMAT STATEMENTS. 13.5.9.2.203320900 +C***** SOME D FORMAT DESCRIPTORS ARE REPEATED. (FIELD 13.3 03330900 +C***** WIDTH ALWAYS INCLUDES 6 EXTRA POSITIONS TO 13.5.9 03340900 +C***** PROVIDE FOR SIGN, DECIMAL POINT AND EXPONENT 13.5.9.2 03350900 +C***** AND 1 POSITION FOR OPTIONAL DIGIT ZERO BEFORE 03360900 +C***** THE DECIMAL POINT) 03370900 +C***** 03380900 +02109 FORMAT (/8X, "D CONVERSION TEST" /) 03390900 + WRITE (NUVI,02109) 03400900 +C***** INPUT CARD 5 03410900 +02110 FORMAT ( 2X, D8.1) 03420900 + READ (IRVI,02110) DPAVD 03430900 +C***** INPUT CARDS 6, 7, 8 03440900 +02111 FORMAT ( 2D10.3, D14.7, D18.11/ 3D21.14/ 2D16.9) 03450900 + READ (IRVI,02111) MCA3D(1,2,2), AC1D(2), BC2D(3,1), AC1D(1), 03460900 + 1 ZZDVD, AC1D(3), DPBVD, MCA3D(1,2,1), BC2D(1,2) 03470900 +CT012* TEST 12 03480900 + IVTNUM = 12 03490900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 03500900 + WRITE (NUVI, 80020) 03510900 + WRITE (NUVI,70120) DPAVD 03520900 +70120 FORMAT (26X,D8.1) 03530900 + IVINSP = IVINSP + 1 03540900 + WRITE (NUVI, 70121) 03550900 +70121 FORMAT (" ",16X,"CORRECT: " ,22X, "3 CORRECT ANSWERS POSSIB03560900 + 1LE") 03570900 + WRITE (NUVI, 70122) 03580900 +70122 FORMAT (26X,"+0.1D+06"/26X,"+0.1E+06"/26X,"+0.1+006") 03590900 +CT013* TEST 13 03600900 + IVTNUM = 13 03610900 + REMRKS = 'LEADING ZERO OPTIONAL' 03620900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 03630900 + WRITE (NUVI, 70130) 03640900 +70130 FORMAT (" ",16X,"COMPUTED:",23X,"2 COMPUTED LINES EXPECTED" )03650900 + WRITE (NUVI, 70131) MCA3D(1,2,2), AC1D(2) 03660900 +70131 FORMAT (26X,D10.3 / 26X,D10.3) 03670900 + IVINSP = IVINSP + 1 03680900 + WRITE (NUVI, 70132) 03690900 +70132 FORMAT (" ",16X,"CORRECT: " ,22X, "EACH RESULT LINE SHOULD 03700900 + 1MATCH "/" ",48X,"ONE OF THE 3 POSSIBLE ANSWERS " / 03710900 + 2 " ",48X,"BELOW") 03720900 + WRITE (NUVI, 70133) 03730900 +70133 FORMAT(26X,"-0.334D-04" /26X,"-0.334E-04" /26X,"-0.334-004" )03740900 +CT014* TEST 14 03750900 + IVTNUM = 14 03760900 + REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL' 03770900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 03780900 + WRITE (NUVI, 80020) 03790900 + WRITE (NUVI, 70140) BC2D(3,1) 03800900 +70140 FORMAT (26X,D14.7) 03810900 + IVINSP = IVINSP + 1 03820900 + WRITE (NUVI, 70121) 03830900 + WRITE (NUVI, 70141) 03840900 +70141 FORMAT (26X,"+0.7657654D+00" / 03850900 + 1 26X,"+0.7657654E+00" / 03860900 + 2 26X,"+0.7657654+000" ) 03870900 +CT015* TEST 15 03880900 + IVTNUM = 15 03890900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 03900900 + WRITE (NUVI, 80020) 03910900 + WRITE (NUVI, 70150) AC1D(1) 03920900 +70150 FORMAT (26X,D18.11) 03930900 + IVINSP = IVINSP + 1 03940900 + WRITE (NUVI, 70121) 03950900 + WRITE (NUVI, 70151) 03960900 +70151 FORMAT (26X,"+0.12345678901D+10" / 03970900 + 1 26X,"+0.12345678901E+10" / 03980900 + 2 26X,"+0.12345678901+010" ) 03990900 +CT016* TEST 16 04000900 + IVTNUM = 16 04010900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 04020900 + WRITE (NUVI, 70110) 04030900 + WRITE (NUVI, 70160) ZZDVD,AC1D(3),DPBVD 04040900 +70160 FORMAT (26X,D21.14 / 26X,D21.14 / 26X,D21.14) 04050900 + IVINSP = IVINSP + 1 04060900 + WRITE (NUVI, 70132) 04070900 + WRITE (NUVI, 70161) 04080900 +70161 FORMAT (26X,"+0.98765432109876D-01" / 04090900 + 1 26X,"+0.98765432109876E-01" / 04100900 + 2 26X,"+0.98765432109876-001" ) 04110900 +CT017* TEST 17 04120900 + IVTNUM = 17 04130900 + REMRKS = 'LEADING ZERO OPTIONAL' 04140900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 04150900 + WRITE (NUVI, 70130) 04160900 + WRITE (NUVI, 70170) MCA3D(1,2,1), BC2D(1,2) 04170900 +70170 FORMAT (26X,D16.9 /26X,D16.9) 04180900 + IVINSP = IVINSP + 1 04190900 + WRITE (NUVI, 70132) 04200900 + WRITE (NUVI, 70171) 04210900 +70171 FORMAT (26X,"-0.555555542D+03" / 04220900 + 1 26X,"-0.555555542E+03" / 04230900 + 2 26X,"-0.555555542+003" ) 04240900 +C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER 04250900 + WRITE (NUVI, 90002) 04260900 + WRITE (NUVI, 90013) 04270900 + WRITE (NUVI, 90014) 04280900 +C***** 04290900 +C***** TESTS 18 THRU 22: 04300900 +C***** FORMATTED READ AND WRITE STATEMENTS WITH ARRAY 12.8.104310900 +C***** NAMES OF ALL TYPES IN AN I/O LIST. THE NUMBER OF 12.8.204320900 +C***** ITEMS IN THE LIST IS VARIABLE. SOME FIELD 13.3 04330900 +C***** DESCRIPTORS ARE REPEATED. 04340900 +C***** 04350900 +02114 FORMAT (/8X, "TEST UNSUBSCRIPTED ARRAY NAMES IN I/O LISTS " /) 04360900 + WRITE (NUVI,02114) 04370900 +C***** INPUT CARDS 9, 10 04380900 +02115 FORMAT(2X,8(F3.1),8F3.1/8(2(F3.1))) 04390900 + READ (IRVI,02115) B1C,B3C 04400900 +C***** INPUT CARDS 11, 12 04410900 +02116 FORMAT(4(D9.2),4D9.2/2X,4(D9.2)) 04420900 + READ (IRVI,02116) A3D, A2D 04430900 +C***** INPUT CARDS 13, 14 04440900 +02117 FORMAT (2X,4(2X),5(D9.2)/4(2(F3.1))) 04450900 + READ (IRVI,02117) DPA1D, A2C 04460900 +CT018* TEST 18 04470900 + IVTNUM = 18 04480900 + WRITE (NUVI, 80004) IVTNUM 04490900 + WRITE (NUVI, 70130) 04500900 + WRITE (NUVI,70180) B1C 04510900 +70180 FORMAT (26X,8(F3.1) / 26X,8(F3.1)) 04520900 + IVINSP = IVINSP + 1 04530900 + WRITE (NUVI, 70181) 04540900 +70181 FORMAT (" ",16X,"CORRECT: " ,22X, "EACH RESULT LINE SHOULD 04550900 + 1EQUAL") 04560900 + WRITE (NUVI, 70182) 04570900 +70182 FORMAT (26X, "9.91.19.92.29.93.39.94.4" ) 04580900 +CT019* TEST 19 04590900 + IVTNUM = 19 04600900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 04610900 + WRITE (NUVI, 70130) 04620900 + WRITE (NUVI, 70190) A3D 04630900 +70190 FORMAT (26X,4(D9.2) / 26X,4(D9.2)) 04640900 + IVINSP = IVINSP + 1 04650900 + WRITE (NUVI, 70132) 04660900 + WRITE (NUVI, 70191) 04670900 +70191 FORMAT (26X,"-0.99D+01-0.98D+01-0.97D+01-0.96D+01" / 04680900 + 1 26X,"-0.99E+01-0.98E+01-0.97E+01-0.96E+01" / 04690900 + 2 26X,"-0.99+001-0.98+001-0.97+001-0.96+001" ) 04700900 +CT020* TEST 20 04710900 + IVTNUM = 20 04720900 + REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL' 04730900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 04740900 + WRITE (NUVI, 80020) 04750900 + WRITE (NUVI,70200) A2D 04760900 +70200 FORMAT (26X,4(D9.2)) 04770900 + IVINSP = IVINSP + 1 04780900 + WRITE (NUVI, 70121) 04790900 + WRITE (NUVI, 70201) 04800900 +70201 FORMAT (26X,"+0.99D+01+0.98D+01+0.97D+01+0.96D+01" / 04810900 + 1 26X,"+0.99E+01+0.98E+01+0.97E+01+0.96E+01" / 04820900 + 2 26X,"+0.99+001+0.98+001+0.97+001+0.96+001" ) 04830900 +CT021* TEST 21 04840900 + IVTNUM = 21 04850900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 04860900 + WRITE (NUVI, 70210) 04870900 +70210 FORMAT (" ",16X,"COMPUTED:",23X,"5 COMPUTED LINES EXPECTED" )04880900 + WRITE (NUVI,70211) DPA1D 04890900 +70211 FORMAT (5(26X,D11.2/)) 04900900 + IVINSP = IVINSP + 1 04910900 + WRITE (NUVI, 70132) 04920900 + WRITE (NUVI, 70212) 04930900 +70212 FORMAT (26X," +0.99D+01" / 04940900 + 1 26X," +0.99E+01" / 04950900 + 2 26X," +0.99+001" ) 04960900 +CT022* TEST 22 04970900 + IVTNUM = 22 04980900 + WRITE (NUVI, 80004) IVTNUM 04990900 + WRITE (NUVI, 70110) 05000900 + WRITE (NUVI,70220) A2C, B3C 05010900 +70220 FORMAT (26X,8(F3.1) / 26X,8(F3.1) / 26X,8(F3.1)) 05020900 + IVINSP = IVINSP + 1 05030900 + WRITE (NUVI, 70181) 05040900 + WRITE (NUVI, 70221) 05050900 +70221 FORMAT (26X,"9.95.59.96.69.97.79.98.8" ) 05060900 +C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER 05070900 + WRITE (NUVI, 90002) 05080900 + WRITE (NUVI, 90013) 05090900 + WRITE (NUVI, 90014) 05100900 +C***** 05110900 +C***** TESTS 23 THRU 30: 05120900 +C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 13.5.905130900 +C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT 05140900 +C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH. (D AND 05150900 +C***** F DESCRIPTORS ARE TESTED.) 05160900 +C***** 05170900 +02121 FORMAT (/8X, "LEADING BLANK INSERTION TEST" /) 05180900 + WRITE (NUVI,02121) 05190900 +CT023* TEST 23 05200900 + IVTNUM = 23 05210900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 05220900 + WRITE (NUVI, 70230) 05230900 +70230 FORMAT (" ",48X,"LEADING BLANKS ARE REQUIRED" ) 05240900 + WRITE (NUVI, 80020) 05250900 + WRITE (NUVI, 70231) AC1D(3) 05260900 +70231 FORMAT (26X,D9.1) 05270900 + IVINSP = IVINSP + 1 05280900 + WRITE (NUVI, 70121) 05290900 + WRITE (NUVI, 70232) 05300900 +70232 FORMAT (26X," +0.1D+00"/26X," +0.1E+00"/26X," +0.1+000") 05310900 +CT024* TEST 24 05320900 + IVTNUM = 24 05330900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 05340900 + WRITE (NUVI, 70230) 05350900 + WRITE (NUVI, 80020) 05360900 + WRITE (NUVI, 70240) ZZDVD 05370900 +70240 FORMAT (26X,D10.1) 05380900 + IVINSP = IVINSP + 1 05390900 + WRITE (NUVI, 70121) 05400900 + WRITE (NUVI, 70241) 05410900 +70241 FORMAT(26X," +0.1D+00" /26X," +0.1E+00" /26X," +0.1+000" )05420900 +CT025* TEST 25 05430900 + IVTNUM = 25 05440900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 05450900 + WRITE (NUVI, 70230) 05460900 + WRITE (NUVI, 80020) 05470900 + WRITE (NUVI, 70250) ZZDVD 05480900 +70250 FORMAT (26X,D11.1) 05490900 + IVINSP = IVINSP + 1 05500900 + WRITE (NUVI, 70121) 05510900 + WRITE (NUVI, 70251) 05520900 +70251 FORMAT (26X," +0.1D+00" / 05530900 + 1 26X," +0.1E+00" / 05540900 + 2 26X," +0.1+000" ) 05550900 +CT026* TEST 26 05560900 + IVTNUM = 26 05570900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 05580900 + WRITE (NUVI, 70230) 05590900 + WRITE (NUVI, 80020) 05600900 + WRITE (NUVI, 70260) ZZDVD 05610900 +70260 FORMAT (26X,D12.1) 05620900 + IVINSP = IVINSP + 1 05630900 + WRITE (NUVI, 70121) 05640900 + WRITE (NUVI, 70261) 05650900 +70261 FORMAT (26X," +0.1D+00" / 05660900 + 1 26X," +0.1E+00" / 05670900 + 2 26X," +0.1+000" ) 05680900 +CT027* TEST 27 05690900 + IVTNUM = 27 05700900 + REMRKS = 'LEADING PLUS OPTIONAL' 05710900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 05720900 + WRITE (NUVI, 70230) 05730900 + WRITE (NUVI, 80020) 05740900 + WRITE (NUVI, 70270) CHAVC 05750900 +70270 FORMAT (26X,2(F5.1)) 05760900 + IVINSP = IVINSP + 1 05770900 + WRITE (NUVI, 80022) 05780900 + WRITE (NUVI, 70271) 05790900 +70271 FORMAT (26X," +1.0 +5.5" ) 05800900 +CT028* TEST 28 05810900 + IVTNUM = 28 05820900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 05830900 + WRITE (NUVI, 70230) 05840900 + WRITE (NUVI, 80020) 05850900 + WRITE (NUVI, 70280) B3C(1,1,1) 05860900 +70280 FORMAT (26X,2(F6.1)) 05870900 + IVINSP = IVINSP + 1 05880900 + WRITE (NUVI, 80022) 05890900 + WRITE (NUVI, 70281) 05900900 +70281 FORMAT (26X," +9.9 +5.5" ) 05910900 +C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER 05920900 + WRITE (NUVI, 90002) 05930900 + WRITE (NUVI, 90013) 05940900 + WRITE (NUVI, 90014) 05950900 +C***** 05960900 +CT029* TEST 29 05970900 + IVTNUM = 29 05980900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 05990900 + WRITE (NUVI, 70230) 06000900 + WRITE (NUVI, 80020) 06010900 + WRITE (NUVI, 70290) B3C(1,1,1) 06020900 +70290 FORMAT (26X,2(F7.1)) 06030900 + IVINSP = IVINSP + 1 06040900 + WRITE (NUVI, 80022) 06050900 + WRITE (NUVI, 70291) 06060900 +70291 FORMAT (26X," +9.9 +5.5" ) 06070900 +CT030* TEST 30 06080900 + IVTNUM = 30 06090900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 06100900 + WRITE (NUVI, 70230) 06110900 + WRITE (NUVI, 80020) 06120900 + WRITE (NUVI, 70300) CHAVC 06130900 +70300 FORMAT (26X,2(F8.1)) 06140900 + IVINSP = IVINSP + 1 06150900 + WRITE (NUVI, 80022) 06160900 + WRITE (NUVI, 70301) 06170900 +70301 FORMAT (26X," +1.0 +5.5" ) 06180900 +C***** TESTS 31 THRU 32: 06190900 +C***** FORMATS WITH G CONVERSIONS USING COMPLEX DATA 13.5.9.2.306200900 +C***** 06210900 +C***** INPUT CARD 15 06220900 +02123 FORMAT( 3(G11.4), 3G11.4) 06230900 + READ (IRVI,02123) LL1C(1), LL1C(2), LL1C(3) 06240900 +02124 FORMAT (/8X,"G CONVERSION TEST" /) 06250900 + WRITE (NUVI, 02124) 06260900 +CT031* TEST 31 06270900 + IVTNUM = 31 06280900 + REMRKS = 'LEADING PLUS SIGN/ZERO OPTIONAL' 06290900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 06300900 + WRITE (NUVI, 70130) 06310900 + WRITE (NUVI, 70310) LL1C(1), LL1C(2), LL1C(3) 06320900 +70310 FORMAT (26X,G14.4,4X,2G11.4 / 26X,G14.4,4X,2G11.4) 06330900 + IVINSP = IVINSP + 1 06340900 + WRITE (NUVI, 70311) 06350900 +70311 FORMAT(/" ",16X,"CORRECT: " ,22X, "CORRESPONDING LINES MUST06360900 + 1 MATCH " ,/" ",48X,"EITHER OF THE FOLLOWING TWO " , 06370900 + 2 /" ",48X,"CORRECT ANSWERS " /) 06380900 + WRITE (NUVI, 70312) 06390900 +70312 FORMAT (26X," +0.1235E+05 +1235. +123.5" / 06400900 + 1 26X," +12.35 +1.235 +0.1235" // 06410900 + 2 26X," +0.1235+005 +1235. +123.5" / 06420900 + 3 26X," +12.35 +1.235 +0.1235" ) 06430900 +C***** TESTS 32 THRU 34: 06440900 +C***** ON READ, BUT NOT ON WRITE 06450900 +C***** SCALE FACTOR APPLIED TO F,E,D,G DESCRIPTORS 13.7.5.106460900 +C***** 06470900 +C***** INPUT CARD 16 06480900 +02126 FORMAT(2PF8.3,-2PE9.4,F9.4,0PG9.4,D9.4,-2PE9.4,F9.4,D9.4,2PG9.4) 06490900 + READ(IRVI,02126)BVC, CHAVC, BC2D(1,4), A1C(1), BC2D(2,1), DPAVD 06500900 +02127 FORMAT(/8X, "SCALE FACTOR ON READ" /) 06510900 + WRITE (NUVI, 02127) 06520900 +CT032* TEST 32 06530900 + IVTNUM = 32 06540900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 06550900 + WRITE (NUVI, 80020) 06560900 + WRITE (NUVI, 70320) BVC,CHAVC 06570900 +70320 FORMAT (26X,F12.4,E12.4,F12.2,F12.3) 06580900 + IVINSP = IVINSP + 1 06590900 + WRITE (NUVI, 70051) 06600900 + WRITE (NUVI, 70321) 06610900 +70321 FORMAT (30X,"+98.7654 +0.9877E+04 +987654.00 +987.654" / 06620900 + 1 30X,"+98.7654 +0.9877+004 +987654.00 +987.654" ) 06630900 +CT033* TEST 33 06640900 + IVTNUM = 33 06650900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 06660900 + WRITE (NUVI, 80020) 06670900 + WRITE (NUVI, 70330) BC2D(1,4), A1C(1) 06680900 +70330 FORMAT (26X,D12.4,E12.4,F12.3) 06690900 + IVINSP = IVINSP + 1 06700900 + WRITE (NUVI, 70121) 06710900 + WRITE (NUVI, 70331) 06720900 +70331 FORMAT (26X," +0.8648D-02 +0.8648E+04 +8647.860" / 06730900 + 1 26X," +0.8648E-02 +0.8648E+04 +8647.860" / 06740900 + 2 26X," +0.8648-002 +0.8648+004 +8647.860" ) 06750900 +70332 FORMAT (" ",48X," OR") 06750900 + WRITE (NUVI,70332) 06750900 +70333 FORMAT (26X," +0.8648D-02 +0.8648E+04 +8647.859" / 06750900 + 1 26X," +0.8648E-02 +0.8648E+04 +8647.859" / 06750900 + 2 26X," +0.8648-002 +0.8648+004 +8647.859" ) 06750900 + WRITE (NUVI,70333) 06750900 +CT034* TEST 34 06760900 + IVTNUM = 34 06770900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 06780900 + WRITE (NUVI, 80020) 06790900 + WRITE (NUVI, 70340) BC2D(2,1), DPAVD 06800900 +70340 FORMAT (26X,D12.4,G16.4) 06810900 + IVINSP = IVINSP + 1 06820900 + WRITE (NUVI, 70121) 06830900 + WRITE (NUVI, 70341) 06840900 +70341 FORMAT (26X," +0.8658D+04 +98.77" / 06850900 + 1 26X," +0.8658E+04 +98.77" / 06860900 + 2 26X," +0.8658+004 +98.77" ) 06870900 +C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADER 06880900 + WRITE (NUVI, 90002) 06890900 + WRITE (NUVI, 90013) 06900900 + WRITE (NUVI, 90014) 06910900 +C***** 06920900 +C***** TESTS 35 AND 36: 06930900 +C***** SCALE FACTOR APPLIED TO F, E, D, G DESCRIPTORS 06940900 +C***** ON WRITE, BUT, NOT ON READ 06950900 +C***** 06960900 +C***** INPUT CARD 17 06970900 +02128 FORMAT(F8.2,E9.4,F9.2,G9.3,D9.0,E9.4,F9.4,D9.2,G9.4) 06980900 + READ(IRVI,02128) CHBVC, A2C(2,1), AC1D(4), CHCVC, AC1D(5), DPBVD 06990900 +02129 FORMAT(/8X, "SCALE FACTOR ON WRITE" /) 07000900 + WRITE (NUVI, 02129) 07010900 +CT035* TEST 35 07020900 + IVTNUM = 35 07030900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 07040900 + WRITE (NUVI, 80020) 07050900 + WRITE (NUVI, 70350) CHBVC, A2C(2,1), AC1D(4) 07060900 +70350 FORMAT (26X,2PF12.2,-2PE12.4,F12.4,1PG12.2,D12.4) 07070900 + IVINSP = IVINSP + 1 07080900 + WRITE (NUVI, 70121) 07090900 + WRITE (NUVI, 70351) 07100900 +70351 FORMAT (28X, " +987.66 +0.0099E+06 +98.7654 +9.88E+02 07110900 + 1+8.6479D+02"/28X, " +987.66 +0.0099E+06 +98.7654 +9.88E+02 07120900 + 2+8.6479E+02"/28X, " +987.66 +0.0099+006 +98.7654 +9.88+002 07130900 + 3+8.6479+002") 07140900 +70352 FORMAT (" ",48X," OR") 07140900 + WRITE (NUVI,70352) 07140900 +70353 FORMAT (28X, " +987.66 +0.0099E+06 +98.76539 +9.88E+02 07140900 + 1+8.6479D+02"/28X, " +987.66 +0.0099E+06 +98.76539 +9.88E+02 07140900 + 2+8.6479E+02"/28X, " +987.66 +0.0099+006 +98.76539 +9.88+002 07140900 + 3+8.6479+002") 07140900 + WRITE (NUVI,70353) 07140900 +CT036* TEST 36 07150900 + IVTNUM = 36 07160900 + WRITE (NUVI, 80004) IVTNUM, REMRKS 07170900 + WRITE (NUVI, 80020) 07180900 + WRITE(NUVI,70360) CHCVC, AC1D(5), DPBVD 07190900 +70360 FORMAT (26X,-2PE12.4,2PF12.2,1PD12.4,2PG16.4) 07200900 + IVINSP = IVINSP + 1 07210900 + WRITE (NUVI, 70121) 07220900 + WRITE (NUVI, 70361) 07230900 +70361 FORMAT(27X, "+0.0086E+06 +8647.86 +8.6579D+03 +9877."07240900 + 1 /27X, "+0.0086E+06 +8647.86 +8.6579E+03 +9877."07250900 + 2 /27X,"+0.0086+006 +8647.86 +8.6579+003 +9877." )07260900 +CBB** ********************** BBCSUM0 **********************************07270900 +C**** WRITE OUT TEST SUMMARY 07280900 +C**** 07290900 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 07300900 + WRITE (I02, 90004) 07310900 + WRITE (I02, 90014) 07320900 + WRITE (I02, 90004) 07330900 + WRITE (I02, 90020) IVPASS 07340900 + WRITE (I02, 90022) IVFAIL 07350900 + WRITE (I02, 90024) IVDELE 07360900 + WRITE (I02, 90026) IVINSP 07370900 + WRITE (I02, 90028) IVTOTN, IVTOTL 07380900 +CBE** ********************** BBCSUM0 **********************************07390900 +CBB** ********************** BBCFOOT0 **********************************07400900 +C**** WRITE OUT REPORT FOOTINGS 07410900 +C**** 07420900 + WRITE (I02,90016) ZPROG, ZPROG 07430900 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 07440900 + WRITE (I02,90019) 07450900 +CBE** ********************** BBCFOOT0 **********************************07460900 +CBB** ********************** BBCFMT0A **********************************07470900 +C**** FORMATS FOR TEST DETAIL LINES 07480900 +C**** 07490900 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 07500900 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 07510900 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 07520900 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 07530900 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 07540900 + 1I6,/," ",15X,"CORRECT= " ,I6) 07550900 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07560900 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 07570900 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07580900 + 1A21,/," ",16X,"CORRECT= " ,A21) 07590900 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 07600900 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 07610900 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 07620900 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 07630900 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 07640900 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 07650900 +80050 FORMAT (" ",48X,A31) 07660900 +CBE** ********************** BBCFMT0A **********************************07670900 +CBB** ********************** BBCFMAT1 **********************************07680900 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 07690900 +C**** 07700900 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07710900 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 07720900 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 07730900 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 07740900 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 07750900 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 07760900 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 07770900 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 07780900 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 07790900 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 07800900 + 2"(",F12.5,", ",F12.5,")") 07810900 +CBE** ********************** BBCFMAT1 **********************************07820900 +CBB** ********************** BBCFMT0B **********************************07830900 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 07840900 +C**** 07850900 +90002 FORMAT ("1") 07860900 +90004 FORMAT (" ") 07870900 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )07880900 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 07890900 +90008 FORMAT (" ",21X,A13,A17) 07900900 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 07910900 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 07920900 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 07930900 + 1 7X,"REMARKS",24X) 07940900 +90014 FORMAT (" ","----------------------------------------------" , 07950900 + 1 "---------------------------------" ) 07960900 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 07970900 +C**** 07980900 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 07990900 +C**** 08000900 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 08010900 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 08020900 + 1 A13) 08030900 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 08040900 +C**** 08050900 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 08060900 +C**** 08070900 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 08080900 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 08090900 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 08100900 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 08110900 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 08120900 +CBE** ********************** BBCFMT0B **********************************08130900 +C***** 08140900 +C***** END OF TEST SEGMENT 21 08150900 + STOP 08160900 + END 08170900 diff --git a/Fortran/UnitTests/fcvs21_f95/FM900.reference_input b/Fortran/UnitTests/fcvs21_f95/FM900.reference_input new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM900.reference_input @@ -0,0 +1,18 @@ +1.05.522.066.633.123455.0789 +123.00456.88 0.123E+01 +0.987+1 -0.2345+02 -0.6879E+2+0.7E+03 0.4E+03 + 0.9876543E-04+0.1357913E-04 +19.34+0.2468E+02 +.765+287.643.96 0.5407E+0243.96+0.5407E+0243.96 0.5407+2 + +0.1D+06 +-0.334D-04 -.334-4 +0.7657654D00 0.12345678901D+10 + +0.98765432109876D-1+0.98765432109876D-01 .98765432109876-1 + -.555555542D+03 -0.555555542+3 + 9.91.19.92.29.93.39.94.49.91.19.92.29.93.39.94.4 +9.95.59.96.69.97.79.98.89.95.59.96.69.97.79.98.8 +-0.99D+01-0.98D+01-0.97D+01-0.96D+01-0.99D+01 -.98D+01 -.97+01 -.96+1 + +0.99D+01 0.98D+01 +.97D01 +.96D1 + +0.99D+01 0.99D+01 0.99D+01+0.99D+01 .99D1 +9.95.59.96.69.97.79.98.8 +123.45678E2 1234.5678 123.45678 12.345678 1.2345678 .12345678 + 9876.5498.7654E2 9876.54 987.654864786D-486.4786E286.4786 8657.86D0 9876.54 + 9.8765698.7654E2 9876.54 987.654864786D-386.4786E286.4786 8657.86D0 9876.54 + diff --git a/Fortran/UnitTests/fcvs21_f95/FM900.reference_output b/Fortran/UnitTests/fcvs21_f95/FM900.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM900.reference_output @@ -0,0 +1,348 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM900BEGIN* TEST RESULTS - FM900 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + FMTRWF - (021) FORMATTED I/O + + REFS - 12.9.5 13.3 13.5 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 36 TESTS + + + COMPLEX CONVERSION TEST + + 1 INSPECT + COMPUTED= + 1.0 5.5 + CORRECT= + 1.0 5.5 + 2 INSPECT + COMPUTED= + 22.0 66.6 + CORRECT= + 22.0 66.6 + 3 INSPECT + COMPUTED= + 33.1234 55.0789 + CORRECT= + 33.1234 55.0789 + 4 INSPECT + COMPUTED= + 123.00 456.88 + CORRECT= + 123.00 456.88 + 5 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.123E+01 0.987E+01 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + +0.123E+01 +0.987E+01 + +0.123+001 +0.987+001 + 6 INSPECT LEADING ZERO OPTIONAL + COMPUTED= + -0.2345E+02 -0.6879E+02 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + -0.2345E+02 -0.6879E+02 + -0.2345+002 -0.6879+002 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 7 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.7E+03 0.4E+03 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + +0.7E+03 +0.4E+03 + +0.7+003 +0.4+003 + 8 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.9876543E-04 0.1357913E-04 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + +0.9876543E-04 +0.1357913E-04 + +0.9876543-004 +0.1357913-004 + 9 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + FOR THE SECOND NUMBER + COMPUTED= + 19.34 0.2468E+02 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 19.34 +0.2468E+02 + 19.34 +0.2468+002 + 10 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + FOR THE FIRST NUMBER + COMPUTED= + 0.765E+02 87.6 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + +0.765E+02 87.6 + +0.765+002 87.6 + 11 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED: 3 COMPUTED LINES EXPECTED + 43.96 0.5407E+02 + 43.96 0.5407E+02 + 43.96 0.5407E+02 + + CORRECT: EACH RESULT LINE SHOULD MATCH + EITHER ONE OF THE 2 POSSIBLE + ANSWERS BELOW + +43.96+0.5407E+02 + +43.96+0.5407+002 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + D CONVERSION TEST + + 12 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.1D+06 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.1D+06 + +0.1E+06 + +0.1+006 + 13 INSPECT LEADING ZERO OPTIONAL + COMPUTED: 2 COMPUTED LINES EXPECTED + -0.334D-04 + -0.334D-04 + CORRECT: EACH RESULT LINE SHOULD MATCH + ONE OF THE 3 POSSIBLE ANSWERS + BELOW + -0.334D-04 + -0.334E-04 + -0.334-004 + 14 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.7657654D+00 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.7657654D+00 + +0.7657654E+00 + +0.7657654+000 + 15 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.12345678901D+10 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.12345678901D+10 + +0.12345678901E+10 + +0.12345678901+010 + 16 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED: 3 COMPUTED LINES EXPECTED + 0.98765432109876D-01 + 0.98765432109876D-01 + 0.98765432109876D-01 + CORRECT: EACH RESULT LINE SHOULD MATCH + ONE OF THE 3 POSSIBLE ANSWERS + BELOW + +0.98765432109876D-01 + +0.98765432109876E-01 + +0.98765432109876-001 + 17 INSPECT LEADING ZERO OPTIONAL + COMPUTED: 2 COMPUTED LINES EXPECTED + -0.555555542D+03 + -0.555555542D+03 + CORRECT: EACH RESULT LINE SHOULD MATCH + ONE OF THE 3 POSSIBLE ANSWERS + BELOW + -0.555555542D+03 + -0.555555542E+03 + -0.555555542+003 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + TEST UNSUBSCRIPTED ARRAY NAMES IN I/O LISTS + + 18 INSPECT + COMPUTED: 2 COMPUTED LINES EXPECTED + 9.91.19.92.29.93.39.94.4 + 9.91.19.92.29.93.39.94.4 + CORRECT: EACH RESULT LINE SHOULD EQUAL + 9.91.19.92.29.93.39.94.4 + 19 INSPECT LEADING ZERO OPTIONAL + COMPUTED: 2 COMPUTED LINES EXPECTED + -0.99D+01-0.98D+01-0.97D+01-0.96D+01 + -0.99D+01-0.98D+01-0.97D+01-0.96D+01 + CORRECT: EACH RESULT LINE SHOULD MATCH + ONE OF THE 3 POSSIBLE ANSWERS + BELOW + -0.99D+01-0.98D+01-0.97D+01-0.96D+01 + -0.99E+01-0.98E+01-0.97E+01-0.96E+01 + -0.99+001-0.98+001-0.97+001-0.96+001 + 20 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.99D+01 0.98D+01 0.97D+01 0.96D+01 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.99D+01+0.98D+01+0.97D+01+0.96D+01 + +0.99E+01+0.98E+01+0.97E+01+0.96E+01 + +0.99+001+0.98+001+0.97+001+0.96+001 + 21 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED: 5 COMPUTED LINES EXPECTED + 0.99D+01 + 0.99D+01 + 0.99D+01 + 0.99D+01 + 0.99D+01 + + CORRECT: EACH RESULT LINE SHOULD MATCH + ONE OF THE 3 POSSIBLE ANSWERS + BELOW + +0.99D+01 + +0.99E+01 + +0.99+001 + 22 INSPECT + COMPUTED: 3 COMPUTED LINES EXPECTED + 9.95.59.96.69.97.79.98.8 + 9.95.59.96.69.97.79.98.8 + 9.95.59.96.69.97.79.98.8 + CORRECT: EACH RESULT LINE SHOULD EQUAL + 9.95.59.96.69.97.79.98.8 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + LEADING BLANK INSERTION TEST + + 23 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + LEADING BLANKS ARE REQUIRED + COMPUTED= + 0.1D+00 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.1D+00 + +0.1E+00 + +0.1+000 + 24 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + LEADING BLANKS ARE REQUIRED + COMPUTED= + 0.1D+00 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.1D+00 + +0.1E+00 + +0.1+000 + 25 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + LEADING BLANKS ARE REQUIRED + COMPUTED= + 0.1D+00 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.1D+00 + +0.1E+00 + +0.1+000 + 26 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + LEADING BLANKS ARE REQUIRED + COMPUTED= + 0.1D+00 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.1D+00 + +0.1E+00 + +0.1+000 + 27 INSPECT LEADING PLUS OPTIONAL + LEADING BLANKS ARE REQUIRED + COMPUTED= + 1.0 5.5 + CORRECT= + +1.0 +5.5 + 28 INSPECT LEADING PLUS OPTIONAL + LEADING BLANKS ARE REQUIRED + COMPUTED= + 9.9 5.5 + CORRECT= + +9.9 +5.5 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 29 INSPECT LEADING PLUS OPTIONAL + LEADING BLANKS ARE REQUIRED + COMPUTED= + 9.9 5.5 + CORRECT= + +9.9 +5.5 + 30 INSPECT LEADING PLUS OPTIONAL + LEADING BLANKS ARE REQUIRED + COMPUTED= + 1.0 5.5 + CORRECT= + +1.0 +5.5 + + G CONVERSION TEST + + 31 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED: 2 COMPUTED LINES EXPECTED + 0.1235E+05 1235. 123.5 + 12.35 1.235 0.1235 + + CORRECT: CORRESPONDING LINES MUST MATCH + EITHER OF THE FOLLOWING TWO + CORRECT ANSWERS + + +0.1235E+05 +1235. +123.5 + +12.35 +1.235 +0.1235 + + +0.1235+005 +1235. +123.5 + +12.35 +1.235 +0.1235 + + SCALE FACTOR ON READ + + 32 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 98.7654 0.9877E+04 987654.00 987.654 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + +98.7654 +0.9877E+04 +987654.00 +987.654 + +98.7654 +0.9877+004 +987654.00 +987.654 + 33 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.8648D-02 0.8648E+04 8647.860 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.8648D-02 +0.8648E+04 +8647.860 + +0.8648E-02 +0.8648E+04 +8647.860 + +0.8648-002 +0.8648+004 +8647.860 + OR + +0.8648D-02 +0.8648E+04 +8647.859 + +0.8648E-02 +0.8648E+04 +8647.859 + +0.8648-002 +0.8648+004 +8647.859 + 34 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.8658D+04 98.77 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.8658D+04 +98.77 + +0.8658E+04 +98.77 + +0.8658+004 +98.77 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + SCALE FACTOR ON WRITE + + 35 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 987.66 0.0099E+06 98.7654 9.88E+02 8.6479D+02 + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +987.66 +0.0099E+06 +98.7654 +9.88E+02 +8.6479D+02 + +987.66 +0.0099E+06 +98.7654 +9.88E+02 +8.6479E+02 + +987.66 +0.0099+006 +98.7654 +9.88+002 +8.6479+002 + OR + +987.66 +0.0099E+06 +98.76539 +9.88E+02 +8.6479D+02 + +987.66 +0.0099E+06 +98.76539 +9.88E+02 +8.6479E+02 + +987.66 +0.0099+006 +98.76539 +9.88+002 +8.6479+002 + 36 INSPECT LEADING PLUS SIGN/ZERO OPTIONAL + COMPUTED= + 0.0086E+06 8647.86 8.6579D+03 9877. + CORRECT: 3 CORRECT ANSWERS POSSIBLE + +0.0086E+06 +8647.86 +8.6579D+03 +9877. + +0.0086E+06 +8647.86 +8.6579E+03 +9877. + +0.0086+006 +8647.86 +8.6579+003 +9877. + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 36 TESTS REQUIRE INSPECTION + 36 OF 36 TESTS EXECUTED + + *FM900END* END OF TEST - FM900 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM901.f b/Fortran/UnitTests/fcvs21_f95/FM901.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM901.f @@ -0,0 +1,314 @@ + PROGRAM FM901 + +C***********************************************************************00010901 +C***** FORTRAN 77 00020901 +C***** FM901 AFMTF - (023) 00030901 +C***** 00040901 +C***********************************************************************00050901 +C***** GENERAL PURPOSE ANS REFS00060901 +C***** TO TEST SIMPLE FORMAT AND FORMATTED DATA 12.9.5.200070901 +C***** TRANSFER STATEMENTS IN EXTERNAL SEQUENTIAL I/O SO 13.1.1 00080901 +C***** THAT THESE FEATURES MAY BE USED IN OTHER TEST 12.8.1 00090901 +C***** PROGRAM SEGMENTS FOR CHARACTER DATA TYPES. 4.8 00100901 +C***** TO TEST READ AND WRITE OF SUBSTRINGS. 5.7 00110901 +C***** 00120901 +C***** RESTRICTIONS OBSERVED 00130901 +C***** * ALL FORMAT STATEMENTS ARE LABELED 12.8.2 00140901 +C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.1.1 00150901 +C***** * FIELD WIDTH IS NEVER ZERO 13.5.11 00160901 +C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE LIST ITEM 13.3 00170901 +C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST 00180901 +C***** IN THE FORMAT SPECIFICATION. 00190901 +C***** * ITEMS IN I/O LIST CORRESPOND TO FORMAT DESCRIPTORS 13.3 00200901 +C***** 00210901 +CBB** ********************** BBCCOMNT **********************************00220901 +C**** 00230901 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00240901 +C**** VERSION 2.1 00250901 +C**** 00260901 +C**** 00270901 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00280901 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00290901 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00300901 +C**** BUILDING 225 RM A266 00310901 +C**** GAITHERSBURG, MD 20899 00320901 +C**** 00330901 +C**** 00340901 +C**** 00350901 +CBE** ********************** BBCCOMNT **********************************00360901 +C***** 00370901 +C INPUT DATA TO THIS SEG. CONSISTS OF 5 DATA CARD IMAGES IN COLS. 1 - 5200380901 +COL. 1-------------------------------------------------52 00390901 +CARD 1 XYZ123:45$'),.JKLABCDEF67890MNOPQRSTUVW =+-*/(GHI 00400901 +CARD 2 ONEFIVENINEELEVENSEVENTHREE 00410901 +CARD 3 SQUARE THE WORLD IN 40 NIGHTS 00420901 +CARD 4 DAYS 80AROUND 00430901 +CARD 5 TO XXXXX NOT TO XXXX- THAT IS THE QUESTIONXXBE ORBE 00440901 +C***** 00450901 +C***** S P E C I F I C A T I O N S SEGMENT 023 00460901 +C***** 00470901 + CHARACTER*13 A13VK 00480901 + CHARACTER*27 A27VK 00490901 + CHARACTER*29 A29VK 00500901 + CHARACTER*36 A36VK 00510901 + CHARACTER*43 B43VK 00520901 +C***** 00530901 +CBB** ********************** BBCINITA **********************************00540901 +C**** SPECIFICATION STATEMENTS 00550901 +C**** 00560901 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00570901 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00580901 +CBE** ********************** BBCINITA **********************************00590901 +CBB** ********************** BBCINITB **********************************00600901 +C**** INITIALIZE SECTION 00610901 + DATA ZVERS, ZVERSD, ZDATE 00620901 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00630901 + DATA ZCOMPL, ZNAME, ZTAPE 00640901 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00650901 + DATA ZPROJ, ZTAPED, ZPROG 00660901 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00670901 + DATA REMRKS /' '/ 00680901 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00690901 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00700901 +C**** 00710901 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00720901 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00730901 +CZ03 ZPROG = 'PROGRAM NAME' 00740901 +CZ04 ZDATE = 'DATE OF TEST' 00750901 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00760901 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00770901 +CZ07 ZNAME = 'NAME OF USER' 00780901 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00790901 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00800901 +C 00810901 + IVPASS = 0 00820901 + IVFAIL = 0 00830901 + IVDELE = 0 00840901 + IVINSP = 0 00850901 + IVTOTL = 0 00860901 + IVTOTN = 0 00870901 + ICZERO = 0 00880901 +C 00890901 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00900901 + I01 = 05 00910901 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00920901 + I02 = 06 00930901 +C 00940901 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00950901 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00960901 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00970901 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00980901 +C 00990901 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01000901 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01010901 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01020901 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01030901 +C 01040901 +CBE** ********************** BBCINITB **********************************01050901 + IRVI = I01 01060901 + NUVI = I02 01070901 + IVTOTL = 4 01080901 + ZPROG = 'FM901' 01090901 +CBB** ********************** BBCHED0A **********************************01100901 +C**** 01110901 +C**** WRITE REPORT TITLE 01120901 +C**** 01130901 + WRITE (I02, 90002) 01140901 + WRITE (I02, 90006) 01150901 + WRITE (I02, 90007) 01160901 + WRITE (I02, 90008) ZVERS, ZVERSD 01170901 + WRITE (I02, 90009) ZPROG, ZPROG 01180901 + WRITE (I02, 90010) ZDATE, ZCOMPL 01190901 +CBE** ********************** BBCHED0A **********************************01200901 +C***** 01210901 +C***** HEADER FOR SEGMENT 23 01220901 + WRITE (NUVI,02300) 01230901 +02300 FORMAT(" ", /1X," AFMTF - (023) FORMATTED DATA TRANSFER" // 01240901 + 1 1X," USING A-CONVERSION WITH SUBSTRINGS" //1X, 01250901 + 2 " REFS - 12.9.5.2 13.3 13.5.11" ) 01260901 +CBB** ********************** BBCHED0B **********************************01270901 +C**** WRITE DETAIL REPORT HEADERS 01280901 +C**** 01290901 + WRITE (I02,90004) 01300901 + WRITE (I02,90004) 01310901 + WRITE (I02,90013) 01320901 + WRITE (I02,90014) 01330901 + WRITE (I02,90015) IVTOTL 01340901 +CBE** ********************** BBCHED0B **********************************01350901 +C***** 01360901 +C***** TEST THAT DATA MAY BE READ IN A SERIES OF SUBSTRINGS, 5.701370901 +C***** NOT NECESSARILY IN THE ORDER OF POSITION IN THE STRING, 12.8.201380901 +C***** AND CAN BE WRITTEN AS A CHARACTER STRING. 13.5.1101390901 +C***** SHOW ALSO THAT THE FULL FORTRAN CHARACTER SET CAN BE READ 3.101400901 +C***** (INCLUDES $ AND :) 01410901 +C***** 01420901 +C***** INPUT CARD 1 01430901 + READ(IRVI, 02301) A36VK(24:29), A13VK(13:13), A36VK(30:31), 01440901 + 1 A13VK(11:12), A13VK(8:10), A36VK(10:12), A36VK(:6), 01450901 + 2 A36VK(32:), A36VK(13:23), A13VK(1:7), A36VK(7:9) 01460901 +02301 FORMAT(A6, A1, 2A2, A3, A3, A6, A5, A11, A7, A3) 01470901 +CT001* TEST 1 01480901 + IVTNUM = 1 01490901 + REMRKS = '2 SETS OF 2 COMPUTED LINES ' 01500901 + WRITE (NUVI, 80004) IVTNUM, REMRKS 01510901 + REMRKS = 'EXPECTED ' 01520901 + WRITE (NUVI, 80050) REMRKS 01530901 + WRITE (NUVI, 80020) 01540901 + WRITE (NUVI, 70010) A36VK(1:6), A36VK(7:9), A36VK(10:12), 01550901 + 1 A36VK(13:23), A36VK(24:29), A36VK(30:31), A36VK(32:36), 01560901 + 2 A36VK, A13VK(:7), A13VK(8:10), A13VK(11:12), A13VK(13:), 01570901 + 3 A13VK 01580901 +70010 FORMAT (26X,A6,2(A3),A11,A6,A2,A5/26X,A36//26X,A7,A3,A2,A1/ 01590901 + 1 26X,A13) 01600901 + IVINSP = IVINSP + 1 01610901 + WRITE (NUVI, 70011) 01620901 +70011 FORMAT(" ",16X,"CORRECT: " ,22X, "CORRESPONDING LINE(S) MUST M01630901 + 1ATCH") 01640901 + WRITE (NUVI, 70012) 01650901 +70012 FORMAT(26X,"ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890" / 01660901 + 1 26X," =+-*/(),.$':" ) 01670901 +C***** 01680901 +C***** TEST THAT A CHARACTER VARIABLE CAN BE OUTPUT AS SUBSTRINGS. 01690901 +C***** 13.5.1101700901 +C***** INPUT CARD 2 01710901 + READ(IRVI, 02303) A27VK 01720901 +02303 FORMAT(A27) 01730901 +CT002* TEST 2 01740901 + IVTNUM = 2 01750901 + WRITE (NUVI, 80004) IVTNUM 01760901 + WRITE (NUVI, 80020) 01770901 + WRITE(NUVI, 70020) A27VK(1:3), A27VK(23:27), A27VK(4:7), 01780901 + 1 A27VK(18:22), A27VK(8:11), A27VK(12:17) 01790901 +70020 FORMAT(26X,A3,A6,A5,A6,A5,A7) 01800901 + IVINSP = IVINSP + 1 01810901 + WRITE (NUVI, 80022) 01820901 + WRITE (NUVI, 70022) 01830901 +70022 FORMAT(26X,"ONE THREE FIVE SEVEN NINE ELEVEN" ) 01840901 +C***** 01850901 +C***** TEST THAT A SUBSTRING CAN BE READ IN, AND PARTIALLY REPLACE 01860901 +C***** A PREVIOUSLY READ CHARACTER STRING. 13.5.1101870901 +C***** THIS SHOWS THAT THE LENGTH IS DERIVED FROM THE SUBSTRING, 01880901 +C***** AND NOT THE CHARACTER VARIABLE LENGTH. 01890901 +C***** 01900901 +C***** INPUT CARDS 3-4 01910901 + READ(IRVI, 02305) A29VK, A29VK(24:29), A29VK(21:22), A29VK(1:6)01920901 +02305 FORMAT(A29/A,2A) 01930901 +CT003* TEST 3 01940901 + IVTNUM = 3 01950901 + WRITE (NUVI, 80004) IVTNUM 01960901 + WRITE (NUVI, 80020) 01970901 + WRITE(NUVI, 70030) A29VK(1:3), A29VK(4:21), A29VK(22:29) 01980901 +70030 FORMAT (26X,3(A)) 01990901 + IVINSP = IVINSP + 1 02000901 + WRITE (NUVI, 80022) 02010901 + WRITE (NUVI, 70032) 02020901 +70032 FORMAT(25X," AROUND THE WORLD IN 80 DAYS " ) 02030901 +C***** 02040901 +C***** SPECIFIED FIELD WIDTH IN A A-EDIT DESCRIPTOR 02050901 +C***** IS DIFFERENT FROM SUBSTRING LENGTH 02060901 +C***** 02070901 +C***** INPUT CARD 5 02080901 + READ(IRVI, 02307) B43VK, B43VK(4:8), B43VK(17:20) 02090901 +02307 FORMAT(A43, A7, A2) 02100901 +CT004* TEST 4 02110901 + IVTNUM = 4 02120901 + WRITE (NUVI, 80004) IVTNUM 02130901 + WRITE (NUVI, 80020) 02140901 + WRITE (NUVI, 70040) B43VK(:) 02150901 +70040 FORMAT (26X,A20) 02160901 + IVINSP = IVINSP + 1 02170901 + WRITE (NUVI, 80022) 02180901 + WRITE (NUVI, 70042) 02190901 +70042 FORMAT(26X,"TO BE OR NOT TO BE " ) 02200901 +C***** 02210901 +CBB** ********************** BBCSUM0 **********************************02220901 +C**** WRITE OUT TEST SUMMARY 02230901 +C**** 02240901 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02250901 + WRITE (I02, 90004) 02260901 + WRITE (I02, 90014) 02270901 + WRITE (I02, 90004) 02280901 + WRITE (I02, 90020) IVPASS 02290901 + WRITE (I02, 90022) IVFAIL 02300901 + WRITE (I02, 90024) IVDELE 02310901 + WRITE (I02, 90026) IVINSP 02320901 + WRITE (I02, 90028) IVTOTN, IVTOTL 02330901 +CBE** ********************** BBCSUM0 **********************************02340901 +CBB** ********************** BBCFOOT0 **********************************02350901 +C**** WRITE OUT REPORT FOOTINGS 02360901 +C**** 02370901 + WRITE (I02,90016) ZPROG, ZPROG 02380901 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02390901 + WRITE (I02,90019) 02400901 +CBE** ********************** BBCFOOT0 **********************************02410901 +CBB** ********************** BBCFMT0A **********************************02420901 +C**** FORMATS FOR TEST DETAIL LINES 02430901 +C**** 02440901 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02450901 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02460901 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02470901 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02480901 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02490901 + 1I6,/," ",15X,"CORRECT= " ,I6) 02500901 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02510901 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02520901 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02530901 + 1A21,/," ",16X,"CORRECT= " ,A21) 02540901 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02550901 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02560901 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02570901 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02580901 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02590901 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02600901 +80050 FORMAT (" ",48X,A31) 02610901 +CBE** ********************** BBCFMT0A **********************************02620901 +CBB** ********************** BBCFMAT1 **********************************02630901 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02640901 +C**** 02650901 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02660901 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02670901 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02680901 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02690901 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02700901 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02710901 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02720901 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02730901 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02740901 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02750901 + 2"(",F12.5,", ",F12.5,")") 02760901 +CBE** ********************** BBCFMAT1 **********************************02770901 +CBB** ********************** BBCFMT0B **********************************02780901 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02790901 +C**** 02800901 +90002 FORMAT ("1") 02810901 +90004 FORMAT (" ") 02820901 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02830901 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02840901 +90008 FORMAT (" ",21X,A13,A17) 02850901 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02860901 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02870901 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02880901 + 1 7X,"REMARKS",24X) 02890901 +90014 FORMAT (" ","----------------------------------------------" , 02900901 + 1 "---------------------------------" ) 02910901 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02920901 +C**** 02930901 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02940901 +C**** 02950901 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02960901 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02970901 + 1 A13) 02980901 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02990901 +C**** 03000901 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03010901 +C**** 03020901 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03030901 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03040901 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03050901 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03060901 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03070901 +CBE** ********************** BBCFMT0B **********************************03080901 +C***** 03090901 +C***** END OF TEST SEGMENT 023 03100901 + STOP 03110901 + END 03120901 diff --git a/Fortran/UnitTests/fcvs21_f95/FM901.reference_input b/Fortran/UnitTests/fcvs21_f95/FM901.reference_input new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM901.reference_input @@ -0,0 +1,6 @@ +XYZ123:45$'),.JKLABCDEF67890MNOPQRSTUVW =+-*/(GHI +ONEFIVENINEELEVENSEVENTHREE +SQUARE THE WORLD IN 40 NIGHTS +DAYS 80AROUND +TO XXXXX NOT TO XXXX- THAT IS THE QUESTIONXXBE ORBE + diff --git a/Fortran/UnitTests/fcvs21_f95/FM901.reference_output b/Fortran/UnitTests/fcvs21_f95/FM901.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM901.reference_output @@ -0,0 +1,60 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM901BEGIN* TEST RESULTS - FM901 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + AFMTF - (023) FORMATTED DATA TRANSFER + + USING A-CONVERSION WITH SUBSTRINGS + + REFS - 12.9.5.2 13.3 13.5.11 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 4 TESTS + + 1 INSPECT 2 SETS OF 2 COMPUTED LINES + EXPECTED + COMPUTED= + ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 + ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 + + =+-*/(),.$': + =+-*/(),.$': + CORRECT: CORRESPONDING LINE(S) MUST MATCH + ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890 + =+-*/(),.$': + 2 INSPECT + COMPUTED= + ONE THREE FIVE SEVEN NINE ELEVEN + CORRECT= + ONE THREE FIVE SEVEN NINE ELEVEN + 3 INSPECT + COMPUTED= + AROUND THE WORLD IN 80 DAYS + CORRECT= + AROUND THE WORLD IN 80 DAYS + 4 INSPECT + COMPUTED= + TO BE OR NOT TO BE + CORRECT= + TO BE OR NOT TO BE + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 4 TESTS REQUIRE INSPECTION + 4 OF 4 TESTS EXECUTED + + *FM901END* END OF TEST - FM901 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM903.f b/Fortran/UnitTests/fcvs21_f95/FM903.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM903.f @@ -0,0 +1,565 @@ + PROGRAM FM903 + +C***********************************************************************00010903 +C***** FORTRAN 77 00020903 +C***** FM903 IOFMTF - (354) 00030903 +C***** THIS PROGRAM CALLS SUBROUTINE SN904 00040903 +C***********************************************************************00050903 +C***** GENERAL PURPOSE ANS REFS 00060903 +C***** TO TEST ADDITIONAL FEATURES OF READ AND WRITE 12.8 00070903 +C***** STATEMENTS, FORMATTED RECORDS AND FORMAT STATEMENTS 12.1.1 00080903 +C***** DOUBLE PRECISION AND COMPLEX DATA TYPES. 00090903 +C***** TO TEST ALL FORMS OF CHARACTER EXPRESSIONS AS 13.1.2 00100903 +C***** FORMAT SPECIFIERS. 00110903 +C***** RESTRICTIONS OBSERVED 00120903 +C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 13.2.1 00130903 +C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND 00140903 +C***** W IS EQUAL TO OR GREATER THAN D 00150903 +C***** * FIELD WIDTH IS NEVER ZERO 00160903 +C***** * IF AN I/O LIST SPECIFIES AT LEAST ONE ITEM 13.3 00170903 +C***** AT LEAST ONE REPEATABLE EDIT DESCRIPTOR MUST EXIST 00180903 +C***** IN THE FORMAT SPECIFICATION 00190903 +C***** * ITEMS IN I/O LIST CORRESPOND TO EDIT DESCRIPTORS 00200903 +C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 13.5.9 00210903 +C***** * AN H EDIT DESCRIPTOR IS NEVER USED ON INPUT 13.5.2 00220903 +C***** * IN THE INPUT FIELD, FOR THE IW EDIT DESCRIPTOR 13.5.9.1 00230903 +C***** THE CHARACTER STRING MUST BE AN OPTIONALLY SIGNED 00240903 +C***** INTEGER CONSTANT 00250903 +C***** GENERAL COMMENTS 00260903 +C***** PLUS SIGNS FOR INPUT FIELDS ARE USUALLY OMITTED 13.5.9 00270903 +C***** 00280903 +C***** CALL SUBROUTINE SN904 (SEGMENT 790) 00290903 +C***** 00300903 +CBB** ********************** BBCCOMNT **********************************00310903 +C**** 00320903 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00330903 +C**** VERSION 2.1 00340903 +C**** 00350903 +C**** 00360903 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00370903 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00380903 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00390903 +C**** BUILDING 225 RM A266 00400903 +C**** GAITHERSBURG, MD 20899 00410903 +C**** 00420903 +C**** 00430903 +C**** 00440903 +CBE** ********************** BBCCOMNT **********************************00450903 +C***** 00460903 +C INPUT DATA TO THIS SEGMENT CONSISTS OF 14 CARD IMAGES IN COL. 1 - 56 00470903 +COL. 1-----------------------------------------------------56 00480903 +CARD 1 333144446666225555 00490903 +CARD 2 1234567890 00500903 +CARD 3 1234567890 00510903 +CARD 4 1234567890 00520903 +CARD 5 1234567890 00530903 +CARD 6 12345 00540903 +CARD 7 12345123.5123.45D-01 12345D+01 00550903 +CARD 8 12 345 678 00560903 +CARD 9 5-1111 3333-5555 7777-9999 00570903 +CARD 10 12345678901234567890123456781234567890123456789012345678 00580903 +CARD 11 12345678901234123456789012341234567890123412345678901234 00590903 +CARD 12 12345678901234123456789012341234567890123456789012345678 00600903 +CARD 13 12345678901234567890123456781234567890123456789012345678 00610903 +CARD 14 12345678901234123456789012341234567890123412345678901234 00620903 +C***** 00630903 +C***** S P E C I F I C A T I O N S SEGMENT 354 00640903 +C***** 00650903 + INTEGER J1I(6) 00660903 + INTEGER IA1I(8) 00670903 + CHARACTER*11 A11VK 00680903 + CHARACTER*15 C151K(7) 00690903 + CHARACTER*19 A19VK 00700903 + CHARACTER*25 C251K(6) 00710903 + CHARACTER*32 A32VK 00720903 + CHARACTER*52 A52VK 00730903 + CHARACTER*65 A65VK 00740903 + CHARACTER*85 A85VK 00750903 + DOUBLE PRECISION AVD, A1D(4), B4D(2,1,2,2) 00760903 + COMPLEX AVC, BVC, CVC, A2C(2,2) 00770903 + EXTERNAL SN904 00780903 +C***** 00790903 +CBB** ********************** BBCINITA **********************************00800903 +C**** SPECIFICATION STATEMENTS 00810903 +C**** 00820903 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00830903 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00840903 +CBE** ********************** BBCINITA **********************************00850903 +CBB** ********************** BBCINITB **********************************00860903 +C**** INITIALIZE SECTION 00870903 + DATA ZVERS, ZVERSD, ZDATE 00880903 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00890903 + DATA ZCOMPL, ZNAME, ZTAPE 00900903 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00910903 + DATA ZPROJ, ZTAPED, ZPROG 00920903 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00930903 + DATA REMRKS /' '/ 00940903 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00950903 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00960903 +C**** 00970903 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00980903 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00990903 +CZ03 ZPROG = 'PROGRAM NAME' 01000903 +CZ04 ZDATE = 'DATE OF TEST' 01010903 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 01020903 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 01030903 +CZ07 ZNAME = 'NAME OF USER' 01040903 +CZ08 ZTAPE = 'TAPE OWNER/ID' 01050903 +CZ09 ZTAPED = 'DATE TAPE COPIED' 01060903 +C 01070903 + IVPASS = 0 01080903 + IVFAIL = 0 01090903 + IVDELE = 0 01100903 + IVINSP = 0 01110903 + IVTOTL = 0 01120903 + IVTOTN = 0 01130903 + ICZERO = 0 01140903 +C 01150903 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 01160903 + I01 = 05 01170903 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 01180903 + I02 = 06 01190903 +C 01200903 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 01210903 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 01220903 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 01230903 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 01240903 +C 01250903 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 01260903 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 01270903 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 01280903 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01290903 +C 01300903 +CBE** ********************** BBCINITB **********************************01310903 + IRVI = I01 01320903 + NUVI = I02 01330903 + IVTOTL = 13 01340903 + ZPROG = 'FM903' 01350903 +CBB** ********************** BBCHED0A **********************************01360903 +C**** 01370903 +C**** WRITE REPORT TITLE 01380903 +C**** 01390903 + WRITE (I02, 90002) 01400903 + WRITE (I02, 90006) 01410903 + WRITE (I02, 90007) 01420903 + WRITE (I02, 90008) ZVERS, ZVERSD 01430903 + WRITE (I02, 90009) ZPROG, ZPROG 01440903 + WRITE (I02, 90010) ZDATE, ZCOMPL 01450903 +CBE** ********************** BBCHED0A **********************************01460903 +C***** HEADER FORMAT STATEMENT 01470903 + WRITE(NUVI, 35400) 01480903 +35400 FORMAT(" ",/ 1X, "IOFMTF - (354) ADDITIONAL FORMATTED" //1X, 01490903 + 1 "DATA TRANSFERS" ,//1X, 01500903 + 2 "ANS REF. - 12.9.5.2 13.1 13.5" ) 01510903 +CBB** ********************** BBCHED0B **********************************01520903 +C**** WRITE DETAIL REPORT HEADERS 01530903 +C**** 01540903 + WRITE (I02,90004) 01550903 + WRITE (I02,90004) 01560903 + WRITE (I02,90013) 01570903 + WRITE (I02,90014) 01580903 + WRITE (I02,90015) IVTOTL 01590903 +CBE** ********************** BBCHED0B **********************************01600903 +C***** TEST THAT A FORMAT MAY BE A CHARACTER VARIABLE, 12.4.2(3) 01610903 +C***** A CHARACTER EXPRESSION, A CHARACTER ARRAY, OR A 12.4.2(4) 01620903 +C***** CHARACTER ARRAY ELEMENT. 13.1.2 01630903 +C***** NOTE THAT THE LENGTH OF THE FORMAT MAY EXCEED THE 01640903 +C***** LENGTH OF AN ARRAY ELEMENT IF THE FORMAT SPECIFIER 01650903 +C***** IS AN ARRAY, BUT NOT IF THE SPECIFIER IS AN ARRAY ELEMENT. 01660903 + WRITE(NUVI, 35401) 01670903 +35401 FORMAT(/8X, "CHARACTER EXPRESSION AS FORMAT" /) 01680903 + A19VK = '(I3,I1,I4,I4,I2,I4)' 01690903 +C***** CARD 1 01700903 + READ(IRVI, A19VK) J1I(3), J1I(1), J1I(4), J1I(6), J1I(2), J1I(5)01710903 +CT001* TEST 1 - CHARACTER EXPRESSION AS FORMAT 01720903 + IVTNUM = 1 01730903 + REMRKS = 'LEADING PLUS SIGN OPTIONAL' 01740903 + WRITE (NUVI, 80004) IVTNUM, REMRKS 01750903 + A65VK = '16X, "COMPUTED: "/26X,I1, 1X, I2, 1X, I3, 1X, I4, 1X, 01760903 + 1I5, 1X, I6' 01770903 + A85VK = '16X, "CORRECT: ",22X, "2 CORRECT ANSWERS POSSIBLE"/26X01780903 + 1, "1 22 333 4444 5555 6666"' 01790903 + WRITE(NUVI, '(/1X,' // A65VK // '/1X,' // A85VK // ')') J1I 01800903 + IVINSP = IVINSP + 1 01810903 + WRITE (NUVI, 70010) 01820903 +70010 FORMAT (26X,"1 22 333 4444 +5555 +6666" ) 01830903 +CT002* TEST 2 - CHARACTER ARRAY AS FORMAT 01840903 + IVTNUM = 2 01850903 + WRITE (NUVI, 80004) IVTNUM, REMRKS 01860903 + WRITE (NUVI, 80020) 01870903 + C251K(1) = '(26X, I6, 1X, I5, 1X, I4,' 01880903 + C251K(2) = ' 1X, I3, 1X, I2, 1X, I1 /' 01890903 + C251K(3) = '17X,"CORRECT: ",22X, "2 C' 01900903 + C251K(4) = 'ORRECT ANSWERS POSSIBLE"/' 01910903 + C251K(5) = '26X, " 6666 5555 4444 ' 01920903 + C251K(6) = '333 22 1")' 01930903 + WRITE(NUVI, C251K) (J1I(7-IVI), IVI=1,6) 01940903 + IVINSP = IVINSP + 1 01950903 + WRITE (NUVI, 70020) 01960903 +70020 FORMAT (26X," +6666 +5555 4444 333 22 1" ) 01970903 +CT003* TEST 3 - CHARACTER ARRAY ELEMENT AS FORMAT 01980903 + IVTNUM = 3 01990903 + WRITE (NUVI, 80004) IVTNUM, REMRKS 02000903 + WRITE (NUVI, 80020) 02010903 +C***** 02020903 + C151K(1) = '(I1,2X,I2)' 02030903 + C151K(3) = '(2X,I3,1X,I4)' 02040903 + C151K(5) = '(I5,T1,I1)' 02050903 + C151K(7) = '(TR4,I2,TL2,I3)' 02060903 +C***** CARDS 2-5 02070903 + DO 0032 IVI = 1, 7, 2 02080903 + READ(IRVI, C151K(IVI)) IA1I(IVI), IA1I(IVI+1) 02090903 + 0032 CONTINUE 02100903 + WRITE(NUVI, 70030) IA1I 02110903 +70030 FORMAT (25X, 8(1X, I5)) 02120903 + IVINSP = IVINSP + 1 02130903 + WRITE (NUVI, 70031) 02140903 +70031 FORMAT (" ",16X,"CORRECT: " ,22X,"2 CORRECT ANSWERS POSSIBLE" )02150903 + WRITE (NUVI, 70032) 02160903 +70032 FORMAT(26X, ' 1 45 345 7890 12345 1 56 567'/ 02170903 + 1 26X, ' +1 +45 +345 +7890 12345 +1 +56 +567') 02180903 +C***** 02190903 +C***** TEST ADDITIONAL INTEGER EDITING FEATURES. 02200903 +C***** - IW.M EDITING DESCRIPTOR 13.5.9.1 02210903 +C***** NOTE THAT IF M IS ZERO AND THE VALUE OF THE INTERNAL 02220903 +C***** DATUM IS ZERO, THE OUTPUT FIELD CONSISTS OF ONLY BLANK 02230903 +C***** CHARACTERS REGARDLESS OF THE SIGN CONTROL IN EFFECT. 02240903 + WRITE(NUVI, 35404) 02250903 +35404 FORMAT(/8X, "INTEGER EDITING AND OUT OF RANGE" /) 02260903 +C***** CARD 6 02270903 + READ(IRVI, 35405) (IA1I(IVI), IVI=1,4) 02280903 +35405 FORMAT(I6.6, T1, I6.4, TL6, I6.2, TL9, I6.0) 02290903 +CT004* TEST 4 - INTEGER EDITING 02300903 + IVTNUM = 4 02310903 + WRITE (NUVI, 80004) IVTNUM,REMRKS 02320903 + WRITE (NUVI, 80020) 02330903 + WRITE(NUVI, 70040) (IA1I(IVI), IVI=1,4) 02340903 +70040 FORMAT(25X, 4(1X, I6)) 02350903 + IVINSP = IVINSP + 1 02360903 + WRITE (NUVI, 70031) 02370903 + WRITE (NUVI, 70041) 02380903 +70041 FORMAT(26X, " 12345 12345 12345 12345" / 02390903 + 1 26X, "+12345 +12345 +12345 +12345" ) 02400903 +CT005* TEST 5 - OUT OF RANGE 02410903 + IVTNUM = 5 02420903 + WRITE (NUVI, 80004) IVTNUM 02430903 + WRITE (NUVI, 80020) 02440903 + JVI = 0 02450903 + IVI = 12 02460903 + WRITE (NUVI, 70050) -IVI, IVI, IVI, IVI, IVI, JVI, JVI, JVI 02470903 +70050 FORMAT (26X, SS, I5.5, S, 1X, I5.5, SS, 1X, I5.3, 1X, I5.1, 02480903 + 1 1X, I5.0, 1X, "(", I5.0, ")", S, 1X, "(", I5.0, ")", 02490903 + 2 SP, 1X, "(", I5.0, ")") 02500903 + IVINSP = IVINSP + 1 02510903 + WRITE (NUVI, 80022) 02520903 + WRITE (NUVI, 70051) 02530903 +70051 FORMAT (26X, "***** 00012 012 12 12 ( ) ( )" , 02540903 + 1 " ( )") 02550903 +C ADVANCE TO TOP-OF PAGE AND WRITE HEADERS 02560903 + WRITE (NUVI, 90002) 02570903 + WRITE (NUVI, 90013) 02580903 + WRITE (NUVI, 90014) 02590903 +C***** 02600903 +C***** TEST ADDITIONAL DOUBLE PRECISION EDITING FEATURES. 13.5.9.2 02610903 +C***** - D.P. MAY BE READ, WRITTEN WITH F AND E 13.5.9.2.1 02620903 +C***** EDIT DESCRIPTOR. 13.5.9.2.2 02630903 +C***** (D AND G FORMATS ARE TEST IN INTERNAL FILE SEGMENTS 02640903 +C***** 392 AND 393.) 02650903 +C***** - FIELD WIDTH TOO SMALL ON F 13.5.9(4) 02660903 +C***** - EXPONENT WIDTH TOO SMALL ON EW.DE(E) 13.5.9(4) 02670903 +C***** - IF SP AND FIELD TOO SMALL, THE PLUS IS NOT 13.5.9(5) 02680903 +C***** OPTIONAL 02690903 + WRITE(NUVI, 35408) 02700903 +35408 FORMAT(/8X,"DOUBLE PRECISION EDITING AND OUT OF RANGE" /) 02710903 +C***** CARD 7 02720903 + READ(IRVI, 35409) B4D 02730903 +35409 FORMAT(1X, 2F5.2, F10.2, F10.5, TL40, 1X, 2E5.2, E10.2, E10.5E5)02740903 +CT006* TEST 6 - DOUBLE PRECISION EDITING AND OUT OF RANGE 02750903 + IVTNUM = 6 02760903 + REMRKS = '2 COMPUTED LINES EXPECTED' 02770903 + WRITE (NUVI, 80004) IVTNUM,REMRKS 02780903 + WRITE (NUVI, 80020) 02790903 + B4D(2,1,2,2) = (B4D(2,1,2,2) * 10) ** 12 02800903 + WRITE(NUVI, 70060) B4D 02810903 +70060 FORMAT(26X, SP, F6.2, SS, 1X, F5.4, 1X, F6.3, 1X, F6.4, 02820903 + 1 /26X,2P,E6.1,0P,2(5X,E10.5),5X,E9.5E1) 02830903 + IVINSP = IVINSP + 1 02840903 + WRITE (NUVI, 70061) 02850903 +70061 FORMAT(/" ",16X,"CORRECT: " ,22X, "CORRESPONDING LINES MUST02860903 + 1 MATCH " ,/" ",48X,"EITHER OF THE FOLLOWING TWO " , 02870903 + 2 /" ",48X,"CORRECT ANSWERS " ) 02880903 + WRITE (NUVI, 70062) 02890903 +70062 FORMAT(26X,"****** ***** 12.345 1.2345" /26X, 02900903 + 1 "****** .12350E+03 .12345E+02 *********" /02910903 + 2 /26X,"****** ***** 12.345 1.2345" /26X, 02920903 + 3 "****** .12350+003 .12345+002 *********" )02930903 +C***** 02940903 +C***** TEST ADDITIONAL COMPLEX EDITING FEATURES. 13.5.9.2.4 02950903 +C***** - FIELD WIDTH TOO SMALL ON F 13.5.9(4) 02960903 +C***** - EXPONENT WIDTH TOO SMALL ON EW.DE(E) 13.5.9(4) 02970903 + WRITE(NUVI, 35411) 02980903 +35411 FORMAT(/8X, "COMPLEX EDITING AND OUT OF RANGE" /) 02990903 +CT007* TEST 7 - COMPLEX EDITING AND OUT OF RANGE 03000903 + IVTNUM = 7 03010903 + WRITE (NUVI, 80004) IVTNUM, REMRKS 03020903 + WRITE (NUVI, 80020) 03030903 + AVC = (25.25, 75.75) 03040903 + BVC = (0.25E+10, 0.75E+10) 03050903 + WRITE(NUVI, 70070) AVC, AVC, BVC, BVC 03060903 +70070 FORMAT (26X, F7.2, 3X, F6.2, 3X, F5.2, 3X, F4.2, 03070903 + 1 /26X, E8.2E3, 3X, E7.2E2, 2(4X, E6.2E1)) 03080903 + IVINSP = IVINSP + 1 03090903 + WRITE (NUVI, 70061) 03100903 + WRITE (NUVI, 70071) 03110903 +70071 FORMAT (26X, " 25.25 75.75 25.25 ****" / 03120903 + 1 25X, " .25E+010 .75E+10 ****** ******" // 03130903 + 2 26X, " +25.25 +75.75 25.25 ****" / 03140903 + 3 25X, " .25E+010 .75E+10 ****** ******" ) 03150903 +C***** 03160903 +C***** - TEST BZ, BN EDIT DESCRIPTORS 13.5.8 03170903 +C***** - TEST T, TL, TR EDIT DESCRIPTORS 13.5.3.1 03180903 + WRITE(NUVI, 35414) 03190903 +35414 FORMAT(/8X,"BZ, BN, T, TL AND TR EDIT DESCRIPTOR" /) 03200903 +CT008* TEST 8 - BZ, BN, T, TL, AND TR EDIT DESCRIPTOR 03210903 + IVTNUM = 8 03220903 + REMRKS = 'LEADING PLUS SIGN OPTIONAL' 03230903 + WRITE (NUVI, 80004) IVTNUM,REMRKS 03240903 + WRITE (NUVI, 80020) 03250903 +C***** CARD 8 03260903 + READ(IRVI, 70080) AVD, B4D(2,1,1,2), A2C(1,1), AVC 03270903 +70080 FORMAT(BN, D5.2, BZ, D5.2, TL40, 2F5.2, T1, TR1, TL1, BN, 2F5.1)03280903 + WRITE(NUVI, 70081) AVD, B4D(2,1,1,2), A2C(1,1), AVC 03290903 +70081 FORMAT (25X, 2F6.2, (((4(1X, F6.2))))) 03300903 + IVINSP = IVINSP + 1 03310903 + WRITE (NUVI, 70031) 03320903 + WRITE (NUVI, 70082) 03330903 +70082 FORMAT(25X, TR26, " 123.40 567.80" , T25, " 12.34506.78" , 03340903 + 1 1X, "120.34 506.78" // 03350903 + 2 25X, TR26, " 123.40 567.80" , T25, " +12.34506.78" , 03360903 + 3 1X, "120.34 506.78" ) 03370903 +C***** 03380903 +C***** PASS A CHARACTER CONSTANT, WHICH IS A LEGITIMATE FORMAT 03390903 +C***** SPECIFIER TO A SUBROUTINE. 03400903 + WRITE(NUVI, 35417) 03410903 +35417 FORMAT(/8X,"SUBROUTINE CALL" /) 03420903 +CT009* TEST 9 - SUBROUTINE CALL 03430903 + IVTNUM = 9 03440903 + WRITE (NUVI, 80004) IVTNUM,REMRKS 03450903 +C***** CARD 9 03460903 + A11VK = '(I5, 6(I5))' 03470903 + CALL SN904(A11VK, IRVI, NUVI) 03480903 + IVINSP = IVINSP + 1 03490903 +C***** 03500903 +C ADVANCE TO TOP-OF PAGE AND WRITE HEADERS 03510903 + WRITE (NUVI, 90002) 03520903 + WRITE (NUVI, 90013) 03530903 + WRITE (NUVI, 90014) 03540903 +C***** 03550903 +C***** - TEST SS AND SP EDIT DESCRIPTORS. 13.5.6 03560903 +C***** - TEST ALSO THAT A FORMAT SPECIFICATION MAY BE 13.1.2 03570903 +C***** ALTERED BY A CHARACTER SUBSTRING SUBSTITUTION. 5.7 03580903 + WRITE(NUVI, 35419) 03590903 +35419 FORMAT(/8X,"SS AND SP EDIT DESCRIPTOR" /) 03600903 +CT010* TEST 10 - SS AND SP EDIT DESCRIPTORS 03610903 + IVTNUM = 10 03620903 + WRITE (NUVI, 80004) IVTNUM, REMRKS 03630903 + WRITE (NUVI, 80020) 03640903 + IVI = 12345 03650903 + AVS = 25.25 03660903 + A1D(2) = 5.5D0 03670903 + A2C(2,1) = (3.0, 4.0) 03680903 + A52VK = '(26X,SP,F5.1,SS,2X,F4.1,SP,(T40,I6,2X,F6.2,SS,F6.1))' 03690903 + WRITE(NUVI, A52VK) A2C(2,1), IVI, AVS, A1D(2), IVI, AVS, A1D(2) 03700903 + IVINSP = IVINSP + 1 03710903 + WRITE (NUVI, 70101) 03720903 +70101 FORMAT(/" ",16X,"CORRECT: " ,22X, "CORRESPONDING LINES MUST03730903 + 1 MATCH " ) 03740903 + WRITE (NUVI, 70102) 03750903 +70102 FORMAT(26X,' +3.0 4.0 +12345 +25.25 5.5' 03760903 + 1 /T40,' 12345 25.25 5.5') 03770903 +CT011* TEST 11 - FORMAT ALTERED BY CHARACTER SUBSTRING SUBSTITUTION 03780903 + IVTNUM = 11 03790903 + WRITE (NUVI, 80004) IVTNUM, REMRKS 03800903 + WRITE (NUVI, 80020) 03810903 + A52VK(7:7) = 'S' 03820903 + A52VK(14:15) = 'SP' 03830903 + A52VK(26:26) = 'S' 03840903 + A52VK(45:45) = 'P' 03850903 + WRITE(NUVI, A52VK) A2C(2,1), IVI, AVS, A1D(2), IVI, AVS, A1D(2) 03860903 + IVINSP = IVINSP + 1 03870903 + WRITE (NUVI, 70101) 03880903 + WRITE (NUVI, 70111) 03890903 +70111 FORMAT (26X,' 3.0 +4.0 12345 25.25 +5.5' 03900903 + 1 /T40,'+12345 +25.25 +5.5') 03910903 +C***** 03920903 +C***** TEST A COLON EDIT DESCRIPTOR FOLLOWED BY A H-EDIT 13.5.5 03930903 +C***** DESCRIPTOR TO SHOW THAT THE COLON EDIT DESCRIPTOR 03940903 +C***** TERMINATED IF THERE ARE NO MORE ITEMS IN THE INPUT/OUTPUT LIST03950903 + WRITE(NUVI, 35422) 03960903 +35422 FORMAT(/8X,'COLON EDIT DESCRIPTOR'/) 03970903 +CT012* TEST 12 03980903 + IVTNUM = 12 03990903 + REMRKS = '2 COMPUTED LINES EXPECTED' 04000903 + WRITE (NUVI, 80004) IVTNUM, REMRKS 04010903 + WRITE (NUVI, 80020) 04020903 + A32VK = 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHH' 04030903 + WRITE(NUVI, 70120) A32VK, A32VK 04040903 +70120 FORMAT(26X, A32, :, 'IIIIJJJJ') 04050903 + IVINSP = IVINSP + 1 04060903 + WRITE (NUVI, 70101) 04070903 + WRITE (NUVI, 70121) 04080903 +70121 FORMAT(26X, 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHHIIIIJJJJ', 04090903 + 1 /26X, 'AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHH') 04100903 +C***** 04110903 +C***** TEST THAT FW.D, EW.DE(E) AND GW.DE(E) MAY HAVE MORE DIGITS ON 04120903 +C***** INPUT THAN THE PROCESSOR CAN HANDLE FOR D.P. AND COMPLEX 04130903 +CT013* TEST 13 - LARGE FORMAT SIZE FOR D.P. AND COMPLEX 04140903 + IVTNUM = 13 04150903 + WRITE (NUVI, 70131) IVTNUM 04160903 +70131 FORMAT (/" ",2X,I3,4X,"INSPECT",32X, 04170903 + 1 'TEST SUCCESSFUL IF PROCESSOR IS '/" ",48X, 04180903 + 2 'ABLE TO READ INPUT CARDS 10-14 '/" ",48X, 04190903 + 3 'UNDER F, E, AND G FORMATS WHICH '/" ",48X, 04200903 + 4 'HAVE MORE DIGITS THAN THE '/" ",48X, 04210903 + 5 'PROCESSOR CAN HANDLE FOR D. P. '/" ",48X, 04220903 + 6 'AND COMPLEX') 04230903 + IVINSP = IVINSP + 1 04240903 +C***** CARDS 10-14 04250903 + READ(IRVI, 70130) B4D(1,1,1,1), AVD, AVC, A2C(2,2), BVC, 04260903 + 1 (B4D(1,1,IVI,1),IVI=1,2), A1D(1), A2C(1,2), CVC 04270903 +70130 FORMAT(2F28.14, /2(E14.7E2, G14.14E1), /G14.0E3, E14.14E3, 04280903 + 1 E28.0E1, /2G28.14E2, /2(F14.0, F14.14) ) 04290903 +C***** 04300903 +CBB** ********************** BBCSUM0 **********************************04310903 +C**** WRITE OUT TEST SUMMARY 04320903 +C**** 04330903 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04340903 + WRITE (I02, 90004) 04350903 + WRITE (I02, 90014) 04360903 + WRITE (I02, 90004) 04370903 + WRITE (I02, 90020) IVPASS 04380903 + WRITE (I02, 90022) IVFAIL 04390903 + WRITE (I02, 90024) IVDELE 04400903 + WRITE (I02, 90026) IVINSP 04410903 + WRITE (I02, 90028) IVTOTN, IVTOTL 04420903 +CBE** ********************** BBCSUM0 **********************************04430903 +CBB** ********************** BBCFOOT0 **********************************04440903 +C**** WRITE OUT REPORT FOOTINGS 04450903 +C**** 04460903 + WRITE (I02,90016) ZPROG, ZPROG 04470903 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04480903 + WRITE (I02,90019) 04490903 +CBE** ********************** BBCFOOT0 **********************************04500903 +CBB** ********************** BBCFMT0A **********************************04510903 +C**** FORMATS FOR TEST DETAIL LINES 04520903 +C**** 04530903 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04540903 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04550903 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04560903 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04570903 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04580903 + 1I6,/," ",15X,"CORRECT= " ,I6) 04590903 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04600903 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04610903 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04620903 + 1A21,/," ",16X,"CORRECT= " ,A21) 04630903 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04640903 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04650903 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04660903 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04670903 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04680903 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04690903 +80050 FORMAT (" ",48X,A31) 04700903 +CBE** ********************** BBCFMT0A **********************************04710903 +CBB** ********************** BBCFMAT1 **********************************04720903 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04730903 +C**** 04740903 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04750903 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04760903 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04770903 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04780903 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04790903 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04800903 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04810903 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04820903 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04830903 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04840903 + 2"(",F12.5,", ",F12.5,")") 04850903 +CBE** ********************** BBCFMAT1 **********************************04860903 +CBB** ********************** BBCFMT0B **********************************04870903 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04880903 +C**** 04890903 +90002 FORMAT ("1") 04900903 +90004 FORMAT (" ") 04910903 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04920903 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04930903 +90008 FORMAT (" ",21X,A13,A17) 04940903 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04950903 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04960903 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04970903 + 1 7X,"REMARKS",24X) 04980903 +90014 FORMAT (" ","----------------------------------------------" , 04990903 + 1 "---------------------------------" ) 05000903 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 05010903 +C**** 05020903 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 05030903 +C**** 05040903 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 05050903 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 05060903 + 1 A13) 05070903 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 05080903 +C**** 05090903 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 05100903 +C**** 05110903 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 05120903 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 05130903 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 05140903 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 05150903 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 05160903 +CBE** ********************** BBCFMT0B **********************************05170903 +C***** 05180903 +C***** END OF TEST SEGMENT 354 05190903 + STOP 05200903 + END 05210903 + +C***********************************************************************00010904 +C***** FORTRAN 77 00020904 +C***** FM904 SN904 - (790) 00030904 +C***** THIS SUBROUTINE IS CALLED BY FM903 00040904 +C***********************************************************************00050904 +C***** GENERAL PURPOSE ANS REFS 00060904 +C***** THIS SUBROUTINE IS CALLED BY IOFMTF (354) 00070904 +C***** IT IS USED PRIMARILY TO TEST THAT A CHARACTER 13.1.2 00080904 +C***** CONSTANT MAY BE PASSED AS A PARAMETER TO A 15.6.2.3 00090904 +C***** SUBROUTINE AND USED AS A FORMAT. 00100904 +C***** IT ALSO TESTS THAT A FORMAT MAY BE DEFINED IN A 9.4 00110904 +C***** DATA STATEMENT. 00120904 +C***** RESTRICTIONS OBSERVED 00130904 +C***** SEE SEGMENT 354 00140904 +C***** 00150904 + SUBROUTINE SN904(A0WVK, IRWVI, NUWVI) 00160904 +C***** 00170904 +C***** S P E C I F I C A T I O N S SEGMENT 790 00180904 +C***** 00190904 + CHARACTER*(*) A0WVK 00200904 + CHARACTER*130 A130VK 00210904 + INTEGER I1I(5) 00220904 +C***** 00230904 +C***** TESTS THAT 00240904 +C***** - A FORMAT SPECIFIER MAY BE PASSED AS A CHARACTER 13.1.2 00250904 +C***** CONSTANT TO A SUBROUTINE. 15.6.2.3 00260904 +C***** - A FORMAT SPECIFIER MAY BE DEFINED IN A DATA 13.1.2 00270904 +C***** STATEMENT. 9.4 00280904 +C***** - AN INPUT LIST MAY CONTAIN AN INTEGER THAT IS USED 12.8.2.3 00290904 +C***** AS A SUBSCRIPT IN AN IMPLIED DO-LIST. 00300904 +C***** - AN OUTPUT LIST MAY CONTAIN AN EXPRESSION WITH AN 12.8.2.2 00310904 +C***** INTRINISC FUNCTION. 15.3 00320904 +C***** 00330904 + DATA A130VK/'(16X, "COMPUTED: "/26X, 3I5/16X, "CORRECT: ",22X, 00340904 + 1''2 CORRECT ANSWERS POSSIBLE''/26X,'' 1111 3333-5555''/26X,''+111100350904 + 2+3333-5555'')'/ 00360904 + READ(IRWVI, A0WVK) IVI, (I1I(JVI),JVI=1,IVI) 00370904 + WRITE(NUWVI, A130VK) IABS(I1I(1)), MAX0(I1I(2),I1I(5)), I1I(3) 00380904 +C***** 00390904 + RETURN 00400904 + END 00410904 diff --git a/Fortran/UnitTests/fcvs21_f95/FM903.reference_input b/Fortran/UnitTests/fcvs21_f95/FM903.reference_input new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM903.reference_input @@ -0,0 +1,15 @@ +333144446666225555 +1234567890 +1234567890 +1234567890 +1234567890 + 12345 + 12345123.5123.45D-01 12345D+01 +12 345 678 + 5-1111 3333-5555 7777-9999 +12345678901234567890123456781234567890123456789012345678 +12345678901234123456789012341234567890123412345678901234 +12345678901234123456789012341234567890123456789012345678 +12345678901234567890123456781234567890123456789012345678 +12345678901234123456789012341234567890123412345678901234 + diff --git a/Fortran/UnitTests/fcvs21_f95/FM903.reference_output b/Fortran/UnitTests/fcvs21_f95/FM903.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM903.reference_output @@ -0,0 +1,164 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM903BEGIN* TEST RESULTS - FM903 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + IOFMTF - (354) ADDITIONAL FORMATTED + + DATA TRANSFERS + + ANS REF. - 12.9.5.2 13.1 13.5 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 13 TESTS + + + CHARACTER EXPRESSION AS FORMAT + + 1 INSPECT LEADING PLUS SIGN OPTIONAL + + COMPUTED: + 1 22 333 4444 5555 6666 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 1 22 333 4444 5555 6666 + 1 22 333 4444 +5555 +6666 + 2 INSPECT LEADING PLUS SIGN OPTIONAL + COMPUTED= + 6666 5555 4444 333 22 1 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 6666 5555 4444 333 22 1 + +6666 +5555 4444 333 22 1 + 3 INSPECT LEADING PLUS SIGN OPTIONAL + COMPUTED= + 1 45 345 7890 12345 1 56 567 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 1 45 345 7890 12345 1 56 567 + +1 +45 +345 +7890 12345 +1 +56 +567 + + INTEGER EDITING AND OUT OF RANGE + + 4 INSPECT LEADING PLUS SIGN OPTIONAL + COMPUTED= + 12345 12345 12345 12345 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 12345 12345 12345 12345 + +12345 +12345 +12345 +12345 + 5 INSPECT + COMPUTED= + ***** 00012 012 12 12 ( ) ( ) ( ) + CORRECT= + ***** 00012 012 12 12 ( ) ( ) ( ) +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + DOUBLE PRECISION EDITING AND OUT OF RANGE + + 6 INSPECT 2 COMPUTED LINES EXPECTED + COMPUTED= + ****** ***** 12.345 1.2345 + ****** .12350E+03 .12345E+02 ********* + + CORRECT: CORRESPONDING LINES MUST MATCH + EITHER OF THE FOLLOWING TWO + CORRECT ANSWERS + ****** ***** 12.345 1.2345 + ****** .12350E+03 .12345E+02 ********* + + ****** ***** 12.345 1.2345 + ****** .12350+003 .12345+002 ********* + + COMPLEX EDITING AND OUT OF RANGE + + 7 INSPECT 2 COMPUTED LINES EXPECTED + COMPUTED= + 25.25 75.75 25.25 **** + .25E+010 .75E+10 ****** ****** + + CORRECT: CORRESPONDING LINES MUST MATCH + EITHER OF THE FOLLOWING TWO + CORRECT ANSWERS + 25.25 75.75 25.25 **** + .25E+010 .75E+10 ****** ****** + + +25.25 +75.75 25.25 **** + .25E+010 .75E+10 ****** ****** + + BZ, BN, T, TL AND TR EDIT DESCRIPTOR + + 8 INSPECT LEADING PLUS SIGN OPTIONAL + COMPUTED= + 12.34506.78 120.34 506.78 123.40 567.80 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 12.34506.78 120.34 506.78 123.40 567.80 + + +12.34506.78 120.34 506.78 123.40 567.80 + + SUBROUTINE CALL + + 9 INSPECT LEADING PLUS SIGN OPTIONAL + COMPUTED: + 1111 3333-5555 + CORRECT: 2 CORRECT ANSWERS POSSIBLE + 1111 3333-5555 + +1111+3333-5555 +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + + SS AND SP EDIT DESCRIPTOR + + 10 INSPECT LEADING PLUS SIGN OPTIONAL + COMPUTED= + +3.0 4.0 +12345 +25.25 5.5 + 12345 25.25 5.5 + + CORRECT: CORRESPONDING LINES MUST MATCH + +3.0 4.0 +12345 +25.25 5.5 + 12345 25.25 5.5 + 11 INSPECT LEADING PLUS SIGN OPTIONAL + COMPUTED= + 3.0 +4.0 12345 25.25 +5.5 + +12345 +25.25 +5.5 + + CORRECT: CORRESPONDING LINES MUST MATCH + 3.0 +4.0 12345 25.25 +5.5 + +12345 +25.25 +5.5 + + COLON EDIT DESCRIPTOR + + 12 INSPECT 2 COMPUTED LINES EXPECTED + COMPUTED= + AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHHIIIIJJJJ + AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHH + + CORRECT: CORRESPONDING LINES MUST MATCH + AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHHIIIIJJJJ + AAAABBBBCCCCDDDDEEEEFFFFGGGGHHHH + + 13 INSPECT TEST SUCCESSFUL IF PROCESSOR IS + ABLE TO READ INPUT CARDS 10-14 + UNDER F, E, AND G FORMATS WHICH + HAVE MORE DIGITS THAN THE + PROCESSOR CAN HANDLE FOR D. P. + AND COMPLEX + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 13 TESTS REQUIRE INSPECTION + 13 OF 13 TESTS EXECUTED + + *FM903END* END OF TEST - FM903 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM905.f b/Fortran/UnitTests/fcvs21_f95/FM905.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM905.f @@ -0,0 +1,338 @@ + PROGRAM FM905 + +C***********************************************************************00010905 +C***** FORTRAN 77 00020905 +C***** FM905 00030905 +C***** LSTDO1 - (371) 00040905 +C***** 00050905 +C***********************************************************************00060905 +C***** GENERAL PURPOSE ANS REF 00070905 +C***** TEST LIST DIRECTED OUTPUT ON 13.6 00080905 +C***** INTEGER, REAL, LOGICAL, AND CHARACTER DATA TYPES 12.4 00090905 +C***** 00100905 +CBB** ********************** BBCCOMNT **********************************00110905 +C**** 00120905 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130905 +C**** VERSION 2.1 00140905 +C**** 00150905 +C**** 00160905 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170905 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180905 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190905 +C**** BUILDING 225 RM A266 00200905 +C**** GAITHERSBURG, MD 20899 00210905 +C**** 00220905 +C**** 00230905 +C**** 00240905 +CBE** ********************** BBCCOMNT **********************************00250905 +C***** 00260905 +C***** S P E C I F I C A T I O N S SEGMENT 371 00270905 + LOGICAL B1B(3), AVB 00280905 + CHARACTER A5VK*5, A9VK*9, A33VK*33, A82VK*82 00290905 + CHARACTER A51K(4)*5 00300905 +C***** 00310905 +CBB** ********************** BBCINITA **********************************00320905 +C**** SPECIFICATION STATEMENTS 00330905 +C**** 00340905 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350905 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360905 +CBE** ********************** BBCINITA **********************************00370905 +CBB** ********************** BBCINITB **********************************00380905 +C**** INITIALIZE SECTION 00390905 + DATA ZVERS, ZVERSD, ZDATE 00400905 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410905 + DATA ZCOMPL, ZNAME, ZTAPE 00420905 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430905 + DATA ZPROJ, ZTAPED, ZPROG 00440905 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450905 + DATA REMRKS /' '/ 00460905 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470905 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480905 +C**** 00490905 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500905 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510905 +CZ03 ZPROG = 'PROGRAM NAME' 00520905 +CZ04 ZDATE = 'DATE OF TEST' 00530905 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540905 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550905 +CZ07 ZNAME = 'NAME OF USER' 00560905 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570905 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580905 +C 00590905 + IVPASS = 0 00600905 + IVFAIL = 0 00610905 + IVDELE = 0 00620905 + IVINSP = 0 00630905 + IVTOTL = 0 00640905 + IVTOTN = 0 00650905 + ICZERO = 0 00660905 +C 00670905 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680905 + I01 = 05 00690905 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700905 + I02 = 06 00710905 +C 00720905 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730905 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740905 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750905 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760905 +C 00770905 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780905 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790905 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800905 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810905 +C 00820905 +CBE** ********************** BBCINITB **********************************00830905 + NUVI = I02 00840905 + IVTOTL = 10 00850905 + ZPROG = 'FM905' 00860905 +CBB** ********************** BBCHED0A **********************************00870905 +C**** 00880905 +C**** WRITE REPORT TITLE 00890905 +C**** 00900905 + WRITE (I02, 90002) 00910905 + WRITE (I02, 90006) 00920905 + WRITE (I02, 90007) 00930905 + WRITE (I02, 90008) ZVERS, ZVERSD 00940905 + WRITE (I02, 90009) ZPROG, ZPROG 00950905 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960905 +CBE** ********************** BBCHED0A **********************************00970905 +C***** 00980905 +C***** HEADING FOR SEGMENT 371 00990905 + WRITE(NUVI,37100) 01000905 +37100 FORMAT(" ", /" LSTDO1 - (371) " , 01010905 + 1 " LIST DIRECTED OUTPUT FOR SUBSET DATA TYPES" // 01020905 + 2 " ANS REF. - 13.6 12.4" ) 01030905 +CBB** ********************** BBCHED0B **********************************01040905 +C**** WRITE DETAIL REPORT HEADERS 01050905 +C**** 01060905 + WRITE (I02,90004) 01070905 + WRITE (I02,90004) 01080905 + WRITE (I02,90013) 01090905 + WRITE (I02,90014) 01100905 + WRITE (I02,90015) IVTOTL 01110905 +CBE** ********************** BBCHED0B **********************************01120905 + WRITE (NUVI, 70000) 01130905 +70000 FORMAT (" ",48X,"THE CORRECT LINE OF EACH TEST " / 01140905 + 1 " ",48X,"IS HOLLERITH INFORMATION. " / 01150905 + 2 " ",48X,"COLUMN SPACING, LINE BREAKS, " / 01160905 + 3 " ",48X,"AND THE NUMBER OF DECIMAL " / 01170905 + 4 " ",48X,"PLACES FOR REAL NUMBERS ARE " / 01180905 + 5 " ",48X,"PROCESSOR DEPENDENT. " / 01190905 + 6 " ",48X,"EITHER E OR F FORMAT MAY BE " / 01200905 + 7 " ",48X,"USED FOR REAL NUMBERS. " /) 01210905 +CT001* TEST 1 - INTEGER 01220905 + IVTNUM = 1 01230905 + WRITE (NUVI, 80004) IVTNUM 01240905 + WRITE (NUVI, 80020) 01250905 + IVI = 2 01260905 + WRITE(NUVI, *) IVI 01270905 + IVINSP = IVINSP + 1 01280905 + WRITE (NUVI, 80022) 01290905 + WRITE (NUVI, 70011) 01300905 +70011 FORMAT (" ",6X,"2") 01310905 +CT002* TEST 2 - SEVERAL INTEGERS 01320905 + IVTNUM = 2 01330905 + WRITE (NUVI, 80004) IVTNUM 01340905 + WRITE (NUVI, 80020) 01350905 + IVI = 1 01360905 + JVI = 3 01370905 + KVI = 5 01380905 + LVI = 7 01390905 + MVI = 9 01400905 + WRITE(NUVI, *) IVI, JVI, KVI, LVI, MVI 01410905 + IVINSP = IVINSP + 1 01420905 + WRITE (NUVI, 80022) 01430905 + WRITE (NUVI, 70021) 01440905 +70021 FORMAT (" ",6X,"1 3 5 7 9" ) 01450905 +CT003* TEST 3 - REAL 01460905 + IVTNUM = 3 01470905 + WRITE (NUVI, 80004) IVTNUM 01480905 + WRITE (NUVI, 80020) 01490905 + AVS = 2.5 01500905 + WRITE(NUVI, *) AVS 01510905 + IVINSP = IVINSP + 1 01520905 + WRITE (NUVI, 80022) 01530905 + WRITE (NUVI, 70031) 01540905 +70031 FORMAT (" ",6X,"2.5") 01550905 +CT004* TEST 4 - SEVERAL REALS 01560905 + IVTNUM = 4 01570905 + WRITE (NUVI, 80004) IVTNUM 01580905 + WRITE (NUVI, 80020) 01590905 + AVS = 0.25E-10 01600905 + BVS = 0.25 01610905 + CVS = 0.25E+3 01620905 + DVS = 0.25E+10 01630905 + WRITE(NUVI, *) AVS, BVS, CVS, DVS 01640905 + IVINSP = IVINSP + 1 01650905 + WRITE (NUVI, 80022) 01660905 + WRITE (NUVI, 70041) 01670905 +70041 FORMAT(" ",6X," 2.5E-11 0.25 250.0 2.5E+09" ) 01680905 +CT005* TEST 5 - IMPLIED-DO TO PRINT ARRAY OF LOGICALS 01690905 + IVTNUM = 5 01700905 + WRITE (NUVI, 80004) IVTNUM 01710905 + WRITE (NUVI, 80020) 01720905 + B1B(1) = .TRUE. 01730905 + B1B(2) = .FALSE. 01740905 + B1B(3) = .TRUE. 01750905 + WRITE(NUVI, *) (B1B(IVI), IVI = 1,3) 01760905 + IVINSP = IVINSP + 1 01770905 + WRITE (NUVI, 80022) 01780905 + WRITE (NUVI, 70051) 01790905 +70051 FORMAT(" ",6X,"T F T") 01800905 +CT006* TEST 6 - LIST OF CHARACTER VALUES, USING ARRAY NAME 01810905 + IVTNUM = 6 01820905 + WRITE (NUVI, 80004) IVTNUM 01830905 + WRITE (NUVI, 80020) 01840905 + A51K(1) = 'ONE ' 01850905 + A51K(2) = 'TWO ' 01860905 + A51K(3) = 'THREE' 01870905 + A51K(4) = 'FOUR ' 01880905 + WRITE(NUVI, *) A51K 01890905 + IVINSP = IVINSP + 1 01900905 + WRITE (NUVI, 80022) 01910905 + WRITE (NUVI, 70061) 01920905 +70061 FORMAT(" ",6X,"ONE TWO THREEFOUR " ) 01930905 +CT007* TEST 7 - MIXED LIST 01940905 + IVTNUM = 7 01950905 + WRITE (NUVI, 80004) IVTNUM 01960905 + WRITE (NUVI, 80020) 01970905 + IVI = -3 01980905 + AVS = 15.25 01990905 + AVB = .TRUE. 02000905 + A5VK = 'HELLO' 02010905 + WRITE(NUVI,*) IVI, AVS, A5VK, AVB 02020905 + IVINSP = IVINSP + 1 02030905 + WRITE (NUVI, 80022) 02040905 + WRITE (NUVI, 70071) 02050905 +70071 FORMAT(" ",6X,"-3 15.25 HELLO T" ) 02060905 +CT008* TEST 8 - CHARACTER CONSTANT CONTAINING EMBEDDED ' 02070905 + IVTNUM = 8 02080905 + WRITE (NUVI, 80004) IVTNUM 02090905 + WRITE (NUVI, 80020) 02100905 + A9VK = '5 O''CLOCK' 02110905 + WRITE(NUVI, *) A9VK 02120905 + IVINSP = IVINSP + 1 02130905 + WRITE (NUVI, 80022) 02140905 + WRITE (NUVI, 70081) 02150905 +70081 FORMAT(" ",6X,"5 O'CLOCK") 02160905 +CT009* TEST 9 - CHARACTER CONSTANT SPILLING OVER RECORD BOUNDARY 02170905 + IVTNUM = 9 02180905 + WRITE (NUVI, 80004) IVTNUM 02190905 + WRITE (NUVI, 80020) 02200905 + A5VK = 'SHORT' 02210905 + A33VK = 'THIS IS A LONGER CHARACTER STRING' 02220905 + A82VK = '123456789012345678901234567890123456789012345678901234502230905 + 167890123456789012' 02240905 + WRITE(NUVI, *) A5VK, A33VK, A82VK 02250905 + IVINSP = IVINSP + 1 02260905 + WRITE (NUVI, 80022) 02270905 + WRITE (NUVI, 70091) 02280905 +70091 FORMAT(" ", "SHORT THIS IS A LONGER CHARACTER STRING" , 02290905 + 1 " 123456789012345678901234567890123456789" / 02300905 + 2 " ","012345678901234567890123456789012" ) 02310905 +CT010* TEST 10 - SEVERAL IDENTICAL VALUES 02320905 + IVTNUM = 10 02330905 + WRITE (NUVI, 80004) IVTNUM 02340905 + WRITE (NUVI, 80020) 02350905 + IVI = 5 02360905 + JVI = 5 02370905 + KVI = 5 02380905 + LVI = 5 02390905 + MVI = 5 02400905 + WRITE(NUVI, *) IVI, JVI, KVI, LVI, MVI 02410905 + IVINSP = IVINSP + 1 02420905 + WRITE (NUVI, 80022) 02430905 + WRITE (NUVI, 70101) 02440905 +70101 FORMAT(" ",6X,"5 5 5 5 5 OR 5*5" ) 02450905 +CBB** ********************** BBCSUM0 **********************************02460905 +C**** WRITE OUT TEST SUMMARY 02470905 +C**** 02480905 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02490905 + WRITE (I02, 90004) 02500905 + WRITE (I02, 90014) 02510905 + WRITE (I02, 90004) 02520905 + WRITE (I02, 90020) IVPASS 02530905 + WRITE (I02, 90022) IVFAIL 02540905 + WRITE (I02, 90024) IVDELE 02550905 + WRITE (I02, 90026) IVINSP 02560905 + WRITE (I02, 90028) IVTOTN, IVTOTL 02570905 +CBE** ********************** BBCSUM0 **********************************02580905 +CBB** ********************** BBCFOOT0 **********************************02590905 +C**** WRITE OUT REPORT FOOTINGS 02600905 +C**** 02610905 + WRITE (I02,90016) ZPROG, ZPROG 02620905 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02630905 + WRITE (I02,90019) 02640905 +CBE** ********************** BBCFOOT0 **********************************02650905 +CBB** ********************** BBCFMT0A **********************************02660905 +C**** FORMATS FOR TEST DETAIL LINES 02670905 +C**** 02680905 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02690905 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02700905 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02710905 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02720905 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02730905 + 1I6,/," ",15X,"CORRECT= " ,I6) 02740905 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02750905 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02760905 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02770905 + 1A21,/," ",16X,"CORRECT= " ,A21) 02780905 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02790905 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02800905 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02810905 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02820905 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02830905 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02840905 +80050 FORMAT (" ",48X,A31) 02850905 +CBE** ********************** BBCFMT0A **********************************02860905 +CBB** ********************** BBCFMAT1 **********************************02870905 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02880905 +C**** 02890905 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02900905 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02910905 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02920905 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02930905 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02940905 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02950905 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02960905 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02970905 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02980905 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02990905 + 2"(",F12.5,", ",F12.5,")") 03000905 +CBE** ********************** BBCFMAT1 **********************************03010905 +CBB** ********************** BBCFMT0B **********************************03020905 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03030905 +C**** 03040905 +90002 FORMAT ("1") 03050905 +90004 FORMAT (" ") 03060905 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03070905 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03080905 +90008 FORMAT (" ",21X,A13,A17) 03090905 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03100905 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03110905 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03120905 + 1 7X,"REMARKS",24X) 03130905 +90014 FORMAT (" ","----------------------------------------------" , 03140905 + 1 "---------------------------------" ) 03150905 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03160905 +C**** 03170905 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03180905 +C**** 03190905 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03200905 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03210905 + 1 A13) 03220905 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03230905 +C**** 03240905 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03250905 +C**** 03260905 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03270905 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03280905 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03290905 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03300905 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03310905 +CBE** ********************** BBCFMT0B **********************************03320905 +C***** 03330905 +C***** END OF TEST SEGMENT 371 03340905 + STOP 03350905 + END 03360905 diff --git a/Fortran/UnitTests/fcvs21_f95/FM905.reference_output b/Fortran/UnitTests/fcvs21_f95/FM905.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM905.reference_output @@ -0,0 +1,92 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM905BEGIN* TEST RESULTS - FM905 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + LSTDO1 - (371) LIST DIRECTED OUTPUT FOR SUBSET DATA TYPES + + ANS REF. - 13.6 12.4 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 10 TESTS + + THE CORRECT LINE OF EACH TEST + IS HOLLERITH INFORMATION. + COLUMN SPACING, LINE BREAKS, + AND THE NUMBER OF DECIMAL + PLACES FOR REAL NUMBERS ARE + PROCESSOR DEPENDENT. + EITHER E OR F FORMAT MAY BE + USED FOR REAL NUMBERS. + + 1 INSPECT + COMPUTED= + 2 + CORRECT= + 2 + 2 INSPECT + COMPUTED= + 1 3 5 7 9 + CORRECT= + 1 3 5 7 9 + 3 INSPECT + COMPUTED= + 2.50000000 + CORRECT= + 2.5 + 4 INSPECT + COMPUTED= + 2.50000003E-11 0.250000000 250.000000 2.50000000E+09 + CORRECT= + 2.5E-11 0.25 250.0 2.5E+09 + 5 INSPECT + COMPUTED= + T F T + CORRECT= + T F T + 6 INSPECT + COMPUTED= + ONE TWO THREEFOUR + CORRECT= + ONE TWO THREEFOUR + 7 INSPECT + COMPUTED= + -3 15.2500000 HELLO T + CORRECT= + -3 15.25 HELLO T + 8 INSPECT + COMPUTED= + 5 O'CLOCK + CORRECT= + 5 O'CLOCK + 9 INSPECT + COMPUTED= + SHORTTHIS IS A LONGER CHARACTER STRING123456789012345678901234567890123456789012345678901234567890123456789012 + CORRECT= + SHORT THIS IS A LONGER CHARACTER STRING 123456789012345678901234567890123456789 + 012345678901234567890123456789012 + 10 INSPECT + COMPUTED= + 5 5 5 5 5 + CORRECT= + 5 5 5 5 5 OR 5*5 + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 10 TESTS REQUIRE INSPECTION + 10 OF 10 TESTS EXECUTED + + *FM905END* END OF TEST - FM905 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM906.f b/Fortran/UnitTests/fcvs21_f95/FM906.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM906.f @@ -0,0 +1,587 @@ + PROGRAM FM906 + +C***********************************************************************00010906 +C***** FORTRAN 77 00020906 +C***** FM906 00030906 +C***** LSTDI2 - (372) 00040906 +C***** 00050906 +C***********************************************************************00060906 +C***** GENERAL PURPOSE ANS REF 00070906 +C***** TEST LIST DIRECTED INPUT 13.6 00080906 +C***** DOUBLE PRECISION, COMPLEX DATA TYPES INCLUDED 12.4 00090906 +C***** 00100906 +CBB** ********************** BBCCOMNT **********************************00110906 +C**** 00120906 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130906 +C**** VERSION 2.1 00140906 +C**** 00150906 +C**** 00160906 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170906 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180906 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190906 +C**** BUILDING 225 RM A266 00200906 +C**** GAITHERSBURG, MD 20899 00210906 +C**** 00220906 +C**** 00230906 +C**** 00240906 +CBE** ********************** BBCCOMNT **********************************00250906 +C***** 00260906 +C INPUT DATA TO THIS SEGMENT CONSISTS OF 12 CARD IMAGES IN COL. 1-44 00270906 +COL. 1-----------------------------------------44 00280906 +CARD 1 2.5D0 00290906 +CARD 2 1.5 2.5D0 3.5E0 00300906 +CARD 3 (3.0,4.0) 00310906 +CARD 4 (1.0,0.0) (0.0,0.0) (0.0,3.0) 00320906 +CARD 5 2, 2.5D0, 2.5D0, T, (3.0,4.0), 'TEST' 00330906 +CARD 6 ( 2.5 , 3.5 ) 00340906 +CARD 7 (1.0 , 00350906 +CARD 8 2.0) 00360906 +CARD 9 , (2.0, 3.0),,6.0D0, 2*, 00370906 +CARD 10 1.0D0 (2.0, 2.0) 3.0D0 (4.0, 4.0) 5.0D0 00380906 +CARD 11 6.0D0 (7.0, 7.0) / 8.0D0 (9.0, 9.0) 10.0D0 00390906 +CARD 12 2.0D0 4.0D0 / 6.0D0 8.0D0 10.0D0 00400906 +C***** 00410906 +C***** S P E C I F I C A T I O N S SEGMENT 372 00420906 + LOGICAL AVB 00430906 + CHARACTER A4VK*4,CVCORR*4 00440906 + DOUBLE PRECISION AVD, BVD, CVD, DVCORR 00450906 + DOUBLE PRECISION A1D(4) 00460906 + COMPLEX AVC, BVC, CVC, ZVCORR 00470906 + REAL R2E(6) 00480906 + EQUIVALENCE (AVC,R2E(1)),(BVC,R2E(3)),(CVC,R2E(5)) 00490906 +C***** 00500906 +CBB** ********************** BBCINITA **********************************00510906 +C**** SPECIFICATION STATEMENTS 00520906 +C**** 00530906 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00540906 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00550906 +CBE** ********************** BBCINITA **********************************00560906 +CBB** ********************** BBCINITB **********************************00570906 +C**** INITIALIZE SECTION 00580906 + DATA ZVERS, ZVERSD, ZDATE 00590906 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00600906 + DATA ZCOMPL, ZNAME, ZTAPE 00610906 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00620906 + DATA ZPROJ, ZTAPED, ZPROG 00630906 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00640906 + DATA REMRKS /' '/ 00650906 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00660906 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00670906 +C**** 00680906 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00690906 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00700906 +CZ03 ZPROG = 'PROGRAM NAME' 00710906 +CZ04 ZDATE = 'DATE OF TEST' 00720906 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00730906 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00740906 +CZ07 ZNAME = 'NAME OF USER' 00750906 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00760906 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00770906 +C 00780906 + IVPASS = 0 00790906 + IVFAIL = 0 00800906 + IVDELE = 0 00810906 + IVINSP = 0 00820906 + IVTOTL = 0 00830906 + IVTOTN = 0 00840906 + ICZERO = 0 00850906 +C 00860906 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00870906 + I01 = 05 00880906 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00890906 + I02 = 06 00900906 +C 00910906 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00920906 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00930906 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00940906 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00950906 +C 00960906 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00970906 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00980906 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00990906 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 01000906 +C 01010906 +CBE** ********************** BBCINITB **********************************01020906 + IRVI = I01 01030906 + NUVI = I02 01040906 + IVTOTL = 28 01050906 + ZPROG = 'FM906' 01060906 +CBB** ********************** BBCHED0A **********************************01070906 +C**** 01080906 +C**** WRITE REPORT TITLE 01090906 +C**** 01100906 + WRITE (I02, 90002) 01110906 + WRITE (I02, 90006) 01120906 + WRITE (I02, 90007) 01130906 + WRITE (I02, 90008) ZVERS, ZVERSD 01140906 + WRITE (I02, 90009) ZPROG, ZPROG 01150906 + WRITE (I02, 90010) ZDATE, ZCOMPL 01160906 +CBE** ********************** BBCHED0A **********************************01170906 +C***** 01180906 +C***** HEADING FOR SEGMENT 372 01190906 + WRITE(NUVI,37200) 01200906 +37200 FORMAT(" ", /" LSTDI2 - (372) " , 01210906 + 1 " LIST DIRECTED INPUT" , 01220906 + 2 " FOR D.P. AND COMPLEX DATA TYPES" // 01230906 + 3 " ANS REF. - 13.6 12.4" ) 01240906 +CBB** ********************** BBCHED0B **********************************01250906 +C**** WRITE DETAIL REPORT HEADERS 01260906 +C**** 01270906 + WRITE (I02,90004) 01280906 + WRITE (I02,90004) 01290906 + WRITE (I02,90013) 01300906 + WRITE (I02,90014) 01310906 + WRITE (I02,90015) IVTOTL 01320906 +CBE** ********************** BBCHED0B **********************************01330906 +CT001* TEST 1 - CARD 1 DOUBLE PRECISION 01340906 + IVTNUM = 1 01350906 + READ(IRVI, *) AVD 01360906 + IF (AVD - 0.2499999998D+01) 20010, 10010, 40010 01370906 +40010 IF (AVD - 0.2500000002D+01) 10010, 10010, 20010 01380906 +10010 IVPASS = IVPASS + 1 01390906 + WRITE (NUVI, 80002) IVTNUM 01400906 + GO TO 0011 01410906 +20010 IVFAIL = IVFAIL + 1 01420906 + DVCORR = 2.5D0 01430906 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01440906 + 0011 CONTINUE 01450906 +C***** TESTS 2 THRU 4 - CARD 2 SEVERAL DOUBLE PRECISION 01460906 +CT002* TEST 2 01470906 + IVTNUM = 2 01480906 + READ(IRVI, *) AVD, BVD, CVD 01490906 + IF (AVD - 0.1499999999D+01) 20020, 10020, 40020 01500906 +40020 IF (AVD - 0.1500000001D+01) 10020, 10020, 20020 01510906 +10020 IVPASS = IVPASS + 1 01520906 + WRITE (NUVI, 80002) IVTNUM 01530906 + GO TO 0021 01540906 +20020 IVFAIL = IVFAIL + 1 01550906 + DVCORR = 1.5D0 01560906 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01570906 + 0021 CONTINUE 01580906 +CT003* TEST 3 01590906 + IVTNUM = 3 01600906 + IF (BVD - 0.2499999998D+01) 20030, 10030, 40030 01610906 +40030 IF (BVD - 0.2500000002D+01) 10030, 10030, 20030 01620906 +10030 IVPASS = IVPASS + 1 01630906 + WRITE (NUVI, 80002) IVTNUM 01640906 + GO TO 0031 01650906 +20030 IVFAIL = IVFAIL + 1 01660906 + DVCORR = 2.5D0 01670906 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 01680906 + 0031 CONTINUE 01690906 +CT004* TEST 4 01700906 + IVTNUM = 4 01710906 + IF (CVD - 0.3499999998D+01) 20040, 10040, 40040 01720906 +40040 IF (CVD - 0.3500000002D+01) 10040, 10040, 20040 01730906 +10040 IVPASS = IVPASS + 1 01740906 + WRITE (NUVI, 80002) IVTNUM 01750906 + GO TO 0041 01760906 +20040 IVFAIL = IVFAIL + 1 01770906 + DVCORR = 3.5D0 01780906 + WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR 01790906 + 0041 CONTINUE 01800906 +CT005* TEST 5 - CARD 3 COMPLEX 01810906 + IVTNUM = 5 01820906 + READ(IRVI, *) AVC 01830906 + IF (R2E(1) - 0.29998E+01) 20050, 40052, 40051 01840906 +40051 IF (R2E(1) - 0.30002E+01) 40052, 40052, 20050 01850906 +40052 IF (R2E(2) - 0.39998E+01) 20050, 10050, 40050 01860906 +40050 IF (R2E(2) - 0.40002E+01) 10050, 10050, 20050 01870906 +10050 IVPASS = IVPASS + 1 01880906 + WRITE (NUVI, 80002) IVTNUM 01890906 + GO TO 0051 01900906 +20050 IVFAIL = IVFAIL + 1 01910906 + ZVCORR = (3.0, 4.0) 01920906 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 01930906 + 0051 CONTINUE 01940906 +C***** TESTS 6 THRU 8 - CARD 4 SEVERAL COMPLEX 01950906 +CT006* TEST 6 01960906 + IVTNUM = 6 01970906 + READ(IRVI, *) AVC, BVC, CVC 01980906 + IF (R2E(1) - 0.99995E+00) 20060, 40062, 40061 01990906 +40061 IF (R2E(1) - 0.10001E+01) 40062, 40062, 20060 02000906 +40062 IF (R2E(2) + 0.50000E-04) 20060, 10060, 40060 02010906 +40060 IF (R2E(2) - 0.50000E-04) 10060, 10060, 20060 02020906 +10060 IVPASS = IVPASS + 1 02030906 + WRITE (NUVI, 80002) IVTNUM 02040906 + GO TO 0061 02050906 +20060 IVFAIL = IVFAIL + 1 02060906 + ZVCORR = (1.0, 0.0) 02070906 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 02080906 + 0061 CONTINUE 02090906 +CT007* TEST 7 02100906 + IVTNUM = 7 02110906 + IF (R2E(3) + 0.50000E-04) 20070, 40072, 40071 02120906 +40071 IF (R2E(3) - 0.50000E-04) 40072, 40072, 20070 02130906 +40072 IF (R2E(4) + 0.50000E-04) 20070, 10070, 40070 02140906 +40070 IF (R2E(4) - 0.50000E-04) 10070, 10070, 20070 02150906 +10070 IVPASS = IVPASS + 1 02160906 + WRITE (NUVI, 80002) IVTNUM 02170906 + GO TO 0071 02180906 +20070 IVFAIL = IVFAIL + 1 02190906 + ZVCORR = (0.0, 0.0) 02200906 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 02210906 + 0071 CONTINUE 02220906 +CT008* TEST 8 02230906 + IVTNUM = 8 02240906 + IF (R2E(5) + 0.50000E-04) 20080, 40082, 40081 02250906 +40081 IF (R2E(5) - 0.50000E-04) 40082, 40082, 20080 02260906 +40082 IF (R2E(6) - 0.29998E+01) 20080, 10080, 40080 02270906 +40080 IF (R2E(6) - 0.30002E+01) 10080, 10080, 20080 02280906 +10080 IVPASS = IVPASS + 1 02290906 + WRITE (NUVI, 80002) IVTNUM 02300906 + GO TO 0081 02310906 +20080 IVFAIL = IVFAIL + 1 02320906 + ZVCORR = (0.0, 3.0) 02330906 + WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR 02340906 + 0081 CONTINUE 02350906 +C***** TESTS 9 THRU 14 - CARD 5 MIXED LIST 02360906 +CT009* TEST 9 02370906 + IVTNUM = 9 02380906 + READ(IRVI, *) IVI, AVD, AVS, AVB, AVC, A4VK 02390906 + IF (IVI - 2) 20090, 10090, 20090 02400906 +10090 IVPASS = IVPASS + 1 02410906 + WRITE (NUVI, 80002) IVTNUM 02420906 + GO TO 0091 02430906 +20090 IVFAIL = IVFAIL + 1 02440906 + IVCORR = 2 02450906 + WRITE (NUVI, 80010) IVTNUM, IVI, IVCORR 02460906 + 0091 CONTINUE 02470906 +CT010* TEST 10 02480906 + IVTNUM = 10 02490906 + IF (AVD - 0.2499999998D+01) 20100, 10100, 40100 02500906 +40100 IF (AVD - 0.2500000002D+01) 10100, 10100, 20100 02510906 +10100 IVPASS = IVPASS + 1 02520906 + WRITE (NUVI, 80002) IVTNUM 02530906 + GO TO 0101 02540906 +20100 IVFAIL = IVFAIL + 1 02550906 + DVCORR = 2.5D0 02560906 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02570906 + 0101 CONTINUE 02580906 +CT011* TEST 11 02590906 + IVTNUM = 11 02600906 + IF (AVS - 0.24998E+01) 20110, 10110, 40110 02610906 +40110 IF (AVS - 0.25002E+01) 10110, 10110, 20110 02620906 +10110 IVPASS = IVPASS + 1 02630906 + WRITE (NUVI, 80002) IVTNUM 02640906 + GO TO 0111 02650906 +20110 IVFAIL = IVFAIL + 1 02660906 + RVCORR = 2.5 02670906 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 02680906 + 0111 CONTINUE 02690906 +CT012* TEST 12 02700906 + IVTNUM = 12 02710906 + IVCOMP = 0 02720906 + IF (AVB) IVCOMP = 1 02730906 + IF (IVCOMP - 1) 20120, 10120, 20120 02740906 +10120 IVPASS = IVPASS + 1 02750906 + WRITE (NUVI, 80002) IVTNUM 02760906 + GO TO 0121 02770906 +20120 IVFAIL = IVFAIL + 1 02780906 + LVCORR = 1 02790906 + REMRKS = '1 = TRUE ; 0 = FALSE' 02800906 + WRITE (NUVI, 80008) IVTNUM, REMRKS 02810906 + WRITE (NUVI, 80024) IVCOMP 02820906 + WRITE (NUVI, 80026) LVCORR 02830906 + 0121 CONTINUE 02840906 +C***** ADVANCE TO TOP-OF-PAGE AND WRITE HEADERS 02850906 + WRITE (NUVI, 90002) 02860906 + WRITE (NUVI, 90013) 02870906 + WRITE (NUVI, 90014) 02880906 +CT013* TEST 13 02890906 + IVTNUM = 13 02900906 + IF (R2E(1) - 0.29998E+01) 20130, 40132, 40131 02910906 +40131 IF (R2E(1) - 0.30002E+01) 40132, 40132, 20130 02920906 +40132 IF (R2E(2) - 0.39998E+01) 20130, 10130, 40130 02930906 +40130 IF (R2E(2) - 0.40002E+01) 10130, 10130, 20130 02940906 +10130 IVPASS = IVPASS + 1 02950906 + WRITE (NUVI, 80002) IVTNUM 02960906 + GO TO 0131 02970906 +20130 IVFAIL = IVFAIL + 1 02980906 + ZVCORR = (3.0, 4.0) 02990906 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 03000906 + 0131 CONTINUE 03010906 +CT014* TEST 14 03020906 + IVTNUM = 14 03030906 + IVCOMP = 0 03040906 + IF (A4VK.EQ.'TEST') IVCOMP = 1 03050906 + IF (IVCOMP - 1) 20140, 10140, 20140 03060906 +10140 IVPASS = IVPASS + 1 03070906 + WRITE (NUVI, 80002) IVTNUM 03080906 + GO TO 0141 03090906 +20140 IVFAIL = IVFAIL + 1 03100906 + CVCORR = 'TEST' 03110906 + WRITE (NUVI, 80018) IVTNUM, A4VK, CVCORR 03120906 + 0141 CONTINUE 03130906 +CT015* TEST 15 - CARD 6 COMPLEX CONSTANT W/EMBEDDED BLANKS 03140906 + IVTNUM = 15 03150906 + READ(IRVI, *) AVC 03160906 + IF (R2E(1) - 0.24998E+01) 20150, 40152, 40151 03170906 +40151 IF (R2E(1) - 0.25002E+01) 40152, 40152, 20150 03180906 +40152 IF (R2E(2) - 0.34998E+01) 20150, 10150, 40150 03190906 +40150 IF (R2E(2) - 0.35002E+01) 10150, 10150, 20150 03200906 +10150 IVPASS = IVPASS + 1 03210906 + WRITE (NUVI, 80002) IVTNUM 03220906 + GO TO 0151 03230906 +20150 IVFAIL = IVFAIL + 1 03240906 + ZVCORR = (2.5, 3.5) 03250906 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 03260906 + 0151 CONTINUE 03270906 +CT016* TEST 16 - CARDS 7-8 COMPLEX WITH EMBEDDED END-OF-RECORD 03280906 + IVTNUM = 16 03290906 + READ(IRVI, *) AVC 03300906 + IF (R2E(1) - 0.99995E+00) 20160, 40162, 40161 03310906 +40161 IF (R2E(1) - 0.10001E+01) 40162, 40162, 20160 03320906 +40162 IF (R2E(2) - 0.19999E+01) 20160, 10160, 40160 03330906 +40160 IF (R2E(2) - 0.20001E+01) 10160, 10160, 20160 03340906 +10160 IVPASS = IVPASS + 1 03350906 + WRITE (NUVI, 80002) IVTNUM 03360906 + GO TO 0161 03370906 +20160 IVFAIL = IVFAIL + 1 03380906 + ZVCORR = (1.0, 2.0) 03390906 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 03400906 + 0161 CONTINUE 03410906 +C***** TESTS 17 THRU 22 - CARD 9 NULL VALUES 03420906 +CT017* TEST 17 03430906 + IVTNUM = 17 03440906 + AVD = 1.0D0 03450906 + BVC = (4.0, 5.0) 03460906 + CVC = (7.0, 8.0) 03470906 + CVD = 9.0D0 03480906 + READ(IRVI, *) AVD, AVC, BVC, BVD, CVC, CVD 03490906 + IF (AVD - 0.9999999995D+00) 20170, 10170, 40170 03500906 +40170 IF (AVD - 0.1000000001D+01) 10170, 10170, 20170 03510906 +10170 IVPASS = IVPASS + 1 03520906 + WRITE (NUVI, 80002) IVTNUM 03530906 + GO TO 0171 03540906 +20170 IVFAIL = IVFAIL + 1 03550906 + DVCORR = 1.0D0 03560906 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03570906 + 0171 CONTINUE 03580906 +CT018* TEST 18 03590906 + IVTNUM = 18 03600906 + IF (R2E(1) - 0.19999E+01) 20180, 40182, 40181 03610906 +40181 IF (R2E(1) - 0.20001E+01) 40182, 40182, 20180 03620906 +40182 IF (R2E(2) - 0.29998E+01) 20180, 10180, 40180 03630906 +40180 IF (R2E(2) - 0.30002E+01) 10180, 10180, 20180 03640906 +10180 IVPASS = IVPASS + 1 03650906 + WRITE (NUVI, 80002) IVTNUM 03660906 + GO TO 0181 03670906 +20180 IVFAIL = IVFAIL + 1 03680906 + ZVCORR = (2.0, 3.0) 03690906 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 03700906 + 0181 CONTINUE 03710906 +CT019* TEST 19 03720906 + IVTNUM = 19 03730906 + IF (R2E(3) - 0.39998E+01) 20190, 40192, 40191 03740906 +40191 IF (R2E(3) - 0.40002E+01) 40192, 40192, 20190 03750906 +40192 IF (R2E(4) - 0.49997E+01) 20190, 10190, 40190 03760906 +40190 IF (R2E(4) - 0.50003E+01) 10190, 10190, 20190 03770906 +10190 IVPASS = IVPASS + 1 03780906 + WRITE (NUVI, 80002) IVTNUM 03790906 + GO TO 0191 03800906 +20190 IVFAIL = IVFAIL + 1 03810906 + ZVCORR = (4.0, 5.0) 03820906 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 03830906 + 0191 CONTINUE 03840906 +CT020* TEST 20 03850906 + IVTNUM = 20 03860906 + IF (BVD - 0.5999999997D+01) 20200, 10200, 40200 03870906 +40200 IF (BVD - 0.6000000003D+01) 10200, 10200, 20200 03880906 +10200 IVPASS = IVPASS + 1 03890906 + WRITE (NUVI, 80002) IVTNUM 03900906 + GO TO 0201 03910906 +20200 IVFAIL = IVFAIL + 1 03920906 + DVCORR = 6.0D0 03930906 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 03940906 + 0201 CONTINUE 03950906 +CT021* TEST 21 03960906 + IVTNUM = 21 03970906 + IF (R2E(5) - 0.69996E+01) 20210, 40212, 40211 03980906 +40211 IF (R2E(5) - 0.70004E+01) 40212, 40212, 20210 03990906 +40212 IF (R2E(6) - 0.79996E+01) 20210, 10210, 40210 04000906 +40210 IF (R2E(6) - 0.80004E+01) 10210, 10210, 20210 04010906 +10210 IVPASS = IVPASS + 1 04020906 + WRITE (NUVI, 80002) IVTNUM 04030906 + GO TO 0211 04040906 +20210 IVFAIL = IVFAIL + 1 04050906 + ZVCORR = (7.0, 8.0) 04060906 + WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR 04070906 + 0211 CONTINUE 04080906 +CT022* TEST 22 04090906 + IVTNUM = 22 04100906 + IF (CVD - 0.8999999995D+01) 20220, 10220, 40220 04110906 +40220 IF (CVD - 0.9000000005D+01) 10220, 10220, 20220 04120906 +10220 IVPASS = IVPASS + 1 04130906 + WRITE (NUVI, 80002) IVTNUM 04140906 + GO TO 0221 04150906 +20220 IVFAIL = IVFAIL + 1 04160906 + DVCORR = 9.0D0 04170906 + WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR 04180906 + 0221 CONTINUE 04190906 +C***** TESTS 23 THRU 27 - CARDS 10-11 SLASH TERMINATOR 04200906 +CT023* TEST 23 04210906 + IVTNUM = 23 04220906 + READ(IRVI, *) AVD, AVC, BVD, BVC, CVD 04230906 + READ(IRVI, *) AVD, AVC, BVD, BVC, CVD 04240906 + IF (AVD - 0.5999999997D+01) 20230, 10230, 40230 04250906 +40230 IF (AVD - 0.6000000003D+01) 10230, 10230, 20230 04260906 +10230 IVPASS = IVPASS + 1 04270906 + WRITE (NUVI, 80002) IVTNUM 04280906 + GO TO 0231 04290906 +20230 IVFAIL = IVFAIL + 1 04300906 + DVCORR = 6.0D0 04310906 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 04320906 + 0231 CONTINUE 04330906 +CT024* TEST 24 04340906 + IVTNUM = 24 04350906 + IF (R2E(1) - 0.69996E+01) 20240, 40242, 40241 04360906 +40241 IF (R2E(1) - 0.70004E+01) 40242, 40242, 20240 04370906 +40242 IF (R2E(2) - 0.69996E+01) 20240, 10240, 40240 04380906 +40240 IF (R2E(2) - 0.70004E+01) 10240, 10240, 20240 04390906 +10240 IVPASS = IVPASS + 1 04400906 + WRITE (NUVI, 80002) IVTNUM 04410906 + GO TO 0241 04420906 +20240 IVFAIL = IVFAIL + 1 04430906 + ZVCORR = (7.0, 7.0) 04440906 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 04450906 + 0241 CONTINUE 04460906 +CT025* TEST 25 04470906 + IVTNUM = 25 04480906 + IF (BVD - 0.2999999998D+01) 20250, 10250, 40250 04490906 +40250 IF (BVD - 0.3000000002D+01) 10250, 10250, 20250 04500906 +10250 IVPASS = IVPASS + 1 04510906 + WRITE (NUVI, 80002) IVTNUM 04520906 + GO TO 0251 04530906 +20250 IVFAIL = IVFAIL + 1 04540906 + DVCORR = 3.0D0 04550906 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 04560906 + 0251 CONTINUE 04570906 +CT026* TEST 26 04580906 + IVTNUM = 26 04590906 + IF (R2E(3) - 0.39998E+01) 20260, 40262, 40261 04600906 +40261 IF (R2E(3) - 0.40002E+01) 40262, 40262, 20260 04610906 +40262 IF (R2E(4) - 0.39998E+01) 20260, 10260, 40260 04620906 +40260 IF (R2E(4) - 0.40002E+01) 10260, 10260, 20260 04630906 +10260 IVPASS = IVPASS + 1 04640906 + WRITE (NUVI, 80002) IVTNUM 04650906 + GO TO 0261 04660906 +20260 IVFAIL = IVFAIL + 1 04670906 + ZVCORR = (4.0, 4.0) 04680906 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 04690906 + 0261 CONTINUE 04700906 +CT027* TEST 27 04710906 + IVTNUM = 27 04720906 + IF (CVD - 0.4999999997D+01) 20270, 10270, 40270 04730906 +40270 IF (CVD - 0.5000000003D+01) 10270, 10270, 20270 04740906 +10270 IVPASS = IVPASS + 1 04750906 + WRITE (NUVI, 80002) IVTNUM 04760906 + GO TO 0271 04770906 +20270 IVFAIL = IVFAIL + 1 04780906 + DVCORR = 5.0D0 04790906 + WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR 04800906 + 0271 CONTINUE 04810906 +CT028* TEST 28 04820906 + IVTNUM = 28 04830906 + A1D(3) = 3.0D0 04840906 + READ(IRVI, *) (A1D(IVI), IVI=1,4) 04850906 + IF (A1D(3) - 0.2999999998D+01) 20280, 10280, 40280 04860906 +40280 IF (A1D(3) - 0.3000000002D+01) 10280, 10280, 20280 04870906 +10280 IVPASS = IVPASS + 1 04880906 + WRITE (NUVI, 80002) IVTNUM 04890906 + GO TO 0281 04900906 +20280 IVFAIL = IVFAIL + 1 04910906 + DVCORR = 3.0D0 04920906 + WRITE (NUVI, 80031) IVTNUM, A1D(3), DVCORR 04930906 + 0281 CONTINUE 04940906 +CBB** ********************** BBCSUM0 **********************************04950906 +C**** WRITE OUT TEST SUMMARY 04960906 +C**** 04970906 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04980906 + WRITE (I02, 90004) 04990906 + WRITE (I02, 90014) 05000906 + WRITE (I02, 90004) 05010906 + WRITE (I02, 90020) IVPASS 05020906 + WRITE (I02, 90022) IVFAIL 05030906 + WRITE (I02, 90024) IVDELE 05040906 + WRITE (I02, 90026) IVINSP 05050906 + WRITE (I02, 90028) IVTOTN, IVTOTL 05060906 +CBE** ********************** BBCSUM0 **********************************05070906 +CBB** ********************** BBCFOOT0 **********************************05080906 +C**** WRITE OUT REPORT FOOTINGS 05090906 +C**** 05100906 + WRITE (I02,90016) ZPROG, ZPROG 05110906 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 05120906 + WRITE (I02,90019) 05130906 +CBE** ********************** BBCFOOT0 **********************************05140906 +CBB** ********************** BBCFMT0A **********************************05150906 +C**** FORMATS FOR TEST DETAIL LINES 05160906 +C**** 05170906 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 05180906 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 05190906 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 05200906 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 05210906 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 05220906 + 1I6,/," ",15X,"CORRECT= " ,I6) 05230906 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05240906 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 05250906 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05260906 + 1A21,/," ",16X,"CORRECT= " ,A21) 05270906 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 05280906 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 05290906 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 05300906 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 05310906 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 05320906 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 05330906 +80050 FORMAT (" ",48X,A31) 05340906 +CBE** ********************** BBCFMT0A **********************************05350906 +CBB** ********************** BBCFMAT1 **********************************05360906 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 05370906 +C**** 05380906 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05390906 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 05400906 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 05410906 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 05420906 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05430906 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 05440906 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 05450906 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 05460906 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 05470906 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 05480906 + 2"(",F12.5,", ",F12.5,")") 05490906 +CBE** ********************** BBCFMAT1 **********************************05500906 +CBB** ********************** BBCFMT0B **********************************05510906 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 05520906 +C**** 05530906 +90002 FORMAT ("1") 05540906 +90004 FORMAT (" ") 05550906 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )05560906 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 05570906 +90008 FORMAT (" ",21X,A13,A17) 05580906 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 05590906 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 05600906 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 05610906 + 1 7X,"REMARKS",24X) 05620906 +90014 FORMAT (" ","----------------------------------------------" , 05630906 + 1 "---------------------------------" ) 05640906 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 05650906 +C**** 05660906 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 05670906 +C**** 05680906 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 05690906 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 05700906 + 1 A13) 05710906 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 05720906 +C**** 05730906 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 05740906 +C**** 05750906 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 05760906 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 05770906 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 05780906 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 05790906 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 05800906 +CBE** ********************** BBCFMT0B **********************************05810906 +C***** 05820906 +C***** END OF TEST SEGMENT 372 05830906 + STOP 05840906 + END 05850906 diff --git a/Fortran/UnitTests/fcvs21_f95/FM906.reference_input b/Fortran/UnitTests/fcvs21_f95/FM906.reference_input new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM906.reference_input @@ -0,0 +1,13 @@ +2.5D0 +1.5 2.5D0 3.5E0 +(3.0,4.0) +(1.0,0.0) (0.0,0.0) (0.0,3.0) +2, 2.5D0, 2.5D0, T, (3.0,4.0), 'TEST' +( 2.5 , 3.5 ) +(1.0 , + 2.0) +, (2.0, 3.0),,6.0D0, 2*, +1.0D0 (2.0, 2.0) 3.0D0 (4.0, 4.0) 5.0D0 +6.0D0 (7.0, 7.0) / 8.0D0 (9.0, 9.0) 10.0D0 +2.0D0 4.0D0 / 6.0D0 8.0D0 10.0D0 + diff --git a/Fortran/UnitTests/fcvs21_f95/FM906.reference_output b/Fortran/UnitTests/fcvs21_f95/FM906.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM906.reference_output @@ -0,0 +1,63 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM906BEGIN* TEST RESULTS - FM906 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + LSTDI2 - (372) LIST DIRECTED INPUT FOR D.P. AND COMPLEX DATA TYPES + + ANS REF. - 13.6 12.4 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 28 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + 28 PASS + + ------------------------------------------------------------------------------- + + 28 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 28 OF 28 TESTS EXECUTED + + *FM906END* END OF TEST - FM906 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM907.f b/Fortran/UnitTests/fcvs21_f95/FM907.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM907.f @@ -0,0 +1,311 @@ + PROGRAM FM907 + +C***********************************************************************00010907 +C***** FORTRAN 77 00020907 +C***** FM907 00030907 +C***** LSTDO2 - (373) 00040907 +C***** 00050907 +C***********************************************************************00060907 +C***** GENERAL PURPOSE ANS REF 00070907 +C***** TEST LIST DIRECTED OUTPUT 13.6 00080907 +C***** DOUBLE PRECISION AND COMPLEX DATA TYPES INCLUDED 12.4 00090907 +C***** 00100907 +CBB** ********************** BBCCOMNT **********************************00110907 +C**** 00120907 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130907 +C**** VERSION 2.1 00140907 +C**** 00150907 +C**** 00160907 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170907 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180907 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190907 +C**** BUILDING 225 RM A266 00200907 +C**** GAITHERSBURG, MD 20899 00210907 +C**** 00220907 +C**** 00230907 +C**** 00240907 +CBE** ********************** BBCCOMNT **********************************00250907 +C***** 00260907 +C***** S P E C I F I C A T I O N S SEGMENT 373 00270907 + DOUBLE PRECISION AVD, BVD, CVD 00280907 + COMPLEX AVC, BVC, CVC, DVC 00290907 + CHARACTER A4VK*4 00300907 +C***** 00310907 +CBB** ********************** BBCINITA **********************************00320907 +C**** SPECIFICATION STATEMENTS 00330907 +C**** 00340907 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350907 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360907 +CBE** ********************** BBCINITA **********************************00370907 +CBB** ********************** BBCINITB **********************************00380907 +C**** INITIALIZE SECTION 00390907 + DATA ZVERS, ZVERSD, ZDATE 00400907 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410907 + DATA ZCOMPL, ZNAME, ZTAPE 00420907 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430907 + DATA ZPROJ, ZTAPED, ZPROG 00440907 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450907 + DATA REMRKS /' '/ 00460907 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470907 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480907 +C**** 00490907 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500907 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510907 +CZ03 ZPROG = 'PROGRAM NAME' 00520907 +CZ04 ZDATE = 'DATE OF TEST' 00530907 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540907 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550907 +CZ07 ZNAME = 'NAME OF USER' 00560907 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570907 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580907 +C 00590907 + IVPASS = 0 00600907 + IVFAIL = 0 00610907 + IVDELE = 0 00620907 + IVINSP = 0 00630907 + IVTOTL = 0 00640907 + IVTOTN = 0 00650907 + ICZERO = 0 00660907 +C 00670907 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680907 + I01 = 05 00690907 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700907 + I02 = 06 00710907 +C 00720907 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730907 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740907 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750907 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760907 +C 00770907 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780907 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790907 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800907 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810907 +C 00820907 +CBE** ********************** BBCINITB **********************************00830907 + NUVI = I02 00840907 + IVTOTL = 8 00850907 + ZPROG = 'FM907' 00860907 +CBB** ********************** BBCHED0A **********************************00870907 +C**** 00880907 +C**** WRITE REPORT TITLE 00890907 +C**** 00900907 + WRITE (I02, 90002) 00910907 + WRITE (I02, 90006) 00920907 + WRITE (I02, 90007) 00930907 + WRITE (I02, 90008) ZVERS, ZVERSD 00940907 + WRITE (I02, 90009) ZPROG, ZPROG 00950907 + WRITE (I02, 90010) ZDATE, ZCOMPL 00960907 +CBE** ********************** BBCHED0A **********************************00970907 +C***** 00980907 +C***** HEADING FOR SEGMENT 373 00990907 + WRITE(NUVI,37300) 01000907 +37300 FORMAT(" ", /" LSTDO2 - (373) " , 01010907 + 1 " LIST DIRECTED OUTPUT" , 01020907 + 2 " FOR D.P. AND COMPLEX DATA TYPES" // 01030907 + 3 " ANS REF. - 13.6 12.4" ) 01040907 +CBB** ********************** BBCHED0B **********************************01050907 +C**** WRITE DETAIL REPORT HEADERS 01060907 +C**** 01070907 + WRITE (I02,90004) 01080907 + WRITE (I02,90004) 01090907 + WRITE (I02,90013) 01100907 + WRITE (I02,90014) 01110907 + WRITE (I02,90015) IVTOTL 01120907 +CBE** ********************** BBCHED0B **********************************01130907 + WRITE (NUVI, 70000) 01140907 +70000 FORMAT (" ",48X,"THE CORRECT LINE OF EACH TEST " / 01150907 + 1 " ",48X,"IS HOLLERITH INFORMATION. " / 01160907 + 2 " ",48X,"COLUMN SPACING, LINE BREAKS, " / 01170907 + 3 " ",48X,"AND THE NUMBER OF DECIMAL " / 01180907 + 4 " ",48X,"PLACES FOR DOUBLE PRECISION " / 01190907 + 5 " ",48X,"OR COMPLEX NUMBERS ARE " / 01200907 + 6 " ",48X,"PROCESSOR DEPENDENT. " / 01210907 + 7 " ",48X,"EITHER E OR F FORMAT MAY BE " / 01220907 + 8 " ",48X,"USED FOR DOUBLE PRECISION OR " / 01230907 + 9 " ",48X,"COMPLEX NUMBERS. " /) 01240907 +CT001* TEST 1 - DOUBLE PRECISION 01250907 + IVTNUM = 1 01260907 + WRITE (NUVI, 80004) IVTNUM 01270907 + WRITE (NUVI, 80020) 01280907 + AVD = 2.5D0 01290907 + WRITE(NUVI, *) AVD 01300907 + IVINSP = IVINSP + 1 01310907 + WRITE (NUVI, 80022) 01320907 + WRITE (NUVI, 70011) 01330907 +70011 FORMAT (" ",6X,"2.5") 01340907 +CT002* TEST 2 - COMPLEX 01350907 + IVTNUM = 2 01360907 + WRITE (NUVI, 80004) IVTNUM 01370907 + WRITE (NUVI, 80020) 01380907 + AVC = (3.0, 4.0) 01390907 + WRITE(NUVI, *) AVC 01400907 + IVINSP = IVINSP + 1 01410907 + WRITE (NUVI, 80022) 01420907 + WRITE (NUVI, 70021) 01430907 +70021 FORMAT(" ",6X," (3.0,4.0)" ) 01440907 +CT003* TEST 3 - SEVERAL DOUBLE PRECISION 01450907 + IVTNUM = 3 01460907 + WRITE (NUVI, 80004) IVTNUM 01470907 + WRITE (NUVI, 80020) 01480907 + AVD = 2.5D0 01490907 + BVD = 2.5D-10 01500907 + CVD = 2.5D+10 01510907 + WRITE(NUVI, *) AVD, BVD, CVD 01520907 + IVINSP = IVINSP + 1 01530907 + WRITE (NUVI, 80022) 01540907 + WRITE (NUVI, 70031) 01550907 +70031 FORMAT(" ",6X,"2.5 2.5D-10 2.5D+10" ) 01560907 +CT004* TEST 4 - SEVERAL COMPLEX 01570907 + IVTNUM = 4 01580907 + WRITE (NUVI, 80004) IVTNUM 01590907 + WRITE (NUVI, 80020) 01600907 + AVC = (0.0, 1.0) 01610907 + BVC = (8.0, 10.0) 01620907 + CVC = (-5.0, 0.0) 01630907 + DVC = (0.0, 0.0) 01640907 + WRITE(NUVI,*) AVC, BVC, CVC, DVC 01650907 + IVINSP = IVINSP + 1 01660907 + WRITE (NUVI, 80022) 01670907 + WRITE (NUVI, 70041) 01680907 +70041 FORMAT(" ",6X, " (0.0,1.0) (8.0,10.0) (-5.0,0.0) (0.0,01690907 + 10.0)") 01700907 +CT005* TEST 5 - MIXED LIST 01710907 + IVTNUM = 5 01720907 + WRITE (NUVI, 80004) IVTNUM 01730907 + WRITE (NUVI, 80020) 01740907 + AVC = (3.0, 4.0) 01750907 + BVC = (-3.0, -4.0) 01760907 + AVD = 5.0D0 01770907 + BVD = -5.0D0 01780907 + WRITE(NUVI,*) AVC, AVD, BVD, BVC 01790907 + IVINSP = IVINSP + 1 01800907 + WRITE (NUVI, 80022) 01810907 + WRITE (NUVI, 70051) 01820907 +70051 FORMAT(" ",6X," (3.0,4.0) 5.0 -5.0 (-3.0,-4.0)" ) 01830907 +CT006* TEST 6 - MIXED MODE EXPRESSION 01840907 + IVTNUM = 6 01850907 + WRITE (NUVI, 80004) IVTNUM 01860907 + WRITE (NUVI, 80020) 01870907 + AVC = (2.0, 3.0) 01880907 + IVI = 3 01890907 + WRITE(NUVI, *) AVC * IVI 01900907 + IVINSP = IVINSP + 1 01910907 + WRITE (NUVI, 80022) 01920907 + WRITE (NUVI, 70061) 01930907 +70061 FORMAT(" ",6X," (6.0,9.0)" ) 01940907 +CT007* TEST 7 - MIXED MODE EXPRESSION 01950907 + IVTNUM = 7 01960907 + WRITE (NUVI, 80004) IVTNUM 01970907 + WRITE (NUVI, 80020) 01980907 + IVI = 2 01990907 + AVS = 6.5 02000907 + WRITE(NUVI, *) AVS / IVI 02010907 + IVINSP = IVINSP + 1 02020907 + WRITE (NUVI, 80022) 02030907 + WRITE (NUVI, 70071) 02040907 +70071 FORMAT(" ",6X,"3.25") 02050907 +CT008* TEST 8 - MIXED LIST 02060907 + IVTNUM = 8 02070907 + WRITE (NUVI, 80004) IVTNUM 02080907 + WRITE (NUVI, 80020) 02090907 + A4VK = 'GOOD' 02100907 + AVS = 2.5 02110907 + AVC = (4, -6) 02120907 + WRITE(NUVI, *) AVC / 2, .TRUE., AVS ** 3, A4VK // 'BYE', 02130907 + 1 ' FOR NOW' 02140907 + IVINSP = IVINSP + 1 02150907 + WRITE (NUVI, 80022) 02160907 + WRITE (NUVI, 70081) 02170907 +70081 FORMAT(" ",6X," (2.0,-3.0) T 15.625 GOODBYE FOR NOW" ) 02180907 +CBB** ********************** BBCSUM0 **********************************02190907 +C**** WRITE OUT TEST SUMMARY 02200907 +C**** 02210907 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02220907 + WRITE (I02, 90004) 02230907 + WRITE (I02, 90014) 02240907 + WRITE (I02, 90004) 02250907 + WRITE (I02, 90020) IVPASS 02260907 + WRITE (I02, 90022) IVFAIL 02270907 + WRITE (I02, 90024) IVDELE 02280907 + WRITE (I02, 90026) IVINSP 02290907 + WRITE (I02, 90028) IVTOTN, IVTOTL 02300907 +CBE** ********************** BBCSUM0 **********************************02310907 +CBB** ********************** BBCFOOT0 **********************************02320907 +C**** WRITE OUT REPORT FOOTINGS 02330907 +C**** 02340907 + WRITE (I02,90016) ZPROG, ZPROG 02350907 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02360907 + WRITE (I02,90019) 02370907 +CBE** ********************** BBCFOOT0 **********************************02380907 +CBB** ********************** BBCFMT0A **********************************02390907 +C**** FORMATS FOR TEST DETAIL LINES 02400907 +C**** 02410907 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02420907 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02430907 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02440907 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02450907 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02460907 + 1I6,/," ",15X,"CORRECT= " ,I6) 02470907 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02480907 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02490907 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02500907 + 1A21,/," ",16X,"CORRECT= " ,A21) 02510907 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02520907 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02530907 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02540907 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02550907 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02560907 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02570907 +80050 FORMAT (" ",48X,A31) 02580907 +CBE** ********************** BBCFMT0A **********************************02590907 +CBB** ********************** BBCFMAT1 **********************************02600907 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02610907 +C**** 02620907 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02630907 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02640907 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02650907 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02660907 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02670907 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02680907 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02690907 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02700907 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02710907 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02720907 + 2"(",F12.5,", ",F12.5,")") 02730907 +CBE** ********************** BBCFMAT1 **********************************02740907 +CBB** ********************** BBCFMT0B **********************************02750907 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02760907 +C**** 02770907 +90002 FORMAT ("1") 02780907 +90004 FORMAT (" ") 02790907 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02800907 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02810907 +90008 FORMAT (" ",21X,A13,A17) 02820907 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02830907 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02840907 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02850907 + 1 7X,"REMARKS",24X) 02860907 +90014 FORMAT (" ","----------------------------------------------" , 02870907 + 1 "---------------------------------" ) 02880907 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02890907 +C**** 02900907 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02910907 +C**** 02920907 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02930907 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02940907 + 1 A13) 02950907 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02960907 +C**** 02970907 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02980907 +C**** 02990907 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03000907 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03010907 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03020907 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03030907 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03040907 +CBE** ********************** BBCFMT0B **********************************03050907 +C***** 03060907 +C***** END OF TEST SEGMENT 373 03070907 + STOP 03080907 + END 03090907 diff --git a/Fortran/UnitTests/fcvs21_f95/FM907.reference_output b/Fortran/UnitTests/fcvs21_f95/FM907.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM907.reference_output @@ -0,0 +1,83 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM907BEGIN* TEST RESULTS - FM907 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + LSTDO2 - (373) LIST DIRECTED OUTPUT FOR D.P. AND COMPLEX DATA TYPES + + ANS REF. - 13.6 12.4 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 8 TESTS + + THE CORRECT LINE OF EACH TEST + IS HOLLERITH INFORMATION. + COLUMN SPACING, LINE BREAKS, + AND THE NUMBER OF DECIMAL + PLACES FOR DOUBLE PRECISION + OR COMPLEX NUMBERS ARE + PROCESSOR DEPENDENT. + EITHER E OR F FORMAT MAY BE + USED FOR DOUBLE PRECISION OR + COMPLEX NUMBERS. + + 1 INSPECT + COMPUTED= + 2.5000000000000000 + CORRECT= + 2.5 + 2 INSPECT + COMPUTED= + (3.00000000,4.00000000) + CORRECT= + (3.0,4.0) + 3 INSPECT + COMPUTED= + 2.5000000000000000 2.5000000000000002E-010 25000000000.000000 + CORRECT= + 2.5 2.5D-10 2.5D+10 + 4 INSPECT + COMPUTED= + (0.00000000,1.00000000) (8.00000000,10.0000000) (-5.00000000,0.00000000) (0.00000000,0.00000000) + CORRECT= + (0.0,1.0) (8.0,10.0) (-5.0,0.0) (0.0,0.0) + 5 INSPECT + COMPUTED= + (3.00000000,4.00000000) 5.0000000000000000 -5.0000000000000000 (-3.00000000,-4.00000000) + CORRECT= + (3.0,4.0) 5.0 -5.0 (-3.0,-4.0) + 6 INSPECT + COMPUTED= + (6.00000000,9.00000000) + CORRECT= + (6.0,9.0) + 7 INSPECT + COMPUTED= + 3.25000000 + CORRECT= + 3.25 + 8 INSPECT + COMPUTED= + (2.00000000,-3.00000000) T 15.6250000 GOODBYE FOR NOW + CORRECT= + (2.0,-3.0) T 15.625 GOODBYE FOR NOW + + ------------------------------------------------------------------------------- + + 0 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 8 TESTS REQUIRE INSPECTION + 8 OF 8 TESTS EXECUTED + + *FM907END* END OF TEST - FM907 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM908.f b/Fortran/UnitTests/fcvs21_f95/FM908.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM908.f @@ -0,0 +1,954 @@ + PROGRAM FM908 + +C***********************************************************************00010908 +C***** FORTRAN 77 00020908 +C***** FM908 00030908 +C***** INTER3 - (392) 00040908 +C***** 00050908 +C***********************************************************************00060908 +C***** TESTING OF INTERNAL FILES - ANS. REF 00070908 +C***** USING READ 12.2.5 00080908 +C***** 00090908 +CBB** ********************** BBCCOMNT **********************************00100908 +C**** 00110908 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00120908 +C**** VERSION 2.1 00130908 +C**** 00140908 +C**** 00150908 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00160908 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00170908 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00180908 +C**** BUILDING 225 RM A266 00190908 +C**** GAITHERSBURG, MD 20899 00200908 +C**** 00210908 +C**** 00220908 +C**** 00230908 +CBE** ********************** BBCCOMNT **********************************00240908 +C***** 00250908 +C***** S P E C I F I C A T I O N S SEGMENT 392 00260908 +C***** 00270908 + DOUBLE PRECISION AVD, BVD, CVD, DVD, EVD, DVCORR 00280908 + LOGICAL AVB 00290908 + CHARACTER*43 A43VK, D43VK, F43VK, G43VK, K43VK, N43VK 00300908 + CHARACTER A8VK*8, E51VK*51, L53VK*53, I82VK*82 00310908 + CHARACTER J97VK*97, C431K(2)*43, CVCORR*30 00320908 + CHARACTER*29 B291K(5), M291K(5), H131K(2)*13 00330908 + COMPLEX AVC, BVC, CVC, DVC, ZVCORR 00340908 + REAL R2E(8) 00350908 + EQUIVALENCE (R2E(1),AVC),(R2E(3),BVC),(R2E(5),CVC),(R2E(7),DVC) 00360908 +C***** 00370908 +CBB** ********************** BBCINITA **********************************00380908 +C**** SPECIFICATION STATEMENTS 00390908 +C**** 00400908 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00410908 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00420908 +CBE** ********************** BBCINITA **********************************00430908 +CBB** ********************** BBCINITB **********************************00440908 +C**** INITIALIZE SECTION 00450908 + DATA ZVERS, ZVERSD, ZDATE 00460908 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00470908 + DATA ZCOMPL, ZNAME, ZTAPE 00480908 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00490908 + DATA ZPROJ, ZTAPED, ZPROG 00500908 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00510908 + DATA REMRKS /' '/ 00520908 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00530908 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00540908 +C**** 00550908 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00560908 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00570908 +CZ03 ZPROG = 'PROGRAM NAME' 00580908 +CZ04 ZDATE = 'DATE OF TEST' 00590908 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00600908 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00610908 +CZ07 ZNAME = 'NAME OF USER' 00620908 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00630908 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00640908 +C 00650908 + IVPASS = 0 00660908 + IVFAIL = 0 00670908 + IVDELE = 0 00680908 + IVINSP = 0 00690908 + IVTOTL = 0 00700908 + IVTOTN = 0 00710908 + ICZERO = 0 00720908 +C 00730908 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00740908 + I01 = 05 00750908 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00760908 + I02 = 06 00770908 +C 00780908 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00790908 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00800908 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00810908 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00820908 +C 00830908 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00840908 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00850908 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00860908 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00870908 +C 00880908 +CBE** ********************** BBCINITB **********************************00890908 + NUVI = I02 00900908 + IVTOTL = 54 00910908 + ZPROG = 'FM908' 00920908 +CBB** ********************** BBCHED0A **********************************00930908 +C**** 00940908 +C**** WRITE REPORT TITLE 00950908 +C**** 00960908 + WRITE (I02, 90002) 00970908 + WRITE (I02, 90006) 00980908 + WRITE (I02, 90007) 00990908 + WRITE (I02, 90008) ZVERS, ZVERSD 01000908 + WRITE (I02, 90009) ZPROG, ZPROG 01010908 + WRITE (I02, 90010) ZDATE, ZCOMPL 01020908 +CBE** ********************** BBCHED0A **********************************01030908 +C***** 01040908 +C***** HEADER FOR SEGMENT 392 01050908 +C***** 01060908 + WRITE(NUVI,39200) 01070908 +39200 FORMAT(" ",/ " INTER3 - (392) INTERNAL FILES -- USING READ" 01080908 + 1 //" ANS. REF. - 12.2.5" ) 01090908 +CBB** ********************** BBCHED0B **********************************01100908 +C**** WRITE DETAIL REPORT HEADERS 01110908 +C**** 01120908 + WRITE (I02,90004) 01130908 + WRITE (I02,90004) 01140908 + WRITE (I02,90013) 01150908 + WRITE (I02,90014) 01160908 + WRITE (I02,90015) IVTOTL 01170908 +CBE** ********************** BBCHED0B **********************************01180908 + A43VK = ' 2.1000000D1 23.45600D3 23.450000000D2' 01190908 + D43VK = '34.58673D2 3458.67300 34.58673D2 3458.673 ' 01200908 + F43VK = 'T 10.98THISISIT 3.4945D2 3 ' 01210908 + G43VK = ' 2.343 34.394 ' 01220908 + K43VK = ' 0.934, 34.567 34.65 0.63540D1 ' 01230908 + N43VK = '34 34.98395.83000D2 F.FALSE.13.45300E+2 ' 01240908 + E51VK = ' 348 3.4783E1384.3847D1 T 3.48570 KDFJ D/.' 01250908 + L53VK = ' 0.345 ,3.4345E01,F, 34.85900D-1, 10.000012345678' 01260908 + I82VK = ' 2.34 , 2.456 2.34 , 2.456 0.234E01, 2.456E0001270908 + 1 0.234E+001, 2.456E-000' 01280908 + J97VK = ' 5.67980, 0.9876 5.67980, 0.9876 05.6798E001290908 + 10, 9.8760E-1 5.67980E0000,0.09876E+001' 01300908 + B291K(1) = '34.38457D1 34.38457D1 ' 01310908 + B291K(2) = '34.38457D1 ' 01320908 + B291K(3) = '34.38457D1 34.38457D1 ' 01330908 + B291K(4) = ' ' 01340908 + B291K(5) = '34.38457D1 ' 01350908 + M291K(1) = ' 98 ' 01360908 + M291K(2) = '8.40485D02 ' 01370908 + M291K(3) = ' ' 01380908 + M291K(4) = ' .TRUE. 340.435E-1, 3.494E+1' 01390908 + M291K(5) = '87654321 ' 01400908 + C431K(1) = ' 2.1000000D1 23.45600D3 23.450000000D2' 01410908 + C431K(2) = ' ' 01420908 + H131K(1) = '34.84' 01430908 + H131K(2) = '349.887' 01440908 +CT001* TEST 1 DOUBLE PRECISION FROM VARIABLE 01450908 + IVTNUM = 1 01460908 + READ(UNIT=A43VK,FMT=39201) AVD 01470908 +39201 FORMAT(13X,D10.5) 01480908 + IF (AVD - 0.2345599998D+05) 20010, 10010, 40010 01490908 +40010 IF (AVD - 0.2345600002D+05) 10010, 10010, 20010 01500908 +10010 IVPASS = IVPASS + 1 01510908 + WRITE (NUVI, 80002) IVTNUM 01520908 + GO TO 0011 01530908 +20010 IVFAIL = IVFAIL + 1 01540908 + DVCORR = 23.456D3 01550908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01560908 + 0011 CONTINUE 01570908 +CT002* TEST 2 FROM ELEMENT 01580908 + IVTNUM = 2 01590908 + READ(UNIT=C431K(1),FMT=39204) AVD 01600908 +39204 FORMAT(D12.7) 01610908 + IF (AVD - 0.2099999999D+02) 20020, 10020, 40020 01620908 +40020 IF (AVD - 0.2100000001D+02) 10020, 10020, 20020 01630908 +10020 IVPASS = IVPASS + 1 01640908 + WRITE (NUVI, 80002) IVTNUM 01650908 + GO TO 0021 01660908 +20020 IVFAIL = IVFAIL + 1 01670908 + DVCORR = 2.1D1 01680908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01690908 + 0021 CONTINUE 01700908 +CT003* TEST 3 FROM SUBSTRING 01710908 + IVTNUM = 3 01720908 + READ(UNIT=A43VK(19:),FMT=39206) AVD 01730908 +39206 FORMAT(11X,D14.9) 01740908 + IF (AVD - 0.2344999998D+04) 20030, 10030, 40030 01750908 +40030 IF (AVD - 0.2345000002D+04) 10030, 10030, 20030 01760908 +10030 IVPASS = IVPASS + 1 01770908 + WRITE (NUVI, 80002) IVTNUM 01780908 + GO TO 0031 01790908 +20030 IVFAIL = IVFAIL + 1 01800908 + DVCORR = 23.45D2 01810908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 01820908 + 0031 CONTINUE 01830908 +CT004* TEST 4 FROM ARRAY 01840908 + IVTNUM = 4 01850908 + READ(UNIT=C431K,FMT=39208) CVD 01860908 +39208 FORMAT(25X,D18.10) 01870908 + IF (CVD - 0.2344999998D+04) 20040, 10040, 40040 01880908 +40040 IF (CVD - 0.2345000002D+04) 10040, 10040, 20040 01890908 +10040 IVPASS = IVPASS + 1 01900908 + WRITE (NUVI, 80002) IVTNUM 01910908 + GO TO 0041 01920908 +20040 IVFAIL = IVFAIL + 1 01930908 + DVCORR = 23.45D2 01940908 + WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR 01950908 + 0041 CONTINUE 01960908 +C***** 01970908 +C***** TESTS 5 THRU 9 - LIST FROM ARRAY 01980908 +C***** 01990908 +CT005* TEST 5 02000908 + IVTNUM = 5 02010908 + READ(UNIT=B291K,FMT=39210) AVD, BVD, CVD, DVD, EVD 02020908 +39210 FORMAT(D10.5,1X,D10.5,/,D10.5,/,D10.5,//,D10.5) 02030908 + IF (AVD - 0.3438456998D+03) 20050, 10050, 40050 02040908 +40050 IF (AVD - 0.3438457002D+03) 10050, 10050, 20050 02050908 +10050 IVPASS = IVPASS + 1 02060908 + WRITE (NUVI, 80002) IVTNUM 02070908 + GO TO 0051 02080908 +20050 IVFAIL = IVFAIL + 1 02090908 + DVCORR = 34.38457D1 02100908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02110908 + 0051 CONTINUE 02120908 +CT006* TEST 6 02130908 + IVTNUM = 6 02140908 + IF (BVD - 0.3438456998D+03) 20060, 10060, 40060 02150908 +40060 IF (BVD - 0.3438457002D+03) 10060, 10060, 20060 02160908 +10060 IVPASS = IVPASS + 1 02170908 + WRITE (NUVI, 80002) IVTNUM 02180908 + GO TO 0061 02190908 +20060 IVFAIL = IVFAIL + 1 02200908 + DVCORR = 34.38457D1 02210908 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02220908 + 0061 CONTINUE 02230908 +CT007* TEST 7 02240908 + IVTNUM = 7 02250908 + IF (CVD - 0.3438456998D+03) 20070, 10070, 40070 02260908 +40070 IF (CVD - 0.3438457002D+03) 10070, 10070, 20070 02270908 +10070 IVPASS = IVPASS + 1 02280908 + WRITE (NUVI, 80002) IVTNUM 02290908 + GO TO 0071 02300908 +20070 IVFAIL = IVFAIL + 1 02310908 + DVCORR = 34.38457D1 02320908 + WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR 02330908 + 0071 CONTINUE 02340908 +CT008* TEST 8 02350908 + IVTNUM = 8 02360908 + IF (DVD - 0.3438456998D+03) 20080, 10080, 40080 02370908 +40080 IF (DVD - 0.3438457002D+03) 10080, 10080, 20080 02380908 +10080 IVPASS = IVPASS + 1 02390908 + WRITE (NUVI, 80002) IVTNUM 02400908 + GO TO 0081 02410908 +20080 IVFAIL = IVFAIL + 1 02420908 + DVCORR = 34.38457D1 02430908 + WRITE (NUVI, 80031) IVTNUM, DVD, DVCORR 02440908 + 0081 CONTINUE 02450908 +CT009* TEST 9 02460908 + IVTNUM = 9 02470908 + IF (EVD - 0.3438456998D+03) 20090, 10090, 40090 02480908 +40090 IF (EVD - 0.3438457002D+03) 10090, 10090, 20090 02490908 +10090 IVPASS = IVPASS + 1 02500908 + WRITE (NUVI, 80002) IVTNUM 02510908 + GO TO 0091 02520908 +20090 IVFAIL = IVFAIL + 1 02530908 + DVCORR = 34.38457D1 02540908 + WRITE (NUVI, 80031) IVTNUM, EVD, DVCORR 02550908 + 0091 CONTINUE 02560908 +C***** 02570908 +C***** TESTS 10 THRU 13 - LIST FROM VARIABLE WITH DIFFERENT FORMATS 02580908 +C***** 02590908 +CT010* TEST 10 02600908 + IVTNUM = 10 02610908 + READ(UNIT=D43VK,FMT=39212) AVD, BVD, CVD, DVD 02620908 +39212 FORMAT(D10.5,1X,F10.5,D11.5,G11.5) 02630908 + IF (AVD - 0.3458672998D+04) 20100, 10100, 40100 02640908 +40100 IF (AVD - 0.3458673002D+04) 10100, 10100, 20100 02650908 +10100 IVPASS = IVPASS + 1 02660908 + WRITE (NUVI, 80002) IVTNUM 02670908 + GO TO 0101 02680908 +20100 IVFAIL = IVFAIL + 1 02690908 + DVCORR = 34.58673D2 02700908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 02710908 + 0101 CONTINUE 02720908 +CT011* TEST 11 02730908 + IVTNUM = 11 02740908 + IF (BVD - 0.3458672998D+04) 20110, 10110, 40110 02750908 +40110 IF (BVD - 0.3458673002D+04) 10110, 10110, 20110 02760908 +10110 IVPASS = IVPASS + 1 02770908 + WRITE (NUVI, 80002) IVTNUM 02780908 + GO TO 0111 02790908 +20110 IVFAIL = IVFAIL + 1 02800908 + DVCORR = 34.58673D2 02810908 + WRITE (NUVI, 80031) IVTNUM, BVD, DVCORR 02820908 + 0111 CONTINUE 02830908 +CT012* TEST 12 02840908 + IVTNUM = 12 02850908 + IF (CVD - 0.3458672998D+04) 20120, 10120, 40120 02860908 +40120 IF (CVD - 0.3458673002D+04) 10120, 10120, 20120 02870908 +10120 IVPASS = IVPASS + 1 02880908 + WRITE (NUVI, 80002) IVTNUM 02890908 + GO TO 0121 02900908 +20120 IVFAIL = IVFAIL + 1 02910908 + DVCORR = 34.58673D2 02920908 + WRITE (NUVI, 80031) IVTNUM, CVD, DVCORR 02930908 + 0121 CONTINUE 02940908 +CT013* TEST 13 02950908 + IVTNUM = 13 02960908 + IF (DVD - 0.3458672998D+04) 20130, 10130, 40130 02970908 +40130 IF (DVD - 0.3458673002D+04) 10130, 10130, 20130 02980908 +10130 IVPASS = IVPASS + 1 02990908 + WRITE (NUVI, 80002) IVTNUM 03000908 + GO TO 0131 03010908 +20130 IVFAIL = IVFAIL + 1 03020908 + DVCORR = 34.58673D2 03030908 + WRITE (NUVI, 80031) IVTNUM, DVD, DVCORR 03040908 + 0131 CONTINUE 03050908 +C***** 03060908 + WRITE (NUVI, 90002) 03070908 + WRITE (NUVI, 90013) 03080908 + WRITE (NUVI, 90014) 03090908 +C***** 03100908 +C***** TESTS 14 THRU 19 - MIXED TYPES 03110908 +C***** 03120908 +CT014* TEST 14 03130908 + IVTNUM = 14 03140908 + READ(UNIT=E51VK,FMT=39214) KVI, AVS, AVD, AVB, BVS, A8VK 03150908 +39214 FORMAT(I4,1X,E9.4,D10.4,1X,L4,1X,F12.5,1X,A8) 03160908 + IF (KVI - 348) 20140, 10140, 20140 03170908 +10140 IVPASS = IVPASS + 1 03180908 + WRITE (NUVI, 80002) IVTNUM 03190908 + GO TO 0141 03200908 +20140 IVFAIL = IVFAIL + 1 03210908 + IVCORR = 348 03220908 + WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 03230908 + 0141 CONTINUE 03240908 +CT015* TEST 15 03250908 + IVTNUM = 15 03260908 + IF (AVS - 0.34781E+02) 20150, 10150, 40150 03270908 +40150 IF (AVS - 0.34785E+02) 10150, 10150, 20150 03280908 +10150 IVPASS = IVPASS + 1 03290908 + WRITE (NUVI, 80002) IVTNUM 03300908 + GO TO 0151 03310908 +20150 IVFAIL = IVFAIL + 1 03320908 + RVCORR = 34.783 03330908 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 03340908 + 0151 CONTINUE 03350908 +CT016* TEST 16 03360908 + IVTNUM = 16 03370908 + IF (AVD - 0.3843846998D+04) 20160, 10160, 40160 03380908 +40160 IF (AVD - 0.3843847002D+04) 10160, 10160, 20160 03390908 +10160 IVPASS = IVPASS + 1 03400908 + WRITE (NUVI, 80002) IVTNUM 03410908 + GO TO 0161 03420908 +20160 IVFAIL = IVFAIL + 1 03430908 + DVCORR = 384.3847D1 03440908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 03450908 + 0161 CONTINUE 03460908 +CT017* TEST 17 03470908 + IVTNUM = 17 03480908 + IVCOMP = 0 03490908 + IF (AVB) IVCOMP = 1 03500908 + IF (IVCOMP - 1) 20170, 10170, 20170 03510908 +10170 IVPASS = IVPASS + 1 03520908 + WRITE (NUVI, 80002) IVTNUM 03530908 + GO TO 0171 03540908 +20170 IVFAIL = IVFAIL + 1 03550908 + LVCORR = 1 03560908 + REMRKS = '1 = TRUE ; 0 = FALSE' 03570908 + WRITE (NUVI, 80008) IVTNUM, REMRKS 03580908 + WRITE (NUVI, 80024) IVCOMP 03590908 + WRITE (NUVI, 80026) LVCORR 03600908 + 0171 CONTINUE 03610908 +CT018* TEST 18 03620908 + IVTNUM = 18 03630908 + IF (BVS - 0.34855E+01) 20180, 10180, 40180 03640908 +40180 IF (BVS - 0.34859E+01) 10180, 10180, 20180 03650908 +10180 IVPASS = IVPASS + 1 03660908 + WRITE (NUVI, 80002) IVTNUM 03670908 + GO TO 0181 03680908 +20180 IVFAIL = IVFAIL + 1 03690908 + RVCORR = 3.4857 03700908 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 03710908 + 0181 CONTINUE 03720908 +CT019* TEST 19 03730908 + IVTNUM = 19 03740908 + IVCOMP = 0 03750908 + IF (A8VK.EQ.'KDFJ D/.') IVCOMP = 1 03760908 + IF (IVCOMP - 1) 20190, 10190, 20190 03770908 +10190 IVPASS = IVPASS + 1 03780908 + WRITE (NUVI, 80002) IVTNUM 03790908 + GO TO 0191 03800908 +20190 IVFAIL = IVFAIL + 1 03810908 + CVCORR = 'KDFJ D/.' 03820908 + WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR 03830908 + 0191 CONTINUE 03840908 +C***** 03850908 +C***** TESTS 20 THRU 25 - MIXED TYPES WITH TC, TLC, TRC, AND NX 03860908 +C***** 03870908 +CT020* TEST 20 03880908 + IVTNUM = 20 03890908 + READ(UNIT=F43VK,FMT=39216) AVB, AVS, A8VK, AVD, BVS, KVI 03900908 +39216 FORMAT(L1,T5,F5.2,A8,TR2,D8.4,TL8,F6.4,4X,I1) 03910908 + IVCOMP = 0 03920908 + IF (AVB) IVCOMP = 1 03930908 + IF (IVCOMP - 1) 20200, 10200, 20200 03940908 +10200 IVPASS = IVPASS + 1 03950908 + WRITE (NUVI, 80002) IVTNUM 03960908 + GO TO 0201 03970908 +20200 IVFAIL = IVFAIL + 1 03980908 + LVCORR = 1 03990908 + REMRKS = '1 = TRUE ; 0 = FALSE' 04000908 + WRITE (NUVI, 80008) IVTNUM, REMRKS 04010908 + WRITE (NUVI, 80024) IVCOMP 04020908 + WRITE (NUVI, 80026) LVCORR 04030908 + 0201 CONTINUE 04040908 +CT021* TEST 21 04050908 + IVTNUM = 21 04060908 + IF (AVS - 0.10979E+02) 20210, 10210, 40210 04070908 +40210 IF (AVS - 0.10981E+02) 10210, 10210, 20210 04080908 +10210 IVPASS = IVPASS + 1 04090908 + WRITE (NUVI, 80002) IVTNUM 04100908 + GO TO 0211 04110908 +20210 IVFAIL = IVFAIL + 1 04120908 + RVCORR = 10.98 04130908 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 04140908 + 0211 CONTINUE 04150908 +CT022* TEST 22 04160908 + IVTNUM = 22 04170908 + IVCOMP = 0 04180908 + IF (A8VK.EQ.'THISISIT') IVCOMP = 1 04190908 + IF (IVCOMP - 1) 20220, 10220, 20220 04200908 +10220 IVPASS = IVPASS + 1 04210908 + WRITE (NUVI, 80002) IVTNUM 04220908 + GO TO 0221 04230908 +20220 IVFAIL = IVFAIL + 1 04240908 + CVCORR = 'THISISIT' 04250908 + WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR 04260908 + 0221 CONTINUE 04270908 +CT023* TEST 23 04280908 + IVTNUM = 23 04290908 + IF (AVD - 0.3494499998D+03) 20230, 10230, 40230 04300908 +40230 IF (AVD - 0.3494500002D+03) 10230, 10230, 20230 04310908 +10230 IVPASS = IVPASS + 1 04320908 + WRITE (NUVI, 80002) IVTNUM 04330908 + GO TO 0231 04340908 +20230 IVFAIL = IVFAIL + 1 04350908 + DVCORR = 3.4945D2 04360908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 04370908 + 0231 CONTINUE 04380908 +CT024* TEST 24 04390908 + IVTNUM = 24 04400908 + IF (BVS - 0.34943E+01) 20240, 10240, 40240 04410908 +40240 IF (BVS - 0.34947E+01) 10240, 10240, 20240 04420908 +10240 IVPASS = IVPASS + 1 04430908 + WRITE (NUVI, 80002) IVTNUM 04440908 + GO TO 0241 04450908 +20240 IVFAIL = IVFAIL + 1 04460908 + RVCORR = 3.4945 04470908 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 04480908 + 0241 CONTINUE 04490908 +CT025* TEST 25 04500908 + IVTNUM = 25 04510908 + IF (KVI - 3) 20250, 10250, 20250 04520908 +10250 IVPASS = IVPASS + 1 04530908 + WRITE (NUVI, 80002) IVTNUM 04540908 + GO TO 0251 04550908 +20250 IVFAIL = IVFAIL + 1 04560908 + IVCORR = 3 04570908 + WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 04580908 + 0251 CONTINUE 04590908 +CT026* TEST 26 COMPLEX FROM VARIABLE 04600908 + IVTNUM = 26 04610908 + READ(UNIT=G43VK,FMT=39218) AVC 04620908 +39218 FORMAT(F10.5,1X,F10.5) 04630908 + IF (R2E(1) - 0.23428E+01) 20260, 40262, 40261 04640908 +40261 IF (R2E(1) - 0.23432E+01) 40262, 40262, 20260 04650908 +40262 IF (R2E(2) - 0.34392E+02) 20260, 10260, 40260 04660908 +40260 IF (R2E(2) - 0.34396E+02) 10260, 10260, 20260 04670908 +10260 IVPASS = IVPASS + 1 04680908 + WRITE (NUVI, 80002) IVTNUM 04690908 + GO TO 0261 04700908 +20260 IVFAIL = IVFAIL + 1 04710908 + ZVCORR = (2.343, 34.394) 04720908 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 04730908 + 0261 CONTINUE 04740908 +CT027* TEST 27 COMPLEX FROM ARRAY 04750908 + IVTNUM = 27 04760908 + READ(UNIT=H131K,FMT=39220) AVC 04770908 +39220 FORMAT(E12.5,/,E12.5) 04780908 + IF (R2E(1) - 0.34838E+02) 20270, 40272, 40271 04790908 +40271 IF (R2E(1) - 0.34842E+02) 40272, 40272, 20270 04800908 +40272 IF (R2E(2) - 0.34987E+03) 20270, 10270, 40270 04810908 +40270 IF (R2E(2) - 0.34991E+03) 10270, 10270, 20270 04820908 +10270 IVPASS = IVPASS + 1 04830908 + WRITE (NUVI, 80002) IVTNUM 04840908 + GO TO 0271 04850908 +20270 IVFAIL = IVFAIL + 1 04860908 + ZVCORR = (34.84, 349.887) 04870908 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 04880908 + 0271 CONTINUE 04890908 +C***** 04900908 + WRITE (NUVI, 90002) 04910908 + WRITE (NUVI, 90013) 04920908 + WRITE (NUVI, 90014) 04930908 +C***** 04940908 +C***** TESTS 28 THRU 31 - COMPLEX LIST FROM VARIABLE POSITION 1X BEYOND04950908 +C***** VARIABLE LENGTH 04960908 +CT028* TEST 28 04970908 + IVTNUM = 28 04980908 + READ(UNIT=I82VK,FMT=39222) AVC, BVC, CVC, DVC 04990908 +39222 FORMAT(2(2(G7.5,1X),2X),2(G10.4E2,1X),1X,2(G11.7E4,1X)) 05000908 + IF (R2E(1) - 0.23398E+01) 20280, 40282, 40281 05010908 +40281 IF (R2E(1) - 0.23402E+01) 40282, 40282, 20280 05020908 +40282 IF (R2E(2) - 0.24558E+01) 20280, 10280, 40280 05030908 +40280 IF (R2E(2) - 0.24562E+01) 10280, 10280, 20280 05040908 +10280 IVPASS = IVPASS + 1 05050908 + WRITE (NUVI, 80002) IVTNUM 05060908 + GO TO 0281 05070908 +20280 IVFAIL = IVFAIL + 1 05080908 + ZVCORR = (2.34, 2.456) 05090908 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 05100908 + 0281 CONTINUE 05110908 +CT029* TEST 29 05120908 + IVTNUM = 29 05130908 + IF (R2E(3) - 0.23398E+01) 20290, 40292, 40291 05140908 +40291 IF (R2E(3) - 0.23402E+01) 40292, 40292, 20290 05150908 +40292 IF (R2E(4) - 0.24558E+01) 20290, 10290, 40290 05160908 +40290 IF (R2E(4) - 0.24562E+01) 10290, 10290, 20290 05170908 +10290 IVPASS = IVPASS + 1 05180908 + WRITE (NUVI, 80002) IVTNUM 05190908 + GO TO 0291 05200908 +20290 IVFAIL = IVFAIL + 1 05210908 + ZVCORR = (2.34, 2.456) 05220908 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 05230908 + 0291 CONTINUE 05240908 +CT030* TEST 30 05250908 + IVTNUM = 30 05260908 + IF (R2E(5) - 0.23398E+01) 20300, 40302, 40301 05270908 +40301 IF (R2E(5) - 0.23402E+01) 40302, 40302, 20300 05280908 +40302 IF (R2E(6) - 0.24558E+01) 20300, 10300, 40300 05290908 +40300 IF (R2E(6) - 0.24562E+01) 10300, 10300, 20300 05300908 +10300 IVPASS = IVPASS + 1 05310908 + WRITE (NUVI, 80002) IVTNUM 05320908 + GO TO 0301 05330908 +20300 IVFAIL = IVFAIL + 1 05340908 + ZVCORR = (2.34, 2.456) 05350908 + WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR 05360908 + 0301 CONTINUE 05370908 +CT031* TEST 31 05380908 + IVTNUM = 31 05390908 + IF (R2E(7) - 0.23398E+01) 20310, 40312, 40311 05400908 +40311 IF (R2E(7) - 0.23402E+01) 40312, 40312, 20310 05410908 +40312 IF (R2E(8) - 0.24558E+01) 20310, 10310, 40310 05420908 +40310 IF (R2E(8) - 0.24562E+01) 10310, 10310, 20310 05430908 +10310 IVPASS = IVPASS + 1 05440908 + WRITE (NUVI, 80002) IVTNUM 05450908 + GO TO 0311 05460908 +20310 IVFAIL = IVFAIL + 1 05470908 + ZVCORR = (2.34, 2.456) 05480908 + WRITE (NUVI, 80045) IVTNUM, DVC, ZVCORR 05490908 + 0311 CONTINUE 05500908 +C***** 05510908 +C***** TESTS 32 THRU 35 - COMPLEX LIST USING EW.D AND EW.DEN 05520908 +C***** 05530908 +CT032* TEST 32 05540908 + IVTNUM = 32 05550908 + READ(UNIT=J97VK(1:),FMT=39224) AVC, BVC, CVC, DVC 05560908 +39224 FORMAT(2(2(E10.5,1X),2X),2(E10.4E2,1X),1X,2(E12.5E4,1X)) 05570908 + IF (R2E(1) - 0.56795E+01) 20320, 40322, 40321 05580908 +40321 IF (R2E(1) - 0.56801E+01) 40322, 40322, 20320 05590908 +40322 IF (R2E(2) - 0.98755E+00) 20320, 10320, 40320 05600908 +40320 IF (R2E(2) - 0.98765E+00) 10320, 10320, 20320 05610908 +10320 IVPASS = IVPASS + 1 05620908 + WRITE (NUVI, 80002) IVTNUM 05630908 + GO TO 0321 05640908 +20320 IVFAIL = IVFAIL + 1 05650908 + ZVCORR = (5.6798, 0.9876) 05660908 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 05670908 + 0321 CONTINUE 05680908 +CT033* TEST 33 05690908 + IVTNUM = 33 05700908 + IF (R2E(3) - 0.56795E+01) 20330, 40332, 40331 05710908 +40331 IF (R2E(3) - 0.56801E+01) 40332, 40332, 20330 05720908 +40332 IF (R2E(4) - 0.98755E+00) 20330, 10330, 40330 05730908 +40330 IF (R2E(4) - 0.98765E+00) 10330, 10330, 20330 05740908 +10330 IVPASS = IVPASS + 1 05750908 + WRITE (NUVI, 80002) IVTNUM 05760908 + GO TO 0331 05770908 +20330 IVFAIL = IVFAIL + 1 05780908 + ZVCORR = (5.6798, 0.9876) 05790908 + WRITE (NUVI, 80045) IVTNUM, BVC, ZVCORR 05800908 + 0331 CONTINUE 05810908 +CT034* TEST 34 05820908 + IVTNUM = 34 05830908 + IF (R2E(5) - 0.56795E+01) 20340, 40342, 40341 05840908 +40341 IF (R2E(5) - 0.56801E+01) 40342, 40342, 20340 05850908 +40342 IF (R2E(6) - 0.98755E+00) 20340, 10340, 40340 05860908 +40340 IF (R2E(6) - 0.98765E+00) 10340, 10340, 20340 05870908 +10340 IVPASS = IVPASS + 1 05880908 + WRITE (NUVI, 80002) IVTNUM 05890908 + GO TO 0341 05900908 +20340 IVFAIL = IVFAIL + 1 05910908 + ZVCORR = (5.6798, 0.9876) 05920908 + WRITE (NUVI, 80045) IVTNUM, CVC, ZVCORR 05930908 + 0341 CONTINUE 05940908 +CT035* TEST 35 05950908 + IVTNUM = 35 05960908 + IF (R2E(7) - 0.56795E+01) 20350, 40352, 40351 05970908 +40351 IF (R2E(7) - 0.56801E+01) 40352, 40352, 20350 05980908 +40352 IF (R2E(8) - 0.98755E+00) 20350, 10350, 40350 05990908 +40350 IF (R2E(8) - 0.98765E+00) 10350, 10350, 20350 06000908 +10350 IVPASS = IVPASS + 1 06010908 + WRITE (NUVI, 80002) IVTNUM 06020908 + GO TO 0351 06030908 +20350 IVFAIL = IVFAIL + 1 06040908 + ZVCORR = (5.6798, 0.9876) 06050908 + WRITE (NUVI, 80045) IVTNUM, DVC, ZVCORR 06060908 + 0351 CONTINUE 06070908 +C***** 06080908 +C***** TESTS 36 THRU 38 - MIXED TYPES FROM VARIABLE 06090908 +C***** 06100908 +CT036* TEST 36 06110908 + IVTNUM = 36 06120908 + READ(UNIT=K43VK,FMT=39226) AVC, AVS, AVD 06130908 +39226 FORMAT(F7.3,1X,F7.3,1X,F10.5,1X,D13.5) 06140908 + IF (R2E(1) - 0.93395E+00) 20360, 40362, 40361 06150908 +40361 IF (R2E(1) - 0.93405E+00) 40362, 40362, 20360 06160908 +40362 IF (R2E(2) - 0.34565E+02) 20360, 10360, 40360 06170908 +40360 IF (R2E(2) - 0.34569E+02) 10360, 10360, 20360 06180908 +10360 IVPASS = IVPASS + 1 06190908 + WRITE (NUVI, 80002) IVTNUM 06200908 + GO TO 0361 06210908 +20360 IVFAIL = IVFAIL + 1 06220908 + ZVCORR = (0.934, 34.567) 06230908 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 06240908 + 0361 CONTINUE 06250908 +CT037* TEST 37 06260908 + IVTNUM = 37 06270908 + IF (AVS - 0.34648E+02) 20370, 10370, 40370 06280908 +40370 IF (AVS - 0.34652E+02) 10370, 10370, 20370 06290908 +10370 IVPASS = IVPASS + 1 06300908 + WRITE (NUVI, 80002) IVTNUM 06310908 + GO TO 0371 06320908 +20370 IVFAIL = IVFAIL + 1 06330908 + RVCORR = 34.65 06340908 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 06350908 + 0371 CONTINUE 06360908 +CT038* TEST 38 06370908 + IVTNUM = 38 06380908 + IF (AVD - 0.6353999996D+01) 20380, 10380, 40380 06390908 +40380 IF (AVD - 0.6354000004D+01) 10380, 10380, 20380 06400908 +10380 IVPASS = IVPASS + 1 06410908 + WRITE (NUVI, 80002) IVTNUM 06420908 + GO TO 0381 06430908 +20380 IVFAIL = IVFAIL + 1 06440908 + DVCORR = 0.6354D1 06450908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 06460908 + 0381 CONTINUE 06470908 +C***** 06480908 +C***** TESTS 39 THRU 43 - MIXED TYPES FROM ARRAY 06490908 +C***** 06500908 +CT039* TEST 39 06510908 + IVTNUM = 39 06520908 + READ(UNIT=L53VK,FMT=39228) AVC, AVB, AVD, AVS, A8VK 06530908 +39228 FORMAT(F9.4,1X,E9.4,1X,L1,1X,D12.5,1X,G9.4,A8) 06540908 + IF (R2E(1) - 0.34498E+00) 20390, 40392, 40391 06550908 +40391 IF (R2E(1) - 0.34502E+00) 40392, 40392, 20390 06560908 +40392 IF (R2E(2) - 0.34343E+02) 20390, 10390, 40390 06570908 +40390 IF (R2E(2) - 0.34347E+02) 10390, 10390, 20390 06580908 +10390 IVPASS = IVPASS + 1 06590908 + WRITE (NUVI, 80002) IVTNUM 06600908 + GO TO 0391 06610908 +20390 IVFAIL = IVFAIL + 1 06620908 + ZVCORR = (0.345, 34.345) 06630908 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 06640908 + 0391 CONTINUE 06650908 +CT040* TEST 40 06660908 + IVTNUM = 40 06670908 + IVCOMP = 0 06680908 + IF (AVB) IVCOMP = 1 06690908 + IF (IVCOMP - 0) 20400, 10400, 20400 06700908 +10400 IVPASS = IVPASS + 1 06710908 + WRITE (NUVI, 80002) IVTNUM 06720908 + GO TO 0401 06730908 +20400 IVFAIL = IVFAIL + 1 06740908 + LVCORR = 0 06750908 + REMRKS = '1 = TRUE ; 0 = FALSE' 06760908 + WRITE (NUVI, 80008) IVTNUM, REMRKS 06770908 + WRITE (NUVI, 80024) IVCOMP 06780908 + WRITE (NUVI, 80026) LVCORR 06790908 + 0401 CONTINUE 06800908 +CT041* TEST 41 06810908 + IVTNUM = 41 06820908 + IF (AVD - 0.3485899998D+01) 20410, 10410, 40410 06830908 +40410 IF (AVD - 0.3485900002D+01) 10410, 10410, 20410 06840908 +10410 IVPASS = IVPASS + 1 06850908 + WRITE (NUVI, 80002) IVTNUM 06860908 + GO TO 0411 06870908 +20410 IVFAIL = IVFAIL + 1 06880908 + DVCORR = 34.859D-1 06890908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 06900908 + 0411 CONTINUE 06910908 +CT042* TEST 42 06920908 + IVTNUM = 42 06930908 + IF (AVS - 0.99995E+01) 20420, 10420, 40420 06940908 +40420 IF (AVS - 0.10001E+02) 10420, 10420, 20420 06950908 +10420 IVPASS = IVPASS + 1 06960908 + WRITE (NUVI, 80002) IVTNUM 06970908 + GO TO 0421 06980908 +20420 IVFAIL = IVFAIL + 1 06990908 + RVCORR = 10.0 07000908 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 07010908 + 0421 CONTINUE 07020908 +CT043* TEST 43 07030908 + IVTNUM = 43 07040908 + IVCOMP = 0 07050908 + IF (A8VK.EQ.'12345678') IVCOMP = 1 07060908 + IF (IVCOMP - 1) 20430, 10430, 20430 07070908 +10430 IVPASS = IVPASS + 1 07080908 + WRITE (NUVI, 80002) IVTNUM 07090908 + GO TO 0431 07100908 +20430 IVFAIL = IVFAIL + 1 07110908 + CVCORR = '12345678' 07120908 + WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR 07130908 + 0431 CONTINUE 07140908 +C***** 07150908 + WRITE (NUVI, 90002) 07160908 + WRITE (NUVI, 90013) 07170908 + WRITE (NUVI, 90014) 07180908 +C***** 07190908 +C***** TESTS 44 THRU 48 - READ 5 RECORD FROM ARRAY POSITION 1X BEYOND 07200908 +C***** ARRAY ELEMENT 07210908 +C***** 07220908 +CT044* TEST 44 07230908 + IVTNUM = 44 07240908 + READ(UNIT=M291K,FMT=39230) KVI, AVD, AVB, AVC, A8VK 07250908 +39230 FORMAT(I5,/,D10.5,//,1X,L6,1X,2(E10.3,1X),/,A8) 07260908 + IF (KVI - 98) 20440, 10440, 20440 07270908 +10440 IVPASS = IVPASS + 1 07280908 + WRITE (NUVI, 80002) IVTNUM 07290908 + GO TO 0441 07300908 +20440 IVFAIL = IVFAIL + 1 07310908 + IVCORR = 98 07320908 + WRITE (NUVI, 80010) IVTNUM, KVI, IVCORR 07330908 + 0441 CONTINUE 07340908 +CT045* TEST 45 07350908 + IVTNUM = 45 07360908 + IF (AVD - 0.8404849995D+03) 20450, 10450, 40450 07370908 +40450 IF (AVD - 0.8404850004D+03) 10450, 10450, 20450 07380908 +10450 IVPASS = IVPASS + 1 07390908 + WRITE (NUVI, 80002) IVTNUM 07400908 + GO TO 0451 07410908 +20450 IVFAIL = IVFAIL + 1 07420908 + DVCORR = 84.0485D1 07430908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 07440908 + 0451 CONTINUE 07450908 +CT046* TEST 46 07460908 + IVTNUM = 46 07470908 + IVCOMP = 0 07480908 + IF (AVB) IVCOMP = 1 07490908 + IF (IVCOMP - 1) 20460, 10460, 20460 07500908 +10460 IVPASS = IVPASS + 1 07510908 + WRITE (NUVI, 80002) IVTNUM 07520908 + GO TO 0461 07530908 +20460 IVFAIL = IVFAIL + 1 07540908 + LVCORR = 1 07550908 + REMRKS = '1 = TRUE ; 0 = FALSE' 07560908 + WRITE (NUVI, 80008) IVTNUM, REMRKS 07570908 + WRITE (NUVI, 80024) IVCOMP 07580908 + WRITE (NUVI, 80026) LVCORR 07590908 + 0461 CONTINUE 07600908 +CT047* TEST 47 07610908 + IVTNUM = 47 07620908 + IF (R2E(1) - 0.34041E+02) 20470, 40472, 40471 07630908 +40471 IF (R2E(1) - 0.34046E+02) 40472, 40472, 20470 07640908 +40472 IF (R2E(2) - 0.34938E+02) 20470, 10470, 40470 07650908 +40470 IF (R2E(2) - 0.34942E+02) 10470, 10470, 20470 07660908 +10470 IVPASS = IVPASS + 1 07670908 + WRITE (NUVI, 80002) IVTNUM 07680908 + GO TO 0471 07690908 +20470 IVFAIL = IVFAIL + 1 07700908 + ZVCORR = (34.0435, 34.94) 07710908 + WRITE (NUVI, 80045) IVTNUM, AVC, ZVCORR 07720908 + 0471 CONTINUE 07730908 +CT048* TEST 48 07740908 + IVTNUM = 48 07750908 + IVCOMP = 0 07760908 + IF (A8VK.EQ.'87654321') IVCOMP = 1 07770908 + IF (IVCOMP - 1) 20480, 10480, 20480 07780908 +10480 IVPASS = IVPASS + 1 07790908 + WRITE (NUVI, 80002) IVTNUM 07800908 + GO TO 0481 07810908 +20480 IVFAIL = IVFAIL + 1 07820908 + CVCORR = '87654321' 07830908 + WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR 07840908 + 0481 CONTINUE 07850908 +C***** 07860908 +C***** TESTS 49 THRU 54 - MIXED TYPES, NX, AND : 07870908 +C***** 07880908 +CT049* TEST 49 07890908 + IVTNUM = 49 07900908 + READ(UNIT=N43VK,FMT=39232)JVI,AVS,AVD,AVB,A8VK,BVS 07910908 +39232 FORMAT(I2,1X,F6.3,D10.5,L2,A8,E10.5,:,I5,2X,F10.4) 07920908 + IF (JVI - 34) 20490, 10490, 20490 07930908 +10490 IVPASS = IVPASS + 1 07940908 + WRITE (NUVI, 80002) IVTNUM 07950908 + GO TO 0491 07960908 +20490 IVFAIL = IVFAIL + 1 07970908 + IVCORR = 34 07980908 + WRITE (NUVI, 80010) IVTNUM, JVI, IVCORR 07990908 + 0491 CONTINUE 08000908 +CT050* TEST 50 08010908 + IVTNUM = 50 08020908 + IF (AVS - 0.34981E+02) 20500, 10500, 40500 08030908 +40500 IF (AVS - 0.34985E+02) 10500, 10500, 20500 08040908 +10500 IVPASS = IVPASS + 1 08050908 + WRITE (NUVI, 80002) IVTNUM 08060908 + GO TO 0501 08070908 +20500 IVFAIL = IVFAIL + 1 08080908 + RVCORR = 34.983 08090908 + WRITE (NUVI, 80012) IVTNUM, AVS, RVCORR 08100908 + 0501 CONTINUE 08110908 +CT051* TEST 51 08120908 + IVTNUM = 51 08130908 + IF (AVD - 0.9582999995D+04) 20510, 10510, 40510 08140908 +40510 IF (AVD - 0.9583000005D+04) 10510, 10510, 20510 08150908 +10510 IVPASS = IVPASS + 1 08160908 + WRITE (NUVI, 80002) IVTNUM 08170908 + GO TO 0511 08180908 +20510 IVFAIL = IVFAIL + 1 08190908 + DVCORR = 95.83D2 08200908 + WRITE (NUVI, 80031) IVTNUM, AVD, DVCORR 08210908 + 0511 CONTINUE 08220908 +CT052* TEST 52 08230908 + IVTNUM = 52 08240908 + IVCOMP = 0 08250908 + IF (AVB) IVCOMP = 1 08260908 + IF (IVCOMP - 0) 20520, 10520, 20520 08270908 +10520 IVPASS = IVPASS + 1 08280908 + WRITE (NUVI, 80002) IVTNUM 08290908 + GO TO 0521 08300908 +20520 IVFAIL = IVFAIL + 1 08310908 + LVCORR = 0 08320908 + REMRKS = '1 = TRUE ; 0 = FALSE' 08330908 + WRITE (NUVI, 80008) IVTNUM, REMRKS 08340908 + WRITE (NUVI, 80024) IVCOMP 08350908 + WRITE (NUVI, 80026) LVCORR 08360908 + 0521 CONTINUE 08370908 +CT053* TEST 53 08380908 + IVTNUM = 53 08390908 + IVCOMP = 0 08400908 + IF (A8VK.EQ.'.FALSE.1') IVCOMP = 1 08410908 + IF (IVCOMP - 1) 20530, 10530, 20530 08420908 +10530 IVPASS = IVPASS + 1 08430908 + WRITE (NUVI, 80002) IVTNUM 08440908 + GO TO 0531 08450908 +20530 IVFAIL = IVFAIL + 1 08460908 + CVCORR = '.FALSE.1' 08470908 + WRITE (NUVI, 80018) IVTNUM, A8VK, CVCORR 08480908 + 0531 CONTINUE 08490908 +CT054* TEST 54 08500908 + IVTNUM = 54 08510908 + IF (BVS - 0.34528E+03) 20540, 10540, 40540 08520908 +40540 IF (BVS - 0.34532E+03) 10540, 10540, 20540 08530908 +10540 IVPASS = IVPASS + 1 08540908 + WRITE (NUVI, 80002) IVTNUM 08550908 + GO TO 0541 08560908 +20540 IVFAIL = IVFAIL + 1 08570908 + RVCORR = 345.3 08580908 + WRITE (NUVI, 80012) IVTNUM, BVS, RVCORR 08590908 + 0541 CONTINUE 08600908 +C***** 08610908 +CBB** ********************** BBCSUM0 **********************************08620908 +C**** WRITE OUT TEST SUMMARY 08630908 +C**** 08640908 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 08650908 + WRITE (I02, 90004) 08660908 + WRITE (I02, 90014) 08670908 + WRITE (I02, 90004) 08680908 + WRITE (I02, 90020) IVPASS 08690908 + WRITE (I02, 90022) IVFAIL 08700908 + WRITE (I02, 90024) IVDELE 08710908 + WRITE (I02, 90026) IVINSP 08720908 + WRITE (I02, 90028) IVTOTN, IVTOTL 08730908 +CBE** ********************** BBCSUM0 **********************************08740908 +CBB** ********************** BBCFOOT0 **********************************08750908 +C**** WRITE OUT REPORT FOOTINGS 08760908 +C**** 08770908 + WRITE (I02,90016) ZPROG, ZPROG 08780908 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 08790908 + WRITE (I02,90019) 08800908 +CBE** ********************** BBCFOOT0 **********************************08810908 +CBB** ********************** BBCFMT0A **********************************08820908 +C**** FORMATS FOR TEST DETAIL LINES 08830908 +C**** 08840908 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 08850908 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 08860908 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 08870908 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 08880908 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 08890908 + 1I6,/," ",15X,"CORRECT= " ,I6) 08900908 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08910908 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 08920908 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08930908 + 1A21,/," ",16X,"CORRECT= " ,A21) 08940908 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 08950908 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 08960908 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 08970908 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 08980908 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 08990908 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 09000908 +80050 FORMAT (" ",48X,A31) 09010908 +CBE** ********************** BBCFMT0A **********************************09020908 +CBB** ********************** BBCFMAT1 **********************************09030908 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 09040908 +C**** 09050908 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 09060908 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 09070908 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 09080908 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 09090908 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 09100908 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 09110908 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 09120908 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 09130908 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 09140908 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 09150908 + 2"(",F12.5,", ",F12.5,")") 09160908 +CBE** ********************** BBCFMAT1 **********************************09170908 +CBB** ********************** BBCFMT0B **********************************09180908 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 09190908 +C**** 09200908 +90002 FORMAT ("1") 09210908 +90004 FORMAT (" ") 09220908 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )09230908 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 09240908 +90008 FORMAT (" ",21X,A13,A17) 09250908 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 09260908 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 09270908 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 09280908 + 1 7X,"REMARKS",24X) 09290908 +90014 FORMAT (" ","----------------------------------------------" , 09300908 + 1 "---------------------------------" ) 09310908 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 09320908 +C**** 09330908 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 09340908 +C**** 09350908 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 09360908 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 09370908 + 1 A13) 09380908 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 09390908 +C**** 09400908 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 09410908 +C**** 09420908 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 09430908 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 09440908 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 09450908 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 09460908 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 09470908 +CBE** ********************** BBCFMT0B **********************************09480908 +C***** 09490908 +C***** END OF TEST SEGMENT 392 09500908 + STOP 09510908 + END 09520908 diff --git a/Fortran/UnitTests/fcvs21_f95/FM908.reference_output b/Fortran/UnitTests/fcvs21_f95/FM908.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM908.reference_output @@ -0,0 +1,95 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM908BEGIN* TEST RESULTS - FM908 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INTER3 - (392) INTERNAL FILES -- USING READ + + ANS. REF. - 12.2.5 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 54 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 28 PASS + 29 PASS + 30 PASS + 31 PASS + 32 PASS + 33 PASS + 34 PASS + 35 PASS + 36 PASS + 37 PASS + 38 PASS + 39 PASS + 40 PASS + 41 PASS + 42 PASS + 43 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 44 PASS + 45 PASS + 46 PASS + 47 PASS + 48 PASS + 49 PASS + 50 PASS + 51 PASS + 52 PASS + 53 PASS + 54 PASS + + ------------------------------------------------------------------------------- + + 54 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 54 OF 54 TESTS EXECUTED + + *FM908END* END OF TEST - FM908 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM909.f b/Fortran/UnitTests/fcvs21_f95/FM909.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM909.f @@ -0,0 +1,901 @@ + PROGRAM FM909 + +C***********************************************************************00010909 +C***** FORTRAN 77 00020909 +C***** FM909 00030909 +C***** INTER4 - (393) 00040909 +C***** 00050909 +C***********************************************************************00060909 +C***** TESTING OF INTERNAL FILES - ANS. REF 00070909 +C***** USING WRITE 12.2.5 00080909 +C***** 00090909 +C***** 00100909 +CBB** ********************** BBCCOMNT **********************************00110909 +C**** 00120909 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00130909 +C**** VERSION 2.1 00140909 +C**** 00150909 +C**** 00160909 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00170909 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00180909 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00190909 +C**** BUILDING 225 RM A266 00200909 +C**** GAITHERSBURG, MD 20899 00210909 +C**** 00220909 +C**** 00230909 +C**** 00240909 +CBE** ********************** BBCCOMNT **********************************00250909 +C***** 00260909 +C***** S P E C I F I C A T I O N S SEGMENT 393 00270909 +C***** 00280909 + LOGICAL AVB 00290909 + DOUBLE PRECISION AVD, BVD, CVD, DVD, B1D(5) 00300909 + COMPLEX AVC, BVC, CVC 00310909 + CHARACTER A8VK*8, A97VK*97, CVCORR*97, AVCORR(24)*97 00320909 + CHARACTER*29 A291K(5) 00330909 + CHARACTER*43 A431K(2) 00340909 + CHARACTER*1 A97E1(97), A97E2(97) 00350909 + EQUIVALENCE (A97VK, A97E1), (A431K, A97E1) 00360909 + EQUIVALENCE (CVCORR, A97E2) 00370909 +C***** 00380909 +CBB** ********************** BBCINITA **********************************00390909 +C**** SPECIFICATION STATEMENTS 00400909 +C**** 00410909 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00420909 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00430909 +CBE** ********************** BBCINITA **********************************00440909 +CBB** ********************** BBCINITB **********************************00450909 +C**** INITIALIZE SECTION 00460909 + DATA ZVERS, ZVERSD, ZDATE 00470909 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00480909 + DATA ZCOMPL, ZNAME, ZTAPE 00490909 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00500909 + DATA ZPROJ, ZTAPED, ZPROG 00510909 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00520909 + DATA REMRKS /' '/ 00530909 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00540909 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00550909 +C**** 00560909 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00570909 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00580909 +CZ03 ZPROG = 'PROGRAM NAME' 00590909 +CZ04 ZDATE = 'DATE OF TEST' 00600909 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00610909 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00620909 +CZ07 ZNAME = 'NAME OF USER' 00630909 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00640909 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00650909 +C 00660909 + IVPASS = 0 00670909 + IVFAIL = 0 00680909 + IVDELE = 0 00690909 + IVINSP = 0 00700909 + IVTOTL = 0 00710909 + IVTOTN = 0 00720909 + ICZERO = 0 00730909 +C 00740909 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00750909 + I01 = 05 00760909 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00770909 + I02 = 06 00780909 +C 00790909 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00800909 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00810909 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00820909 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00830909 +C 00840909 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00850909 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00860909 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00870909 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00880909 +C 00890909 +CBE** ********************** BBCINITB **********************************00900909 + NUVI = I02 00910909 + IVTOTL = 27 00920909 + ZPROG = 'FM909' 00930909 +CBB** ********************** BBCHED0A **********************************00940909 +C**** 00950909 +C**** WRITE REPORT TITLE 00960909 +C**** 00970909 + WRITE (I02, 90002) 00980909 + WRITE (I02, 90006) 00990909 + WRITE (I02, 90007) 01000909 + WRITE (I02, 90008) ZVERS, ZVERSD 01010909 + WRITE (I02, 90009) ZPROG, ZPROG 01020909 + WRITE (I02, 90010) ZDATE, ZCOMPL 01030909 +CBE** ********************** BBCHED0A **********************************01040909 +C***** 01050909 +C***** HEADER FOR SEGMENT 393 01060909 +C***** 01070909 + WRITE(NUVI,39300) 01080909 +39300 FORMAT(" ",/ " INTER4 - (393) INTERNAL FILES -- USING WRITE" 01090909 + 1 //" ANS. REF. - 12.2.5" ) 01100909 +CBB** ********************** BBCHED0B **********************************01110909 +C**** WRITE DETAIL REPORT HEADERS 01120909 +C**** 01130909 + WRITE (I02,90004) 01140909 + WRITE (I02,90004) 01150909 + WRITE (I02,90013) 01160909 + WRITE (I02,90014) 01170909 + WRITE (I02,90015) IVTOTL 01180909 +CBE** ********************** BBCHED0B **********************************01190909 + WRITE (NUVI, 39199) 01200909 +39199 FORMAT (" ",48X,"NOTE 1: FOR NUMERIC VALUES, " / 01210909 + 1 " ",48X," OPTIONAL LEADING ZERO MAY BE" / 01220909 + 2 " ",48X," BLANK FOR ABSOLUTE VALUE < 1" / 01230909 + 3 " ",48X,"NOTE 2: LEADING PLUS SIGN IS " / 01240909 + 4 " ",48X," OPTIONAL FOR NUMERIC VALUES " / 01250909 + 5 " ",48X,"NOTE 3: E FORMAT EXPONENT MAY " / 01260909 + 6 " ",48X," BE E+NN OR +0NN FOR REALS " / 01270909 + 7 " ",48X,"NOTE 4: D FORMAT EXPONENT MAY " / 01280909 + 8 " ",48X," BE D+NN, E+NN, OR +0NN FOR " / 01290909 + 9 " ",48X," DOUBLE PRECISION VALUES " /) 01300909 +C***** 01310909 +CT001* TEST 1 DOUBLE PRECISION INTO VARIABLE 01320909 + IVTNUM = 1 01330909 + A97VK = 'XXXXXXXXXXXXXXXXXX' 01340909 + AVD = 23.456D3 01350909 + WRITE(UNIT=A97VK,FMT=39301) AVD 01360909 +39301 FORMAT(13X,D10.5) 01370909 + IVCOMP = 0 01380909 + AVCORR(1) = ' .23456D+05' 01390909 + AVCORR(2) = ' .23456E+05' 01400909 + AVCORR(3) = ' .23456+005' 01410909 + DO 40011 I = 1, 3 01420909 + IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 01430909 + IF (IVCOMP - 1) 40011, 10010, 40011 01440909 +40011 CONTINUE 01450909 + GO TO 20010 01460909 +10010 IVPASS = IVPASS + 1 01470909 + WRITE (NUVI, 80002) IVTNUM 01480909 + GO TO 0011 01490909 +20010 IVFAIL = IVFAIL + 1 01500909 + CVCORR = ' .23456D+05' 01510909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 01520909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 01530909 + REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 01540909 + WRITE (NUVI, 80050) REMRKS 01550909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 01560909 +70010 FORMAT(" ",16X,"COMPUTED: " ,54A1) 01570909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 01580909 +70020 FORMAT(" ",26X,43A1) 01590909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 01600909 +70030 FORMAT(" ",16X,"CORRECT: " ,54A1) 01610909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 01620909 +70040 FORMAT(" ",26X,43A1) 01630909 + 0011 CONTINUE 01640909 +CT002* TEST 2 INTO ARRAY ELEMENT 01650909 + IVTNUM = 2 01660909 + AVD = 2.1D1 01670909 + A431K(1) = ' ' 01680909 + A431K(2) = 'WRONG' 01690909 + WRITE(UNIT=A431K(1),FMT=39303) AVD 01700909 +39303 FORMAT(D12.7) 01710909 + IVCOMP = 0 01720909 + AVCORR(1) = '.2100000D+02' 01730909 + AVCORR(2) = '.2100000E+02' 01740909 + AVCORR(3) = '.2100000+002' 01750909 + DO 40021 I = 1, 3 01760909 + IF (A431K(1).EQ.AVCORR(I)) IVCOMP = 1 01770909 + IF (IVCOMP - 1) 40021, 10020, 40021 01780909 +40021 CONTINUE 01790909 + GO TO 20020 01800909 +10020 IVPASS = IVPASS + 1 01810909 + WRITE (NUVI, 80002) IVTNUM 01820909 + GO TO 0021 01830909 +20020 IVFAIL = IVFAIL + 1 01840909 + CVCORR = '.2100000D+02' 01850909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 01860909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 01870909 + REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 01880909 + WRITE (NUVI, 80050) REMRKS 01890909 + WRITE (NUVI, 80020) A431K(1) 01900909 + WRITE (NUVI, 80022) CVCORR 01910909 + 0021 CONTINUE 01920909 +CT003* TEST 3 CHARACTER SUBSTRING 01930909 + IVTNUM = 3 01940909 + A97VK = ' SOME WHERE' 01950909 + AVD = 23.45D2 01960909 + WRITE(UNIT=A97VK(21:),FMT=39305) AVD 01970909 +39305 FORMAT(11X,D14.9) 01980909 + IVCOMP = 0 01990909 + AVCORR(1) = ' SOME WHERE .234500000D+04' 02000909 + AVCORR(2) = ' SOME WHERE .234500000E+04' 02010909 + AVCORR(3) = ' SOME WHERE .234500000+004' 02020909 + DO 40031 I = 1, 3 02030909 + IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 02040909 + IF (IVCOMP - 1) 40031, 10030, 40031 02050909 +40031 CONTINUE 02060909 + GO TO 20030 02070909 +10030 IVPASS = IVPASS + 1 02080909 + WRITE (NUVI, 80002) IVTNUM 02090909 + GO TO 0031 02100909 +20030 IVFAIL = IVFAIL + 1 02110909 + CVCORR = ' SOME WHERE .234500000D+04' 02120909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 02130909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 02140909 + REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 02150909 + WRITE (NUVI, 80050) REMRKS 02160909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 02170909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 02180909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 02190909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 02200909 + 0031 CONTINUE 02210909 +C***** TESTS 4 - 5 ARRAY, SINGLE RECORD 02220909 +CT004* TEST 4 02230909 + IVTNUM = 4 02240909 + CVD = 23.45D2 02250909 + A431K(2) = ' ' 02260909 + WRITE(UNIT=A431K,FMT=39306) CVD 02270909 +39306 FORMAT(24X,D19.10) 02280909 + IVCOMP = 0 02290909 + AVCORR(1) = ' 0.2345000000D+04' 02300909 + AVCORR(2) = ' 0.2345000000E+04' 02310909 + AVCORR(3) = ' 0.2345000000+004' 02320909 + AVCORR(4) = ' .2345000000D+04' 02330909 + AVCORR(5) = ' .2345000000E+04' 02340909 + AVCORR(6) = ' .2345000000+004' 02350909 + AVCORR(7) = ' +.2345000000D+04' 02360909 + AVCORR(8) = ' +.2345000000E+04' 02370909 + AVCORR(9) = ' +.2345000000+004' 02380909 + AVCORR(10) = ' +0.2345000000D+04' 02390909 + AVCORR(11) = ' +0.2345000000E+04' 02400909 + AVCORR(12) = ' +0.2345000000+004' 02410909 + DO 40041 I = 1, 12 02420909 + IF (A431K(1).EQ.AVCORR(I)) IVCOMP = 1 02430909 + IF (IVCOMP - 1) 40041, 10040, 40041 02440909 +40041 CONTINUE 02450909 + GO TO 20040 02460909 +10040 IVPASS = IVPASS + 1 02470909 + WRITE (NUVI, 80002) IVTNUM 02480909 + GO TO 0041 02490909 +20040 IVFAIL = IVFAIL + 1 02500909 + CVCORR = ' 0.2345000000D+04' 02510909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 02520909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 02530909 + REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 02540909 + WRITE (NUVI, 80050) REMRKS 02550909 + WRITE (NUVI, 70050) (A97E1(I), I = 1,43) 02560909 + WRITE (NUVI, 70060) (A97E2(I), I = 1,43) 02570909 +70050 FORMAT(" ",16X,"COMPUTED: " ,43A1) 02580909 +70060 FORMAT(" ",16X,"CORRECT: " ,43A1) 02590909 + 0041 CONTINUE 02600909 +CT005* TEST 5 02610909 + IVTNUM = 5 02620909 + IVCOMP = 0 02630909 + IF (A431K(2).EQ.' ') IVCOMP = 1 02640909 + IF (IVCOMP - 1) 20050, 10050, 20050 02650909 +10050 IVPASS = IVPASS + 1 02660909 + WRITE (NUVI, 80002) IVTNUM 02670909 + GO TO 0051 02680909 +20050 IVFAIL = IVFAIL + 1 02690909 + CVCORR = ' ' 02700909 + WRITE (NUVI, 80018) IVTNUM, A431K(2), CVCORR 02710909 + 0051 CONTINUE 02720909 +C***** TESTS 6 - 10 ARRAY, 5 RECORDS, ONE BLANK 02730909 +CT006* TEST 6 02740909 + IVTNUM = 6 02750909 + B1D(1) = 11D1 02760909 + B1D(2) = 21D1 02770909 + B1D(3) = 31D1 02780909 + B1D(4) = 32D1 02790909 + B1D(5) = 51D1 02800909 + WRITE(UNIT=A291K,FMT=39307) (B1D(JVI), JVI=1,5) 02810909 +39307 FORMAT(E11.6E2/1X,E10.5E2/2X,2(E9.4E2,3X)//4X,E7.2E2) 02820909 + IVCOMP = 0 02830909 + IF (A291K(1).EQ.'.110000E+03') IVCOMP = 1 02840909 + IF (IVCOMP - 1) 20060, 10060, 20060 02850909 +10060 IVPASS = IVPASS + 1 02860909 + WRITE (NUVI, 80002) IVTNUM 02870909 + GO TO 0061 02880909 +20060 IVFAIL = IVFAIL + 1 02890909 + CVCORR = '.110000E+03' 02900909 + WRITE (NUVI, 80018) IVTNUM, A291K(1), CVCORR 02910909 + 0061 CONTINUE 02920909 +CT007* TEST 7 02930909 + IVTNUM = 7 02940909 + IVCOMP = 0 02950909 + IF (A291K(2).EQ.' .21000E+03') IVCOMP = 1 02960909 + IF (IVCOMP - 1) 20070, 10070, 20070 02970909 +10070 IVPASS = IVPASS + 1 02980909 + WRITE (NUVI, 80002) IVTNUM 02990909 + GO TO 0071 03000909 +20070 IVFAIL = IVFAIL + 1 03010909 + CVCORR = ' .21000E+03' 03020909 + WRITE (NUVI, 80018) IVTNUM, A291K(2), CVCORR 03030909 + 0071 CONTINUE 03040909 +CT008* TEST 8 03050909 + IVTNUM = 8 03060909 + IVCOMP = 0 03070909 + IF (A291K(3).EQ.' .3100E+03 .3200E+03') IVCOMP = 1 03080909 + IF (IVCOMP - 1) 20080, 10080, 20080 03090909 +10080 IVPASS = IVPASS + 1 03100909 + WRITE (NUVI, 80002) IVTNUM 03110909 + GO TO 0081 03120909 +20080 IVFAIL = IVFAIL + 1 03130909 + CVCORR = ' .3100+003 .3200E+03' 03140909 + WRITE (NUVI, 70070) IVTNUM, A291K(3), CVCORR 03150909 +70070 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED: " , 03160909 + 1 A29,/," ",16X,"CORRECT: " ,A29) 03170909 + 0081 CONTINUE 03180909 +CT009* TEST 9 03190909 + IVTNUM = 9 03200909 + IVCOMP = 0 03210909 + IF (A291K(4).EQ.' ') IVCOMP = 1 03220909 + IF (IVCOMP - 1) 20090, 10090, 20090 03230909 +10090 IVPASS = IVPASS + 1 03240909 + WRITE (NUVI, 80002) IVTNUM 03250909 + GO TO 0091 03260909 +20090 IVFAIL = IVFAIL + 1 03270909 + CVCORR = ' ' 03280909 + WRITE (NUVI, 80018) IVTNUM, A291K(4), CVCORR 03290909 + 0091 CONTINUE 03300909 +CT010* TEST 10 03310909 + IVTNUM = 10 03320909 + IVCOMP = 0 03330909 + IF (A291K(5).EQ.' .51E+03') IVCOMP = 1 03340909 + IF (IVCOMP - 1) 20100, 10100, 20100 03350909 +10100 IVPASS = IVPASS + 1 03360909 + WRITE (NUVI, 80002) IVTNUM 03370909 + GO TO 0101 03380909 +20100 IVFAIL = IVFAIL + 1 03390909 + CVCORR = ' .51E+03' 03400909 + WRITE (NUVI, 80018) IVTNUM, A291K(5), CVCORR 03410909 + 0101 CONTINUE 03420909 +C***** 03430909 + WRITE(NUVI, 90002) 03440909 + WRITE(NUVI, 90013) 03450909 + WRITE(NUVI, 90014) 03460909 +C***** 03470909 +CT011* TEST 11 VARIABLE, MORE THEN ONE FIELD 03480909 + IVTNUM = 11 03490909 + AVD = 34.58673D2 03500909 + BVD = 34.58673D2 03510909 + CVD = 34.58673D2 03520909 + DVD = 34.58673D2 03530909 + WRITE(UNIT=A97VK,FMT=39309) AVD, BVD, CVD, DVD 03540909 +39309 FORMAT(D10.5,1X,F10.5,1X,D11.5,G11.5) 03550909 + IVCOMP = 0 03560909 + CVCORR = '.34587D+04 3458.67300 0.34587D+04 3458.7' 03570909 + IF (A97VK.EQ.CVCORR) IVCOMP = 1 03580909 + IF (IVCOMP - 1) 20110, 10110, 20110 03590909 +10110 IVPASS = IVPASS + 1 03600909 + WRITE (NUVI, 80002) IVTNUM 03610909 + GO TO 0111 03620909 +20110 IVFAIL = IVFAIL + 1 03630909 + REMRKS = '54 PERMISSIBLE REPRESENTATIONS' 03640909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 03650909 + REMRKS = 'SEE NOTES ABOVE' 03660909 + WRITE (NUVI, 80050) REMRKS 03670909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 03680909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 03690909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 03700909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 03710909 + 0111 CONTINUE 03720909 +CT012* TEST 12 GW.D FIELD WITH D.P. 03730909 + IVTNUM = 12 03740909 + AVD = 314.5673D0 03750909 + BVD = 14.45673D-1 03760909 + CVD = 85.7343D6 03770909 + WRITE(UNIT=A97VK,FMT=39310) AVD, BVD, CVD 03780909 +39310 FORMAT(G12.5,1X,G14.5E3,1X,G10.5E2) 03790909 + IVCOMP = 0 03800909 + AVCORR(1) = ' 314.57 1.4457 .85734E+08' 03810909 + AVCORR(2) = ' +314.57 1.4457 .85734E+08' 03820909 + AVCORR(3) = ' 314.57 +1.4457 .85734E+08' 03830909 + AVCORR(4) = ' +314.57 +1.4457 .85734E+08' 03840909 + DO 40121 I = 1, 4 03850909 + IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 03860909 + IF (IVCOMP - 1) 40121, 10120, 40121 03870909 +40121 CONTINUE 03880909 + GO TO 20120 03890909 +10120 IVPASS = IVPASS + 1 03900909 + WRITE (NUVI, 80002) IVTNUM 03910909 + GO TO 0121 03920909 +20120 IVFAIL = IVFAIL + 1 03930909 + CVCORR = ' 314.57 1.4457 .85734E+08' 03940909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 03950909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 03960909 + REMRKS = 'WITH PERMISSIBLE OPTIONS. SEE ' 03970909 + WRITE (NUVI, 80050) REMRKS 03980909 + REMRKS = 'NOTES ABOVE' 03990909 + WRITE (NUVI, 80050) REMRKS 04000909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 04010909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 04020909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 04030909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 04040909 + 0121 CONTINUE 04050909 +CT013* TEST 13 DIFFERENT TYPES IN SAME RECORD 04060909 + IVTNUM = 13 04070909 + KVI = 348 04080909 + AVS = 34.783 04090909 + AVD = 384.3847D1 04100909 + AVB = .TRUE. 04110909 + BVS = 3.4857 04120909 + A8VK = 'KDFJ D/.' 04130909 + WRITE(UNIT=A97VK,FMT=39311) KVI, AVS, AVD, AVB, BVS, A8VK 04140909 +39311 FORMAT(I4,1X,E9.4,1X,D10.4,1X,L4,1X,F12.5,1X,A8) 04150909 + IVCOMP = 0 04160909 + CVCORR = ' 348 .3478E+02 0.3844D+04 T 3.48570 KDFJ D/04170909 + 1.' 04180909 + IF (A97VK.EQ.CVCORR) IVCOMP = 1 04190909 + IF (IVCOMP - 1) 20130, 10130, 20130 04200909 +10130 IVPASS = IVPASS + 1 04210909 + WRITE (NUVI, 80002) IVTNUM 04220909 + GO TO 0131 04230909 +20130 IVFAIL = IVFAIL + 1 04240909 + REMRKS = '72 PERMISSIBLE REPRESENTATIONS' 04250909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 04260909 + REMRKS = 'SEE NOTES ABOVE' 04270909 + WRITE (NUVI, 80050) REMRKS 04280909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 04290909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 04300909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 04310909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 04320909 + 0131 CONTINUE 04330909 +CT014* TEST 14 POSITIONAL EDITING 04340909 + IVTNUM = 14 04350909 + AVB = .TRUE. 04360909 + AVS = 10.98 04370909 + A8VK = 'THISISIT' 04380909 + AVD = 3.4945D2 04390909 + BVS = 3.4945 04400909 + KVI = 3 04410909 + WRITE(UNIT=A97VK,FMT=39312) AVB, AVS, A8VK, AVD, BVS, KVI 04420909 +39312 FORMAT(L1,T5,F5.2,A8,TR2,E10.4E2,TL10,F6.4,6X,I1) 04430909 + IVCOMP = 0 04440909 + IF (A97VK.EQ.'T 10.98THISISIT 3.4945E+03 3') 04450909 + 1 IVCOMP = 1 04460909 + IF (IVCOMP - 1) 20140, 10140, 20140 04470909 +10140 IVPASS = IVPASS + 1 04480909 + WRITE (NUVI, 80002) IVTNUM 04490909 + GO TO 0141 04500909 +20140 IVFAIL = IVFAIL + 1 04510909 + CVCORR = 'T 10.98THISISIT 3.4945E+03 3' 04520909 + WRITE (NUVI, 80008) IVTNUM 04530909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 04540909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 04550909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 04560909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 04570909 + 0141 CONTINUE 04580909 +CT015* TEST 15 COLON AND SIGN 04590909 + IVTNUM = 15 04600909 + AVB = .TRUE. 04610909 + AVS = 98.11 04620909 + A8VK = 'THISISIT' 04630909 + AVD = 3.4945D2 04640909 + KVI = 33 04650909 + WRITE(UNIT=A97VK,FMT=39313) AVB, AVS, A8VK, AVD, KVI 04660909 +39313 FORMAT(L1,S,F7.2,A8,SP,D11.5,6X,SS,I2,:,F9.3) 04670909 + IVCOMP = 0 04680909 + AVCORR(1) = 'T 98.11THISISIT+.34945D+03 33' 04690909 + AVCORR(2) = 'T 98.11THISISIT+.34945E+03 33' 04700909 + AVCORR(3) = 'T 98.11THISISIT+.34945+003 33' 04710909 + DO 40151 I = 1, 3 04720909 + IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 04730909 + IF (IVCOMP - 1) 40151, 10150, 40151 04740909 +40151 CONTINUE 04750909 + GO TO 20150 04760909 +10150 IVPASS = IVPASS + 1 04770909 + WRITE (NUVI, 80002) IVTNUM 04780909 + GO TO 0151 04790909 +20150 IVFAIL = IVFAIL + 1 04800909 + CVCORR = 'T 98.11THISISIT+.34945D+03 33' 04810909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 04820909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 04830909 + REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 04840909 + WRITE (NUVI, 80050) REMRKS 04850909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 04860909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 04870909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 04880909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 04890909 + 0151 CONTINUE 04900909 +CT016* TEST 16 COMPLEX TYPES INTO VARIABLE 04910909 + IVTNUM = 16 04920909 + AVC = (2.343, 34.394) 04930909 + WRITE(UNIT=A97VK,FMT=39314) AVC 04940909 +39314 FORMAT(F10.5,1X,F10.5) 04950909 + IVCOMP = 0 04960909 + AVCORR(1) = ' 2.34300 34.39400' 04970909 + AVCORR(2) = ' 2.34300 +34.39400' 04980909 + AVCORR(3) = ' +2.34300 34.39400' 04990909 + AVCORR(4) = ' +2.34300 +34.39400' 05000909 + DO 40161 I = 1, 4 05010909 + IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 05020909 + IF (IVCOMP - 1) 40161, 10160, 40161 05030909 +40161 CONTINUE 05040909 + GO TO 20160 05050909 +10160 IVPASS = IVPASS + 1 05060909 + WRITE (NUVI, 80002) IVTNUM 05070909 + GO TO 0161 05080909 +20160 IVFAIL = IVFAIL + 1 05090909 + CVCORR = ' +2.34300 +34.39400' 05100909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 05110909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 05120909 + REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 05130909 + WRITE (NUVI, 80050) REMRKS 05140909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 05150909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 05160909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 05170909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 05180909 + 0161 CONTINUE 05190909 +CT017* TEST 17 05200909 + IVTNUM = 17 05210909 + AVC = (34.84, 349.887) 05220909 + WRITE(UNIT=A97VK,FMT=39315) AVC 05230909 +39315 FORMAT(E12.5,1X,E12.5) 05240909 + IVCOMP = 0 05250909 + IF (A97VK.EQ.' 0.34840E+02 0.34989E+03') IVCOMP = 1 05260909 + IF (IVCOMP - 1) 20170, 10170, 20170 05270909 +10170 IVPASS = IVPASS + 1 05280909 + WRITE (NUVI, 80002) IVTNUM 05290909 + GO TO 0171 05300909 +20170 IVFAIL = IVFAIL + 1 05310909 + CVCORR = ' 0.34840E+02 0.34989E+03' 05320909 + REMRKS = '16 PERMISSIBLE REPRESENTATIONS' 05330909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 05340909 + REMRKS = 'SEE NOTES ABOVE' 05350909 + WRITE (NUVI, 80050) REMRKS 05360909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 05370909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 05380909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 05390909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 05400909 + 0171 CONTINUE 05410909 +CT018* TEST 18 LIST OF COMPLEX 05420909 + IVTNUM = 18 05430909 + AVC = (2.34, 2.456) 05440909 + BVC = (2.34, 2.456) 05450909 + CVC = (2.34, 2.456) 05460909 + WRITE(UNIT=A97VK,FMT=39316) AVC, BVC, CVC 05470909 +39316 FORMAT(2(G9.4,1X),2(G10.4E2,1X),2(G11.5E3,1X)) 05480909 + IVCOMP = 0 05490909 + AVCORR(1) = '2.340 2.456 2.340 2.456 2.340005500909 + 1 2.4560' 05510909 + AVCORR(2) = '2.340 2.456 2.340 +2.456 2.340005520909 + 1 2.4560' 05530909 + AVCORR(3) = '2.340 2.456 +2.340 2.456 2.340005540909 + 1 2.4560' 05550909 + AVCORR(4) = '2.340 2.456 +2.340 +2.456 2.340005560909 + 1 2.4560' 05570909 + DO 40181 I = 1, 4 05580909 + IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 05590909 + IF (IVCOMP - 1) 40181, 10180, 40181 05600909 +40181 CONTINUE 05610909 + GO TO 20180 05620909 +10180 IVPASS = IVPASS + 1 05630909 + WRITE (NUVI, 80002) IVTNUM 05640909 + GO TO 0181 05650909 +20180 IVFAIL = IVFAIL + 1 05660909 + CVCORR = '2.340 2.456 2.340 2.456 2.3400 05670909 + 1 2.4560' 05680909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 05690909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 05700909 + REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 05710909 + WRITE (NUVI, 80050) REMRKS 05720909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 05730909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 05740909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 05750909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 05760909 + 0181 CONTINUE 05770909 +CT019* TEST 19 LIST FROM SUBSTRING 05780909 + IVTNUM = 19 05790909 + AVC = (5.6798, 0.9876) 05800909 + BVC = (5.6798, 0.9876) 05810909 + CVC = (5.6798, 0.9876) 05820909 + WRITE(UNIT=A97VK(1:),FMT=39317) AVC, BVC, CVC 05830909 +39317 FORMAT(2(E6.2E1,1X),1X,2(E7.2E2,1X),1X,2(E9.2E3,1X)) 05840909 + IVCOMP = 0 05850909 + AVCORR(1) = '.57E+1 .99E+0 .57E+01 .99E+00 .57E+001 .99E+05860909 + 1000' 05870909 + AVCORR(2) = '.57E+1 .99E+0 .57E+01 .99E+00 .57E+001 0.99E+05880909 + 1000' 05890909 + AVCORR(3) = '.57E+1 .99E+0 .57E+01 .99E+00 .57E+001 +.99E+05900909 + 1000' 05910909 + AVCORR(4) = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 .99E+05920909 + 1000' 05930909 + AVCORR(5) = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 0.99E+05940909 + 1000' 05950909 + AVCORR(6) = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 +.99E+05960909 + 1000' 05970909 + AVCORR(7) = '.57E+1 .99E+0 .57E+01 .99E+00 +.57E+001 .99E+05980909 + 1000' 05990909 + AVCORR(8) = '.57E+1 .99E+0 .57E+01 .99E+00 +.57E+001 0.99E+06000909 + 1000' 06010909 + AVCORR(9) = '.57E+1 .99E+0 .57E+01 .99E+00 +.57E+001 +.99E+06020909 + 1000' 06030909 + DO 40191 I = 1, 9 06040909 + IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 06050909 + IF (IVCOMP - 1) 40191, 10190, 40191 06060909 +40191 CONTINUE 06070909 + GO TO 20190 06080909 +10190 IVPASS = IVPASS + 1 06090909 + WRITE (NUVI, 80002) IVTNUM 06100909 + GO TO 0191 06110909 +20190 IVFAIL = IVFAIL + 1 06120909 + CVCORR = '.57E+1 .99E+0 .57E+01 .99E+00 0.57E+001 0.99E+00006130909 + 1' 06140909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 06150909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 06160909 + REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 06170909 + WRITE (NUVI, 80050) REMRKS 06180909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 06190909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 06200909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 06210909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 06220909 + 0191 CONTINUE 06230909 +CT020* TEST 20 MIXED TYPES 06240909 + IVTNUM = 20 06250909 + AVC = (0.934, 34.567) 06260909 + AVS = 34.65 06270909 + AVD = 0.6354D1 06280909 + WRITE(UNIT=A97VK,FMT=39318) AVC, AVS, AVD 06290909 +39318 FORMAT(F7.3,1X,F7.3,1X,F10.5,1X,E13.5E2) 06300909 + IVCOMP = 0 06310909 + IF (A97VK.EQ.' 0.934 34.567 34.65000 0.63540E+01') IVCO06320909 + 1MP = 1 06330909 + IF (A97VK.EQ.' .934 34.567 34.65000 .63540E+01') IVCO06330909 + 1MP = 1 06330909 + IF (A97VK.EQ.' 0.934 34.567 34.64999 0.63540E+01') IVCO06330909 + 1MP = 1 06330909 + IF (A97VK.EQ.' .934 34.567 34.64999 .63540E+01') IVCO06330909 + 1MP = 1 06330909 + IF (IVCOMP - 1) 20200, 10200, 20200 06340909 +10200 IVPASS = IVPASS + 1 06350909 + WRITE (NUVI, 80002) IVTNUM 06360909 + GO TO 0201 06370909 +20200 IVFAIL = IVFAIL + 1 06380909 + CVCORR = ' 0.934 34.567 34.65000 0.63540E+01' 06390909 + REMRKS = '32 PERMISSIBLE REPRESENTATIONS' 06400909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 06410909 + REMRKS = 'SEE NOTES ABOVE' 06420909 + WRITE (NUVI, 80050) REMRKS 06430909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 06440909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 06450909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 06460909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 06470909 + 0201 CONTINUE 06480909 +C***** 06490909 + WRITE(NUVI, 90002) 06500909 + WRITE(NUVI, 90013) 06510909 + WRITE(NUVI, 90014) 06520909 +C***** 06530909 +CT021* TEST 21 MIXED TYPES WITH POSITIONAL EDITING 06540909 + IVTNUM = 21 06550909 + AVC = (0.345, 34.349) 06560909 + AVB = .FALSE. 06570909 + AVD = 34.859D-1 06580909 + AVS = 10.0 06590909 + A8VK = '12345678' 06600909 + WRITE(UNIT=A97VK,FMT=39319) AVC, AVB, AVD, AVS, A8VK 06610909 +39319 FORMAT(F9.4,1X,E9.4,1X,L1,1X,D12.5,1X,G9.4,A8) 06620909 + IVCOMP = 0 06630909 + IF (A97VK.EQ.' 0.3450 .3435E+02 F 0.34859D+01 10.00 12306640909 + 145678') IVCOMP = 1 06650909 + IF (IVCOMP - 1) 20210, 10210, 20210 06660909 +10210 IVPASS = IVPASS + 1 06670909 + WRITE (NUVI, 80002) IVTNUM 06680909 + GO TO 0211 06690909 +20210 IVFAIL = IVFAIL + 1 06700909 + CVCORR = ' 0.3450 .3435E+02 F 0.34859D+01 10.00 123456706710909 + 18' 06720909 + REMRKS = '96 PERMISSIBLE REPRESENTATIONS' 06730909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 06740909 + REMRKS = 'SEE NOTES ABOVE' 06750909 + WRITE (NUVI, 80050) REMRKS 06760909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 06770909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 06780909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 06790909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 06800909 + 0211 CONTINUE 06810909 +C***** TESTS 22 - 26 MIXED TYPES INTO 5 RECORDS 06820909 +CT022* TEST 22 06830909 + IVTNUM = 22 06840909 + KVI = 98 06850909 + AVD = 84.0489D1 06860909 + AVB = .TRUE. 06870909 + AVC = (34.0435, 34.94) 06880909 + A8VK = 'THE LAST' 06890909 + WRITE(UNIT=A291K,FMT=39320) KVI, AVD, AVB, AVC, A8VK 06900909 +39320 FORMAT(I5/E10.5E2//1X,L6,2(1X,E10.3)/A8) 06910909 + IVCOMP = 0 06920909 + AVCORR(1) = ' 98' 06930909 + AVCORR(2) = ' +98' 06940909 + DO 40221 I = 1, 2 06950909 + IF (A291K(1).EQ.AVCORR(I)) IVCOMP = 1 06960909 + IF (IVCOMP - 1) 40221, 10220, 40221 06970909 +40221 CONTINUE 06980909 + GO TO 20220 06990909 +10220 IVPASS = IVPASS + 1 07000909 + WRITE (NUVI, 80002) IVTNUM 07010909 + GO TO 0221 07020909 +20220 IVFAIL = IVFAIL + 1 07030909 + CVCORR = ' 98' 07040909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 07050909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 07060909 + REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 07070909 + WRITE (NUVI, 80050) REMRKS 07080909 + WRITE (NUVI, 80020) A291K(1) 07090909 + WRITE (NUVI, 80022) CVCORR 07100909 + 0221 CONTINUE 07110909 +CT023* TEST 23 07120909 + IVTNUM = 23 07130909 + IVCOMP = 0 07140909 + IF (A291K(2).EQ.'.84049E+03') IVCOMP = 1 07150909 + IF (IVCOMP - 1) 20230, 10230, 20230 07160909 +10230 IVPASS = IVPASS + 1 07170909 + WRITE (NUVI, 80002) IVTNUM 07180909 + GO TO 0231 07190909 +20230 IVFAIL = IVFAIL + 1 07200909 + CVCORR = '.84049E+03' 07210909 + WRITE (NUVI, 80018) IVTNUM, A291K(2), CVCORR 07220909 + 0231 CONTINUE 07230909 +CT024* TEST 24 07240909 + IVTNUM = 24 07250909 + IVCOMP = 0 07260909 + IF (A291K(3).EQ.' ') IVCOMP = 1 07270909 + IF (IVCOMP - 1) 20240, 10240, 20240 07280909 +10240 IVPASS = IVPASS + 1 07290909 + WRITE (NUVI, 80002) IVTNUM 07300909 + GO TO 0241 07310909 +20240 IVFAIL = IVFAIL + 1 07320909 + CVCORR = ' ' 07330909 + WRITE (NUVI, 80018) IVTNUM, A291K(3), CVCORR 07340909 + 0241 CONTINUE 07350909 +CT025* TEST 25 07360909 + IVTNUM = 25 07370909 + IVCOMP = 0 07380909 + IF (A291K(4).EQ.' T 0.340E+02 0.349E+02') IVCOMP = 1 07390909 + IF (IVCOMP - 1) 20250, 10250, 20250 07400909 +10250 IVPASS = IVPASS + 1 07410909 + WRITE (NUVI, 80002) IVTNUM 07420909 + GO TO 0251 07430909 +20250 IVFAIL = IVFAIL + 1 07440909 + CVCORR = ' T 0.340E+02 0.349E+02' 07450909 + REMRKS = '64 PERMISSIBLE REPRESENTATIONS' 07460909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 07470909 + REMRKS = 'SEE NOTES ABOVE' 07480909 + WRITE (NUVI, 80050) REMRKS 07490909 + WRITE (NUVI, 70080) A291K(4), CVCORR 07500909 +70080 FORMAT (" ",16X,"COMPUTED: " , A29,/ 07510909 + 1 " ",16X,"CORRECT: " ,A29) 07520909 + 0251 CONTINUE 07530909 +CT026* TEST 26 07540909 + IVTNUM = 26 07550909 + IVCOMP = 0 07560909 + IF (A291K(5).EQ.'THE LAST') IVCOMP = 1 07570909 + IF (IVCOMP - 1) 20260, 10260, 20260 07580909 +10260 IVPASS = IVPASS + 1 07590909 + WRITE (NUVI, 80002) IVTNUM 07600909 + GO TO 0261 07610909 +20260 IVFAIL = IVFAIL + 1 07620909 + CVCORR = 'THE LAST' 07630909 + WRITE (NUVI, 80018) IVTNUM, A291K(5), CVCORR 07640909 + 0261 CONTINUE 07650909 +CT027* TEST 27 MIXED TYPES WITH SS, SP, NX, AND : 07660909 + IVTNUM = 27 07670909 + JVI = 34 07680909 + AVS = 34.983 07690909 + BVS = 345.3 07700909 + AVD = 95.83D2 07710909 + AVB = .FALSE. 07720909 + A8VK = '.FALSE.1' 07730909 + WRITE(UNIT=A97VK,FMT=39321)JVI, AVS, AVD, AVB, A8VK, BVS 07740909 +39321 FORMAT(S,I2,1X,SP,F7.3,SS,1X,D10.5,L2,1X,A8,1X,E10.5,:,I5,F10.4)07750909 + IVCOMP = 0 07760909 + AVCORR(1) = '34 +34.983 .95830D+04 F .FALSE.1 .34530E+03' 07770909 + AVCORR(2) = '34 +34.983 .95830D+04 F .FALSE.1 .34530+003' 07780909 + AVCORR(3) = '34 +34.983 .95830E+04 F .FALSE.1 .34530E+03' 07790909 + AVCORR(4) = '34 +34.983 .95830E+04 F .FALSE.1 .34530+003' 07800909 + AVCORR(5) = '34 +34.983 .95830+004 F .FALSE.1 .34530E+03' 07810909 + AVCORR(6) = '34 +34.983 .95830+004 F .FALSE.1 .34530+003' 07820909 + DO 40271 I = 1, 6 07830909 + IF (A97VK.EQ.AVCORR(I)) IVCOMP = 1 07840909 + IF (IVCOMP - 1) 40271, 10270, 40271 07850909 +40271 CONTINUE 07860909 + GO TO 20270 07870909 +10270 IVPASS = IVPASS + 1 07880909 + WRITE (NUVI, 80002) IVTNUM 07890909 + GO TO 0271 07900909 +20270 IVFAIL = IVFAIL + 1 07910909 + CVCORR = '34 +34.983 .95830D+04 F .FALSE.1 .34530E+03' 07920909 + REMRKS = 'COMPUTED VALUE NOT CONSISTENT' 07930909 + WRITE (NUVI, 80008) IVTNUM, REMRKS 07940909 + REMRKS = 'WITH PERMISSIBLE OPTIONS ABOVE' 07950909 + WRITE (NUVI, 80050) REMRKS 07960909 + WRITE (NUVI, 70010) (A97E1(I), I = 1,54) 07970909 + WRITE (NUVI, 70020) (A97E1(I), I= 55,97) 07980909 + WRITE (NUVI, 70030) (A97E2(I), I = 1,54) 07990909 + WRITE (NUVI, 70040) (A97E2(I), I= 55,97) 08000909 + 0271 CONTINUE 08010909 +C***** 08020909 +CBB** ********************** BBCSUM0 **********************************08030909 +C**** WRITE OUT TEST SUMMARY 08040909 +C**** 08050909 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 08060909 + WRITE (I02, 90004) 08070909 + WRITE (I02, 90014) 08080909 + WRITE (I02, 90004) 08090909 + WRITE (I02, 90020) IVPASS 08100909 + WRITE (I02, 90022) IVFAIL 08110909 + WRITE (I02, 90024) IVDELE 08120909 + WRITE (I02, 90026) IVINSP 08130909 + WRITE (I02, 90028) IVTOTN, IVTOTL 08140909 +CBE** ********************** BBCSUM0 **********************************08150909 +CBB** ********************** BBCFOOT0 **********************************08160909 +C**** WRITE OUT REPORT FOOTINGS 08170909 +C**** 08180909 + WRITE (I02,90016) ZPROG, ZPROG 08190909 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 08200909 + WRITE (I02,90019) 08210909 +CBE** ********************** BBCFOOT0 **********************************08220909 +CBB** ********************** BBCFMT0A **********************************08230909 +C**** FORMATS FOR TEST DETAIL LINES 08240909 +C**** 08250909 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 08260909 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 08270909 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 08280909 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 08290909 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 08300909 + 1I6,/," ",15X,"CORRECT= " ,I6) 08310909 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08320909 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 08330909 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08340909 + 1A21,/," ",16X,"CORRECT= " ,A21) 08350909 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 08360909 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 08370909 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 08380909 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 08390909 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 08400909 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 08410909 +80050 FORMAT (" ",48X,A31) 08420909 +CBE** ********************** BBCFMT0A **********************************08430909 +CBB** ********************** BBCFMAT1 **********************************08440909 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 08450909 +C**** 08460909 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08470909 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 08480909 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 08490909 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 08500909 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 08510909 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 08520909 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 08530909 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 08540909 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08550909 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 08560909 + 2"(",F12.5,", ",F12.5,")") 08570909 +CBE** ********************** BBCFMAT1 **********************************08580909 +CBB** ********************** BBCFMT0B **********************************08590909 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 08600909 +C**** 08610909 +90002 FORMAT ("1") 08620909 +90004 FORMAT (" ") 08630909 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )08640909 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08650909 +90008 FORMAT (" ",21X,A13,A17) 08660909 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 08670909 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 08680909 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 08690909 + 1 7X,"REMARKS",24X) 08700909 +90014 FORMAT (" ","----------------------------------------------" , 08710909 + 1 "---------------------------------" ) 08720909 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 08730909 +C**** 08740909 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08750909 +C**** 08760909 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 08770909 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 08780909 + 1 A13) 08790909 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 08800909 +C**** 08810909 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 08820909 +C**** 08830909 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 08840909 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 08850909 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 08860909 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 08870909 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 08880909 +CBE** ********************** BBCFMT0B **********************************08890909 +C***** 08900909 +C***** END OF TEST SEGMENT 393 08910909 + STOP 08920909 + END 08930909 diff --git a/Fortran/UnitTests/fcvs21_f95/FM909.reference_output b/Fortran/UnitTests/fcvs21_f95/FM909.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM909.reference_output @@ -0,0 +1,76 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM909BEGIN* TEST RESULTS - FM909 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INTER4 - (393) INTERNAL FILES -- USING WRITE + + ANS. REF. - 12.2.5 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 27 TESTS + + NOTE 1: FOR NUMERIC VALUES, + OPTIONAL LEADING ZERO MAY BE + BLANK FOR ABSOLUTE VALUE < 1 + NOTE 2: LEADING PLUS SIGN IS + OPTIONAL FOR NUMERIC VALUES + NOTE 3: E FORMAT EXPONENT MAY + BE E+NN OR +0NN FOR REALS + NOTE 4: D FORMAT EXPONENT MAY + BE D+NN, E+NN, OR +0NN FOR + DOUBLE PRECISION VALUES + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS +1 + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + 27 PASS + + ------------------------------------------------------------------------------- + + 27 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 27 OF 27 TESTS EXECUTED + + *FM909END* END OF TEST - FM909 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM910.f b/Fortran/UnitTests/fcvs21_f95/FM910.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM910.f @@ -0,0 +1,515 @@ + PROGRAM FM910 + +C***********************************************************************00010910 +C***** FM910 00020910 +C***** DIRAF2 - (411) 00030910 +C***** THIS PROGRAM CALLS SUBROUTINE SN911 IN FILE FM911 00040910 +C***********************************************************************00050910 +C***** TESTING OF DIRECT ACCESS FILES ANS REF 00060910 +C***** UNFORMATTED WITH BOTH SEQUENTIAL AND DIRECT 12.5 00070910 +C***** ACCESS TO THE SAME FILE 00080910 +C***** NAMED FILE AND SCRATCH FILE 00090910 +C***** 00100910 +C***** USES SUBROUTINE SN911 00110910 +C***** 00120910 +CBB** ********************** BBCCOMNT **********************************00130910 +C**** 00140910 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00150910 +C**** VERSION 2.1 00160910 +C**** 00170910 +C**** 00180910 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00190910 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00200910 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00210910 +C**** BUILDING 225 RM A266 00220910 +C**** GAITHERSBURG, MD 20899 00230910 +C**** 00240910 +C**** 00250910 +C**** 00260910 +CBE** ********************** BBCCOMNT **********************************00270910 +C***** 00280910 +C***** S P E C I F I C A T I O N S SEGMENT 910 00290910 + DIMENSION L1I(10), N1I(15), F1S(10), H1S(15) 00300910 + CHARACTER*4 A4VK, B4VK, D4VK, A41K(10), C41K(15) 00310910 + LOGICAL AVB, BVB, C1B(10), E1B(15) 00320910 + DOUBLE PRECISION AVD, BVD, D1D(10), B1D(15) 00330910 + COMPLEX AVC, BVC, C1C(10), D1C(15) 00340910 +C***** 00350910 +C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00360910 +CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING 00370910 + CHARACTER*15 CDIR 00380910 +C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-100 00390910 +C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR. 00400910 +CBB** ********************** BBCINITA **********************************00410910 +C**** SPECIFICATION STATEMENTS 00420910 +C**** 00430910 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00440910 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00450910 +CBE** ********************** BBCINITA **********************************00460910 +CBB** ********************** BBCINITB **********************************00470910 +C**** INITIALIZE SECTION 00480910 + DATA ZVERS, ZVERSD, ZDATE 00490910 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00500910 + DATA ZCOMPL, ZNAME, ZTAPE 00510910 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00520910 + DATA ZPROJ, ZTAPED, ZPROG 00530910 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00540910 + DATA REMRKS /' '/ 00550910 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00560910 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00570910 +C**** 00580910 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00590910 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00600910 +CZ03 ZPROG = 'PROGRAM NAME' 00610910 +CZ04 ZDATE = 'DATE OF TEST' 00620910 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00630910 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00640910 +CZ07 ZNAME = 'NAME OF USER' 00650910 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00660910 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00670910 +C 00680910 + IVPASS = 0 00690910 + IVFAIL = 0 00700910 + IVDELE = 0 00710910 + IVINSP = 0 00720910 + IVTOTL = 0 00730910 + IVTOTN = 0 00740910 + ICZERO = 0 00750910 +C 00760910 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00770910 + I01 = 05 00780910 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00790910 + I02 = 06 00800910 +C 00810910 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00820910 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00830910 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00840910 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00850910 +C 00860910 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00870910 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00880910 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00890910 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00900910 +C 00910910 +CBE** ********************** BBCINITB **********************************00920910 +C***** 00930910 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE 00940910 +C***** UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED. 00950910 +C***** 00960910 +C I10 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE. 00970910 + I10 = 786 00980910 +CX100 REPLACED BY FEXEC X-100 CONTROL CARD (DIR. FILE UNIT NUMBER). 00990910 +C SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24. 01000910 +C***** 01010910 +C I11 CONTAINS THE UNIT NUMBER FOR A SCRATCH DIRECT ACCESS FILE. 01020910 + I11 = 785 01030910 +CX110 REPLACED BY FEXEC X-110 CONTROL CARD (DIR. FILE UNIT NUMBER). 01040910 +C SPECIFYING I11 = NN OVERRIDES THE DEFAULT I11 = 25. 01050910 +C***** 01060910 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01070910 +C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 01080910 +C***** UNFORMATTED FILE. 01090910 +C***** 01100910 +C CDIR CONTAINS THE FILE NAME FOR UNIT I10. 01110910 + CDIR = ' DIRFILE910' 01120910 +C 01130910 +CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS 01140910 +C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 01150910 +C X-100 THAN THE DEFAULT CDIR = ' DIRFILE'. 01160910 +C***** FILE NUMBER AND NAME ASSIGNMENT 01170910 + NUVI = I02 01180910 + IMVI = I10 01190910 + KMVI = I11 01200910 + IVTOTL = 6 01210910 + ZPROG = 'FM910' 01220910 +CBB** ********************** BBCHED0A **********************************01230910 +C**** 01240910 +C**** WRITE REPORT TITLE 01250910 +C**** 01260910 + WRITE (I02, 90002) 01270910 + WRITE (I02, 90006) 01280910 + WRITE (I02, 90007) 01290910 + WRITE (I02, 90008) ZVERS, ZVERSD 01300910 + WRITE (I02, 90009) ZPROG, ZPROG 01310910 + WRITE (I02, 90010) ZDATE, ZCOMPL 01320910 +CBE** ********************** BBCHED0A **********************************01330910 +C***** 01340910 +C***** HEADER FOR SEGMENT 910 01350910 + WRITE(NUVI,41100) 01360910 +41100 FORMAT(" ",/" DIRAF2 - (411) DIRECT ACCESS UNFORMATTED FILE" // 01370910 + 1 " WITH OPTION TO OPEN AS A SEQUENTIAL FILE" // 01380910 + 2 " ANS REF. - 12.5" ) 01390910 +CBB** ********************** BBCHED0B **********************************01400910 +C**** WRITE DETAIL REPORT HEADERS 01410910 +C**** 01420910 + WRITE (I02,90004) 01430910 + WRITE (I02,90004) 01440910 + WRITE (I02,90013) 01450910 + WRITE (I02,90014) 01460910 + WRITE (I02,90015) IVTOTL 01470910 +CBE** ********************** BBCHED0B **********************************01480910 +C***** INITIALIZE DATA 01490910 + CALL SN911(L1I,N1I,F1S,H1S,C1B,E1B,D1D,B1D,C1C,D1C,A41K,C41K) 01500910 + MMVI = 0 01510910 +C***** 01520910 + OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT',RECL=132, 01530910 + 1 STATUS='NEW') 01540910 +C***** WRITE DIRECT FILE IN SEQUENTIAL ORDER 01550910 + DO 41101 IVI = 1,10 01560910 + AVS = F1S (IVI) 01570910 + A4VK = A41K (IVI) 01580910 + AVB = C1B (IVI) 01590910 + AVD = D1D (IVI) 01600910 + AVC = C1C (IVI) 01610910 + WRITE(UNIT=IMVI, REC= IVI) IVI, AVS, A4VK, AVB, AVD, AVC 01620910 +41101 CONTINUE 01630910 +C***** CHECK TO SEE IF IT CAN BE OPEN SEQUENTIAL 01640910 + INQUIRE(UNIT=IMVI,SEQUENTIAL=D4VK) 01650910 + CLOSE(UNIT=IMVI) 01660910 + IF(D4VK .EQ. 'YES ') GOTO 41103 01670910 + WRITE(NUVI,41102) 01680910 +41102 FORMAT(" ",48X,"TESTS 2 THRU 6 ARE EXPECTED TO " / 01690910 + 1 " ",48X,"EXECUTE " / 01700910 + 2 " ",48X,"TEST 1 IS OPTIONAL AND IS NOT " / 01710910 + 3 " ",48X,"EXECUTED IF DIRECT ACCESS " / 01720910 + 4 " ",48X,"FILE CANNOT BE REOPENED AS " / 01730910 + 5 " ",48X,"A SEQUENTIAL FILE " ) 01740910 + GOTO 41119 01750910 +CT001* TEST 1 READ IT SEQUENTIALY 01760910 +41103 IVTNUM = 1 01770910 + IVCOMP = 0 01780910 + OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='SEQUENTIAL', STATUS='OLD', 01790910 + 1 FORM='UNFORMATTED') 01800910 + REWIND(UNIT=IMVI) 01810910 + DO 41104 IVI = 1, 10 01820910 + READ(UNIT=IMVI) KVI, BVS, B4VK, BVB, BVD, BVC 01830910 + IF (IVI .NE. KVI) GOTO 20010 01840910 + IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20010 01850910 + IF (B4VK .NE. A41K(IVI)) GOTO 20010 01860910 + IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 01870910 + 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20010 01880910 + IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20010 01890910 + IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT. 01900910 + 1 REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI))) 01910910 + 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20010 01920910 + GO TO 41104 01930910 +20010 IVCOMP = IVCOMP + 1 01940910 + IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 01950910 + WRITE (NUVI, 70010) IVTNUM, IVI 01960910 + WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI, 01970910 + 1 F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI), 01980910 + 1 C1C(IVI) 01990910 +70010 FORMAT (" ",2X,I3,4X," FAIL ON REC " ,I2) 02000910 +70020 FORMAT (" ",16X,"COMPUTED: " ,I2,1X,F5.2,1X,A4,1X,L1,1X, 02010910 + 1 D10.3,1X,"(",F6.3,", ",F6.3,")"/02020910 + 1 " ",16X,"CORRECT: " ,I2,1X,F5.2,1X,A4,1X,L1,1X, 02030910 + 1 D10.3,1X,"(",F6.3,", ",F6.3,")")02040910 +41104 CONTINUE 02050910 + IF (IVCOMP - 0) 0011, 10010, 0011 02060910 +10010 IVPASS = IVPASS + 1 02070910 + WRITE (NUVI, 80002) IVTNUM 02080910 + 0011 CONTINUE 02090910 +C***** 02100910 +41118 CLOSE(UNIT=IMVI) 02110910 +CT002* TEST 2 REOPEN AS DIRECT FILE, 02120910 +C***** AND READ IN SEQUENTIAL ORDER 02130910 +41119 IVTNUM = 2 02140910 + IVCOMP = 0 02150910 +C***** 02160910 + OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD', 02170910 + 1 RECL=132) 02180910 + DO 41120 IVI = 1, 10 02190910 + READ(UNIT=IMVI, REC = IVI) KVI, BVS, B4VK, BVB, BVD, BVC 02200910 + IF (IVI .NE. KVI) GOTO 20020 02210910 + IF (BVS .LT. F1S(IVI) .OR. BVS .GT. F1S(IVI)) GOTO 20020 02220910 + IF (B4VK .NE. A41K(IVI)) GOTO 20020 02230910 + IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 02240910 + 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 20020 02250910 + IF (BVD .LT. D1D(IVI) .OR. BVD .GT. D1D(IVI)) GOTO 20020 02260910 + IF ((REAL(BVC) .LT. REAL(C1C(IVI))) .OR. (REAL(BVC) .GT. 02270910 + 1 REAL(C1C(IVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(IVI))) 02280910 + 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(IVI)))) GOTO 20020 02290910 + GO TO 41120 02300910 +20020 IVCOMP = IVCOMP + 1 02310910 + IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 02320910 + WRITE (NUVI, 70010) IVTNUM, IVI 02330910 + WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, IVI, 02340910 + 1 F1S(IVI), A41K(IVI), C1B(IVI), D1D(IVI), 02350910 + 1 C1C(IVI) 02360910 +41120 CONTINUE 02370910 + IF (IVCOMP - 0) 0021, 10020, 0021 02380910 +10020 IVPASS = IVPASS + 1 02390910 + WRITE (NUVI, 80002) IVTNUM 02400910 + 0021 CONTINUE 02410910 +C***** 02420910 +41121 CLOSE(UNIT=IMVI) 02430910 +CT003* TEST 3 READ IT AS DIRECT 02440910 +C***** FILE IN NONSEQUENTIAL ORDER 02450910 + IVTNUM = 3 02460910 + IVCOMP = 0 02470910 +C***** 02480910 + OPEN(FILE=CDIR, UNIT=IMVI, ACCESS='DIRECT', STATUS='OLD', 02490910 + 1 RECL=132) 02500910 + DO 41122 IVI = 1, 10 02510910 + JVI = L1I(IVI) 02520910 + READ(UNIT=IMVI, REC = JVI) KVI, BVS, B4VK, BVB, BVD, BVC 02530910 + IF (KVI .NE. JVI) GOTO 20030 02540910 + IF (BVS .LT. F1S(JVI) .OR. BVS .GT. F1S(JVI)) GOTO 20030 02550910 + IF (B4VK .NE. A41K(JVI)) GOTO 20030 02560910 + IF ((BVB .AND. .NOT. C1B(JVI)) .OR. 02570910 + 1 (.NOT. BVB .AND. C1B(JVI))) GOTO 20030 02580910 + IF (BVD .LT. D1D(JVI) .OR. BVD .GT. D1D(JVI)) GOTO 20030 02590910 + IF ((REAL(BVC) .LT. REAL(C1C(JVI))) .OR. (REAL(BVC) .GT. 02600910 + 1 REAL(C1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(C1C(JVI))) 02610910 + 2 .OR. (AIMAG(BVC) .GT. AIMAG(C1C(JVI)))) GOTO 20030 02620910 + GO TO 41122 02630910 +20030 IVCOMP = IVCOMP + 1 02640910 + IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 02650910 + WRITE (NUVI, 70010) IVTNUM, JVI 02660910 + WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI, 02670910 + 1 F1S(JVI), A41K(JVI), C1B(JVI), D1D(JVI), 02680910 + 1 C1C(JVI) 02690910 +41122 CONTINUE 02700910 + IF (IVCOMP - 0) 0031, 10030, 0031 02710910 +10030 IVPASS = IVPASS + 1 02720910 + WRITE (NUVI, 80002) IVTNUM 02730910 + 0031 CONTINUE 02740910 +C***** 02750910 +41123 OPEN(UNIT=KMVI, ACCESS='DIRECT', RECL=80, STATUS='SCRATCH') 02760910 +C***** 02770910 +CT004* TEST 4 CHECK RECL AND NEXTREC ON SCRATCH FILE 02780910 + IVTNUM = 4 02790910 + INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI) 02800910 + IF (IVI .NE. 80) GOTO 20040 02810910 + IF (KVI .NE. 1) GOTO 20040 02820910 +10040 IVPASS = IVPASS + 1 02830910 + WRITE (NUVI, 80002) IVTNUM 02840910 + GO TO 0041 02850910 +20040 IVFAIL = IVFAIL + 1 02860910 + WRITE (NUVI, 70030) IVTNUM 02870910 + WRITE (NUVI, 70040) IVI, KVI 02880910 +70030 FORMAT (" ",2X,I3,4X," FAIL ON RECL AND/OR NEXTREC" ) 02890910 +70040 FORMAT (" ",16X,"COMPUTED: RECL=" ,I4,", NEXTREC=" ,I4/ 02900910 + 1 " ",16X,"CORRECT: RECL= 80, NEXTREC= 1" ) 02910910 + 0041 CONTINUE 02920910 +C***** 02930910 +C***** WRITE DIRECT ACCESS 02940910 +C***** SCRATCH FILE IN NONSEQUENTIAL ORDER 02950910 + DO 41126 IVI = 1,15 02960910 + JVI = N1I (IVI) 02970910 + AVS = H1S (JVI) 02980910 + A4VK = C41K (JVI) 02990910 + AVB = E1B (JVI) 03000910 + AVC = D1C(JVI) 03010910 + AVD = B1D(JVI) 03020910 + WRITE(UNIT=KMVI, REC= JVI) AVB, AVC, A4VK, JVI, AVD, AVS 03030910 +41126 CONTINUE 03040910 +CT005* TEST 5 CHECK DIRECT ACCESS SCRATCH FILE 03050910 +C***** BY READING IT IN NONSEQUENTIAL ORDER 03060910 + IVTNUM = 5 03070910 + IVCOMP = 0 03080910 + MMVI = -1 03090910 + DO 41127 IVI = 15,1,-1 03100910 + JVI = N1I (IVI) 03110910 + READ(UNIT=KMVI, REC = JVI) BVB, BVC, B4VK, KVI, BVD, BVS 03120910 + IF (KVI .NE. JVI) GOTO 20050 03130910 + IF (BVS .LT. H1S(JVI) .OR. BVS .GT. H1S(JVI)) GOTO 20050 03140910 + IF (B4VK .NE. C41K(JVI)) GOTO 20050 03150910 + IF ((BVB .AND. .NOT. E1B(JVI)) .OR. 03160910 + 1 (.NOT. BVB .AND. E1B(JVI))) GOTO 20050 03170910 + IF (BVD .LT. B1D(JVI) .OR. BVD .GT. B1D(JVI)) GOTO 20050 03180910 + IF ((REAL(BVC) .LT. REAL(D1C(JVI))) .OR. (REAL(BVC) .GT. 03190910 + 1 REAL(D1C(JVI))) .OR. (AIMAG(BVC) .LT. AIMAG(D1C(JVI))) 03200910 + 2 .OR. (AIMAG(BVC) .GT. AIMAG(D1C(JVI)))) GOTO 20050 03210910 + GO TO 41127 03220910 +20050 IVCOMP = IVCOMP + 1 03230910 + IF (IVCOMP .LE. 1) IVFAIL = IVFAIL + 1 03240910 + WRITE (NUVI, 70010) IVTNUM, JVI 03250910 + WRITE (NUVI, 70020) KVI, BVS, B4VK, BVB, BVD, BVC, JVI, 03260910 + 1 H1S(JVI), C41K(JVI), E1B(JVI), B1D(JVI), 03270910 + 1 D1C(JVI) 03280910 +41127 CONTINUE 03290910 + IF (IVCOMP - 0) 0051, 10050, 0051 03300910 +10050 IVPASS = IVPASS + 1 03310910 + WRITE (NUVI, 80002) IVTNUM 03320910 + 0051 CONTINUE 03330910 +C***** 03340910 +CT006* TEST 6 CHECK RECL AND NEXTREC AFTER READING 03350910 + IVTNUM = 6 03360910 + INQUIRE(UNIT=KMVI,RECL=IVI,NEXTREC=KVI) 03370910 + IF (IVI .NE. 80) GOTO 20060 03380910 + IF (KVI .NE. 6) GOTO 20060 03390910 +10060 IVPASS = IVPASS + 1 03400910 + WRITE (NUVI, 80002) IVTNUM 03410910 + GO TO 0061 03420910 +20060 IVFAIL = IVFAIL + 1 03430910 + WRITE (NUVI, 70050) IVTNUM 03440910 + WRITE (NUVI, 70060) IVI, KVI 03450910 +70050 FORMAT (" ",2X,I3,4X," FAIL ON RECL AND/OR NEXTREC" ) 03460910 +70060 FORMAT (" ",16X,"COMPUTED: RECL=" ,I4,", NEXTREC=" ,I4/ 03470910 + 1 " ",16X,"CORRECT: RECL= 80, NEXTREC= 6" ) 03480910 + 0061 CONTINUE 03490910 +C***** 03500910 + CLOSE (UNIT=IMVI,STATUS='DELETE') 03510910 +C***** 03520910 +C**** 04070910 +CBB** ********************** BBCSUM0 **********************************04080910 +C**** WRITE OUT TEST SUMMARY 04090910 +C**** 04100910 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 04110910 + WRITE (I02, 90004) 04120910 + WRITE (I02, 90014) 04130910 + WRITE (I02, 90004) 04140910 + WRITE (I02, 90020) IVPASS 04150910 + WRITE (I02, 90022) IVFAIL 04160910 + WRITE (I02, 90024) IVDELE 04170910 + WRITE (I02, 90026) IVINSP 04180910 + WRITE (I02, 90028) IVTOTN, IVTOTL 04190910 +CBE** ********************** BBCSUM0 **********************************04200910 +CBB** ********************** BBCFOOT0 **********************************04210910 +C**** WRITE OUT REPORT FOOTINGS 04220910 +C**** 04230910 + WRITE (I02,90016) ZPROG, ZPROG 04240910 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 04250910 + WRITE (I02,90019) 04260910 +CBE** ********************** BBCFOOT0 **********************************04270910 +CBB** ********************** BBCFMT0A **********************************04280910 +C**** FORMATS FOR TEST DETAIL LINES 04290910 +C**** 04300910 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 04310910 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 04320910 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 04330910 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 04340910 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 04350910 + 1I6,/," ",15X,"CORRECT= " ,I6) 04360910 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04370910 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 04380910 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04390910 + 1A21,/," ",16X,"CORRECT= " ,A21) 04400910 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 04410910 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 04420910 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 04430910 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 04440910 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 04450910 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 04460910 +80050 FORMAT (" ",48X,A31) 04470910 +CBE** ********************** BBCFMT0A **********************************04480910 +CBB** ********************** BBCFMAT1 **********************************04490910 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 04500910 +C**** 04510910 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04520910 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 04530910 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 04540910 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 04550910 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04560910 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 04570910 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04580910 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 04590910 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 04600910 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 04610910 + 2"(",F12.5,", ",F12.5,")") 04620910 +CBE** ********************** BBCFMAT1 **********************************04630910 +CBB** ********************** BBCFMT0B **********************************04640910 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 04650910 +C**** 04660910 +90002 FORMAT ("1") 04670910 +90004 FORMAT (" ") 04680910 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )04690910 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 04700910 +90008 FORMAT (" ",21X,A13,A17) 04710910 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 04720910 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 04730910 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 04740910 + 1 7X,"REMARKS",24X) 04750910 +90014 FORMAT (" ","----------------------------------------------" , 04760910 + 1 "---------------------------------" ) 04770910 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 04780910 +C**** 04790910 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 04800910 +C**** 04810910 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 04820910 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 04830910 + 1 A13) 04840910 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 04850910 +C**** 04860910 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 04870910 +C**** 04880910 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 04890910 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 04900910 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 04910910 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 04920910 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 04930910 +CBE** ********************** BBCFMT0B **********************************04940910 +C***** 04950910 +C***** END OF TEST SEGMENT 910 04960910 + STOP 04970910 + END 04980910 + +C********************************************************************** 00010911 +C***** FM911 00020911 +C***** 00030911 +C***** SN911 EAQ - (806) 00040911 +C***** THIS SUBROUTINE IS CALLED BY FM910 00050911 +C********************************************************************** 00060911 + SUBROUTINE SN911(LW1I, NW1I, FW1S, HW1S, CW1B, EW1B, DW1D, 00070911 + 1 BW1D,CW1C, DW1C, A4W1K, C4W1K) 00080911 +C***** 00090911 +C***** SUBROUTINE USED WITH SEGMENT DIRAF2 (411) TO SUPPLY VALUES 00100911 +C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST 00110911 +C***** 00120911 + DIMENSION LW1I(10),LT1I(10),NT1I(15),NW1I(15) 00130911 + REAL FT1S(10),FW1S(10),HT1S(15),HW1S(15) 00140911 + LOGICAL CT1B(10),CW1B(10),ET1B(15),EW1B(15) 00150911 + DOUBLE PRECISION DT1D(10),DW1D(10),BT1D(15),BW1D(15) 00160911 + COMPLEX CW1C(10),CT1C(10),DW1C(15),DT1C(15) 00170911 + CHARACTER*4 A4T1K(10),A4W1K(10),C4T1K(15),C4W1K(15) 00180911 +C***** 00190911 + DATA LT1I /2, 3, 1, 3, 10, 8, 9, 6, 7, 5/ 00200911 + DATA NT1I /5, 7, 3, 9, 4, 11, 8, 13, 14, 12, 6, 10, 2, 15, 1/ 00210911 + DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0, 6.5, 7.1, 8.2, 9.9, 10.0/ 00220911 + DATA HT1S /2.34, 2.3,1.9, 2.3, 9.9, 1.1, 8.8, 7.6, 2.3, 10.1, 00230911 + 1 3.4, 5.60, 34.9, 3.48, 23.8/ 00240911 + DATA A4T1K / 'AAAA', 'BBBB', 'CCCC', 'DDDD', 'EDFG', 'JLKD'00250911 + 1 , 'CDFE', 'LKJH', 'JHGF', 'LLLL'/ 00260911 + DATA C4T1K / 'HDFK', 'LKJH', 'ASDF', 'LKJH', 'XMNC', 'ALXM'00270911 + 1 , 'IEOW', 'IERU', 'DJNC', 'DJAL', 'KDFJ', 'ABCD'00280911 + 2 , 'ASDF', 'GHJK', 'QWER'/ 00290911 + DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .TRUE., .FALSE., 00300911 + 1 .FALSE., .TRUE., .TRUE., .FALSE./ 00310911 + DATA ET1B /.FALSE., .FALSE., .FALSE., .TRUE., .FALSE., .FALSE., 00320911 + 1 .TRUE., .TRUE., .FALSE., .TRUE., .TRUE., .TRUE., 00330911 + 2 .FALSE., .TRUE., .FALSE./ 00340911 + DATA DT1D /1.23D1, 2.34D1, 3.45D3, 4.56D4, 5.602D0, 34.35D1, 00350911 + 1 2.34D1, 398.0D0, 3.49D-1, 0.99D1/ 00360911 + DATA BT1D /3.45D1, 34.5D0, 34.5D4, 2.93D3, 0.09D-2, 3.4D-1, 00370911 + 1 34.0D1, 85.0D1, 3.968D0, 3.48D1, 39.3D4, 0.09D3, 00380911 + 2 389.098D1, 483.98D0, 3456.0D-4/ 00390911 + DATA CT1C /(1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9), 00400911 + 1 (2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2), 00410911 + 2 (2.56, 2.1), (3.4, 4.5)/ 00420911 + DATA DT1C /(2.3, 3.9), (3.98, 8.9), (3.112, 3.4), (8.0, 1.2), 00430911 + 1 (2.56, 2.1), (3.4, 4.5), (3.4, 34.9), (9.0, 34.9), 00440911 + 2 (1.2, 3.4), (9.8, 34.5), (3.4, 34.9), (9.0, 34.9), 00450911 + 3 (3.112, 3.4), (8.0, 1.2), (3.112, 3.4)/ 00460911 + 00470911 +C***** 00480911 + DO 1 IVI = 1, 10 00490911 + LW1I(IVI) = LT1I(IVI) 00500911 + FW1S(IVI) = FT1S(IVI) 00510911 + CW1B(IVI) = CT1B(IVI) 00520911 + DW1D(IVI) = DT1D(IVI) 00530911 + CW1C(IVI) = CT1C(IVI) 00540911 + A4W1K(IVI) = A4T1K(IVI) 00550911 +1 CONTINUE 00560911 +C***** 00570911 + DO 2 IVI = 1, 15 00580911 + NW1I(IVI) = NT1I(IVI) 00590911 + HW1S(IVI) = HT1S(IVI) 00600911 + EW1B(IVI) = ET1B(IVI) 00610911 + BW1D(IVI) = BT1D(IVI) 00620911 + DW1C(IVI) = DT1C(IVI) 00630911 + C4W1K(IVI) = C4T1K(IVI) 00640911 +2 CONTINUE 00650911 +C***** 00660911 + RETURN 00670911 + END 00680911 diff --git a/Fortran/UnitTests/fcvs21_f95/FM910.reference_output b/Fortran/UnitTests/fcvs21_f95/FM910.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM910.reference_output @@ -0,0 +1,45 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM910BEGIN* TEST RESULTS - FM910 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + DIRAF2 - (411) DIRECT ACCESS UNFORMATTED FILE + + WITH OPTION TO OPEN AS A SEQUENTIAL FILE + + ANS REF. - 12.5 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 6 TESTS + + TESTS 2 THRU 6 ARE EXPECTED TO + EXECUTE + TEST 1 IS OPTIONAL AND IS NOT + EXECUTED IF DIRECT ACCESS + FILE CANNOT BE REOPENED AS + A SEQUENTIAL FILE + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + + ------------------------------------------------------------------------------- + + 5 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 5 OF 6 TESTS EXECUTED + + *FM910END* END OF TEST - FM910 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM912.f b/Fortran/UnitTests/fcvs21_f95/FM912.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM912.f @@ -0,0 +1,938 @@ + PROGRAM FM912 + +C***********************************************************************00010912 +C***** FORTRAN 77 00020912 +C***** FM912 00030912 +C***** DIRAF3 - (412) 00040912 +C***** THIS PROGRAM CALLS SUBROUTINE SN913 IN FILE FM913 00050912 +C***********************************************************************00060912 +C***** TESTING OF DIRECT ACCESS FILES ANS REF 00070912 +C***** FORMATTED, WITH BOTH SEQUENTIAL AND DIRECT 12.5 00080912 +C***** ACCESS TO THE SAME FILE 00090912 +C***** 00100912 +C***** USES SUBROUTINE SN913 FAQ 00110912 +C***** 00120912 +C***** S P E C I F I C A T I O N S SEGMENT 412 00130912 +C***********************************************************************00140912 + DIMENSION F1S(10), G1S(10) 00150912 + CHARACTER*20 A20VK, B20VK, C20VK, A201K(10), B201K(10) 00160912 + CHARACTER*47 A47VK, B47VK, C47VK 00170912 + CHARACTER*51 A51VK 00180912 + CHARACTER*12 A12VK 00190912 + CHARACTER A120VK*120, B120VK*120, A1VK*1, A4VK*4 00200912 + CHARACTER*31 REMK,REMK1,REMK2,REMK3,REMK4,REMK5,REMK45 00210912 + LOGICAL AVB, BVB, CVB, C1B(10), D1B(10) 00220912 + DOUBLE PRECISION AVD, BVD, CVD, DVD, D1D(10), B1D(15) 00230912 +C***** 00240912 +C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00250912 +CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING 00260912 + CHARACTER*15 CDIR 00270912 +C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-130 00280912 +C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR. 00290912 +CBB** ********************** BBCINITA **********************************00300912 +C**** SPECIFICATION STATEMENTS 00310912 +C**** 00320912 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00330912 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00340912 +CBE** ********************** BBCINITA **********************************00350912 +CBB** ********************** BBCINITB **********************************00360912 +C**** INITIALIZE SECTION 00370912 + DATA ZVERS, ZVERSD, ZDATE 00380912 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00390912 + DATA ZCOMPL, ZNAME, ZTAPE 00400912 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00410912 + DATA ZPROJ, ZTAPED, ZPROG 00420912 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00430912 + DATA REMRKS /' '/ 00440912 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00450912 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00460912 +C**** 00470912 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00480912 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00490912 +CZ03 ZPROG = 'PROGRAM NAME' 00500912 +CZ04 ZDATE = 'DATE OF TEST' 00510912 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00520912 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00530912 +CZ07 ZNAME = 'NAME OF USER' 00540912 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00550912 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00560912 +C 00570912 + IVPASS = 0 00580912 + IVFAIL = 0 00590912 + IVDELE = 0 00600912 + IVINSP = 0 00610912 + IVTOTL = 0 00620912 + IVTOTN = 0 00630912 + ICZERO = 0 00640912 +C 00650912 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00660912 + I01 = 05 00670912 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00680912 + I02 = 06 00690912 +C 00700912 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00710912 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00720912 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00730912 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00740912 +C 00750912 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00760912 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00770912 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00780912 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00790912 +C 00800912 +CBE** ********************** BBCINITB **********************************00810912 +C***** 00820912 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE 00830912 +C***** UNITS GIVEN ARE NOT CAPABLE OF BEING OPENED AS SPECIFIED. 00840912 +C***** 00850912 +C I13 CONTAINS THE UNIT NUMBER FOR A NAMED DIRECT ACCESS FILE. 00860912 + I13 = 936 00870912 +CX130 REPLACED BY FEXEC X-130 CONTROL CARD (DIR. FILE UNIT NUMBER). 00880912 +C SPECIFYING I13 = NN OVERRIDES THE DEFAULT I13 = 24. 00890912 +C 00900912 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 00910912 +C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 00920912 +C***** FORMATTED FILE. 00930912 +C***** 00940912 +C CDIR CONTAINS THE FILE NAME FOR UNIT I13. 00950912 + CDIR = ' DIRFILE912' 00960912 +C 00970912 +CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS 00980912 +C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 00990912 +C X-130 THAN THE DEFAULT CDIR = ' DIRFILE'. 01000912 +C 01010912 +C***** FILE NUMBER AND NAME ASSIGNMENT 01020912 + NUVI = I02 01030912 + KUVI = I13 01040912 + IVTOTL = 26 01050912 + ZPROG = 'FM912' 01060912 +C***** 01070912 +C***** FILE NUMBER AND NAME ASSIGNMENT 01080912 +C***** 01090912 + REMK1='RECORD 1 - ERR PATH TAKEN' 01100912 + REMK2='RECORD 2 - ERR PATH TAKEN' 01110912 + REMK3='RECORD 3 - ERR PATH TAKEN' 01120912 + REMK4='RECORD 4 - ERR PATH TAKEN' 01130912 + REMK5='RECORD 5 - ERR PATH TAKEN' 01140912 + REMK45='RECORD 4 + 5 - ERR PATH TAKEN' 01150912 +CBB** ********************** BBCHED0A **********************************01160912 +C**** 01170912 +C**** WRITE REPORT TITLE 01180912 +C**** 01190912 + WRITE (I02, 90002) 01200912 + WRITE (I02, 90006) 01210912 + WRITE (I02, 90007) 01220912 + WRITE (I02, 90008) ZVERS, ZVERSD 01230912 + WRITE (I02, 90009) ZPROG, ZPROG 01240912 + WRITE (I02, 90010) ZDATE, ZCOMPL 01250912 +CBE** ********************** BBCHED0A **********************************01260912 + WRITE(NUVI,41200) 01270912 +41200 FORMAT( " ",/" DIRAF3 - (412) DIRECT ACCESS FORMATTED FILE" / 01280912 + 1 " WITH OPTION TO OPEN AS A SEQUENTIAL FILE" / 01290912 + 2 " ANS REF. - 12.5" ) 01300912 +CBB** ********************** BBCHED0B **********************************01310912 +C**** WRITE DETAIL REPORT HEADERS 01320912 +C**** 01330912 + WRITE (I02,90004) 01340912 + WRITE (I02,90004) 01350912 + WRITE (I02,90013) 01360912 + WRITE (I02,90014) 01370912 + WRITE (I02,90015) IVTOTL 01380912 +CBE** ********************** BBCHED0B **********************************01390912 +C***** 01400912 +C***** PLUS OR MINUS VALUES 01410912 +C***** 01420912 + CVS = 0.0001 01430912 + CVD = 0.0001D0 01440912 +C***** 01450912 +C***** INITIALIZE DATA ARRAYS 01460912 +C***** 01470912 + CALL SN913(F1S,G1S,C1B,D1B,D1D,B1D,A201K,B201K) 01480912 +C***** 01490912 +C***** OPEN DIRECT ACCESS FILE - STATUS=NEW 01500912 +C***** 01510912 + OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',RECL=120, 01520912 + 1 FORM='FORMATTED',STATUS='NEW') 01530912 +C***** 01540912 +CT001* TEST 1 - CHECKS RECL AND NEXTREC 01550912 +C***** FOR JUST OPENED DIRECT ACCESS FILE 01560912 +C***** 01570912 + IVTNUM=1 01580912 + INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI) 01590912 + IF (IVI .NE. 120) GO TO 33020 01600912 + IF (KVI .NE. 1) GO TO 33020 01610912 + WRITE(NUVI,80002)IVTNUM 01620912 + IVPASS=IVPASS+1 01630912 + GO TO 33030 01640912 +33020 REMK='ERROR IN INQUIRE' 01650912 + WRITE(NUVI,55010)IVTNUM,REMK 01660912 +55010 FORMAT(" ","TEST ",I3,1X," FAIL",34X,A31) 01670912 + IVFAIL=IVFAIL+1 01680912 + WRITE(NUVI,55020)IVI,KVI 01690912 +55020 FORMAT(" ",/,11X,"COMPUTED: RECL=" ,I6,5X,"NEXTREC=",I6) 01700912 + WRITE(NUVI,55030) 01710912 +55030 FORMAT(" ",10X,"CORRECT: RECL= 120" ,5X,"NEXTREC= 1" /) 01720912 +C***** 01730912 +CT002* TEST 2 - WRITES RECORD 1 01740912 +C***** 01750912 +33030 IVTNUM=2 01760912 + IVI = 1 01770912 + AVS = F1S (IVI) 01780912 + BVS = F1S(IVI + 1) 01790912 + A20VK = A201K (IVI) 01800912 + AVB = C1B (IVI) 01810912 + AVD = D1D (IVI) 01820912 + WRITE(UNIT=KUVI,REC=1,FMT=41204,ERR=33040) IVI, AVS, BVS, AVD, 01830912 + 1 AVB, A20VK 01840912 +41204 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 35X, ' LAST RECORD') 01850912 + WRITE(NUVI,80002)IVTNUM 01860912 + IVPASS=IVPASS+1 01870912 + GO TO 33050 01880912 +33040 WRITE(NUVI,55010)IVTNUM,REMK1 01890912 + IVFAIL=IVFAIL+1 01900912 +C***** 01910912 +CT003* TEST 3 - WRITES RECORD 2 01920912 +C***** 01930912 +33050 IVTNUM=3 01940912 + IVI = IVI + 1 01950912 + AVS = F1S (IVI) 01960912 + BVS = F1S(IVI + 1) 01970912 + A20VK = A201K (IVI) 01980912 + AVB = C1B (IVI) 01990912 + AVD = D1D (IVI) 02000912 + WRITE(UNIT=KUVI,REC=2,FMT=41205,ERR=33060) BVS, AVD, IVI, AVS, 02010912 + 1 AVB, A20VK 02020912 +41205 FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, 30X, ' LASTS RECORD') 02030912 + WRITE(NUVI,80002)IVTNUM 02040912 + IVPASS=IVPASS+1 02050912 + GO TO 33070 02060912 +33060 WRITE(NUVI,55010)IVTNUM,REMK2 02070912 + IVFAIL=IVFAIL+1 02080912 +C***** 02090912 +CT004* TEST 4 - WRITES RECORD 3 02100912 +C***** 02110912 +33070 IVTNUM=4 02120912 + IVI = IVI + 1 02130912 + AVS = F1S (IVI) 02140912 + BVS = F1S(IVI + 1) 02150912 + A20VK = A201K (IVI) 02160912 + AVB = C1B (IVI) 02170912 + AVD = D1D (IVI) 02180912 + WRITE(UNIT=KUVI,REC=3,FMT=41206,ERR=33080) IVI, BVS, AVS, AVD, 02190912 + 1 AVB, A20VK 02200912 +41206 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, 30X, 'THE LAST REC') 02210912 + WRITE(NUVI,80002)IVTNUM 02220912 + IVPASS=IVPASS+1 02230912 + GO TO 33090 02240912 + 02250912 +33080 WRITE(NUVI,55010)IVTNUM,REMK3 02260912 + IVFAIL=IVFAIL+1 02270912 +C***** 02280912 +CT005* TEST 5 - WRITES RECORDS 4 AND 5 WITH ONE WRITE 02290912 +C***** 02300912 +33090 IVTNUM=5 02310912 + IVI = IVI + 1 02320912 + AVS = F1S (IVI) 02330912 + BVS = F1S(IVI + 1) 02340912 + A20VK = A201K (IVI) 02350912 + AVB = C1B (IVI) 02360912 + AVD = D1D (IVI) 02370912 + WRITE(UNIT=KUVI,REC=4,FMT=41207,ERR=33100) IVI, AVS, AVD, AVB, 02380912 + 1 A20VK, BVS, BVS, AVD, AVB, IVI, AVS, A20VK 02390912 +41207 FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, 35X, 'NEXT TO LAST',/ 02400912 + 1 E12.6, D15.7, L2, I4, F11.5, A25, 30X, 'THE END') 02410912 + WRITE(NUVI,80002)IVTNUM 02420912 + IVPASS=IVPASS+1 02430912 + GO TO 33290 02440912 +33100 WRITE(NUVI,55010)IVTNUM,REMK45 02450912 + IVFAIL=IVFAIL+1 02460912 +C***** 02470912 +CT006* TEST 6 - CHECK RECL AND NEXTREC ON OPENED FILE 02480912 +C***** 02490912 +33290 IVTNUM=6 02500912 + INQUIRE(UNIT=KUVI, RECL=IVI, NEXTREC=KVI) 02510912 + IF (IVI .NE. 120)GO TO 33300 02520912 + IF(KVI .NE. 6)GO TO 33300 02530912 + WRITE(NUVI,80002)IVTNUM 02540912 + IVPASS=IVPASS+1 02550912 + GO TO 33110 02560912 +33300 REMK='ERROR IN INQUIRE' 02570912 + WRITE(NUVI,55010)IVTNUM,REMK 02580912 + IVFAIL=IVFAIL+1 02590912 + WRITE(NUVI,55020)IVI,KVI 02600912 + WRITE(NUVI,55040) 02610912 +55040 FORMAT(" ",10X,"CORRECT: RECL= 120" ,5X,"NEXTREC= 6" /) 02620912 +C***** 02630912 +CT007* TEST 7 - READS RECORD 1 02640912 +C***** 02650912 +33110 IVTNUM=7 02660912 + IVI = 1 02670912 + READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33120) KVI, AVS, BVS, AVD, 02680912 + 1 AVB, A20VK, A47VK 02690912 +41210 FORMAT(I5, F10.5, E14.6, D14.8, L10, A20, A47) 02700912 + ISWT=1 02710912 + GO TO 33220 02720912 + 02730912 +33120 WRITE(NUVI,55010)IVTNUM,REMK1 02740912 + IVFAIL=IVFAIL+1 02750912 +C***** 02760912 +CT008* TEST 8 - READS RECORD 2 02770912 +C***** 02780912 +33130 IVTNUM=8 02790912 + IVI = 2 02800912 + READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33140) BVS, AVD, KVI, AVS, 02810912 + 1 AVB, A20VK, A51VK 02820912 +41238 FORMAT(E12.6, D15.7, I4, F11.5, L2, A25, A51) 02830912 + ISWT=2 02840912 + GO TO 33230 02850912 + 02860912 +33140 WRITE(NUVI,55010)IVTNUM,REMK2 02870912 + IVFAIL=IVFAIL+1 02880912 +C***** 02890912 +CT009* TEST 9 - READS RECORD 3 02900912 +C***** 02910912 +33150 IVTNUM=9 02920912 + IVI = 3 02930912 + READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33160) LVI, DVS, GVS, BVD, 02940912 + 1 BVB, B20VK, B47VK 02950912 + ISWT=3 02960912 + GO TO 33240 02970912 + 02980912 +33160 WRITE(NUVI,55010)IVTNUM,REMK3 02990912 + IVFAIL=IVFAIL+1 03000912 +C***** 03010912 +CT010* TEST 10 - READS RECORD 4 03020912 +C***** 03030912 +33170 IVTNUM=10 03040912 + IVI = 4 03050912 + READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33180) NVI, EVS, DVD, CVB, 03060912 + 1 C20VK, FVS, C47VK 03070912 +41241 FORMAT(I5, F10.5, D14.8, L10, A20, E14.6, A47) 03080912 + ISWT=4 03090912 + GO TO 33250 03100912 + 03110912 +33180 WRITE(NUVI,55010)IVTNUM,REMK4 03120912 + IVFAIL=IVFAIL+1 03130912 +C***** 03140912 +CT011* TEST 11 - READS RECORD 5 03150912 +C***** 03160912 +33190 IVTNUM=11 03170912 + IVI = 5 03180912 + JVI = 4 03190912 + READ(UNIT=KUVI,REC=IVI,FMT=41218,ERR=33200) BVS, AVD, AVB, KVI, 03200912 + 1 AVS, A20VK, A51VK 03210912 +41218 FORMAT(E12.6, D15.7, L2, I4, F11.5, A25, A51) 03220912 + ISWT=5 03230912 + GO TO 33260 03240912 + 03250912 +33200 WRITE(NUVI,55010)IVTNUM,REMK5 03260912 + IVFAIL=IVFAIL+1 03270912 +C***** 03280912 +CT012* TEST 12 - OVERWRITES RECORD 3 03290912 +C***** 03300912 +33210 IVTNUM=12 03310912 + IVI = 3 03320912 + AVS = G1S (IVI) 03330912 + BVS = G1S(IVI + 1) 03340912 + A20VK = B201K (IVI) 03350912 + AVB = D1B (IVI) 03360912 + AVD = B1D (IVI) 03370912 + WRITE(UNIT=KUVI,REC=3,FMT=41251,ERR=33310) IVI, AVS, BVS, AVD, 03380912 + 1 A20VK, AVB 03390912 +41251 FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, 35X, 'NEW RECORD ') 03400912 + WRITE(NUVI,80002)IVTNUM 03410912 + IVPASS=IVPASS+1 03420912 + GO TO 33320 03430912 + 03440912 +33310 WRITE(NUVI,55010)IVTNUM,REMK3 03450912 + IVFAIL=IVFAIL+1 03460912 +C***** 03470912 +CT013* TEST 13 - OVERWRITES RECORD 5 03480912 +C***** 03490912 +33320 IVTNUM=13 03500912 + IVI = 5 03510912 + AVS = G1S (IVI) 03520912 + BVS = G1S(IVI - 1) 03530912 + A20VK = B201K (IVI) 03540912 + AVB = D1B (IVI) 03550912 + AVD = B1D (IVI) 03560912 + WRITE(UNIT=KUVI,REC=5,FMT=41252,ERR=33330) AVS, IVI, A20VK, AVD,03570912 + 1 BVS, AVB 03580912 +41252 FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, 35X, 'STOP RECORD') 03590912 + WRITE(NUVI,80002)IVTNUM 03600912 + IVPASS=IVPASS+1 03610912 + GO TO 33340 03620912 + 03630912 +33330 WRITE(NUVI,55010)IVTNUM,REMK5 03640912 + IVFAIL=IVFAIL+1 03650912 +C***** 03660912 +C***** CLOSE AND REOPEN DIRECT ACCESS FILE 03670912 +C***** 03680912 +33340 CLOSE(UNIT=KUVI) 03690912 + OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD', 03700912 + 1 FORM='FORMATTED',RECL=120) 03710912 +C***** 03720912 +CT014* TEST 14 - READS RECORD 4 03730912 +C***** 03740912 + IVTNUM=14 03750912 + IVI = 4 03760912 + READ(UNIT=KUVI,REC=IVI,FMT=41241,ERR=33350) NVI, EVS, DVD, CVB, 03770912 + 1 C20VK, FVS, C47VK 03780912 + ISWT=6 03790912 + GO TO 33250 03800912 + 03810912 +33350 WRITE(NUVI,55010)IVTNUM,REMK4 03820912 + IVFAIL=IVFAIL+1 03830912 +C***** 03840912 +CT015* TEST 15 - READS THE CHANGED RECORD 5 03850912 +C***** 03860912 +33360 IVTNUM=15 03870912 + IVI = 5 03880912 + READ(UNIT=KUVI,REC=IVI,FMT=41254,ERR=33370) AVS, KVI, A20VK, 03890912 + 1 AVD, BVS, AVB, A47VK03900912 +41254 FORMAT(F10.5, I5, A20, D14.8, E14.6, L10, A47) 03910912 + ISWT=7 03920912 + IF (KVI .NE. IVI) GOTO 41221 03930912 + IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 4122303940912 + IF (BVS.LT.G1S(IVI-1)-CVS .OR. BVS.GT.G1S(IVI-1)+CVS) GOTO 4122503950912 + IF (A20VK .NE. B201K(IVI)) GOTO 41229 03960912 + IF ((AVB .AND. .NOT. D1B(IVI)) .OR. 03970912 + 1 (.NOT. AVB .AND. D1B(IVI))) GOTO 41233 03980912 + IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 4122703990912 + IF (A47VK .NE. 04000912 + 1 ' STOP RECORD') GOTO 41231 04010912 + WRITE(NUVI,80002)IVTNUM 04020912 + IVPASS=IVPASS+1 04030912 + GO TO 33380 04040912 +33370 WRITE(NUVI,55010)IVTNUM,REMK5 04050912 + IVFAIL=IVFAIL+1 04060912 +C***** 04070912 +CT016* TEST 16 - READS RECORD 2 04080912 +C***** 04090912 +33380 IVTNUM=16 04100912 + IVI = 2 04110912 + READ(UNIT=KUVI,REC=IVI,FMT=41238,ERR=33390) BVS, AVD, KVI, AVS, 04120912 + 1 AVB, A20VK, A51VK 04130912 + ISWT=8 04140912 + GO TO 33230 04150912 + 04160912 +33390 WRITE(NUVI,55010)IVTNUM,REMK2 04170912 + IVFAIL=IVFAIL+1 04180912 +C***** 04190912 +CT017* TEST 17 - READS THE CHANGED RECORD 3 04200912 +C***** 04210912 +33400 IVTNUM=17 04220912 + IVI = 3 04230912 + READ(UNIT=KUVI,REC=3,FMT=41256,ERR=33410) KVI, AVS, BVS, AVD, 04240912 + 1 A20VK, AVB, A47VK 04250912 +41256 FORMAT(I5, F11.5, E13.6, D14.8, A20, L10, A47) 04260912 + ISWT=9 04270912 + IF (KVI .NE. IVI) GOTO 41221 04280912 + IF (AVS .LT. G1S(IVI)-CVS .OR. AVS .GT. G1S(IVI)+CVS) GOTO 4122304290912 + IF (BVS.LT.G1S(IVI+1)-CVS .OR. BVS.GT.G1S(IVI+1)+CVS) GOTO 4122504300912 + IF (A20VK .NE. B201K(IVI)) GOTO 41229 04310912 + IF ((AVB .AND. .NOT. D1B(IVI)) .OR. 04320912 + 1 (.NOT. AVB .AND. D1B(IVI))) GOTO 41233 04330912 + IF (AVD .LT. B1D(IVI)-CVD .OR. AVD .GT. B1D(IVI)+CVD) GOTO 4122704340912 + IF (A47VK .NE. 04350912 + 1 ' NEW RECORD ') GOTO 41231 04360912 + WRITE(NUVI,80002)IVTNUM 04370912 + IVPASS=IVPASS+1 04380912 + GO TO 33420 04390912 + 04400912 +33410 WRITE(NUVI,55010)IVTNUM,REMK3 04410912 + IVFAIL=IVFAIL+1 04420912 +C***** 04430912 +CT018* TEST 18 - READS RECORD 1 04440912 +C***** 04450912 +33420 IVTNUM=18 04460912 + IVI = 1 04470912 + READ(UNIT=KUVI,REC=IVI,FMT=41210,ERR=33430) KVI, AVS, BVS, AVD, 04480912 + 1 AVB, A20VK, A47VK 04490912 + ISWT=10 04500912 + GO TO 33220 04510912 + 04520912 +33430 WRITE(NUVI,55010)IVTNUM,REMK1 04530912 + IVFAIL=IVFAIL+1 04540912 +C***** 04550912 +CT019* TEST 19 - OVERWRITES RECORD 4 04560912 +C***** 04570912 +33440 IVTNUM=19 04580912 +41258 IVI = 4 04590912 + KVI = IVI + 1 04600912 + AVS = F1S (IVI) 04610912 + BVS = F1S(IVI + 1) 04620912 + EVS = F1S(IVI) + 2.34 04630912 + AVD = D1D (IVI) 04640912 + WRITE(UNIT=KUVI,REC=4,FMT=41259,ERR=33450) IVI, KVI, AVS, BVS, 04650912 + 1 EVS, AVD 04660912 +41259 FORMAT(I5, I5.3, F10.5, E14.6, E20.1E4, D14.8) 04670912 + WRITE(NUVI,80002)IVTNUM 04680912 + IVPASS=IVPASS+1 04690912 + GO TO 33460 04700912 + 04710912 +33450 WRITE(NUVI,55010)IVTNUM,REMK4 04720912 + IVFAIL=IVFAIL+1 04730912 +C***** 04740912 +CT020* TEST 20 - OVERWRITES RECORDS 1, 2, AND 3 04750912 +C***** 04760912 +33460 IVTNUM=20 04770912 + IVI = 1 04780912 + A1VK = 'A' 04790912 + A4VK = A201K (IVI) (1:4) 04800912 + AVB = C1B (IVI) 04810912 + AVD = D1D (IVI) 04820912 + BVD = D1D (IVI) + 3.234D2 04830912 + WRITE(UNIT=KUVI,REC=1,FMT=41260,ERR=33470) AVD, BVD, AVB, A1VK, 04840912 + 1 A4VK 04850912 +41260 FORMAT(G14.8, G20.2E4, L2, A, A4, 'TSAL DROCER',//, 04860912 + 1 "HOLLERITH " , T15, 'ONE', 10X, TL5, 'TWO', TR5, 04870912 + 2 'THREE', :, 'LAST') 04880912 + WRITE(NUVI,80002)IVTNUM 04890912 + IVPASS=IVPASS+1 04900912 + GO TO 33480 04910912 + 04920912 +33470 WRITE(NUVI,55010)IVTNUM,REMK1 04930912 + IVFAIL=IVFAIL+1 04940912 +C***** 04950912 +CT021* TEST 21 - OVERWRITES RECORD 5 04960912 +C***** 04970912 +33480 IVTNUM=21 04980912 + IVI = 5 04990912 + BVS = F1S(IVI - 1) 05000912 + AVD = B1D (4) 05010912 + WRITE(UNIT=KUVI,REC=5,FMT=41261,ERR=33490) IVI, BVS, IVI, AVD 05020912 +41261 FORMAT(SP, I5, S, F10.5, SS, I5, 3PE14.6E2) 05030912 + WRITE(NUVI,80002)IVTNUM 05040912 + IVPASS=IVPASS+1 05050912 + GO TO 33500 05060912 + 05070912 +33490 WRITE(NUVI,55010)IVTNUM,REMK5 05080912 + IVFAIL=IVFAIL+1 05090912 +C***** 05100912 +C***** CLOSE AND REOPEN DIRECT ACCESS FILE 05110912 +C***** 05120912 +33500 CLOSE(UNIT=KUVI) 05130912 + OPEN(FILE=CDIR, UNIT=KUVI, ACCESS='DIRECT',STATUS='OLD', 05140912 + 1 FORM='FORMATTED',RECL=120) 05150912 +C***** 05160912 +CT022* TEST 22 - READS RECORD 1 05170912 +C***** 05180912 + IVTNUM=22 05190912 + IVI = 1 05200912 + READ(UNIT=KUVI,REC=IVI,FMT=41262,ERR=33510) AVD, A20VK, AVB, 05210912 + 1 A1VK, A4VK, A12VK 05220912 +41262 FORMAT(G14.8, A20, L2, A, A4, A12) 05230912 + ISWT=1 05240912 + IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4127705250912 + IF (A20VK(12:20) .NE. '.34E+0003') GOTO 41279 05260912 + IF ((A1VK .NE. 'A') .OR. 05270912 + 1 (A4VK .NE. A201K(IVI)(1:4)) .OR. 05280912 + 2 (A12VK .NE. 'TSAL DROCER')) GOTO 41279 05290912 + WRITE(NUVI,80002)IVTNUM 05300912 + IVPASS=IVPASS+1 05310912 + GO TO 33520 05320912 + 05330912 +33510 WRITE(NUVI,55010)IVTNUM,REMK1 05340912 + IVFAIL=IVFAIL+1 05350912 +C***** RECORD # 4 05360912 +CT023* TEST 23 - READS RECORD 4 05370912 +C***** 05380912 +33520 IVTNUM=23 05390912 + IVI = 4 05400912 + READ(UNIT=KUVI,REC=IVI,FMT=41266,ERR=33530) KVI, A20VK, AVS, 05410912 + 1 BVS, B20VK, AVD 05420912 +41266 FORMAT(I5, A5, F10.5, E14.6, A20, D14.8) 05430912 + ISWT=2 05440912 + IF (A20VK(3:5) .NE. '005') GOTO 41293 05450912 + IF ((AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) .OR. 05460912 + 1 (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) .OR. 05470912 + 2 (B20VK(13:20) .NE. '.6E+0001')) GOTO 41293 05480912 + WRITE(NUVI,80002)IVTNUM 05490912 + IVPASS=IVPASS+1 05500912 + GO TO 33540 05510912 + 05520912 +33530 WRITE(NUVI,55010)IVTNUM,REMK4 05530912 + IVFAIL=IVFAIL+1 05540912 +C***** 05550912 +CT024* TEST 24 - READS RECORD 2 TESTS FOR BLANK RECORD 05560912 +C***** 05570912 +33540 IVTNUM=24 05580912 + B120VK = ' ' 05590912 + IVI = 2 05600912 + READ(UNIT=KUVI,REC=IVI,FMT=41269,ERR=33550) A120VK 05610912 +41269 FORMAT(A120) 05620912 + ISWT=3 05630912 + IF (A120VK .NE. B120VK) GOTO 41281 05640912 + WRITE(NUVI,80002)IVTNUM 05650912 + IVPASS=IVPASS+1 05660912 + GO TO 33560 05670912 + 05680912 +33550 WRITE(NUVI,55010)IVTNUM,REMK2 05690912 + IVFAIL=IVFAIL+1 05700912 +C***** 05710912 +CT025* TEST 25 - READS RECORD 5 05720912 +C***** 05730912 +33560 IVTNUM=25 05740912 + IVI = 5 05750912 + READ(UNIT=KUVI,REC=IVI,FMT=41271,ERR=33570) A20VK(1:5), AVS, 05760912 + 1 B20VK, C20VK 05770912 +41271 FORMAT(A5, F10.5, BZ, A5, BN, A20) 05780912 + ISWT=4 05790912 + IF (A20VK(1:5) .NE. ' +5') GOTO 41283 05800912 + IF (B20VK(1:5) .NE. ' 5') GOTO 41285 05810912 + IF (C20VK(1:14) .NE. ' 625.0000E-03') GOTO 41287 05820912 + WRITE(NUVI,80002)IVTNUM 05830912 + IVPASS=IVPASS+1 05840912 + GO TO 33580 05850912 + 05860912 +33570 WRITE(NUVI,55010)IVTNUM,REMK5 05870912 + IVFAIL=IVFAIL+1 05880912 +C***** 05890912 +CT026* TEST 26 - READS RECORD 3 05900912 +C***** 05910912 +33580 IVTNUM=26 05920912 + IVI = 3 05930912 + READ(UNIT=KUVI,REC=IVI,FMT=41275,ERR=33590) A120VK 05940912 +41275 FORMAT(A120) 05950912 + ISWT=5 05960912 + IF (A120VK(1:10) .NE. 'HOLLERITH') GOTO 41289 05970912 + IF (A120VK(11:40) .NE. 05980912 + 1 ' ONE TWO THREE ') GOTO 41291 05990912 + WRITE(NUVI,80002)IVTNUM 06000912 + IVPASS=IVPASS+1 06010912 + GO TO 33600 06020912 + 06030912 +33590 WRITE(NUVI,55010)IVTNUM,REMK3 06040912 + IVFAIL=IVFAIL+1 06050912 +C***** 06060912 +C***** CLOSE DIRECT ACCESS FILE 06070912 +C***** 06080912 +33600 CLOSE(UNIT=KUVI,STATUS='DELETE') 06090912 + GO TO 33610 06100912 +C***** 06110912 +C***** CHECKING RECORD 1 06120912 +C***** 06130912 +33220 IF (KVI .NE. IVI) GOTO 41221 06140912 + IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 4122306150912 + IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 4122506160912 + IF (A20VK .NE. A201K(IVI)) GOTO 41229 06170912 + IF (A47VK .NE. 06180912 + 1 ' LAST RECORD') GOTO 41231 06190912 + IF ((AVB .AND. .NOT. C1B(IVI)) .OR. 06200912 + 1 (.NOT. AVB .AND. C1B(IVI))) GOTO 41233 06210912 + IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4122706220912 + WRITE(NUVI,80002)IVTNUM 06230912 + IVPASS=IVPASS+1 06240912 + IF (ISWT .EQ. 10)GO TO 33440 06250912 + GO TO 33130 06260912 + 06270912 +41221 WRITE(NUVI,41222)IVTNUM,IVI 06280912 + IVFAIL=IVFAIL+1 06290912 + GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06300912 + 1 33420,33440)ISWT 06310912 + 06320912 +41223 WRITE(NUVI,41224)IVTNUM,IVI 06330912 + IVFAIL=IVFAIL+1 06340912 + GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06350912 + 1 33420,33440)ISWT 06360912 + 06370912 +41225 WRITE(NUVI,41226)IVTNUM,IVI 06380912 + IVFAIL=IVFAIL+1 06390912 + GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06400912 + 1 33420,33440)ISWT 06410912 + 06420912 +41227 WRITE(NUVI,41228)IVTNUM,IVI 06430912 + IVFAIL=IVFAIL+1 06440912 + GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06450912 + 1 33420,33440)ISWT 06460912 + 06470912 +41229 WRITE(NUVI,41230)IVTNUM,IVI 06480912 + IVFAIL=IVFAIL+1 06490912 + GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06500912 + 1 33420,33440)ISWT 06510912 + 06520912 +41231 WRITE(NUVI,41232)IVTNUM,IVI 06530912 + IVFAIL=IVFAIL+1 06540912 + GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06550912 + 1 33420,33440)ISWT 06560912 + 06570912 +41233 WRITE(NUVI,41234)IVTNUM,IVI 06580912 + IVFAIL=IVFAIL+1 06590912 + GO TO (33130,33150,33170,33190,33210,33360,33380,33400, 06600912 + 1 33420,33440)ISWT 06610912 +C***** 06620912 +C***** CHECKING RECORD 2 06630912 +C***** 06640912 +33230 IF (KVI .NE. IVI) GOTO 41221 06650912 + IF (AVS .LT. F1S(IVI)-CVS .OR. AVS .GT. F1S(IVI)+CVS) GOTO 4122306660912 + IF (BVS.LT.F1S(IVI+1)-CVS .OR. BVS.GT.F1S(IVI+1)+CVS) GOTO 4122506670912 + IF (A20VK .NE. A201K(IVI)) GOTO 41229 06680912 + IF ((AVB .AND. .NOT. C1B(IVI)) .OR. 06690912 + 1 (.NOT. AVB .AND. C1B(IVI))) GOTO 41233 06700912 + IF (AVD .LT. D1D(IVI)-CVD .OR. AVD .GT. D1D(IVI)+CVD) GOTO 4122706710912 + IF (A51VK .NE. 06720912 + 1 ' LASTS RECORD ')GOTO 41231 06730912 + WRITE(NUVI,80002)IVTNUM 06740912 + IVPASS=IVPASS+1 06750912 + IF (ISWT .EQ. 8)GO TO 33400 06760912 + GO TO 33150 06770912 +C***** 06780912 +C***** CHECKING RECORD 3 06790912 +C***** 06800912 +33240 IF (LVI .NE. IVI) GOTO 41221 06810912 + IF (GVS .LT. F1S(IVI)-CVS .OR. GVS .GT. F1S(IVI)+CVS) GOTO 4122306820912 + IF (DVS.LT.F1S(IVI+1)-CVS .OR. DVS.GT.F1S(IVI+1)+CVS) GOTO 4122506830912 + IF (B20VK .NE. A201K(IVI)) GOTO 41229 06840912 + IF ((BVB .AND. .NOT. C1B(IVI)) .OR. 06850912 + 1 (.NOT. BVB .AND. C1B(IVI))) GOTO 41233 06860912 + IF (BVD .LT. D1D(IVI)-CVD .OR. BVD .GT. D1D(IVI)+CVD) GOTO 4122706870912 + IF (B47VK .NE. 06880912 + 1 ' THE LAST REC ') GOTO 41231 06890912 + WRITE(NUVI,80002)IVTNUM 06900912 + IVPASS=IVPASS+1 06910912 + GO TO 33170 06920912 +C***** 06930912 +C***** CHECKING RECORD 4 06940912 +C***** 06950912 +33250 IF (NVI .NE. IVI) GOTO 41221 06960912 + IF (EVS .LT. F1S(IVI)-CVS .OR. EVS .GT. F1S(IVI)+CVS) GOTO 4122306970912 + IF (FVS.LT.F1S(IVI+1)-CVS .OR. FVS.GT.F1S(IVI+1)+CVS) GOTO 4122506980912 + IF (C20VK .NE. A201K(IVI)) GOTO 41229 06990912 + IF ((CVB .AND. .NOT. C1B(IVI)) .OR. 07000912 + 1 (.NOT. CVB .AND. C1B(IVI))) GOTO 41233 07010912 + IF (DVD .LT. D1D(IVI)-CVD .OR. DVD .GT. D1D(IVI)+CVD) GOTO 4122707020912 + IF (C47VK .NE. 07030912 + 1 ' NEXT TO LAST') GOTO 41231 07040912 + WRITE(NUVI,80002)IVTNUM 07050912 + IVPASS=IVPASS+1 07060912 + IF (ISWT .EQ. 6)GO TO 33360 07070912 + GO TO 33190 07080912 +C***** 07090912 +C***** CHECKING RECORD 5 07100912 +C***** 07110912 +33260 IF (KVI .NE. JVI) GOTO 41221 07120912 + IF (AVS .LT. F1S(JVI)-CVS .OR. AVS .GT. F1S(JVI)+CVS) GOTO 4122307130912 + IF (BVS.LT.F1S(JVI+1)-CVS .OR. BVS.GT.F1S(JVI+1)+CVS) GOTO 4122507140912 + IF (A20VK .NE. A201K(JVI)) GOTO 41229 07150912 + IF ((AVB .AND. .NOT. C1B(JVI)) .OR. 07160912 + 1 (.NOT. AVB .AND. C1B(JVI))) GOTO 41233 07170912 + IF (AVD .LT. D1D(JVI)-CVD .OR. AVD .GT. D1D(JVI)+CVD) GOTO 4122707180912 + IF (A51VK .NE. 07190912 + 1 ' THE END ') GOTO 4123107200912 + WRITE(NUVI,80002)IVTNUM 07210912 + IVPASS=IVPASS+1 07220912 + GO TO 33210 07230912 +C***** 07240912 +C***** 07250912 +C***** 07260912 +41277 WRITE(NUVI,41278)IVTNUM,IVI 07270912 + IVFAIL=IVFAIL+1 07280912 + GO TO(33520,33540,33560,33580,33600)ISWT 07290912 + 07300912 +41279 WRITE(NUVI,41280)IVTNUM,IVI 07310912 + IVFAIL=IVFAIL+1 07320912 + GO TO(33520,33540,33560,33580,33600)ISWT 07330912 + 07340912 +41281 WRITE(NUVI,41282)IVTNUM,IVI 07350912 + IVFAIL=IVFAIL+1 07360912 + GO TO(33520,33540,33560,33580,33600)ISWT 07370912 + 07380912 +41283 WRITE(NUVI,41284)IVTNUM,IVI 07390912 + IVFAIL=IVFAIL+1 07400912 + GO TO(33520,33540,33560,33580,33600)ISWT 07410912 + 07420912 +41285 WRITE(NUVI,41286)IVTNUM,IVI 07430912 + IVFAIL=IVFAIL+1 07440912 + GO TO(33520,33540,33560,33580,33600)ISWT 07450912 + 07460912 +41287 WRITE(NUVI,41288)IVTNUM,IVI 07470912 + IVFAIL=IVFAIL+1 07480912 + GO TO(33520,33540,33560,33580,33600)ISWT 07490912 + 07500912 +41289 WRITE(NUVI,41290)IVTNUM,IVI 07510912 + IVFAIL=IVFAIL+1 07520912 + GO TO(33520,33540,33560,33580,33600)ISWT 07530912 + 07540912 +41291 WRITE(NUVI,41292)IVTNUM,IVI 07550912 + IVFAIL=IVFAIL+1 07560912 + GO TO(33520,33540,33560,33580,33600)ISWT 07570912 + 07580912 +41293 WRITE(NUVI,41294)IVTNUM,IVI 07590912 + IVFAIL=IVFAIL+1 07600912 + GO TO(33520,33540,33560,33580,33600)ISWT 07610912 +C***** 07620912 +C***** 07630912 +C***** 07640912 +41222 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07650912 + 1 " - ON I FORMAT" ) 07660912 +41224 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07670912 + 1 " - ON F FORMAT" ) 07680912 +41226 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07690912 + 1 " - ON E FORMAT" ) 07700912 +41228 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07710912 + 1 " - ON D FORMAT" ) 07720912 +41230 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07730912 + 1 " - ON A FORMAT" ) 07740912 +41232 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07750912 + 1 " - ON X AND ' FORMAT" ) 07760912 +41234 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07770912 + 1 " - ON L FORMAT" ) 07780912 +41278 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07790912 + 1 " - ON GW.D FORMAT" ) 07800912 +41280 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07810912 + 1 " - ON GW.DEN FORMAT" ) 07820912 +41282 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07830912 + 1 " - ON BLANK RECORD " ) 07840912 +41284 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07850912 + 1 " - ON SP FORMAT " ) 07860912 +41286 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07870912 + 1 " - ON BZ OR SS FORMAT" ) 07880912 +41288 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07890912 + 1 " - ON NP FORMAT " ) 07900912 +41290 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07910912 + 1 " - ON H FORMAT " ) 07920912 +41292 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07930912 + 1 " - ON TR, TLC, T FORMAT" ) 07940912 +41294 FORMAT(" ","TEST ",I3," FAIL",34X,"RECORD",I2, 07950912 + 1 " - ON IN.N FORMAT " ) 07960912 +C***** 07970912 +C***** END OF TEST SEGMENT 412 07980912 +C***** 07990912 +33610 CONTINUE 08000912 +CBB** ********************** BBCSUM0 **********************************08010912 +C**** WRITE OUT TEST SUMMARY 08020912 +C**** 08030912 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 08040912 + WRITE (I02, 90004) 08050912 + WRITE (I02, 90014) 08060912 + WRITE (I02, 90004) 08070912 + WRITE (I02, 90020) IVPASS 08080912 + WRITE (I02, 90022) IVFAIL 08090912 + WRITE (I02, 90024) IVDELE 08100912 + WRITE (I02, 90026) IVINSP 08110912 + WRITE (I02, 90028) IVTOTN, IVTOTL 08120912 +CBE** ********************** BBCSUM0 **********************************08130912 +CBB** ********************** BBCFOOT0 **********************************08140912 +C**** WRITE OUT REPORT FOOTINGS 08150912 +C**** 08160912 + WRITE (I02,90016) ZPROG, ZPROG 08170912 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 08180912 + WRITE (I02,90019) 08190912 +CBE** ********************** BBCFOOT0 **********************************08200912 +CBB** ********************** BBCFMT0A **********************************08210912 +C**** FORMATS FOR TEST DETAIL LINES 08220912 +C**** 08230912 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 08240912 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 08250912 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 08260912 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 08270912 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 08280912 + 1I6,/," ",15X,"CORRECT= " ,I6) 08290912 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08300912 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 08310912 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08320912 + 1A21,/," ",16X,"CORRECT= " ,A21) 08330912 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 08340912 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 08350912 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 08360912 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 08370912 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 08380912 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 08390912 +80050 FORMAT (" ",48X,A31) 08400912 +CBE** ********************** BBCFMT0A **********************************08410912 +CBB** ********************** BBCFMAT1 **********************************08420912 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 08430912 +C**** 08440912 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08450912 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 08460912 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 08470912 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 08480912 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 08490912 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 08500912 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 08510912 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 08520912 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 08530912 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 08540912 + 2"(",F12.5,", ",F12.5,")") 08550912 +CBE** ********************** BBCFMAT1 **********************************08560912 +CBB** ********************** BBCFMT0B **********************************08570912 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 08580912 +C**** 08590912 +90002 FORMAT ("1") 08600912 +90004 FORMAT (" ") 08610912 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )08620912 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 08630912 +90008 FORMAT (" ",21X,A13,A17) 08640912 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 08650912 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 08660912 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 08670912 + 1 7X,"REMARKS",24X) 08680912 +90014 FORMAT (" ","----------------------------------------------" , 08690912 + 1 "---------------------------------" ) 08700912 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 08710912 +C**** 08720912 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 08730912 +C**** 08740912 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 08750912 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 08760912 + 1 A13) 08770912 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 08780912 +C**** 08790912 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 08800912 +C**** 08810912 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 08820912 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 08830912 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 08840912 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 08850912 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 08860912 +CBE** ********************** BBCFMT0B **********************************08870912 + STOP 08880912 + END 08890912 + +C********************************************************************** 00010913 +C***** FORTRAN 77 00020913 +C***** FM913 00030913 +C***** SN913 FAQ - (807) 00040913 +C***** THIS SUBROUTINE IS CALLED BY PROGRAM FM912 00050913 +C********************************************************************** 00060913 + SUBROUTINE SN913(FW1S, GW1S, CW1B, DW1B, DW1D, BW1D, 00070913 + 1 A20W1K, B20W1K) 00080913 +C***** 00090913 +C***** SUBROUTINE USED WITH SEGMENT DIRAF3 (412) TO SUPPLY VALUES 00100913 +C***** TO ARRAYS THRU THE DUMMY ARGUMENT LIST 00110913 +C***** 00120913 + REAL FT1S(5),FW1S(5),GT1S(5),GW1S(5) 00130913 + LOGICAL CT1B(5),CW1B(5),DT1B(5),DW1B(5) 00140913 + DOUBLE PRECISION DT1D(5),DW1D(5),BT1D(5),BW1D(5) 00150913 + CHARACTER*20 A20T1K(5),A20W1K(5),B20T1K(5),B20W1K(5) 00160913 + DATA FT1S /1.0, 2.0, 3.0, 4.0, 5.0/ 00170913 + DATA GT1S /1.2, 2.3, 3.5, 4.45, 45.0/ 00180913 + DATA A20T1K / 'AAAALKJHGFASERTYUIOP', 'KDJFLKJEOITMNV E CJF', 00190913 + 1 'CDFEJHFKLM CNB FHGDC', 'LKJHNHBJMVK,FIJ NVHD', 00200913 + 2 'JHGFKDJJSLDKFJDKJFSL'/ 00210913 + DATA B20T1K / 'AAAALSDEFCASERTYUIOP', 'KDDFFEJEOITMNV E CJF', 00220913 + 1 'CDFEJHFKLM DHGDC', 'L...NHBJMVK,FIJ NVHD', 00230913 + 2 'LKJHDNMVHNEUYHBDGHCJ'/ 00240913 + DATA CT1B /.TRUE., .FALSE., .TRUE., .TRUE., .FALSE./ 00250913 + DATA DT1B /.FALSE., .TRUE., .FALSE., .TRUE., .TRUE./ 00260913 + DATA DT1D /1.23D1, 2.34D1, 3.45D3, 5.602D3, 5.602D0/ 00270913 + DATA BT1D /23.1D1, 34.1D1, 23.45D3, .625D0, 109.384D0/ 00280913 +C***** 00290913 +C***** 00300913 +C***** 00310913 + DO 1 IVI = 1, 5 00320913 + FW1S(IVI) = FT1S(IVI) 00330913 + GW1S(IVI) = GT1S(IVI) 00340913 + CW1B(IVI) = CT1B(IVI) 00350913 + DW1B(IVI) = DT1B(IVI) 00360913 + DW1D(IVI) = DT1D(IVI) 00370913 + BW1D(IVI) = BT1D(IVI) 00380913 + A20W1K(IVI) = A20T1K(IVI) 00390913 + B20W1K(IVI) = B20T1K(IVI) 00400913 +1 CONTINUE 00410913 +C***** 00420913 +C***** 00430913 +C***** 00440913 + RETURN 00450913 + END 00460913 diff --git a/Fortran/UnitTests/fcvs21_f95/FM912.reference_output b/Fortran/UnitTests/fcvs21_f95/FM912.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM912.reference_output @@ -0,0 +1,58 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM912BEGIN* TEST RESULTS - FM912 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + DIRAF3 - (412) DIRECT ACCESS FORMATTED FILE + WITH OPTION TO OPEN AS A SEQUENTIAL FILE + ANS REF. - 12.5 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 26 TESTS + + 1 PASS + 2 PASS + 3 PASS + 4 PASS + 5 PASS + 6 PASS + 7 PASS + 8 PASS + 9 PASS + 10 PASS + 11 PASS + 12 PASS + 13 PASS + 14 PASS + 15 PASS + 16 PASS + 17 PASS + 18 PASS + 19 PASS + 20 PASS + 21 PASS + 22 PASS + 23 PASS + 24 PASS + 25 PASS + 26 PASS + + ------------------------------------------------------------------------------- + + 26 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 26 OF 26 TESTS EXECUTED + + *FM912END* END OF TEST - FM912 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM914.f b/Fortran/UnitTests/fcvs21_f95/FM914.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM914.f @@ -0,0 +1,264 @@ + PROGRAM FM914 + +C***********************************************************************00010914 +C***** FM914 00020914 +C***** INQU1 - (430) 00030914 +C***** 00040914 +C***********************************************************************00050914 +C***** GENERAL PURPOSE ANS REF 00060914 +C***** TEST INQUIRE BY UNIT ON SEQUENTIAL, FORMATTED FILES 12.10.3 00070914 +C***** 00080914 +C***** THE TESTS IN THIS UNIT ARE ONLY PERFORMED ON A 00090914 +C***** UNIT THAT IS CONNECTED FOR SEQUENTIAL, FORMATTED ACCESS 00100914 +C***** (ANS REF. 12.2.4.1 AND 12.9.5.2) 00110914 +C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS 00120914 +C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT. 00130914 +C***********************************************************************00140914 +CBB** ********************** BBCCOMNT **********************************00150914 +C**** 00160914 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00170914 +C**** VERSION 2.1 00180914 +C**** 00190914 +C**** 00200914 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00210914 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00220914 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00230914 +C**** BUILDING 225 RM A266 00240914 +C**** GAITHERSBURG, MD 20899 00250914 +C**** 00260914 +C**** 00270914 +C**** 00280914 +CBE** ********************** BBCCOMNT **********************************00290914 + LOGICAL AVB, BVB 00300914 + CHARACTER*10 B10VK, C10VK, E11VK*11, F10VK, H10VK 00310914 +CBB** ********************** BBCINITA **********************************00320914 +C**** SPECIFICATION STATEMENTS 00330914 +C**** 00340914 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00350914 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00360914 +CBE** ********************** BBCINITA **********************************00370914 +CBB** ********************** BBCINITB **********************************00380914 +C**** INITIALIZE SECTION 00390914 + DATA ZVERS, ZVERSD, ZDATE 00400914 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00410914 + DATA ZCOMPL, ZNAME, ZTAPE 00420914 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00430914 + DATA ZPROJ, ZTAPED, ZPROG 00440914 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00450914 + DATA REMRKS /' '/ 00460914 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00470914 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00480914 +C**** 00490914 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00500914 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00510914 +CZ03 ZPROG = 'PROGRAM NAME' 00520914 +CZ04 ZDATE = 'DATE OF TEST' 00530914 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00540914 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00550914 +CZ07 ZNAME = 'NAME OF USER' 00560914 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00570914 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00580914 +C 00590914 + IVPASS = 0 00600914 + IVFAIL = 0 00610914 + IVDELE = 0 00620914 + IVINSP = 0 00630914 + IVTOTL = 0 00640914 + IVTOTN = 0 00650914 + ICZERO = 0 00660914 +C 00670914 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00680914 + I01 = 05 00690914 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00700914 + I02 = 06 00710914 +C 00720914 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00730914 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00740914 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00750914 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00760914 +C 00770914 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00780914 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00790914 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00800914 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00810914 +C 00820914 +CBE** ********************** BBCINITB **********************************00830914 +C***** 00840914 +C I08 CONTAINS THE UNIT NUMBER FOR A SEQUENTIAL FORMATTED FILE. 00850914 + I08 = 918 00860914 +CX080 REPLACED BY FEXEC X-080 CONTROL CARD (SEQ. FILE UNIT NUMBER). 00870914 +C SPECIFYING I08 = NN OVERRIDES THE DEFAULT I08 = 14. 00880914 +C***** 00890914 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 00900914 +C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 00910914 +C***** SEQUENTIAL, FORMATTED FILE. 00920914 +C***** 00930914 + NUVI = I02 00940914 + IMVI = I08 00950914 + ZPROG = 'FM914' 00960914 + IVTOTL = 1 00970914 +CBB** ********************** BBCHED0A **********************************00980914 +C**** 00990914 +C**** WRITE REPORT TITLE 01000914 +C**** 01010914 + WRITE (I02, 90002) 01020914 + WRITE (I02, 90006) 01030914 + WRITE (I02, 90007) 01040914 + WRITE (I02, 90008) ZVERS, ZVERSD 01050914 + WRITE (I02, 90009) ZPROG, ZPROG 01060914 + WRITE (I02, 90010) ZDATE, ZCOMPL 01070914 +CBE** ********************** BBCHED0A **********************************01080914 +C***** 01090914 + WRITE(NUVI,43000) 01100914 +43000 FORMAT(" ", / " INQU1 - (430) INQUIRE BY UNIT" // 01110914 + 1 " SEQUENTIAL FORMATTED FILE, CONNECTED BY OPEN" // 01120914 + 2 " ANS REF. - 12.10.3" ) 01130914 +CBB** ********************** BBCHED0B **********************************01140914 +C**** WRITE DETAIL REPORT HEADERS 01150914 +C**** 01160914 + WRITE (I02,90004) 01170914 + WRITE (I02,90004) 01180914 + WRITE (I02,90013) 01190914 + WRITE (I02,90014) 01200914 + WRITE (I02,90015) IVTOTL 01210914 +CBE** ********************** BBCHED0B **********************************01220914 +C***** 01230914 +C***** OPEN FILE 01240914 +C***** 01250914 + OPEN(UNIT=IMVI, ACCESS='SEQUENTIAL', FORM='FORMATTED', 01260914 + 1 BLANK='NULL') 01270914 +C***** 01280914 +CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN) 01290914 + IVTNUM = 1 01300914 + INQUIRE(UNIT=IMVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01310914 + 1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK, 01320914 + 2 FORMATTED=F10VK, BLANK=H10VK, ERR=20011, IOSTAT=KVI) 01330914 + IF (KVI .NE. 0) GO TO 20010 01340914 + IF (.NOT. AVB) GO TO 20010 01350914 + IF (.NOT. BVB) GO TO 20010 01360914 + IF (JVI .NE. IMVI) GO TO 20010 01370914 + IF (B10VK .NE. 'SEQUENTIAL') GO TO 20010 01380914 + IF (C10VK .NE. 'YES') GO TO 20010 01390914 + IF (E11VK .NE. 'FORMATTED') GO TO 20010 01400914 + IF (F10VK .NE. 'YES' ) GO TO 20010 01410914 + IF (H10VK .NE. 'NULL') GO TO 20010 01420914 + WRITE (NUVI, 80002) IVTNUM 01430914 + IVPASS = IVPASS + 1 01440914 + GO TO 0011 01450914 +20011 CONTINUE 01460914 + WRITE (NUVI, 20021) IVTNUM 01470914 +20021 FORMAT (" ",2X,I3,4X," FAIL",12X, 01480914 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 01490914 + GO TO 20012 01500914 +20010 CONTINUE 01510914 + WRITE (NUVI, 20020) IVTNUM 01520914 +20020 FORMAT(" ",2X,I3,4X," FAIL",12X, 01530914 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 01540914 +20012 CONTINUE 01550914 + IVFAIL = IVFAIL + 1 01560914 + WRITE (NUVI, 20030) KVI,AVB,BVB,JVI,B10VK,C10VK,E11VK, 01570914 + 1 F10VK,H10VK 01580914 +20030 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 01590914 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 01600914 + 2 " ",26X,"ACCESS=",A10,", SEQUENTIAL=" ,A3,", FORM=", 01610914 + 3 A9,","/" ",26X,"FORMATTED=" ,A3,", BLANK=",A4) 01620914 + WRITE (NUVI, 20040) IMVI 01630914 +20040 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 01640914 + 1 "OPENED=T, NUMBER=" ,I4,","/ 01650914 + 2 " ",26X,"ACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=" , 01660914 + 3 "FORMATTED," /" ",26X,"FORMATTED=YES, BLANK=NULL" ) 01670914 + 0011 CONTINUE 01680914 +C***** 01690914 + REWIND IMVI 01700914 + CLOSE(UNIT=IMVI, STATUS='DELETE') 01710914 +CBB** ********************** BBCSUM0 **********************************01720914 +C**** WRITE OUT TEST SUMMARY 01730914 +C**** 01740914 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01750914 + WRITE (I02, 90004) 01760914 + WRITE (I02, 90014) 01770914 + WRITE (I02, 90004) 01780914 + WRITE (I02, 90020) IVPASS 01790914 + WRITE (I02, 90022) IVFAIL 01800914 + WRITE (I02, 90024) IVDELE 01810914 + WRITE (I02, 90026) IVINSP 01820914 + WRITE (I02, 90028) IVTOTN, IVTOTL 01830914 +CBE** ********************** BBCSUM0 **********************************01840914 +CBB** ********************** BBCFOOT0 **********************************01850914 +C**** WRITE OUT REPORT FOOTINGS 01860914 +C**** 01870914 + WRITE (I02,90016) ZPROG, ZPROG 01880914 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 01890914 + WRITE (I02,90019) 01900914 +CBE** ********************** BBCFOOT0 **********************************01910914 +CBB** ********************** BBCFMT0A **********************************01920914 +C**** FORMATS FOR TEST DETAIL LINES 01930914 +C**** 01940914 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 01950914 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 01960914 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 01970914 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 01980914 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 01990914 + 1I6,/," ",15X,"CORRECT= " ,I6) 02000914 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02010914 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02020914 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02030914 + 1A21,/," ",16X,"CORRECT= " ,A21) 02040914 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02050914 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02060914 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02070914 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02080914 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02090914 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02100914 +80050 FORMAT (" ",48X,A31) 02110914 +CBE** ********************** BBCFMT0A **********************************02120914 +CBB** ********************** BBCFMAT1 **********************************02130914 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 02140914 +C**** 02150914 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02160914 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 02170914 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 02180914 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 02190914 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02200914 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 02210914 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02220914 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 02230914 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02240914 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 02250914 + 2"(",F12.5,", ",F12.5,")") 02260914 +CBE** ********************** BBCFMAT1 **********************************02270914 +CBB** ********************** BBCFMT0B **********************************02280914 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02290914 +C**** 02300914 +90002 FORMAT ("1") 02310914 +90004 FORMAT (" ") 02320914 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02330914 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02340914 +90008 FORMAT (" ",21X,A13,A17) 02350914 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02360914 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02370914 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02380914 + 1 7X,"REMARKS",24X) 02390914 +90014 FORMAT (" ","----------------------------------------------" , 02400914 + 1 "---------------------------------" ) 02410914 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02420914 +C**** 02430914 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02440914 +C**** 02450914 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02460914 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02470914 + 1 A13) 02480914 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02490914 +C**** 02500914 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02510914 +C**** 02520914 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02530914 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02540914 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02550914 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02560914 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02570914 +CBE** ********************** BBCFMT0B **********************************02580914 +C***** 02590914 +C***** END OF TEST SEGMENT 914 02600914 + STOP 02610914 + END 02620914 diff --git a/Fortran/UnitTests/fcvs21_f95/FM914.reference_output b/Fortran/UnitTests/fcvs21_f95/FM914.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM914.reference_output @@ -0,0 +1,35 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM914BEGIN* TEST RESULTS - FM914 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INQU1 - (430) INQUIRE BY UNIT + + SEQUENTIAL FORMATTED FILE, CONNECTED BY OPEN + + ANS REF. - 12.10.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 1 TESTS + + 1 PASS + + ------------------------------------------------------------------------------- + + 1 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 1 OF 1 TESTS EXECUTED + + *FM914END* END OF TEST - FM914 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM915.f b/Fortran/UnitTests/fcvs21_f95/FM915.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM915.f @@ -0,0 +1,352 @@ + PROGRAM FM915 + +C***********************************************************************00010915 +C***** FORTRAN 77 00020915 +C***** FM915 00030915 +C***** INQU2 - (431) 00040915 +C***** 00050915 +C***********************************************************************00060915 +C***** GENERAL PURPOSE ANS REF 00070915 +C***** TEST INQUIRE ON SEQUENTIAL, UNFORMATTED FILES 12.10.3 00080915 +C***** 00090915 +C***** THE TESTS IN THIS UNIT ARE ONLY PERFORMED ON A 00100915 +C***** UNIT THAT IS CONNECTED FOR SEQUENTIAL, UNFORMATTED ACCESS 00110915 +C***** (ANS REF. 12.2.4.1 AND 12.9.5.1) 00120915 +C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS 00130915 +C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT. 00140915 +C***** THE SEGMENT TESTS THAT INQUIRE IS PERFORMED CORRECTLY 00150915 +C***** BEFORE READING OR WRITING TO A FILE, AFTER WRITING TO A FILE 00160915 +C***** AND AFTER READING FROM A FILE. 00170915 +C***********************************************************************00180915 +CBB** ********************** BBCCOMNT **********************************00190915 +C**** 00200915 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00210915 +C**** VERSION 2.1 00220915 +C**** 00230915 +C**** 00240915 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00250915 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00260915 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00270915 +C**** BUILDING 225 RM A266 00280915 +C**** GAITHERSBURG, MD 20899 00290915 +C**** 00300915 +C**** 00310915 +C**** 00320915 +CBE** ********************** BBCCOMNT **********************************00330915 + LOGICAL AVB, BVB 00340915 + CHARACTER*10 B10VK, C10VK, E11VK*11, G10VK 00350915 +C***** 00360915 +CBB** ********************** BBCINITA **********************************00370915 +C**** SPECIFICATION STATEMENTS 00380915 +C**** 00390915 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00400915 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00410915 +CBE** ********************** BBCINITA **********************************00420915 +CBB** ********************** BBCINITB **********************************00430915 +C**** INITIALIZE SECTION 00440915 + DATA ZVERS, ZVERSD, ZDATE 00450915 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00460915 + DATA ZCOMPL, ZNAME, ZTAPE 00470915 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00480915 + DATA ZPROJ, ZTAPED, ZPROG 00490915 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00500915 + DATA REMRKS /' '/ 00510915 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00520915 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00530915 +C**** 00540915 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00550915 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00560915 +CZ03 ZPROG = 'PROGRAM NAME' 00570915 +CZ04 ZDATE = 'DATE OF TEST' 00580915 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00590915 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00600915 +CZ07 ZNAME = 'NAME OF USER' 00610915 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00620915 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00630915 +C 00640915 + IVPASS = 0 00650915 + IVFAIL = 0 00660915 + IVDELE = 0 00670915 + IVINSP = 0 00680915 + IVTOTL = 0 00690915 + IVTOTN = 0 00700915 + ICZERO = 0 00710915 +C 00720915 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00730915 + I01 = 05 00740915 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00750915 + I02 = 06 00760915 +C 00770915 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00780915 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00790915 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00800915 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00810915 +C 00820915 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00830915 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00840915 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00850915 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00860915 +C 00870915 +CBE** ********************** BBCINITB **********************************00880915 +C***** 00890915 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 00900915 +C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 00910915 +C***** SEQUENTIAL, UNFORMATTED FILE. 00920915 +C I05 CONTAINS THE UNIT NUMBER FOR A SEQUENTIAL UNFORMATTED FILE. 00930915 + I05 = 14 00940915 +CX050 REPLACED BY FEXEC X-050 CONTROL CARD (SEQ. FILE UNIT NUMBER). 00950915 +C SPECIFYING I05 = NN OVERRIDES THE DEFAULT I05 = 14. 00960915 +C***** 00970915 + NUVI = I02 00980915 + IMVI = I05 00990915 + ZPROG = 'FM915' 01000915 + IVTOTL = 3 01010915 +CBB** ********************** BBCHED0A **********************************01020915 +C**** 01030915 +C**** WRITE REPORT TITLE 01040915 +C**** 01050915 + WRITE (I02, 90002) 01060915 + WRITE (I02, 90006) 01070915 + WRITE (I02, 90007) 01080915 + WRITE (I02, 90008) ZVERS, ZVERSD 01090915 + WRITE (I02, 90009) ZPROG, ZPROG 01100915 + WRITE (I02, 90010) ZDATE, ZCOMPL 01110915 +CBE** ********************** BBCHED0A **********************************01120915 +C***** 01130915 + WRITE(NUVI,43100) 01140915 +43100 FORMAT(" ", / " INQU2 - (431) INQUIRE BY UNIT" // 01150915 + 1 " SEQUENTIAL UNFORMATTED FILE, CONNECTED BY OPEN" // 01160915 + 2 " ANS REF. - 12.10.3" ) 01170915 +CBB** ********************** BBCHED0B **********************************01180915 +C**** WRITE DETAIL REPORT HEADERS 01190915 +C**** 01200915 + WRITE (I02,90004) 01210915 + WRITE (I02,90004) 01220915 + WRITE (I02,90013) 01230915 + WRITE (I02,90014) 01240915 + WRITE (I02,90015) IVTOTL 01250915 +CBE** ********************** BBCHED0B **********************************01260915 +C***** 01270915 +C***** OPEN FILE 01280915 +C***** 01290915 + OPEN(UNIT=IMVI, ACCESS='SEQUENTIAL', FORM='UNFORMATTED') 01300915 +CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN) 01310915 + IVTNUM = 1 01320915 + INQUIRE(UNIT=IMVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01330915 + 1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK, 01340915 + 2 UNFORMATTED=G10VK, ERR=20014, IOSTAT=KVI) 01350915 +C***** 01360915 + IF (KVI .NE. 0) GO TO 20010 01370915 + IF (.NOT. AVB) GO TO 20010 01380915 + IF (.NOT. BVB) GO TO 20010 01390915 + IF (JVI .NE. IMVI) GO TO 20010 01400915 + IF (B10VK .NE. 'SEQUENTIAL') GO TO 20010 01410915 + IF (C10VK. NE. 'YES') GO TO 20010 01420915 + IF (E11VK .NE. 'UNFORMATTED') GO TO 20010 01430915 + IF (G10VK .NE. 'YES' ) GO TO 20010 01440915 + WRITE (NUVI, 80002) IVTNUM 01450915 + IVPASS = IVPASS + 1 01460915 + GO TO 0011 01470915 +20014 CONTINUE 01480915 + WRITE (NUVI, 20015) IVTNUM 01490915 +20015 FORMAT (" ",2X,I3,4X," FAIL",12X, 01500915 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 01510915 + GO TO 20016 01520915 +20010 CONTINUE 01530915 + WRITE (NUVI, 20011) IVTNUM 01540915 +20011 FORMAT(" ",2X,I3,4X," FAIL",12X, 01550915 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 01560915 +20016 IVFAIL = IVFAIL + 1 01570915 + WRITE (NUVI, 20012) KVI,AVB,BVB,JVI,B10VK,C10VK,E11VK, 01580915 + 1 G10VK 01590915 +20012 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 01600915 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 01610915 + 2 " ",26X,"ACCESS=",A10,", SEQUENTIAL=" ,A3,", FORM=", 01620915 + 3 A11,","/" ",26X,"UNFORMATTED=" ,A3) 01630915 + WRITE (NUVI, 20013) IMVI 01640915 +20013 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 01650915 + 1 "OPENED=T, NUMBER=" ,I4,","/ 01660915 + 2 " ",26X,"ACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=" , 01670915 + 3 "UNFORMATTED," /" ",26X,"UNFORMATTED=YES" ) 01680915 + 0011 CONTINUE 01690915 +C***** 01700915 +C***** WRITE TO FILE 01710915 +C***** 01720915 + WRITE(IMVI) JVI 01730915 +CT002* TEST 2 - SECOND INQUIRE (AFTER WRITE) 01740915 + IVTNUM = 2 01750915 + INQUIRE(UNIT=IMVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01760915 + 1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK, 01770915 + 2 UNFORMATTED=G10VK, ERR=20024, IOSTAT=KVI) 01780915 +C***** 01790915 + IF (KVI .NE. 0) GO TO 20020 01800915 + IF (.NOT. AVB) GO TO 20020 01810915 + IF (.NOT. BVB) GO TO 20020 01820915 + IF (JVI .NE. IMVI) GO TO 20020 01830915 + IF (B10VK .NE. 'SEQUENTIAL') GO TO 20020 01840915 + IF (C10VK.NE. 'YES') GO TO 20020 01850915 + IF (E11VK .NE. 'UNFORMATTED') GO TO 20020 01860915 + IF (G10VK .NE. 'YES' ) GO TO 20020 01870915 + WRITE (NUVI, 80002) IVTNUM 01880915 + IVPASS = IVPASS + 1 01890915 + GO TO 0021 01900915 +20024 CONTINUE 01910915 + WRITE (NUVI, 20025) IVTNUM 01920915 +20025 FORMAT (" ",2X,I3,4X," FAIL",12X, 01930915 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 01940915 + GO TO 20026 01950915 +20020 CONTINUE 01960915 + WRITE (NUVI, 20021) IVTNUM 01970915 +20021 FORMAT(" ",2X,I3,4X," FAIL",12X, 01980915 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 01990915 +20026 IVFAIL = IVFAIL + 1 02000915 + WRITE (NUVI, 20022) KVI,AVB,BVB,JVI,B10VK,C10VK,E11VK, 02010915 + 1 G10VK 02020915 +20022 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 02030915 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 02040915 + 2 " ",26X,"ACCESS=",A10,", SEQUENTIAL=" ,A3,", FORM=", 02050915 + 3 A11,","/" ",26X,"UNFORMATTED=" ,A3) 02060915 + WRITE (NUVI, 20023) IMVI 02070915 +20023 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 02080915 + 1 "OPENED=T, NUMBER=" ,I4,","/ 02090915 + 2 " ",26X,"ACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=" , 02100915 + 3 "UNFORMATTED," /" ",26X,"UNFORMATTED=YES" ) 02110915 + 0021 CONTINUE 02120915 +C***** 02130915 +C***** REWIND AND READ FILE 02140915 + REWIND IMVI 02150915 + READ(IMVI) JVI 02160915 + REWIND IMVI 02170915 +C***** 02180915 +CT003* TEST 3 - THIRD INQUIRE (AFTER READ) 02190915 + IVTNUM = 3 02200915 + INQUIRE(UNIT=IMVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 02210915 + 1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK, 02220915 + 2 UNFORMATTED=G10VK, ERR=20034,IOSTAT=KVI) 02230915 +C***** 02240915 + IF (KVI .NE. 0) GO TO 20030 02250915 + IF (.NOT. AVB) GO TO 20030 02260915 + IF (.NOT. BVB) GO TO 20030 02270915 + IF (JVI .NE. IMVI) GO TO 20030 02280915 + IF (B10VK .NE. 'SEQUENTIAL') GO TO 20030 02290915 + IF (C10VK .NE. 'YES') GO TO 20030 02300915 + IF (E11VK .NE. 'UNFORMATTED') GO TO 20030 02310915 + IF (G10VK .NE. 'YES' ) GO TO 20030 02320915 + WRITE (NUVI, 80002) IVTNUM 02330915 + IVPASS = IVPASS + 1 02340915 + GO TO 0031 02350915 +20034 CONTINUE 02360915 + WRITE (NUVI, 20035) IVTNUM 02370915 +20035 FORMAT (" ",2X,I3,4X," FAIL",12X, 02380915 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 02390915 + GO TO 20036 02400915 +20030 CONTINUE 02410915 + WRITE (NUVI, 20031) IVTNUM 02420915 +20031 FORMAT(" ",2X,I3,4X," FAIL",12X, 02430915 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 02440915 +20036 IVFAIL = IVFAIL + 1 02450915 + WRITE (NUVI, 20032) KVI,AVB,BVB,JVI,B10VK,C10VK,E11VK, 02460915 + 1 G10VK 02470915 +20032 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 02480915 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 02490915 + 2 " ",26X,"ACCESS=",A10,", SEQUENTIAL=" ,A3,", FORM=", 02500915 + 3 A11,","/" ",26X,"UNFORMATTED=" ,A3) 02510915 + WRITE (NUVI, 20033) IMVI 02520915 +20033 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 02530915 + 1 "OPENED=T, NUMBER=" ,I4,","/ 02540915 + 2 " ",26X,"ACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=" , 02550915 + 3 "UNFORMATTED," /" ",26X,"UNFORMATTED=YES" ) 02560915 + 0031 CONTINUE 02570915 + CLOSE(UNIT=IMVI, STATUS='DELETE') 02580915 +C***** 02590915 +CBB** ********************** BBCSUM0 **********************************02600915 +C**** WRITE OUT TEST SUMMARY 02610915 +C**** 02620915 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02630915 + WRITE (I02, 90004) 02640915 + WRITE (I02, 90014) 02650915 + WRITE (I02, 90004) 02660915 + WRITE (I02, 90020) IVPASS 02670915 + WRITE (I02, 90022) IVFAIL 02680915 + WRITE (I02, 90024) IVDELE 02690915 + WRITE (I02, 90026) IVINSP 02700915 + WRITE (I02, 90028) IVTOTN, IVTOTL 02710915 +CBE** ********************** BBCSUM0 **********************************02720915 +CBB** ********************** BBCFOOT0 **********************************02730915 +C**** WRITE OUT REPORT FOOTINGS 02740915 +C**** 02750915 + WRITE (I02,90016) ZPROG, ZPROG 02760915 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02770915 + WRITE (I02,90019) 02780915 +CBE** ********************** BBCFOOT0 **********************************02790915 +CBB** ********************** BBCFMT0A **********************************02800915 +C**** FORMATS FOR TEST DETAIL LINES 02810915 +C**** 02820915 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02830915 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02840915 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02850915 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02860915 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02870915 + 1I6,/," ",15X,"CORRECT= " ,I6) 02880915 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02890915 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02900915 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02910915 + 1A21,/," ",16X,"CORRECT= " ,A21) 02920915 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02930915 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02940915 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02950915 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02960915 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02970915 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02980915 +80050 FORMAT (" ",48X,A31) 02990915 +CBE** ********************** BBCFMT0A **********************************03000915 +CBB** ********************** BBCFMAT1 **********************************03010915 +C**** FORMATS FOR TEST DETAIL LINES - FULL LANGUAGE 03020915 +C**** 03030915 +80031 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03040915 + 1D17.10,/," ",16X,"CORRECT= " ,D17.10) 03050915 +80033 FORMAT (" ",16X,"COMPUTED= " ,D17.10,10X,A31) 03060915 +80035 FORMAT (" ",16X,"CORRECT= " ,D17.10,10X,A31) 03070915 +80037 FORMAT (" ",16X,"COMPUTED= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03080915 +80039 FORMAT (" ",16X,"CORRECT= " ,"(",E12.5,", ",E12.5,")",6X,A31) 03090915 +80041 FORMAT (" ",16X,"COMPUTED= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03100915 +80043 FORMAT (" ",16X,"CORRECT= " ,"(",F12.5,", ",F12.5,")",6X,A31) 03110915 +80045 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03120915 + 1"(",F12.5,", ",F12.5,")"/," ",16X,"CORRECT= " , 03130915 + 2"(",F12.5,", ",F12.5,")") 03140915 +CBE** ********************** BBCFMAT1 **********************************03150915 +CBB** ********************** BBCFMT0B **********************************03160915 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03170915 +C**** 03180915 +90002 FORMAT ("1") 03190915 +90004 FORMAT (" ") 03200915 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03210915 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03220915 +90008 FORMAT (" ",21X,A13,A17) 03230915 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03240915 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03250915 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03260915 + 1 7X,"REMARKS",24X) 03270915 +90014 FORMAT (" ","----------------------------------------------" , 03280915 + 1 "---------------------------------" ) 03290915 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03300915 +C**** 03310915 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03320915 +C**** 03330915 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03340915 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03350915 + 1 A13) 03360915 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03370915 +C**** 03380915 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03390915 +C**** 03400915 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03410915 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03420915 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03430915 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03440915 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03450915 +CBE** ********************** BBCFMT0B **********************************03460915 +C***** 03470915 +C***** END OF TEST SEGMENT 431 03480915 + STOP 03490915 + END 03500915 diff --git a/Fortran/UnitTests/fcvs21_f95/FM915.reference_output b/Fortran/UnitTests/fcvs21_f95/FM915.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM915.reference_output @@ -0,0 +1,37 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM915BEGIN* TEST RESULTS - FM915 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INQU2 - (431) INQUIRE BY UNIT + + SEQUENTIAL UNFORMATTED FILE, CONNECTED BY OPEN + + ANS REF. - 12.10.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 3 TESTS + + 1 PASS + 2 PASS + 3 PASS + + ------------------------------------------------------------------------------- + + 3 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 3 OF 3 TESTS EXECUTED + + *FM915END* END OF TEST - FM915 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM916.f b/Fortran/UnitTests/fcvs21_f95/FM916.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM916.f @@ -0,0 +1,258 @@ + PROGRAM FM916 + +C***********************************************************************00010916 +C***** FORTRAN 77 00020916 +C***** FM916 00030916 +C***** INQU3 - (432) 00040916 +C***** 00050916 +C***********************************************************************00060916 +C***** GENERAL PURPOSE ANS REF 00070916 +C***** TEST INQUIRE BY UNIT ON DIRECT, FORMATTED FILE 12.10.3 00080916 +C***** 00090916 +C***** THE TESTS IN THE UNIT ARE ONLY PERFORMED ON A 00100916 +C***** UNIT THAT IS CONNECTED FOR FORMATTED, DIRECT ACCESS 00110916 +C***** (ANS REF. 12.2.4.2 AND 12.9.5.2) 00120916 +C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS 00130916 +C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT. 00140916 +C***** 00150916 +CBB** ********************** BBCCOMNT **********************************00160916 +C**** 00170916 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00180916 +C**** VERSION 2.1 00190916 +C**** 00200916 +C**** 00210916 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00220916 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00230916 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00240916 +C**** BUILDING 225 RM A266 00250916 +C**** GAITHERSBURG, MD 20899 00260916 +C**** 00270916 +C**** 00280916 +C**** 00290916 +CBE** ********************** BBCCOMNT **********************************00300916 +C***** 00310916 + LOGICAL AVB, BVB 00320916 + CHARACTER*10 B10VK, D10VK, E11VK*11, F10VK, H10VK 00330916 +CBB** ********************** BBCINITA **********************************00340916 +C**** SPECIFICATION STATEMENTS 00350916 +C**** 00360916 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00370916 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00380916 +CBE** ********************** BBCINITA **********************************00390916 +CBB** ********************** BBCINITB **********************************00400916 +C**** INITIALIZE SECTION 00410916 + DATA ZVERS, ZVERSD, ZDATE 00420916 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00430916 + DATA ZCOMPL, ZNAME, ZTAPE 00440916 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00450916 + DATA ZPROJ, ZTAPED, ZPROG 00460916 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00470916 + DATA REMRKS /' '/ 00480916 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00490916 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00500916 +C**** 00510916 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00520916 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00530916 +CZ03 ZPROG = 'PROGRAM NAME' 00540916 +CZ04 ZDATE = 'DATE OF TEST' 00550916 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00560916 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00570916 +CZ07 ZNAME = 'NAME OF USER' 00580916 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00590916 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00600916 +C 00610916 + IVPASS = 0 00620916 + IVFAIL = 0 00630916 + IVDELE = 0 00640916 + IVINSP = 0 00650916 + IVTOTL = 0 00660916 + IVTOTN = 0 00670916 + ICZERO = 0 00680916 +C 00690916 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00700916 + I01 = 05 00710916 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00720916 + I02 = 06 00730916 +C 00740916 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00750916 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00760916 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00770916 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00780916 +C 00790916 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00800916 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00810916 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00820916 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00830916 +C 00840916 +CBE** ********************** BBCINITB **********************************00850916 +C***** 00860916 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 00870916 +C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 00880916 +C***** DIRECT, FORMATTED FILE. 00890916 +C***** S C R A T C H D I R E C T A C C E S S U N I T 00900916 + I14 = 930 00910916 +CX140 THIS CARD IS REPLACED BY THE CONTENTS OF CARD X-140 00920916 +C X-140 I14 = NN WILL OVERRIDE I14 = 14 00930916 +C***** 00940916 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 40 IS 00950916 +C***** NOT A VALID RECORD LENGTH. 00960916 + MVI = 40 00970916 +C***** 00980916 + NUVI = I02 00990916 + IOVI = I14 01000916 + ZPROG = 'FM916' 01010916 + IVTOTL = 1 01020916 +CBB** ********************** BBCHED0A **********************************01030916 +C**** 01040916 +C**** WRITE REPORT TITLE 01050916 +C**** 01060916 + WRITE (I02, 90002) 01070916 + WRITE (I02, 90006) 01080916 + WRITE (I02, 90007) 01090916 + WRITE (I02, 90008) ZVERS, ZVERSD 01100916 + WRITE (I02, 90009) ZPROG, ZPROG 01110916 + WRITE (I02, 90010) ZDATE, ZCOMPL 01120916 +CBE** ********************** BBCHED0A **********************************01130916 +C***** 01140916 + WRITE(NUVI,43200) 01150916 +43200 FORMAT(" ", / " INQU3 - (432) INQUIRE BY UNIT" // 01160916 + 1 " DIRECT ACCESS FORMATTED FILE" // 01170916 + 2 " ANS REF. - 12.10.3" ) 01180916 +CBB** ********************** BBCHED0B **********************************01190916 +C**** WRITE DETAIL REPORT HEADERS 01200916 +C**** 01210916 + WRITE (I02,90004) 01220916 + WRITE (I02,90004) 01230916 + WRITE (I02,90013) 01240916 + WRITE (I02,90014) 01250916 + WRITE (I02,90015) IVTOTL 01260916 +CBE** ********************** BBCHED0B **********************************01270916 +C***** 01280916 +C***** OPEN FILE 01290916 + OPEN(UNIT=IOVI, ACCESS='DIRECT', RECL=MVI, FORM='FORMATTED', 01300916 + 1 BLANK='NULL') 01310916 +C***** 01320916 +C***** TEST 1 - FIRST INQUIRE (AFTER OPEN) 01330916 + IVTNUM = 1 01340916 + INQUIRE(UNIT=IOVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01350916 + 1 ACCESS=B10VK, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 01360916 + 2 FORM=E11VK, FORMATTED=F10VK, BLANK=H10VK, ERR=20014, 01370916 + 3 IOSTAT=NVI) 01380916 +C***** 01390916 + IF (NVI .NE. 0) GO TO 20010 01400916 + IF (.NOT. AVB) GO TO 20010 01410916 + IF (.NOT. BVB) GO TO 20010 01420916 + IF (JVI .NE. IOVI) GO TO 20010 01430916 + IF (B10VK .NE. 'DIRECT') GO TO 20010 01440916 + IF (D10VK .NE. 'YES') GO TO 20010 01450916 + IF (KVI .NE. MVI) GO TO 20010 01460916 + IF (LVI .NE. 1) GO TO 20010 01470916 + IF (E11VK .NE. 'FORMATTED') GO TO 20010 01480916 + IF (F10VK .NE. 'YES' ) GO TO 20010 01490916 + IF (H10VK .NE. 'NULL') GO TO 20010 01500916 + WRITE (NUVI, 80002) IVTNUM 01510916 + IVPASS = IVPASS + 1 01520916 + GO TO 0011 01530916 +20014 CONTINUE 01540916 + WRITE (NUVI, 20015) IVTNUM 01550916 +20015 FORMAT (" ",2X,I3,4X," FAIL",12X, 01560916 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 01570916 + GO TO 20016 01580916 +20010 CONTINUE 01590916 + WRITE (NUVI, 20011) IVTNUM 01600916 +20011 FORMAT(" ",2X,I3,4X," FAIL",12X, 01610916 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 01620916 +20016 IVFAIL = IVFAIL + 1 01630916 + WRITE (NUVI, 20012) NVI,AVB,BVB,JVI,B10VK,D10VK, 01640916 + 1 KVI,LVI,E11VK,F10VK,H10VK 01650916 +20012 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 01660916 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 01670916 + 2 " ",26X,"ACCESS=",A10,", DIRECT=",A3,", RECL=", 01680916 + 3 I4,","/" ",26X,"NEXTREC=",I4,", FORM=", 01690916 + 4 A9,","/" ",26X,"FORMATTED=" ,A3,", BLANK=",A4) 01700916 + WRITE (NUVI, 20013) IOVI,MVI 01710916 +20013 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 01720916 + 1 "OPENED=T, NUMBER=" ,I4,","/ 01730916 + 2 " ",26X,"ACCESS=DIRECT, DIRECT=YES, RECL=" , 01740916 + 3 I4,","/" ",26X,"NEXTREC=1, FORM=FORMATTED," / 01750916 + 4 " ",26X,"FORMATTED=YES, BLANK=NULL" ) 01760916 + 0011 CONTINUE 01770916 +C***** 01780916 + CLOSE(UNIT=IOVI, STATUS='DELETE') 01790916 +C***** 01800916 +CBB** ********************** BBCSUM0 **********************************01810916 +C**** WRITE OUT TEST SUMMARY 01820916 +C**** 01830916 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01840916 + WRITE (I02, 90004) 01850916 + WRITE (I02, 90014) 01860916 + WRITE (I02, 90004) 01870916 + WRITE (I02, 90020) IVPASS 01880916 + WRITE (I02, 90022) IVFAIL 01890916 + WRITE (I02, 90024) IVDELE 01900916 + WRITE (I02, 90026) IVINSP 01910916 + WRITE (I02, 90028) IVTOTN, IVTOTL 01920916 +CBE** ********************** BBCSUM0 **********************************01930916 +CBB** ********************** BBCFOOT0 **********************************01940916 +C**** WRITE OUT REPORT FOOTINGS 01950916 +C**** 01960916 + WRITE (I02,90016) ZPROG, ZPROG 01970916 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 01980916 + WRITE (I02,90019) 01990916 +CBE** ********************** BBCFOOT0 **********************************02000916 +CBB** ********************** BBCFMT0A **********************************02010916 +C**** FORMATS FOR TEST DETAIL LINES 02020916 +C**** 02030916 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02040916 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02050916 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02060916 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02070916 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02080916 + 1I6,/," ",15X,"CORRECT= " ,I6) 02090916 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02100916 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02110916 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02120916 + 1A21,/," ",16X,"CORRECT= " ,A21) 02130916 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02140916 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02150916 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02160916 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02170916 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02180916 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02190916 +80050 FORMAT (" ",48X,A31) 02200916 +CBE** ********************** BBCFMT0A **********************************02210916 +CBB** ********************** BBCFMT0B **********************************02220916 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02230916 +C**** 02240916 +90002 FORMAT ("1") 02250916 +90004 FORMAT (" ") 02260916 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02270916 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02280916 +90008 FORMAT (" ",21X,A13,A17) 02290916 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02300916 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02310916 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02320916 + 1 7X,"REMARKS",24X) 02330916 +90014 FORMAT (" ","----------------------------------------------" , 02340916 + 1 "---------------------------------" ) 02350916 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02360916 +C**** 02370916 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02380916 +C**** 02390916 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02400916 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02410916 + 1 A13) 02420916 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02430916 +C**** 02440916 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02450916 +C**** 02460916 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02470916 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02480916 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02490916 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02500916 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02510916 +CBE** ********************** BBCFMT0B **********************************02520916 +C***** 02530916 +C***** END OF TEST SEGMENT 432 02540916 + STOP 02550916 + END 02560916 diff --git a/Fortran/UnitTests/fcvs21_f95/FM916.reference_output b/Fortran/UnitTests/fcvs21_f95/FM916.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM916.reference_output @@ -0,0 +1,35 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM916BEGIN* TEST RESULTS - FM916 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INQU3 - (432) INQUIRE BY UNIT + + DIRECT ACCESS FORMATTED FILE + + ANS REF. - 12.10.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 1 TESTS + + 1 PASS + + ------------------------------------------------------------------------------- + + 1 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 1 OF 1 TESTS EXECUTED + + *FM916END* END OF TEST - FM916 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM917.f b/Fortran/UnitTests/fcvs21_f95/FM917.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM917.f @@ -0,0 +1,345 @@ + PROGRAM FM917 + +C***********************************************************************00010917 +C***** FORTRAN 77 00020917 +C***** FM917 00030917 +C***** INQU4 - (433) 00040917 +C***** 00050917 +C***********************************************************************00060917 +C***** GENERAL PURPOSE ANS REF 00070917 +C***** TEST INQUIRE BY UNIT ON DIRECT, UNFORMATTED FILE 12.10.3 00080917 +C***** 00090917 +C***** THE TESTS IN THE UNIT ARE ONLY PERFORMED ON A 00100917 +C***** UNIT THAT IS CONNECTED FOR DIRECT, UNFORMATTED ACCESS 00110917 +C***** (ANS REF. 12.2.4.2 AND 12.9.5.1) 00120917 +C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS 00130917 +C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT. 00140917 +C***** THIS SEGMENT TESTS THAT AN INQUIRE IS PERFORMED CORRECTLY 00150917 +C***** BEFORE READING OR WRITING TO THE FILE, AFTER WRITING TO 00160917 +C***** THE FILE, AND AFTER READING FROM THE FILE. 00170917 +C***** 00180917 +C***** NOTE: 00190917 +C***** AN INQUIRE STATEMENT IS NEEDED TO TEST THE READ AND 00200917 +C***** WRITE OF MORE THAN A SINGLE RECORD AT A TIME, IN ORDER TO 00210917 +C***** DETERMINE THAT THE RECORD NUMBER IS ADVANCED THE CORRECT 00220917 +C***** NUMBER (ONE MORE THAN THE RECORD NUMBER LAST READ OR WRITTEN).00230917 +C***** THIS TEST WILL BE PERFORMED IN THE SEGMENTS WHICH TEST 00240917 +C***** DIRECT ACCESS FILES - SEGMENT DIRAF3 (412). 00250917 +C***********************************************************************00260917 +C***** 00270917 +CBB** ********************** BBCCOMNT **********************************00280917 +C**** 00290917 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00300917 +C**** VERSION 2.1 00310917 +C**** 00320917 +C**** 00330917 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00340917 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00350917 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00360917 +C**** BUILDING 225 RM A266 00370917 +C**** GAITHERSBURG, MD 20899 00380917 +C**** 00390917 +C**** 00400917 +C**** 00410917 +CBE** ********************** BBCCOMNT **********************************00420917 +C***** 00430917 + LOGICAL AVB, BVB 00440917 + CHARACTER*10 B10VK, D10VK, E11VK*11, G10VK 00450917 +C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00460917 +CBB** ********************** BBCINITA **********************************00470917 +C**** SPECIFICATION STATEMENTS 00480917 +C**** 00490917 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00500917 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00510917 +CBE** ********************** BBCINITA **********************************00520917 +CBB** ********************** BBCINITB **********************************00530917 +C**** INITIALIZE SECTION 00540917 + DATA ZVERS, ZVERSD, ZDATE 00550917 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00560917 + DATA ZCOMPL, ZNAME, ZTAPE 00570917 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00580917 + DATA ZPROJ, ZTAPED, ZPROG 00590917 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00600917 + DATA REMRKS /' '/ 00610917 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00620917 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00630917 +C**** 00640917 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00650917 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00660917 +CZ03 ZPROG = 'PROGRAM NAME' 00670917 +CZ04 ZDATE = 'DATE OF TEST' 00680917 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00690917 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00700917 +CZ07 ZNAME = 'NAME OF USER' 00710917 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00720917 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00730917 +C 00740917 + IVPASS = 0 00750917 + IVFAIL = 0 00760917 + IVDELE = 0 00770917 + IVINSP = 0 00780917 + IVTOTL = 0 00790917 + IVTOTN = 0 00800917 + ICZERO = 0 00810917 +C 00820917 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00830917 + I01 = 05 00840917 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00850917 + I02 = 06 00860917 +C 00870917 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00880917 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00890917 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00900917 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00910917 +C 00920917 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00930917 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00940917 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00950917 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00960917 +C 00970917 +CBE** ********************** BBCINITB **********************************00980917 +C***** 00990917 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 01000917 +C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 01010917 +C***** DIRECT, UNFORMATTED FILE. 01020917 +C***** 01030917 +C I12 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE. 01040917 + I12 = 931 01050917 +CX120 REPLACED BY FEXEC X-120 CONTROL CARD (DIR. FILE UNIT NUMBER). 01060917 +C SPECIFYING I12 = NN OVERRIDES THE DEFAULT I12 = 14. 01070917 +C***** 01080917 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01090917 +C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 01100917 +C***** UNFORMATTED FILE. 01110917 +C***** 01120917 +C***** 01130917 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 40 IS 01140917 +C***** NOT A VALID RECORD LENGTH. 01150917 + MVI = 40 01160917 +C***** 01170917 + NUVI = I02 01180917 + IOVI = I12 01190917 + ZPROG = 'FM917' 01200917 + IVTOTL = 3 01210917 +CBB** ********************** BBCHED0A **********************************01220917 +C**** 01230917 +C**** WRITE REPORT TITLE 01240917 +C**** 01250917 + WRITE (I02, 90002) 01260917 + WRITE (I02, 90006) 01270917 + WRITE (I02, 90007) 01280917 + WRITE (I02, 90008) ZVERS, ZVERSD 01290917 + WRITE (I02, 90009) ZPROG, ZPROG 01300917 + WRITE (I02, 90010) ZDATE, ZCOMPL 01310917 +CBE** ********************** BBCHED0A **********************************01320917 +C***** 01330917 + WRITE(NUVI,43300) 01340917 +43300 FORMAT(" ", / " INQU4 - (433) INQUIRE BY UNIT" // 01350917 + 1 " DIRECT ACCESS UNFORMATTED FILE" // 01360917 + 2 " ANS REF. - 12.10.3" ) 01370917 +CBB** ********************** BBCHED0B **********************************01380917 +C**** WRITE DETAIL REPORT HEADERS 01390917 +C**** 01400917 + WRITE (I02,90004) 01410917 + WRITE (I02,90004) 01420917 + WRITE (I02,90013) 01430917 + WRITE (I02,90014) 01440917 + WRITE (I02,90015) IVTOTL 01450917 +CBE** ********************** BBCHED0B **********************************01460917 +C***** 01470917 +C***** OPEN FILE 01480917 + OPEN(UNIT=IOVI, ACCESS='DIRECT', RECL=MVI, FORM='UNFORMATTED') 01490917 +C***** 01500917 +CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN) 01510917 + IVTNUM = 1 01520917 + INQUIRE(UNIT=IOVI, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01530917 + 1 ACCESS=B10VK, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 01540917 + 2 FORM=E11VK, UNFORMATTED=G10VK, ERR=20014,IOSTAT=IVI) 01550917 +C***** 01560917 + IF (IVI .NE. 0) GO TO 20010 01570917 + IF (.NOT. AVB) GO TO 20010 01580917 + IF (.NOT. BVB) GO TO 20010 01590917 + IF (JVI .NE. IOVI) GO TO 20010 01600917 + IF (B10VK .NE. 'DIRECT') GO TO 20010 01610917 + IF (D10VK .NE. 'YES') GO TO 20010 01620917 + IF (KVI .NE. MVI) GO TO 20010 01630917 + IF (LVI .NE. 1) GO TO 20010 01640917 + IF (E11VK .NE. 'UNFORMATTED') GO TO 20010 01650917 + IF (G10VK .NE. 'YES' ) GO TO 20010 01660917 + WRITE (NUVI, 80002) IVTNUM 01670917 + IVPASS = IVPASS + 1 01680917 + GO TO 0011 01690917 +20014 CONTINUE 01700917 + WRITE (NUVI, 20015) IVTNUM 01710917 +20015 FORMAT (" ",2X,I3,4X," FAIL",12X, 01720917 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 01730917 + GO TO 20016 01740917 +20010 CONTINUE 01750917 + WRITE (NUVI, 20011) IVTNUM 01760917 +20011 FORMAT(" ",2X,I3,4X," FAIL",12X, 01770917 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 01780917 +20016 IVFAIL = IVFAIL + 1 01790917 + WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,D10VK, 01800917 + 1 KVI,LVI,E11VK,G10VK 01810917 +20012 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 01820917 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 01830917 + 2 " ",26X,"ACCESS=",A10,", DIRECT=",A3,", RECL=", 01840917 + 3 I4,","/" ",26X,"NEXTREC=",I4,", FORM=", 01850917 + 4 A11,","/" ",26X,"UNFORMATTED=" ,A3) 01860917 + WRITE (NUVI, 20013) IOVI, MVI 01870917 +20013 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 01880917 + 1 "OPENED=T, NUMBER=" ,I4,","/ 01890917 + 2 " ",26X,"ACCESS=DIRECT, DIRECT=YES, RECL=" , 01900917 + 3 I4,","/" ",26X,"NEXTREC=1, FORM=UNFORMATTED," / 01910917 + 4 " ",26X,"UNFORMATTED=YES" ) 01920917 + 0011 CONTINUE 01930917 +C***** 01940917 +C***** WRITE A RECORD TO FILE 01950917 + WRITE(IOVI, REC=1) JVI 01960917 +C***** 01970917 +CT002* TEST 2 - SECOND INQUIRE (AFTER WRITE) 01980917 + IVTNUM = 2 01990917 +C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC 02000917 +C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED 02010917 + INQUIRE(UNIT=IOVI, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 02020917 + 1 ERR=20024, IOSTAT=IVI) 02030917 +C***** 02040917 + IF (IVI .NE. 0) GO TO 20020 02050917 + IF (D10VK .NE. 'YES') GO TO 20020 02060917 + IF (KVI .NE. MVI) GO TO 20020 02070917 + IF (LVI .NE. 2) GO TO 20020 02080917 + WRITE (NUVI, 80002) IVTNUM 02090917 + IVPASS = IVPASS + 1 02100917 + GO TO 0021 02110917 +20024 CONTINUE 02120917 + WRITE (NUVI, 20025) IVTNUM 02130917 +20025 FORMAT (" ",2X,I3,4X," FAIL",12X, 02140917 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 02150917 + GO TO 20026 02160917 +20020 CONTINUE 02170917 + WRITE (NUVI, 20021) IVTNUM 02180917 +20021 FORMAT(" ",2X,I3,4X," FAIL",12X, 02190917 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 02200917 +20026 IVFAIL = IVFAIL + 1 02210917 + WRITE (NUVI, 20022) IVI,D10VK,KVI,LVI 02220917 +20022 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", DIRECT=",A3, 02230917 + 1 " ,RECL=",I4,", NEXTREC=" ,I4) 02240917 + WRITE (NUVI, 20023) MVI 02250917 +20023 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, DIRECT=YES, " , 02260917 + 1 "RECL=",I4,", NEXTREC= 2" ) 02270917 + 0021 CONTINUE 02280917 +C***** 02290917 +C***** READ A RECORD FROM FILE 02300917 +C***** 02310917 + READ(IOVI, REC=1) JVI 02320917 +C***** 02330917 +CT003* TEST 3 - THIRD INQUIRE (AFTER READ) 02340917 + IVTNUM = 3 02350917 +C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC 02360917 +C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED 02370917 + INQUIRE(UNIT=IOVI, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 02380917 + 1 ERR=20034, IOSTAT=IVI) 02390917 +C***** 02400917 + IF (IVI .NE. 0) GO TO 20030 02410917 + IF (D10VK .NE. 'YES') GO TO 20030 02420917 + IF (KVI .NE. MVI) GO TO 20030 02430917 + IF (LVI .NE. 2) GO TO 20030 02440917 + WRITE (NUVI, 80002) IVTNUM 02450917 + IVPASS = IVPASS + 1 02460917 + GO TO 0031 02470917 +20034 CONTINUE 02480917 + WRITE (NUVI, 20035) IVTNUM 02490917 +20035 FORMAT (" ",2X,I3,4X," FAIL",12X, 02500917 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 02510917 + GO TO 20036 02520917 +20030 CONTINUE 02530917 + WRITE (NUVI, 20031) IVTNUM 02540917 +20031 FORMAT(" ",2X,I3,4X," FAIL",12X, 02550917 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 02560917 +20036 IVFAIL = IVFAIL + 1 02570917 + WRITE (NUVI, 20032) IVI,D10VK,KVI,LVI 02580917 +20032 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", DIRECT=",A3, 02590917 + 1 " ,RECL=",I4,", NEXTREC=" ,I4) 02600917 + WRITE (NUVI, 20023) MVI 02610917 +20033 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, DIRECT=YES, " , 02620917 + 1 "RECL=",I4,", NEXTREC= 2" ) 02630917 + 0031 CONTINUE 02640917 +C***** 02650917 + CLOSE(UNIT=IOVI, STATUS='DELETE') 02660917 +C***** 02670917 +CBB** ********************** BBCSUM0 **********************************02680917 +C**** WRITE OUT TEST SUMMARY 02690917 +C**** 02700917 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02710917 + WRITE (I02, 90004) 02720917 + WRITE (I02, 90014) 02730917 + WRITE (I02, 90004) 02740917 + WRITE (I02, 90020) IVPASS 02750917 + WRITE (I02, 90022) IVFAIL 02760917 + WRITE (I02, 90024) IVDELE 02770917 + WRITE (I02, 90026) IVINSP 02780917 + WRITE (I02, 90028) IVTOTN, IVTOTL 02790917 +CBE** ********************** BBCSUM0 **********************************02800917 +CBB** ********************** BBCFOOT0 **********************************02810917 +C**** WRITE OUT REPORT FOOTINGS 02820917 +C**** 02830917 + WRITE (I02,90016) ZPROG, ZPROG 02840917 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02850917 + WRITE (I02,90019) 02860917 +CBE** ********************** BBCFOOT0 **********************************02870917 +CBB** ********************** BBCFMT0A **********************************02880917 +C**** FORMATS FOR TEST DETAIL LINES 02890917 +C**** 02900917 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02910917 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02920917 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02930917 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02940917 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02950917 + 1I6,/," ",15X,"CORRECT= " ,I6) 02960917 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02970917 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02980917 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02990917 + 1A21,/," ",16X,"CORRECT= " ,A21) 03000917 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03010917 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03020917 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03030917 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03040917 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03050917 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03060917 +80050 FORMAT (" ",48X,A31) 03070917 +CBE** ********************** BBCFMT0A **********************************03080917 +CBB** ********************** BBCFMT0B **********************************03090917 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03100917 +C**** 03110917 +90002 FORMAT ("1") 03120917 +90004 FORMAT (" ") 03130917 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03140917 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03150917 +90008 FORMAT (" ",21X,A13,A17) 03160917 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03170917 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03180917 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03190917 + 1 7X,"REMARKS",24X) 03200917 +90014 FORMAT (" ","----------------------------------------------" , 03210917 + 1 "---------------------------------" ) 03220917 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03230917 +C**** 03240917 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03250917 +C**** 03260917 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03270917 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03280917 + 1 A13) 03290917 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03300917 +C**** 03310917 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03320917 +C**** 03330917 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03340917 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03350917 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03360917 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03370917 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03380917 +CBE** ********************** BBCFMT0B **********************************03390917 +C***** 03400917 +C***** END OF TEST SEGMENT 433 03410917 + STOP 03420917 + END 03430917 diff --git a/Fortran/UnitTests/fcvs21_f95/FM917.reference_output b/Fortran/UnitTests/fcvs21_f95/FM917.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM917.reference_output @@ -0,0 +1,37 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM917BEGIN* TEST RESULTS - FM917 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INQU4 - (433) INQUIRE BY UNIT + + DIRECT ACCESS UNFORMATTED FILE + + ANS REF. - 12.10.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 3 TESTS + + 1 PASS + 2 PASS + 3 PASS + + ------------------------------------------------------------------------------- + + 3 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 3 OF 3 TESTS EXECUTED + + *FM917END* END OF TEST - FM917 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM919.f b/Fortran/UnitTests/fcvs21_f95/FM919.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM919.f @@ -0,0 +1,270 @@ + PROGRAM FM919 + +C***********************************************************************00010919 +C***** FORTRAN 77 00020919 +C***** FM919 00030919 +C***** INQF1 - (438) 00040919 +C***** 00050919 +C***********************************************************************00060919 +C***** GENERAL PURPOSE ANS REF 00070919 +C***** TEST INQUIRE BY FILE ON SEQUENTIAL, FORMATTED FILES 12.10.3 00080919 +C***** 00090919 +C***** THE TESTS IN THIS UNIT ARE ONLY PERFORMED ON A 00100919 +C***** FILE THAT IS CONNECTED FOR SEQUENTIAL, FORMATTED ACCESS 00110919 +C***** (ANS REF. 12.2.4.1 AND 12.9.5.2) 00120919 +C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS 00130919 +C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT. 00140919 +C***********************************************************************00150919 +CBB** ********************** BBCCOMNT **********************************00160919 +C**** 00170919 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00180919 +C**** VERSION 2.1 00190919 +C**** 00200919 +C**** 00210919 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00220919 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00230919 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00240919 +C**** BUILDING 225 RM A266 00250919 +C**** GAITHERSBURG, MD 20899 00260919 +C**** 00270919 +C**** 00280919 +C**** 00290919 +CBE** ********************** BBCCOMNT **********************************00300919 +C***** 00310919 + LOGICAL AVB, BVB 00320919 + CHARACTER*10 B10VK, C10VK, E11VK*11, F10VK, H10VK 00330919 +C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00340919 +CX19 REPLACED BY FEXEC X-19 CONTROL CARD. X-19 IS FOR REPLACING 00350919 + CHARACTER*15 CSEQ 00360919 +C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-090 00370919 +C (PROGRAM VARIABLE CSEQ) IF NOT VALID FOR THE PROCESSOR. 00380919 +CBB** ********************** BBCINITA **********************************00390919 +C**** SPECIFICATION STATEMENTS 00400919 +C**** 00410919 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00420919 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00430919 +CBE** ********************** BBCINITA **********************************00440919 +CBB** ********************** BBCINITB **********************************00450919 +C**** INITIALIZE SECTION 00460919 + DATA ZVERS, ZVERSD, ZDATE 00470919 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00480919 + DATA ZCOMPL, ZNAME, ZTAPE 00490919 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00500919 + DATA ZPROJ, ZTAPED, ZPROG 00510919 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00520919 + DATA REMRKS /' '/ 00530919 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00540919 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00550919 +C**** 00560919 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00570919 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00580919 +CZ03 ZPROG = 'PROGRAM NAME' 00590919 +CZ04 ZDATE = 'DATE OF TEST' 00600919 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00610919 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00620919 +CZ07 ZNAME = 'NAME OF USER' 00630919 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00640919 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00650919 +C 00660919 + IVPASS = 0 00670919 + IVFAIL = 0 00680919 + IVDELE = 0 00690919 + IVINSP = 0 00700919 + IVTOTL = 0 00710919 + IVTOTN = 0 00720919 + ICZERO = 0 00730919 +C 00740919 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00750919 + I01 = 05 00760919 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00770919 + I02 = 06 00780919 +C 00790919 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00800919 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00810919 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00820919 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00830919 +C 00840919 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00850919 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00860919 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00870919 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00880919 +C 00890919 +CBE** ********************** BBCINITB **********************************00900919 +C***** 00910919 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 00920919 +C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 00930919 +C***** SEQUENTIAL, FORMATTED FILE. 00940919 +C***** 00950919 + I09 = 933 00960919 +CX090 THIS CARD IS REPLACED BY THE CONTENTS OF CX090 00970919 +C X-090 I09 = NN WILL OVERRIDE I09 = 14 00980919 +C***** 00990919 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01000919 +C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A SEQUENTIAL, 01010919 +C***** FORMATTED FILE. 01020919 +C***** 01030919 +C***** 01040919 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01050919 +C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A SEQUENTIAL, 01060919 +C***** FORMATTED FILE. 01070919 +C***** 01080919 +C CSEQ CONTAINS THE FILE NAME FOR UNIT I09. 01090919 + CSEQ = ' SEQFILE919' 01100919 +C 01110919 +CX191 REPLACED BY FEXEC X-191 CONTROL CARD. CX191 IS FOR SYSTEMS 01120919 +C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 01130919 +C X-090 THAN THE DEFAULT CSEQ = ' SEQFILE'. 01140919 +C***** 01150919 + NUVI = I02 01160919 + IMVI = I09 01170919 + ZPROG = 'FM919' 01180919 + IVTOTL = 1 01190919 +CBB** ********************** BBCHED0A **********************************01200919 +C**** 01210919 +C**** WRITE REPORT TITLE 01220919 +C**** 01230919 + WRITE (I02, 90002) 01240919 + WRITE (I02, 90006) 01250919 + WRITE (I02, 90007) 01260919 + WRITE (I02, 90008) ZVERS, ZVERSD 01270919 + WRITE (I02, 90009) ZPROG, ZPROG 01280919 + WRITE (I02, 90010) ZDATE, ZCOMPL 01290919 +CBE** ********************** BBCHED0A **********************************01300919 +C***** 01310919 + WRITE(NUVI,43800) 01320919 +43800 FORMAT(" ", / " INQF1 - (438) INQUIRE BY FILE" // 01330919 + 1 " SEQUENTIAL FORMATTED FILE, CONNECTED BY OPEN" // 01340919 + 2 " ANS REF. - 12.10.3" ) 01350919 +CBB** ********************** BBCHED0B **********************************01360919 +C**** WRITE DETAIL REPORT HEADERS 01370919 +C**** 01380919 + WRITE (I02,90004) 01390919 + WRITE (I02,90004) 01400919 + WRITE (I02,90013) 01410919 + WRITE (I02,90014) 01420919 + WRITE (I02,90015) IVTOTL 01430919 +CBE** ********************** BBCHED0B **********************************01440919 +C***** 01450919 +C***** OPEN FILE 01460919 + OPEN(FILE=CSEQ, UNIT=IMVI, ACCESS='SEQUENTIAL', 01470919 + 1 FORM='FORMATTED', BLANK='NULL') 01480919 +C***** 01490919 +CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN) 01500919 + IVTNUM = 1 01510919 + INQUIRE(FILE=CSEQ, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01520919 + 1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK, 01530919 + 2 FORMATTED=F10VK, BLANK=H10VK, ERR=20014, IOSTAT=IVI) 01540919 + 01550919 + IF (IVI .NE. 0) GO TO 20010 01560919 + IF (.NOT. AVB) GO TO 20010 01570919 + IF (.NOT. BVB) GO TO 20010 01580919 + IF (JVI .NE. IMVI) GO TO 20010 01590919 + IF (B10VK .NE. 'SEQUENTIAL') GO TO 20010 01600919 + IF (C10VK .NE. 'YES') GO TO 20010 01610919 + IF (E11VK .NE. 'FORMATTED') GO TO 20010 01620919 + IF (F10VK .NE. 'YES' ) GO TO 20010 01630919 + IF (H10VK .NE. 'NULL') GO TO 20010 01640919 + WRITE (NUVI, 80002) IVTNUM 01650919 + IVPASS = IVPASS + 1 01660919 + GO TO 0011 01670919 +20014 CONTINUE 01680919 + WRITE (NUVI, 20015) IVTNUM 01690919 +20015 FORMAT (" ",2X,I3,4X," FAIL",12X, 01700919 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 01710919 + GO TO 20016 01720919 +20010 CONTINUE 01730919 + WRITE (NUVI, 20011) IVTNUM 01740919 +20011 FORMAT(" ",2X,I3,4X," FAIL",12X, 01750919 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 01760919 +20016 IVFAIL = IVFAIL + 1 01770919 + WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,C10VK,E11VK, 01780919 + 1 F10VK,H10VK 01790919 +20012 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 01800919 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 01810919 + 2 " ",26X,"ACCESS=",A10,", SEQUENTIAL=" ,A3,", FORM=", 01820919 + 3 A9,","/" ",26X,"FORMATTED=" ,A3,", BLANK=",A4) 01830919 + WRITE (NUVI, 20013) IMVI 01840919 +20013 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 01850919 + 1 "OPENED=T, NUMBER=" ,I4,","/ 01860919 + 2 " ",26X,"ACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=" , 01870919 + 3 "FORMATTED," /" ",26X,"FORMATTED=YES, BLANK=NULL" ) 01880919 + 0011 CONTINUE 01890919 +C***** 01900919 +43803 CLOSE(UNIT=IMVI, STATUS='DELETE') 01910919 +C***** 01920919 +CBB** ********************** BBCSUM0 **********************************01930919 +C**** WRITE OUT TEST SUMMARY 01940919 +C**** 01950919 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01960919 + WRITE (I02, 90004) 01970919 + WRITE (I02, 90014) 01980919 + WRITE (I02, 90004) 01990919 + WRITE (I02, 90020) IVPASS 02000919 + WRITE (I02, 90022) IVFAIL 02010919 + WRITE (I02, 90024) IVDELE 02020919 + WRITE (I02, 90026) IVINSP 02030919 + WRITE (I02, 90028) IVTOTN, IVTOTL 02040919 +CBE** ********************** BBCSUM0 **********************************02050919 +CBB** ********************** BBCFOOT0 **********************************02060919 +C**** WRITE OUT REPORT FOOTINGS 02070919 +C**** 02080919 + WRITE (I02,90016) ZPROG, ZPROG 02090919 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02100919 + WRITE (I02,90019) 02110919 +CBE** ********************** BBCFOOT0 **********************************02120919 +CBB** ********************** BBCFMT0A **********************************02130919 +C**** FORMATS FOR TEST DETAIL LINES 02140919 +C**** 02150919 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02160919 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02170919 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02180919 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02190919 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02200919 + 1I6,/," ",15X,"CORRECT= " ,I6) 02210919 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02220919 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02230919 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02240919 + 1A21,/," ",16X,"CORRECT= " ,A21) 02250919 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02260919 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02270919 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02280919 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02290919 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02300919 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02310919 +80050 FORMAT (" ",48X,A31) 02320919 +CBE** ********************** BBCFMT0A **********************************02330919 +CBB** ********************** BBCFMT0B **********************************02340919 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02350919 +C**** 02360919 +90002 FORMAT ("1") 02370919 +90004 FORMAT (" ") 02380919 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02390919 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02400919 +90008 FORMAT (" ",21X,A13,A17) 02410919 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02420919 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02430919 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02440919 + 1 7X,"REMARKS",24X) 02450919 +90014 FORMAT (" ","----------------------------------------------" , 02460919 + 1 "---------------------------------" ) 02470919 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02480919 +C**** 02490919 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02500919 +C**** 02510919 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02520919 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02530919 + 1 A13) 02540919 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02550919 +C**** 02560919 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02570919 +C**** 02580919 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02590919 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02600919 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02610919 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02620919 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02630919 +CBE** ********************** BBCFMT0B **********************************02640919 +C***** 02650919 +C***** END OF TEST SEGMENT 438 02660919 + STOP 02670919 + END 02680919 diff --git a/Fortran/UnitTests/fcvs21_f95/FM919.reference_output b/Fortran/UnitTests/fcvs21_f95/FM919.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM919.reference_output @@ -0,0 +1,35 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM919BEGIN* TEST RESULTS - FM919 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INQF1 - (438) INQUIRE BY FILE + + SEQUENTIAL FORMATTED FILE, CONNECTED BY OPEN + + ANS REF. - 12.10.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 1 TESTS + + 1 PASS + + ------------------------------------------------------------------------------- + + 1 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 1 OF 1 TESTS EXECUTED + + *FM919END* END OF TEST - FM919 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM920.f b/Fortran/UnitTests/fcvs21_f95/FM920.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM920.f @@ -0,0 +1,357 @@ + PROGRAM FM920 + +C***********************************************************************00010920 +C***** FORTRAN 77 00020920 +C***** FM920 00030920 +C***** INQF2 - (439) 00040920 +C***** 00050920 +C***********************************************************************00060920 +C***** GENERAL PURPOSE ANS REF 00070920 +C***** TEST INQUIRE ON SEQUENTIAL, UNFORMATTED FILES 12.10.3 00080920 +C***** 00090920 +C***** THE TESTS IN THIS UNIT ARE ONLY PERFORMED ON A 00100920 +C***** FILE THAT IS CONNECTED FOR SEQUENTIAL, UNFORMATTED ACCESS 00110920 +C***** (ANS REF. 12.2.4.1 AND 12.9.5.1) 00120920 +C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS 00130920 +C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT. 00140920 +C***** THE SEGMENT TESTS THAT INQUIRE IS PERFORMED CORRECTLY 00150920 +C***** BEFORE READING OR WRITING TO A FILE, AFTER WRITING TO A FILE 00160920 +C***** AND AFTER READING FROM A FILE. 00170920 +C***********************************************************************00180920 +C***** 00190920 +CBB** ********************** BBCCOMNT **********************************00200920 +C**** 00210920 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00220920 +C**** VERSION 2.1 00230920 +C**** 00240920 +C**** 00250920 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00260920 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00270920 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00280920 +C**** BUILDING 225 RM A266 00290920 +C**** GAITHERSBURG, MD 20899 00300920 +C**** 00310920 +C**** 00320920 +C**** 00330920 +CBE** ********************** BBCCOMNT **********************************00340920 +C***** 00350920 + LOGICAL AVB, BVB 00360920 + CHARACTER*10 B10VK, C10VK, E11VK*11, G10VK 00370920 +C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00380920 +CX19 REPLACED BY FEXEC X-19 CONTROL CARD. X-19 IS FOR REPLACING 00390920 + CHARACTER*15 CSEQ 00400920 +C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-050 00410920 +C (PROGRAM VARIABLE CSEQ) IF NOT VALID FOR THE PROCESSOR. 00420920 +C***** 00430920 +CBB** ********************** BBCINITA **********************************00440920 +C**** SPECIFICATION STATEMENTS 00450920 +C**** 00460920 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00470920 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00480920 +CBE** ********************** BBCINITA **********************************00490920 +CBB** ********************** BBCINITB **********************************00500920 +C**** INITIALIZE SECTION 00510920 + DATA ZVERS, ZVERSD, ZDATE 00520920 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00530920 + DATA ZCOMPL, ZNAME, ZTAPE 00540920 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00550920 + DATA ZPROJ, ZTAPED, ZPROG 00560920 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00570920 + DATA REMRKS /' '/ 00580920 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00590920 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00600920 +C**** 00610920 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00620920 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00630920 +CZ03 ZPROG = 'PROGRAM NAME' 00640920 +CZ04 ZDATE = 'DATE OF TEST' 00650920 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00660920 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00670920 +CZ07 ZNAME = 'NAME OF USER' 00680920 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00690920 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00700920 +C 00710920 + IVPASS = 0 00720920 + IVFAIL = 0 00730920 + IVDELE = 0 00740920 + IVINSP = 0 00750920 + IVTOTL = 0 00760920 + IVTOTN = 0 00770920 + ICZERO = 0 00780920 +C 00790920 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00800920 + I01 = 05 00810920 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00820920 + I02 = 06 00830920 +C 00840920 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00850920 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00860920 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00870920 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00880920 +C 00890920 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00900920 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00910920 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00920920 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00930920 +C 00940920 +CBE** ********************** BBCINITB **********************************00950920 +C***** 00960920 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 00970920 +C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 00980920 +C***** SEQUENTIAL, UNFORMATTED FILE. 00990920 +C***** 01000920 + I05 = 14 01010920 +CX050 THIS CARD IS USED TO REPLACE THE CONTENTS OF I05 = 15 01020920 +C X-050 I05 = NN WILL OVERRIDE DEFAULT I05 = 14 01030920 +C 01040920 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01050920 +C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A SEQUENTIAL, 01060920 +C***** UNFORMATTED FILE. 01070920 +C***** 01080920 +C CSEQ CONTAINS THE FILE NAME FOR UNIT I05. 01090920 + CSEQ = ' SEQFILE920' 01100920 +C 01110920 +CX191 REPLACED BY FEXEC X-191 CONTROL CARD. CX191 IS FOR SYSTEMS 01120920 +C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 01130920 +C X-050 THAN THE DEFAULT CSEQ = ' SEQFILE'. 01140920 +C***** 01150920 + NUVI = I02 01160920 + IMVI = I05 01170920 + ZPROG = 'FM920' 01180920 + IVTOTL = 3 01190920 +CBB** ********************** BBCHED0A **********************************01200920 +C**** 01210920 +C**** WRITE REPORT TITLE 01220920 +C**** 01230920 + WRITE (I02, 90002) 01240920 + WRITE (I02, 90006) 01250920 + WRITE (I02, 90007) 01260920 + WRITE (I02, 90008) ZVERS, ZVERSD 01270920 + WRITE (I02, 90009) ZPROG, ZPROG 01280920 + WRITE (I02, 90010) ZDATE, ZCOMPL 01290920 +CBE** ********************** BBCHED0A **********************************01300920 +C***** 01310920 + WRITE(NUVI,43900) 01320920 +43900 FORMAT(" ", / " INQF2 - (439) INQUIRE BY FILE" // 01330920 + 1 " SEQUENTIAL UNFORMATTED FILE, CONNECTED BY OPEN" // 01340920 + 2 " ANS REF. - 12.10.3" ) 01350920 +CBB** ********************** BBCHED0B **********************************01360920 +C**** WRITE DETAIL REPORT HEADERS 01370920 +C**** 01380920 + WRITE (I02,90004) 01390920 + WRITE (I02,90004) 01400920 + WRITE (I02,90013) 01410920 + WRITE (I02,90014) 01420920 + WRITE (I02,90015) IVTOTL 01430920 +CBE** ********************** BBCHED0B **********************************01440920 +C***** 01450920 +C***** OPEN FILE 01460920 + OPEN(FILE=CSEQ, UNIT=IMVI, ACCESS='SEQUENTIAL', 01470920 + 1 FORM='UNFORMATTED') 01480920 +C***** 01490920 +CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN) 01500920 + IVTNUM = 1 01510920 + INQUIRE(FILE=CSEQ, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01520920 + 1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK, 01530920 + 2 UNFORMATTED=G10VK, ERR=20014, IOSTAT=IVI) 01540920 +C***** 01550920 + IF (IVI .NE. 0) GO TO 20010 01560920 + IF (.NOT. AVB) GO TO 20010 01570920 + IF (.NOT. BVB) GO TO 20010 01580920 + IF (JVI .NE. IMVI) GO TO 20010 01590920 + IF (B10VK .NE. 'SEQUENTIAL') GO TO 20010 01600920 + IF (C10VK. NE. 'YES') GO TO 20010 01610920 + IF (E11VK .NE. 'UNFORMATTED') GO TO 20010 01620920 + IF (G10VK .NE. 'YES' ) GO TO 20010 01630920 + WRITE (NUVI, 80002) IVTNUM 01640920 + IVPASS = IVPASS + 1 01650920 + GO TO 0011 01660920 +20014 CONTINUE 01670920 + WRITE (NUVI, 20015) IVTNUM 01680920 +20015 FORMAT (" ",2X,I3,4X," FAIL",12X, 01690920 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 01700920 + GO TO 20016 01710920 +20010 CONTINUE 01720920 + WRITE (NUVI, 20011) IVTNUM 01730920 +20011 FORMAT(" ",2X,I3,4X," FAIL",12X, 01740920 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 01750920 +20016 IVFAIL = IVFAIL + 1 01760920 + WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,C10VK,E11VK, 01770920 + 1 G10VK 01780920 +20012 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 01790920 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 01800920 + 2 " ",26X,"ACCESS=",A10,", SEQUENTIAL=" ,A3,", FORM=", 01810920 + 3 A11,","/" ",26X,"UNFORMATTED=" ,A3) 01820920 + WRITE (NUVI, 20013) IMVI 01830920 +20013 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 01840920 + 1 "OPENED=T, NUMBER=" ,I4,","/ 01850920 + 2 " ",26X,"ACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=" , 01860920 + 3 "UNFORMATTED," /" ",26X,"UNFORMATTED=YES" ) 01870920 + 0011 CONTINUE 01880920 +C***** 01890920 +C***** WRITE TO FILE 01900920 + WRITE(IMVI) JVI 01910920 +C***** 01920920 +CT002* TEST 2 - SECOND INQUIRE (AFTER WRITE) 01930920 + IVTNUM = 2 01940920 + INQUIRE(FILE=CSEQ, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01950920 + 1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK, 01960920 + 2 UNFORMATTED=G10VK, ERR=20024, IOSTAT=IVI) 01970920 +C***** 01980920 + IF (IVI .NE. 0) GO TO 20020 01990920 + IF (.NOT. AVB) GO TO 20020 02000920 + IF (.NOT. BVB) GO TO 20020 02010920 + IF (JVI .NE. IMVI) GO TO 20020 02020920 + IF (B10VK .NE. 'SEQUENTIAL') GO TO 20020 02030920 + IF (C10VK.NE. 'YES') GO TO 20020 02040920 + IF (E11VK .NE. 'UNFORMATTED') GO TO 20020 02050920 + IF (G10VK .NE. 'YES' ) GO TO 20020 02060920 + WRITE (NUVI, 80002) IVTNUM 02070920 + IVPASS = IVPASS + 1 02080920 + GO TO 0021 02090920 +20024 CONTINUE 02100920 + WRITE (NUVI, 20025) IVTNUM 02110920 +20025 FORMAT (" ",2X,I3,4X," FAIL",12X, 02120920 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 02130920 + GO TO 20026 02140920 +20020 CONTINUE 02150920 + WRITE (NUVI, 20011) IVTNUM 02160920 +20021 FORMAT(" ",2X,I3,4X," FAIL",12X, 02170920 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 02180920 +20026 IVFAIL = IVFAIL + 1 02190920 + WRITE (NUVI, 20022) IVI,AVB,BVB,JVI,B10VK,C10VK,E11VK, 02200920 + 1 G10VK 02210920 +20022 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 02220920 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 02230920 + 2 " ",26X,"ACCESS=",A10,", SEQUENTIAL=" ,A3,", FORM=", 02240920 + 3 A11,","/" ",26X,"UNFORMATTED=" ,A3) 02250920 + WRITE (NUVI, 20023) IMVI 02260920 +20023 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 02270920 + 1 "OPENED=T, NUMBER=" ,I4,","/ 02280920 + 2 " ",26X,"ACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=" , 02290920 + 3 "UNFORMATTED," /" ",26X,"UNFORMATTED=YES" ) 02300920 + 0021 CONTINUE 02310920 +C***** 02320920 +C***** REWIND AND READ FILE 02330920 + REWIND IMVI 02340920 + READ(IMVI) JVI 02350920 + REWIND IMVI 02360920 +C***** 02370920 +CT003* TEST 3 - THIRD INQUIRE (AFTER READ) 02380920 + IVTNUM = 3 02390920 + INQUIRE(FILE=CSEQ, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 02400920 + 1 ACCESS=B10VK, SEQUENTIAL=C10VK, FORM=E11VK, 02410920 + 2 UNFORMATTED=G10VK, ERR=20034, IOSTAT=IVI) 02420920 +C***** 02430920 + IF (IVI .NE. 0) GO TO 20030 02440920 + IF (.NOT. AVB) GO TO 20030 02450920 + IF (.NOT. BVB) GO TO 20030 02460920 + IF (JVI .NE. IMVI) GO TO 20030 02470920 + IF (B10VK .NE. 'SEQUENTIAL') GO TO 20030 02480920 + IF (C10VK .NE. 'YES') GO TO 20030 02490920 + IF (E11VK .NE. 'UNFORMATTED') GO TO 20030 02500920 + IF (G10VK .NE. 'YES' ) GO TO 20030 02510920 + WRITE (NUVI, 80002) IVTNUM 02520920 + IVPASS = IVPASS + 1 02530920 + GO TO 0031 02540920 +20034 CONTINUE 02550920 + WRITE (NUVI, 20035) IVTNUM 02560920 +20035 FORMAT (" ",2X,I3,4X," FAIL",12X, 02570920 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 02580920 + GO TO 20036 02590920 +20030 CONTINUE 02600920 + WRITE (NUVI, 20031) IVTNUM 02610920 +20031 FORMAT(" ",2X,I3,4X," FAIL",12X, 02620920 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 02630920 +20036 IVFAIL = IVFAIL + 1 02640920 + WRITE (NUVI, 20032) IVI,AVB,BVB,JVI,B10VK,C10VK,E11VK, 02650920 + 1 G10VK 02660920 +20032 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 02670920 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 02680920 + 2 " ",26X,"ACCESS=",A10,", SEQUENTIAL=" ,A3,", FORM=", 02690920 + 3 A11,","/" ",26X,"UNFORMATTED=" ,A3) 02700920 + WRITE (NUVI, 20033) IMVI 02710920 +20033 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 02720920 + 1 "OPENED=T, NUMBER=" ,I4,","/ 02730920 + 2 " ",26X,"ACCESS=SEQUENTIAL, SEQUENTIAL=YES, FORM=" , 02740920 + 3 "UNFORMATTED," /" ",26X,"UNFORMATTED=YES" ) 02750920 + 0031 CONTINUE 02760920 +C***** 02770920 + CLOSE(UNIT=IMVI, STATUS='DELETE') 02780920 +C***** 02790920 +CBB** ********************** BBCSUM0 **********************************02800920 +C**** WRITE OUT TEST SUMMARY 02810920 +C**** 02820920 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02830920 + WRITE (I02, 90004) 02840920 + WRITE (I02, 90014) 02850920 + WRITE (I02, 90004) 02860920 + WRITE (I02, 90020) IVPASS 02870920 + WRITE (I02, 90022) IVFAIL 02880920 + WRITE (I02, 90024) IVDELE 02890920 + WRITE (I02, 90026) IVINSP 02900920 + WRITE (I02, 90028) IVTOTN, IVTOTL 02910920 +CBE** ********************** BBCSUM0 **********************************02920920 +CBB** ********************** BBCFOOT0 **********************************02930920 +C**** WRITE OUT REPORT FOOTINGS 02940920 +C**** 02950920 + WRITE (I02,90016) ZPROG, ZPROG 02960920 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02970920 + WRITE (I02,90019) 02980920 +CBE** ********************** BBCFOOT0 **********************************02990920 +CBB** ********************** BBCFMT0A **********************************03000920 +C**** FORMATS FOR TEST DETAIL LINES 03010920 +C**** 03020920 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03030920 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03040920 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03050920 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03060920 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03070920 + 1I6,/," ",15X,"CORRECT= " ,I6) 03080920 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03090920 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03100920 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03110920 + 1A21,/," ",16X,"CORRECT= " ,A21) 03120920 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03130920 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03140920 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03150920 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03160920 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03170920 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03180920 +80050 FORMAT (" ",48X,A31) 03190920 +CBE** ********************** BBCFMT0A **********************************03200920 +CBB** ********************** BBCFMT0B **********************************03210920 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03220920 +C**** 03230920 +90002 FORMAT ("1") 03240920 +90004 FORMAT (" ") 03250920 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03260920 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03270920 +90008 FORMAT (" ",21X,A13,A17) 03280920 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03290920 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03300920 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03310920 + 1 7X,"REMARKS",24X) 03320920 +90014 FORMAT (" ","----------------------------------------------" , 03330920 + 1 "---------------------------------" ) 03340920 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03350920 +C**** 03360920 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03370920 +C**** 03380920 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03390920 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03400920 + 1 A13) 03410920 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03420920 +C**** 03430920 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03440920 +C**** 03450920 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03460920 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03470920 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03480920 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03490920 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03500920 +CBE** ********************** BBCFMT0B **********************************03510920 +C***** 03520920 +C***** END OF TEST SEGMENT 439 03530920 + STOP 03540920 + END 03550920 diff --git a/Fortran/UnitTests/fcvs21_f95/FM920.reference_output b/Fortran/UnitTests/fcvs21_f95/FM920.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM920.reference_output @@ -0,0 +1,37 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM920BEGIN* TEST RESULTS - FM920 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INQF2 - (439) INQUIRE BY FILE + + SEQUENTIAL UNFORMATTED FILE, CONNECTED BY OPEN + + ANS REF. - 12.10.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 3 TESTS + + 1 PASS + 2 PASS + 3 PASS + + ------------------------------------------------------------------------------- + + 3 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 3 OF 3 TESTS EXECUTED + + *FM920END* END OF TEST - FM920 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM921.f b/Fortran/UnitTests/fcvs21_f95/FM921.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM921.f @@ -0,0 +1,354 @@ + PROGRAM FM921 + +C***********************************************************************00010921 +C***** FORTRAN 77 00020921 +C***** FM921 00030921 +C***** INQF4 - (441) 00040921 +C***** 00050921 +C***********************************************************************00060921 +C***** GENERAL PURPOSE ANS REF 00070921 +C***** TEST INQUIRE BY FILE ON DIRECT, UNFORMATTED FILE 12.10.3 00080921 +C***** 00090921 +C***** THE TESTS IN THE UNIT ARE ONLY PERFORMED ON A 00100921 +C***** FILE THAT IS CONNECTED FOR DIRECT, UNFORMATTED ACCESS 00110921 +C***** (ANS REF. 12.2.4.2 AND 12.9.5.1) 00120921 +C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND PERFORMS 00130921 +C***** A CLOSE WITH STATUS='DELETE' AT THE END OF THE SEGMENT. 00140921 +C***** THIS SEGMENT TESTS THAT AN INQUIRE IS PERFORMED CORRECTLY 00150921 +C***** BEFORE READING OR WRITING TO THE FILE, AFTER WRITING TO 00160921 +C***** THE FILE, AND AFTER READING FROM THE FILE. 00170921 +C***** 00180921 +C***** NOTE: 00190921 +C***** AN INQUIRE STATEMENT IS NEEDED TO TEST THE READ AND 00200921 +C***** WRITE OF MORE THAN A SINGLE RECORD AT A TIME, IN ORDER TO 00210921 +C***** DETERMINE THAT THE RECORD NUMBER IS ADVANCED THE CORRECT 00220921 +C***** NUMBER (ONE MORE THAN THE RECORD NUMBER LAST READ OR WRITTEN).00230921 +C***** THIS TEST WILL BE PERFORMED IN THE SEGMENTS WHICH TEST 00240921 +C***** DIRECT ACCESS FILES - DIRAF3 (412). 00250921 +C***********************************************************************00260921 +CBB** ********************** BBCCOMNT **********************************00270921 +C**** 00280921 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00290921 +C**** VERSION 2.1 00300921 +C**** 00310921 +C**** 00320921 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00330921 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00340921 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00350921 +C**** BUILDING 225 RM A266 00360921 +C**** GAITHERSBURG, MD 20899 00370921 +C**** 00380921 +C**** 00390921 +C**** 00400921 +CBE** ********************** BBCCOMNT **********************************00410921 +C***** 00420921 + LOGICAL AVB, BVB 00430921 + CHARACTER*10 B10VK, D10VK, E11VK*11, G10VK 00440921 +C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00450921 +CX20 REPLACED BY FEXEC X-20 CONTROL CARD. X-20 IS FOR REPLACING 00460921 + CHARACTER*15 CDIR, CSEQ 00470921 +C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-100 00480921 +C (PROGRAM VARIABLE CDIR) IF NOT VALID FOR THE PROCESSOR. 00490921 +CBB** ********************** BBCINITA **********************************00500921 +C**** SPECIFICATION STATEMENTS 00510921 +C**** 00520921 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00530921 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00540921 +CBE** ********************** BBCINITA **********************************00550921 +CBB** ********************** BBCINITB **********************************00560921 +C**** INITIALIZE SECTION 00570921 + DATA ZVERS, ZVERSD, ZDATE 00580921 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00590921 + DATA ZCOMPL, ZNAME, ZTAPE 00600921 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00610921 + DATA ZPROJ, ZTAPED, ZPROG 00620921 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00630921 + DATA REMRKS /' '/ 00640921 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00650921 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00660921 +C**** 00670921 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00680921 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00690921 +CZ03 ZPROG = 'PROGRAM NAME' 00700921 +CZ04 ZDATE = 'DATE OF TEST' 00710921 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00720921 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00730921 +CZ07 ZNAME = 'NAME OF USER' 00740921 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00750921 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00760921 +C 00770921 + IVPASS = 0 00780921 + IVFAIL = 0 00790921 + IVDELE = 0 00800921 + IVINSP = 0 00810921 + IVTOTL = 0 00820921 + IVTOTN = 0 00830921 + ICZERO = 0 00840921 +C 00850921 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00860921 + I01 = 05 00870921 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00880921 + I02 = 06 00890921 +C 00900921 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00910921 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00920921 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00930921 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00940921 +C 00950921 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00960921 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00970921 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00980921 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00990921 +C 01000921 +CBE** ********************** BBCINITB **********************************01010921 +C***** 01020921 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 01030921 +C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 01040921 +C***** DIRECT, UNFORMATTED FILE. 01050921 +C***** 01060921 +C I10 CONTAINS THE UNIT NUMBER FOR A DIRECT, UNFORMATTED FILE. 01070921 + I10 = 945 01080921 +CX100 REPLACED BY FEXEC X-100 CONTROL CARD (DIR. FILE UNIT NUMBER). 01090921 +C SPECIFYING I10 = NN OVERRIDES THE DEFAULT I10 = 24. 01100921 +C***** 01110921 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01120921 +C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A DIRECT, 01130921 +C***** UNFORMATTED FILE. 01140921 +C***** 01150921 +C CDIR CONTAINS THE FILE NAME FOR UNIT I10. 01160921 + CDIR = ' DIRFILE921' 01170921 +C 01180921 +CX201 REPLACED BY FEXEC X-201 CONTROL CARD. CX201 IS FOR SYSTEMS 01190921 +C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 01200921 +C X-100 THAN THE DEFAULT CDIR = ' DIRFILE'. 01210921 +C***** 01220921 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 40 IS 01230921 +C***** NOT A VALID RECORD LENGTH. 01240921 + MVI = 40 01250921 +C***** 01260921 + NUVI = I02 01270921 + IOVI = I10 01280921 + ZPROG = 'FM921' 01290921 + IVTOTL = 3 01300921 +CBB** ********************** BBCHED0A **********************************01310921 +C**** 01320921 +C**** WRITE REPORT TITLE 01330921 +C**** 01340921 + WRITE (I02, 90002) 01350921 + WRITE (I02, 90006) 01360921 + WRITE (I02, 90007) 01370921 + WRITE (I02, 90008) ZVERS, ZVERSD 01380921 + WRITE (I02, 90009) ZPROG, ZPROG 01390921 + WRITE (I02, 90010) ZDATE, ZCOMPL 01400921 +CBE** ********************** BBCHED0A **********************************01410921 +C***** 01420921 + WRITE(NUVI,44100) 01430921 +44100 FORMAT(" ", / " INQF4 - (441) INQUIRE BY FILE" // 01440921 + 1 " DIRECT ACCESS UNFORMATTED FILE" // 01450921 + 2 " ANS REF. - 12.10.3" ) 01460921 +CBB** ********************** BBCHED0B **********************************01470921 +C**** WRITE DETAIL REPORT HEADERS 01480921 +C**** 01490921 + WRITE (I02,90004) 01500921 + WRITE (I02,90004) 01510921 + WRITE (I02,90013) 01520921 + WRITE (I02,90014) 01530921 + WRITE (I02,90015) IVTOTL 01540921 +CBE** ********************** BBCHED0B **********************************01550921 +C***** 01560921 +C***** OPEN FILE 01570921 + OPEN(FILE=CDIR, UNIT=IOVI, ACCESS='DIRECT', RECL=MVI, 01580921 + 1 FORM='UNFORMATTED') 01590921 +C***** 01600921 +CT001* TEST 1 - FIRST INQUIRE (AFTER OPEN) 01610921 + IVTNUM = 1 01620921 + INQUIRE(FILE=CDIR, EXIST=AVB, OPENED=BVB, NUMBER=JVI, 01630921 + 1 ACCESS=B10VK, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 01640921 + 2 FORM=E11VK, UNFORMATTED=G10VK, ERR=20014, IOSTAT=IVI) 01650921 +C***** 01660921 + IF (IVI .NE. 0) GO TO 20010 01670921 + IF (.NOT. AVB) GO TO 20010 01680921 + IF (.NOT. BVB) GO TO 20010 01690921 + IF (JVI .NE. IOVI) GO TO 20010 01700921 + IF (B10VK .NE. 'DIRECT') GO TO 20010 01710921 + IF (D10VK .NE. 'YES') GO TO 20010 01720921 + IF (KVI .NE. MVI) GO TO 20010 01730921 + IF (LVI .NE. 1) GO TO 20010 01740921 + IF (E11VK .NE. 'UNFORMATTED') GO TO 20010 01750921 + IF (G10VK .NE. 'YES' ) GO TO 20010 01760921 + WRITE (NUVI, 80002) IVTNUM 01770921 + IVPASS = IVPASS + 1 01780921 + GO TO 0011 01790921 +20014 CONTINUE 01800921 + WRITE (NUVI, 20015) IVTNUM 01810921 +20015 FORMAT (" ",2X,I3,4X," FAIL",12X, 01820921 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 01830921 + GO TO 20016 01840921 +20010 CONTINUE 01850921 + WRITE (NUVI, 20011) IVTNUM 01860921 +20011 FORMAT(" ",2X,I3,4X," FAIL",12X, 01870921 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 01880921 +20016 IVFAIL = IVFAIL + 1 01890921 + WRITE (NUVI, 20012) IVI,AVB,BVB,JVI,B10VK,D10VK,KVI, 01900921 + 1 LVI,E11VK,G10VK 01910921 +20012 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", EXIST=",L1, 01920921 + 1 " ,OPENED=",L1,", NUMBER=",I4,","/ 01930921 + 2 " ",26X,"ACCESS=",A6,", DIRECT=",A3,", RECL=", 01940921 + 3 I4,","/" ",26X,"NEXTREC=",I4,", FORM=", 01950921 + 4 A11,","/" ",26X,"UNFORMATTED=" ,A3) 01960921 + WRITE (NUVI, 20013) IOVI,MVI 01970921 +20013 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, EXIST=T, " , 01980921 + 1 "OPENED=T, NUMBER=" ,I4,","/ 01990921 + 2 " ",26X,"ACCESS=DIRECT, DIRECT=YES, RECL=" , 02000921 + 3 I4,","/" ",26X,"NEXTREC= 1, FORM=UNFORMATTED," / 02010921 + 4 " ",26X,"UNFORMATTED=YES" ) 02020921 + 0011 CONTINUE 02030921 +C***** 02040921 +C***** WRITE A RECORD TO FILE 02050921 +44103 WRITE(IOVI, REC=1) JVI 02060921 +C***** 02070921 +CT002* TEST 2 - SECOND INQUIRE (AFTER WRITE) 02080921 + IVTNUM = 2 02090921 +C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC 02100921 +C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED 02110921 + INQUIRE(FILE=CDIR, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 02120921 + 1 ERR=20024, IOSTAT=IVI) 02130921 +C***** 02140921 + IF (IVI .NE. 0) GO TO 20020 02150921 + IF (D10VK .NE. 'YES') GO TO 20020 02160921 + IF (KVI .NE. MVI) GO TO 20020 02170921 + IF (LVI .NE. 2) GO TO 20020 02180921 + WRITE (NUVI, 80002) IVTNUM 02190921 + IVPASS = IVPASS + 1 02200921 + GO TO 0021 02210921 +20024 CONTINUE 02220921 + WRITE (NUVI, 20025) IVTNUM 02230921 +20025 FORMAT (" ",2X,I3,4X," FAIL",12X, 02240921 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 02250921 + GO TO 20026 02260921 +20020 CONTINUE 02270921 + WRITE (NUVI, 20021) IVTNUM 02280921 +20021 FORMAT(" ",2X,I3,4X," FAIL",12X, 02290921 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 02300921 +20026 IVFAIL = IVFAIL + 1 02310921 + WRITE (NUVI, 20022) IVI,D10VK,KVI,LVI 02320921 +20022 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", DIRECT=",A3, 02330921 + 1 " ,RECL=",I4,", NEXTREC=" ,I4) 02340921 + WRITE (NUVI, 20023) MVI 02350921 +20023 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, DIRECT=YES" , 02360921 + 1 " ,RECL=",I4,", NEXTREC= 2" ) 02370921 + 0021 CONTINUE 02380921 +C***** 02390921 +C***** READ A RECORD FROM FILE 02400921 +44106 READ(IOVI, REC=1) JVI 02410921 +C***** 02420921 +CT003* TEST 3 - THIRD INQUIRE (AFTER READ) 02430921 + IVTNUM = 3 02440921 +C***** THIS INQUIRE ONLY TESTS THE DIRECT, RECL, AND NEXTREC 02450921 +C***** AS THE OTHER SPECIFIERS HAVE BEEN PREVIOUSLY TESTED 02460921 + INQUIRE(FILE=CDIR, DIRECT=D10VK, RECL=KVI, NEXTREC=LVI, 02470921 + 1 ERR=20034, IOSTAT=IVI) 02480921 +C***** 02490921 + IF (IVI .NE. 0) GO TO 20030 02500921 + IF (D10VK .NE. 'YES') GO TO 20030 02510921 + IF (KVI .NE. MVI) GO TO 20030 02520921 + IF (LVI .NE. 2) GO TO 20030 02530921 + WRITE (NUVI, 80002) IVTNUM 02540921 + IVPASS = IVPASS + 1 02550921 + GO TO 0031 02560921 +20034 CONTINUE 02570921 + WRITE (NUVI, 20035) IVTNUM 02580921 +20035 FORMAT (" ",2X,I3,4X," FAIL",12X, 02590921 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 02600921 + GO TO 20036 02610921 +20030 CONTINUE 02620921 + WRITE (NUVI, 20031) IVTNUM 02630921 +20031 FORMAT(" ",2X,I3,4X," FAIL",12X, 02640921 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 02650921 +20036 IVFAIL = IVFAIL + 1 02660921 + WRITE (NUVI, 20032) IVI,D10VK,KVI,LVI 02670921 +20032 FORMAT (" ",16X,"COMPUTED: " ,"IOSTAT=",I1,", DIRECT=",A3, 02680921 + 1 " ,RECL=",I4,", NEXTREC=" ,I4) 02690921 + WRITE (NUVI, 20033) MVI 02700921 +20033 FORMAT (" ",16X,"CORRECT: " ,"IOSTAT=0, DIRECT=YES" , 02710921 + 1 " ,RECL=",I4,", NEXTREC= 2" ) 02720921 + 0031 CONTINUE 02730921 +C***** 02740921 + CLOSE(UNIT=IOVI, STATUS='DELETE') 02750921 +C***** 02760921 +CBB** ********************** BBCSUM0 **********************************02770921 +C**** WRITE OUT TEST SUMMARY 02780921 +C**** 02790921 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 02800921 + WRITE (I02, 90004) 02810921 + WRITE (I02, 90014) 02820921 + WRITE (I02, 90004) 02830921 + WRITE (I02, 90020) IVPASS 02840921 + WRITE (I02, 90022) IVFAIL 02850921 + WRITE (I02, 90024) IVDELE 02860921 + WRITE (I02, 90026) IVINSP 02870921 + WRITE (I02, 90028) IVTOTN, IVTOTL 02880921 +CBE** ********************** BBCSUM0 **********************************02890921 +CBB** ********************** BBCFOOT0 **********************************02900921 +C**** WRITE OUT REPORT FOOTINGS 02910921 +C**** 02920921 + WRITE (I02,90016) ZPROG, ZPROG 02930921 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02940921 + WRITE (I02,90019) 02950921 +CBE** ********************** BBCFOOT0 **********************************02960921 +CBB** ********************** BBCFMT0A **********************************02970921 +C**** FORMATS FOR TEST DETAIL LINES 02980921 +C**** 02990921 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 03000921 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 03010921 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 03020921 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 03030921 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 03040921 + 1I6,/," ",15X,"CORRECT= " ,I6) 03050921 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03060921 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 03070921 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 03080921 + 1A21,/," ",16X,"CORRECT= " ,A21) 03090921 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 03100921 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 03110921 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 03120921 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 03130921 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 03140921 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 03150921 +80050 FORMAT (" ",48X,A31) 03160921 +CBE** ********************** BBCFMT0A **********************************03170921 +CBB** ********************** BBCFMT0B **********************************03180921 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 03190921 +C**** 03200921 +90002 FORMAT ("1") 03210921 +90004 FORMAT (" ") 03220921 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )03230921 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 03240921 +90008 FORMAT (" ",21X,A13,A17) 03250921 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 03260921 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 03270921 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 03280921 + 1 7X,"REMARKS",24X) 03290921 +90014 FORMAT (" ","----------------------------------------------" , 03300921 + 1 "---------------------------------" ) 03310921 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 03320921 +C**** 03330921 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 03340921 +C**** 03350921 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 03360921 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 03370921 + 1 A13) 03380921 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 03390921 +C**** 03400921 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 03410921 +C**** 03420921 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 03430921 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 03440921 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 03450921 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 03460921 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 03470921 +CBE** ********************** BBCFMT0B **********************************03480921 +C***** 03490921 +C***** END OF TEST SEGMENT 441 03500921 + STOP 03510921 + END 03520921 diff --git a/Fortran/UnitTests/fcvs21_f95/FM921.reference_output b/Fortran/UnitTests/fcvs21_f95/FM921.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM921.reference_output @@ -0,0 +1,37 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM921BEGIN* TEST RESULTS - FM921 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INQF4 - (441) INQUIRE BY FILE + + DIRECT ACCESS UNFORMATTED FILE + + ANS REF. - 12.10.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 3 TESTS + + 1 PASS + 2 PASS + 3 PASS + + ------------------------------------------------------------------------------- + + 3 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 3 OF 3 TESTS EXECUTED + + *FM921END* END OF TEST - FM921 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/FM922.f b/Fortran/UnitTests/fcvs21_f95/FM922.f new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM922.f @@ -0,0 +1,266 @@ + PROGRAM FM922 + +C***********************************************************************00010922 +C***** FORTRAN 77 00020922 +C***** FM922 00030922 +C***** INQF5 - (442) 00040922 +C***** 00050922 +C***********************************************************************00060922 +C***** GENERAL PURPOSE ANS REF 00070922 +C***** TEST INQUIRE BY FILE ON A FILE THAT IS NOT 12.10.3 00080922 +C***** CONNECTED TO A UNIT 00090922 +C***** 00100922 +C***** THE TESTS IN THIS UNIT ARE ONLY BE PERFORMED ON A 00110922 +C***** FILE THAT IS NOT CONNECTED TO A UNIT. 00120922 +C***** THIS TEST PERFORMS AN EXPLICIT OPEN, AND THEN 00130922 +C***** PERFORMS A CLOSE WITH STATUS='KEEP' IN ORDER TO 00140922 +C***** ENSURE THAT THE UNIT AND FILE ARE NOT CONNECTED. 00150922 +C***** (ANS REF 12.10.2) 00160922 +C***********************************************************************00170922 +CBB** ********************** BBCCOMNT **********************************00180922 +C**** 00190922 +C**** 1978 FORTRAN COMPILER VALIDATION SYSTEM 00200922 +C**** VERSION 2.1 00210922 +C**** 00220922 +C**** 00230922 +C**** SUGGESTIONS AND COMMENTS SHOULD BE FORWARDED TO 00240922 +C**** NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY 00250922 +C**** SOFTWARE STANDARDS VALIDATION GROUP 00260922 +C**** BUILDING 225 RM A266 00270922 +C**** GAITHERSBURG, MD 20899 00280922 +C**** 00290922 +C**** 00300922 +C**** 00310922 +CBE** ********************** BBCCOMNT **********************************00320922 + LOGICAL AVB, BVB 00330922 + CHARACTER*10 C10VK, F10VK 00340922 +C***** BELOW CHARACTER STATEMENT ESTABLISHES THE FILE NAME VARIABLES. 00350922 +CX19 REPLACED BY FEXEC X-19 CONTROL CARD. X-19 IS FOR REPLACING 00360922 + CHARACTER*15 CSEQ 00370922 +C THE CHARACTER STATEMENT FOR FILE NAMES ASSOCIATED WITH X-150 00380922 +C (PROGRAM VARIABLE CSEQ) IF NOT VALID FOR THE PROCESSOR. 00390922 +CBB** ********************** BBCINITA **********************************00400922 +C**** SPECIFICATION STATEMENTS 00410922 +C**** 00420922 + CHARACTER ZVERS*13, ZVERSD*17, ZDATE*17, ZPROG*5, ZCOMPL*20, 00430922 + 1 ZNAME*20, ZTAPE*10, ZPROJ*13, REMRKS*31, ZTAPED*13 00440922 +CBE** ********************** BBCINITA **********************************00450922 +CBB** ********************** BBCINITB **********************************00460922 +C**** INITIALIZE SECTION 00470922 + DATA ZVERS, ZVERSD, ZDATE 00480922 + 1 /'VERSION 2.1 ', '93/10/21*21.02.00', '*NO DATE*TIME'/ 00490922 + DATA ZCOMPL, ZNAME, ZTAPE 00500922 + 1 /'*NONE SPECIFIED*', '*NO COMPANY NAME*', '*NO TAPE*'/ 00510922 + DATA ZPROJ, ZTAPED, ZPROG 00520922 + 1 /'*NO PROJECT*', '*NO TAPE DATE', 'XXXXX'/ 00530922 + DATA REMRKS /' '/ 00540922 +C**** THE FOLLOWING 9 COMMENT LINES (CZ01, CZ02, ...) CAN BE REPLACED 00550922 +C**** FOR IDENTIFYING THE TEST ENVIRONMENT 00560922 +C**** 00570922 +CZ01 ZVERS = 'VERSION OF THE COMPILER VALIDATION SYSTEM' 00580922 +CZ02 ZVERSD = 'CREATION DATE/TIME OF THE COMPILER VALIDATION SYSTEM' 00590922 +CZ03 ZPROG = 'PROGRAM NAME' 00600922 +CZ04 ZDATE = 'DATE OF TEST' 00610922 +CZ05 ZCOMPL = 'COMPILER IDENTIFICATION' 00620922 +CZ06 ZPROJ = 'PROJECT NUMBER/IDENTIFICATION' 00630922 +CZ07 ZNAME = 'NAME OF USER' 00640922 +CZ08 ZTAPE = 'TAPE OWNER/ID' 00650922 +CZ09 ZTAPED = 'DATE TAPE COPIED' 00660922 +C 00670922 + IVPASS = 0 00680922 + IVFAIL = 0 00690922 + IVDELE = 0 00700922 + IVINSP = 0 00710922 + IVTOTL = 0 00720922 + IVTOTN = 0 00730922 + ICZERO = 0 00740922 +C 00750922 +C I01 CONTAINS THE LOGICAL UNIT NUMBER FOR THE CARD READER. 00760922 + I01 = 05 00770922 +C I02 CONTAINS THE LOGICAL UNIT NUMBER FOR THE PRINTER. 00780922 + I02 = 06 00790922 +C 00800922 +CX010 REPLACED BY FEXEC X-010 CONTROL CARD (CARD-READER UNIT NUMBER). 00810922 +C THE CX010 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I01 = 5 00820922 +CX011 REPLACED BY FEXEC X-011 CONTROL CARD. CX011 IS FOR SYSTEMS 00830922 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX010. 00840922 +C 00850922 +CX020 REPLACED BY FEXEC X-020 CONTROL CARD (PRINTER UNIT NUMBER). 00860922 +C THE CX020 CARD IS FOR OVERRIDING THE PROGRAM DEFAULT I02= 6 00870922 +CX021 REPLACED BY FEXEC X-021 CONTROL CARD. CX021 IS FOR SYSTEMS 00880922 +C REQUIRING ADDITIONAL STATEMENTS FOR FILES ASSOCIATED WITH CX020. 00890922 +C 00900922 +CBE** ********************** BBCINITB **********************************00910922 +C***** 00920922 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF 00930922 +C***** THE UNIT GIVEN IS NOT CAPABLE OF BEING OPENED AS A 00940922 +C***** SEQUENTIAL, FORMATTED FILE. 00950922 +C***** 00960922 +C I15 CONTAINS THE UNIT NUMBER FOR A SEQUENTIAL FORMATTED FILE. 00970922 + I15 = 908 00980922 +CX150 REPLACED BY FEXEC X-150 CONTROL CARD (SEQ. FILE UNIT NUMBER). 00990922 +C SPECIFYING I15 = NN OVERRIDES THE DEFAULT I15 = 14. 01000922 +C***** 01010922 +C***** THE FOLLOWING STATEMENT MUST BE CHANGED IF THE NAME 01020922 +C***** GIVEN IS NOT A VALID FILE SPECIFIER FOR A SEQUENTIAL, 01030922 +C***** FORMATTED FILE. 01040922 +C***** 01050922 +C CSEQ CONTAINS THE FILE NAME FOR UNIT I15. 01060922 + CSEQ = ' SEQFILE922' 01070922 +C 01080922 +CX191 REPLACED BY FEXEC X-191 CONTROL CARD. CX191 IS FOR SYSTEMS 01090922 +C REQUIRING A DIFFERENT FILE SPECIFIER FOR FILES ASSOCIATED WITH 01100922 +C X-150 THAN THE DEFAULT CSEQ = ' SEQFILE'. 01110922 +C 01120922 +C***** 01130922 + NUVI = I02 01140922 + IMVI = I15 01150922 + ZPROG = 'FM922' 01160922 + IVTOTL = 1 01170922 +CBB** ********************** BBCHED0A **********************************01180922 +C**** 01190922 +C**** WRITE REPORT TITLE 01200922 +C**** 01210922 + WRITE (I02, 90002) 01220922 + WRITE (I02, 90006) 01230922 + WRITE (I02, 90007) 01240922 + WRITE (I02, 90008) ZVERS, ZVERSD 01250922 + WRITE (I02, 90009) ZPROG, ZPROG 01260922 + WRITE (I02, 90010) ZDATE, ZCOMPL 01270922 +CBE** ********************** BBCHED0A **********************************01280922 + WRITE(NUVI,44200) 01290922 +44200 FORMAT(" ",/ " INQF5 - (442) INQUIRE BY FILE" / 01300922 + 1 " FILE NOT CONNECTED TO A UNIT" / 01310922 + 2 " ANS REF. - 12.10.3" ) 01320922 +CBB** ********************** BBCHED0B **********************************01330922 +C**** WRITE DETAIL REPORT HEADERS 01340922 +C**** 01350922 + WRITE (I02,90004) 01360922 + WRITE (I02,90004) 01370922 + WRITE (I02,90013) 01380922 + WRITE (I02,90014) 01390922 + WRITE (I02,90015) IVTOTL 01400922 +CBE** ********************** BBCHED0B **********************************01410922 +C***** 01420922 +C***** OPEN FILE, WRITE TO FILE, REWIND FILE 01430922 +C***** 01440922 + OPEN(FILE=CSEQ,UNIT=IMVI,ACCESS='SEQUENTIAL',FORM='FORMATTED', 01450922 + 1 STATUS='NEW') 01450922 + WRITE(IMVI, 44200) 01460922 + ENDFILE IMVI 01470922 + REWIND IMVI 01480922 +C***** 01490922 +C***** DISCONNECT FILE 01500922 +C***** 01510922 + CLOSE(UNIT=IMVI, STATUS='KEEP') 01520922 +C***** 01530922 +CT001* TEST 1 - INQUIRE ON DISCONNECTED FILE 01540922 + IVTNUM = 1 01550922 + INQUIRE(FILE=CSEQ, IOSTAT=IVI, EXIST=AVB, OPENED=BVB, 01560922 + 1 SEQUENTIAL=C10VK, FORMATTED=F10VK, ERR=44206) 01570922 + 01580922 + IF (IVI .NE. 0) GO TO 44202 01590922 + IF (.NOT. AVB) GO TO 44202 01600922 + IF (BVB) GO TO 44202 01610922 + IF (C10VK .EQ. 'NO') GO TO 44202 01620922 + IF (F10VK .EQ. 'NO') GO TO 44202 01630922 +55040 WRITE(NUVI,80002)IVTNUM 01640922 + IVPASS=IVPASS+1 01650922 + GO TO 44204 01660922 +44206 CONTINUE 01670922 + WRITE (NUVI, 44207) IVTNUM 01680922 +44207 FORMAT (" ",2X,I3,4X," FAIL",12X, 01690922 + 1 "ERROR IN EXECUTION OF INQUIRE STATEMENT (ERR=)" /) 01700922 + GO TO 44208 01710922 +44202 CONTINUE 01720922 + WRITE(NUVI,55010)IVTNUM 01730922 +55010 FORMAT(" ",5X,I3,4X," FAIL",12X, 01740922 + 1 "ERROR IN AN INQUIRE SPECIFIER" /) 01750922 +44208 IVFAIL=IVFAIL+1 01760922 + WRITE(NUVI,55020)IVI,AVB,BVB,C10VK,F10VK 01770922 +55020 FORMAT(" ",10X,"COMPUTED: " , 01780922 + 1 "IOSTAT=",I1, 01790922 + 2 ", EXIST=",L1,", OPENED=",L1,", SEQUENTIAL=" ,A3, 01800922 + 3 ", FORMATTED=" ,A3) 01810922 + WRITE(NUVI,55030) 01820922 +55030 FORMAT(" ",10X,"CORRECT: " , 01830922 + 1 "IOSTAT=0, " , 01840922 + 2 "EXIST=T, OPENED=F, SEQUENTIAL=YES, FORMATTED=" , 01850922 + 3 "YES"/55X,"OR UNKNOWN" ,4X,"OR UNKNOWN" ) 01860922 +44204 CONTINUE 01870922 + OPEN(FILE=CSEQ, UNIT=IMVI) 01880922 + CLOSE(UNIT=IMVI, STATUS='DELETE') 01890922 +CBB** ********************** BBCSUM0 **********************************01900922 +C**** WRITE OUT TEST SUMMARY 01910922 +C**** 01920922 + IVTOTN = IVPASS + IVFAIL + IVDELE + IVINSP 01930922 + WRITE (I02, 90004) 01940922 + WRITE (I02, 90014) 01950922 + WRITE (I02, 90004) 01960922 + WRITE (I02, 90020) IVPASS 01970922 + WRITE (I02, 90022) IVFAIL 01980922 + WRITE (I02, 90024) IVDELE 01990922 + WRITE (I02, 90026) IVINSP 02000922 + WRITE (I02, 90028) IVTOTN, IVTOTL 02010922 +CBE** ********************** BBCSUM0 **********************************02020922 +CBB** ********************** BBCFOOT0 **********************************02030922 +C**** WRITE OUT REPORT FOOTINGS 02040922 +C**** 02050922 + WRITE (I02,90016) ZPROG, ZPROG 02060922 + WRITE (I02,90018) ZPROJ, ZNAME, ZTAPE, ZTAPED 02070922 + WRITE (I02,90019) 02080922 +CBE** ********************** BBCFOOT0 **********************************02090922 +CBB** ********************** BBCFMT0A **********************************02100922 +C**** FORMATS FOR TEST DETAIL LINES 02110922 +C**** 02120922 +80000 FORMAT (" ",2X,I3,4X,"DELETED",32X,A31) 02130922 +80002 FORMAT (" ",2X,I3,4X," PASS ",32X,A31) 02140922 +80004 FORMAT (" ",2X,I3,4X,"INSPECT",32X,A31) 02150922 +80008 FORMAT (" ",2X,I3,4X," FAIL ",32X,A31) 02160922 +80010 FORMAT (" ",2X,I3,4X," FAIL ",/," ",15X,"COMPUTED= " , 02170922 + 1I6,/," ",15X,"CORRECT= " ,I6) 02180922 +80012 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02190922 + 1E12.5,/," ",16X,"CORRECT= " ,E12.5) 02200922 +80018 FORMAT (" ",2X,I3,4X," FAIL ",/," ",16X,"COMPUTED= " , 02210922 + 1A21,/," ",16X,"CORRECT= " ,A21) 02220922 +80020 FORMAT (" ",16X,"COMPUTED= " ,A21,1X,A31) 02230922 +80022 FORMAT (" ",16X,"CORRECT= " ,A21,1X,A31) 02240922 +80024 FORMAT (" ",16X,"COMPUTED= " ,I6,16X,A31) 02250922 +80026 FORMAT (" ",16X,"CORRECT= " ,I6,16X,A31) 02260922 +80028 FORMAT (" ",16X,"COMPUTED= " ,E12.5,10X,A31) 02270922 +80030 FORMAT (" ",16X,"CORRECT= " ,E12.5,10X,A31) 02280922 +80050 FORMAT (" ",48X,A31) 02290922 +CBE** ********************** BBCFMT0A **********************************02300922 +CBB** ********************** BBCFMT0B **********************************02310922 +C**** FORMAT STATEMENTS FOR PAGE HEADERS 02320922 +C**** 02330922 +90002 FORMAT ("1") 02340922 +90004 FORMAT (" ") 02350922 +90006 FORMAT (" ",20X,"NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY" )02360922 +90007 FORMAT (" ",19X,"FORTRAN COMPILER VALIDATION SYSTEM" ) 02370922 +90008 FORMAT (" ",21X,A13,A17) 02380922 +90009 FORMAT (" ",/," *",A5,"BEGIN*",12X,"TEST RESULTS - " ,A5,/) 02390922 +90010 FORMAT (" ",8X,"TEST DATE*TIME= " ,A17," - COMPILER= " ,A20) 02400922 +90013 FORMAT (" "," TEST ","PASS/FAIL " ,6X,"DISPLAYED RESULTS" , 02410922 + 1 7X,"REMARKS",24X) 02420922 +90014 FORMAT (" ","----------------------------------------------" , 02430922 + 1 "---------------------------------" ) 02440922 +90015 FORMAT (" ",48X,"THIS PROGRAM HAS " ,I3," TESTS",/) 02450922 +C**** 02460922 +C**** FORMAT STATEMENTS FOR REPORT FOOTINGS 02470922 +C**** 02480922 +90016 FORMAT (" ",/," *",A5,"END*",14X,"END OF TEST - " ,A5,/) 02490922 +90018 FORMAT (" ",A13,13X,A20," * ",A10,"/", 02500922 + 1 A13) 02510922 +90019 FORMAT (" ","FOR OFFICIAL USE ONLY " ,35X,"COPYRIGHT 1982" ) 02520922 +C**** 02530922 +C**** FORMAT STATEMENTS FOR RUN SUMMARY 02540922 +C**** 02550922 +90020 FORMAT (" ",21X,I5," TESTS PASSED" ) 02560922 +90022 FORMAT (" ",21X,I5," TESTS FAILED" ) 02570922 +90024 FORMAT (" ",21X,I5," TESTS DELETED" ) 02580922 +90026 FORMAT (" ",21X,I5," TESTS REQUIRE INSPECTION" ) 02590922 +90028 FORMAT (" ",21X,I5," OF ",I3," TESTS EXECUTED" ) 02600922 +CBE** ********************** BBCFMT0B **********************************02610922 + STOP 02620922 + END 02630922 diff --git a/Fortran/UnitTests/fcvs21_f95/FM922.reference_output b/Fortran/UnitTests/fcvs21_f95/FM922.reference_output new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/FM922.reference_output @@ -0,0 +1,33 @@ +1 + NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY + FORTRAN COMPILER VALIDATION SYSTEM + VERSION 2.1 93/10/21*21.02.00 + + *FM922BEGIN* TEST RESULTS - FM922 + + TEST DATE*TIME= *NO DATE*TIME - COMPILER= *NONE SPECIFIED* + + INQF5 - (442) INQUIRE BY FILE + FILE NOT CONNECTED TO A UNIT + ANS REF. - 12.10.3 + + + TEST PASS/FAIL DISPLAYED RESULTS REMARKS + ------------------------------------------------------------------------------- + THIS PROGRAM HAS 1 TESTS + + 1 PASS + + ------------------------------------------------------------------------------- + + 1 TESTS PASSED + 0 TESTS FAILED + 0 TESTS DELETED + 0 TESTS REQUIRE INSPECTION + 1 OF 1 TESTS EXECUTED + + *FM922END* END OF TEST - FM922 + + *NO PROJECT* *NO COMPANY NAME* * *NO TAPE* /*NO TAPE DATE + FOR OFFICIAL USE ONLY COPYRIGHT 1982 +exit 0 diff --git a/Fortran/UnitTests/fcvs21_f95/README b/Fortran/UnitTests/fcvs21_f95/README new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/README @@ -0,0 +1,61 @@ + +From: +http://www.itl.nist.gov/div897/ctg/fortran_form.htm + +Fortran +Available Test Suites + +The FORTRAN78 test suite is a product of the NIST Information Technology +Laboratory (ITL). It is used to determine, insofar as is practical, the degree +to which a FORTRAN processor conforms to FIPS Fortran. +The Fortran test suite consists of programs containing features of Standard +Fortran, their related data and an executive program that prepares the audit +routines for compilation. Each program includes tests and supporting +procedures indicating the results of the tests. The testing of a processor in +a particular hardware/operating system environment is accomplished by +compiling and executing each program. + +From: +http://www.itl.nist.gov/div897/ctg/softagre.htm + +Software Acknowledgment and Redistribution + +The conformance test suites provided here are released by the National +Institute of Standards and Technology (NIST), an agency of the U.S. +Department of Commerce, Gaithersburg MD 20899, USA. The test suites bear +no warranty, either express or implied. NIST does not assume legal liability +nor responsibility for a User's use of a test suite or the results of such +use. + +Please note that within the United States, copyright protection, under +Section 105 of the United States Code, Title 17, is not available for any +work of the United States Government and/or for any works created by United +States Government employees. User acknowledges that these test suites contain +work which was created by NIST employees and is therefore in the public +domain and not subject to copyright. The User may use, distribute, or +incorporate these test suites provided the User acknowledges this via an +explicit acknowledgment of NIST-related contributions to the User's work. +User also agrees to acknowledge, via an explicit acknowledgment, that any +modifications or alterations have been made to these test suites before +redistribution. + + +Acknowledgment: +The present version has been slighly altered in the following way: +- a non standard conforming FORMAT statement has been fixed in FM110.f. +- Hollerith strings in FORMAT statements have been converted to quoted + strings to conform to the Fortran 95 standard. + +Modifications: +June 10 by Nichols A. Romero +- modified driver_run input and output files to make it easier to update LLVM Test-Suite +- remove a number of problematic tests, see CMakeLists.txt +June 11 by Nichols A. Romero +- adjust I0? logical unit (I06,I08,etc.) for many tests to avoid race conditions when + running in parallel +- rename CSEQ, DIRFILE, CDIR for many tests to avoid race conditions when running in + parallel +June 12 by Nichols A. Romero +- remove `driver_parse` script since it is not needed or used. +June 23 by Nichols A. Romero +- Added comments regarding the use of the `driver_run` script. diff --git a/Fortran/UnitTests/fcvs21_f95/driver_run b/Fortran/UnitTests/fcvs21_f95/driver_run new file mode 100755 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/driver_run @@ -0,0 +1,92 @@ +#! /bin/sh -u + +# `driver_run` script is NOT intended to used for running the LLVM +# test-suite, nor is it invoked by any of the LLVM test-suite +# infrastructure. It is provided for convenience for the specific +# purpose of updating the reference_output files should the need to do +# so arise. + +# Fortran compiler name +FC='gfortran' +# option to produce executable name +EXECOPT='-o' +# run test 257 (that uses PAUSE) +EXE257=1 +# do not run tests that include deleted features in Fortran 95 +AVOID_DELETED_F95=0 + +# +# main loop +# +for file in `ls FM???.f` +do + process_it=1 + # + # If requested, do not run tests that contain features + # deleted in Fortran 95 + # + if [ x"${AVOID_DELETED_F95}" != x0 ]; then + if [ `grep -c '^[^C*].....[ ]*\bASSIGN\b' ${file}` -ne 0 ]; then + process_it=0 + elif [ `grep -c '^[^C*].....[ ]*\bPAUSE\b' ${file}` -ne 0 ]; then + process_it=0 + elif [ x"${file}" = x'FM719.f' ]; then + process_it=0 + fi + fi + + basename=`basename ${file} .f` + + # If requested, run the test + if [ ${process_it} -eq 0 ]; then + echo "Skip ${basename}" + else + result="${basename}".reference_output + data="${basename}".reference_input + + echo "Process ${basename}" + + eval "${FC}" "${file}" "${EXECOPT}" a.out + + # FM257 tests PAUSE + if [ x"${basename}" = xFM257 ]; then + if [ x"${EXE257}" = x0 ]; then + echo "Skip ${basename}" + else + { + cat <<__EOT__ +go + + + +__EOT__ + } < /dev/null | \ + ./a.out > "${result}" & + pn=`ps | grep a.out | grep -v grep | sed 's/ *\([0-9]*\).*/\1/'` + kill -15 "${pn}" + kill -15 "${pn}" + kill -15 "${pn}" + kill -15 "${pn}" + kill -15 "${pn}" + fi + elif [ -f "${data}" ]; then + ./a.out < "${data}" > "${result}" + else + ./a.out > "${result}" + fi + + # hard-coded to exit 0 + echo "exit 0" >> "${result}" + + rm -f a.out + fi +done + +rm -f fort.* +echo "Finished." + +# +# Possible error extraction +# + +#grep -n 'FAIL' *.res | grep -v '0 TESTS FAILED' | grep -v 'TEST[ ]*PASS/FAIL' diff --git a/Fortran/UnitTests/fcvs21_f95/lit.local.cfg b/Fortran/UnitTests/fcvs21_f95/lit.local.cfg new file mode 100644 --- /dev/null +++ b/Fortran/UnitTests/fcvs21_f95/lit.local.cfg @@ -0,0 +1,2 @@ +config.traditional_output = True +config.single_source = True diff --git a/cmake/modules/SingleMultiSource.cmake b/cmake/modules/SingleMultiSource.cmake --- a/cmake/modules/SingleMultiSource.cmake +++ b/cmake/modules/SingleMultiSource.cmake @@ -82,6 +82,11 @@ set(name ${target}) endif() + # Find the reference input + if(EXISTS ${CMAKE_CURRENT_SOURCE_DIR}/${name}.reference_input) + list(APPEND RUN_OPTIONS < ${CMAKE_CURRENT_SOURCE_DIR}/${name}.reference_input) + endif() + # Always run in the same directory as the executable list(INSERT RUN_OPTIONS 0 WORKDIR ${CMAKE_CURRENT_BINARY_DIR}) llvm_test_run(${RUN_OPTIONS})