1c comment section. 2c 3c fm025 4c 5c this routine tests arrays with if statements, do loops, 6c assigned and computed go to statements in conjunction with array 7c elements in common or dimensioned. one, two, and three 8c dimensioned arrays are used. the subscripts are integer constants 9c or sometimes integer variables when the elements are in loops 10c and all arrays have fixed size limits. integer, real, and logical 11c arrays are used with the type sometimes specified with the 12c explicit type statement. 13c 14c references 15c american national standard programming language fortran, 16c x3.9-1978 17c 18c section 8, specification statements 19c section 8.1, dimension statement 20c section 8.3, common statement 21c section 8.4, type-statements 22c section 9, data statement 23c section 11.2, computed go to statement 24c section 11.3, assigned go to statement 25c section 11.10, do statement 26c 27 common iadn31(2,2,2), radn31(2,2,2), ladn31(2,2,2) 28c 29 dimension iadn32(2,2,2), iadn21(2,2), iadn11(2) 30c 31 logical ladn31 32 integer radn33(2,2,2), radn21(2,4), radn11(8) 33 real iadn33(2,2,2), iadn22(2,4), iadn12(8) 34c 35c 36c ********************************************************** 37c 38c a compiler validation system for the fortran language 39c based on specifications as defined in american national standard 40c programming language fortran x3.9-1978, has been developed by the 41c federal cobol compiler testing service. the fortran compiler 42c validation system (fcvs) consists of audit routines, their related 43c data, and an executive system. each audit routine is a fortran 44c program, subprogram or function which includes tests of specific 45c language elements and supporting procedures indicating the result 46c of executing these tests. 47c 48c this particular program/subprogram/function contains features 49c found only in the subset as defined in x3.9-1978. 50c 51c suggestions and comments should be forwarded to - 52c 53c department of the navy 54c federal cobol compiler testing service 55c washington, d.c. 20376 56c 57c ********************************************************** 58c 59c 60c 61c initialization section 62c 63c initialize constants 64c ************** 65c i01 contains the logical unit number for the card reader. 66 i01 = 5 67c i02 contains the logical unit number for the printer. 68 i02 = 6 69c system environment section 70c 71cx010 this card is replaced by contents of fexec x-010 control card. 72c the cx010 card is for overriding the program default i01 = 5 73c (unit number for card reader). 74cx011 this card is replaced by contents of fexec x-011 control card. 75c the cx011 card is for systems which require additional 76c fortran statements for files associated with cx010 above. 77c 78cx020 this card is replaced by contents of fexec x-020 control card. 79c the cx020 card is for overriding the program default i02 = 6 80c (unit number for printer). 81cx021 this card is replaced by contents of fexec x-021 control card. 82c the cx021 card is for systems which require additional 83c fortran statements for files associated with cx020 above. 84c 85 ivpass=0 86 ivfail=0 87 ivdele=0 88 iczero=0 89c 90c write page headers 91 write (i02,90000) 92 write (i02,90001) 93 write (i02,90002) 94 write (i02, 90002) 95 write (i02,90003) 96 write (i02,90002) 97 write (i02,90004) 98 write (i02,90002) 99 write (i02,90011) 100 write (i02,90002) 101 write (i02,90002) 102 write (i02,90005) 103 write (i02,90006) 104 write (i02,90002) 105 ivtnum = 653 106c 107c **** test 653 **** 108c test 653 - test of setting all values of an integer array 109c by the integer index of a do loop. the array has one dimension. 110c 111 if (iczero) 36530, 6530, 36530 112 6530 continue 113 do 6532 i = 1,2,1 114 iadn11(i) = i 115 6532 continue 116 ivcomp = iadn11(1) 117 go to 46530 11836530 ivdele = ivdele + 1 119 write (i02,80003) ivtnum 120 if (iczero) 46530, 6541, 46530 12146530 if ( ivcomp - 1 ) 26530, 16530, 26530 12216530 ivpass = ivpass + 1 123 write (i02,80001) ivtnum 124 go to 6541 12526530 ivfail = ivfail + 1 126 ivcorr = 1 127 write (i02,80004) ivtnum, ivcomp ,ivcorr 128 6541 continue 129 ivtnum = 654 130c 131c **** test 654 **** 132c test 654 - see test 653. this test checks the second element of 133c the integer array iadn11(2). 134c 135 if (iczero) 36540, 6540, 36540 136 6540 continue 137 ivcomp = iadn11(2) 138 go to 46540 13936540 ivdele = ivdele + 1 140 write (i02,80003) ivtnum 141 if (iczero) 46540, 6551, 46540 14246540 if ( ivcomp - 2 ) 26540, 16540, 26540 14316540 ivpass = ivpass + 1 144 write (i02,80001) ivtnum 145 go to 6551 14626540 ivfail = ivfail + 1 147 ivcorr = 2 148 write (i02,80004) ivtnum, ivcomp ,ivcorr 149 6551 continue 150 ivtnum = 655 151c 152c **** test 655 **** 153c test 655 - test of setting the values of the column of a two 154c dimension integer array by a do loop. the values for the elements 155c in a column is the number of the column as set by the do loop 156c index. row numbers are integer constants. 157c the values for the elements are as follows 158c 1 2 159c 1 2 160c 161 if (iczero) 36550, 6550, 36550 162 6550 continue 163 do 6552 j = 1, 2 164 iadn21(1,j) = j 165 iadn21(2,j) = j 166 6552 continue 167 ivcomp = iadn21(1,1) 168 go to 46550 16936550 ivdele = ivdele + 1 170 write (i02,80003) ivtnum 171 if (iczero) 46550, 6561, 46550 17246550 if ( ivcomp - 1 ) 26550, 16550, 26550 17316550 ivpass = ivpass + 1 174 write (i02,80001) ivtnum 175 go to 6561 17626550 ivfail = ivfail + 1 177 ivcorr = 1 178 write (i02,80004) ivtnum, ivcomp ,ivcorr 179 6561 continue 180 ivtnum = 656 181c 182c **** test 656 **** 183c test 656 - see test 655. this test checks the value of the 184c integer array iadn21(2,2) 185c 186 if (iczero) 36560, 6560, 36560 187 6560 continue 188 ivcomp = iadn21(2,2) 189 go to 46560 19036560 ivdele = ivdele + 1 191 write (i02,80003) ivtnum 192 if (iczero) 46560, 6571, 46560 19346560 if ( ivcomp - 2 ) 26560, 16560, 26560 19416560 ivpass = ivpass + 1 195 write (i02,80001) ivtnum 196 go to 6571 19726560 ivfail = ivfail + 1 198 ivcorr = 2 199 write (i02,80004) ivtnum, ivcomp ,ivcorr 200 6571 continue 201 ivtnum = 657 202c 203c **** test 657 **** 204c test 657 - this tests setting both the row and column subscripts 205c in a two dimension integer array with a double nested do loop. 206c the element values are set by an integer counter. element values 207c are as follows 1 2 208c 3 4 209c 210 if (iczero) 36570, 6570, 36570 211 6570 continue 212 icon01 = 0 213 do 6573 i = 1, 2 214 do 6572 j = 1, 2 215 icon01 = icon01 + 1 216 iadn21(i,j) = icon01 217 6572 continue 218 6573 continue 219 ivcomp = iadn21(1,2) 220 go to 46570 22136570 ivdele = ivdele + 1 222 write (i02,80003) ivtnum 223 if (iczero) 46570, 6581, 46570 22446570 if ( ivcomp - 2 ) 26570, 16570, 26570 22516570 ivpass = ivpass + 1 226 write (i02,80001) ivtnum 227 go to 6581 22826570 ivfail = ivfail + 1 229 ivcorr = 2 230 write (i02,80004) ivtnum, ivcomp ,ivcorr 231 6581 continue 232 ivtnum = 658 233c 234c **** test 658 **** 235c test 658 - see test 657. this test checks the value of array 236c element iadn21(2,1) = 3 237c 238 if (iczero) 36580, 6580, 36580 239 6580 continue 240 ivcomp = iadn21(2,1) 241 go to 46580 24236580 ivdele = ivdele + 1 243 write (i02,80003) ivtnum 244 if (iczero) 46580, 6591, 46580 24546580 if ( ivcomp - 3 ) 26580, 16580, 26580 24616580 ivpass = ivpass + 1 247 write (i02,80001) ivtnum 248 go to 6591 24926580 ivfail = ivfail + 1 250 ivcorr = 3 251 write (i02,80004) ivtnum, ivcomp ,ivcorr 252 6591 continue 253 ivtnum = 659 254c 255c **** test 659 **** 256c test 659 - this test uses a triple nested do loop to set the 257c elements in all three dimensions of an integer array that is 258c dimensioned. the values for the elements are as follows 259c for element (i,j,k) = i + j + k 260c so for element (1,1,2) = 1 + 1 + 2 = 4 261c 262 if (iczero) 36590, 6590, 36590 263 6590 continue 264 do 6594 i = 1, 2 265 do 6593 j = 1, 2 266 do 6592 k = 1, 2 267 iadn32( i, j, k ) = i + j + k 268 6592 continue 269 6593 continue 270 6594 continue 271 ivcomp = iadn32(1,1,2) 272 go to 46590 27336590 ivdele = ivdele + 1 274 write (i02,80003) ivtnum 275 if (iczero) 46590, 6601, 46590 27646590 if ( ivcomp - 4 ) 26590, 16590, 26590 27716590 ivpass = ivpass + 1 278 write (i02,80001) ivtnum 279 go to 6601 28026590 ivfail = ivfail + 1 281 ivcorr = 4 282 write (i02,80004) ivtnum, ivcomp ,ivcorr 283 6601 continue 284 ivtnum = 660 285c 286c **** test 660 **** 287c test 660 - see test 659. this checks for iadn32(2,2,2) = 6 288c 289 if (iczero) 36600, 6600, 36600 290 6600 continue 291 ivcomp = iadn32(2,2,2) 292 go to 46600 29336600 ivdele = ivdele + 1 294 write (i02,80003) ivtnum 295 if (iczero) 46600, 6611, 46600 29646600 if ( ivcomp - 6 ) 26600, 16600, 26600 29716600 ivpass = ivpass + 1 298 write (i02,80001) ivtnum 299 go to 6611 30026600 ivfail = ivfail + 1 301 ivcorr = 6 302 write (i02,80004) ivtnum, ivcomp ,ivcorr 303 6611 continue 304 ivtnum = 661 305c 306c **** test 661 **** 307c test 661 - this test sets the elements of an integer array in 308c common to minus the value of the integer array set in test 659. 309c element iadn32(1,1,2) = 4 so element iadn31(1,1,2) = -4 310c the same integer assignment statement is used as the terminating 311c statement for all three do loops used to set the array values 312c of integer array iadn31. 313c if test 659 fails, then this test should also fail. however, the 314c computed values should relate in that the computed value for 315c test 661 should be minus the computed value for test 659. 316c 317 if (iczero) 36610, 6610, 36610 318 6610 continue 319 do 6612 i = 1, 2 320 do 6612 j = 1, 2 321 do 6612 k = 1, 2 322 6612 iadn31(i,j,k) = - iadn32 ( i, j, k ) 323 ivcomp = iadn31(1,1,2) 324 go to 46610 32536610 ivdele = ivdele + 1 326 write (i02,80003) ivtnum 327 if (iczero) 46610, 6621, 46610 32846610 if ( ivcomp + 4 ) 26610, 16610, 26610 32916610 ivpass = ivpass + 1 330 write (i02,80001) ivtnum 331 go to 6621 33226610 ivfail = ivfail + 1 333 ivcorr = -4 334 write (i02,80004) ivtnum, ivcomp ,ivcorr 335 6621 continue 336 ivtnum = 662 337c 338c **** test 662 **** 339c test 662 - this is a test of a triple nested do loop used to 340c set the values of a logical array ladn31. unlike the other tests 341c the third dimension is set last, the first dimension is set second 342c and the second dimension is set first. all array elements are set 343c to the logical constant .false. 344c 345 if (iczero) 36620, 6620, 36620 346 6620 continue 347 do 6622 k = 1, 2 348 do 6622 i = 1, 2 349 do 6622 j = 1, 2 350 ladn31( i, j, k ) = .false. 351 6622 continue 352 icon01 = 1 353 if ( ladn31(2,1,2) ) icon01 = 0 354 go to 46620 35536620 ivdele = ivdele + 1 356 write (i02,80003) ivtnum 357 if (iczero) 46620, 6631, 46620 35846620 if ( icon01 - 1 ) 26620, 16620, 26620 35916620 ivpass = ivpass + 1 360 write (i02,80001) ivtnum 361 go to 6631 36226620 ivfail = ivfail + 1 363 ivcomp = icon01 364 ivcorr = 1 365 write (i02,80004) ivtnum, ivcomp ,ivcorr 366 6631 continue 367 ivtnum = 663 368c 369c note **** test 663 was deleted by fccts. 370c 371 if (iczero) 36630, 6630, 36630 372 6630 continue 37336630 ivdele = ivdele + 1 374 write (i02,80003) ivtnum 375 if (iczero) 46630, 6641, 46630 37646630 if ( icon01 - 6633 ) 26630, 16630, 26630 37716630 ivpass = ivpass + 1 378 write (i02,80001) ivtnum 379 go to 6641 38026630 ivfail = ivfail + 1 381 ivcomp = icon01 382 ivcorr = 6633 383 write (i02,80004) ivtnum, ivcomp ,ivcorr 384 6641 continue 385 ivtnum = 664 386c 387c note **** test 664 was deleted by fccts. 388c 389 if (iczero) 36640, 6640, 36640 390 6640 continue 39136640 ivdele = ivdele + 1 392 write (i02,80003) ivtnum 393 if (iczero) 46640, 6651, 46640 39446640 if ( icon01 - 6643 ) 26640, 16640, 26640 39516640 ivpass = ivpass + 1 396 write (i02,80001) ivtnum 397 go to 6651 39826640 ivfail = ivfail + 1 399 ivcomp = icon01 400 ivcorr = 6443 401 write (i02,80004) ivtnum, ivcomp ,ivcorr 402 6651 continue 403 ivtnum = 665 404c 405c **** test 665 **** 406c test 665 - array elements set to type real by the explicit 407c real statement are set to the value 0.5 and used to set the value 408c of an array element set to type integer by the integer statement. 409c this last integer element is used in a logical if statement 410c that should compare true. ( .5 + .5 + .5 ) * 2. .eq. 3 411c 412 if (iczero) 36650, 6650, 36650 413 6650 continue 414 iadn33(2,2,2) = 0.5 415 iadn22(2,4) = 0.5 416 iadn12(8) = 0.5 417 radn11(8) = ( iadn33(2,2,2) + iadn22(2,4) + iadn12(8) ) * 2. 418 icon01 = 0 419 if ( radn11(8) .eq. 3 ) icon01 = 1 420 go to 46650 42136650 ivdele = ivdele + 1 422 write (i02,80003) ivtnum 423 if (iczero) 46650, 6661, 46650 42446650 if ( icon01 - 1 ) 26650, 16650, 26650 42516650 ivpass = ivpass + 1 426 write (i02,80001) ivtnum 427 go to 6661 42826650 ivfail = ivfail + 1 429 ivcomp = icon01 430 ivcorr = 1 431 write (i02,80004) ivtnum, ivcomp ,ivcorr 432 6661 continue 433c 434c write page footings and run summaries 43599999 continue 436 write (i02,90002) 437 write (i02,90006) 438 write (i02,90002) 439 write (i02,90002) 440 write (i02,90007) 441 write (i02,90002) 442 write (i02,90008) ivfail 443 write (i02,90009) ivpass 444 write (i02,90010) ivdele 445c 446c 447c terminate routine execution 448 stop 449c 450c format statements for page headers 45190000 format (1h1) 45290002 format (1h ) 45390001 format (1h ,10x,34hfortran compiler validation system) 45490003 format (1h ,21x,11hversion 1.0) 45590004 format (1h ,10x,38hfor official use only - copyright 1978) 45690005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) 45790006 format (1h ,5x,46h----------------------------------------------) 45890011 format (1h ,18x,17hsubset level test) 459c 460c format statements for run summaries 46190008 format (1h ,15x,i5,19h errors encountered) 46290009 format (1h ,15x,i5,13h tests passed) 46390010 format (1h ,15x,i5,14h tests deleted) 464c 465c format statements for test results 46680001 format (1h ,4x,i5,7x,4hpass) 46780002 format (1h ,4x,i5,7x,4hfail) 46880003 format (1h ,4x,i5,7x,7hdeleted) 46980004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) 47080005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) 471c 47290007 format (1h ,20x,20hend of program fm025) 473 end 474