1c comment section. 2c 3c fm023 4c 5c two 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 iadn22(2,2), radn22(2,2), icoe01, rcoe01 27 dimension iadn21(2,2), radn21(2,2) 28 dimension iade23(2,2), iade24(2,2), rade23(2,2), rade24(2,2) 29 equivalence (iade23(2,2),iadn22(2,2),iade24(2,2)) 30 equivalence (rade23(2,2),radn22(2,2),rade24(2,2)) 31 equivalence (icoe01,icoe02,icoe03,icoe04), (rcoe01,rcoe02,rcoe03) 32 integer radn11(2), radn25(2,2) 33 logical ladn21(2,2) 34 data radn21(2,2)/-512./ 35 data ladn21/4*.true./ 36c 37c ********************************************************** 38c 39c a compiler validation system for the fortran language 40c based on specifications as defined in american national standard 41c programming language fortran x3.9-1978, has been developed by the 42c federal cobol compiler testing service. the fortran compiler 43c validation system (fcvs) consists of audit routines, their related 44c data, and an executive system. each audit routine is a fortran 45c program, subprogram or function which includes tests of specific 46c language elements and supporting procedures indicating the result 47c of executing these tests. 48c 49c this particular program/subprogram/function contains features 50c found only in the subset as defined in x3.9-1978. 51c 52c suggestions and comments should be forwarded to - 53c 54c department of the navy 55c federal cobol compiler testing service 56c washington, d.c. 20376 57c 58c ********************************************************** 59c 60c 61c 62c initialization section 63c 64c initialize constants 65c ************** 66c i01 contains the logical unit number for the card reader. 67 i01 = 5 68c i02 contains the logical unit number for the printer. 69 i02 = 6 70c system environment section 71c 72cx010 this card is replaced by contents of fexec x-010 control card. 73c the cx010 card is for overriding the program default i01 = 5 74c (unit number for card reader). 75cx011 this card is replaced by contents of fexec x-011 control card. 76c the cx011 card is for systems which require additional 77c fortran statements for files associated with cx010 above. 78c 79cx020 this card is replaced by contents of fexec x-020 control card. 80c the cx020 card is for overriding the program default i02 = 6 81c (unit number for printer). 82cx021 this card is replaced by contents of fexec x-021 control card. 83c the cx021 card is for systems which require additional 84c fortran statements for files associated with cx020 above. 85c 86 ivpass=0 87 ivfail=0 88 ivdele=0 89 iczero=0 90c 91c write page headers 92 write (i02,90000) 93 write (i02,90001) 94 write (i02,90002) 95 write (i02, 90002) 96 write (i02,90003) 97 write (i02,90002) 98 write (i02,90004) 99 write (i02,90002) 100 write (i02,90011) 101 write (i02,90002) 102 write (i02,90002) 103 write (i02,90005) 104 write (i02,90006) 105 write (i02,90002) 106 ivtnum = 632 107c 108c **** test 632 **** 109c test 632 - tests setting an integer array element by a 110c simple assignment statement to the value 9999. 111c 112 if (iczero) 36320, 6320, 36320 113 6320 continue 114 iadn21(1,1) = 9999 115 ivcomp = iadn21(1,1) 116 go to 46320 11736320 ivdele = ivdele + 1 118 write (i02,80003) ivtnum 119 if (iczero) 46320, 6331, 46320 12046320 if ( ivcomp - 9999 ) 26320, 16320, 26320 12116320 ivpass = ivpass + 1 122 write (i02,80001) ivtnum 123 go to 6331 12426320 ivfail = ivfail + 1 125 ivcorr = 9999 126 write (i02,80004) ivtnum, ivcomp ,ivcorr 127 6331 continue 128 ivtnum = 633 129c 130c **** test 633 **** 131c test 633 - tests setting a real array element by a simple 132c assignment statement to the value -32766. 133c 134 if (iczero) 36330, 6330, 36330 135 6330 continue 136 radn21(1,2) = -32766. 137 ivcomp = radn21(1,2) 138 go to 46330 13936330 ivdele = ivdele + 1 140 write (i02,80003) ivtnum 141 if (iczero) 46330, 6341, 46330 14246330 if ( ivcomp + 32766 ) 26330, 16330, 26330 14316330 ivpass = ivpass + 1 144 write (i02,80001) ivtnum 145 go to 6341 14626330 ivfail = ivfail + 1 147 ivcorr = -32766 148 write (i02,80004) ivtnum, ivcomp ,ivcorr 149 6341 continue 150 ivtnum = 634 151c 152c **** test 634 **** 153c test 634 - test of the data initialization statement and setting 154c an integer array element equal to the value of a real array 155c element. the value used is -512. 156c 157 if (iczero) 36340, 6340, 36340 158 6340 continue 159 iadn21(2,2) = radn21(2,2) 160 ivcomp = iadn21(2,2) 161 go to 46340 16236340 ivdele = ivdele + 1 163 write (i02,80003) ivtnum 164 if (iczero) 46340, 6351, 46340 16546340 if ( ivcomp + 512 ) 26340, 16340, 26340 16616340 ivpass = ivpass + 1 167 write (i02,80001) ivtnum 168 go to 6351 16926340 ivfail = ivfail + 1 170 ivcorr = -512 171 write (i02,80004) ivtnum, ivcomp ,ivcorr 172 6351 continue 173 ivtnum = 635 174c 175c **** test 635 **** 176c test 635 - test of setting a two dimensioned array element 177c equal to the value of a one dimensioned array element. 178c both arrays are set integer by the type statement and the two 179c dimensioned array element is minus the value of the one dimension 180c element. the value used is 3. 181c 182 if (iczero) 36350, 6350, 36350 183 6350 continue 184 radn11(1) = 3 185 radn25(2,2) = - radn11(1) 186 ivcomp = radn25(2,2) 187 go to 46350 18836350 ivdele = ivdele + 1 189 write (i02,80003) ivtnum 190 if (iczero) 46350, 6361, 46350 19146350 if ( ivcomp + 3 ) 26350, 16350, 26350 19216350 ivpass = ivpass + 1 193 write (i02,80001) ivtnum 194 go to 6361 19526350 ivfail = ivfail + 1 196 ivcorr = -3 197 write (i02,80004) ivtnum, ivcomp ,ivcorr 198 6361 continue 199 ivtnum = 636 200c 201c **** test 636 **** 202c test 636 - test of logical array elements set by data statements 203c 204 if (iczero) 36360, 6360, 36360 205 6360 continue 206 icon01 = 0 207 if ( ladn21(2,1) ) icon01 = 1 208 go to 46360 20936360 ivdele = ivdele + 1 210 write (i02,80003) ivtnum 211 if (iczero) 46360, 6371, 46360 21246360 if ( icon01 - 1 ) 26360, 16360, 26360 21316360 ivpass = ivpass + 1 214 write (i02,80001) ivtnum 215 go to 6371 21626360 ivfail = ivfail + 1 217 ivcomp = icon01 218 ivcorr = 1 219 write (i02,80004) ivtnum, ivcomp ,ivcorr 220 6371 continue 221 ivtnum = 637 222c 223c **** test 637 **** 224c test 637 - test of real to integer conversion and setting 225c integer array elements to the value obtained in an arithmetic 226c expression using real array elements. .5 + .5 = 1 227c 228 if (iczero) 36370, 6370, 36370 229 6370 continue 230 radn21(1,2) = 00000.5 231 radn21(2,1) = .500000 232 iadn21(2,1) = radn21(1,2) + radn21(2,1) 233 ivcomp = iadn21(2,1) 234 go to 46370 23536370 ivdele = ivdele + 1 236 write (i02,80003) ivtnum 237 if (iczero) 46370, 6381, 46370 23846370 if ( ivcomp - 1 ) 26370, 16370, 26370 23916370 ivpass = ivpass + 1 240 write (i02,80001) ivtnum 241 go to 6381 24226370 ivfail = ivfail + 1 243 ivcorr = 1 244 write (i02,80004) ivtnum, ivcomp ,ivcorr 245 6381 continue 246 ivtnum = 638 247c 248c **** test 638 **** 249c test 638 - test of equivalence of three integer arrays one of 250c which is in common. 251c 252 if (iczero) 36380, 6380, 36380 253 6380 continue 254 iadn22(2,1) = -9999 255 ivcomp = iade23(2,1) 256 go to 46380 25736380 ivdele = ivdele + 1 258 write (i02,80003) ivtnum 259 if (iczero) 46380, 6391, 46380 26046380 if ( ivcomp + 9999 ) 26380, 16380, 26380 26116380 ivpass = ivpass + 1 262 write (i02,80001) ivtnum 263 go to 6391 26426380 ivfail = ivfail + 1 265 ivcorr = -9999 266 write (i02,80004) ivtnum, ivcomp ,ivcorr 267 6391 continue 268 ivtnum = 639 269c 270c **** test 639 **** 271c test 639 - like test 638 only the other equivalenced array is 272c tested for the value -9999. 273c 274 if (iczero) 36390, 6390, 36390 275 6390 continue 276 iade23(2,1) = -9999 277 ivcomp = iade24(2,1) 278 go to 46390 27936390 ivdele = ivdele + 1 280 write (i02,80003) ivtnum 281 if (iczero) 46390, 6401, 46390 28246390 if ( ivcomp + 9999 ) 26390, 16390, 26390 28316390 ivpass = ivpass + 1 284 write (i02,80001) ivtnum 285 go to 6401 28626390 ivfail = ivfail + 1 287 ivcorr = -9999 288 write (i02,80004) ivtnum, ivcomp ,ivcorr 289 6401 continue 290 ivtnum = 640 291c 292c **** test 640 **** 293c test 640 - test of three real arrays that are equivalenced. 294c one of the arrays is in common. the value 512 is set into one of 295c the dimensioned array elements by an integer to real conversion 296c assignment statement. 297c 298 if (iczero) 36400, 6400, 36400 299 6400 continue 300 rade24(2,2) = 512 301 ivcomp = radn22(2,2) 302 go to 46400 30336400 ivdele = ivdele + 1 304 write (i02,80003) ivtnum 305 if (iczero) 46400, 6411, 46400 30646400 if ( ivcomp - 512 ) 26400, 16400, 26400 30716400 ivpass = ivpass + 1 308 write (i02,80001) ivtnum 309 go to 6411 31026400 ivfail = ivfail + 1 311 ivcorr = 512 312 write (i02,80004) ivtnum, ivcomp ,ivcorr 313 6411 continue 314 ivtnum = 641 315c 316c **** test 641 **** 317c test 641 - like test 640 only the other equivalenced array is 318c tested for the value 512. 319c 320 if (iczero) 36410, 6410, 36410 321 6410 continue 322 radn22(2,2) = 512 323 ivcomp = rade23(2,2) 324 go to 46410 32536410 ivdele = ivdele + 1 326 write (i02,80003) ivtnum 327 if (iczero) 46410, 6421, 46410 32846410 if ( ivcomp - 512 ) 26410, 16410, 26410 32916410 ivpass = ivpass + 1 330 write (i02,80001) ivtnum 331 go to 6421 33226410 ivfail = ivfail + 1 333 ivcorr = 512 334 write (i02,80004) ivtnum, ivcomp ,ivcorr 335 6421 continue 336 ivtnum = 642 337c 338c **** test 642 **** 339c test 642 - test of four integer variables that are equivalenced. 340c one of the integer variables is in blank common. the value used 341c is 3 set by an assignment statement. 342c 343 if (iczero) 36420, 6420, 36420 344 6420 continue 345 icoe03 = 3 346 ivcomp = icoe01 347 go to 46420 34836420 ivdele = ivdele + 1 349 write (i02,80003) ivtnum 350 if (iczero) 46420, 6431, 46420 35146420 if ( ivcomp - 3 ) 26420, 16420, 26420 35216420 ivpass = ivpass + 1 353 write (i02,80001) ivtnum 354 go to 6431 35526420 ivfail = ivfail + 1 356 ivcorr = 3 357 write (i02,80004) ivtnum, ivcomp ,ivcorr 358 6431 continue 359 ivtnum = 643 360c 361c **** test 643 **** 362c test 643 - like test 642 but another of the elements is tested 363c by an arithmetic expression using the equivalenced elements. 364c the value of all of the elements should inititially be 3 since 365c they all should share the same storage location. icoe04 = 3+3+3+3 366c icoe04 = 12 then the element icoe02 is tested for the value 12. 367c 368 if (iczero) 36430, 6430, 36430 369 6430 continue 370 icoe01 = 3 371 icoe04 = icoe01 + icoe02 + icoe03 + icoe04 372 ivcomp = icoe02 373 go to 46430 37436430 ivdele = ivdele + 1 375 write (i02,80003) ivtnum 376 if (iczero) 46430, 6441, 46430 37746430 if ( ivcomp - 12 ) 26430, 16430, 26430 37816430 ivpass = ivpass + 1 379 write (i02,80001) ivtnum 380 go to 6441 38126430 ivfail = ivfail + 1 382 ivcorr = 12 383 write (i02,80004) ivtnum, ivcomp ,ivcorr 384 6441 continue 385 ivtnum = 644 386c 387c **** test 644 **** 388c test 644 - test of equivalence with three real variables one 389c of which is in blank common. the elements are set initially to .5 390c then all of the elements are used in an arithmetic expression 391c rcoe01 =(.5 + .5 + .5) * 2. so rcoe01 = 3. element rcoe02 392c is tested for the value 3. 393c 394 if (iczero) 36440, 6440, 36440 395 6440 continue 396 rcoe02 = 0.5 397 rcoe01 = ( rcoe01 + rcoe02 + rcoe03 ) * 2. 398 ivcomp = rcoe02 399 go to 46440 40036440 ivdele = ivdele + 1 401 write (i02,80003) ivtnum 402 if (iczero) 46440, 6451, 46440 40346440 if ( ivcomp - 3 ) 26440, 16440, 26440 40416440 ivpass = ivpass + 1 405 write (i02,80001) ivtnum 406 go to 6451 40726440 ivfail = ivfail + 1 408 ivcorr = 3 409 write (i02,80004) ivtnum, ivcomp ,ivcorr 410 6451 continue 411c 412c write page footings and run summaries 41399999 continue 414 write (i02,90002) 415 write (i02,90006) 416 write (i02,90002) 417 write (i02,90002) 418 write (i02,90007) 419 write (i02,90002) 420 write (i02,90008) ivfail 421 write (i02,90009) ivpass 422 write (i02,90010) ivdele 423c 424c 425c terminate routine execution 426 stop 427c 428c format statements for page headers 42990000 format (1h1) 43090002 format (1h ) 43190001 format (1h ,10x,34hfortran compiler validation system) 43290003 format (1h ,21x,11hversion 1.0) 43390004 format (1h ,10x,38hfor official use only - copyright 1978) 43490005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) 43590006 format (1h ,5x,46h----------------------------------------------) 43690011 format (1h ,18x,17hsubset level test) 437c 438c format statements for run summaries 43990008 format (1h ,15x,i5,19h errors encountered) 44090009 format (1h ,15x,i5,13h tests passed) 44190010 format (1h ,15x,i5,14h tests deleted) 442c 443c format statements for test results 44480001 format (1h ,4x,i5,7x,4hpass) 44580002 format (1h ,4x,i5,7x,4hfail) 44680003 format (1h ,4x,i5,7x,7hdeleted) 44780004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) 44880005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) 449c 45090007 format (1h ,20x,20hend of program fm023) 451 end 452