1c 2c comment section 3c 4c fm050 5c 6c this routine contains basic subroutine and function reference 7c tests. four subroutines and one function are called or 8c referenced. fs051 is called to test the calling and passing of 9c arguments through unlabeled common. no arguments are specified 10c in the call line. fs052 is identical to fs051 except that several 11c returns are used. fs053 utilizes many arguments on the call 12c statement and many return statements in the subroutine body. 13c ff054 is a function subroutine in which many arguments and return 14c statements are used. and finally fs055 passes a one dimenional 15c array back to fm050. 16c 17c references 18c american national standard programming language fortran, 19c x3.9-1978 20c 21c section 15.5.2, referencing an external function 22c section 15.6.2, subroutine reference 23c 24 common rvcn01,ivcn01,ivcn02,iacn11(20) 25 integer ff054 26c 27c ********************************************************** 28c 29c a compiler validation system for the fortran language 30c based on specifications as defined in american national standard 31c programming language fortran x3.9-1978, has been developed by the 32c federal cobol compiler testing service. the fortran compiler 33c validation system (fcvs) consists of audit routines, their related 34c data, and an executive system. each audit routine is a fortran 35c program, subprogram or function which includes tests of specific 36c language elements and supporting procedures indicating the result 37c of executing these tests. 38c 39c this particular program/subprogram/function contains features 40c found only in the subset as defined in x3.9-1978. 41c 42c suggestions and comments should be forwarded to - 43c 44c department of the navy 45c federal cobol compiler testing service 46c washington, d.c. 20376 47c 48c ********************************************************** 49c 50c 51c 52c initialization section 53c 54c initialize constants 55c ************** 56c i01 contains the logical unit number for the card reader. 57 i01 = 5 58c i02 contains the logical unit number for the printer. 59 i02 = 6 60c system environment section 61c 62cx010 this card is replaced by contents of fexec x-010 control card. 63c the cx010 card is for overriding the program default i01 = 5 64c (unit number for card reader). 65cx011 this card is replaced by contents of fexec x-011 control card. 66c the cx011 card is for systems which require additional 67c fortran statements for files associated with cx010 above. 68c 69cx020 this card is replaced by contents of fexec x-020 control card. 70c the cx020 card is for overriding the program default i02 = 6 71c (unit number for printer). 72cx021 this card is replaced by contents of fexec x-021 control card. 73c the cx021 card is for systems which require additional 74c fortran statements for files associated with cx020 above. 75c 76 ivpass=0 77 ivfail=0 78 ivdele=0 79 iczero=0 80c 81c write page headers 82 write (i02,90000) 83 write (i02,90001) 84 write (i02,90002) 85 write (i02, 90002) 86 write (i02,90003) 87 write (i02,90002) 88 write (i02,90004) 89 write (i02,90002) 90 write (i02,90011) 91 write (i02,90002) 92 write (i02,90002) 93 write (i02,90005) 94 write (i02,90006) 95 write (i02,90002) 96c test section 97c 98c subroutine and function subprograms 99c 100 4001 continue 101 ivtnum = 400 102c 103c **** test 400 **** 104c test 400 tests the call to a subroutine containing no arguments. 105c all parameters are passed through unlabeled common. 106c 107 if (iczero) 34000, 4000, 34000 108 4000 continue 109 rvcn01 = 2.1654 110 call fs051 111 rvcomp = rvcn01 112 go to 44000 11334000 ivdele = ivdele + 1 114 write (i02,80003) ivtnum 115 if (iczero) 44000, 4011, 44000 11644000 if (rvcomp - 3.1649) 24000,14000,44001 11744001 if (rvcomp - 3.1659) 14000,14000,24000 11814000 ivpass = ivpass + 1 119 write (i02,80001) ivtnum 120 go to 4011 12124000 ivfail = ivfail + 1 122 rvcorr = 3.1654 123 write (i02,80005) ivtnum, rvcomp, rvcorr 124 4011 continue 125c 126c test 401 through test 403 test the call to subroutine fs052 which 127c contains no arguments. all parameters are passed through 128c unlabeled common. subroutine fs052 contain several return 129c statements. 130c 131 ivtnum = 401 132c 133c **** test 401 **** 134c 135 if (iczero) 34010, 4010, 34010 136 4010 continue 137 ivcn01 = 5 138 ivcn02 = 1 139 call fs052 140 ivcomp = ivcn01 141 go to 44010 14234010 ivdele = ivdele + 1 143 write (i02,80003) ivtnum 144 if (iczero) 44010, 4021, 44010 14544010 if (ivcomp - 6) 24010,14010,24010 14614010 ivpass = ivpass + 1 147 write (i02,80001) ivtnum 148 go to 4021 14924010 ivfail = ivfail + 1 150 ivcorr = 6 151 write (i02,80004) ivtnum, ivcomp ,ivcorr 152 4021 continue 153 ivtnum = 402 154c 155c **** test 402 **** 156c 157 if (iczero) 34020, 4020, 34020 158 4020 continue 159 ivcn01 = 10 160 ivcn02 = 5 161 call fs052 162 ivcomp = ivcn01 163 go to 44020 16434020 ivdele = ivdele + 1 165 write (i02,80003) ivtnum 166 if (iczero) 44020, 4031, 44020 16744020 if (ivcomp - 15) 24020,14020,24020 16814020 ivpass = ivpass + 1 169 write (i02,80001) ivtnum 170 go to 4031 17124020 ivfail = ivfail + 1 172 ivcorr = 15 173 write (i02,80004) ivtnum, ivcomp ,ivcorr 174 4031 continue 175 ivtnum = 403 176c 177c **** test 403 **** 178c 179 if (iczero) 34030, 4030, 34030 180 4030 continue 181 ivcn01 = 30 182 ivcn02 = 3 183 call fs052 184 ivcomp = ivcn01 185 go to 44030 18634030 ivdele = ivdele + 1 187 write (i02,80003) ivtnum 188 if (iczero) 44030, 4041, 44030 18944030 if (ivcomp - 33) 24030,14030,24030 19014030 ivpass = ivpass + 1 191 write (i02,80001) ivtnum 192 go to 4041 19324030 ivfail = ivfail + 1 194 ivcorr = 33 195 write (i02,80004) ivtnum, ivcomp ,ivcorr 196 4041 continue 197c 198c test 404 through test 406 test the call to subroutine fs053 which 199c contains several arguments and several return statements. 200c 201 ivtnum = 404 202c 203c **** test 404 **** 204c 205 if (iczero) 34040, 4040, 34040 206 4040 continue 207 call fs053 (6,10,11,ivon04,1) 208 ivcomp = ivon04 209 go to 44040 21034040 ivdele = ivdele + 1 211 write (i02,80003) ivtnum 212 if (iczero) 44040, 4051, 44040 21344040 if (ivcomp - 6) 24040,14040,24040 21414040 ivpass = ivpass + 1 215 write (i02,80001) ivtnum 216 go to 4051 21724040 ivfail = ivfail + 1 218 ivcorr = 6 219 write (i02,80004) ivtnum, ivcomp ,ivcorr 220 4051 continue 221 ivtnum = 405 222c 223c **** test 405 **** 224c 225 if (iczero) 34050, 4050, 34050 226 4050 continue 227 ivcn01 = 10 228 call fs053 (6,ivcn01,11,ivon04,2) 229 ivcomp = ivon04 230 go to 44050 23134050 ivdele = ivdele + 1 232 write (i02,80003) ivtnum 233 if (iczero) 44050, 4061, 44050 23444050 if (ivcomp - 16) 24050,14050,24050 23514050 ivpass = ivpass + 1 236 write (i02,80001) ivtnum 237 go to 4061 23824050 ivfail = ivfail + 1 239 ivcorr = 16 240 write (i02,80004) ivtnum, ivcomp ,ivcorr 241 4061 continue 242 ivtnum = 406 243c 244c **** test 406 **** 245c 246 if (iczero) 34060, 4060, 34060 247 4060 continue 248 ivon01 = 6 249 ivon02 = 10 250 ivon03 = 11 251 ivon05 = 3 252 call fs053 (ivon01,ivon02,ivon03,ivon04,ivon05) 253 ivcomp = ivon04 254 go to 44060 25534060 ivdele = ivdele + 1 256 write (i02,80003) ivtnum 257 if (iczero) 44060, 4071, 44060 25844060 if (ivcomp - 27) 24060,14060,24060 25914060 ivpass = ivpass + 1 260 write (i02,80001) ivtnum 261 go to 4071 26224060 ivfail = ivfail + 1 263 ivcorr = 27 264 write (i02,80004) ivtnum, ivcomp ,ivcorr 265 4071 continue 266c 267c test 407 through 409 test the reference to function ff054 which 268c contains several arguments and several return statements 269c 270 ivtnum = 407 271c 272c **** test 407 **** 273c 274 if (iczero) 34070, 4070, 34070 275 4070 continue 276 ivcomp = ff054 (300,1,21,1) 277 go to 44070 27834070 ivdele = ivdele + 1 279 write (i02,80003) ivtnum 280 if (iczero) 44070, 4081, 44070 28144070 if (ivcomp - 300) 24070,14070,24070 28214070 ivpass = ivpass + 1 283 write (i02,80001) ivtnum 284 go to 4081 28524070 ivfail = ivfail + 1 286 ivcorr = 300 287 write (i02,80004) ivtnum, ivcomp ,ivcorr 288 4081 continue 289 ivtnum = 408 290c 291c **** test 408 **** 292c 293 if (iczero) 34080, 4080, 34080 294 4080 continue 295 ivon01 = 300 296 ivon04 = 2 297 ivcomp = ff054 (ivon01,77,5,ivon04) 298 go to 44080 29934080 ivdele = ivdele + 1 300 write (i02,80003) ivtnum 301 if (iczero) 44080, 4091, 44080 30244080 if (ivcomp - 377) 24080,14080,24080 30314080 ivpass = ivpass + 1 304 write (i02,80001) ivtnum 305 go to 4091 30624080 ivfail = ivfail + 1 307 ivcorr = 377 308 write (i02,80004) ivtnum, ivcomp ,ivcorr 309 4091 continue 310 ivtnum = 409 311c 312c **** test 409 **** 313c 314 if (iczero) 34090, 4090, 34090 315 4090 continue 316 ivon01 = 71 317 ivon02 = 21 318 ivon03 = 17 319 ivon04 = 3 320 ivcomp = ff054 (ivon01,ivon02,ivon03,ivon04) 321 go to 44090 32234090 ivdele = ivdele + 1 323 write (i02,80003) ivtnum 324 if (iczero) 44090, 4101, 44090 32544090 if (ivcomp - 109) 24090,14090,24090 32614090 ivpass = ivpass + 1 327 write (i02,80001) ivtnum 328 go to 4101 32924090 ivfail = ivfail + 1 330 ivcorr = 109 331 write (i02,80004) ivtnum, ivcomp ,ivcorr 332 4101 continue 333c 334c test 410 through 429 test the call to subroutine fs055 which 335c contains no arguments. the parameters are passed through an 336c integer array variable in unlabeled common. 337c 338 call fs055 339 do 20 i = 1,20 340 if (iczero) 34100, 4100, 34100 341 4100 continue 342 ivtnum = 409 + i 343 ivcomp = iacn11(i) 344 go to 44100 34534100 ivdele = ivdele + 1 346 write (i02,80003) ivtnum 347 if (iczero) 44100, 4111, 44100 34844100 if (ivcomp - i) 24100,14100,24100 34914100 ivpass = ivpass + 1 350 write (i02,80001) ivtnum 351 go to 4111 35224100 ivfail = ivfail + 1 353 ivcorr = i 354 write (i02,80004) ivtnum, ivcomp ,ivcorr 355 4111 continue 35620 continue 357c 358c write page footings and run summaries 35999999 continue 360 write (i02,90002) 361 write (i02,90006) 362 write (i02,90002) 363 write (i02,90002) 364 write (i02,90007) 365 write (i02,90002) 366 write (i02,90008) ivfail 367 write (i02,90009) ivpass 368 write (i02,90010) ivdele 369c 370c 371c terminate routine execution 372 stop 373c 374c format statements for page headers 37590000 format (1h1) 37690002 format (1h ) 37790001 format (1h ,10x,34hfortran compiler validation system) 37890003 format (1h ,21x,11hversion 1.0) 37990004 format (1h ,10x,38hfor official use only - copyright 1978) 38090005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect) 38190006 format (1h ,5x,46h----------------------------------------------) 38290011 format (1h ,18x,17hsubset level test) 383c 384c format statements for run summaries 38590008 format (1h ,15x,i5,19h errors encountered) 38690009 format (1h ,15x,i5,13h tests passed) 38790010 format (1h ,15x,i5,14h tests deleted) 388c 389c format statements for test results 39080001 format (1h ,4x,i5,7x,4hpass) 39180002 format (1h ,4x,i5,7x,4hfail) 39280003 format (1h ,4x,i5,7x,7hdeleted) 39380004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6) 39480005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5) 395c 39690007 format (1h ,20x,20hend of program fm050) 397 end 398