Return to fm024.f CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / usr.bin / f77 / testf77 / tests

Annotation of 43BSDTahoe/usr.bin/f77/testf77/tests/fm024.f, revision 1.1

1.1     ! root        1: c     comment section.
        !             2: c
        !             3: c     fm024
        !             4: c
        !             5: c                  three dimensioned arrays are used in this routine.
        !             6: c         this routine tests arrays with fixed dimension and size limits
        !             7: c     set either in a blank common or dimension statement.  the values
        !             8: c     of the array elements are set in various ways such as simple
        !             9: c     assignment statements, set to the values of other array elements
        !            10: c     (either positive or negative), set by integer to real or real to
        !            11: c     integer conversion, set by arithmetic expressions, or set by
        !            12: c     use of the  equivalence  statement.
        !            13: c
        !            14: c
        !            15: c      references
        !            16: c        american national standard programming language fortran,
        !            17: c              x3.9-1978
        !            18: c
        !            19: c        section 8, specification statements
        !            20: c        section 8.1, dimension statement
        !            21: c        section 8.2, equivalence statement
        !            22: c        section 8.3, common statement
        !            23: c        section 8.4, type-statements
        !            24: c        section 9, data statement
        !            25: c
        !            26:       common icoe01, rcoe01, lcoe01
        !            27:       common iade31(3,3,3), rade31(3,3,3), lade31(3,3,3)
        !            28:       common iadn31(2,2,2), radn31(2,2,2), ladn31(2,2,2)
        !            29: c
        !            30:       dimension iade32(3,3,3), rade32(3,3,3), lade32(3,3,3)
        !            31:       dimension iadn32(2,2,2), iadn21(2,2), iadn11(2)
        !            32:       dimension iade21(2,2), iade11(4)
        !            33: c
        !            34:       equivalence (iade31(1,1,1), iade32(1,1,1) )
        !            35:       equivalence ( rade31(1,1,1), rade32(1,1,1) )
        !            36:       equivalence ( lade31(1,1,1), lade32(1,1,1) )
        !            37:       equivalence ( iade31(1,1,1), iade21(1,1), iade11(1) )
        !            38:       equivalence ( icoe01, icoe02, icoe03 )
        !            39: c
        !            40:       logical lade31, ladn31, lade32, lcoe01
        !            41:       integer radn33(2,2,2), radn21(2,4), radn11(8)
        !            42:       real iadn33(2,2,2), iadn22(2,4), iadn12(8)
        !            43: c
        !            44: c
        !            45: c      **********************************************************
        !            46: c
        !            47: c         a compiler validation system for the fortran language
        !            48: c     based on specifications as defined in american national standard
        !            49: c     programming language fortran x3.9-1978, has been developed by the
        !            50: c     federal cobol compiler testing service.  the fortran compiler
        !            51: c     validation system (fcvs) consists of audit routines, their related
        !            52: c     data, and an executive system.  each audit routine is a fortran
        !            53: c     program, subprogram or function which includes tests of specific
        !            54: c     language elements and supporting procedures indicating the result
        !            55: c     of executing these tests.
        !            56: c
        !            57: c         this particular program/subprogram/function contains features
        !            58: c     found only in the subset as defined in x3.9-1978.
        !            59: c
        !            60: c         suggestions and comments should be forwarded to -
        !            61: c
        !            62: c                  department of the navy
        !            63: c                  federal cobol compiler testing service
        !            64: c                  washington, d.c.  20376
        !            65: c
        !            66: c      **********************************************************
        !            67: c
        !            68: c
        !            69: c
        !            70: c     initialization section
        !            71: c
        !            72: c     initialize constants
        !            73: c      **************
        !            74: c     i01 contains the logical unit number for the card reader.
        !            75:       i01 = 5
        !            76: c     i02 contains the logical unit number for the printer.
        !            77:       i02 = 6
        !            78: c     system environment section
        !            79: c
        !            80: cx010    this card is replaced by contents of fexec x-010 control card.
        !            81: c     the cx010 card is for overriding the program default i01 = 5
        !            82: c     (unit number for card reader).
        !            83: cx011    this card is replaced by contents of fexec x-011 control card.
        !            84: c     the cx011 card is for systems which require additional
        !            85: c     fortran statements for files associated with cx010 above.
        !            86: c
        !            87: cx020    this card is replaced by contents of fexec x-020 control card.
        !            88: c     the cx020 card is for overriding the program default i02 = 6
        !            89: c     (unit number for printer).
        !            90: cx021    this card is replaced by contents of fexec x-021 control card.
        !            91: c     the cx021 card is for systems which require additional
        !            92: c     fortran statements for files associated with cx020 above.
        !            93: c
        !            94:       ivpass=0
        !            95:       ivfail=0
        !            96:       ivdele=0
        !            97:       iczero=0
        !            98: c
        !            99: c     write page headers
        !           100:       write (i02,90000)
        !           101:       write (i02,90001)
        !           102:       write (i02,90002)
        !           103:       write (i02, 90002)
        !           104:       write (i02,90003)
        !           105:       write (i02,90002)
        !           106:       write (i02,90004)
        !           107:       write (i02,90002)
        !           108:       write (i02,90011)
        !           109:       write (i02,90002)
        !           110:       write (i02,90002)
        !           111:       write (i02,90005)
        !           112:       write (i02,90006)
        !           113:       write (i02,90002)
        !           114:       ivtnum = 645
        !           115: c
        !           116: c      ****  test 645  ****
        !           117: c     test 645  -  tests setting a three dimension integer array element
        !           118: c     by a simple integer assignment statement.
        !           119: c
        !           120:       if (iczero) 36450, 6450, 36450
        !           121:  6450 continue
        !           122:       iadn31(2,2,2) = -9999
        !           123:       ivcomp = iadn31(2,2,2)
        !           124:       go to 46450
        !           125: 36450 ivdele = ivdele + 1
        !           126:       write (i02,80003) ivtnum
        !           127:       if (iczero) 46450, 6461, 46450
        !           128: 46450 if ( ivcomp + 9999 )  26450, 16450, 26450
        !           129: 16450 ivpass = ivpass + 1
        !           130:       write (i02,80001) ivtnum
        !           131:       go to 6461
        !           132: 26450 ivfail = ivfail + 1
        !           133:       ivcorr = -9999
        !           134:       write (i02,80004) ivtnum, ivcomp ,ivcorr
        !           135:  6461 continue
        !           136:       ivtnum = 646
        !           137: c
        !           138: c      ****  test 646  ****
        !           139: c     test 646  -  tests setting a three dimension real array element
        !           140: c     by a simple real assignment statement.
        !           141: c
        !           142:       if (iczero) 36460, 6460, 36460
        !           143:  6460 continue
        !           144:       radn31(1,2,1) = 512.
        !           145:       ivcomp = radn31(1,2,1)
        !           146:       go to 46460
        !           147: 36460 ivdele = ivdele + 1
        !           148:       write (i02,80003) ivtnum
        !           149:       if (iczero) 46460, 6471, 46460
        !           150: 46460 if ( ivcomp - 512 )  26460, 16460, 26460
        !           151: 16460 ivpass = ivpass + 1
        !           152:       write (i02,80001) ivtnum
        !           153:       go to 6471
        !           154: 26460 ivfail = ivfail + 1
        !           155:       ivcorr = 512
        !           156:       write (i02,80004) ivtnum, ivcomp ,ivcorr
        !           157:  6471 continue
        !           158:       ivtnum = 647
        !           159: c
        !           160: c      ****  test 647  ****
        !           161: c     test 647  -  tests setting a three dimension logical array element
        !           162: c     by a simple logical assignment statement.
        !           163: c
        !           164:       if (iczero) 36470, 6470, 36470
        !           165:  6470 continue
        !           166:       ladn31(1,2,2) = .true.
        !           167:       icon01 = 0
        !           168:       if ( ladn31(1,2,2) )  icon01 = 1
        !           169:       go to 46470
        !           170: 36470 ivdele = ivdele + 1
        !           171:       write (i02,80003) ivtnum
        !           172:       if (iczero) 46470, 6481, 46470
        !           173: 46470 if ( icon01 - 1 )  26470, 16470, 26470
        !           174: 16470 ivpass = ivpass + 1
        !           175:       write (i02,80001) ivtnum
        !           176:       go to 6481
        !           177: 26470 ivfail = ivfail + 1
        !           178:       ivcomp = icon01
        !           179:       ivcorr = 1
        !           180:       write (i02,80004) ivtnum, ivcomp ,ivcorr
        !           181:  6481 continue
        !           182:       ivtnum = 648
        !           183: c
        !           184: c      ****  test 648  ****
        !           185: c     test 648  -  tests setting a one, two, and three dimension array
        !           186: c     element to a value in arithmetic assignment statements.  all three
        !           187: c     elements are integers.  the integer array elements are then used
        !           188: c     in an arithmetic statement and the result is stored by integer
        !           189: c     to real conversion into a three dimension real array element.
        !           190: c
        !           191:       if (iczero) 36480, 6480, 36480
        !           192:  6480 continue
        !           193:       iadn11(2) = 1
        !           194:       iadn21(2,2) = 2
        !           195:       iadn32(2,2,2) = 3
        !           196:       radn31(2,2,1) = iadn11(2) + iadn21(2,2) + iadn32(2,2,2)
        !           197:       ivcomp = radn31(2,2,1)
        !           198:       go to 46480
        !           199: 36480 ivdele = ivdele + 1
        !           200:       write (i02,80003) ivtnum
        !           201:       if (iczero) 46480, 6491, 46480
        !           202: 46480 if ( ivcomp - 6) 26480, 16480, 26480
        !           203: 16480 ivpass = ivpass + 1
        !           204:       write (i02,80001) ivtnum
        !           205:       go to 6491
        !           206: 26480 ivfail = ivfail + 1
        !           207:       ivcorr = 6
        !           208:       write (i02,80004) ivtnum, ivcomp ,ivcorr
        !           209:  6491 continue
        !           210:       ivtnum = 649
        !           211: c
        !           212: c      ****  test 649  ****
        !           213: c     test 649  -  tests of one, two, and three dimension array elements
        !           214: c     set explicitly integer by the integer type statement.  all element
        !           215: c     values should be zero from real to integer truncation from a value
        !           216: c     of 0.5.  all three elements are used in an arithmetic expression.
        !           217: c     the value of the sum of the elements should be zero.
        !           218: c
        !           219:       if (iczero) 36490, 6490, 36490
        !           220:  6490 continue
        !           221:       radn11(8) = 0000.50000
        !           222:       radn21(2,4) = .50000
        !           223:       radn33(2,2,2) = 00000.5
        !           224:       radn11(1) = radn11(8) + radn21(2,4) + radn33(2,2,2)
        !           225:       ivcomp = radn11(1)
        !           226:       go to 46490
        !           227: 36490 ivdele = ivdele + 1
        !           228:       write (i02,80003) ivtnum
        !           229:       if (iczero) 46490, 6501, 46490
        !           230: 46490 if ( ivcomp - 0 )  26490, 16490, 26490
        !           231: 16490 ivpass = ivpass + 1
        !           232:       write (i02,80001) ivtnum
        !           233:       go to 6501
        !           234: 26490 ivfail = ivfail + 1
        !           235:       ivcorr = 0
        !           236:       write (i02,80004) ivtnum, ivcomp ,ivcorr
        !           237:  6501 continue
        !           238:       ivtnum = 650
        !           239: c
        !           240: c      ****  test 650  ****
        !           241: c     test 650  -  test of the equivalence statement.  a real array
        !           242: c     element is set by an assignment statement.  its equivalent element
        !           243: c     in common is used to set the value of an integer array element
        !           244: c     also in common.  finally the dimensioned equivalent integer
        !           245: c     array element is tested for the value used throughout  32767.
        !           246: c
        !           247:       if (iczero) 36500, 6500, 36500
        !           248:  6500 continue
        !           249:       rade32(2,2,2) = 32767.
        !           250:       iade31(2,2,2) = rade31(2,2,2)
        !           251:       ivcomp = iade32(2,2,2)
        !           252:       go to 46500
        !           253: 36500 ivdele = ivdele + 1
        !           254:       write (i02,80003) ivtnum
        !           255:       if (iczero) 46500, 6511, 46500
        !           256: 46500 if ( ivcomp - 32767 )  26500, 16500, 26500
        !           257: 16500 ivpass = ivpass + 1
        !           258:       write (i02,80001) ivtnum
        !           259:       go to 6511
        !           260: 26500 ivfail = ivfail + 1
        !           261:       ivcorr = 32767
        !           262:       write (i02,80004) ivtnum, ivcomp ,ivcorr
        !           263:  6511 continue
        !           264:       ivtnum = 651
        !           265: c
        !           266: c      ****  test 651  ****
        !           267: c     test 651  -  this is a test of common and dimension as well as a
        !           268: c     test of the equivalence statement using logical array elements
        !           269: c     both in common and dimensioned.  a logical variable in common is
        !           270: c     set to a value of .not. the value used in the equivalenced array
        !           271: c     elements which were set in a logical assignment statement.
        !           272: c
        !           273:       if (iczero) 36510, 6510, 36510
        !           274:  6510 continue
        !           275:       lade31(1,2,3) = .false.
        !           276:       lcoe01 = .not. lade32(1,2,3)
        !           277:       icon01 = 0
        !           278:       if ( lcoe01 )  icon01 = 1
        !           279:       go to 46510
        !           280: 36510 ivdele = ivdele + 1
        !           281:       write (i02,80003) ivtnum
        !           282:       if (iczero) 46510, 6521, 46510
        !           283: 46510 if ( icon01 - 1 )  26510, 16510, 26510
        !           284: 16510 ivpass = ivpass + 1
        !           285:       write (i02,80001) ivtnum
        !           286:       go to 6521
        !           287: 26510 ivfail = ivfail + 1
        !           288:       ivcomp = icon01
        !           289:       ivcorr = 1
        !           290:       write (i02,80004) ivtnum, ivcomp ,ivcorr
        !           291:  6521 continue
        !           292:       ivtnum = 652
        !           293: c
        !           294: c      ****  test 652  ****
        !           295: c     test 652  -  tests of one, two, and three dimension array elements
        !           296: c     set explicitly real by the real type statement.  all element
        !           297: c     values should be 0.5 from the real assignment statement.  the
        !           298: c     array elements are summed and then the sum multiplied by 2.
        !           299: c     finally 0.2 is added to the result and the final result converted
        !           300: c     to an integer  ( ( .5 + .5 + .5 ) * 2. ) + 0.2
        !           301: c
        !           302:       if (iczero) 36520, 6520, 36520
        !           303:  6520 continue
        !           304:       iadn12(5) = 0.5
        !           305:       iadn22(1,3) = 0.5
        !           306:       iadn33(1,2,2) = 0.5
        !           307:       ivcomp = ( ( iadn12(5) + iadn22(1,3) + iadn33(1,2,2) ) * 2. ) + .2
        !           308:       go to 46520
        !           309: 36520 ivdele = ivdele + 1
        !           310:       write (i02,80003) ivtnum
        !           311:       if (iczero) 46520, 6531, 46520
        !           312: 46520 if ( ivcomp - 3 )  26520, 16520, 26520
        !           313: 16520 ivpass = ivpass + 1
        !           314:       write (i02,80001) ivtnum
        !           315:       go to 6531
        !           316: 26520 ivfail = ivfail + 1
        !           317:       ivcorr = 3
        !           318:       write (i02,80004) ivtnum, ivcomp ,ivcorr
        !           319:  6531 continue
        !           320: c
        !           321: c     write page footings and run summaries
        !           322: 99999 continue
        !           323:       write (i02,90002)
        !           324:       write (i02,90006)
        !           325:       write (i02,90002)
        !           326:       write (i02,90002)
        !           327:       write (i02,90007)
        !           328:       write (i02,90002)
        !           329:       write (i02,90008)  ivfail
        !           330:       write (i02,90009) ivpass
        !           331:       write (i02,90010) ivdele
        !           332: c
        !           333: c
        !           334: c     terminate routine execution
        !           335:       stop
        !           336: c
        !           337: c     format statements for page headers
        !           338: 90000 format (1h1)
        !           339: 90002 format (1h )
        !           340: 90001 format (1h ,10x,34hfortran compiler validation system)
        !           341: 90003 format (1h ,21x,11hversion 1.0)
        !           342: 90004 format (1h ,10x,38hfor official use only - copyright 1978)
        !           343: 90005 format (1h ,5x,4htest,5x,9hpass/fail, 5x,8hcomputed,8x,7hcorrect)
        !           344: 90006 format (1h ,5x,46h----------------------------------------------)
        !           345: 90011 format (1h ,18x,17hsubset level test)
        !           346: c
        !           347: c     format statements for run summaries
        !           348: 90008 format (1h ,15x,i5,19h errors encountered)
        !           349: 90009 format (1h ,15x,i5,13h tests passed)
        !           350: 90010 format (1h ,15x,i5,14h tests deleted)
        !           351: c
        !           352: c     format statements for test results
        !           353: 80001 format (1h ,4x,i5,7x,4hpass)
        !           354: 80002 format (1h ,4x,i5,7x,4hfail)
        !           355: 80003 format (1h ,4x,i5,7x,7hdeleted)
        !           356: 80004 format (1h ,4x,i5,7x,4hfail,10x,i6,9x,i6)
        !           357: 80005 format (1h ,4x,i5,7x,4hfail,4x,e12.5,3x,e12.5)
        !           358: c
        !           359: 90007 format (1h ,20x,20hend of program fm024)
        !           360:       end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.