1c 2c comment section. 3c 4c fm020 5c 6c this routine tests the fortran in-line statement function 7c of type logical and integer. integer constants, logical constants 8c integer variables, logical variables, integer arithmetic express- 9c ions are all used to test the statement function definition and 10c the value returned for the statement function when it is used 11c in the main body of the program. 12c 13c references 14c american national standard programming language fortran, 15c x3.9-1978 16c 17c section 8.4.1, integer, real, double precision, complex, and 18c logical type-statements 19c section 15.3.2, intrinsic function references 20c section 15.4, statement functions 21c section 15.4.1, forms of a function statement 22c section 15.4.2, referencing a statement function 23c section 15.5.2, external function references 24c 25 logical lftn01, ldtn01 26 logical lftn02, ldtn02 27 logical lftn03, ldtn03, lctn03 28 logical lftn04, ldtn04, lctn04 29 dimension iadn11(2) 30c 31c..... test 553 32 ifon01(idon01) = 32767 33c 34c..... test 554 35 lftn01(ldtn01) = .true. 36c 37c..... test 555 38 ifon02 ( idon02 ) = idon02 39c 40c..... test 556 41 lftn02( ldtn02 ) = ldtn02 42c 43c..... test 557 44 ifon03 (idon03 )= idon03 45c 46c..... test 558 47 lftn03(ldtn03) = ldtn03 48c 49c..... test 559 50 lftn04(ldtn04) = .not. ldtn04 51c 52c..... test 560 53 ifon04(idon04) = idon04 ** 2 54c 55c..... test 561 56 ifon05(idon05, idon06) = idon05 + idon06 57c 58c..... test 562 59 ifon06(idon07, idon08) = sqrt(float(idon07**2)+float(idon08**2)) 60c 61c..... test 563 62 ifon07(idon09) = idon09 ** 2 63 ifon08(i,j)=sqrt(float(ifon07(i))+float(ifon07(j))) 64c 65c..... test 564 66 ifon09(k,l) = k / l + k ** l - k * l 67c 68c 69c 70c ********************************************************** 71c 72c a compiler validation system for the fortran language 73c based on specifications as defined in american national standard 74c programming language fortran x3.9-1978, has been developed by the 75c federal cobol compiler testing service. the fortran compiler 76c validation system (fcvs) consists of audit routines, their related 77c data, and an executive system. each audit routine is a fortran 78c program, subprogram or function which includes tests of specific 79c language elements and supporting procedures indicating the result 80c of executing these tests. 81c 82c this particular program/subprogram/function contains features 83c found only in the subset as defined in x3.9-1978. 84c 85c suggestions and comments should be forwarded to - 86c 87c department of the navy 88c federal cobol compiler testing service 89c washington, d.c. 20376 90c 91c ********************************************************** 92c 93c 94c 95c initialization section 96c 97c initialize constants 98c ************** 99c i01 contains the logical unit number for the card reader. 100 i01 = 5 101c i02 contains the logical unit number for the printer. 102 i02 = 6 103c system environment section 104c 105cx010 this card is replaced by contents of fexec x-010 control card. 106c the cx010 card is for overriding the program default i01 = 5 107c (unit number for card reader). 108cx011 this card is replaced by contents of fexec x-011 control card. 109c the cx011 card is for systems which require additional 110c fortran statements for files associated with cx010 above. 111c 112cx020 this card is replaced by contents of fexec x-020 control card. 113c the cx020 card is for overriding the program default i02 = 6 114c (unit number for printer). 115cx021 this card is replaced by contents of fexec x-021 control card. 116c the cx021 card is for systems which require additional 117c fortran statements for files associated with cx020 above. 118c 119 ivpass=0 120 ivfail=0 121 ivdele=0 122 iczero=0 123c 124c write page headers 125 write (i02,90000) 126 write (i02,90001) 127 write (i02,90002) 128 write (i02, 90002) 129 write (i02,90003) 130 write (i02,90002) 131 write (i02,90004) 132 write (i02,90002) 133 write (i02,90011) 134 write (i02,90002) 135 write (i02,90002) 136 write (i02,90005) 137 write (i02,90006) 138 write (i02,90002) 139 ivtnum = 553 140c 141c **** test 553 **** 142c test 553 - the value of the integer function is set to a 143c constant of 32767 regardless of the value of the arguement 144c supplied to the dummy arguement. test of positive integer 145c constants for a statement function. 146c 147c 148 if (iczero) 35530, 5530, 35530 149 5530 continue 150 ivcomp = ifon01(3) 151 go to 45530 15235530 ivdele = ivdele + 1 153 write (i02,80003) ivtnum 154 if (iczero) 45530, 5541, 45530 15545530 if ( ivcomp - 32767 ) 25530, 15530, 25530 15615530 ivpass = ivpass + 1 157 write (i02,80001) ivtnum 158 go to 5541 15925530 ivfail = ivfail + 1 160 ivcorr = 32767 161 write (i02,80004) ivtnum, ivcomp ,ivcorr 162 5541 continue 163 ivtnum = 554 164c 165c **** test 554 **** 166c test 554 - test of the statement function of type logical 167c set to the logical constant .true. regardless of the 168c arguement supplied to the dummy arguement. 169c a logical if statement is used in conjunction with the logical 170c statement function. the true path is tested. 171c 172c 173 if (iczero) 35540, 5540, 35540 174 5540 continue 175 ivon01 = 0 176 if ( lftn01(.false.) ) ivon01 = 1 177 go to 45540 17835540 ivdele = ivdele + 1 179 write (i02,80003) ivtnum 180 if (iczero) 45540, 5551, 45540 18145540 if ( ivon01 - 1 ) 25540, 15540, 25540 18215540 ivpass = ivpass + 1 183 write (i02,80001) ivtnum 184 go to 5551 18525540 ivfail = ivfail + 1 186 ivcomp = ivon01 187 ivcorr = 1 188 write (i02,80004) ivtnum, ivcomp ,ivcorr 189 5551 continue 190 ivtnum = 555 191c 192c **** test 555 **** 193c test 555 - the integer statement function is set to the value 194c of the argeument supplied. 195c 196c 197 if (iczero) 35550, 5550, 35550 198 5550 continue 199 ivcomp = ifon02 ( 32767 ) 200 go to 45550 20135550 ivdele = ivdele + 1 202 write (i02,80003) ivtnum 203 if (iczero) 45550, 5561, 45550 20445550 if ( ivcomp - 32767 ) 25550, 15550, 25550 20515550 ivpass = ivpass + 1 206 write (i02,80001) ivtnum 207 go to 5561 20825550 ivfail = ivfail + 1 209 ivcorr = 32767 210 write (i02,80004) ivtnum, ivcomp ,ivcorr 211 5561 continue 212 ivtnum = 556 213c 214c **** test 556 **** 215c test 556 - test of a logical statement function set to the 216c value of the arguement supplied. the false path of a logical 217c if statement is used in conjunction with the logical 218c statement function. 219c 220c 221 if (iczero) 35560, 5560, 35560 222 5560 continue 223 ivon01 = 1 224 if ( lftn02(.false.) ) ivon01 = 0 225 go to 45560 22635560 ivdele = ivdele + 1 227 write (i02,80003) ivtnum 228 if (iczero) 45560, 5571, 45560 22945560 if ( ivon01 - 1 ) 25560, 15560, 25560 23015560 ivpass = ivpass + 1 231 write (i02,80001) ivtnum 232 go to 5571 23325560 ivfail = ivfail + 1 234 ivcomp = ivon01 235 ivcorr = 1 236 write (i02,80004) ivtnum, ivcomp ,ivcorr 237 5571 continue 238 ivtnum = 557 239c 240c **** test 557 **** 241c test 557 - the value of an integer function is set equal to 242c value of the arguement supplied. this value is an integer 243c variable set to 32767. 244c 245c 246 if (iczero) 35570, 5570, 35570 247 5570 continue 248 icon01 = 32767 249 ivcomp = ifon03 ( icon01 ) 250 go to 45570 25135570 ivdele = ivdele + 1 252 write (i02,80003) ivtnum 253 if (iczero) 45570, 5581, 45570 25445570 if ( ivcomp - 32767 ) 25570, 15570, 25570 25515570 ivpass = ivpass + 1 256 write (i02,80001) ivtnum 257 go to 5581 25825570 ivfail = ivfail + 1 259 ivcorr = 32767 260 write (i02,80004) ivtnum, ivcomp ,ivcorr 261 5581 continue 262 ivtnum = 558 263c 264c **** test 558 **** 265c test 558 - a logical statement function is set equal to the 266c value of the arguement supplied. this value is a logical 267c variable set to .true. the true path of a logical if 268c statement is used in conjunction with the logical statement 269c function. 270c 271c 272 if (iczero) 35580, 5580, 35580 273 5580 continue 274 ivon01 = 0 275 lctn03 = .true. 276 if ( lftn03(lctn03) ) ivon01 = 1 277 go to 45580 27835580 ivdele = ivdele + 1 279 write (i02,80003) ivtnum 280 if (iczero) 45580, 5591, 45580 28145580 if ( ivon01 - 1 ) 25580, 15580, 25580 28215580 ivpass = ivpass + 1 283 write (i02,80001) ivtnum 284 go to 5591 28525580 ivfail = ivfail + 1 286 ivcomp = ivon01 287 ivcorr = 1 288 write (i02,80004) ivtnum, ivcomp ,ivcorr 289 5591 continue 290 ivtnum = 559 291c 292c **** test 559 **** 293c test 559 - like test 558 only the logical .not. is used 294c in the logical statement function definition the false path 295c of a logical if statement is used in conjunction with the 296c logical statement function. 297c 298c 299 if (iczero) 35590, 5590, 35590 300 5590 continue 301 ivon01 = 1 302 lctn04 = .true. 303 if ( lftn04(lctn04) ) ivon01 = 0 304 go to 45590 30535590 ivdele = ivdele + 1 306 write (i02,80003) ivtnum 307 if (iczero) 45590, 5601, 45590 30845590 if ( ivon01 - 1 ) 25590, 15590, 25590 30915590 ivpass = ivpass + 1 310 write (i02,80001) ivtnum 311 go to 5601 31225590 ivfail = ivfail + 1 313 ivcomp = ivon01 314 ivcorr = 1 315 write (i02,80004) ivtnum, ivcomp ,ivcorr 316 5601 continue 317 ivtnum = 560 318c 319c **** test 560 **** 320c test 560 - integer exponientiation used in an integer 321c statement function. 322c 323c 324 if (iczero) 35600, 5600, 35600 325 5600 continue 326 icon04 = 3 327 ivcomp = ifon04(icon04) 328 go to 45600 32935600 ivdele = ivdele + 1 330 write (i02,80003) ivtnum 331 if (iczero) 45600, 5611, 45600 33245600 if ( ivcomp - 9 ) 25600, 15600, 25600 33315600 ivpass = ivpass + 1 334 write (i02,80001) ivtnum 335 go to 5611 33625600 ivfail = ivfail + 1 337 ivcorr = 9 338 write (i02,80004) ivtnum, ivcomp ,ivcorr 339 5611 continue 340 ivtnum = 561 341c 342c **** test 561 **** 343c test 561 - test of integer addition using two (2) dummy 344c arguements. 345c 346c 347 if (iczero) 35610, 5610, 35610 348 5610 continue 349 icon05 = 9 350 icon06 = 16 351 ivcomp = ifon05(icon05, icon06) 352 go to 45610 35335610 ivdele = ivdele + 1 354 write (i02,80003) ivtnum 355 if (iczero) 45610, 5621, 45610 35645610 if ( ivcomp - 25 ) 25610, 15610, 25610 35715610 ivpass = ivpass + 1 358 write (i02,80001) ivtnum 359 go to 5621 36025610 ivfail = ivfail + 1 361 ivcorr = 25 362 write (i02,80004) ivtnum, ivcomp ,ivcorr 363 5621 continue 364 ivtnum = 562 365c 366c **** test 562 **** 367c test 562 - this test is the solution of a right triangle 368c using integer statement functions which reference the 369c intrinsic functions sqrt and float. this is a 3-4-5 370c right triangle. 371c 372c 373 if (iczero) 35620, 5620, 35620 374 5620 continue 375 icon07 = 3 376 icon08 = 4 377 ivcomp = ifon06(icon07, icon08) 378 go to 45620 37935620 ivdele = ivdele + 1 380 write (i02,80003) ivtnum 381 if (iczero) 45620, 5631, 45620 38245620 if ( ivcomp - 5 ) 5622, 15620, 5622 383 5622 if ( ivcomp - 4 ) 25620, 15620, 25620 38415620 ivpass = ivpass + 1 385 write (i02,80001) ivtnum 386 go to 5631 38725620 ivfail = ivfail + 1 388 ivcorr = 5 389 write (i02,80004) ivtnum, ivcomp ,ivcorr 390 5631 continue 391 ivtnum = 563 392c 393c **** test 563 **** 394c test 563 - solution of a 3-4-5 right triangle like test 562 395c except that both intrinsic and previously defined statement 396c functions are used. 397c 398c 399 if (iczero) 35630, 5630, 35630 400 5630 continue 401 icon09 = 3 402 icon10 = 4 403 ivcomp = ifon08(icon09, icon10) 404 go to 45630 40535630 ivdele = ivdele + 1 406 write (i02,80003) ivtnum 407 if (iczero) 45630, 5641, 45630 40845630 if ( ivcomp - 5 ) 5632, 15630, 5632 409 5632 if ( ivcomp - 4 ) 25630, 15630, 25630 41015630 ivpass = ivpass + 1 411 write (i02,80001) ivtnum 412 go to 5641 41325630 ivfail = ivfail + 1 414 ivcorr = 5 415 write (i02,80004) ivtnum, ivcomp ,ivcorr 416 5641 continue 417 ivtnum = 564 418c 419c **** test 564 **** 420c test 564 - use of array elements in an integer statement 421c function which uses the operations of + - * / . 422c 423c 424 if (iczero) 35640, 5640, 35640 425 5640 continue 426 iadn11(1) = 2 427 iadn11(2) = 2 428 ivcomp = ifon09( iadn11(1), iadn11(2) ) 429 go to 45640 43035640 ivdele = ivdele + 1 431 write (i02,80003) ivtnum 432 if (iczero) 45640, 5651, 45640 43345640 if ( ivcomp - 1 ) 25640, 15640, 25640 43415640 ivpass = ivpass + 1 435 write (i02,80001) ivtnum 436 go to 5651 43725640 ivfail = ivfail + 1 438 ivcorr = 1 439 write (i02,80004) ivtnum, ivcomp ,ivcorr 440 5651 continue 441c 442c write page footings and run summaries 44399999 continue 444 write (i02,90002) 445 write (i02,90006) 446 write (i02,90002) 447 write (i02,90002) 448 write (i02,90007) 449 write (i02,90002) 450 write (i02,90008) ivfail 451 write (i02,90009) ivpass 452 write (i02,90010) ivdele 453c 454c 455c terminate routine execution 456 stop 457c 458c format statements for page headers 45990000 format (1h1) 46090002 format (1h ) 46190001 format (1h ,10x,34hfortran compiler validation system) 46290003 format (1h ,21x,11hversion 1.0) 46390004 format (1h ,10x,38hfor official use only - copyright 1978) 46490005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) 46590006 format (1h ,5x,46h----------------------------------------------) 46690011 format (1h ,18x,17hsubset level test) 467c 468c format statements for run summaries 46990008 format (1h ,15x,i5,19h errors encountered) 47090009 format (1h ,15x,i5,13h tests passed) 47190010 format (1h ,15x,i5,14h tests deleted) 472c 473c format statements for test results 47480001 format (1h ,4x,i5,7x,4hpass) 47580002 format (1h ,4x,i5,7x,4hfail) 47680003 format (1h ,4x,i5,7x,7hdeleted) 47780004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) 47880005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) 479c 48090007 format (1h ,20x,20hend of program fm020) 481 end 482