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