| 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 |
