1c comment section 2c 3c fm080 4c 5c this routine contains external function reference tests. 6c the function subprograms called by this routine are ff081, 7c ff082 and ff083. the function subprograms are defined as 8c ff081 = integer, ff082 = real, ff083 = implicit real. 9c the function subprogram dummy arguments must agree in order, 10c number and type with the corresponding actual arguments of the 11c main program. the arguments of the function subprograms will 12c correspond to actual argument list references of variable-name, 13c array-name, array-element-name and expression respectively. 14c 15c this routine will test the value of the function and the 16c function arguments returned following the function reference call. 17c 18c 19c references 20c american national standard programming language fortran, 21c x3.9-1978 22c 23c section 2.6, array 24c section 15.5.2, referencing external functions 25c section 17.2, events that cause entities to become defined 26 dimension iadn1a (5), iadn2a (4,4) 27 dimension radn3a (3,6,3), radn1a (10) 28 dimension iadn3a (3,4,5) 29 integer ff081 30 real ff082 31c 32c ********************************************************** 33c 34c a compiler validation system for the fortran language 35c based on specifications as defined in american national standard 36c programming language fortran x3.9-1978, has been developed by the 37c federal cobol compiler testing service. the fortran compiler 38c validation system (fcvs) consists of audit routines, their related 39c data, and an executive system. each audit routine is a fortran 40c program, subprogram or function which includes tests of specific 41c language elements and supporting procedures indicating the result 42c of executing these tests. 43c 44c this particular program/subprogram/function contains features 45c found only in the subset as defined in x3.9-1978. 46c 47c suggestions and comments should be forwarded to - 48c 49c department of the navy 50c federal cobol compiler testing service 51c washington, d.c. 20376 52c 53c ********************************************************** 54c 55c 56c 57c initialization section 58c 59c initialize constants 60c ************** 61c i01 contains the logical unit number for the card reader. 62 i01 = 5 63c i02 contains the logical unit number for the printer. 64 i02 = 6 65c system environment section 66c 67cx010 this card is replaced by contents of fexec x-010 control card. 68c the cx010 card is for overriding the program default i01 = 5 69c (unit number for card reader). 70cx011 this card is replaced by contents of fexec x-011 control card. 71c the cx011 card is for systems which require additional 72c fortran statements for files associated with cx010 above. 73c 74cx020 this card is replaced by contents of fexec x-020 control card. 75c the cx020 card is for overriding the program default i02 = 6 76c (unit number for printer). 77cx021 this card is replaced by contents of fexec x-021 control card. 78c the cx021 card is for systems which require additional 79c fortran statements for files associated with cx020 above. 80c 81 ivpass=0 82 ivfail=0 83 ivdele=0 84 iczero=0 85c 86c write page headers 87 write (i02,90000) 88 write (i02,90001) 89 write (i02,90002) 90 write (i02, 90002) 91 write (i02,90003) 92 write (i02,90002) 93 write (i02,90004) 94 write (i02,90002) 95 write (i02,90011) 96 write (i02,90002) 97 write (i02,90002) 98 write (i02,90005) 99 write (i02,90006) 100 write (i02,90002) 101c 102c test section 103c 104c external function reference - function subprogram defined as 105c integer (ff081) 106c 107 6741 continue 108 ivtnum = 674 109c 110c test 674 through 679 test the function and argument values 111c from reference of function ff081. function subprogram ff081 is 112c defined as integer. 113c 114c **** test 674 **** 115c 116c test 674 tests the function value returned from function ff081 117c 118 if (iczero) 36740,6740,36740 119 6740 continue 120 ivon0a = 0 121 ivon02 = 2 122 iadn1a (3) = 8 123 iadn1a (2) = 4 124 iadn2a (1,3) =10 125 ivon0a = ff081 (ivon02, iadn1a, iadn2a, 999) 126 go to 46740 12736740 ivdele = ivdele + 1 128 write (i02,80003) ivtnum 129 if (iczero) 46740,6751,46740 13046740 if (ivon0a - 1015) 26740,16740,26740 13116740 ivpass = ivpass + 1 132 write (i02,80001) ivtnum 133 go to 6751 13426740 ivfail = ivfail + 1 135 ivcorr = 1015 136 ivcomp = ivon0a 137 write (i02,80004) ivtnum, ivcomp, ivcorr 138 6751 continue 139 ivtnum = 675 140c 141c **** test 675 **** 142c 143c test 675 tests the return value of variable-name argument 144c ivon02. value of ivon02 should be 4. 145c 146 if (iczero) 36750,6750,36750 147 6750 continue 148 go to 46750 14936750 ivdele = ivdele + 1 150 write (i02,80003) ivtnum 151 if (iczero) 46750,6761,46750 15246750 if (ivon02 - 4) 26750,16750,26750 15316750 ivpass = ivpass + 1 154 write (i02,80001) ivtnum 155 go to 6761 15626750 ivfail = ivfail + 1 157 ivcorr = 4 158 ivcomp = ivon02 159 write (i02,80004) ivtnum, ivcomp, ivcorr 160 6761 continue 161 ivtnum = 676 162c 163c **** test 676 **** 164c 165c test 676 tests the return value of array-name argument 166c iadn1a. iadn1a (2) is incremented by 40 in function subprogram 167c and should return a value of 44. 168c 169 if (iczero) 36760,6760,36760 170 6760 continue 171 go to 46760 17236760 ivdele = ivdele + 1 173 write (i02,80003) ivtnum 174 if (iczero) 46760,6771,46760 17546760 if (iadn1a (2) - 44) 26760,16760,26760 17616760 ivpass = ivpass + 1 177 write (i02,80001) ivtnum 178 go to 6771 17926760 ivfail = ivfail + 1 180 ivcorr = 44 181 ivcomp = iadn1a (2) 182 write (i02,80004) ivtnum, ivcomp, ivcorr 183 6771 continue 184 ivtnum = 677 185c 186c **** test 677 **** 187c 188c test 677 tests the return value of array-name argument iadn1a. 189c iadn1a (3) was not modiffed by function subprogram and should 190c have a value of 8 191c 192 if (iczero) 36770,6770,36770 193 6770 continue 194 go to 46770 19536770 ivdele = ivdele + 1 196 write (i02,80003) ivtnum 197 if (iczero) 46770,6781,46770 19846770 if (iadn1a (3) - 8) 26770,16770,26770 19916770 ivpass = ivpass + 1 200 write (i02,80001) ivtnum 201 go to 6781 20226770 ivfail = ivfail + 1 203 ivcorr = 8 204 ivcomp = iadn1a (3) 205 write (i02,80004) ivtnum, ivcomp, ivcorr 206 6781 continue 207 ivtnum = 678 208c 209c **** test 678 **** 210c 211c test 678 tests the return value of array-element-name 212c iadn2a (1,3). iadn2a (1,3) was incremented by 70 in the function 213c subprogram and should contain a value of 80. 214c 215 if (iczero) 36780,6780,36780 216 6780 continue 217 go to 46780 21836780 ivdele = ivdele + 1 219 write (i02,80003) ivtnum 220 if (iczero) 46780,6791,46780 22146780 if (iadn2a (1,3) - 80) 26780,16780,26780 22216780 ivpass = ivpass + 1 223 write (i02,80001) ivtnum 224 go to 6791 22526780 ivfail = ivfail + 1 226 ivcorr = 80 227 ivcomp = iadn2a (1,3) 228 write (i02,80004) ivtnum, ivcomp, ivcorr 229 6791 continue 230 ivtnum = 679 231c 232c **** test 679 **** 233c 234c test 679 tests the value of integer function assigned 235c to a real variable. 236c 237 if (iczero) 36790,6790,36790 238 6790 continue 239 rvon0a = 0.0 240 ivon02 = 2 241 iadn1a (2) = 4 242 iadn2a (1,3) = 10 243 rvon0a = ff081 (ivon02, iadn1a, iadn2a, 999) 244 go to 46790 24536790 ivdele = ivdele + 1 246 write (i02,80003) ivtnum 247 if (iczero) 46790,6801,46790 24846790 if (rvon0a - 1014.5) 26790,16790,46791 24946791 if (rvon0a - 1015.5) 16790,16790,26790 25016790 ivpass = ivpass + 1 251 write (i02,80001) ivtnum 252 go to 6801 25326790 ivfail = ivfail + 1 254 rvcorr = 1015.0 255 rvcomp = rvon0a 256 write (i02,80005) ivtnum, rvcomp, rvcorr 257 6801 continue 258 ivtnum = 680 259c 260c external function reference - function subprogram ff082 defined as 261c real 262c 263c tests 680 thru 685 tests the function and argument values 264c from the function reference to subprogram ff082. the function 265c subprogram is defined as real. 266c 267c **** test 680 *** 268c 269c test 680 tests the value of the function ff082. value of 270c function should be 339.0. 271c 272 if (iczero) 36800,6800,36800 273 6800 continue 274 rvon01 = 2.0 275 radn3a (2,5,2) = 100.0 276 radn1a (5) = 210.5 277 rvon0a = 0.0 278 rvon0a = ff082 (rvon01, radn3a, radn1a, 26.5) 279 go to 46800 28036800 ivdele = ivdele + 1 281 write (i02, 80003) ivtnum 282 if (iczero) 46800,6811,46800 28346800 if (rvon0a - 338.5) 26800,16800,46801 28446801 if (rvon0a - 339.5) 16800,16800,26800 28516800 ivpass = ivpass + 1 286 write (i02,80001) ivtnum 287 go to 6811 28826800 ivfail = ivfail + 1 289 rvcorr = 339.0 290 rvcomp = rvon0a 291 write (i02,80005) ivtnum, rvcomp, rvcorr 292 6811 continue 293 ivtnum = 681 294c 295c **** test 681 **** 296c 297c test 681 tests the value of the variable-name argument rvon01 298c following the function reference. value of rvon01 should be 8.4. 299c 300 if (iczero) 36810,6810,36810 301 6810 continue 302 go to 46810 30336810 ivdele = ivdele + 1 304 write (i02,80003) ivtnum 305 if (iczero) 46810,6821,46810 30646810 if (rvon01 - 8.395) 26810,16810,46811 30746811 if (rvon01 - 8.405) 16810,16810,26810 30816810 ivpass = ivpass + 1 309 write (i02,80001) ivtnum 310 go to 6821 31126810 ivfail = ivfail + 1 312 rvcorr = 8.4 313 rvcomp = rvon01 314 write (i02,80005) ivtnum, rvcomp, rvcorr 315 6821 continue 316 ivtnum = 682 317c 318c **** test 682 **** 319c 320c test 682 tests the value of the array-name argument radn3a 321c following the function reference. radn3a (2,5,2) was initialized 322c in main program and incremented in subprogram. value of radn3a 323c (2,5,2) should be 112.2. 324c 325 if (iczero) 36820,6820,36820 326 6820 continue 327 go to 46820 32836820 ivdele = ivdele + 1 329 write (i02,80003) ivtnum 330 if (iczero) 46820,6831,46820 33146820 if (radn3a (2,5,2) - 111.7) 26820,16820,46821 33246821 if (radn3a (2,5,2) - 112.7) 16820,16820,26820 33316820 ivpass = ivpass + 1 334 write (i02,80001) ivtnum 335 go to 6831 33626820 ivfail = ivfail + 1 337 rvcorr = 112.2 338 rvcomp = radn3a (2,5,2) 339 write (i02,80005) ivtnum, rvcomp, rvcorr 340 6831 continue 341 ivtnum = 683 342c 343c **** test 683 **** 344c 345c test 683 tests the value of the array-name argument radn3a 346c following the function reference. radn3a (1,2,1) was initialized 347c in the subprogram. the value of radn3a (1,2,1) should be 612.2. 348c 349 if (iczero) 36830,6830,36830 350 6830 continue 351 go to 46830 35236830 ivdele = ivdele + 1 353 write (i02,80003) ivtnum 354 if (iczero) 46830,6841,46830 35546830 if (radn3a (1,2,1) - 611.7) 26830,16830,46831 35646831 if (radn3a (1,2,1) - 612.7) 16830,16830,26830 35716830 ivpass = ivpass + 1 358 write (i02,80001) ivtnum 359 go to 6841 36026830 ivfail = ivfail + 1 361 rvcorr = 612.2 362 rvcomp = radn3a (1,2,1) 363 write (i02,80005) ivtnum, rvcomp, rvcorr 364 6841 continue 365 ivtnum = 684 366c 367c **** test 684 **** 368c 369c test 684 tests the value of the array-element-name argument 370c radn1a following the function reference. radn1a (5) was 371c initialized in the main program and incremented by 18.8 in the 372c function subprogram. the value of radn1a should be 229.3. 373c 374 if (iczero) 36840,6840,36840 375 6840 continue 376 go to 46840 37736840 ivdele = ivdele + 1 378 write (i02,80003) ivtnum 379 if (iczero) 46840,6851,46840 38046840 if (radn1a (5) - 228.8) 26840,16840,46841 38146841 if (radn1a (5) - 229.8) 16840,16840,26840 38216840 ivpass = ivpass + 1 383 write (i02,80001) ivtnum 384 go to 6851 38526840 ivfail = ivfail + 1 386 rvcorr = 229.3 387 rvcomp = radn1a (5) 388 write (i02,80005) ivtnum, rvcomp, rvcorr 389 6851 continue 390 ivtnum = 685 391c 392c **** test 685 **** 393c 394c test 685 tests the resultant value where the function 395c subprogram is defined as real and the variable to which the 396c function value is assigned in the main program is defined as 397c integer. 398c 399 if (iczero) 36850,6850,36850 400 6850 continue 401 rvon01 = 4.0 402 radn3a (2,5,2) = 200.0 403 radn1a (5) = 2.85 404 ivon0a = 0.0 405 ivon0a = ff082 (rvon01, radn3a, radn1a, 102.68) 406 go to 46850 40736850 ivdele = ivdele + 1 408 write (i02,80003) ivtnum 409 if (iczero) 46850,6861,46850 41046850 if (ivon0a - 309) 26850,16850,26850 41116850 ivpass = ivpass + 1 412 write (i02,80001) ivtnum 413 go to 6861 41426850 ivfail = ivfail + 1 415 ivcorr = 309 416 ivcomp = ivon0a 417 write (i02,80004) ivtnum, ivcomp, ivcorr 418 6861 continue 419 ivtnum = 686 420c 421c tests 686 thru 690 tests the function and argument values 422c from the external function reference to subprogram ff083. the 423c function subprogram is an implicit definition of real. 424c 425c ***** test 686 ***** 426c 427c test 686 tests the value of function ff082. the value of the 428c function should be 921.8. 429c 430 if (iczero) 36860,6860,36860 431 6860 continue 432c 433c 434 ivon01 = 826 435 iadn2a (1,1) = 77 436 iadn3a (2,3,4) = 10 437 rvon02 = 4.4 438 rvon03 = 0.0 439c 440 rvon03 = ff083 (ivon01, iadn2a, iadn3a, rvon02 * 2.0) 441 go to 46860 44236860 ivdele = ivdele + 1 443 write (i02,80003) ivtnum 444 if (iczero) 46860,6871,46860 44546860 if (rvon03 - 921.3) 26860,16860,46861 44646861 if (rvon03 - 922.3) 16860,16860,26860 44716860 ivpass = ivpass + 1 448 write (i02,80001) ivtnum 449 go to 6871 45026860 ivfail = ivfail + 1 451 rvcorr = 921.8 452 rvcomp = rvon03 453 write (i02,80005) ivtnum, rvcomp, ivcorr 454 6871 continue 455 ivtnum = 687 456c 457c **** test 687 ***** 458c 459c test 687 tests the value of the variable-name argument ivon01 460c following the function reference. the value of ivon01 should be 461c 836. 462c 463 if (iczero) 36870,6870,36870 464 6870 continue 465 go to 46870 46636870 ivdele = ivdele + 1 467 write (i02,80003) ivtnum 468 if (iczero) 46870,6881,46870 46946870 if (ivon01 - 836) 26870,16870,26870 47016870 ivpass = ivpass + 1 471 write (i02,80001) ivtnum 472 go to 6881 47326870 ivfail = ivfail + 1 474 ivcorr = 836 475 ivcomp = ivon01 476 write (i02,80004) ivtnum, ivcomp, ivcorr 477 6881 continue 478 ivtnum = 688 479c 480c **** test 688 ***** 481c 482c test 688 tests the value of the array-name argument iadn2a 483c following the function reference. the actual argument was 484c initialized in the main program and is incremented in the 485c subprogram. the value of iadn2a (1,1) should be 97. 486c 487 if (iczero) 36880,6880,36880 488 6880 continue 489 go to 46880 49036880 ivdele = ivdele + 1 491 write (i02,80003) ivtnum 492 if (iczero) 46880,6880,46880 49346880 if (iadn2a (1,1) - 97) 26880,16880,26880 49416880 ivpass = ivpass + 1 495 write (i02,80001) ivtnum 496 go to 6891 49726880 ivfail = ivfail + 1 498 ivcorr = 97 499 ivcomp = iadn2a (1,1) 500 write (i02,80004) ivtnum, ivcomp, ivcorr 501 6891 continue 502 ivtnum = 689 503c 504c **** test 689 **** 505c 506c test 689 tests the value of the array-element-name argument 507c iadn3a following the function reference. iadn3a (2,3,4) 508c was intialized in the main program and incremented by 40 in the 509c function subprogram. the value of iadn3a should be 50. 510c 511 if (iczero) 36890,6890,36890 512 6890 continue 513 go to 46890 51436890 ivdele = ivdele + 1 515 write (i02,80003) ivtnum 516 if (iczero) 46890,6901,46890 51746890 if (iadn3a (2,3,4) - 50) 26890,16890,26890 51816890 ivpass = ivpass + 1 519 write (i02,80001) ivtnum 520 go to 6901 52126890 ivfail = ivfail + 1 522 ivcorr = 50 523 ivcomp = iadn3a (2,3,4) 524 write (i02,80004) ivtnum,ivcomp,ivcorr 525 6901 continue 526 ivtnum = 690 527c 528c **** test 690 **** 529c 530c test 690 tests the resultant value where the function 531c subprogram is implicity defined as real and the variable 532c to which the function value is assigned in the main program 533c is defined as integer. the value of ivon03 should be 329. 534c 535 if (iczero) 36900,6900,36900 536 6900 continue 537 ivon01 = 226 538 iadn2a (1,1) = 66 539 iadn3a (2,3,4) = 20 540 rvon02 = 8.8 541 ivon03 = 0 542c 543 ivon03 = ff083 (ivon01,iadn2a,iadn3a,rvon02 * 2.0) 544c 545 go to 46900 54636900 ivdele = ivdele + 1 547 write (i02,80003) ivtnum 548 if (iczero) 46900,6911,46900 54946900 if (ivon03 - 329) 26900,16900,26900 55016900 ivpass = ivpass + 1 551 write (i02,80001) ivtnum 552 go to 6911 55326900 ivfail = ivfail + 1 554 ivcorr = 329 555 ivcomp = ivon03 556 write (i02,80004) ivtnum, ivcomp, ivcorr 557 6911 continue 558c 559c write page footings and run summaries 56099999 continue 561 write (i02,90002) 562 write (i02,90006) 563 write (i02,90002) 564 write (i02,90002) 565 write (i02,90007) 566 write (i02,90002) 567 write (i02,90008) ivfail 568 write (i02,90009) ivpass 569 write (i02,90010) ivdele 570c 571c 572c terminate routine execution 573 stop 574c 575c format statements for page headers 57690000 format (1h1) 57790002 format (1h ) 57890001 format (1h ,10x,34hfortran compiler validation system) 57990003 format (1h ,21x,11hversion 1.0) 58090004 format (1h ,10x,38hfor official use only - copyright 1978) 58190005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) 58290006 format (1h ,5x,46h----------------------------------------------) 58390011 format (1h ,18x,17hsubset level test) 584c 585c format statements for run summaries 58690008 format (1h ,15x,i5,19h errors encountered) 58790009 format (1h ,15x,i5,13h tests passed) 58890010 format (1h ,15x,i5,14h tests deleted) 589c 590c format statements for test results 59180001 format (1h ,4x,i5,7x,4hpass) 59280002 format (1h ,4x,i5,7x,4hfail) 59380003 format (1h ,4x,i5,7x,7hdeleted) 59480004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) 59580005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) 596c 59790007 format (1h ,20x,20hend of program fm080) 598 end 599