1c comment section. 2c 3c fm024 4c 5c three dimensioned arrays are used in this routine. 6c this routine tests arrays with fixed dimension and size limits 7c set either in a blank common or dimension statement. the values 8c of the array elements are set in various ways such as simple 9c assignment statements, set to the values of other array elements 10c (either positive or negative), set by integer to real or real to 11c integer conversion, set by arithmetic expressions, or set by 12c use of the equivalence statement. 13c 14c 15c references 16c american national standard programming language fortran, 17c x3.9-1978 18c 19c section 8, specification statements 20c section 8.1, dimension statement 21c section 8.2, equivalence statement 22c section 8.3, common statement 23c section 8.4, type-statements 24c section 9, data statement 25c 26 common icoe01, rcoe01, lcoe01 27 common iade31(3,3,3), rade31(3,3,3), lade31(3,3,3) 28 common iadn31(2,2,2), radn31(2,2,2), ladn31(2,2,2) 29c 30 dimension iade32(3,3,3), rade32(3,3,3), lade32(3,3,3) 31 dimension iadn32(2,2,2), iadn21(2,2), iadn11(2) 32 dimension iade21(2,2), iade11(4) 33c 34 equivalence (iade31(1,1,1), iade32(1,1,1) ) 35 equivalence ( rade31(1,1,1), rade32(1,1,1) ) 36 equivalence ( lade31(1,1,1), lade32(1,1,1) ) 37 equivalence ( iade31(1,1,1), iade21(1,1), iade11(1) ) 38 equivalence ( icoe01, icoe02, icoe03 ) 39c 40 logical lade31, ladn31, lade32, lcoe01 41 integer radn33(2,2,2), radn21(2,4), radn11(8) 42 real iadn33(2,2,2), iadn22(2,4), iadn12(8) 43c 44c 45c ********************************************************** 46c 47c a compiler validation system for the fortran language 48c based on specifications as defined in american national standard 49c programming language fortran x3.9-1978, has been developed by the 50c federal cobol compiler testing service. the fortran compiler 51c validation system (fcvs) consists of audit routines, their related 52c data, and an executive system. each audit routine is a fortran 53c program, subprogram or function which includes tests of specific 54c language elements and supporting procedures indicating the result 55c of executing these tests. 56c 57c this particular program/subprogram/function contains features 58c found only in the subset as defined in x3.9-1978. 59c 60c suggestions and comments should be forwarded to - 61c 62c department of the navy 63c federal cobol compiler testing service 64c washington, d.c. 20376 65c 66c ********************************************************** 67c 68c 69c 70c initialization section 71c 72c initialize constants 73c ************** 74c i01 contains the logical unit number for the card reader. 75 i01 = 5 76c i02 contains the logical unit number for the printer. 77 i02 = 6 78c system environment section 79c 80cx010 this card is replaced by contents of fexec x-010 control card. 81c the cx010 card is for overriding the program default i01 = 5 82c (unit number for card reader). 83cx011 this card is replaced by contents of fexec x-011 control card. 84c the cx011 card is for systems which require additional 85c fortran statements for files associated with cx010 above. 86c 87cx020 this card is replaced by contents of fexec x-020 control card. 88c the cx020 card is for overriding the program default i02 = 6 89c (unit number for printer). 90cx021 this card is replaced by contents of fexec x-021 control card. 91c the cx021 card is for systems which require additional 92c fortran statements for files associated with cx020 above. 93c 94 ivpass=0 95 ivfail=0 96 ivdele=0 97 iczero=0 98c 99c write page headers 100 write (i02,90000) 101 write (i02,90001) 102 write (i02,90002) 103 write (i02, 90002) 104 write (i02,90003) 105 write (i02,90002) 106 write (i02,90004) 107 write (i02,90002) 108 write (i02,90011) 109 write (i02,90002) 110 write (i02,90002) 111 write (i02,90005) 112 write (i02,90006) 113 write (i02,90002) 114 ivtnum = 645 115c 116c **** test 645 **** 117c test 645 - tests setting a three dimension integer array element 118c by a simple integer assignment statement. 119c 120 if (iczero) 36450, 6450, 36450 121 6450 continue 122 iadn31(2,2,2) = -9999 123 ivcomp = iadn31(2,2,2) 124 go to 46450 12536450 ivdele = ivdele + 1 126 write (i02,80003) ivtnum 127 if (iczero) 46450, 6461, 46450 12846450 if ( ivcomp + 9999 ) 26450, 16450, 26450 12916450 ivpass = ivpass + 1 130 write (i02,80001) ivtnum 131 go to 6461 13226450 ivfail = ivfail + 1 133 ivcorr = -9999 134 write (i02,80004) ivtnum, ivcomp ,ivcorr 135 6461 continue 136 ivtnum = 646 137c 138c **** test 646 **** 139c test 646 - tests setting a three dimension real array element 140c by a simple real assignment statement. 141c 142 if (iczero) 36460, 6460, 36460 143 6460 continue 144 radn31(1,2,1) = 512. 145 ivcomp = radn31(1,2,1) 146 go to 46460 14736460 ivdele = ivdele + 1 148 write (i02,80003) ivtnum 149 if (iczero) 46460, 6471, 46460 15046460 if ( ivcomp - 512 ) 26460, 16460, 26460 15116460 ivpass = ivpass + 1 152 write (i02,80001) ivtnum 153 go to 6471 15426460 ivfail = ivfail + 1 155 ivcorr = 512 156 write (i02,80004) ivtnum, ivcomp ,ivcorr 157 6471 continue 158 ivtnum = 647 159c 160c **** test 647 **** 161c test 647 - tests setting a three dimension logical array element 162c by a simple logical assignment statement. 163c 164 if (iczero) 36470, 6470, 36470 165 6470 continue 166 ladn31(1,2,2) = .true. 167 icon01 = 0 168 if ( ladn31(1,2,2) ) icon01 = 1 169 go to 46470 17036470 ivdele = ivdele + 1 171 write (i02,80003) ivtnum 172 if (iczero) 46470, 6481, 46470 17346470 if ( icon01 - 1 ) 26470, 16470, 26470 17416470 ivpass = ivpass + 1 175 write (i02,80001) ivtnum 176 go to 6481 17726470 ivfail = ivfail + 1 178 ivcomp = icon01 179 ivcorr = 1 180 write (i02,80004) ivtnum, ivcomp ,ivcorr 181 6481 continue 182 ivtnum = 648 183c 184c **** test 648 **** 185c test 648 - tests setting a one, two, and three dimension array 186c element to a value in arithmetic assignment statements. all three 187c elements are integers. the integer array elements are then used 188c in an arithmetic statement and the result is stored by integer 189c to real conversion into a three dimension real array element. 190c 191 if (iczero) 36480, 6480, 36480 192 6480 continue 193 iadn11(2) = 1 194 iadn21(2,2) = 2 195 iadn32(2,2,2) = 3 196 radn31(2,2,1) = iadn11(2) + iadn21(2,2) + iadn32(2,2,2) 197 ivcomp = radn31(2,2,1) 198 go to 46480 19936480 ivdele = ivdele + 1 200 write (i02,80003) ivtnum 201 if (iczero) 46480, 6491, 46480 20246480 if ( ivcomp - 6) 26480, 16480, 26480 20316480 ivpass = ivpass + 1 204 write (i02,80001) ivtnum 205 go to 6491 20626480 ivfail = ivfail + 1 207 ivcorr = 6 208 write (i02,80004) ivtnum, ivcomp ,ivcorr 209 6491 continue 210 ivtnum = 649 211c 212c **** test 649 **** 213c test 649 - tests of one, two, and three dimension array elements 214c set explicitly integer by the integer type statement. all element 215c values should be zero from real to integer truncation from a value 216c of 0.5. all three elements are used in an arithmetic expression. 217c the value of the sum of the elements should be zero. 218c 219 if (iczero) 36490, 6490, 36490 220 6490 continue 221 radn11(8) = 0000.50000 222 radn21(2,4) = .50000 223 radn33(2,2,2) = 00000.5 224 radn11(1) = radn11(8) + radn21(2,4) + radn33(2,2,2) 225 ivcomp = radn11(1) 226 go to 46490 22736490 ivdele = ivdele + 1 228 write (i02,80003) ivtnum 229 if (iczero) 46490, 6501, 46490 23046490 if ( ivcomp - 0 ) 26490, 16490, 26490 23116490 ivpass = ivpass + 1 232 write (i02,80001) ivtnum 233 go to 6501 23426490 ivfail = ivfail + 1 235 ivcorr = 0 236 write (i02,80004) ivtnum, ivcomp ,ivcorr 237 6501 continue 238 ivtnum = 650 239c 240c **** test 650 **** 241c test 650 - test of the equivalence statement. a real array 242c element is set by an assignment statement. its equivalent element 243c in common is used to set the value of an integer array element 244c also in common. finally the dimensioned equivalent integer 245c array element is tested for the value used throughout 32767. 246c 247 if (iczero) 36500, 6500, 36500 248 6500 continue 249 rade32(2,2,2) = 32767. 250 iade31(2,2,2) = rade31(2,2,2) 251 ivcomp = iade32(2,2,2) 252 go to 46500 25336500 ivdele = ivdele + 1 254 write (i02,80003) ivtnum 255 if (iczero) 46500, 6511, 46500 25646500 if ( ivcomp - 32767 ) 26500, 16500, 26500 25716500 ivpass = ivpass + 1 258 write (i02,80001) ivtnum 259 go to 6511 26026500 ivfail = ivfail + 1 261 ivcorr = 32767 262 write (i02,80004) ivtnum, ivcomp ,ivcorr 263 6511 continue 264 ivtnum = 651 265c 266c **** test 651 **** 267c test 651 - this is a test of common and dimension as well as a 268c test of the equivalence statement using logical array elements 269c both in common and dimensioned. a logical variable in common is 270c set to a value of .not. the value used in the equivalenced array 271c elements which were set in a logical assignment statement. 272c 273 if (iczero) 36510, 6510, 36510 274 6510 continue 275 lade31(1,2,3) = .false. 276 lcoe01 = .not. lade32(1,2,3) 277 icon01 = 0 278 if ( lcoe01 ) icon01 = 1 279 go to 46510 28036510 ivdele = ivdele + 1 281 write (i02,80003) ivtnum 282 if (iczero) 46510, 6521, 46510 28346510 if ( icon01 - 1 ) 26510, 16510, 26510 28416510 ivpass = ivpass + 1 285 write (i02,80001) ivtnum 286 go to 6521 28726510 ivfail = ivfail + 1 288 ivcomp = icon01 289 ivcorr = 1 290 write (i02,80004) ivtnum, ivcomp ,ivcorr 291 6521 continue 292 ivtnum = 652 293c 294c **** test 652 **** 295c test 652 - tests of one, two, and three dimension array elements 296c set explicitly real by the real type statement. all element 297c values should be 0.5 from the real assignment statement. the 298c array elements are summed and then the sum multiplied by 2. 299c finally 0.2 is added to the result and the final result converted 300c to an integer ( ( .5 + .5 + .5 ) * 2. ) + 0.2 301c 302 if (iczero) 36520, 6520, 36520 303 6520 continue 304 iadn12(5) = 0.5 305 iadn22(1,3) = 0.5 306 iadn33(1,2,2) = 0.5 307 ivcomp = ( ( iadn12(5) + iadn22(1,3) + iadn33(1,2,2) ) * 2. ) + .2 308 go to 46520 30936520 ivdele = ivdele + 1 310 write (i02,80003) ivtnum 311 if (iczero) 46520, 6531, 46520 31246520 if ( ivcomp - 3 ) 26520, 16520, 26520 31316520 ivpass = ivpass + 1 314 write (i02,80001) ivtnum 315 go to 6531 31626520 ivfail = ivfail + 1 317 ivcorr = 3 318 write (i02,80004) ivtnum, ivcomp ,ivcorr 319 6531 continue 320c 321c write page footings and run summaries 32299999 continue 323 write (i02,90002) 324 write (i02,90006) 325 write (i02,90002) 326 write (i02,90002) 327 write (i02,90007) 328 write (i02,90002) 329 write (i02,90008) ivfail 330 write (i02,90009) ivpass 331 write (i02,90010) ivdele 332c 333c 334c terminate routine execution 335 stop 336c 337c format statements for page headers 33890000 format (1h1) 33990002 format (1h ) 34090001 format (1h ,10x,34hfortran compiler validation system) 34190003 format (1h ,21x,11hversion 1.0) 34290004 format (1h ,10x,38hfor official use only - copyright 1978) 34390005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) 34490006 format (1h ,5x,46h----------------------------------------------) 34590011 format (1h ,18x,17hsubset level test) 346c 347c format statements for run summaries 34890008 format (1h ,15x,i5,19h errors encountered) 34990009 format (1h ,15x,i5,13h tests passed) 35090010 format (1h ,15x,i5,14h tests deleted) 351c 352c format statements for test results 35380001 format (1h ,4x,i5,7x,4hpass) 35480002 format (1h ,4x,i5,7x,4hfail) 35580003 format (1h ,4x,i5,7x,7hdeleted) 35680004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) 35780005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) 358c 35990007 format (1h ,20x,20hend of program fm024) 360 end 361