V10/nbstests/nbs66.a
!<arch>
nbs01.d 480890328 170 2 100666 1873 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2 . DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4 . DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6 DOUBLE SPACE ON OUTPUT ID 6
999
555554444
666 777777 8
333333111112222222255555444444444444
7.7123456.7
8.889.9997.123456
5.44446.5555533.133.133.133.1444.1
5555.15555.1 66666.166666.1 44.22
2.12.12.12.12.1666.3334.3334.3334.333
-0.1E+01+0.22E-01 0.333E+02 0.4444E+03-0.55555E-03+0.666666E+00+0.9876543E+12
1.05.522.066.633.123455.0789
123.00456.88 0.123E+01 +0.987+1 -0.2345+02 -0.6879E+2+0.7E+03 0.4E+03
0.9876543E-04+0.1357913E-04
19.34+0.2468E+02 +.765+287.643.96 0.5407E+0243.96+0.5407E+0243.96 0.5407+2
+0.1D+06
-0.334D-04 -.334-4 +0.7657654D00 0.12345678901D+10
+0.98765432109876D-1+0.98765432109876D-01 .98765432109876-1
-.555555542D+03 -0.555555542+3
TABC
FDEFFGHIT*+T1F$)TF
9.91.19.92.29.93.39.94.49.91.19.92.29.93.39.94.4
9.95.59.96.69.97.79.98.89.95.59.96.69.97.79.98.8
-9.9-9.9-9.9-9.9
-0.99D+01-0.99D+01-0.99D+01-0.99D+01-0.99D+01 -.99D+01 -.99+01 -.99+1
9999999999
+0.99D+01 0.99D+01 +.99D01 +.99D1
.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9
TFTFTFTFTF
99999999+0.99D+01 0.99D+01 0.99D+01+0.99D+01 .99D1
9.95.59.96.69.97.79.98.89999999999999999TFFT9.99.99.99.99.9
T F T F
4444.55555
123.45678E2 1234.5678 123.45678 12.345678 1.2345678 .12345678
9876.5498.7654E2 9876.54 987.654864786D-486.4786E286.4786 8657.86D0 9876.54
9.8765598.7654E2 9876.54 987.654864786D-386.4786E286.4786 8657.86D0 9876.54
122333544888611222
455666233444966111
788999377555899777
11112 334 559 880 11
6 778 995 441 222 00
B=EF-*JKL/()012TUVW+,.$X YZACDGHIPQRSMNO678(C)B2$9+A345
QZ1*A
ABCDEFGHIJKLMNOPQRSTUVWXYZ
nbs01.f 480887303 170 2 100666 50099 `
C***** PART1 *****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 1 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** DATA1 - 003 TEST FORMAT OF DATA STATEMENT
C*****
C***** FMTRW - 008 FORMATTED INPUT/OUTPUT
C*****
C***** AFRMT - 009 A-CONVERSION
C*****
C***** DATA2 - 010 DATA STATEMENT USE
C*****
C***** AASGN - 011 REAL AND INTEGER ARITH ASSIGN. STMNTS
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN
C***** SEGMENTS 003, 008, 009, 010, 011 ARE RUN AS ONE MAIN PROGRAM
C*****
DIMENSION IAC2I(2,7), EP1S(33), AC2S(5,6), AC3S(1,1,3)
DIMENSION A1S(5), A2S(2,2), CMA1S(5), A3S(3,3,3)
1 , IAC1I(5), AC1S(25), MCA1I(5)
INTEGER AVI,MCA3I(2,3,3),I2I(2,2),I3I(2,2,2),BVI,MAVI,LAVI,I1I(5)
REAL JVS, MVS, CVS, BCVS
LOGICAL MAVB, MBVB, MCVB, MCA1B(7), GH2B(1,2), GI3B(1,1,2),MCBVB
1 , A1B(2), A2B(2,2), A3B(2,2,2), GG1B(2), AVB, CVB, DVB, EVB
DOUBLE PRECISION AVD, BVD, CVD, DVD
1 , DPA2D(2,2), MCA3D(1,4,2), A1D(4)
DOUBLE PRECISION DPA1D(5), ZZDVD, A2D(2,2), A3D(2,2,2)
1 , AC1D(10), BC2D(7,4), DPAVD, DPBVD
COMPLEX ADSVC, BCVC, CHEVC, DCVC, LL1C(32), LM2C(8,4)
1, LN3C(9,2,2), BVC, QAVC, CHAVC, CHBVC, CHCVC, CHDVC
2 , A1C(12), A2C(2,2), B3C(2,2,2), B1C(8)
C***** END OF SPECIFICATIONS FOR SEGMENTS 003, 008, 009, 010, 011
C*****
C***********************************************************************
C*****
C***** DATA1 - (003)
C***** COMPLETE WITH DATA2 - (010)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** TO TEST FORMAT OF DATA STATEMENT 7.2.2
C***** RESTRICTIONS OBSERVED
C***** NO DUMMY ARGUMENTS OR EXTERNAL FUNCTION NAMES 7.2.2/27
C***** APPEAR IN DATA STATEMENTS 8.4.1.1/40
C***** 10.1.2/08
C***** NO INITIALY DEFINED ITEMS APPEAR IN BLANK COMMON 7.2.2/39
C***** 10.2.4/47
C***** STORAGE UNITS INITIALIZED ONLY ONCE 10.1.2/10
C***** SUBSCRIPTS ARE INTEGER CONSTANTS 7.2.2/28
C***** EXPLICIT VARIABLES
C***** AVI IS INTEGER
C***** JVS IS REAL
C*****
C***** S P E C I F I C A T I O N S SEGMENTS 003 AND 010
C*****
C***** WHEN EXECUTING ONLY SEGMENTS 003 AND 010, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH APPEAR AS
C***** COMMENTS MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= DIMENSION IAC2I(2,7), EP1S(33), AC2S(5,6)
C= 1,AC3S(1,1,3)
C= INTEGER AVI ,MCA3I(2,3,3), I1I(5)
C= REAL JVS
C= LOGICAL MAVB,MBVB,MCVB, MCA1B(7),GH2B(1,2),GI3B(1,1,2),GG1B(2)
C= DOUBLE PRECISION AVD,BVD,CVD,DVD
C= 1,DPA2D(2,2),MCA3D(1,4,2),A1D(4)
C= COMPLEX ADSVC,BCVC,CHEVC,DCVC,LL1C(32),LM2C(8,4),LN3C(9,2,2)
C*****
C***** TEST DATA INITIALIZATION OF INTEGER CONSTANTS TO 5.1.1.1
C***** INTEGER VARIABLES
DATA I1I(1),MCA3I(1,2,1),MCA3I(2,2,2),IAC2I(2,5),IAC2I(2,6),
AMCA3I(2,1,1)/0,2*10,3*246/
C***** TEST DATA INITIALIZATION OF REAL CONSTANTS TO 5.1.1.2
C***** REAL VARIABLES
DATA EP1S(8),EP1S(10),EP1S(12),AC2S(5,5),EP1S(11),AC2S(5,3),
AAC2S(5,2)/2*0.,2*-750.05,.24615E3,2.4615E2,3.54674E+3/
C***** TEST DATA INITIALIZATION OF DP CONTANTS TO 5.1.1.3
C***** DP VARIABLES
DATA BVD ,DPA2D(2,1),CVD,DPA2D(1,2), DVD,DPA2D(2,2)/+34567890.1D-
A3,345.678901D+2,112233.5D-08,11.22335D-4,3.4D12,0.34D13/
C***** TEST DATA INITIALIZATION OF COMPLEX CONSTANTS TO 5.1.1.4
C***** COMPLEX VARIABLES
DATA ADSVC,LN3C(9,1,2),LL1C(30),LN3C(8,2,2),LM2C(8,3),LN3C(9,1,1),
ALL1C(32),LN3C(8,1,2)/2*(11.1,22.22),(-3.45E1,-67.8E-1),
B(-34.5E0,-6.78E0),(10.E0,-20.E0),(1.0E1,-2.0E1),(-20.0E1,+4.E3),
C(-200.E0,+4000.E0)/
C***** TEST DATA INITIALIZATION OF LOGICAL CONSTANTS TO 5.1.1.5
C***** LOGICAL VARIABLES
DATA MAVB ,MCA1B(6), MBVB/2*.TRUE.,.FALSE./
C***** TEST DATA INITIALIZATION OF HOLLERITH CONSTANTS 5.1.1.6
DATA GI3B(1,1,2),GG1B(1),EP1S(15)/2HNO,2*2HAD/
C***** TEST DATA INITIALIZATION OF A MIXTURE OF ALL TYPES OF
C***** CONSTANTS AND VARIABLES IN ONE DATA STATEMENT
DATA I1I(2),IAC2I(1,5),IAC2I(1,3), I1I(5),IAC2I(2,4),
AMCA3I(1,1,2), AVI,EP1S(13),AC2S(2,6),AC2S(1,6),AC3S(1,1,1),
BAC2S(3,6),AC3S(1,1,2),AC2S(4,6), AVD,A1D(1),DPA2D(1,1),
CMCA3D(1,1,1),A1D(2),MCA3D(1,1,2),LL1C(29),LN3C(8,2,1),BCVC,
DLM2C(8,4),GH2B(1,1),GI3B(1,1,1), MCVB/3*0,4*-750,2*0.,2*246.15,
E354674.E-2,354.674E+ 1,35467.4E-01,3*-.295D5,-29.5D+3,
F3456.78901D+01,0.345678901D+5,2*(1.11E1,+222.2E-1),(-34.5,-6.78),
G(-.345E2,-678.E-2),2*.TRUE.,.FALSE./, I1I(3), I1I(4),
HMCA3I(1,2,2),AC2S(5,6),JVS ,EP1S(14),AC3S(1,1,3),IAC2I(1,4),
ICHEVC,LL1C(31),DCVC,LM2C(8,2),A1D(3),MCA3D(1,3,1),A1D(4),
JMCA3D(1,4,1), MCA1B(7),GH2B(1,2) / 2*10,+246,
K-.75005E03,-7.5005E+02,2HBC,2H*=,2H P,2*(10.,-20.),
L(-200.,+4000.),(-2000.E-1,+400.E1),+1122.335D-6,0.00001122335D+2,
M34.0D11,0.034D14,2*.FALSE./
C***** END OF SEGMENT 003
C***********************************************************************
C*****
C***** FMTRW - (008)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** TO TEST SIMPLE FORMAT AND FORMATTED I/O STATEMENTS 7.1.3.2.2
C***** SO THAT THESE FEATURES MAY BE USED IN OTHER TEST 7.1.3.2.3
C***** PROGRAM SEGMENTS 7.2.3
C***** RESTRICTIONS OBSERVED
C***** * ALL FORMAT STATEMENTS ARE LABELED 7.2.3 /57
C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 7.2.3.3/54
C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND 7.2.3.1/31
C***** W IS EQUAL TO OR GREATER THAN D 7.2.3.1/33
C***** * FIELD WIDTH IS NEVER ZERO 7.2.3 /18
C***** * IF THERE IS AN I/O LIST, THE FORMAT STATEMENT 7.2.3.4/22
C***** CONTAINS AT LEAST ONE FIELD DESCRIPTOR (OTHER
C***** THAN H OR X)
C***** * ITEMS IN I/O LIST CORRESPOND TO FORMAT DESCRIPTORS 7.2.3.4/36
C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 7.2.3.6/56
C***** * FIELD WIDTH NEVER EXCEEDED BY OUTPUT 7.2.3.6/01
C***** * FOR I CONVERSION, EXTERNAL INPUT FIELDS ARE 7.2.3.6.1/07
C***** INTEGER CONSTANTS
C***** GENERAL COMMENTS
C***** PLUS SIGNS FOR INPUT FIELDS ARE USUALLY OMITTED 7.2.3.6/44
C*****
C***** READ AND WRITE STATEMENTS FOR ENTIRE SEGMENT FOLLOW
C*****
C***** FORMATTED WRITES WITHOUT AN I/O LIST (FORMAT 7.1.3.2.3/05
C***** STATEMENTS TEST H AND X DESCRIPTORS AND SLASH 7.2.3.2 /44
C***** RECORD DIVIDERS) 7.2.3.8 /09
C***** 7.2.3.9 /31
C INPUT DATA TO THIS SEGMENT CONSISTS OF 40 CARD IMAGES IN COL. 1 - 80
COL. 1----------------------------------------------------------61
CARD 1 999
CARD 2 555554444
CARD 3 666 777777 8
CARD 4 333333111112222222255555444444444444
CARD 5 7.7123456.7
CARD 6 8.889.9997.123456
CARD 7 5.44446.5555533.133.133.133.1444.1
CARD 8 5555.15555.1 66666.166666.1 44.22
CARD 9 2.12.12.12.12.1666.3334.3334.3334.333
CARD 10 -0.1E+01+0.22E-01 0.333E+02 0.4444E+03-0.55555E-03+0.666666E+
COL. 62------------77
CARD 10 00+0.9876543E+12
COL. 1----------------------------------------------------------61
CARD 11 1.05.522.066.633.123455.0789
CARD 12 123.00456.88 0.123E+01 +0.987+1 -0.2345+02 -0.6879E+2+0.7E+0
COL 62-----70
CARD 12 3 0.4E+03
COL. 1----------------------------------------------------------61
CARD 13 0.9876543E-04+0.1357913E-04
CARD 14 19.34+0.2468E+02 +.765+287.643.96 0.5407E+0243.96+0.5407E+0
COL. 62-------------78
CARD 14 243.96 0.5407+2
COL. 1----------------------------- ----------------------------61
CARD 15 +0.10+06
CARD 16 -0.334D-04 -.334-4 +0.7657654D00 0.12345678901D+10
CARD 17 +0.98765432109876D-1+0.98765432109876D-01 .98765432109876
COL. 62-66
CARD 17 -1
COL. 1----------------------------------------------------------61
CARD 18 -.555555542D+03 -0.555555542+3
CARD 19 TABC
CARD 20 FDEFFGHIT*+T1F$)TF
CARD 21 9.91.19.92.29.93.39.94.49.91.19.92.29.93.39.94.4
CARD 22 9.95.59.96.69.97.79.98.89.95.59.96.69.97.79.98.8
CARD 23 -9.9-9.9-9.9-9.9
CARD 24 -0.99D+01-0.99D+01-0.99D+01-0.99D+01-0.99D+01 -.99D+01 -.99+
COL. 62-------72
CARD 24 01 -.99+1
COL. 1----------------------------------------------------------61
CARD 25 9999999999
CARD 26 +0.99D+01 0.99D+01 +.99D01 +.99D1
CARD 27 .9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9.9
CARD 28 TFTFTFTFTF
CARD 29 99999999+0.99D+01 0.99D+01 0.99D+01+0.99D+01 .99D1
CARD 30 9.95.59.96.69.97.79.98.89999999999999999TFFT9.99.99.99.99.9
CARD 31 T F T F
CARD 32 4444.55555
COL. 1----------------------------------------------------------61
CARD 33 123.45678E2 1234.5678 123.45678 12.345678 1.2345678 .123
COL. 62-66
CARD 33 45678
COL. 1----------------------------------------------------------61
CARD 34 9876.5498.7654E2 9876.54 987.654864786D-486.4786E286.4786
COL. 62---------------80
CARD 34 8657.86D0 9876.54
COL. 1----------------------------------------------------------61
CARD 35 9.8765598.7654E2 9876.54 987.654864786D-386.4786E286.4786
COL. 62---------------80
CARD 35 8657.86D0 9876.54
COL. 1----------------------------------------------------------61
CARD 36 122333544888611222
CARD 37 455666233444966111
CARD 38 788999377555899777
CARD 39 11112 334 559 880 11
CARD 40 6 778 995 441 222 00
C*****
C***** S P E C I F I C A T I O N S SEGMENT 008
C*****
C***** WHEN EXECUTING ONLY SEGMENT 008, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED
C= DIMENSION A1S(5),A2S(2,2) ,EP1S(33),CMA1S(5),A3S(3,3,3)
C= 1,IAC1I(5),IAC2I(2,7),AC1S(25),AC2S(5,6),MCA1I(5)
C= INTEGER I2I(2,2),I3I(2,2,2),MCA3I(2,3,3)
C= LOGICAL MCA1B(7),A1B(2),A2B(2,2),A3B(2,2,2),AVB,CVB,DVB ,MCBVB
C= DOUBLE PRECISION DPA1D(5),MCA3D(1,4,2),ZZDVD ,A2D(2,2),A3D(2,2,2)
C= 1,AC1D(10),BC2D(7,4),DPAVD,DPBVD
C= COMPLEX BVC,QAVC,CHAVC,CHBVC,CHCVC,CHDVC
C= 1,LL1C(32),LM2C(8,4),A1C(12),A2C(2,2),B3C(2,2,2),B1C(8)
C*****
C***** I N P U T - O U T P U T TAPE ASSIGNMENT STATEMENTS
C*****
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 1 ///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
C***** HEADER FORMAT STATEMENT
0080 FORMAT (1H1, 1X,27HFMTRW - (008) FORMATTED I/O//2X,
138HASA REFS - 7.1.3.2.2 7.1.3.2.3 7.2.3//2X,7HRESULTS)
WRITE (NUVI,0080)
C***** FORMAT WITH DIGITS 0-9 IN H FIELDS
0081 FORMAT (//22H 10101010101010101010,9H999999999,8H88888888/2X,
17H7777777,6H666666,5H55555,4H4444,3H333,2H22,1H1)
WRITE (NUVI,0081)
C***** FORMAT CONTAINING ALL LETTERS (A-Z) IN H FIELDS AND
C***** A VARIABLE NUMBER OF BLANKS IN H AND X FIELDS
0082 FORMAT(/2X,3HAAA,5X,5H ,3HBBB,10X,3HCCC/3H ,3HDDD,9X,3HEEE,
19H ,3HFFF/4X,3HGGG,8X,3HHHH,8H ,3HIII/5H ,3HJJJ
2,7H ,3HKKK,7X,3HLLL/6X,3HMMM,6X,3HNNN,6H ,3HOOO/7X,
3 3HPPP,5H ,3HQQQ,5X,3HRRR/8X,3HSSS,4X,3HTTT,4H ,3HUUU/ 1
45H VVV ,3HWWW,3X,3HXXX/12X,3HYYY,3X,3HZZZ)
WRITE (NUVI,0082)
C***** FORMAT CONTAINING H FIELD WITH ALL POSSIBLE
C***** SPECIAL CHARACTERS 3.1/46
0083 FORMAT(/21H = + - * / ( ) , . $)
WRITE (NUVI,0083)
C***** FORMAT TO TEST VERTICAL SPACING
C***** 7.1.3.4/04
7154 FORMAT(/24H BEGIN VERTICAL SPACING//30H FORMAT(14H SKIP 1 LINE
1 /) /)
WRITE (NUVI, 7154)
7155 FORMAT(32H FORMAT(15H SKIP 2 LINES //) //)
WRITE (NUVI, 7155)
7156 FORMAT(33H FORMAT(16H SKIP 3 LINES ///) ///)
WRITE (NUVI,7156)
0084 FORMAT( 32H IMBEDDED SLASHES - SKIP 1 LINE //
1 14H SKIP 2 LINES/// 14H SKIP 3 LINES/ 3(/),
2 19H SKIP TO NEXT LINE/ 1H , 12H SKIP 1 LINE/ 1H0,
38H TEST NO/1H+,9X,14H/1H+,7HADVANCE/19H SKIP TO NEW PAGE /
4 1H1, /// 30H END OF VERTICAL SPACING TEST)
WRITE (NUVI,0084)
C***** FORMATTED READ AND WRITE STATEMENTS WITH INTEGER 7.1.3.2.1/25
C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST. (THE 7.2.3.3/01
C***** NUMBER OF ITEMS IN THE LIST IS VARIABLE.) SOME
C***** FORMAT STATEMENTS CONTAIN REPEATED FIELDS.
C***** FORMATS CONTAINING I CONVERSION DESCRIPTORS. 7.2.3.6.1/03
C***** FIELDS WIDTH IS FROM 1 TO 5 DIGITS. SOME 7.2.3.3 /01
C***** FIELDS ARE REPEATED
0085 FORMAT (//25H BEGIN I CONVERSION TEST/40H EACH PAIR OF LINES SHO
1ULD BE IDENTICAL/47H LINE 1 OF EACH GROUP IS HOLLERITH INFORMATIO
2N)
WRITE (NUVI,0085)
C***** INPUT CARD 1
0086 FORMAT (2X,I3)
READ (IRVI,0086) JACVI
C***** INPUT CARD 2
0087 FORMAT (2X,I5,I4)
READ (IRVI,0087) KBCVI, IAC1I(1)
C***** INPUT CARD 3
0088 FORMAT (2X,I3,2X,3(I2),2X,I1)
READ (IRVI,0088) IAC2I(1,2), LCCVI, IAC1I(5), IHDVI, MCA3I(1,2,3)
C***** INPUT CARD 4
0089 FORMAT (2X,2(I3),5(I1),4(I2),1(I5),3(I4))
READ (IRVI,0089) MDCVI, IAC2I(2,2), IAC1I(4), NECVI, IAC1I(3),
1 IAC2I(2,3), IAC2I(2,1), MRRVI, IGDVI, KGVI, IEDVI, IAC2I(1,1)
2 ,IAC1I(2), IAC2I(2,7), MCA3I(2,1,3)
7086 FORMAT (/ 5H 999)
WRITE (NUVI,7086)
WRITE (NUVI,0086) JACVI
7087 FORMAT (/ 11H 555554444)
WRITE (NUVI,7087)
WRITE (NUVI,0087) KBCVI, IAC1I(1)
7088 FORMAT (/ 16H 666 777777 8)
WRITE (NUVI,7088)
WRITE (NUVI,0088) IAC2I(1,2), LCCVI, IAC1I(5), IHDVI, MCA3I(1,2,3)
7089 FORMAT (/ 38H 333333111112222222255555444444444444)
WRITE (NUVI,7089)
WRITE (NUVI,0089) MDCVI, IAC2I(2,2), IAC1I(4), NECVI, IAC1I(3),
1 IAC2I(2,3), IAC2I(2,1), MRRVI, IGDVI, KGVI, IEDVI, IAC2I(1,1)
2 ,IAC1I(2), IAC2I(2,7), MCA3I(2,1,3)
C***** FORMATTED READ AND WRITE STATEMENTS WITH REAL 7.1.3.2.1/25
C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST.(THE 7.2.3.6.2/18
C***** NUMBER OF ITEMS IN THE LIST IS VARIABLE.) ONLY 7.2.3.3 /01
C***** F CONVERSION IS USED IN THE FORMAT STATEMENTS.
C***** SOME F FIELD DESCRIPTORS ARE REPEATED. FIELD
C***** WIDTH ALWAYS CONTAINS 1 POSITION FOR DECIMAL PT.
C***** FORMATS CONTAINING F CONVERSION DESCRIPTORS. 7.2.3.6.2/18
C***** FIELD WIDTH IS FROM 1 TO 7 DIGITS. PLACEMENT OF 7.2.3.3 /01
C***** DECIMAL POINT IS VARIABLE. SOME F FIELDS ARE
C***** REPEATED
7080 FORMAT (/ 25H BEGIN F CONVERSION TEST/40H EACH PAIR OF LINES SHO
1ULD BE IDENTICAL)
WRITE (NUVI,7080)
C***** INPUT CARD 5
7081 FORMAT (2X,F3.1,F8.1)
READ (IRVI,7081) ACVS, CMAVS
C***** INPUT CARD 6
7082 FORMAT(2X,F4.2,F5.3,F8.6)
READ (IRVI,7082) A1S(2), BCVS, CMBVS
C***** INPUT CARD 7
7083 FORMAT (2X,F6.4,F7.5,4(F4.1),F5.1)
READ (IRVI,7083) HHCVS, CMCVS, GGCVS, FFCVS, A1S(1), AC1S(25),
1 AC2S(4,1)
C***** INPUT CARD 8
7084 FORMAT (2X,2(F6.1),2X,2(F7.1),2X,F5.2)
READ (IRVI,7084) AC1S(18), AC1S(7), AC2S(4,4) , AC1S(8), AC1S(10)
C***** INPUT CARD 9
7085 FORMAT (2X,5(F3.1),F7.3,3(F5.3))
READ (IRVI,7085) AC2S(3,3) , AC2S(5,1), CCVS, AC1S(12), DCVS,
1 AC1S(13), AC1S(5), A3S(1,1,2), AC2S(3,5)
7091 FORMAT (/ 13H 7.7123456.7)
WRITE (NUVI,7091)
WRITE (NUVI,7081) ACVS, CMAVS
7092 FORMAT (/ 19H 8.889.9997.123456)
WRITE (NUVI,7092)
WRITE (NUVI,7082) A1S(2), BCVS, CMBVS
7093 FORMAT (/ 36H 5.44446.5555533.133.133.133.1444.1)
WRITE (NUVI,7093)
WRITE (NUVI,7083) HHCVS, CMCVS, GGCVS, FFCVS, A1S(1), AC1S(25)
1 ,AC2S(4,1)
7094 FORMAT (/ 37H 5555.15555.1 66666.166666.1 44.22 )
WRITE (NUVI,7094)
WRITE (NUVI,7084) AC1S(18), AC1S(7), AC2S(4,4) , AC1S(8), AC1S(10)
7095 FORMAT ( /39H 2.12.12.12.12.1666.3334.3334.3334.333)
WRITE (NUVI,7095)
WRITE (NUVI,7085) AC2S(3,3) , AC2S(5,1), CCVS, AC1S(12), DCVS,
1 AC1S(13), AC1S(5), A3S(1,1,2), AC2S(3,5)
C***** FORMATTED READ AND WRITE STATEMENTS WITH REAL 7.1.3.2.1/
C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST. 7.2.3.6.2/
C***** E CONVERSION IS USED IN THE FORMAT STATEMENTS 7.2.3.3 /
C***** SOME E FIELD DESCRIPTORS ARE REPEATED
C***** (FIELD WIDTH ALWAYS INCLUDES 6 EXTRA POSITIONS 7.2.3.6.2.1/47
C***** TO PROVIDE FOR SIGN, DECIMAL POINT AND EXPONENT. 7.2.3.6/01
C***** PROVISION IS ALWAYS MADE FOR THE DIGIT ZERO 7.2.3.6.2.1/04
C***** BEFORE THE DECIMAL POINT)
C***** THE NUMBER OF DECIMAL PLACES VARIES FROM 1
C***** TO 7 DIGITS.
7110 FORMAT (//25H BEGIN E CONVERSION TEST/40H EACH PAIR OF LINES SHO
1ULD BE IDENTICAL)
WRITE (NUVI,7110)
C***** INPUT CARD 10
7111 FORMAT (E8.1,E9.2,E10.3,E11.4,E12.5,E13.6,E14.7)
READ (IRVI,7111) AVS, BVS, EP1S(5), AC2S(1,5), CVS, AC2S(5,4),
1 A3S(2,1,2)
7112 FORMAT (/ 21H -0.1E+01 0.22E-01/2X,E8.1,2X,E9.2//
1 25H 0.333E+02 0.4444E+03/2X,E10.3,2X,E11.4//
2 29H -0.55555E-03 0.666666E+00/2X,E12.5,2X,E13.6//
3 16H 0.9876543E+12/2X,E14.7)
WRITE (NUVI,7112) AVS, BVS, EP1S(5), AC2S(1,5), CVS, AC2S(5,4),
1 A3S(2,1,2)
C***** FORMATTED READ AND WRITE STATEMENTS WITH COMPLEX 7.1.3.2.1/25
C***** VARIABLES AND ARRAY ELEMAENTS IN AN I/O LIST. 7.2.3.6.4/52
C***** E AND F CONVERSION ARE USED IN THE FORMAT 7.2.3.4 /39
C***** STATEMENTS. SOME FORMAT DESCRIPTORS ARE REPEATED 7.2.3.3 /01
7118 FORMAT ( 31H1 BEGIN COMPLEX CONVERSION TEST/32H EACH GROUP SHOUL
1D BE IDENTICAL)
WRITE (NUVI,7118)
C***** INPUT CARD 11
7119 FORMAT ( 2(F3.1) , 2(F4.1), 2(F7.4))
READ (IRVI,7119) CHAVC, CHBVC, A1C(2)
C***** INPUT CARDS 12, 13
7120 FORMAT ( 2(F6.2), 2(E10.3), 2(E11.4), 2(E8.1)/ 2(E14.7))
READ (IRVI,7120) A2C(1,2), B3C(2,2,1), CHCVC, A1C(1), CHDVC
C***** INPUT CARD 14
7122 FORMAT (F5.2, E11.4, E10.3, F4.1, 3(F5.2,E11.4))
READ (IRVI,7122) A2C(2,1), BVC, QAVC, LM2C(1,2), LL1C(2)
7123 FORMAT (/ 10H 1.0 5.5/ 2X, F3.1,2X, F3.1 //
1 12H 22.0 66.6/ 2X, F4.1, 2X, F4.1 //
2 18H 33.1234 55.0789/ 2X, F7.4, 2X, F7.4 )
WRITE (NUVI,7123) CHAVC, CHBVC, A1C(2)
7124 FORMAT (/ 16H 123.00 456.88/ 2X, F6.2, 2X, F6.2 //
1 24H 0.123E+01 0.987E+01/ 2X, E10.3, 2X, E10.3 //
2 26H -0.2345E+02 -0.6879E+02/ 2X, E11.4, 2X, E11.4 //
3 20H 0.7E+03 0.4E+03/ 2X, E8.1, 2X, E8.1 //
4 32H 0.9876543E-04 0.1357913E-04/ 2X, E14.7, 2X, E14.7)
WRITE (NUVI,7124) A2C(1,2), B3C(2,2,1), CHCVC, A1C(1), CHDVC
7126 FORMAT (/ 20H 19.34 0.2468E+02/ 2X, F5.2, 2X, E11.4//
1 18H 0.765E+02 87.6/ 2X, E10.3, 2X,F4.1//
2 18H 43.96 0.5407E+02/ 3(F7.2,E11.4/))
WRITE (NUVI,7126) A2C(2,1), BVC, QAVC, LM2C(1,2), LL1C(2)
C***** FORMATTED READ AND WRITE STATEMENTS WITH 7.1.3.2.1/25
C***** DOUBLE PRECISION VARIABLES IN AN I/O LIST. 7.2.3.6.3/41
C***** D CONVERSION IS USED IN THE FORMAT STATEMENTS. 7.2.3.3 /01
C***** SOME D FORMAT DESCRIPTORS ARE REPEATED. (FIELD
C***** WIDTH ALWAYS INCLUDES 6 EXTRA POSITIONS TO 7.2.3.6.2.1/45
C***** PROVIDE FOR SIGN, DECIMAL POINT AND EXPONENT 7.2.3.6 /04
C***** AND 1 POSITION FOR OPTIONAL DIGIT ZERO BEFORE 7.2.3.6.2.1/04
C***** THE DECIMAL POINT)
7127 FORMAT ( /25H BEGIN D CONVERSION TEST/32H EACH GROUP SHOULD BE I
1DENTICAL)
WRITE (NUVI,7127)
C***** INPUT CARD 15
7128 FORMAT ( 2X, D8.1)
READ (IRVI,7128) DPAVD
C***** INPUT CARDS 16, 17, 18
7129 FORMAT ( 2(D10.3), D14.7, D18.11/ 3(D21.14)/ 2(D16.9))
READ (IRVI,7129) MCA3D(1,2,2), AC1D(2), BC2D(3,1), AC1D(1),
1 ZZDVD, AC1D(3), DPBVD, MCA3D(1,2,1), BC2D(1,2)
7130 FORMAT (/ 10H 0.1D+06)
WRITE (NUVI,7130)
WRITE (NUVI,7128) DPAVD
7131 FORMAT (/ 12H -0.334D-04/ 2X, D10.3 / 2X, D10.3 //
1 16H 0.7657654D+00/ 2X, D14.7 //
2 20H1 0.12345678901D+10/ 2X, D18.11 //
3 23H 0.98765432109876D-01/ 2X, D21.14/ 2X, D21.14 / 2X, D21.14//
4 18H -0.555555542D+03/ 2X, D16.9/ 2X, D16.9 )
WRITE (NUVI,7131) MCA3D(1,2,2), AC1D(2), BC2D(3,1), AC1D(1) ,
1 ZZDVD, AC1D(3), DPBVD, MCA3D(1,2,1), BC2D(1,2)
C***** FORMATTED READ AND WRITE STATEMENTS WITH LOGICAL 7.1.3.2.1/25
C***** VARIABLES AND ARRAY ELEMENTS IN AN I/O LIST 7.2.3.7 /56
C***** SOME L DESCRIPTORS ARE REPEATED.
7132 FORMAT(//25H BEGIN L CONVERSION TEST/33H LINES BELOW SHOULD BE I
1DENTICAL)
C***** L CONVERSION IS USED IN THE FORMAT STATEMENTS 7.2.3.3 /01
WRITE (NUVI,7132)
C***** INPUT CARD 19
7133 FORMAT (L4)
READ (IRVI,7133) A2B(2,1)
C***** INPUT CARD 20
7134 FORMAT ( 2(L4), L3, L2, L3, 2(L1))
READ (IRVI,7134) MCA1B(1), MCBVB, A2B(1,1), A3B(1,1,1), CVB,
1 DVB, A3B(1,2,1)
7135 FORMAT (//24H T F F T T FTF/ 2X, 3(L4), L3, L2, L3,
1 2(L1))
WRITE (NUVI,7135) A2B(2,1), MCA1B(1), MCBVB, A2B(1,1), A3B(1,1,1),
1 CVB, DVB, A3B(1,2,1)
C***** FORMATTED READ AND WRITE STATEMENTS WITH ARRAY 7.1.3.2.1/26
C***** NAMES OF ALL TYPES IN AN I/O LIST. THE NUMBER OF 7.1.3.2.1/39
C***** ITEMS IN THE LIST IS VARIABLE. SOME FIELD 7.2.3.3 /01
C***** DESCRIPTORS ARE REPEATED.
7097 FORMAT (//32H TEST UNSUBSCRIPTED ARRAY NAMES/35H IN I/O LISTS. E
1ACH GROUP OF LINES/22H SHOULD BE IDENTICAL.)
WRITE (NUVI,7097)
C***** INPUT CARDS 21, 22
7098 FORMAT(2X,8(F3.1),8F3.1/8(2(F3.1)))
READ (IRVI,7098) B1C,B3C
C***** INPUT CARDS 23, 24, 25
7099 FORMAT(2X,4(F4.1)/4(D9.2),4D9.2/5(I2))
READ (IRVI,7099) A2S, A3D, MCA1I
C***** INPUT CARDS 26, 27, 28
7100 FORMAT(2X,4(D9.2)/27(F2.1)/5(L1),5L1)
READ (IRVI,7100) A2D, A3S, A1B, A3B
C***** INPUT CARDS 29, 30
7101 FORMAT (2X,4(I2),5(D9.2)/4(2(F3.1)),8(I2),4(L1),5(F3.1))
READ (IRVI,7101) I2I, DPA1D, A2C, I3I, A2B, CMA1S
7102 FORMAT (/ 26H 9.91.19.92.29.93.39.94.4 / 2X,8(F3.1)/2X,8(F3.1))
WRITE (NUVI,7102) B1C
7103 FORMAT (/ 18H -9.9-9.9-9.9-9.9/2X,4(F4.1) //
138H -0.99D+01-0.99D+01-0.99D+01-0.99D+01/2X,4(D9.2)/2X,4(D9.2)//
2 12H 9999999999/ 2X, 5(I2) //38H 0.99D+01 0.99D+01 0.99D+01 0.9
39D+01/ 2X, 4(D9.2) // 37H 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9 0.9/1X,
4 9(F4.1)/ 1X, 9(F4.1)/ 1X,9(F4.1)/ 4H1 TF/ 2X,2(L1))
WRITE (NUVI,7103) A2S, A3D, MCA1I, A2D, A3S, A1B
7104 FORMAT (/ 10H TFTFTFTF/ 2X, 8(L1) // 10H 99999999/ 2X, 4(I2)//
1 11H 0.99D+01/ 5(D11.2/) /26H 9.95.59.96.69.97.79.98.8/2X,
28(F3.1)/2X,8(F3.1)/2X,8(F3.1)//18H 9999999999999999/2X,8(I2)//
3 6H TFFT/ 2X, 4(L1) // 17H 9.99.99.99.99.9/2X, 5(F3.1))
WRITE (NUVI,7104) A3B, I2I, DPA1D, A2C, B3C, I3I, A2B, CMA1S
C***** FORMATTED WRITES TO TEST THAT LEADING BLANKS 7.2.3.6/51
C***** ARE INSERTED IN THE OUTPUT FIELD WHEN THE OUTPUT
C***** PRODUCED IS SMALLER THAN THE FIELD WIDTH. (I, E,
C***** F AND D DESCRIPTORS ARE TESTED)
7090 FORMAT ( /30H LEADING BLANK INSERTION TEST/40H EACH PAIR OF LINE
1S SHOULD BE IDENTICAL)
WRITE (NUVI,7090)
7096 FORMAT (/ 3H 8/I3//4H 1/I4//5H 1/I5//6H 1/I6//
1 7H 1/I7// 5H 7.7/F5.1// 7H 8.88/F7.2/ 9H1 9.999/
2 F9.3// 11H 5.4444/F11.4// 13H 6.55555/F13.5//
3 15H 7.123456/F15.6// 10H 0.21E+01/E10.2//
4 12H 0.331E+02/E12.3// 14H 0.4441E+03/E14.4//
5 16H 0.55551E+04/E16.5// 18H 0.666661E+05/E18.6//
6 20H 0.1234567E+06/E20.7)
WRITE (NUVI,7096) MCA3I(1,2,3), IAC1I(4), NECVI, IAC1I(3),
1 IAC2I(2,3), ACVS, A1S(2), BCVS, HHCVS, CMCVS, CMBVS,
2 DCVS, AC1S(25), AC2S(4,1), AC1S(7), AC1S(8), CMAVS
7105 FORMAT (/ 9H 0.1D+00/D9.1// 10H 0.1D+00/D10.1//
1 11H 0.1D+00/D11.1// 12H 0.1D+00/D12.1//
2 10H 1.0 5.5/ 2(F5.1) // 12H 9.9 5.5/ 2(F6.1) //
3 14H 9.9 5.5/ 2(F7.1) // 16H 1.0 5.5/ 2(F8.1))
WRITE (NUVI,7105) AC1D(3), ZZDVD, ZZDVD,
1 ZZDVD, CHAVC, B3C(1,1,1), B3C(1,1,1), CHAVC
C***** FORMATTED READ AND WRITE STATEMENT TO TEST THAT 7.2.3.7/03
C***** OPTIONAL BLANKS MAY PRECEDE A LOGICAL INPUT FIELD 7.2.3.7/06
7138 FORMAT ( 33H1 TEST LOGICAL FIELDS WITH BLANKS/33H LINES BELOW SH
1OULD BE IDENTICAL)
WRITE (NUVI,7138)
C***** INPUT CARD 31
7139 FORMAT ( L6, L4, L10, L5)
READ (IRVI,7139) AVB, MCA1B(2), A2B(1,2), A3B(2,1,2)
7140 FORMAT (//27H T F T F/ 2X, L6, L4, L10, L5)
WRITE (NUVI,7140) AVB, MCA1B(2), A2B(1,2), A3B(2,1,2)
C***** FORMATTED READ AND WRITE TO TEST F DESCRIPTORS 7.2.3.1/31
C***** WHERE D IS EQUAL TO ZERO AND WHERE W EQUALS D 7.2.3.4/40
C***** (2ND TEST APPLIES ONLY TO READ STMNTS.)
7108 FORMAT (//36H TEST D = 0, W=D+1 (PAIRS OF LINES/ 28H BELOW SHOU
1LD BE IDENTICAL))
WRITE (NUVI,7108)
C***** INPUT CARD 32
7141 FORMAT (2X, F5.0, F5.5)
READ (IRVI,7141) ACVS, BVS
7109 FORMAT (//7H 4444./2X, F5.0// 9H .55555/ 3X,F6.5)
WRITE (NUVI,7109) ACVS, BVS
C***** FORMATS WITH G CONVERSIONS
C***** INPUT CARD 33
7142 FORMAT( 3(G11.4), 3G11.4)
READ (IRVI,7142) AC1S(14), AC1S(15), AC1S(16), AC1S(17) ,
1 AC1S(21), AC1S(22)
7143 FORMAT(/ 2X,23HBEGIN G CONVERSION /2X,38HEACH PAIR OF LINES SH
1OULD BE IDENTICAL//36H .1235E+05 1235. 123.5/
2 G14.4,4X,2G11.4///3X,33H 12.35 1.235 .1235/
3 G14.4,4X,2G11.4)
WRITE(NUVI,7143) AC1S(14), AC1S(15), AC1S(16), AC1S(17),
1 AC1S(21), AC1S(22)
C***** SCALE FACTOR APPLIED TO F,E,D,G DESCRIPTORS
C***** ON READ, BUT NOT ON WRITE
C***** INPUT CARD 34
7144 FORMAT(2PF8.3,-2PE9.4,F9.4,0PG9.4,D9.4,-2PE9.4,F9.4,D9.4,2PG9.4)
READ(IRVI,7144)EP1S(16),EP1S(17),EP1S(18), EP1S(19),
1 BC2D(1,4),EP1S(20),EP1S(22),BC2D(2,1),EP1S(23)
7145 FORMAT(22H1 SCALE FACTOR ON READ/31H IN ORDER OF FORMAT OCCURRENC
1E//40H CARD 9876.54 98.7654E2 9876.54/
2 40H DESC 2PF8.3 -2PE9.4 F9.4/
3 40H TO BE 98.7654 .9877E+04 987654.00/
4 4H IS, F12.4, E12.4, F12.2//
5 40H CARD 987.654 864786D-4 86.4786E2/
6 40H DESC 0PG9.4 D9.4 -2PE9.4/
7 40H TO BE 987.654 .8648D-02 .8648E+04/
8 4H IS, F12.3,D12.4, E12.4//
9 40H CARD 86.4786 8657.87D0 9876.54/
A 40H DESC F9.4 D9.4 2PG9.4/
B 40H TO BE 8647.860 .8658D+04 98.77/
C4H IS,F12.3, D12.4, G16.4)
WRITE(NUVI,7145) EP1S(16),EP1S(17),EP1S(18),EP1S(19),
1 BC2D(1,4),EP1S(20),EP1S(22),BC2D(2,1),EP1S(23)
C***** SCALE FACTOR APPLIED TO F, E, D, G DESCRIPTORS
C***** ON WRITE, BUT, NOT ON READ
C***** INPUT CARD 35
7152 FORMAT(F8.2,E9.4,F9.2,G9.3,D9.0,E9.4,F9.4,D9.2,G9.4)
READ(IRVI,7152) AC1S(1),AC1S(2),AC1S(3),AC1S(4),
1 AC1D(4),AC1S(20),AC1S(23),AC1D(5),AC1S(24)
7153 FORMAT(/23H SCALE FACTOR ON WRITE/31H IN ORDER OF FORMAT OCCURRE
1NCE//40H CARD 9.87655 98.7654E2 9876.54/
2 40H DESC 2PF12.2 -2PE12.4 F12.4/
3 40H TO BE 987.65 .0099E+06 98.7654/
4 4H IS, 2PF12.2, -2PE12.4,F12.4//
5 40H CARD 987.654 864786D-3 86.4786E2/
6 40H DESC 1PG12.2 D12.4 -2PE12.4/
7 40H TO BE 9.88E+02 8.6479D+02 .0086E+06/
8 4H IS, 1PG12.2, D12.4, -2PE12.4//
9 40H CARD 86.4786 8657.86D0 9876.54/
A 40H DESC 2PF12.2 1PD12.4 2PG16.4/
B 40H TO BE 8647.86 8.6579D+03 9877./
C 4H IS, 2PF12.2, 1PD12.4, 2PG16.4//
H28H THE LAST TWO LINES OF EACH/24H SET SHOULD BE THE SAME)
WRITE(NUVI,7153) AC1S(1),AC1S(2),AC1S(3),AC1S(4),
1 AC1D(4),AC1S(20),AC1S(23),AC1D(5),AC1S(24)
C***** I/O FORMAT RESCAN
C***** INPUT CARDS 36, 37, 38
7146 FORMAT( I1,I2,I3)
READ(IRVI,7146) I2I,IAC1I
7147 FORMAT(/ 37H FORMAT RESCAN - THE SECOND GROUP OF/38H EACH SET SH
1OULD AGREE WITH THE FIRST //15H 1 22 333/15H 4 55 666/
115H 7 88 999/1H )
WRITE(NUVI,7147)
7148 FORMAT(I4,I5,I6)
WRITE(NUVI,7148) I2I(1,1),I2I(2,1),I2I(1,2),I2I(2,2),IAC1I
C***** INPUT CARDS 39, 40
7149 FORMAT(I4, 2(I1,1X,I2))
READ( IRVI,7149) I2I, IAC1I
7150 FORMAT(/21H 2 ** 4 $$ 6 ((/7H 8 $$/1H )
WRITE( NUVI,7150)
7151 FORMAT (I4,3H **,1(I4,3H $$,(I4,3H (()))
WRITE( NUVI,7151) I2I(2,1),I2I(2,2),IAC1I(2),IAC1I(4)
C***** END OF TEST SEGMENT 008
C***** WHEN EXECUTING ONLY SEGMENT 008 , THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED
C= STOP
C= END
C***********************************************************************
C*****
C***** AFRMT - (009)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** TO TEST SIMPLE FORMAT AND FORMATTED I/O STATEMENTS 7.1.3.2.2
C***** WHICH USE A-CONVERSION SO THAT THIS FEATURE MAY 7.1.3.2.2
C***** BE USED IN OTHER SEGMENTS 7.1.3.2.3
C***** 7.2.3
C***** 7.2.3.8
C***** RESTRICTIONS OBSERVED
C***** * ALL FORMAT STATEMENTS ARE LABELED 7.2.3 /57
C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 7.2.3.3/54
C***** * FIELD WIDTH IS NEVER ZERO 7.2.3 /18
C***** * IF THERE IS AN I/O LIST, THE FORMAT STATEMENT 7.2.3.4/22
C***** CONTAINS AT LEAST ONE FIELD DESCRIPTOR (OTHER
C***** THAN H OR X)
C***** * ITEMS IN I/O LIST CORRESPOND TO FORMAT DESCRIPTORS 7.2.3.4/36
C***** * FIELD WIDTH NEVER EXCEEDED BY OUTPUT 7.2.3.6/01
C*****
C***** READ AND WRITE STATEMENTS FOR ENTIRE SEGMENT FOLLOW
C*****
C***** FORMATTED READ AND WRITE STATEMENTS WITH ALL 7.1.3.2.1/25
C***** TYPES OF FIELDS. ONLY A (HOLLERITH) CONVERSION 7.2.3.8 /16
C***** IS USED IN THE FORMAT STATEMENTS. SOME A FORMAT 7.2.3.3 /01
C***** DESCRIPTORS ARE REPEATED
C INPUT DATA TO THIS SEG. CONSISTS OF 3 DATA CARD IMAGES IN COLS. 1 - 55
COL. 1-----------------------------31---------------------55
CARD 1 B=EF-*JKL/()012TUVW+,.$X YZACDGHIPQRSMNO678(C)B2$9+A345
CARD 2 QZ1*A
CARD 3 ABCDEFGHIJKLMNOPQRSTUVWXYZ
C*****
C***** S P E C I F I C A T I O N S SEGMENT 009
C*****
C***** WHEN EXECUTING ONLY SEGMENT 009, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION A1S(5),A3S(3,3,3),EP1S(33),IAC2I(2,7),AC2S(5,6)
C= 1,MCA1I(5),CMA1S(5)
C= INTEGER BVI,MAVI,LAVI,MCA3I(2,3,3)
C= REAL MVS,CVS,BCVS
C= LOGICAL MCA1B(7), A1B(2), A2B(2,2),A3B(2,2,2),AVB,EVB
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS
C*****
C***** WHEN EXECUTING ONLY SEGMENT 009, THE FOLLOWING TWO STATEMENTS
C***** NUVI = 6 AND IRVI = 5 MUST HAVE
C***** THE C= IN COL 1 AND 2 REMOVED.
C= NUVI = 6
C= IRVI = 5
C*****
WRITE (NUVI,0090)
READ (IRVI,0091) MVS, IAC2I(2,2),MAVI ,AC2S(4,2),MCA1I(1),LAVI,
1 A2B(1,2),A1B(2), BCVS, MCA1B(2), BVI, CVS, EVB,A1S(2),EP1S(9),
2A3S(1,1,1),A3B(2,2,1),MCA3I(1,2,3), MCA3I(2,1,2), MCA3I(1,1,3)
WRITE (NUVI,0092) BVI, MVS, CVS, MAVI, EVB, MCA1I(1), EP1S(9),
1 A1S(2), A1B(2), MCA1B(2), IAC2I(2,2), AC2S(4,2),
2 LAVI, BCVS, A2B(1,2), MCA3I(1,1,3), A3S(1,1,1),
3 MCA3I(2,1,2), MCA3I(1,2,3), A3B(2,2,1)
C***** FORMATTED READ AND WRITE TO TEST HOLLERITH FIELDS 7.2.3.8/22
C***** WHERE FIELD WIDTH IS LESS THAN THE WORD LENGTH 7.2.3.8/28
C***** CAPACITY OF THE MACHINE
WRITE (NUVI,0093)
READ (IRVI,0094) CMA1S(2), CMA1S(1), LCCVI, AVB, BVI
WRITE (NUVI,0095) BVI, AVB, CMA1S(2), LCCVI, CMA1S(1)
C***** FORMATTED READ AND WRITE TO TEST HOLLERITH FIELDS 7.2.3.8/20
C***** WHERE FIELD WIDTH IS GREATER THAN THE WORD LENGTH 7.2.3.8/25
C***** CAPACITY OF THE MACHINE
WRITE (NUVI,0096)
READ (IRVI,0097) MRRVI
WRITE (NUVI,0098) MRRVI
C*****
C*****
C***** FORMAT STATEMENTS FOR THE ENTRIRE SEGMENT FOLLOW
C***** FORMATS TO TEST A CONVERSION. FIELD WIDTH IS 7.2.3.8/16
C***** FROM 1 TO 4 CHARACTERS. SOME A DESCRIPTORS ARE 7.2.3.3/01
C***** REPEATED.
0090 FORMAT (1H1,1X,26HAFRMT - (009) A-CONVERSION//2X,
117HASA REF - 7.2.3.8//40H EACH PAIR OF LINES SHOULD BE IDENTICAL/
28X,26HFOR COMPUTERS STORING FOUR/8X,27HOR MORE CHARACTERS PER WORD
3)
0091 FORMAT ( 2(A1), 2(A2), 3(A3), 3(A4), A1, A2, A3, A4, 6(A3))
0092 FORMAT (// 29H ABCDEFGHIJKLMNOPQRSTUVWX YZ/ 2X, 2(A1), 2(A2),
1 3(A3), 3(A4)//12H =-*/()+,.$/ 2X, A1, A2, A3, A4 //
2 20H 0123456789+AB2$(C)/ 2X, 6 A3 )
C***** FORMATS TO TEST A CONVERSION WHERE FIELD WIDTH 7.2.3.8/22
C***** IS LESS THAN THE WORD LENGTH CAPACITY OF MACHINE 7.2.3.8/28
0093 FORMAT (//35H TEST A CONVERSION - ADDING BLANKS/40H EACH PAIR OF
1 LINES SHOULD BE IDENTICAL)
0094 FORMAT ( 5(A1))
0095 FORMAT (//4H A / 3X, A3//4H */ 3X, A3 //4H Q/ 3X, A3//
1 4H 1/3X, A3 //4H Z/ 3X,A3)
C***** FORMATS TO TEST A CONVERSION WHERE FIELD WIDTH 7.2.3.8/20
C***** IS GREATER THAN WORD LENGTH CAPACITY OF MACHINE 7.2.3.8/25
0096 FORMAT(/25H TEST A FIELD TRUNCATION/37H 2ND LINE SHOULD PARTIALL
1Y MATCH 1ST)
0097 FORMAT ( A26 )
0098 FORMAT (// 28H ABCDEFGHIJKLMNOPQRSTUVWXYZ/ 2X, A26)
C***** END OF TEST SEGMENT 009
C***** WHEN EXECUTING ONLY SEGMENT 009 , THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED
C= STOP
C= END
C***********************************************************************
C*****
C***** DATA2 - (010)
C*****
C***********************************************************************
C*****
C***** GENERAL PURPOSE
C***** TO TEST CONTENTS OF VARIABLES THAT WERE FORMED BY
C***** DATA STATEMENTS IN SEG. DATA1 - (003)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 010, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI,100)
100 FORMAT (1H1,1X, 32HDATA2 - (010) DATA STATEMENT USE/
A /2X,17HASA REFS. - 7.2.2//2X,7HRESULTS)
WRITE (NUVI,101)
101 FORMAT(/35H LINE 1 OF EACH GROUP IS HOLLERITH/36H INFORMATION. T
AEST IS SUCCESSFUL IF/37H EACH GROUP CONTAINS THE SAME VALUES)
WRITE (NUVI,102) I1I(1), I1I(2), IAC2I(1,5), IAC2I(1,3),
A MCA3I(1,2,1), MCA3I(2,2,2), I1I(3), I1I(4),
B IAC2I(2,5), IAC2I(2,6), MCA3I(2,1,1),
C MCA3I(1,2,2), I1I(5), IAC2I(2,4), MCA3I(1,1,2),
D AVI
102 FORMAT ( /25X,1H0/4(I26/)//
A 24X,2H10/4(I26/)//
B 23X,3H246/4(I26/)//
C 22X,4H-750/4(I26/))
WRITE (NUVI,103) EP1S(8), EP1S(10), EP1S(13), AC2S(2,6),
A AC2S(1,6),AC3S(1,1,1),EP1S(11),AC2S(5,3),
B AC2S(3,6), AC2S(5,2), AC3S(1,1,2), AC2S(4,6),
C EP1S(12), AC2S(5,5), AC2S(5,6), JVS
103 FORMAT ( /22X,4H0.00/4(F26.2/)//
A 20X,6H246.15/4(F26.2/)//
B 19X,7H3546.74/4(F26.2/),
C 1H1,18X,7H-750.05/4(F26.2/))
WRITE (NUVI,104)ADSVC, LL1C(29), LN3C(9,1,2), LN3C(8,2,1),
A BCVC, LL1C(30), LM2C(8,4), LN3C(8,2,2),
B CHEVC, LL1C(31), LM2C(8,3), LN3C(9,1,1),
C DCVC, LL1C(32), LM2C(8,2), LN3C(8,1,2)
104 FORMAT ( /9X,17H 11.1 22.22/4(F14.1,F12.2/)//
A 8X,18H-34.50 -6.78/4(F14.2,F12.2/)//
B 8X,18H 10.00 -20.00/4(F14.2,F12.2/)//
C 5X,21H -200.00 4000.00/4(F14.2,F12.2/))
WRITE (NUVI,105) AVD, A1D(1), DPA2D(1,1), MCA3D(1,1,1),
A BVD, A1D(2), DPA2D(2,1), MCA3D(1,1,2),
B CVD, A1D(3),DPA2D(1,2), MCA3D(1,3,1),
C DVD, A1D(4), DPA2D(2,2), MCA3D(1,4,1)
105 FORMAT ( /16X,10H-0.295D+05/4(D26.3/)//
A 11X,15H0.345678901D+05/4(D26.9/)//
B 13X,13H0.1122335D-02/4(D26.7/),
C 1H1,17X,8H0.34D+13/4(D26.2/))
WRITE (NUVI,106) MAVB, MCA1B(6), GH2 B(1,1), GI3B(1,1,1),
A MBVB, MCVB, MCA1B(7), GH2B(1,2), GG1B(1),
B EP1S(15), GI3B(1,1,2),
C EP1S(14), AC3S(1,1,3), IAC2I(1,4)
106 FORMAT (//20X,4H T/ 4(L24/)//
A 20X,4H F/ 4(L24/)//
B 22X,2HAD /2(22X,A2/)/
C 22X,2HNO / 22X,A2//
D 22X,2HBC / 22X,A2//
E 22X,2H*= / 22X,A2//
F 22X,2H P / 22X,A2)
C***** END OF SEGMENT 010
C***** WHEN EXECUTING ONLY SEGMENTS 003 AND 010, THE STOP AND END
C***** CARDS WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED
C= STOP
C= END
C***********************************************************************
C*****
C***** AASGN - (011)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** * TO TEST VERY SIMPLE ARITHMETIC ASSIGNMENT 7.1.1.1
C***** STATEMENTS, SO THAT THIS STATEMENT MAY BE
C***** USED IN LATER SEGMENTS
C***** * TO TEST THAT ALL TYPES OF INTEGER AND REAL CONSTANTS 5.1.1
C***** MAY BE FORMED 5.1.1.1
C***** 5.1.1.2
C***** GENERAL COMMENTS
C***** * ONLY REAL AND INTEGER TYPES ARE INCLUDED IN
C***** THIS SEGMENT - NO MIXING OF TYPES
C***** * IN ORDER NOT TO EXCEED THE WORD LENGTH CAPACITY OF
C***** SOME COMPUTERS, INTEGER CONSTANTS ARE LIMITED TO
C***** 5 DIGITS AND REAL CONSTANTS TO 7 DIGITS.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 011
C*****
C***** WHEN EXECUTING ONLY SEGMENT 011, THE SPECIFICATION STATEMENT
C***** WHICH APPEARS AS A COMMENT MUST HAVE THE C= REMOVED
C= DIMENSION IAC1I(5),IAC2I(2,7),AC1S(25),AC2S(5,6),A2S(2,2)
C*****
C***** O U T P U T T A P E ASSIGNMENT - NO INPUT DATA
C*****
C***** WHEN EXECUTING ONLY SEGMENT 011, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,110)
110 FORMAT (1H1,1X,38HASSIGN - (011) SIMPLE REAL AND INTEGER/10X,32HAR
1ITHMETIC ASSIGNMENT STATEMENTS/2X,16HASA REF. - 7.1.1//34H LINE 1
2 OF EACH PAIR IS HOLLERITH/13H INFORMATION//17H INTEGER RESULTS)
C***** HEADER FOR SEGMENT 011 WRITTEN
C***** TEST ASSIGNMENT OF UNSIGNED INTEGER CONSTANTS 7.1.1.1/40
C***** TO VARIABLES 5.1.1.1/15
MRRVI = 1
JACVI = 12345
KBCVI = 000
C***** TEST ASSIGNMENT OF SIGNED INTEGER CONSTANTS TO 7.1.1.1/40
C***** VARIABLES 5.1.1/11
MCAVI = +2
LCCVI = -3
MDCVI = -98765
NECVI = +36912
C***** TEST ASSIGNMENT OF UNSIGNED INTEGER CONSTANTS 7.1.1.1/40
C***** TO ARRAYS 5.1.1.1/15
IAC1I(1) = 0
IAC2I(2,1) = 02468
IAC2I(2,2) = 00
IAC1I(3) = 4444
C***** TEST ASSIGNMENT OF SIGNED INTEGER CONSTANTS 7.1.1.1/40
C***** TO ARRAYS 5.1.1/11
IAC2I(1,1) = +45
IAC1I(4) = +54321
IAC1I(2) = -23
IAC2I(1,2) = -43123
C***** TEST ASSIGNMENT OF UNSIGNED REAL CONSTANTS 7.1.1.1/40
C***** TO VARIABLES (BASIC REAL CONSTANTS) 5.1.1.2/18
ACVS = 1.0
BCVS = 358.6724
C***** TEST ASSIGNMENT OF SIGNED REAL CONSTANTS 7.1.1.1/40
C***** TO VARIABLES (BASIC REAL CONSTANTS) 5.1.1.2/18
C***** 5.1.1/11
CCVS = -2.0
DCVS = +3.0
ECVS = -2714.250
FCVS = +29.30542
C***** TEST ASSIGNMENT OF UNSIGNED REAL CONSTANTS 7.1.1.1/40
C***** TO ARRAYS (BASIC REAL CONSTANTS) 5.1.1.2/18
C***** 5.1.1/11
AC1S(2) = 86.27
AC2S(1,2) = 1034.2
AC1S(1) = 0.0
AC2S(1,1) = 0.00000
C***** TEST ASSIGNMENT OF SIGNED REAL CONSTANTS 7.1.1.1/40
C***** TO ARRAYS (BASIC REAL CONSTANTS) 5.1.1.2/18
C***** 5.1.1/11
AC2S(2,2) = +345.678
AC1S(3) = -2.5
AC2S(2,1) = -5.66
AC1S(4) = +1.111111
C***** TEST ASSIGNMENT OF UNSIGNED AND SIGNED REAL 5.1.1.2/22
C***** CONSTANTS WITH NO DECIMAL DIGITS TO BOTH
C***** VARIABLES AND ARRAYS
GCVS = 1.
HCVS = -2.
AADVS = +3.
AC2S(3,1) = 4.
AC2S(1,3) = +5.
AC1S(5) = -6.
C***** TEST ASSIGNMENT OF UNSIGNED AND SIGNED REAL 5.1.1.2/22
C***** CONSTANTS WITH NO INTEGER PART TO BOTH
C***** VARIABLES AND ARRAYS
BBDVS = .0
CCDVS = +.23
DDDVS = -.716
AC1S(6) = -.7
AC2S(4,1) = .81
AC1S(7) = +.9
C***** TEST ASSIGNMENT OF UNSIGNED AND SIGNED REAL 5.1.1.2/25
C***** CONSTANTS WITH UNSIGNED AND SIGNED DECIMAL 5.1.1.2/32
C***** EXPONENTS TO BOTH VARIABLES AND ARRAYS
EEDVS = 1.05E02
FFDVS = -7.6E1
GGDVS = +332.4E0
HHDVS = 51.32E-1
OODVS = +5.34E-3
PPDVS = -14.19E-2
QQDVS = -9.9E+2
RRDVS = +10.5210E+3
SSDVS = 4.56E+1
AC2S(1,4) = 665.2E0
AC1S(11) =-52.9E01
AC1S(9) = +78.564E2
AC2S(5,1) = -3.4567E+3
AC2S(1,5) = 61.62E+2
AC1S(10) = +0.023E+1
AC1S(8) = 94.333E-1
AC1S(12) = +0.3524E-2
AC2S(3,2) = -743.2E-3
C***** TEST ASSIGNMENT OF UNSIGNED AND SIGNED REAL 5.1.1.2/22
C***** CONSTANTS (NO DECIMAL PART) WITH DECIMAL 5.1.1.2/26
C***** EXPONENTS TO BOTH VARIABLES AND ARRAYS
TTDVS = 1.E0
UUDVS = +123.E2
VVDVS = -11.E3
WWDVS = 144.E-1
XXDVS = -12.E-2
YYDVS = +3645.E-3
ZZDVS = 1.E+4
CMAVS = -200.E+1
CMBVS = +99.E+2
AC1S(13) = +0.E00
AC2S(2,5) = -1512.E2
AC2S(4,3) = 214.E3
AC1S(15) = 34.E-1
AC1S(14) = -4.E-2
AC2S(3,4) = +53214.E-4
AC2S(4,4) = +6.E+3
AC2S(2,3) = 72.E+4
AC1S(16) = -813.E+1
C***** TEST ASSIGNMENT OF UNSIGNED AND SIGNED REAL 5.1.1.2/22
C***** CONSTANTS (NO INTEGER PART) WITH DECIMAL 5.1.1.2/26
C***** EXPONENTS TO BOTH VARIABLES AND ARRAYS
CMCVS = .234E0
CMDVS = -.3E2
CMEVS = +.44E1
CMFVS = .36E-3
CMGVS = +.9E-4
CMHVS = -.10E-2
CMOVS = .777E+1
CMPVS = -.29E+3
CMQVS = +.04E+2
AC1S(17) = .90E1
AC2S(4,2) = +.810E0
AC1S(19) = -.7E3
AC2S(3,3) = .62E+3
AC1S(21) = +.5310E+1
A2S(1,2) = -.442E+2
AC1S(18) = .3E-4
AC2S(2,4) = +.25E-03
A2S(2,1) = -.163E-2
C***** TEST ASSIGNMENT OF UNSIGNED AND SIGNED REAL 5.1.1.2/34
C***** CONSTANTS (FORMED BY PLACING DECIMAL EXPONENT
C***** AFTER INTEGER CONSTANT) TO BOTH VARIABLES AND
C***** ARRAYS
AVS = 709E3
BVS = +81842E0
CVS = -9E5
DVS = 627E+2
EVS = +53E+3
FVS = -4E+04
GVS = 1463E-2
HVS = +2E-3
PVS = -355E-1
AC1S(24) = 29E5
AC1S(20) = +4072E3
AC2S(5,4) = -61835E2
AC2S(3,5) = 829E+1
AC1S(22) = +03E+2
AC1S(25) = -1E+3
AC2S(4,5) = 3404E-4
A2S(2,2) = +55E-5
AC1S(23) = -761E-1
C***** VERIFY CORRECTNESS OF ASSIGNMENT BY WRITING
C***** THE INFORMATION
WRITE (NUVI,111) MRRVI, JACVI, KBCVI, MCAVI, LCCVI, MDCVI, NECVI,
1 (IAC1I(IVI),IVI=1,4),((IAC2I(IVI,JVI),IVI=1,2),JVI=1,2)
WRITE (NUVI,112)
WRITE (NUVI,113) ACVS, BCVS, CCVS, DCVS, ECVS, FCVS, AC1S(2),
1 AC2S(1,2), AC1S(1), AC2S(1,1), AC2S(2,2),
2 AC1S(3), AC2S(2,1), AC1S(4), GCVS, HCVS,
3 AADVS, AC2S(3,1)
WRITE (NUVI,114) AC2S(1,3), AC1S(5), BBDVS, CCDVS, DDDVS, AC1S(6),
1 AC2S(4,1), AC1S(7), EEDVS, FFDVS, GGDVS, HHDVS,
2 OODVS, PPDVS, QQDVS, RRDVS, SSDVS
WRITE (NUVI,115) AC2S(1,4), AC1S(11), AC1S(9), AC2S(5,1),
1 AC2S(1,5), AC1S(10), AC1S(8), AC1S(12),
2 AC2S(3,2), TTDVS, UUDVS, VVDVS, WWDVS, XXDVS,
3 YYDVS
WRITE (NUVI,116) CMAVS, CMBVS, AC1S(13), AC2S(2,5), AC2S(4,3),
1 AC1S(15), AC1S(14), AC2S(3,4), AC2S(4,4),
2 AC2S(2,3), AC1S(16), CMCVS, CMDVS, CMEVS,ZZDVS
WRITE (NUVI,117) CMFVS, CMGVS, CMHVS, CMOVS, CMPVS, CMQVS,
1 AC1S(17), AC2S(4,2), AC1S(19), AC2S(3,3),
1 AC1S(21),A2S(1,2),AC1S(18), AC2S(2,4),A2S(2,1)
WRITE (NUVI,118) AVS, BVS, CVS, DVS, EVS, FVS, GVS, HVS, PVS,
1 AC1S(24), AC1S(20), AC2S(5,4), AC2S(3,5),
2 AC1S(22),AC1S(25),AC2S(4,5),A2S(2,2) ,
3 AC1S(23)
111 FORMAT(/7X,1H1,7X,5H12345,13X,1H0/1X,I7,5X,I7,7X,I7//
1 7X, 1H2, 10X, 2H-3,8X, 6H-98765/1X, I7, 5X, I7, 7X, I7//
2 3X, 5H36912, 11X, 1H0, 11X, 3H-23/ 1X, I7, 5X, I7, 7X,I7//
3 4X, 4H4444, 7X, 5H54321, 12X, 2H45/ 1X, I7, 5X, I7, 7X, I7//
4 4X, 4H2468, 6X, 6H-43123, 13X, 1H0/ 1X, I7, 5X, I7, 7X, I7)
112 FORMAT (/14H REAL RESULTS)
113 FORMAT(/3X,3H1.0, 10X, 8H358.6724, 6X, 4H-2.0/1X,F5.1,6X,F12.4,2X,
1 F8.1//3X,3H3.0,8X,9H-2714.250,7X,8H29.30542/1X,F5.1,6X,F11.3,3X,
2 F12.5//2X,5H86.27,8X,6H1034.2,10X,3H0.0/1X,F6.2,5X,F9.1,5X,F8.1//
3 3X, 3H0.0, 10X,7H345.678,7X, 4H-2.5/1X,F5.1,6X,F11.3,3X,F8.1//
4 2X,5H-5.66,11X,8H1.111111,5X,3H1.0/1X,F6.2,5X,F14.6,F8.1//
5 2X,4H-2.0,12X,3H3.0,10X,3H4.0/1X,F5.1,6X,F9.1,5X,F8.1)
114 FORMAT(/3X,3H5.0,11X,4H-6.0,10X,3H0.0/1X,F5.1,6X,F9.1,5X,F8.1//
1 3X,4H0.23,10X,6H-0.716,7X,4H-0.7/1X,F6.2,5X,F11.3,3X,F8.1//
2 3X,4H0.81,11X,3H0.9/1X,F6.2,5X,F9.1/1H1,2X,9H0.105E+03,3X,
3 9H-0.76E+02,5X,10H0.3324E+03/E12.3,E12.2,E15.4//
4 3X,10H0.5132E+01,3X,9H0.534E-02,3X,11H-0.1419E+00/E13.4,E12.3,
5 E14.4//2X,9H-0.99E+03,5X,12H0.105210E+05,10H 0.456E+02/E11.2,
6 E17.6,E10.3)
115 FORMAT(/3X,10H0.6652E+03,2X,10H-0.529E+03,4X,11H0.78564E+04/E13.4,
1 E12.3,E15.5//2X,12H-0.34567E+04,2X,10H0.6162E+04,3X,8H0.23E+00/
2 E14.5,E12.4,E11.2//3X,11H0.94333E+01,2X,10H0.3524E-02,2X,
3 11H-0.7432E+00/E14.5,E12.4,E13.4//3X,7H0.1E+01,6X,9H0.123E+05,
4 3X,9H-0.11E+05/E10.1,E15.3,E12.2//3X,9H0.144E+02,3X,9H-0.12E+00,
5 5X,10H0.3645E+01/E12.3,E12.2,E15.4)
116 FORMAT(/12H -0.200E+04,4X,8H0.99E+04,5X,7H0.0E+00/E12.3,E12.2,
1 E12.1//2X,11H-0.1512E+06,3X,9H0.214E+06,4X,8H0.34E+01/E13.4,
2 E12.3,E12.2//2X,8H-0.4E-01,6X,11H0.53214E+01,2X,7H0.6E+04/E10.1,
3 E17.5,E9.1//3X,8H0.72E+06,4X,10H-0.813E+04,4X,9H0.234E+00/E11.2,
4 E14.3,E13.3//2X,8H-0.3E+02,6X,8H0.44E+01,5X,7H0.1E+05/E10.1,
5 E14.2,E12.1)
117 FORMAT(/3X,8H0.36E-03,5X,7H0.9E-04,5X,9H-0.10E-02/E11.2,E12.1,
1 E14.2//3X,9H0.777E+01,3X,9H-0.29E+03,5X,7H0.4E+01/E12.3,E12.2,
2 E12.1//3X,8H0.90E+01,5X,9H0.810E+00,3X,8H-0.7E+03/E11.2,E14.3,
3 E11.1//3X,8H0.62E+03,5X,10H0.5310E+01,2X,10H-0.442E+02/E11.2,
4 E15.4,E12.3//3X,7H0.3E-04,6X,8H0.25E-03,4X,10H-0.163E-02/E10.1,
5 E14.2,E14.3/1H1)
118 FORMAT(3X,9H0.709E+06,4X,11H0.81842E+05,1X,8H-0.9E+06/E12.3,E15.5,
1 E9.1//3X,9H0.627E+05,4X,8H0.53E+05,4X,8H-0.4E+05/E12.3,E12.2,
2 E12.1//3X,10H0.1463E+02,3X,7H0.2E-02,5X,10H-0.355E+02/E13.4,
3 E10.1,E15.3//3X,8H0.29E+07,5X,10H0.4072E+07,2X,12H-0.61835E+07/
4 E11.2,E15.4,E14.5//3X,9H0.829E+04,4X,7H0.3E+03,5X,8H-0.1E+04/
5 E12.3,E11.1,E13.1//3X,10H0.3404E+00,3X,8H0.55E-03,4X,10H-0.761E+0
62/E13.4,E11.2,E14.3)
C***** END OF TEST SEGMENT 011
C***** WHEN EXECUTING ONLY SEGMENT 011, THE STOP AND END CARDS
C**** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED
C= STOP
C= END
STOP
END
nbs02.d 480890330 170 2 100666 302 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2 . DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4 . DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6 DOUBLE SPACE ON OUTPUT ID 6
nbs02.f 480887307 170 2 100666 39962 `
C***** PART2 *****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 2 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** DASGN - 013 SIMPLE D.P. ASSIGNMENT STATEMENTS
C*****
C***** CASGN - 015 SIMPLE COMPLEX ASSIGNMENT STATEMENTS
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN
C***** SEGMENTS 013 AND 015 ARE RUN AS ONE MAIN PROGRAM.
C*****
DOUBLE PRECISION MCAVD,MCBVD,MCCVD,MCDVD,MCEVD,MCFVD,MCGVD,
1MCHVD,MCIVD,EEDVD,ACVD,BCVD,CCVD,DCVD,DDDVD,CCDVD,FFDVD,GGDVD,
2 HHDVD,EP1D(43),AC1D(10),BC2D(7,4),CC3D(7,2,2),FC2D(5,5)
DOUBLE PRECISION DPAVD,DPBVD,DPCVD,DPDVD,DPEVD,DPFVD,DPGVD,DPHVD,
1 DPIVD,DPJVD,DPKVD,DPLVD,DPMVD,DPNVD,DPOVD,DPPVD,
2 AADVD,BBDVD,PPDVD,RRDVD,SSDVD,TTDVD,UUDVD,VVDVD,WWDVD,XXDVD,
3 YYDVD,ZZDVD,ECVD,FCVD,GCVD,HCVD,RC3D(3,3,3),MCJVD,MCKVD
COMPLEX QEVC,QFVC,QGVC,QHVC,QIVC,QJVC,QKVC,QLVC,QMVC,QNVC,QOVC,
1 QPVC,QRVC,QSVC,QTVC,QUVC,QVVC,KVC,LVC,MVC,NVC,OVC,PVC,QVC,VVC,
2 MEVC,MFVC,MGVC,MHVC,MIVC,QQVC,MJVC,MKVC,MLVC, MNVC,MOVC,
3 MPVC,MQVC,MRVC,MSVC,MTVC,MUVC,MVVC,BCVC,DCVC,DDVC
COMPLEX AVC,BVC,CVC,DVC,EVC,FVC,GVC,HVC,IVC,JVC,AAVC,
1 ABVC,BAVC,BBVC,CCVC,CDVC,CAVC,DAVC,ASVC,BSVC,CSVC,
2 DSVC,AAAVC,ABAVC,ACAVC,ADAVC,CHCVC
COMPLEX NUMVC, QAVC,QBVC,QCVC,QDVC,RVC,SVC,TVC,UVC
1 , MAVC,MBVC,MCVC,MDVC,B1C(8),B2C(4,2),B3C(2,2,2)
COMPLEX LL1C(32),LM2C(8,4),LN3C(9,2,2),A1C(12),A2C(2,2),A3C(2,2,1)
C***** END OF SPECIFICATIONS FOR SEGMENTS 013, 015
C*****
C***********************************************************************
C*****
C***** DASGN - (013)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** * TO TEST ALL POSSIBLE METHODS OF FORMING DOUBLE 5.1.1 THRU
C***** PRECISION CONSTANTS
C***** * TO TEST THAT D.P. VARIABLES AND ARRAY 5.1.2 /5
C***** ELEMENTS MAY BE REFERENCED 5.1.3.1/16
C***** * TO TEST VERY SIMPLE ARITHMETIC ASSIGNMENT 7.1.1.1
C***** STATEMENTS, SO THAT THIS FEATURE CAN BE USED TABLE 1
C***** FOR INITIALIZATION IN LATER SEGMENTS
C***** S P E C I F I C A T I O N S SEGMENT 013
C*****
C***** WHEN EXECUTING ONLY SEGMENT 013, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH APPEAR
C***** AS COMMENTS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION MCAVD,MCBVD,MCCVD,MCDVD,MCEVD,MCFVD,MCGVD,
C= 1MCHVD,MCIVD,EEDVD,ACVD,BCVD,CCVD,DCVD,DDDVD,CCDVD,FFDVD,GGDVD,
C= 2 HHDVD,EP1D(43),AC1D(10),BC2D(7,4),CC3D(7,2,2),FC2D(5,5)
C= DOUBLE PRECISION DPAVD,DPBVD,DPCVD,DPDVD,DPEVD,DPFVD,DPGVD,DPHVD,
C= 1 DPIVD,DPJVD,DPKVD,DPLVD,DPMVD,DPNVD,DPOVD,DPPVD,
C= 2 AADVD,BBDVD,PPDVD,RRDVD,SSDVD,TTDVD,UUDVD,VVDVD,WWDVD,XXDVD,
C= 3 YYDVD,ZZDVD,ECVD,FCVD,GCVD,HCVD,RC3D(3,3,3),MCJVD,MCKVD
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS
C*****
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 2 ///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FO-TRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
WRITE (NUVI,130)
WRITE(NUVI,131)
130 FORMAT(1H1,1X,36HDASGN - (013) SIMPLE D.P. ARITHMETIC/
1 16X,18HASSIGNMENT STMNTS./2X,28HASA REFS. - 7.1.1.1 5.1.1.3//
2 2X,7HRESULTS)
131 FORMAT(/2X,23HLINE 1 OF EACH GROUP IS/
A 2X,21HHOLLERITH INFORMATION)
C***** HEADER FOR THIS SEGMENT WRITTEN
C***** TEST ASSIGNMENT OF UNSIGNED DP CONSTANTS WITH 7.1.1.1/41
C***** UNSIGNED EXPONENTS TO VARIABLES AND ARRAY ELEMENTS 5.1.1.3/40
C***** 5.1.1 /14
C***** 5.1.1.3/36
C***** 5.1.1.2/26
MCAVD = 3.4D1
MCBVD = 123456.7891011D02
AC1D(1) = 3.4D1
AC1D(2) = 123456.7891011D02
BC2D(1,1) = 3.4D1
BC2D(2,1) = 123456.7891011D02
CC3D(1,1,1) = 3.4D1
CC3D(2,1,1) = 123456.7891011D2
C***** ASSIGNMENT OF UNSIGNED DP CONSTANTS WITH 5.1.1.3/36
C***** SIGNED EXPONENTS TO VARIABLES AND ARRAY ELEMENTS 5.1.1.2/26
MCCVD = 29.8765234D-3
MCDVD = 345.10000555D+4
AC1D(3) = 29.8765234D-3
AC1D(4) = 345.10000555D+4
BC2D(3,1) = 29.8765234D-3
BC2D(4,1) = 345.10000555D+4
CC3D(3,1,1) = 29.8765234D-3
CC3D(4,1,1) = 345.10000555D+4
C***** ASSIGNMENT OF UNSIGNED DP CONSTANTS (NO DECIMAL 5.1.1.2/22
C***** PART) WITH UNSIGNED EXPONENTS TO VARIABLES
C***** AND ARRAY ELEMENTS
MCEVD = 22232425.D00
AC1D(5) = 22232425.D00
BC2D(5,1) = 22232425.D00
CC3D(5,1,1) = 22232425.D00
C***** ASSIGNMENT OF UNSIGNED DP CONSTANTS (NO 5.1.1.2/22
C***** INTEGER PART) WITH UNSIGNED EXPONENTS TO
C***** VARIABLES AND ARRAY ELEMENTS
MCFVD = .281420D5
AC1D(6) = .281420D5
BC2D(6,1) = .281420D5
CC3D(6,1,1) = .281420D5
C***** ASSIGNMENT OF UNSIGNED DP CONSTANTS (NO DECIMAL
C***** PART) WITH SIGNED EXPONENTS TO VARIABLES AND
C***** ARRAY ELEMENTS
MCGVD = 4455667788.D+6
MCHVD = 35692483569248.D-02
AC1D(7) = 4455667788.D+6
AC1D(8) = 35692483569248.D-02
BC2D(7,1) = 4455667788.D+6
BC2D(1,2) = 35692483569248.D-02
CC3D(7,1,1) = 4455667788.D+6
CC3D(1,2,1) = 35692483569248.D-2
C***** ASSIGNMENT OF UNSIGNED DP CONSTANTS (NO
C***** INTEGER PART) WITH SIGNED EXPONENTS TO
C***** VARIABLES AND ARRAY ELEMENTS
ACVD = .6549876D-3
BCVD = .78D+10
AC1D(9) = .6549876D-3
AC1D(10) = .78D+10
BC2D(2,2) = .6549876D-3
BC2D(3,2) = .78D+10
CC3D(2,2,1) = .6549876D-3
CC3D(3,2,1) = .78D+10
C***** ASSIGNMENT OF SIGNED DP CONSTANTS WITH 5.1.1 /12
C***** UNSIGNED EXPONENTS TO VARIABLES AND ARRAY
C***** ELEMENTS
CCVD = +0.0D0
DCVD = -17263544.5D3
EP1D(1) = +0.0D0
EP1D(2) = -17263544.5D3
BC2D(4,2) = +0.0D00
BC2D(5,2) = -17263544.5D3
CC3D(4,2,1) = +0.0D0
CC3D(5,2,1) = -17263544.5D3
C***** ASSIGNMENT OF SIGNED DP CONSTANTS WITH
C***** SIGNED EXPONENTS TO VARIABLES AND ARRAY
C***** ELEMENTS
ECVD = +1987.62D+1
FCVD = -2.54396621D+2
GCVD = +34.786529910234D-7
HCVD = -44.4D-10
EP1D(3) = +1987.62D+1
EP1D(4) = -2.54396621D+2
EP1D(5) = +34.786529910234D-7
EP1D(6) = -44.4D-10
BC2D(6,2) = +1987.62D+1
BC2D(7,2) = -2.54396621D+2
BC2D(1,3) = +34.786529910234D-7
BC2D(2,3) = -44.4D-10
CC3D(6,2,1) = +1987.62D+1
CC3D(7,2,1) = -2.54396621D+2
CC3D(1,1,2) = +34.786529910234D-07
CC3D(2,1,2) = -44.4D-10
C***** ASSIGNMENT OF SIGNED DP CONSTANTS (NO DECIMAL
C***** PART) WITH SIGNED EXPONENT TO VARIABLES AND
C***** ARRAY ELEMENTS
AADVD = +0.D+1
BBDVD = -123.D+17
CCDVD = +3692468.D-8
DDDVD = -147937824967.D-5
EP1D(7) = +0.D+1
EP1D(8) = -123.D+17
EP1D(9) = +3692468.D-8
EP1D(10) = -147937824967.D-5
BC2D(3,3) = +0.D+1
BC2D(4,3) = -123.D+17
BC2D(5,3) = +3692468.D-8
BC2D(6,3) = -147937824967.D-5
CC3D(3,1,2) = +0.D+1
CC3D(4,1,2) = -123.D+17
CC3D(5,1,2) = +3692468.D-8
CC3D(6,1,2) = -147937824967.D-5
C***** ASSIGNMENT OF SIGNED DP CONSTANTS (NO INTEGER
C***** PART) WITH SIGNED EXPONENTS TO VARIABLES AND
C***** ARRAY ELEMENTS
EEDVD = +.927786174985D+2
FFDVD = -.59354914223619D+0
GGDVD = +.98663271D-03
HHDVD = -.1D-15
EP1D(11) = +.927786174985D+2
EP1D(12) = -.59354914223619D+0
EP1D(13) = +.98663271D-03
EP1D(14) = -.1D-15
BC2D(7,3) = +.927786174985D+2
BC2D(1,4) = -.59354914223619D+0
BC2D(2,4) = +.98663271D-03
BC2D(3,4) = -.1D-15
CC3D(7,1,2) = +.927786174985D+2
CC3D(1,2,2) = -.59354914223619D+0
CC3D(2,2,2) = +.98663271D-3
CC3D(3,2,2) = -.1D-15
C***** ASSIGNMENT OF SIGNED DP CONSTANTS (NO DECIMAL
C***** PART) WITH UNSIGNED EXPONENTS TO VARIABLES
C***** AND ARRAY ELEMENTS
PPDVD = +3261294675.D12
RRDVD = -969492909.D4
EP1D(15) = +3261294675.D12
EP1D(16) = -969492909.D4
BC2D(4,4) = +3261294675.D12
BC2D(5,4) = -969492909.D4
CC3D(4,2,2) = +3261294675.D12
CC3D(5,2,2) = -969492909.D4
C***** ASSIGNMENT OF SIGNED DP CONSTANTS (NO INTEGER
C***** PART) WITH UNSIGNED EXPONENTS TO VARIABLES
C***** AND ARRAY ELEMENTS
SSDVD = +.001246085D3
TTDVD = -.59D2
EP1D(17) = +.001246085D3
EP1D(18) = -.59D2
BC2D(6,4) = +.001246085D3
BC2D(7,4) = -.59D2
CC3D(6,2,2) = +.001246085D3
CC3D(7,2,2) = -.59D2
C***** ASSIGNMENT OF DP CONSTANTS FORMED BY ADDING 5.1.1.3/42
C***** UNSIGNED EXPONENTS TO UNSIGNED INTEGERS
UUDVD = 798281392253D0
EP1D(19) = 798281392253D0
FC2D(1,1) = 798281392253D0
RC3D(1,1,1) = 798281392253D0
C***** ASSIGNMENT OF DP CONSTANTS FORMED BY ADDING
C***** SIGNED EXPONENTS TO UNSIGNED INTEGERS
VVDVD = 42921D+6
WWDVD = 793685443D-4
EP1D(20) = 42921D+6
EP1D(21) = 793685443D-4
FC2D(2,1) = 42921D+6
FC2D(3,1) = 793685443D-4
RC3D(2,1,1) = 42921D+6
RC3D(3,1,1) = 793685443D-4
C***** ASSIGNMENT OF DP CONSTANTS FORMED BY ADDING
C***** UNSIGNED EXPONENTS TO SIGNED INTEGERS
XXDVD = +33344455566D2
YYDVD = -222333444D1
EP1D(22) = +33344455566D2
EP1D(23) = -222333444D1
FC2D(4,1) = +33344455566D2
FC2D(5,1) = -222333444D1
RC3D(1,2,1) = +33344455566D2
RC3D(2,2,1) = -222333444D1
C***** ASSIGNMENT OF DP CONSTANTS FORMED BY ADDING
C***** SIGNED EXPONENTS TO SIGNED INTEGERS
ZZDVD = +1D+1
MCIVD = -2D+2
MCJVD = +33333333333333D-3
MCKVD = -444444444D-4
EP1D(24) = +1D+1
EP1D(25) = -2D+2
EP1D(26) = +33333333333333D-3
EP1D(27) = -444444444D-4
FC2D(1,2) = +1D+1
FC2D(2,2) = -2D+2
FC2D(3,2) = +33333333333333D-3
FC2D(4,2) = -444444444D-4
RC3D(3,2,1) = +1D+1
RC3D(1,3,1) = -2D+2
RC3D(2,3,1) = +33333333333333D-3
RC3D(3,3,1) = -444444444D-4
C***** ASSIGNMENT OF UNSIGNED DP VARIABLES AND ARRAY 7.1.1.1/41
C***** ELEMENTS TO DP VARIABLES AND ARRAY ELEMENTS
C***** (BOTH PLUS AND MINUS VALUES ARE ASSIGNED IN THIS
C***** WAY)
DPAVD = MCAVD
DPBVD = DCVD
DPCVD = EP1D(1)
DPDVD = EP1D(2)
DPEVD = BC2D(2,2)
DPFVD = BC2D(4,2)
DPGVD = CC3D(3,1,1)
DPHVD = CC3D(7,2,1)
EP1D(28) = DPAVD
EP1D(29) = DPBVD
EP1D(30) = EP1D(1)
EP1D(31) = EP1D(2)
EP1D(32) = BC2D(2,2)
EP1D(33) = BC2D(4,2)
EP1D(34) = CC3D(3,1,1)
EP1D(35) = CC3D(7,2,1)
FC2D(5,2) = DPAVD
FC2D(1,3) = DPBVD
FC2D(2,3) = EP1D(1)
FC2D(3,3) = EP1D(2)
FC2D(4,3) = BC2D(2,2)
FC2D(5,3) = BC2D(4,2)
FC2D(1,4) = CC3D(3,1,1)
FC2D(2,4) = CC3D(7,2,1)
RC3D(1,1,2) = MCAVD
RC3D(2,1,2) = DCVD
RC3D(3,1,2) = EP1D(1)
RC3D(1,2,2) = EP1D(2)
RC3D(2,2,2) = BC2D(2,2)
RC3D(3,2,2) = BC2D(4,2)
RC3D(1,3,2) = CC3D(3,1,1)
RC3D(2,3,2) = CC3D(7,2,1)
C***** ASSIGNMENT OF SIGNED DP VARIABLES AND ARRAY
C***** ELEMENTS TO DP VARIABLES AND ARRAY ELEMENTS
C***** (UNARY MINUS USED TO REVERSE BOTH PLUS AND 6.4 /44
C***** MINUS VALUES)
DPIVD = -GCVD
DPJVD = -DDDVD
DPKVD = -AC1D(3)
DPLVD = -EP1D(10)
DPMVD = -BC2D(3,1)
DPNVD = -BC2D(2,4)
DPOVD = -CC3D(2,1,1)
DPPVD = -CC3D(2,1,2)
EP1D(36) = -GCVD
EP1D(37) = -DDDVD
EP1D(38) = -AC1D(3)
EP1D(39) = -EP1D(10)
EP1D(40) = -BC2D(3,1)
EP1D(41) = -BC2D(2,4)
EP1D(42) = -CC3D(2,1,1)
EP1D(43) = -CC3D(2,1,2)
FC2D(3,4) = -GCVD
FC2D(4,4) = -DDDVD
FC2D(5,4) = -AC1D(3)
FC2D(1,5) = -EP1D(10)
FC2D(2,5) = -BC2D(3,1)
FC2D(3,5) = -BC2D(2,4)
FC2D(4,5) = -CC3D(2,1,1)
FC2D(5,5) = -CC3D(2,1,2)
RC3D(3,3,2) = -GCVD
RC3D(1,1,3) = -DDDVD
RC3D(2,1,3) = -AC1D(3)
RC3D(3,1,3) = -EP1D(10)
RC3D(1,2,3) = -BC2D(3,1)
RC3D(2,2,3) = -BC2D(2,4)
RC3D(3,2,3) = -CC3D(2,1,1)
RC3D(1,3,3) = -CC3D(2,1,2)
C***** WRITE RESULTS FOR THIS SEGMENT
WRITE (NUVI,132) MCAVD, AC1D(1), BC2D(1,1), CC3D(1,1,1), MCBVD,
A AC1D(2), BC2D(2,1), CC3D(2,1,1), MCCVD, AC1D(3), BC2D(3,1),
B CC3D(3,1,1), MCDVD, AC1D(4), BC2D(4,1), CC3D(4,1,1), MCEVD,
C AC1D(5), BC2D(5,1), CC3D(5,1,1), MCFVD, AC1D(6), BC2D(6,1),
D CC3D(6,1,1), MCGVD, AC1D(7), BC2D(7,1), CC3D(7,1,1), MCHVD,
E AC1D(8), BC2D(1,2), CC3D(1,2,1), ACVD, AC1D(9), BC2D(2,2),
F CC3D(2,2,1), BCVD, AC1D(10), BC2D(3,2), CC3D(3,2,1), CCVD,
G EP1D(1) , BC2D(4,2), CC3D(4,2,1), DCVD, EP1D(2) , BC2D(5,2),
H CC3D(5,2,1), ECVD, EP1D(3) , BC2D(6,2), CC3D(6,2,1), FCVD,
I EP1D(4) , BC2D(7,2), CC3D(7,2,1), GCVD, EP1D(5) , BC2D(1,3),
J CC3D(1,1,2), HCVD, EP1D(6) , BC2D(2,3), CC3D(2,1,2), AADVD,
K EP1D(7) , BC2D(3,3), CC3D(3,1,2), BBDVD, EP1D(8) , BC2D(4,3),
L CC3D(4,1,2), CCDVD, EP1D(9) , BC2D(5,3), CC3D(5,1,2), DDDVD,
M EP1D(10), BC2D(6,3), CC3D(6,1,2)
WRITE (NUVI,133) EEDVD, EP1D(11), BC2D(7,3), CC3D(7,1,2), FFDVD,
1 EP1D(12), BC2D(1,4), CC3D(1,2,2),GGDVD, EP1D(13), BC2D(2,4),
2 CC3D(2,2,2), HHDVD, EP1D(14), BC2D(3,4), CC3D(3,2,2), PPDVD,
3 EP1D(15), BC2D(4,4), CC3D(4,2,2), RRDVD, EP1D(16),BC2D( 5,4),
4 CC3D(5,2,2),SSDVD, EP1D(17), BC2D(6,4), CC3D(6,2,2), TTDVD,
5 EP1D(18), BC2D(7,4), CC3D(7,2,2)
WRITE (NUVI,134) UUDVD, EP1D(19), FC2D(1,1), RC3D(1,1,1), VVDVD,
1 EP1D(20), FC2D(2,1), RC3D(2,1,1), WWDVD, EP1D(21), FC2D(3,1),
2 RC3D(3,1,1), XXDVD, EP1D(22), FC2D(4,1), RC3D(1,2,1), YYDVD,
3 EP1D(23), FC2D(5,1), RC3D(2,2,1), ZZDVD, EP1D(24), FC2D(1,2),
4 RC3D(3,2,1), MCIVD, EP1D(25), FC2D(2,2), RC3D(1,3,1), MCJVD,
5 EP1D(26), FC2D(3,2), RC3D(2,3,1), MCKVD, EP1D(27), FC2D(4,2),
6 RC3D(3,3,1)
WRITE (NUVI,135) MCAVD, DPAVD, EP1D(28), FC2D(5,2), RC3D(1,1,2),
A DCVD, DPBVD, EP1D(29), FC2D(1,3), RC3D(2,1,2), EP1D(1),
B DPCVD, EP1D(30), FC2D(2,3), RC3D(3,1,2), EP1D(2), DPDVD,
C EP1D(31), FC2D(3,3), RC3D(1,2,2), BC2D(2,2), DPEVD, EP1D(32),
D FC2D(4,3), RC3D(2,2,2), BC2D(4,2), DPFVD, EP1D(33), FC2D(5,3),
E RC3D(3,2,2), CC3D(3,1,1), DPGVD, EP1D(34), FC2D(1,4),
F RC3D(1,3,2), CC3D(7,2,1), DPHVD, EP1D(35), FC2D(2,4),
G RC3D(2,3,2), GCVD, DPIVD, EP1D(36), FC2D(3,4), RC3D(3,3,2),
H DDDVD, DPJVD, EP1D(37), FC2D(4,4), RC3D(1,1,3), AC1D(3),
I DPKVD, EP1D(38), FC2D(5,4), RC3D(2,1,3), EP1D(10), DPLVD,
J EP1D(39), FC2D(1,5), RC3D(3,1,3), BC2D(3,1), DPMVD, EP1D(40),
K FC2D(2,5), RC3D(1,2,3), BC2D(2,4), DPNVD, EP1D(41), FC2D(3,5),
L RC3D(2,2,3), CC3D(2,1,1), DPOVD, EP1D(42), FC2D(4,5),
M RC3D(3,2,3), CC3D(2,1,2), DPPVD, EP1D(43), FC2D(5,5),
N RC3D(1,3,3)
132 FORMAT (/ 6X,8H0.34D+02/4(D14.2/)/
A 6X,19H0.1234567891011D+08/4(D25.13/)/
B 6X,15H0.298765234D-01/4(D21.9/)/
C 6X,17H0.34510000555D+07/4(D23.11/)/
D 6X,14H0.22232425D+08/4(D20.8/)/
E 6X,12H0.281420D+05/4(D18.6/)/
F 6X,16H0.4455667788D+16/4(D22.10/),
G 1H1,5X,20H0.35692483569248D+12/4(D26.14/)/
H 6X,13H0.6549876D-03/4(D19.7/)/
I 6X,8H0.78D+10/4(D14.2/)/
J 6X,7H0.0D+00/4(D13.1/)/
K 5X,16H-0.172635445D+11/4(D21.9/)/
L 6X,12H0.198762D+05/4(D18.6/)/
M 5X,16H-0.254396621D+03/4(D21.9/)/
N 6X,20H0.34786529910234D-05/4(D26.14/)/
O 5X,10H-0.444D-08/4(D15.3/),
P 1H1,5X,7H0.0D+00/4(D13.1/)/
Q 5X,10H-0.123D+20/4(D15.3/)/
R 6X,13H0.3692468D-01/4(D19.7/)/
S 5X,19H-0.147937824967D+07/4(D24.12/),1H )
133 FORMAT ( 6X,18H0.927786174985D+02/4(D24.12/)/
T 5X,21H-0.59354914223619D+00/4(D26.14/)/
U 6X,14H0.98663271D-03/4(D20.8/)/
V 5X,8H-0.1D-15/4(D13.1/)/
W 6X,16H0.3261294675D+22/4(D22.10/),
X 1H1,4X,16H-0.969492909D+13/4(D21.9/)/
Y 6X,13H0.1246085D+01/4(D19.7/)/
Z 5X,9H-0.59D+02/4(D14.2/),1H )
134 FORMAT ( 6X,18H0.798281392253D+12/4(D24.12/)/
1 6X,11H0.42921D+11/4(D17.5/)/
2 6X,15H0.793685443D+05/4(D21.9/)/
3 6X,17H0.33344455566D+13/4(D23.11/)/
4 5X,16H-0.222333444D+10/4(D21.9/)/
5 6X,7H0.1D+02/4(D13.1/),
6 1H1,4X,8H-0.2D+03/4(D13.1/)/
7 6X,20H0.33333333333333D+11/4(D26.14/)/
8 5X,16H-0.444444444D+05/4(D21.9/),1H )
135 FORMAT( 6X,20H0.34000000000000D+02/5(D26.14/)/
1 5X,21H-0.17263544500000D+11/5(D26.14/)/
2 6X,20H0.00000000000000D+00/5(D26.14/)/
3 5X,21H-0.17263544500000D+11/5(D26.14/)/
4 6X,20H0.65498760000000D-03/5(D26.14/),
5 1H1,5X,20H0.00000000000000D+00/5(D26.14/)/
6 6X,20H0.29876523400000D-01/5(D26.14/)/
7 5X,21H-0.25439662100000D+03/5(D26.14/),
8 39H1 EACH GROUP SHOULD BE IDENTICAL EXCEPT/
9 38H FOR THE SIGNS OF THE FIRST TWO LINES//
A 6X,20H0.34786529910234D-05/5(D26.14/)/
B 5X,21H-0.14793782496700D+07/5(D26.14/)/
C 6X,20H0.29876523400000D-01/5(D26.14/)/
D 5X,21H-0.14793782496700D+07/5(D26.14/)/
E 6X,20H0.29876523400000D-01/5(D26.14/)/
F 6X,20H0.98663271000000D-03/5(D26.14/)/
G 6X,20H0.12345678910110D+08/5(D26.14/),
H 1H1,4X,21H-0.44400000000000D-08/5(D26.14/))
C***** END OF SEGMENT 013
C***** WHEN EXECUTING ONLY SEGMENT 013, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED
C= STOP
C= END
C***********************************************************************
C*****
C***** CASGN - (015)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** * TO TEST METHODS OF FORMING COMPLEX CONSTANTS 5.1.1
C***** * TO TEST THAT COMPLEX VARIABLES AND ARRAY 5.1.2 /5
C***** ELEMENTS MAY BE REFERENCED. 5.1.3 /16
C***** * TO TEST SIMPLE ARITHMETIC ASSIGNMENT STATEMENTS 7.1.1.1
C***** SO THAT THIS FEATURE CAN BE USED FOR INITIALIZATION TABLE 1
C***** IN LATER SEGMENTS
C***** S P E C I F I C A T I O N S SEGMENT 015
C*****
C***** WHEN EXECUTING ONLY SEGMENT 015, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= COMPLEX QEVC,QFVC,QGVC,QHVC,QIVC,QJVC,QKVC,QLVC,QMVC,QNVC,QOVC,
C= 1 QPVC,QRVC,QSVC,QTVC,QUVC,QVVC,KVC,LVC,MVC,NVC,OVC,PVC,QVC,VVC,
C= 2 MEVC,MFVC,MGVC,MHVC,MIVC,QQVC,MJVC,MKVC,MLVC, MNVC,MOVC,
C= 3 MPVC,MQVC,MRVC,MSVC,MTVC,MUVC,MVVC,BCVC,DCVC,DDVC
C= COMPLEX AVC,BVC,CVC,DVC,EVC,FVC,GVC,HVC,IVC,JVC,AAVC,
C= 1 ABVC,BAVC,BBVC,CCVC,CDVC,CAVC,DAVC,ASVC,BSVC,CSVC,
C= 2 DSVC,AAAVC,ABAVC,ACAVC,ADAVC,CHCVC
C= COMPLEX NUMVC, QAVC,QBVC,QCVC,QDVC,RVC,SVC,TVC,UVC
C= 1 , MAVC,MBVC,MCVC,MDVC,B1C(8),B2C(4,2),B3C(2,2,2)
C= COMPLEX LL1C(32),LM2C(8,4),LN3C(9,2,2),A1C(12),A2C(2,2),A3C(2,2,1)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 015, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,150)
WRITE (NUVI,151)
150 FORMAT(1H1,1X,32HCASGN - (015) COMPLEX ASSIGNMENT/
1 16X, 10HSTATEMENTS/2X,28HASA REFS. - 5.1.1.4 7.1.1.1//
2 2X, 7HRESULTS//2X,23HLINE 1 OF EACH GROUP IS/
3 2X,21HHOLLERITH INFORMATION/)
151 FORMAT(2X,36HVALUES IN A GROUP SHOULD BE THE SAME)
C***** HEADER FOR SEGMENT 015 WRITTEN
C***** BEGINNING OF TEST OF COMPLEX CONSTANT ASSIGNMENTS. IN
C***** THE FOLLOWING 22 BLOCKS, BOTH PARTS OF THE CONSTANT
C***** HAVE THE SAME METHOD OF FORMATION
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** UNSIGNED BASIC REAL CONSTANTS
QAVC = (22.2,33.33)
LL1C(1) = (22.2,33.33)
LM2C(1,1) = (22.2,33.33)
LN3C(1,1,1) = (22.2,33.33)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** SIGNED BASIC REAL CONSTANTS
QBVC = (+395.6,+4106.7)
QCVC = (-12345.67,-1234.567)
QDVC = (+8.9,-9.1)
QEVC = (-2635.12,+46.21)
LL1C(2) = (+395.6,+4106.7)
LL1C(3) = (-12345.67,-1234.567)
LL1C(4) = (+8.9,-9.1)
LL1C(5) = (-2635.12,+46.21)
LM2C(2,1) = (+395.6,+4106.7)
LM2C(3,1) = (-12345.67,-1234.567)
LM2C(4,1) = (+8.9,-9.1)
LM2C(5,1) = (-2635.12,+46.21)
LN3C(2,1,1) = (+395.6,+4106.7)
LN3C(3,1,1) = (-12345.67,-1234.567)
LN3C(4,1,1) = (+8.9,-9.1)
LN3C(5,1,1) = (-2635.12,+46.21)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** UNSIGNED AND SIGNED REAL CONSTANTS (INTEGER PART
C***** ONLY)
QFVC = (10.,20.)
QGVC = (+300.,+4000.)
QHVC = (-50.,-600.)
QIVC = (+71.,-92.)
QJVC = (-883.,+1414.)
QKVC = (10.,+562.)
QLVC = (2002.,-983.)
QMVC = (+461.,-165.)
QNVC = (-21.,+122.)
LL1C(6) = (10.,20.)
LM2C(6,1) = (+300.,+4000.)
LN3C(6,1,1) = (-50.,-600.)
LL1C(7) = (+71.,-92.)
LM2C(7,1) = (-883.,+1414.)
LN3C(7,1,1) = (10.,+562.)
LL1C(8) = (2002.,-983.)
LM2C(8,1) = (+461.,-165.)
LN3C(8,1,1) = (-21.,+122.)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** UNSIGNED AND SIGNED REAL CONSTANTS (DECIMAL PART
C***** ONLY
QOVC = (.001,.00200)
QPVC = (+.562,+.562)
QQVC = (-.3,-.3333333)
QRVC = (+.4,-.445)
QSVC = (-.95,+.95)
QTVC = (.0164239,+.36)
QUVC = (.21,-.3963)
QVVC = (+.3398,.3398)
NUMVC = (-.6,.6)
LL1C(9) = (.001,.00200)
LM2C(1,2) = (+.562,+.562)
LN3C(1,2,1) = (-.3,-.3333333)
LL1C(10) = (+.4,-.445)
LM2C (2,2) = (-.95, +.95)
LN3C(2,2,1) = (.0164239,+.36)
LL1C(11) = (.21,-.3963)
LM2C(3,2) = (+.3398,.3398)
LN3C(3,2,1) = (-.6,.6)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** UNSIGNED REAL CONSTANTS WITH UNSIGNED EXPONENTS
AVC = (0.0E0,1.0E0)
LL1C(12) = (456231.1E1,789.453E3)
LM2C(4,2) = (44.9E4,2.5E3)
LN3C(4,2,1) = (2222.3E3,333.2E2)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** UNSIGNED REAL CONSTANTS WITH SIGNED EXPONENTS
BVC = (3.0E+0,3.0E+0)
CVC = (987654.3E-1,876543.2E-2)
DVC = (4.444E+3,55.555E-4)
EVC = (6.0E-5,7.7E+6)
LL1C(13) = (3.0E+0,3.0E+0)
LM2C(5,2) = (987654.3E-1,876543.2E-2)
LN3C(5,2,1) = (4.444E+3,55.555E-4)
LL1C(14) = (6.0E-5,7.7E+6)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** SIGNED REAL CONSTANTS WITH UNSIGNED EXPONENTS
FVC = (+14.2E1,+26.67E0)
GVC = (-36.923E4,-0.234E03)
HVC = (+2.1E2,-2.1E2)
IVC = (-595.9E00,+4.967E2)
LM2C(6,2) = (+14.2E1,+26.67E0)
LN3C(6,2,1) = (-36.923E4,-0.234E03)
LL1C(15) = (+2.1E2,-2.1E2)
LM2C(7,2) = (-595.9E00,+4.967E2)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** SIGNED REAL CONSTANTS WITH SIGNED EXPONENTS
JVC = (+1.0E+0,+1.0E+0)
KVC = (-2.0E-0,-2.0E-0)
LVC = (+49.2E-1,-65.27E+2)
MVC = (-737.1E+3,+99.8E-3)
NVC = (+4774.47E+03,-9362.4E-4)
OVC = (-846.2E-5,+13.33E+1)
LN3C(7,2,1) = (+1.0E+0,+1.0E+0)
LL1C(16) = (-2.0E-0,-2.0E-0)
LM2C(1,3) = (+49.2E-1,-65.27E+2)
LN3C(1,1,2) = (-737.1E+3,+99.8E-3)
LL1C(17) = (+4774.47E+03,-9362.4E-4)
LM2C(2,3) = (-846.2E-5,+13.33E+1)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** UNSIGNED REAL CONSTANTS (NO DECIMAL PART) WITH
C***** UNSIGNED EXPONENTS
PVC = (77.E7,816248.E2)
LL1C(18) = (77.E7,816248.E2)
LM2C(3,3) = (1334.E01,379.E03)
LN3C(2,1,2) = (1334.E01,379.E03)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** UNSIGNED REAL CONSTANTS (NO DECIMAL PART) WITH
C***** SIGNED EXPONENTS
QVC = (3.E+5,3.E+05)
RVC = (299.E-4,299.E-1)
SVC = (1419.E+2,1419.E-2)
TVC = (76.E-3,987.E+0)
LL1C(19) = (3.E+05,3.E+5)
LM2C(4,3) = (299.E-4,299.E-1)
LN3C(3,1,2) = (1419.E+2,1419.E-2)
LL1C(20) = (76.E-3, 987.E+0)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** SIGNED REAL CONSTANTS (NO DECIMAL PART) WITH
C***** UNSIGNED EXPONENTS
UVC = (+31.E0,+4659.E1)
VVC = (-728.E2,-93296.E3)
MAVC = (+6.E6,-6.E6)
MBVC = (-7914.E3,+16.E5)
LM2C(5,3) = (+31.E0,+4659.E1)
LN3C(4,1,2) = (-728.E2,-93296.E3)
LL1C(21) = (+6.E6,-6.E6)
LM2C(6,3) = (-7914.E3,+16.E5)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** SIGNED REAL CONSTANTS (NO DECIMAL PART) WITH
C***** SIGNED EXPONENTS
MCVC = (+1.E+1,+1.E+1)
MDVC = (-2.E-2,-2.E-2)
MEVC = (+3.E-3,-3.E+3)
MFVC = (-4.E+4,+4.E-4)
MGVC = (+5.E+5,-5.E-5)
MHVC = (-6.E-6,+6.E+6)
LN3C(5,1,2) = (+1.E+1,+1.E+1)
LL1C(22) = (-2.E-2,-2.E-2)
LM2C(7,3) = (+3.E-3,-3.E+3)
LN3C(6,1,2) = (-4.E+4,+4.E-4)
LL1C(23) = (+5.E+5,-5.E-5)
LM2C(1,4) = (-6.E-6,+6.E+6)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** UNSIGNED REAL CONSTANTS (NO INTEGER PART) WITH
C***** UNSIGNED EXPONENTS
MIVC = (.39393E01,.62E04)
LL1C(24) = (.39393E01,.62E04)
LM2C(2,4) = (.009E2,.765765E3)
LN3C(7,1,2) = (.009E2,.765765E3)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** UNSIGNED REAL CONSTANTS (NO INTEGER PART) WITH
C***** SIGNED EXPONENTS
MJVC =(.352E+09,.352E+3)
MKVC =(.147626E+0,.891E-14)
MLVC =(.9E-7,.9999E+8)
MNVC =(.13E-04,.13E-04)
LL1C(25) =(.352E+09,.352E+3)
LM2C(3,4) =(.147626E+0,.891E-14)
LN3C(1,2,2) =(.9E-7,.9999E+8)
LN3C(2,2,2) =(.13E-4,.13E-4)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** SIGNED REAL CONSTANTS (NO INTEGER PART) WITH
C***** UNSIGNED EXPONENTS
MOVC =(+.77E00,+.77E00)
MPVC =(+.878E1,-.878E1)
MQVC =(-.9797E2,+.9797E2)
MRVC =(-.10101E15,-.10101E15)
LL1C(26) =(+.77E00,+.77E00)
LM2C(4,4) =(+.878E1,-.878E1)
LN3C(3,2,2) =(-.9797E2,+.9797E2)
LN3C(4,2,2) =(-.10101E15,-.10101E15)
C***** TEST ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM
C***** SIGNED REAL CONSTANTS (NO INTEGER PART) WITH
C***** SIGNED EXPONENTS
MSVC =(+.68E+12,+.357628E+0)
MTVC =(+.798E-3,+.76444E-00)
MUVC =(-.3247E+20,-.2594E+5)
MVVC =(-.43599E-19,-.12E-4)
AAVC =(-.6E-9,-.6E+9)
ABVC =(-.9119E+6,+.9119E-6)
BAVC =(+.39426E+2,-.39426E-2)
BBVC =(+.45E-12,+.45E+12)
LL1C(27) =(+.68E+12,+.357628E+0)
LM2C(5,4) =(+.798E-3,+.76444E-00)
LN3C(5,2,2) =(-.3247E+20,-.2594E+5)
LL1C(28) =(-.43599E-19,-.12E-4)
LM2C(6,4) =(-.6E-9,-.6E+9)
LN3C(6,2,2) =(-.9119E+6,+.9119E-6)
LM2C(7,4) =(+.39426E+2,-.39426E-2)
LN3C(7,2,2) =(+.45E-12,+.45E+12)
C***** ASSIGNMENT OF COMPLEX CONSTANTS FORMED FROM SIGNED AND UNSIGNED
C***** INTEGER CONSTANTS WITH SIGNED AND UNSIGNED EXPONENTS
BCVC = (+4793E+2,3479E2)
DDVC = (3682E-3,8236E-2)
DCVC = (-2571E5,+1752E+5)
CHCVC = (+1460E-4,-1064E+01)
A1C(5) = (4793E2,3479E+2)
A1C(6) = (3682E-03,+8236E-02)
A1C(7) = (-2571E+5,1752E+05)
A1C(8) = (1460E-4,-1064E1)
LM2C(8,2) = (4793E+2,+3479E+2)
LN3C(8,2,1) = (+3682E-3,8236E-02)
LN3C(8,2,2) = (-2571E+05,1752E5)
LN3C(8,1,2) = (1460E-04,-1064E+1)
C***** ASSIGNMENT OF COMPLEX VARIABLES AND ARRAY ELEMENTS
C***** TO COMPLEX VARIABLES AND ARRAY ELEMENTS
CCVC = QTVC
CDVC = LL1C(12)
CAVC = LM2C(1,4)
DAVC = LN3C(6,2,2)
A1C(1) = CCVC
A1C(2) = LL1C(12)
A1C(3) = LM2C(1,4)
A1C(4) = LN3C(6,2,2)
A2C(1,1) = QTVC
A2C(2,1) = LL1C(12)
A2C(1,2) = LM2C(1,4)
A2C(2,2) = LN3C(6,2,2)
A3C(1,1,1) = CCVC
A3C(2,1,1) = LL1C(12)
A3C(1,2,1) = LM2C(1,4)
A3C(2,2,1) = LN3C(6,2,2)
C***** ASSIGNMENT OF COMPLEX VARIABLES AND ARRAY ELEMENTS
C***** TO COMPLEX VARIABLES AND ARRAY ELEMENTS (UNARY 6.4/44
C***** MINUS USED TO REVERSE BOTH PLUS AND MINUS VALUES)
ASVC = - QGVC
BSVC = - QHVC
CSVC = - LL1C(26)
DSVC = - LL1C(23)
AAAVC = - LM2C(1,3)
AAAVC = - LM2C(1,3)
ABAVC = - LM2C(1,4)
ACAVC = - LN3C(5,2,1)
ADAVC = - LN3C(6,2,1)
B1C(1) = - QGVC
B1C(2) = - QHVC
B1C(3) = - LL1C(26)
B1C(4) = - LL1C(23)
B1C(5) = - LM2C(1,3)
B1C(6) = - LM2C(1,4)
B1C(7) = - LN3C(5,2,1)
B1C(8) = - LN3C(6,2,1)
B2C(1,1) = - QGVC
B2C(2,1) = - QHVC
B2C(3,1) = - LL1C(26)
B2C(4,1) = - LL1C(23)
B2C(1,2) = - LM2C(1,3)
B2C(2,2) = - LM2C(1,4)
B2C(3,2) = - LN3C(5,2,1)
B2C(4,2) = - LN3C(6,2,1)
B3C(1,1,1) = - QGVC
B3C(2,1,1) = - QHVC
B3C(1,2,1) = - LL1C(26)
B3C(2,2,1) = - LL1C(23)
B3C(1,1,2) = - LM2C(1,3)
B3C(2,1,2) = - LM2C(1,4)
B3C(1,2,2) = - LN3C(5,2,1)
B3C(2,2,2) = - LN3C(6,2,1)
C***** WRITE RESULTS FOR THIS TEST SEGMENT
WRITE (NUVI, 152) QAVC, LL1C(1), LM2C(1,1), LN3C(1,1,1), QBVC,
1 LL1C(2), LM2C(2,1), LN3C(2,1,1), QCVC, LL1C(3), LM2C(3,1),
2 LN3C(3,1,1), QDVC, LL1C(4), LM2C(4,1), LN3C(4,1,1), QEVC,
3 LL1C(5), LM2C(5,1), LN3C(5,1,1), QFVC, LL1C(6), QGVC,
4 LM2C(6,1), QHVC, LN3C(6,1,1), QIVC, LL1C(7), QJVC, LM2C(7,1),
5 QKVC, LN3C(7,1,1), QLVC, LL1C(8), QMVC, LM2C(8,1), QNVC,
6 LN3C(8,1,1), QOVC, LL1C(9), QPVC, LM2C(1,2), QQVC,
7 LN3C(1,2,1), QRVC, LL1C(10), QSVC, LM2C(2,2), QTVC,
8 LN3C(2,2,1)
WRITE (NUVI,153) QUVC, LL1C(11), QVVC, LM2C(3,2), NUMVC,
1 LN3C(3,2,1), AVC, LL1C(12), LM2C(4,2), LN3C(4,2,1), BVC,
2 LL1C(13), CVC, LM2C(5,2), DVC, LN3C(5,2,1), EVC, LL1C(14),
3 FVC, LM2C(6,2), GVC, LN3C(6,2,1), HVC, LL1C(15), IVC,
4 LM2C(7,2), JVC, LN3C(7,2,1), KVC, LL1C(16), LVC, LM2C(1,3),
5 MVC, LN3C(1,1,2), NVC, LL1C(17)
WRITE(NUVI,8873) OVC, LM2C(2,3), PVC,
1 LL1C(18), LM2C(3,3), LN3C(2,1,2), QVC, LL1C(19)
WRITE (NUVI,154) RVC, LM2C(4,3), SVC, LN3C(3,1,2), TVC,
1 LL1C(20), UVC, LM2C(5,3), VVC, LN3C(4,1,2), MAVC, LL1C(21),
2 MBVC, LM2C(6,3), MCVC, LN3C(5,1,2), MDVC, LL1C(22), MEVC,
3 LM2C(7,3), MFVC, LN3C(6,1,2), MGVC, LL1C(23), MHVC,
4 LM2C(1,4), MIVC, LL1C(24), LM2C(2,4), LN3C(7,1,2)
WRITE (NUVI,8870) MJVC, LL1C(25), MKVC, LM2C(3,4), MLVC,
- LN3C(1,2,2), MNVC, LN3C(2,2,2), MOVC, LL1C(26),
+ MPVC, LM2C(4,4), MQVC, LN3C(3,2,2), MRVC,
= LN3C(4,2,2), MSVC, LL1C(27), MTVC, LM2C(5,4),
$ MUVC, LN3C(5,2,2), MVVC, LL1C(28), AAVC,
. LM2C(6,4), ABVC, LN3C(6,2,2), BAVC, LM2C(7,4),
+ BBVC, LN3C(7,2,2)
WRITE(NUVI,8872) BCVC,A1C(5),LM2C(8,2),DDVC, A1C(6),LN3C(8,2,1),
1 DCVC,A1C(7),LN3C(8,2,2),CHCVC,A1C(8),LN3C(8,1,2)
0WRITE (NUVI,8871) QTVC, CCVC, A1C(1), A2C(1,1), A3C(1,1,1),
1 LL1C(12), CDVC, A1C(2), A2C(2,1), A3C(2,1,1), LM2C(1,4),
2 CAVC, A1C(3), A2C(1,2), A3C(1,2,1), LN3C(6,2,2), DAVC,
3 A1C(4), A2C(2,2), A3C(2,2,1), QGVC, ASVC, B1C(1), B2C(1,1),
4 B3C(1,1,1), QHVC, BSVC, B1C(2), B2C(2,1), B3C(2,1,1),
5 LL1C(26), CSVC, B1C(3), B2C(3,1), B3C(1,2,1), LL1C(23),
6 DSVC, B1C(4), B2C(4,1), B3C(2,2,1), LM2C(1,3), AAAVC, B1C(5),
7 B2C(1,2), B3C(1,1,2), LM2C(1,4), ABAVC, B1C(6), B2C(2,2),
8 B3C(2,1,2), LN3C(5,2,1), ACAVC, B1C(7), B2C(3,2), B3C(1,2,2),
9 LN3C(6,2,1), ADAVC, B1C(8), B2C(4,2), B3C(2,2,2)
C***** FORMAT STATEMENTS FOR THIS SEGMENT
152 FORMAT (/ 6X,9H0.222E+02,9X,10H0.3333E+02/4(E15.3,E19.4/)/
A 6X,10H0.3956E+03,8X,11H0.41067E+04/4(E16.4,E19.5/)/
B 5X,14H-0.1234567E+05,4X,14H-0.1234567E+04/4(E19.7,E18.7/)/
C 6X,8H0.89E+01,9X,9H-0.91E+01/4(E14.2,E18.2/)/
D 5X,13H-0.263512E+04,6X,10H0.4621E+02/4(E18.6,E16.4/)/
E 6X,7H0.1E+02,11X,7H0.2E+02/2(E13.1,E18.1/)/
F 6X,7H0.3E+03,11X,7H0.4E+04/2(E13.1,E18.1/)/
G 5X,8H-0.5E+02,10X,8H-0.6E+03/2(E13.1,E18.1/)/
H 6X,8H0.71E+02,9X,9H-0.92E+02/2(E14.2,E18.2/)/
I1H1,4X,10H-0.883E+03,9X,10H0.1414E+04/2(E15.3,E19.4/)/
J 6X,7H0.1E+02,11X,9H0.562E+03/2(E13.1,E20.3/)/
K 6X,10H0.2002E+04,7X,10H-0.983E+03/2(E16.4,E17.3/)/
L 6X,9H0.461E+03,8X,10H-0.165E+03/2(E15.3,E18.3/)/
M 5X,9H-0.21E+02,10X,9H0.122E+03/2(E14.2,E19.3/)/
N 6X,7H0.1E-02,11X,7H0.2E-02/2(E13.1,E18.1/)/
O 6X,9H0.562E+00,9X,9H0.562E+00/2(E15.3,E18.3/)/
P 5X,8H-0.3E+00,10X,14H-0.3333333E+00/2(E13.1,E24.7/)/
Q 6X,7H0.4E+00,10X,10H-0.445E+00/2(E13.1,E20.3/)/
R 5X,9H-0.95E+00,10X,8H0.95E+00/2(E14.2,E18.2/)/
S 6X,12H0.164239E-01,6X,8H0.36E+00/2(E18.6,E14.2/),1H )
153 FORMAT ( 6X,8H0.21E+00,9X,11H-0.3963E+00/2(E14.2,E20.4/)/
A 6X,10H0.3398E+00,8X,10H0.3398E+00/2(E16.4,E18.4/)/
B 5X,8H-0.6E+00,11X,7H0.6E+00/2(E13.1,E18.1/)/
C1H1,5X,7H0.0E+00,11X,7H0.1E+01/E13.1,E18.1//
D 6X,13H0.4562311E+07,5X,12H0.789453E+06/E19.7,E17.6//
E 6X,9H0.449E+06,9X,8H0.25E+04/E15.3,E17.2//
F 6X,11H0.22223E+07,7X,10H0.3332E+05/E17.5,E17.4//
G 6X,7H0.3E+01,11X,7H0.3E+01/2(E13.1,E18.1/)/
H 6X,13H0.9876543E+05,5X,13H0.8765432E+04/2(E19.7,E18.7/)/
I 6X,10H0.4444E+04,8X,11H0.55555E-02/2(E16.4,E19.5/)/
J 6X,7H0.6E-04,11X,8H0.77E+07/2(E13.1,E19.2/)/
K 6X,9H0.142E+03,9X,10H0.2667E+02/2(E15.3,E19.4/)/
L 5X,12H-0.36923E+06,6X,10H-0.234E+03/2(E17.5,E16.3/)/
M 6X,8H0.21E+03,9X,9H-0.21E+03/2(E14.2,E18.2/)/
N 5X,11H-0.5959E+03,8X,10H0.4967E+03/2(E16.4,E18.4/)/
O 6X,7H0.1E+01,11X,7H0.1E+01/2(E13.1,E18.1/)/
P 5X,8H-0.2E+01,10X,8H-0.2E+01/2(E13.1,E18.1/)/
Q 6X,9H0.492E+01,8X,11H-0.6527E+04/2(E15.3,E19.4/),
R1H1,4X,11H-0.7371E+06,8X,9H0.998E-01/2(E16.4,E17.3/)/
S 6X,12H0.477447E+07,5X,12H-0.93624E+00/2(E18.6,E17.5/),1H )
8873 FORMAT(5X,13H-0.846200E-02,6X,11H0.13330E+03/2(E18.6,E17.5/)/
U 6X,12H0.770000E+09,6X,11H0.81625E+08/2(E18.6,E17.5/)/
V 6X,12H0.133400E+05,6X,11H0.37900E+06/2(E18.6,E17.5/)/
W 6X,12H0.300000E+06,6X,11H0.30000E+06/2(E18.6,E17.5/),1H )
154 FORMAT ( 6X,9H0.299E-01,9X,9H0.299E+02/2(E15.3,E18.3/)/
A 6X,10H0.1419E+06,8X,10H0.1419E+02/2(E16.4,E18.4/)/
B 6X,8H0.76E-01,10X,9H0.987E+03/2(E14.2,E19.3/)/
C 6X,8H0.31E+02,10X,10H0.4659E+05/2(E14.2,E20.4/)/
D 5X,10H-0.728E+05,8X,12H-0.93296E+08/2(E15.3,E20.5/)/
E 6X,7H0.6E+07,10X,8H-0.6E+07/2(E13.1,E18.1/)/
F 5X,11H-0.7914E+07,8X,8H0.16E+07/2(E16.4,E16.2/)/
G 6X,7H0.1E+02,11X,7H0.1E+02/2(E13.1,E18.1/),
H1H1,4X,8H-0.2E-01,10X,8H-0.2E-01/2(E13.1,E18.1/)/
I 6X,7H0.3E-02,10X,8H-0.3E+04/2(E13.1,E18.1/)/
J 5X,8H-0.4E+05,11X,7H0.4E-03/2(E13.1,E18.1/)/
K 6X,7H0.5E+06,10X,8H-0.5E-04/2(E13.1,E18.1/)/
L 5X,8H-0.6E-05,11X,7H0.6E+07/2(E13.1,E18.1/)/
M 6X,11H0.39393E+01,7X,8H0.62E+04/2(E17.5,E15.2/)/
N 6X,7H0.9E+00,11X,12H0.765765E+03/2(E13.1,E23.6/),1H )
8870 FORMAT ( 6X,9H0.352E+09,9X,8H0.35E+03/2(E15.3,E17.2/)/
( 6X,12H0.147626E+00,6X,9H0.891E-14/2(E18.6,E15.3/)/
* 6X,7H0.9E-07,11X,10H0.9999E+08/2(E13.1,E21.4/)/
) 6X,8H0.13E-04,10X,8H0.13E-04/2(E14.2,E18.2/)/
/ 6X,8H0.77E+00,10X,8H0.77E+00/2(E14.2,E18.2/)/
/ 6X,9H0.878E+01,8X,10H-0.878E+01/2(E15.3,E18.3/)/
A 5X,11H-0.9797E+02,8X,10H0.9797E+02/2(E16.4,E18.4/),
. 1H1,4X,12H-0.10101E+15,6X,12H-0.10101E+15/2(E17.5,E18.5/)/
, 6X,8H0.68E+12,10X,12H0.357628E+00/2(E14.2,E22.6/)/
- 6X,9H0.798E-03,9X,11H0.76444E+00/2(E15.3,E20.5/)/
+ 5X,11H-0.3247E+20,7X,11H-0.2594E+05/2(E16.4,E18.4/)/
1 5X,12H-0.43599E-19,6X,9H-0.12E-04/2(E17.5,E15.2/)/
2 5X,8H-0.6E-09,10X,8H-0.6E+09/2(E13.1,E18.1/)/
3 5X,11H-0.9119E+06,8X,10H0.9119E-06/2(E16.4,E18.4/)/
4 6X,11H0.39426E+02,6X,12H-0.39426E-02/2(E17.5,E18.5/)/
5 6X,8H0.45E-12,10X,8H0.45E+12/2(E14.2,E18.2/),1H )
8872 FORMAT(
6 6X,10H0.4793E+06,8X,10H0.3479E+06/3(E16.4,E18.4/)/
7 6X,10H0.3682E+01,8X,10H0.8236E+02/3(E16.4,E18.4/)/
8 5X,11H-0.2571E+09,8X,10H0.1752E+09/3(E16.4,E18.4/)/
9 6X,10H0.1460E+00,7X,11H-0.1064E+05/3(E16.4,E18.4/))
8871 FORMAT(1H1,5X,13H0.1642390E-01,5X,13H0.3600000E+00/5(E19.7,E18.7/)
1 /6X,13H0.4562311E+07,5X,13H0.7894530E+06/5(E19.7,E18.7/)/
2 5X,14H-0.6000000E-05,5X,13H0.6000000E+07/5(E19.7,E18.7/)/
3 5X,14H-0.9119000E+06,5X,13H0.9119000E-06/5(E19.7,E18.7/),
4 39H1 EACH GROUP SHOULD BE IDENTICAL EXCEPT/
5 38H FOR THE SIGN OF THE FIRST TWO LINES//
6 6X,13H0.3000000E+03,5X,13H0.4000000E+04/5(E19.7,E18.7/)/
7 5X,14H-0.5000000E+02,4X,14H-0.6000000E+03/5(E19.7,E18.7/)/
8 6X,13H0.7700000E+00,5X,13H0.7700000E+00/5(E19.7,E18.7/)/
9 6X, 13H0.5000000E+06,4X,14H-0.5000000E-04/5(E19.7,E18.7/)/
A 6X,13H0.4920000E+01,4X,14H-0.6527000E+04/5(E19.7,E18.7/)/
B 5X,14H-0.6000000E-05,5X,13H0.6000000E+07/5(E19.7,E18.7/)/
C 6X,13H0.4444000E+04,5X,13H0.5555500E-02/5(E19.7,E18.7/)/
D 1H1,4X,14H-0.3692300E+06,4X,14H-0.2340000E+03/5(E19.7,E18.7/))
C***** END OF TEST SEGMENT 015
C***** WHEN EXECUTING ONLY SEGMENT 015, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
nbs03.d 480890331 170 2 100666 299 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2 . DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4 . DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6 DOUBLE SPACE ON OUTPUT ID 6
nbs03.f 480887313 170 2 100666 37969 `
C***** PART3 *****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 3 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** LASGN - 016 LOGICAL ASSIGNMENT STATEMENTS
C*****
C***** INTRL - 017 ARITHMETIC ASSIGNMENT STATEMENTS
C*****
C***** UGOTO - 020 UNCONDITIONAL GO TO STATEMENTS
C*****
C***** AGOTO - 021 GO TO ASSIGNMENT STATEMENTS
C*****
C***** CGOTO - 022 COMPUTED GO TO STATEMENTS
C*****
C***** ARBAD - 030 BASIC ADDITION
C*****
C***** ARFAD - 031 DOUBLE PRECISION ADDITION
C*****
C***** ARBSB - 032 BASIC SUBTRACTION
C*****
C***** ARFSB - 033 DOUBLE PRECISION SUBTRACTION
C*****
C***** ARBAS - 034 BASIC ADDITION AND SUBTRACTION
C*****
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN
C***** SEGMENTS 016, 017, 020, 021, 022, 030, 031, 032, 033, 034,
C***** ARE RUN AS ONE MAIN PROGRAM.
C*****
DIMENSION A1S(5), A2S(2,2), A3S(3,3,3), IAC1I(5), IAC2I(2,7)
1 , AC1S(25)
INTEGER MCA3I(2,3,3), GTVI
DOUBLE PRECISION AC1D(10), BC2D(7,4), CC3D(7,2,2), DPAVD, ACVD,
1 BCVD, FFCVD, GGCVD, HHCVD, EP1D(43), CCVD, DCVD, A2D(2,2)
2 , A3D(2,2,2), DPCVD
LOGICAL MCAVB, MCBVB, MCCVB, MCDVB, MCEVB, MCFVB, MCGVB, MCIVB
1 , MCJVB, MCKVB, MCLVB, MCMVB, MCNVB, MCA1B(7),MCHVB
LOGICAL A1B(2), A2B(2,2), A3B(2,2,2), AVB, BVB, CVB
C*****
C***** END OF SPECIFICATIONS FOR SEGMENTS 016, 017, 020, 021, 022,
C***** 030, 031, 032, 033, 034
C*****
C***********************************************************************
C*****
C***** LASGN - (016)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST LOGICAL ASSIGNMENTS 7.1.1.2
C***** CONSTANTS USED IN THIS SEGMENT
C***** S P E C I F I C A T I O N S SEGMENT 016
C*****
C***** WHEN EXECUTING ONLY SEGMENT 016, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH APPEAR AS
C***** COMMENTS MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= DIMENSION IAC1I(5)
C= LOGICAL MCAVB,MCBVB,MCCVB,MCDVB,MCEVB,MCFVB,MCGVB,MCHVB,MCIVB,
C= 1 MCJVB, MCKVB, MCLVB, MCMVB, MCNVB ,MCA1B(7)
C= LOGICAL A1B(2),A2B(2,2),A3B(2,2,2),AVB,BVB,CVB
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 3 ///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
C*****
IAC1I(1) = 25
IAC1I(2) = 10
IAC1I(3) = 15
IAC1I(4) = 25
C***** WRITE HEADER FOR THIS SEGMENT
WRITE (NUVI,160)
160 FORMAT (1H1,28H LASGN - (016) ASSIGNMENT OF/ 16X,17HLOGIGAL VARIAB
ALES/21H ASA REFS. - 7.1.1.2//9H RESULTS)
C***** TEST THE ASSIGNMENT OF RELATIONAL EXPRESSIONS 6.2
C***** TO LOGICAL VARIABLES AND ARRAYS
MCAVB = IAC1I(2) .LT. IAC1I(3)
MCBVB = IAC1I(3) .LT. IAC1I(2)
MCCVB = IAC1I(1) .EQ. IAC1I(4)
MCDVB = IAC1I(2) .EQ. IAC1I(1)
MCEVB = IAC1I(1) .LE. IAC1I(4)
MCFVB = IAC1I(2) .LE. IAC1I(1)
MCGVB = IAC1I(1) .LE. IAC1I(2)
MCHVB = IAC1I(1) .EQ. 25
MCIVB = IAC1I(2) .EQ. IAC1I(4)
MCA1B(1) = IAC1I(2) .NE. IAC1I(3)
MCA1B(2) = IAC1I(1) .NE. IAC1I(4)
MCA1B(3) = IAC1I(1) .GT. IAC1I(2)
MCA1B(4) = IAC1I(2) .GT. IAC1I(1)
MCA1B(5) = IAC1I(1) .GE. IAC1I(2)
A1B(1) = IAC1I(1) .GE. IAC1I(4)
A1B(2) = IAC1I(2) .GE. IAC1I(1)
C***** TEST THE ASSIGNMENT OF A MIXTURE OF RELATIONAL AND
C***** LOGICAL EXPRESSIONS TO LOGICAL VARIABLES AND ARRAYS 6.3
A2B(1,1) = .TRUE.
A2B(1,2) = .FALSE.
AVB = A2B(1,2) .AND. .NOT. A2B(1,1)
BVB = A2B(1,2) .OR. .NOT. A2B(1,1)
CVB = IAC1I(2).LT.IAC1I(3).AND.(A2B(1,1).OR..NOT.A2B(1,2)).OR.A2B(
A1,1).AND..NOT.A2B(1,2).AND.IAC1I(1).GT.IAC1I(4)
A2B(2,1) = .NOT. (CVB.AND.MCIVB).AND. IAC1I(2) .NE. IAC1I(3) .AND.
1 IAC1I(2) .LT. IAC1I(3) .AND. IAC1I(1) .EQ. IAC1I(4)
A2B(2,2) = A2B(1,2) .AND. IAC1I(1) .EQ. IAC1I(4)
A3B(1,1,1) = IAC1I(2) .LT. IAC1I(3) .AND. A2B(1,2)
A3B(1,1,2) = IAC1I(2) .GT. IAC1I(3) .AND. A2B(1,1)
A3B(1,2,1) = .NOT. MCA1B(5) .AND.
1 A2B(1,1) .OR. IAC1I(1) .EQ. IAC1I(4)
A3B(1,2,2) = .NOT. (A2B(1,2) .AND. IAC1I(1) .EQ. IAC1I(4)).OR.
1 A2B(1,1) .OR. A2B(1,2)
A3B(2,1,1) = A2B(1,2) .OR. IAC1I(1) .EQ. IAC1I(4)
A3B(2,2,1) = .NOT.MCCVB.AND.MCHVB .OR. IAC1I(1) .NE. IAC1I(4) .OR.
1 IAC1I(1) .LT. IAC1I(4) .OR. A2B(1,2)
A3B(2,1,2) = .NOT. A3B(1,1,2) .AND.
1 ( A2B(1,1) .AND. .NOT. A2B(1,2) )
A3B(2,2,2) = IAC1I(1) .LT. IAC1I(4) .OR. .NOT. A2B(1,2)
MCJVB=IAC1I(2).GT.IAC1I(3).AND.(A2B(1,1).OR..NOT.A2B(1,2)).OR.A2B(
A1,2).AND..NOT.A2B(1,2).AND.IAC1I(1).GT.IAC1I(4)
MCKVB = IAC1I(2).LT.IAC1I(3).AND.A2B(1,1).OR.A2B(1,2)
MCLVB = (IAC1I(2) .LT. IAC1I(3) .AND. A2B(1,2)) .OR. A2B(1,1)
MCMVB = A2B(1,2) .OR. IAC1I(2) .LT. IAC1I(3) .AND. A2B(1,1)
MCNVB = A2B(1,2) .OR. (IAC1I(2) .LT. IAC1I(3) .AND. A2B(1,1))
C***** WRITE VARIABLES THAT ARE TRUE
WRITE (NUVI,161) MCAVB, MCCVB, MCEVB, MCFVB, MCHVB, MCA1B(1),
A MCA1B(3), MCA1B(5), A1B(1), A2B(1,1), A2B(2,1),
B A3B(1,2,1), A3B(1,2,2), A3B(2,1,1), A3B(2,1,2),
C A3B(2,2,2), CVB, MCKVB, MCLVB, MCMVB, MCNVB
161 FORMAT (//32H ALL ANSWERS BELOW MUST BE TRUE//21(L16/)//)
C***** WRITE VARIABLES THAT ARE FALSE
WRITE (NUVI,162) MCBVB, MCDVB, MCGVB, MCIVB, MCA1B(2), MCA1B(4),
A A1B(2), A2B(1,2), A2B(2,2),A3B(1,1,1),A3B(1,1,2),
B A3B(2,2,1), AVB, BVB, MCJVB
162 FORMAT (33H ALL ANSWERS BELOW MUST BE FALSE//15(L16/))
C***** END OF SEGMENT 016
C*****
C***** WHEN EXECUTING ONLY SEGMENT 016, THE STOP AND END
C***** CARDS, WHICH APPEAR AS COMMENTS, MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C*****
C= STOP
C= END
C***********************************************************************
C*****
C***** INTRL - (017)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST ARITHMETIC ASSIGNMENT STATEMENTS WHERE TABLE 1,PG13
C***** REAL CONSTANTS AND VARIABLES, INTEGER VARIABLES (LINES 2,3,
C***** AND ARRAY ELEMENTS, AND DOUBLE PRECISION CON- 5,6,
C***** STANTS AND VARIABLES ARE ASSIGNED TO EACH OTHER 9,10)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 017
C*****
C***** WHEN EXECUTING ONLY SEGMENT 017, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C= IN
C***** COL 1 AND 2 REMOVED
C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3),IAC1I(5),IAC2I(2,7)
C= INTEGER MCA3I(2,3,3)
C= DOUBLE PRECISION AC1D(10),BC2D(7,4),CC3D(7,2,2),DPAVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 017, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,170)
170 FORMAT(1H1,1X,39HINTRL - (017) ASSIGN INTEGER, REAL, AND/
1 16X,23HDOUBLE PRECISION VALUES/2X,29HASA REFS. - 7.1.1.1. 5.1.1.
22/2X,7HRESULTS/)
C***** TEST ASSIGNMENT OF INTEGER VARIABLES TABLE 1/LN 5,9
JACVI = 1
IAC1I(3) = +111
IAC2I(2,3) = -1111
MCA3I(2,1,2) = -1111111
ACVS = IAC1I(3)
A1S(2) = IAC2I(2,3)
A2S(2,1) = MCA3I(2,1,2)
A3S(2,1,2) = JACVI
DPAVD = MCA3I(2,1,2)
AC1D(7) = JACVI
BC2D(7,4) = IAC1I(3)
CC3D(5,1,2) = IAC2I(2,3)
WRITE (NUVI,171)
171 FORMAT (/2X,24HASSIGN INTEGER VARIABLES//3X, 21H1 - TO
1REAL VARIABLES)
WRITE (NUVI,172)ACVS,A1S(2),A2S(2,1),A3S(2,1,2),DPAVD,AC1D(7),BC2D
1(7,4),CC3D(5,1,2)
172 FORMAT(/8X,8H 111.0 */F14.1//
1 7X,9H-1111.0 */F14.1//
2 4X,12H-1111111.0 */F14.1//
3 11X,5H1.0 */F14.1//3X,33H2 - TO DOUBLE PRECISION VARIABLES
4 //4X,16H-0.1111111D 07 */D18.7//
5 11X,9H0.1D 01 */D18.1//
6 9X,11H0.111D 03 */D18.3//
7 7X,13H-0.1111D 04 */D18.4/)
C***** TEST ASSIGNMENT OF INTEGER CONSTANTS
ACVS = -2222
A1S(2) = +222
A2S(2,1) = -2222222
A3S(2,1,2) = 2
DPAVD = 2
AC1D(7) = -2222222
BC2D(7,4) = -2222
CC3D(5,1,2) = +222
WRITE (NUVI,173)
173 FORMAT (/2X,24HASSIGN INTEGER CONSTANTS//3X, 21H1 - TO R
1EAL VARIABLES)
WRITE (NUVI,174)ACVS,A1S(2),A2S(2,1),A3S(2,1,2),DPAVD,AC1D(7),BC2D
1(7,4),CC3D(5,1,2)
174 FORMAT(/6X,9H-2222.0 */F13.1//
1 8X,7H222.0 */F13.1//
2 3X,12H-2222222.0 */F13.1//
3 10X,5H2.0 */F13.1/ 35H1 2 - TO DOUBLE PRECISION VARIABLES/
4 /12X,9H0.2D 01 */D19.1//
5 5X,16H-0.2222222D 07 */D19.7//
6 8X,13H-0.2222D 04 */D19.4//
7 10X,11H0.222D 03 */D19.3/)
C***** TEST ASSIGNMENT OF BASIC REAL CONSTANTS TABLE 1/LN 2,10
JACVI = 3.3
IAC1I(3) = +333.3E-2
IAC2I(2,3) = .3333E+1
MCA3I(2,1,2) = -.0033333E3
DPAVD = +3.3333
AC1D(7) = .3333333E1
BC2D(7,4) = -333.3333E-2
CC3D(5,1,2) = -.0333333E+2
WRITE (NUVI,7173)
7173 FORMAT (/2X,27HASSIGN BASIC REAL CONSTANTS//3X, 24H1 -
1TO INTEGER VARIABLES)
WRITE(NUVI,7172)JACVI,IAC1I(3),IAC2I(2,3),MCA3I(2,1,2),DPAVD,AC1D(
17),BC2D(7,4),CC3D(5,1,2)
7172 FORMAT(/9X,3H3 */3(I10/)/8X,4H-3 */I10//3X,33H2 - TO DOUBLE PRECIS
1ION VARIABLES//
2 8X,13H0.33333D 01 */D19.5//
3 6X,15H0.3333333D 01 */D19.7//
4 5X,16H-0.3333333D 01 */D19.7//
5 6X,15H-0.333333D 01 */D19.6/)
C***** TEST ASSIGNMENT OF REAL VARIABLES
ACVS = +.0044444E4
A1S(2) = -4444.E-2
A2S(2,1) = -44.4
A3S(2,1,2) = 4.4444E+1
JACVI = A2S(2,1)
IAC1I(3) = A1S(2)
IAC2I(2,3) = A3S(2,1,2)
MCA3I(2,1,2) = ACVS
DPAVD = A2S(2,1)
AC1D(7) = A1S(2)
BC2D(7,4) = A3S(2,1,2)
CC3D(5,1,2) = ACVS
WRITE (NUVI,175)
175 FORMAT (/23H ASSIGN REAL VARIABLES// 27H 1 - TO INTEG
1ER VARIABLES)
WRITE (NUVI,176)JACVI,IAC1I(3),IAC2I(2,3),MCA3I(2,1,2),DPAVD,AC1D(
17),BC2D(7,4),CC3D(5,1,2)
176 FORMAT( /7X,5H-44 */2(I10/)/8X,4H44 */2(I10/), 35H1 2 - TO DOUBL
1E PRECISION VARIABLES//
2 6X,12H-0.444D 02 */D16.3//
3 5X,13H-0.4444D 02 */D16.4//
4 5X,13H0.44444D 02 */D16.5//
5 5X,13H0.44444D 02 */D16.5/)
C***** TEST ASSIGNMENT OF D.P. VARIABLES TABLE 1/LN 3,6
DPAVD=55555.5
AC1D(7) = +55555555555555.D-13
BC2D(7,4) = -.00000555555555D6
CC3D(5,1,2) = -.05555555555555D+2
JACVI = DPAVD
IAC1I(3) = AC1D(7)
IAC2I(2,3) = BC2D(7,4)
MCA3I(2,1,2) = CC3D(5,1,2)
ACVS = CC3D(5,1,2)
A1S(2) = BC2D(7,4)
A2S(2,1) = AC1D(7)
A3S(2,1,2) = DPAVD
WRITE (NUVI,177)
177 FORMAT (/2X,33HASSIGN DOUBLE PRECISION VARIABLES/
1/3X,24H1 - TO INTEGER VARIABLES)
WRITE (NUVI,178)JACVI,IAC1I(3),IAC2I(2,3),MCA3I(2,1,2),ACVS,A1S(2)
1,A2S(2,1),A3S(2,1,2)
178 FORMAT(/3X,9H 55555 */I10//9X,3H5 */I10//8X,4H-5 */2(I10/)/3X,21H
12 - TO REAL VARIABLES//
2 3X,16H-0.5555556E 01 */E17.7//
3 3X,16H-0.5555556E 01 */E17.7//
4 3X,16H 0.5555556E 01 */E17.7//
5 3X,16H 0.555555E 05 */E17.6/)
C***** TEST ASSIGNMENT OF DOUBLE PRECISION CONSTANTS
JACVI = 66666.D-4
IAC1I(3) = -.00000066666666D7
IAC2I(2,3) = -.06666666666666D+2
MCA3I(2,1,2)=66666.666666666
ACVS = 66666666666666.
A1S(2) = +66666.D-4
A2S(2,1) = -.00000006666666D8
A3S(2,1,2) = -.06666666666666D+2
WRITE (NUVI,179)
179 FORMAT ( 35H1 ASSIGN DOUBLE PRECISION CONSTANTS/
1/3X,24H1 - TO INTEGER VARIABLES)
WRITE(NUVI,7170)JACVI,IAC1I(3),IAC2I(2,3),MCA3I(2,1,2),ACVS,A1S(2)
1,A2S(2,1),A3S(2,1,2)
7170 FORMAT( / 9X,3H6 */I10//8X,4H-6 */2(I10/)/3X,9H 66666 */I10//
1 3X,21H2 - TO REAL VARIABLES//
2 3X,16H 0.6666667E 14 */E17.7//
3 3X,16H 0.66666E 01 */E17.5//
4 3X,16H-0.6666666E 01 */E17.7//
5 3X,16H-0.6666667E 01 */E17.7/)
WRITE (NUVI,7171)
7171 FORMAT(//34H ALL TEST OUTPUT SHOULD BE CHECKED/
1 34H AGAINST THE ASTERISKED (*) FIGURE/
2 18H WHICH PRECEDES IT)
C***** END OF TEST SEGMENT 017
C*****
C***** WHEN EXECUTING ONLY SEGMENT 017, THE STOP AND END
C***** CARDS WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C*****
C= STOP
C= END
C***********************************************************************
C*****
C***** UGOTO - (020)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST UNCONDITIONAL GO TO STATEMENTS 7.1.2.1.1
C***** RESTRICTION OBSERVED
C***** GO TO STATEMENTS CAUSE BRANCHES ONLY TO 7.1.2 /54
C***** EXECUTABLE STATEMENTS
C***** GENERAL COMMENTS
C***** GO TO STATEMENTS ALSO TESTED IN SEGMENT 193
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 020, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,200)
200 FORMAT (1H1,1X,33HUGOTO - (020) UNCONDITIONAL GO TO/16X,
19HSTATEMENT//2X,
2 21HASA REFS. - 7.1.2.1.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 020 WRITTEN
C***** TEST BRANCH FORWARD
GO TO 201
203 MRRVI = 3
WRITE (NUVI,7200) MRRVI
7200 FORMAT (/4X,I1)
GO TO 204
207 MRRVI = 7
WRITE (NUVI,7200) MRRVI
GO TO 208
202 MRRVI = 2
WRITE (NUVI,7200) MRRVI
C***** TEST BRANCH BACKWARD
GO TO 203
201 MRRVI = 1
WRITE (NUVI,7200) MRRVI
GO TO 202
208 MRRVI = 8
WRITE (NUVI,7200) MRRVI
GO TO 209
206 MRRVI = 6
WRITE (NUVI,7200) MRRVI
GO TO 207
204 MRRVI = 4
WRITE (NUVI,7200) MRRVI
C***** TEST BRANCH TO STATEMENT IMMEDIATELY AFTER
C***** UNCONDITIONAL GO TO
GO TO 205
205 MRRVI = 5
WRITE (NUVI,7200) MRRVI
GO TO 206
209 WRITE (NUVI,7201)
7201 FORMAT (//2X,35HTHIS TEST IS SUCCESSFUL ONLY IF THE/
12X,37HNUMBERS LISTED ABOVE ARE SEQUENTIALLY/
22X,20HIN ORDER FROM 1 TO 8)
C***** END OF TEST SEGMENT 020
C*****
C***** WHEN EXECUTING ONLY SEGMENT 020, THE STOP AND END
C***** CARDS, WHICH APPEAR AS COMMENTS, MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** AGOTO - (021)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST GO TO ASSIGNMENT STATEMENTS 7.1.1.3
C***** AND ASSIGNED GO TO STATEMENTS 7.1.2.1.2
C***** RESTRICTIONS OBSERVED
C***** INTEGER VARIABLE USED IN ASSIGN STATEMENTS 7.1.1.3 /06
C***** IS NEVER REFERENCED ELSEWHERE IN THIS SEGMENT 10.2.3 /12
C***** ASSIGNED GO TO STATEMENTS CAUSE BRANCHES ONLY 7.1.1.3 /03
C***** TO EXECUTABLE STATEMENTS 7.1.2 /54
C***** INTEGER VARIABLE ALWAYS CONTAINS STATEMENT 7.1.2.1.2/20
C***** LABEL FROM THE ASSIGNED GO TO LIST
C***** GENERAL COMMENTS
C***** IGVI AND KGVI ARE IMPLICITLY DEFINED 5.3 /07
C***** GTVI IS EXPLICITLY DEFINED 7.2.1.6 /55
C***** ASSIGN AND ASSIGNED GO TO ALSO TESTED IN
C***** SEGMENT 190
C*****
C***** S P E C I F I C A T I O N S SEGMENT 021
C*****
C***** WHEN EXECUTING ONLY SEGMENT 021, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COL
C***** 1 AND 2 REMOVED
C= INTEGER GTVI
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 021, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,210)
210 FORMAT (1H1,1X,33HAGOTO - (021) ASSIGN AND ASSIGNED/16X,
15HGO TO//2X,
231HASA REFS. - 7.1.1.3 AND 7.1.2.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 021 WRITTEN
C***** TEST FORWARD BRANCHING GO TO WITH ONLY ONE
C***** LABEL IN THE BRANCH LIST
ASSIGN 211 TO IGVI
GO TO IGVI, (211)
C***** TEST FORWARD BRANCHING GO TO WHICH BRANCHES
C***** TO IMMEDIATELY FOLLOWING STATEMENT
212 MRRVI = 2
WRITE (NUVI,8212) MRRVI
ASSIGN 213 TO GTVI
GO TO GTVI, (213)
C***** TEST FORWARD BRANCHING GO TO WHERE ALL BRANCHES
C***** ARE IDENTICAL
213 MRRVI = 3
WRITE (NUVI,8212) MRRVI
ASSIGN 214 TO GTVI
GO TO GTVI, (214,214,214)
C***** TEST FORWARD BRANCHING GO TO WITH SEVERAL UNIQUE
C***** BRANCHES IN THE LIST
215 MRRVI = 5
WRITE (NUVI,8212) MRRVI
ASSIGN 217 TO KGVI
ASSIGN 216 TO IGVI
GO TO IGVI, (217,218,216,219)
C***** TEST BACKWARD BRANCHING GO TO WHERE BRANCHES
C***** ARE IDENTICAL
214 MRRVI = 4
WRITE (NUVI,8212) MRRVI
ASSIGN 215 TO IGVI
GO TO IGVI, (215,215)
C***** TEST BACKWARD BRANCHING GO TO WITH ONLY ONE LABEL
C***** IN THE BRANCH LIST
211 MRRVI = 1
WRITE (NUVI,8212) MRRVI
ASSIGN 212 TO GTVI
GO TO GTVI, (212)
C***** IN THE FIRST PART OF THIS TEST, ALL GO TO STATEMENTS
C***** WERE EXECUTED ONLY ONCE, IMMEDIATELY AFTER THE
C***** INTEGER VARIABLE WAS DEFINED. ALL GO TO STATEMENTS
C***** WHICH FOLLOW WILL BE EXECUTED MORE THAN ONCE.
C***** VALUE OF IGVI IS ALWAYS 8216 IN THIS PART OF THE
C***** TEST UNTIL FINAL MESSAGE IS TO BE WRITTEN
216 MRRVI = 6
WRITE (NUVI,8212) MRRVI
ASSIGN 8216 TO IGVI
8216 GO TO KGVI, (217,219,7210,7214,8210)
217 MRRVI = 7
ASSIGN 218 TO GTVI
GO TO 8211
218 MRRVI = 8
ASSIGN 219 TO KGVI
GO TO 8213
219 MRRVI = 9
ASSIGN 7210 TO KGVI
GO TO 8213
7210 MRRVI = 10
ASSIGN 7211 TO GTVI
GO TO 8211
7211 MRRVI = 11
ASSIGN 7212 TO GTVI
GO TO 8211
7212 MRRVI = 12
ASSIGN 7213 TO GTVI
GO TO 8211
7213 MRRVI = 13
ASSIGN 7214 TO KGVI
GO TO 8213
7214 MRRVI = 14
ASSIGN 7215 TO GTVI
GO TO 8211
7215 MRRVI = 15
ASSIGN 7216 TO GTVI
GO TO 8211
7216 MRRVI = 16
ASSIGN 7217 TO GTVI
GO TO 8211
7217 MRRVI = 17
ASSIGN 7218 TO GTVI
GO TO 8211
7218 MRRVI = 18
ASSIGN 7219 TO GTVI
GO TO 8211
7219 MRRVI = 19
ASSIGN 8210 TO KGVI
GO TO 8213
8210 MRRVI = 20
ASSIGN 8214 TO IGVI
GO TO 8213
8211 WRITE (NUVI,8212) MRRVI
8212 FORMAT (/6X,I2)
C***** TEST GO TO WITH CONTINUATION CARD
GO TO GTVI, (218, 7211, 7212, 7213, 7215, 7216, 7217, 7218,
1 7219)
8213 WRITE (NUVI,8212) MRRVI
GO TO IGVI, (8216,8214)
8214 WRITE (NUVI,8215)
8215 FORMAT (1H0,2X,35HTHIS TEST IS SUCCESSFUL ONLY IF THE/
12X,37HNUMBERS LISTED ABOVE ARE SEQUENTIALLY/
22X,21HIN ORDER FROM 1 TO 20)
C***** END OF TEST SEGMENT 021
C*****
C***** WHEN EXECUTING ONLY SEGMENT 021, THE STOP AND END
C***** CARDS, WHICH APPEAR AS COMMENTS, MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CGOTO - (022)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST COMPUTED GO TO STATEMENTS 7.1.2.1.3
C***** RESTRICTIONS OBSERVED
C***** VALUE OF INTEGER VARIABLE IS NEVER LESS THAN 1 7.1.2.1.3/33
C***** AND NEVER LARGER THAN THE NUMBER OF BRANCHES
C***** INTEGER VARIABLES USED IN COMPUTED GO TO STMNTS. 10.2.8 /09
C***** ARE NOT EQUATED TO AVOID SECOND LEVEL 10.3 /13
C***** DEFINITION PROBLEMS
C***** GENERAL COMMENTS
C***** IGVI AND KGVI ARE IMPLICITLY DEFINED 5.3 /07
C***** GTVI IS EXPLICITLY DEFINED 7.2.1.6 /55
C***** COMPUTED GO TO ALSO TESTED IN SEGMENT 162
C*****
C***** S P E C I F I C A T I O N S SEGMENT 022
C*****
C***** WHEN EXECUTING ONLY SEGMENT 022, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COL
C***** 1 AND 2 REMOVED
C*****
C= INTEGER GTVI
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 022, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,220)
220 FORMAT (1H1,1X,28HCGOTO - (022) COMPUTED GO TO//2X,
120HASA REF. - 7.1.2.1.3//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 022 WRITTEN
C***** TEST FORWARD BRANCHING GO TO WITH ONLY ONE
C***** LABEL IN BRANCH LIST
IGVI = 1
GO TO (221), IGVI
C***** TEST FORWARD BRANCHING GO TO WHICH BRANCHES
C***** TO IMMEDIATELY FOLLOWING STATEMENT
222 MRRVI = 2
WRITE (NUVI,8222) MRRVI
GO TO (223), GTVI
C*****
C***** TEST FORWARD BRANCHING GO TO WHERE SOME BRANCHES
C***** ARE IDENTICAL
223 MRRVI = 3
WRITE (NUVI,8222) MRRVI
GTVI = 2
GO TO (225,224,225), GTVI
C***** TEST FORWARD BRANCHING GO TO WITH SEVERAL UNIQUE
C***** BRANCHES IN LIST
225 MRRVI = 5
WRITE (NUVI,8222) MRRVI
KGVI = 1
IGVI = 3
GO TO (227,228,226,229), IGVI
C***** TEST BACKWARD BRANCHING GO TO WHERE SOME
C***** BRANCHES ARE IDENTICAL
224 MRRVI = 4
WRITE (NUVI,8222) MRRVI
IGVI = 4
GO TO (226,226,226,225), IGVI
C***** TEST BACKWARD BRANCHING GO TO WITH ONLY ONE
C***** LABEL IN BRANCH LIST
221 MRRVI = 1
WRITE (NUVI, 8222) MRRVI
GTVI = 1
GO TO (222), GTVI
C***** IN THE FIRST PART OF THIS TEST, ALL GO TO STATEMENTS
C***** WERE EXECUTED ONLY ONCE, IMMEDIATELY AFTER THE
C***** INTEGER VARIABLE WAS DEFINED. ALL GO TO STATEMENTS
C***** WHICH FOLLOW WILL BE EXECUTED MORE THAN ONCE.
C***** VALUE OF IGVI IS ALWAYS 1 IN THIS PART OF THE TEST
C***** UNTIL THE FINAL MESSAGE IS TO BE WRITTEN
226 MRRVI = 6
IGVI = 1
WRITE (NUVI,8222) MRRVI
8226 GO TO (227,229,7220,7224,8220), KGVI
227 MRRVI = 7
GTVI = 1
GO TO 8221
228 MRRVI = 8
KGVI = 2
GO TO 8223
229 MRRVI = 9
KGVI = 3
GO TO 8223
7220 MRRVI = 10
GTVI = 2
GO TO 8221
7221 MRRVI = 11
GTVI = 5
GO TO 8221
7222 MRRVI = 12
GTVI = 4
GO TO 8221
7223 MRRVI = 13
KGVI = 4
GO TO 8223
7224 MRRVI = 14
GTVI = 6
GO TO 8221
7225 MRRVI = 15
GTVI = 7
GO TO 8221
7226 MRRVI = 16
GTVI = 9
GO TO 8221
7227 MRRVI = 17
GTVI = 8
GO TO 8221
7228 MRRVI = 18
GTVI = 3
GO TO 8221
7229 MRRVI = 19
KGVI = 5
GO TO 8223
8220 MRRVI = 20
IGVI = 2
GO TO 8223
8221 WRITE (NUVI,8222) MRRVI
8222 FORMAT(/6X,I2)
C***** TEST GO TO STATEMENT WITH CONTINUATION LINE
GO TO (228, 7221, 7229, 7223, 7222, 7225, 7226, 7228,
1 7227), GTVI
8223 WRITE (NUVI,8222) MRRVI
GO TO (8226,8224), IGVI
8224 WRITE (NUVI,8225)
8225 FORMAT (1H0,2X,35HTHIS TEST IS SUCCESSFUL ONLY IF THE/
12X,37HNUMBERS LISTED ABOVE ARE SEQUENTIALLY/
22X,21HIN ORDER FROM 1 TO 20)
C***** END OF TEST SEGMENT 022
C*****
C***** WHEN EXECUTING ONLY SEGMENT 022, THE STOP AND END
C***** CARDS, WHICH APPEAR AS COMMENTS, MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARBAD - (030)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING THE ADDITION 6.1
C***** OF INTEGER OR REAL VALUES MAY BE FORMED
C***** GENERAL COMMENTS
C***** TYPES ARE NEVER MIXED.
C***** VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED
C***** IN A VARIETY OF COMBINATIONS.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 030
C*****
C***** WHEN EXECUTING ONLY SEGMENT 030, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COL
C***** 1 AND 2 REMOVED
C*****
C= DIMENSION A1S(5),A2S(2,2),IAC1I(5),IAC2I(2,7)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 030, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,301)
301 FORMAT (1H1,1X,28HARBAD - (030) BASIC ADDITION//2X,
-14HASA REF. - 6.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 030 WRITTEN
WRITE (NUVI,302)
302 FORMAT (//2X,16HINTEGER ADDITION)
C***** TEST 1 - ADD 2 INTEGER VARIABLES (ONE CONTAINS MINUS VALUE)
MRRVI=1
JACVI=2
KBCVI = -2
IHDVI=JACVI+KBCVI
WRITE (NUVI,303) MRRVI, IHDVI
303 FORMAT (/6H TEST,I3,I6)
C***** TEST 2 - REVERSE VARIABLES IN TEST 1
MRRVI = 2
IGDVI=KBCVI+JACVI
WRITE (NUVI,303) MRRVI, IGDVI
C***** TEST 3 - ADD 2 CONSTANTS
MRRVI = 3
IAC1I(1) = 2+(-2)
WRITE (NUVI,303) MRRVI, IAC1I(1)
C***** TEST 4 - ADD 2 ARRAY ELEMENTS (ONE CONTAINS MINUS VALUE)
MRRVI = 4
IAC1I(3) = 3
IAC2I(1,3) = - 3
IAC2I(2,2) = IAC1I(3)+IAC2I(1,3)
WRITE (NUVI,303) MRRVI, IAC2I(2,2)
C***** TEST 5 - ADD 8 INTEGER VARIABLES
MRRVI = 5
LCCVI = -6
MDCVI=-2
NECVI = +18
IFDVI = JACVI+KBCVI+LCCVI+MDCVI+MDCVI+LCCVI+KBCVI+NECVI
WRITE (NUVI,303) MRRVI, IFDVI
C***** TEST 6 - ADD COMBINATION OF VARIABLES, ARRAY ELEMENTS
C***** AND CONSTANTS
MRRVI = 6
IAC2I(2,2) = -2
IFDVI = IAC1I(3)+IAC2I(1,3)+IAC2I(2,2)+JACVI+KBCVI+LCCVI+7+1
WRITE (NUVI,303) MRRVI, IFDVI
C***** TEST 7 - ADD 2 REAL VARIABLES
WRITE (NUVI,304)
304 FORMAT (//15H REAL ADDITION)
MRRVI = 7
ACVS = -2.0
BCVS = 2.0E0
HHCVS = ACVS+BCVS
WRITE (NUVI,305) MRRVI, HHCVS
305 FORMAT (/6H TEST,I3,F7.1)
C***** TEST 8 - REVERSE ORDER OF VARIABLES IN TEST 7
MRRVI = 8
GGCVS = BCVS + ACVS
WRITE (NUVI,305) MRRVI, GGCVS
C***** TEST 9 - ADD 4 REAL VARIABLES
MRRVI = 9
FFCVS = ACVS + BCVS + ACVS + BCVS
WRITE (NUVI,305) MRRVI, FFCVS
C***** TEST 10 - ADD 2 REAL CONSTANTS
MRRVI = 10
A2S(1,2) = 3.5 + (-3.5)
WRITE (NUVI,305) MRRVI, A2S(1,2)
C***** TEST 11 - ADD REAL ARRAY ELEMENTS
MRRVI = 11
A1S(1) = -25.E-1
ACVS = 2.5
A2S (1,1) = -7.0
FFCVS = A1S(1) + A2S(1,1) + 9.5
WRITE ( NUVI,305) MRRVI, FFCVS
C***** TEST 12 - ADD COMBINATION OF VARIABLES, ARRAY ELEMENTS
C***** AND CONSTANTS
MRRVI = 12
FFCVS = A1S(1) + ACVS + 7.0 + A2S(1,1)
WRITE (NUVI,305) MRRVI, FFCVS
WRITE (NUVI,306)
306 FORMAT (//35H ALL ABOVE ANSWERS SHOULD BE 0 FOR/
1 31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 030
C*****
C***** WHEN EXECUTING ONLY SEGMENT 030, THE STOP AND END
C***** CARDS, WHICH APPEAR AS COMMENTS, MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARFAD - (031)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING THE ADDITION OF 6.1
C***** DOUBLE PRECISION VALUES MAY BE FORMED
C***** GENERAL COMMENTS
C***** VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED IN A
C***** VARIETY OF COMBINATIONS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 031
C*****
C***** WHEN EXECUTING ONLY SEGMENT 031, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COL
C***** 1 AND 2 REMOVED
C*****
C= DOUBLE PRECISION ACVD,BCVD,FFCVD,GGCVD,HHCVD
C= 1,EP1D(43),BC2D(7,4),CC3D(7,2,2)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 031, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,310)
310 FORMAT (1H1,1X,27HARFAD - (031) D.P. ADDITION//
-16H ASA REF. - 6.1//9H RESULTS)
C***** HEADER FOR SEGMENT 031 WRITTEN
ACVD = -.01414213562373095D2
BCVD = 14.14213562373095D-1
EP1D(20) = -4.12310562561766D0
BC2D(6,3) = .206155281280883D1
HHCVD=ACVD+BCVD
GGCVD=BCVD+ACVD
EP1D(34) = .003D3 + (-300.0D-2)
FFCVD = BCVD+ACVD+ACVD+BCVD
CC3D(7,1,1)=EP1D(20)+BC2D(6,3)+206.155281280883D-2 +41.23105625617
166D-1 + EP1D(20)
WRITE (NUVI,312) HHCVD, GGCVD, FFCVD, EP1D(34), CC3D(7,1,1)
312 FORMAT (//5(D22.10//)//38H THE 5 ANSWERS ABOVE SHOULD BE 0 PLUS/
137H OR MINUS AN ERROR FACTOR OF 0.1D-13)
C***** END OF TEST SEGMENT 031
C*****
C***** WHEN EXECUTING ONLY SEGMENT 031, THE STOP AND END
C***** CARDS, WHICH APPEAR AS COMMENTS, MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C= END
C= STOP
C***********************************************************************
C*****
C***** ARBSB - (032)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING THE SUBTRACTION OF 6.1
C***** INTEGER OR REAL VALUES MAY BE FORMED
C***** GENERAL COMMENTS
C***** TYPES ARE NEVER MIXED
C***** VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED IN A
C***** VARIETY OF COMBINATIONS.
C***** S P E C I F I C A T I O N S SEGMENT 032
C*****
C***** WHEN EXECUTING ONLY SEGMENT 032, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COL
C***** 1 AND 2 REMOVED
C*****
C= DIMENSION A1S(5),A2S(2,2),IAC1I(5),IAC2I(2,7)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 032, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,320)
320 FORMAT (1H1,1X,31HARBSB - (032) BASIC SUBTRACTION//
1 17H ASA REFS. - 6.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 032 WRITTEN
MRRVI = 1
WRITE (NUVI,321)MRRVI
321 FORMAT (//2X,4HTEST,I1,1X,19HINTEGER SUBTRACTION)
JACVI=3
IAC1I(1)=3
IHDVI=JACVI-IAC1I(1)
IGDVI=IAC1I(1)-JACVI
IFDVI=JACVI-IAC1I(1)-IAC1I(1)+JACVI
IAC2I(2,3) = 3-2-1
IAC2I(1,1) = 6 - JACVI - IAC1I(1)
WRITE (NUVI,323) IHDVI,IGDVI, IFDVI, IAC2I(2,3), IAC2I(1,1)
323 FORMAT (/5(I11/))
MRRVI = 2
328 WRITE (NUVI,329)MRRVI
329 FORMAT (//2X,4HTEST,I1,1X,16HREAL SUBTRACTION)
ACVS=5.1E1
BCVS=.51E2
HHCVS=ACVS-BCVS
GGCVS=BCVS-ACVS
FFCVS=ACVS-BCVS+BCVS-ACVS
A2S(1,2) = 2.1E1
A1S(1) = ACVS - A2S(1,2) - 30.0
WRITE (NUVI,324) HHCVS, GGCVS, FFCVS, A1S(1)
324 FORMAT (/4(F11.1/)/34H ALL ABOVE ANSWERS SHOULD BE 0 FOR/
1 31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 032
C*****
C***** WHEN EXECUTING ONLY SEGMENT 032, THE STOP AND END
C***** CARDS, WHICH APPEAR AS COMMENTS, MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARFSB - (033)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING THE SUBTRACTION OF 6.1
C***** DOUBLE PRECISION VALUES MAY BE FORMED
C***** GENERAL COMMENTS
C***** VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED IN A
C***** VARIETY OF COMBINATIONS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 033
C*****
C***** WHEN EXECUTING ONLY SEGMENT 033, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COL
C***** 1 AND 2 REMOVED
C*****
C= DOUBLE PRECISION ACVD,BCVD,CCVD,DCVD,GGCVD,HHCVD,DPCVD,FFCVD
C= 1,AC1D(10),A2D(2,2),A3D(2,2,2)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 033, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,330)
330 FORMAT (1H1,1X,30HARFSB - (033) D.P. SUBTRACTION//
-16H ASA REF. - 6.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 033 WRITTEN
ACVD=1.0D2
BCVD=.3D1
CCVD=15.D0
AC1D(1) = 60.D-1
A2D(1,1) = -.02D2
A3D(1,2,1) = 4000.D-3
C***** TWO TERM SUBTRACTION
HHCVD= ACVD-BCVD
HHCVD= HHCVD-97.0D0
GGCVD=1.0D0-AC1D(1)
GGCVD=GGCVD+5.0D0
DCVD = 4.0D0 - A3D(1,2,1)
WRITE (NUVI,331) HHCVD, GGCVD, DCVD
C***** THREE TERM SUBTRACTION
HHCVD= ACVD-BCVD-97.0D0
GGCVD = 16.0D0 - CCVD - 1.0D0
DCVD = A3D(1,2,1)-A2D(1,1) -6.0D0
WRITE (NUVI,331) HHCVD, GGCVD, DCVD
C***** FOUR TERM SUBTRACTION
DPCVD = 6.85565460040104D0
FFCVD = (+.342782730020052D1)
GGCVD = DPCVD - FFCVD - 42.782730020052D-2 - 300D-2
HHCVD=ACVD-AC1D(1)-AC1D(1)-8.8D1
DCVD = CCVD - A2D(1,1) - 110.D-1 - AC1D(1)
WRITE (NUVI,332) HHCVD, DCVD , GGCVD
331 FORMAT (//3(D22.10/))
332 FORMAT (//3(D22.10/)//36H THE ANSWERS ABOVE SHOULD BE 0 PLUS/
137H OR MINUS AN ERROR FACTOR OF 0.1D-13)
C***** END OF TEST SEGMENT 033
C*****
C***** WHEN EXECUTING ONLY SEGMENT 033, THE STOP AND END
C***** CARDS, WHICH APPEAR AS COMMENTS, MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARBAS - (034)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING THE ADDITION AND 6.1
C***** SUBTRACTION (COMBINED) OF INTEGER OR REAL VALUES MAY BE
C***** FORMED.
C***** GENERAL COMMENTS
C***** TYPES ARE NEVER MIXED.
C***** VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED IN
C***** A VARIETY OF COMBINATIONS.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 034
C*****
C***** WHEN EXECUTING ONLY SEGMENT 034, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COL
C***** 1 AND 2 REMOVED
C*****
C= DIMENSION A2S(2,2),A3S(3,3,3)
C= 1,IAC1I(5),IAC2I(2,7),AC1S(25)
C= INTEGER MCA3I(2,3,3)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 034, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COL 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,340)
340 FORMAT (1H1,1X,32HARBAS - (034) BASIC ADDITION AND/14X,
113H SUBTRACTION//16H ASA REF. - 6.4//
22X,7HRESULTS)
C***** HEADER FOR SEGMENT 034 WRITTEN
WRITE (NUVI,341)
341 FORMAT (//2X,26HTEST1 INTEGER ADD AND SUBT)
JACVI = 5
KBCVI = 1
LCCVI = 10
MDCVI = -2
IAC1I(2) = 3
IAC2I(2,2) = -3
IHDVI = JACVI+KBCVI-LCCVI+MDCVI-IAC1I(2)+9
IGDVI = (JACVI+KBCVI) - (MDCVI-IAC1I(2)) - 11
IFDVI =(6 + (KBCVI - (LCCVI+MDCVI))) + 1
MCA3I(1,1,1) = IAC2I(2,2) - JACVI - MDCVI - KBCVI + 7 + 0
WRITE (NUVI,342) IHDVI,IGDVI, IFDVI, MCA3I(1,1,1)
342 FORMAT (/4(I11/))
C***** HEADER FOR TEST2
WRITE (NUVI,344)
344 FORMAT (/2X,24HTEST2 REAL ADD AND SUBTR)
ACVS = 5.0
BCVS = 1.0
CCVS = 10.0
DCVS = -.2E+1
AC1S(1) = 30.E-1
A2S (2,1) = 6.0
HHDVS= ACVS + BCVS - CCVS + DCVS +9.0-AC1S(1)
GGDVS= (ACVS + 1.0) -11.0 - ( DCVS-AC1S(1))
FFDVS= (6.0 + (BCVS-(CCVS+DCVS))) + 1.0
A3S(1,1,2) = A2S(2,1) - CCVS + 8.0 - 4.0
WRITE (NUVI,343) HHDVS, GGDVS, FFDVS, A3S(1,1,2)
343 FORMAT (//4(F11.1/)/35H ALL ABOVE ANSWERS SHOULD BE 0 FOR/
1 31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 034
C*****
C***** WHEN EXECUTING ONLY SEGMENT 034, THE STOP AND END
C***** CARDS WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
nbs04.d 480890332 170 2 100666 302 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2 . DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4 . DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6 DOUBLE SPACE ON OUTPUT ID 6
nbs04.f 480887319 170 2 100666 41989 `
C***** PART4 *****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 4 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** ARFAS - 035 ADDITION AND SUBTRACTION OF DP VALUES
C*****
C***** ARBMI - 036 MULTIPLICATION OF INTEGER VALUES
C*****
C***** ARBMR - 037 MULTIPLICATION OF REAL VALUES
C*****
C***** ARFMD - 038 MULTIPLICATION OF DOUBLE PRECISION VALUES
C*****
C***** ARBDV - 039 DIVISION OF INTEGER AND REAL VALUES
C*****
C***** ARFDV - 040 DIVISION OF DOUBLE PRECISION VALUES
C*****
C***** ARBEX - 041 EXPONENTIATION OF INTEGER AND REAL VALUES
C*****
C***** ARFEX - 042 EXPONENTIATION OF DOUBLE PRECISION VALUES
C*****
C***** ARBHI - 043 HIERARCHY OF OPERATORS AND PARENTHESES
C*****
C***** SBB67 - 050 SUBSCRIPTS OF INTEGER AND REAL ARRAYS V, K
C*****
C***** SBB45 - 051 SUBSCRIPTS OF INT., REAL ARRAYS V+K, V-K
C*****
C***** SBB13 - 052 SUBSCRIPTS OF INT, REAL ARRAYS C*V, C*V+K, C*V-K
C*****
C***** SBF17 - 053 SUBSCRIPTS OF DP ARRAYS V, K, C*V, C*V+K, C*V-K
C***** V+K, V-K
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN SEGMENTS
C***** 035, 036, 037, 038, 039, 040, 041, 042, 043, 050, 051, 052, 053
C***** ARE RUN AS ONE MAIN PROGRAM.
C*****
INTEGER MCA3I(2,3,3)
DOUBLE PRECISION ACVD, BCVD, CCVD, DCVD, CCDVD, DDDVD
1 , EEDVD, FFDVD, GGDVD, HHDVD, AC1D(10), BC2D(7,4), CC3D(7,2,2)
2 , EP1D(43), VTAVD, WTAVD, AADVD
DIMENSION A2S(2,2), A3S(3,3,3), AC1S(25), AC2S(5,6)
1 , IAC1I(5), IAC2I(2,7)
C*****
C***** END OF SPECIFICATIONS FOR SEGMENTS
C***** 035, 036, 037, 038, 039, 040, 041, 042, 043, 050, 051, 052, 053
C***********************************************************************
C*****
C***** ARFAS - (035)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING THE ADDITION AND 6.1
C***** SUBTRACTION (COMBINED) OF DOUBLE PRECISION VALUES
C***** MAY BE FORMED
C***** GENERAL COMMENTS
C***** VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED IN A
C***** VARIETY OF COMBINATIONS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 035
C*****
C***** WHEN EXECUTING ONLY SEGMENT 035, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH APPEAR AS
C***** COMMENTS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION ACVD,BCVD,CCVD,DCVD,FFDVD,GGDVD,HHDVD
C= 1,AC1D(10),BC2D(7,4),CC3D(7,2,2)
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS.
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 4 ///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
WRITE (NUVI,350)
350 FORMAT (1H1,1X,32HARFAS - (035) D.P. ADD AND SUBTR//2X,
-14HASA REF. - 6.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 035 WRITTEN
ACVD = 5.0D0
BCVD = 10.0D-1
CCVD = 10.0D0
DCVD = -0.2D1
AC1D(1)= 300.0D-2
BC2D(6,3) = 400.D-2
AC1D(2) = .24816326424816D5
BC2D(5,3) = -.12408163212408D5
HHDVD = ACVD + BCVD - CCVD + DCVD + 9.0D0 - AC1D(1)
GGDVD = (ACVD + 1.0E0) - 11.0E0 -(DCVD - AC1D(1))
FFDVD = (6.0D0+(BCVD-(CCVD+DCVD))) + 10.0D-1
CC3D(6,1,1) = CCVD-DCVD+BC2D(6,3)-ACVD-11.0D0
CC3D(5,1,2) = AC1D(2) + BC2D(5,3) - 12408.163212408D0
WRITE (NUVI,351) HHDVD, GGDVD, FFDVD, CC3D(6,1,1), CC3D(5,1,2)
351 FORMAT (//5(D22.10/)//35H THE ANSWERS ABOVE SHOULD BE 0 FOR/
1 32H THIS SEGMENT TO BE SUCCESSFUL./36H VALUES WITH EXPONENTS LE
2SS THAN /31H 10**(-14) ARE CONSIDERED ZERO)
C***** END OF TEST SEGMENT 035
C*****
C***** WHEN EXECUTING ONLY SEGMENT 035, THE STOP AND END
C***** CARDS, WHICH APPEAR AS COMMENTS, MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARBMI - (036)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING MULTIPLICATION OF 6.1
C***** INTEGER VALUES MAY BE FORMED.
C***** GENERAL COMMENTS
C***** INTEGER SUBTRACTION ASSUMED WORKING
C***** * VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED
C***** IN A VARIETY OF COMBINATIONS.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 036
C*****
C***** WHEN EXECUTING ONLY SEGMENT 036, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DIMENSION IAC1I(5), IAC2I(2,7)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 036, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,360)
360 FORMAT (1H1, 1X,36HARBMI - (036) INTEGER MULTIPLICATION//
116H ASA REF. - 6.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 036 WRITTEN
JACVI=1
KBCVI=2
LCCVI=0
MDCVI=-5
IAC1I(2) = -10
IAC2I(1,2) = 3
IHDVI=JACVI*KBCVI
IGDVI=KBCVI*MDCVI*LCCVI
IFDVI = MDCVI*JACVI*IAC1I(2)*3
IEDVI=-3*JACVI*(-MDCVI)*JACVI*KBCVI
IDDVI=KBCVI*KBCVI*KBCVI*KBCVI*KBCVI*JACVI
ICDVI = (-IAC1I(2))*JACVI*KBCVI*JACVI*KBCVI*JACVI*1
IAC2I(1,1)=IAC2I(1,2)*MDCVI*IAC1I(2)*2
IHDVI = IHDVI - 2
IFDVI = IFDVI - 150
IEDVI = IEDVI + 30
IDDVI = IDDVI - 32
ICDVI = ICDVI - 40
IAC2I(1,1) = IAC2I(1,1) - 300
WRITE (NUVI,361) IHDVI, IGDVI, IFDVI, IEDVI, IDDVI, ICDVI,
1 IAC2I(1,1)
361 FORMAT (//7(I10/)//35H ALL ABOVE ANSWERS SHOULD BE 0 FOR/
1 31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 036
C*****
C***** WHEN EXECUTING ONLY SEGMENT 036, THE STOP AND END
C***** CARDS, WHICH APPEAR AS COMMENTS, MUST HAVE THE C=
C***** IN COL 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARBMR - (037)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING MULTIPLICATION OF 6.1
C***** REAL VALUES MAY BE FORMED
C***** GENERAL COMMENTS
C***** REAL SUBTRACTION ASSUMED WORKING
C***** * VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED IN A
C***** VARIETY OF COMBINATIONS.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 037
C*****
C***** WHEN EXECUTING ONLY SEGMENT 037, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DIMENSION A2S(2,2),AC1S(25)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 037, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,370)
370 FORMAT (1H1,1X,33HARBMR - (037) REAL MULTIPLICATION//2X,
114HASA REF. - 6.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 037 WRITTEN
ACVS = 1.0
BCVS = 0.2E2
CCVS = -1.0
DCVS = 0.0
AC1S(1) = .5E+1
HHDVS=ACVS*BCVS
GGDVS=BCVS*BCVS*1.0
FFDVS=2.0*AC1S(1)*ACVS*ACVS
EEDVS=ACVS*BCVS*CCVS*DCVS*AC1S(1)
DDDVS=AC1S(1)*ACVS*BCVS*1.0E1*ACVS*ACVS
CCDVS=CCVS*CCVS*CCVS*3.E0*ACVS*ACVS*ACVS
A2S(1,1) = ACVS*CCVS*2.
HHDVS = HHDVS - 20.0
GGDVS = GGDVS - 400.0
FFDVS = FFDVS - 10.0
DDDVS = DDDVS - 1000.0
CCDVS = CCDVS + 3.0
A2S(1,1) = A2S(1,1) + 2.
WRITE (NUVI,371) HHDVS, GGDVS, FFDVS, EEDVS, DDDVS, CCDVS,
1 A2S(1,1)
371 FORMAT (//7(F11.1/)//35H ALL ABOVE ANSWERS SHOULD BE 0 FOR/
1 31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 037
C***** WHEN EXECUTING ONLY SEGMENT 037, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARFMD - (038)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING THE MULTIPLICATION 6.1
C***** OF DOUBLE PRECISION VALUES MAY BE FORMED
C***** GENERAL COMMENTS
C***** * DP ADDITION AND SUBTRACTION ASSUMED WORKING.
C***** * VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED IN A
C***** VARIETY OF COMBINATIONS.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 038
C*****
C***** WHEN EXECUTING ONLY SEGMENT 038, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION ACVD,BCVD,CCVD,DCVD,EEDVD,DDDVD,CCDVD
C= 1,FFDVD, GGDVD,HHDVD,AC1D(10),BC2D(7,4), CC3D(7,2,2)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 038, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,380)
380 FORMAT (1H1,1X,33HARFMD - (038) D.P. MULTIPLICATION// 2X,
-15H ASA REF. - 6.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 038 WRITTEN
ACVD=1.0D0
BCVD=2.0
CCVD=-30.0D-1
DCVD=1.0D1
AC1D(1) = 1.1D1
CC3D(3,1,2) = .262144D6
CC3D(6,1,2) = -2000.D-3
CC3D(3,2,2) = 409.6D1
HHDVD=ACVD*BCVD
GGDVD=ACVD*0.0D0*CCVD
FFDVD = AC1D(1)*ACVD*ACVD*ACVD
EEDVD=CCVD*CCVD*ACVD*1.0D0*BCVD
DDDVD=ACVD*2.0D1*ACVD*DCVD*1.0E0*CCVD
CCDVD=ACVD*BCVD*CCVD*CCVD*CCVD*BCVD*ACVD
BC2D(3,4) = DCVD*(400.D-2)*CC3D(6,1,2)
BC2D(2,3) = CC3D(3,1,2) * CC3D(3,2,2)
HHDVD = HHDVD - 2.0D0
FFDVD = FFDVD - 11.0D0
EEDVD = EEDVD - 18.0D0
DDDVD = DDDVD + 600.0D0
CCDVD = CCDVD + 108.0D0
BC2D(3,4) = BC2D(3,4) -(-80.D0)
BC2D(2,3) = BC2D(2,3) - 1.073741824D9
WRITE (NUVI,381) HHDVD, GGDVD, FFDVD, EEDVD, DDDVD, CCDVD,
1 BC2D(3,4) , BC2D(2,3)
381 FORMAT (//8(D22.10/)//35H THE ANSWERS ABOVE SHOULD BE 0 FOR/
1 31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 038
C***** WHEN EXECUTING ONLY SEGMENT 038, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARBDV - (039)
C*****
C***********************************************************************
C*****
C***** GENERAL PURPOSE ASA REF
C***** TEST BASIC DIVISION, 6.1
C***** INTEGER AND REAL (SP) TYPES ONLY
C*****
C***** S P E C I F I C A T I O N S SEGMENT 039
C*****
C***** WHEN EXECUTING ONLY SEGMENT 039, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DIMENSION A2S(2,2),IAC1I(5),IAC2I(2,7),AC1S(25)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 039, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,390)
390 FORMAT (1H1,1X,30HARBDV - (039) INTEGER AND REAL/15X,
-9H DIVISION//2X,14HASA REF. - 6.1/ /2X,7HRESULTS)
C***** HEADER FOR SEGMENT 039 WRITTEN
WRITE (NUVI,391)
391 FORMAT (//2X,22HTEST1 INTEGER DIVISION)
JACVI=1
KBCVI=2
LCCVI=0
MDCVI=10
IAC1I(2) = 1
IAC2I(1,4) = -8
IHDVI=KBCVI/JACVI
IGDVI=MDCVI/KBCVI/JACVI
IFDVI=LCCVI/JACVI/JACVI/1
IEDVI = MDCVI/KBCVI/IAC1I(2)/IAC1I(2)/JACVI
IAC2I(1,2)=IAC2I(1,4)/4/KBCVI
IHDVI = IHDVI - 2
IGDVI = IGDVI - 5
IEDVI = IEDVI - 5
IAC2I(1,2) = IAC2I(1,2) + 1
WRITE (NUVI,392) IHDVI, IGDVI, IFDVI, IEDVI, IAC2I(1,2)
392 FORMAT (//5(I10/))
WRITE (NUVI, 393)
393 FORMAT (//2X,19HTEST2 REAL DIVISION)
ACVS=1.0
BCVS=0.0
CCVS=1.0E1
DCVS=20.0E-1
AC1S(1)=100.0E-2
A2S(1,1) = -200.E-2
HHDVS= ACVS/ACVS
GGDVS = CCVS/ACVS/(-ACVS)
FFDVS= BCVS/CCVS/DCVS/ACVS
EEDVS= CCVS/AC1S(1)/DCVS/(-1.0)/ACVS
A2S(1,2) = A2S(1,1)/AC1S(1)/ACVS/(-2.0E0)
HHDVS = HHDVS - 1.0
GGDVS = GGDVS + 10.0
EEDVS = EEDVS + 5.0
A2S(1,2) = A2S(1,2) - 1.
WRITE (NUVI,394) HHDVS , GGDVS, FFDVS, EEDVS, A2S(1,2)
394 FORMAT (//5(F11.1/)//35H ALL ABOVE ANSWERS SHOULD BE 0 FOR/
12X,29HTHIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 039
C***** WHEN EXECUTING ONLY SEGMENT 039, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARFDV - (040)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING DIVISION OF DOUBLE 6.1
C***** PRECISION VALUES MAY BE FORMED
C***** GENERAL COMMENTS
C***** * DP SUBTRACTION ASSUMED WORKING.
C***** * VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED IN A
C***** VARIETY OF COMBINATIONS.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 040
C*****
C***** WHEN EXECUTING ONLY SEGMENT 040, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION ACVD,BCVD,CCVD,DCVD,EEDVD,FFDVD,GGDVD,HHDVD
C= 1,AC1D(10),BC2D(7,4),CC3D(7,2,2)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 040, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,400)
400 FORMAT (1H1,1X,27HARFDV - (040) D.P. DIVISION//
-16H ASA REF. - 6.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 040 WRITTEN
ACVD = 1.0D0
BCVD = 20.0D-1
CCVD = .1D2
DCVD = -10.0
AC1D(1)= 0.0
CC3D(1,2,2) = -.004D3
CC3D(1,1,2) = .244140625D-3
HHDVD = BCVD/ACVD
CC3D(3,1,2) = .125D0
GGDVD = DCVD/DCVD/ACVD
FFDVD = AC1D(1)/BCVD/ACVD/1.D0/1.D0
EEDVD = DCVD/BCVD/(-5.0E0)/ACVD/ACVD
BC2D(4,4) = CC3D(1,2,2)/BCVD/DCVD/.002D2
BC2D(4,3) = CC3D(1,1,2) / CC3D(3,1,2)
HHDVD = HHDVD - 2.0D0
GGDVD = GGDVD - 1.0D0
EEDVD = EEDVD - 1.0D0
BC2D(4,4) = BC2D(4,4) - 1.0D0
BC2D(4,3) = BC2D(4,3) - 195.3125D-5
WRITE (NUVI,401) HHDVD,GGDVD,FFDVD,EEDVD,BC2D(4,4) , BC2D(4,3)
401 FORMAT (//6(D22.10/)//35H THE ANSWERS ABOVE SHOULD BE 0 FOR/
1 31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 040
C***** WHEN EXECUTING ONLY SEGMENT 040, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARBEX - (041)
C*****
C***********************************************************************
C*****
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT EXPRESSIONS INVOLVING INTEGER AND REAL 6.1
C***** EXPONENTIATION MAY BE FORMED
C***** GENERAL COMMENTS
C***** THE FOLLOWING TESTS ARE MADE -
C***** INTEGER BY INTEGER GIVING INTEGER 6.1
C***** REAL (SP) BY INTEGER GIVING REAL (SP)
C***** REAL (SP) BY REAL (SP) GIVING REAL (SP)
C***** RESTRICTIONS OBSERVED
C*****
C***** S P E C I F I C A T I O N S SEGMENT 041
C*****
C***** WHEN EXECUTING ONLY SEGMENT 041, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DIMENSION A2S(2,2),IAC1I(5),IAC2I(2,7),AC1S(25)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 041, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,410)
410 FORMAT (1H1,1X,34HARBEX - (041) BASIC EXPONENTIATION//
- 2X,15HASA REFS. - 6.1//2X, 7HRESULTS)
C***** HEADER FOR SEGMENT 041 WRITTEN
WRITE (NUVI,411)
411 FORMAT (//2X,18HINTEGER BY INTEGER)
JACVI=1
KBCVI=0
LCCVI=2
MDCVI=-1
IAC1I(2) = 3
IAC2I(1,4) = 3
IHDVI = LCCVI**IAC1I(2)
IGDVI=KBCVI**JACVI
IFDVI=JACVI**KBCVI
IEDVI = MDCVI**IAC1I(2)
IDDVI=(LCCVI**LCCVI)**(JACVI**MDCVI)
IAC2I(1,2) = (LCCVI**IAC2I(1,4))**JACVI
IHDVI = IHDVI - 8
IFDVI = IFDVI - 1
IEDVI = IEDVI + 1
IDDVI = IDDVI- 4
IAC2I(1,2) = IAC2I(1,2) - 8
WRITE (NUVI, 412) IHDVI, IGDVI, IFDVI, IEDVI, IAC2I(1,2)
412 FORMAT (//6(I10/))
WRITE (NUVI, 413)
413 FORMAT (//2X,25HREAL BY INT, REAL BY REAL)
ACVS=1.0
BCVS=0.0
CCVS=0.5E0
DCVS = 20.0E-1
AC1S(1)=1.21E0
A2S(1,1) = 300.E-2
HHDVS=ACVS**JACVI
GGDVS=BCVS**JACVI
FFDVS=DCVS**IAC1I(2)
EEDVS=ACVS**ACVS
DDDVS=AC1S(1)**CCVS
CCDVS=(DCVS**1)**(2.0**ACVS)
A2S(2,1) = (A2S(1,1)**DCVS)**BCVS
HHDVS = HHDVS - 1.0
FFDVS = FFDVS - 8.0
EEDVS = EEDVS - 1.0
DDDVS = DDDVS - 1.1
CCDVS = CCDVS - 4.0
A2S(2,1) = A2S(2,1) - 1.0
WRITE (NUVI,414) HHDVS, GGDVS, FFDVS, EEDVS, DDDVS, CCDVS,A2S(2,1)
414 FORMAT (//7(F11.1/)//35H ALL ABOVE ANSWERS SHOULD BE 0 FOR/
12X, 29HTHIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 041
C***** WHEN EXECUTING ONLY SEGMENT 041, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARFEX - (042)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST EXPONENTIATION OF DOUBLE PRECISION ITEMS 6.1
C***** THE FOLLOWING TYPES OF DP EXPONENTIATION ARE TESTED -
C***** DP BY REAL GIVING DP
C***** REAL BY DP GIVING DP
C***** DP BY DP GIVING DP
C***** GENERAL COMMENTS
C***** * DP ADDITION AND SUBTRACTION ASSUMED WORKING.
C***** * VARIABLES, ARRAY ELEMENTS AND CONSTANTS ARE USED IN A
C***** VARIETY OF COMBINATIONS.
C***** RESTRICTION OBSERVED
C***** NEGATIVE VALUED ITEMS ARE NEVER RAISED TO A REAL OR 6.4/12
C***** DP EXPONENT
C*****
C***** S P E C I F I C A T I O N S SEGMENT 042
C*****
C***** WHEN EXECUTING ONLY SEGMENT 042, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION ACVD,BCVD,CCVD,EEDVD,FFDVD,GGDVD,HHDVD
C= DOUBLE PRECISION AC1D(10),BC2D(7,4),CC3D(7,2,2)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 042, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,420)
420 FORMAT (1H1,1X,28HARFEX - (042) EXPONENTIATION//
-16H ASA REF. - 6.1//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 042 WRITTEN
C***** DEFINE VARIABLES AND ARRAY ELEMENTS
ACVS=1.0
BCVS=0.0
CCVS=0.5
DCVS=20.0E-1
ACVD = 1.0D0
BCVD = 80.0D-1
CCVD = 0.0
AC1D(1) = 1.0
BC2D(2,4) = 3000.D-3
HHDVD = ACVD**BCVS
GGDVD = ACVS**ACVD
FFDVD = AC1D(1)**BCVD
EEDVD = (DCVS**ACVD)** (2.0D0**ACVS)
CC3D(5,1,2) = BC2D(2,4)**(DCVS**BCVS)
HHDVD = HHDVD - 1.0D0
GGDVD = GGDVD - 1.0D0
FFDVD = FFDVD - 1.0D0
EEDVD = EEDVD - 4.0D0
CC3D(5,1,2) = CC3D(5,1,2) - 3.0D0
WRITE (NUVI,421) HHDVD, GGDVD, FFDVD, EEDVD, CC3D(5,1,2)
421 FORMAT (//5(D22.10/)//35H THE ANSWERS ABOVE SHOULD BE 0 FOR/
1 32H THIS SEGMENT TO BE SUCCESSFUL./36H VALUES WITH EXPONENTS LE
2SS THAN /31H 10**(-14) ARE CONSIDERED ZERO)
C***** END OF TEST SEGMENT 042
C***** WHEN EXECUTING ONLY SEGMENT 042, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARBHI - (043)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TESTS THAT HIERARCHY OF OPERATORS AND PARENTHESES 6.1/07
C***** ARE HANDLED CORRECTLY. OPERATORS SHOULD FOLLOW
C***** THIS ORDER - ** (EXPONENTIATION) 6.4/41
C***** * AND / (MULTIPLICATION,DIVISION)
C***** + AND - (ADDITION,SUBTRACTION)
C***** GENERAL COMMENTS
C***** * ONLY INTEGER EXPRESSIONS ARE USED SINCE THIS TEST IS
C***** CONCENTRATING ON OPERATORS AND PARENTHESES
C***** * ADDITION, SUBTRACTION, MULTIPLICATION, DIVISION, 6.4/49
C***** EXPONENTIATION ASSUMED TO FOLLOW LAWS OF
C***** ASSOCIATION AND COMMUTATION UNLESS PARENTHESES
C***** REGROUP EXPRESSIONS
C***** * INTEGER DIVISION MUST BE EVALUATED FROM LEFT TO 6.4/56
C***** RIGHT
C***** RESTRICTIONS OBSERVED
C***** * ALL ELEMENTS EVALUATED ARE MATHEMATICALLY DEFINED 6.4/16
C***** * NO NEGATIVE VALUES ARE RAISED TO A REAL 6.4/12
C***** EXPONENT
C***** * NO ZERO VALUED PRIMARY IS RAISED TO A ZERO 6.4/14
C***** VALUED EXPONENT
C*****
C***** S P E C I F I C A T I O N S SEGMENT 043
C*****
C***** WHEN EXECUTING ONLY SEGMENT 043, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DIMENSION IAC1I(5),IAC2I(2,7)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 043, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,430)
430 FORMAT (1H1,1X,36HARBHI - (043) HIERARCHY, PARENTHESES//2X,
1 23HASA REFS. - 6.1 AND 6.4//
2 2X, 7HRESULTS)
JACVI = 1
KBCVI = 2
LCCVI = -5
MDCVI = 0
NECVI = 36
IAC1I(2) = 10
C***** TEST THAT ADDITION IS COMMUTATIVE (TEST 1)
MRRVI = 1
IHDVI = JACVI + KBCVI
IGDVI = KBCVI + JACVI
IFDVI = IHDVI - IGDVI
WRITE (NUVI,431) MRRVI, IFDVI
C***** TEST THAT MULTIPLICATION IS COMMUTATIVE (TEST 2)
MRRVI = 2
IHDVI = JACVI * KBCVI
IGDVI = KBCVI * JACVI
IFDVI = IHDVI - IGDVI
WRITE (NUVI,431) MRRVI, IFDVI
C***** TEST THAT SUBTRACTION IS COMMUTATIVE (TEST 3)
MRRVI = 3
IHDVI = KBCVI - JACVI
IGDVI = -JACVI + KBCVI
IFDVI = IHDVI - IGDVI
WRITE (NUVI,431) MRRVI, IFDVI
C***** TEST THAT ADDITION IS ASSOCIATIVE (TEST 4)
MRRVI = 4
IHDVI = (IAC1I(2) + JACVI) + KBCVI
IGDVI = IAC1I(2) + (JACVI + KBCVI)
IFDVI = IHDVI - IGDVI
WRITE (NUVI,431) MRRVI, IFDVI
C***** TEST THAT MULTIPLICATION IS ASSOCIATIVE (TEST 5)
MRRVI = 5
IHDVI = (IAC1I(2) * LCCVI) * KBCVI
IGDVI = IAC1I(2) * (LCCVI * KBCVI)
IFDVI = IHDVI - IGDVI
WRITE (NUVI,431) MRRVI, IFDVI
C***** TEST THAT MULTIPLICATION IS DONE BEFORE ADDITION
C***** OR SUBTRACTION (TEST 6). ANSWER SHOULD BE ZERO
MRRVI = 6
IHDVI = JACVI + KBCVI * LCCVI - 1 + IAC1I(2)
WRITE (NUVI,431) MRRVI, IHDVI
C***** REGROUP TEST 6 EXPRESSION (SLIGHTLY CHANGED) WITH
C***** PARENTHESES. ANSWERS SHOULD BE NON-ZERO (TEST7).
MRRVI = 7
IGDVI = (JACVI + KBCVI) * LCCVI + 9
IFDVI = JACVI + KBCVI * (LCCVI + 9)
IEDVI = (JACVI + KBCVI) * (LCCVI + 9)
IAC1I(1) = IGDVI + 6
IAC1I(3) = IFDVI - 9
IAC1I(4) = IEDVI - 12
WRITE (NUVI,432) MRRVI, IAC1I(1), IAC1I(3), IAC1I(4)
C***** TEST THAT DIVISION IS DONE BEFORE ADDITION
C***** AND SUBTRACTION (TEST 8). ANSWER SHOULD BE ZERO.
MRRVI = 8
LCCVI = - 6
IAC1I(2) = 12
IHDVI = LCCVI + IAC1I(2) / KBCVI - LCCVI - 6
WRITE (NUVI,431) MRRVI, IHDVI
C***** REGROUP TEST 8 EXPRESSION WITH PARENTHESES (TEST 9). SECOND
C***** ANSWER SHOULD BE ZERO, OTHERS NON-ZERO.
MRRVI = 9
IGDVI = (LCCVI + IAC1I(2)) / KBCVI - LCCVI - 6
IFDVI = LCCVI + IAC1I(2) / (KBCVI - LCCVI - 6)
IEDVI = (LCCVI + IAC1I(2)) / (KBCVI - LCCVI - 6)
IAC1I(1) = IGDVI - 3
IAC1I(4) = IEDVI - 3
WRITE (NUVI,432) MRRVI, IAC1I(1), IAC1I(3), IAC1I(4)
C***** TEST THAT EXPONENTIATION IS DONE BEFORE
C***** ANY OTHER OPERATION (TEST 10). ANSWERS SHOULD
C***** BE ZERO.
MRRVI = 10
IHDVI = KBCVI + 3 ** 2 - 11
IGDVI = IAC1I(2) * KBCVI ** 3 - 96
IFDVI = NECVI / LCCVI ** KBCVI - 1
WRITE (NUVI,432) MRRVI, IHDVI, IGDVI, IFDVI
C***** REGROUP TEST 10 EXPRESSIONS WITH PARENTHESES (TEST 11)
C***** ANSWERS SHOULD BE NON-ZERO
MRRVI = 11
IHDVI = (KBCVI + 3) ** 2 - 11
IGDVI = (IAC1I(2) * KBCVI) ** 3 - 80
IFDVI = (NECVI / LCCVI) ** KBCVI - 1
IAC1I(1) = IHDVI - 14
IAC1I(3) = IGDVI - 13744
IAC1I(4) = IFDVI - 35
WRITE (NUVI,432) MRRVI, IAC1I(1), IAC1I(3), IAC1I(4)
C***** THE FOLLOWING STATEMENTS INCLUDE AN ADDITIONAL TEST
C***** OF OPERATOR HIERARCHY. A VARIETY OF OPERATORS IS USED
C***** BOTH VARIABLES AND ARRAY ELEMENTS ARE USED. ALL
C***** ANSWERS SHOULD BE ZERO (TEST 12).
MRRVI = 12
LCCVI = -5
IAC1I(2) = 10
IEDVI = JACVI+KBCVI*LCCVI-IAC1I(2)/2-IAC1I(2)/2/5+15
IDDVI = KBCVI**3*4 + 162/(3**(KBCVI*2)) + MDCVI-34
IHDVI = KBCVI*(JACVI+KBCVI*(IAC1I(2)-KBCVI)) - 34
IGDVI = IAC1I(2)/KBCVI+70/(LCCVI*(KBCVI**2+3))-3
IFDVI = KBCVI*(KBCVI+IAC1I(2)*(KBCVI+3*(JACVI+KBCVI)))-224
IAC1I(1) = KBCVI*(KBCVI+KBCVI*(KBCVI+KBCVI*(KBCVI+KBCVI*
-(KBCVI+KBCVI)))) - 92
IAC2I(1,4) = IAC1I(2)+LCCVI+JACVI+KBCVI+KBCVI-JACVI-9
IAC2I(1,2) = IAC1I(2)/(LCCVI+JACVI+KBCVI)*(KBCVI**
1(KBCVI-JACVI))+10
WRITE (NUVI,433) MRRVI, IEDVI, IDDVI, IHDVI, IGDVI, IFDVI,
1 IAC1I(1),IAC2I(1,4),IAC2I(1,2)
C***** EVALUATION MAY PROCEED ACCORDING TO ANY VALID FORMATION SEQUENCE
C***** EVALUATION OF INTEGER TERM CONTAINING DIVISION
MRRVI = 13
NECVI = 7
KBCVI = 2
LCCVI = 4
IGDVI = NECVI/KBCVI * LCCVI
IFDVI = LCCVI * NECVI / KBCVI
IAC1I(1) = IGDVI - 12
IAC1I(2) = IFDVI - 14
WRITE (NUVI,434) MRRVI,IAC1I(1), IAC1I(2)
C***** FORMAT STATEMENTS FOR THIS SEGMENT
431 FORMAT ( /2X,4HTEST, I4, I6)
432 FORMAT(/2X, 4HTEST, I4, I6/ I16/ I16)
433 FORMAT(/2X, 4HTEST,I4,I6/6(I16/),I16)
434 FORMAT(/2X,4HTEST,I4,I6/I16/2X,35H THE ANSWERS ABOVE SHOULD BE 0
1FOR/31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 043
C***** WHEN EXECUTING ONLY SEGMENT 043, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C******
C****** SBB67 - (050)
C******
C***********************************************************************
C****** GENERAL PURPOSE ASA REF
C****** TEST FORMATION OF SUBSCRIPTS FOR INTEGER 5.1.3.3
C****** AND SINGLE PRECISION ARRAYS IN FORM V,K FORMS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 050
C*****
C***** WHEN EXECUTING ONLY SEGMENT 050, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DIMENSION A3S(3,3,3)
C= DIMENSION IAC1I(5),IAC2I(2,7),AC1S(25),AC2S(5,6)
C= INTEGER MCA3I(2,3,3)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 050, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,501)
501 FORMAT (1H1,1X,36HSBB67 - (050) SUBSCRIPTS FOR INTEGER/
-16X,21HAND REAL ARRAYS, V, K//2X,14HASA REF. 5.1.3//2X,
-7HRESULTS)
IAC1I(5) = 3
IAC2I(1,3)=4
MCA3I(2,2,1) = -7
AC1S(20)=1.0
AC2S(4,1)=-2.1E1
A3S(1,2,2) = -22.0
JACVI = IAC1I(5) + IAC2I(1,3) + MCA3I(2,2,1)
HHCVS = AC1S(20) - AC2S( 4,1) + A3S(1,2,2)
WRITE (NUVI, 502) JACVI, HHCVS
502 FORMAT (// I9//F11.1)
504 JACVI=1
ACVS=1.0
IAC1I(JACVI)=10
IAC2I(JACVI,3)=12
IAC2I(2,JACVI)=-6
MCA3I(JACVI,JACVI,3) = -1
MCA3I(2,JACVI,JACVI) = -1
MCA3I(JACVI,3,JACVI) = -2
AC1S(JACVI)=ACVS
AC2S(JACVI,2)=3.0
AC2S(5,JACVI)=60.0E-1
A3S(JACVI,JACVI,3) = +1.0
A3S(2,JACVI,JACVI) = +1.0
A3S(JACVI,3,JACVI) = +0.0
NECVI = IAC1I(1) - IAC2I(1,3) - IAC2I(2,1) + MCA3I(1,1,3) +
1 MCA3I(2,1,1) + MCA3I(1,3,1)
MDCVI = IAC1I(JACVI) - IAC2I(JACVI,3) - IAC2I(2,JACVI) +
1 MCA3I(JACVI,JACVI,3) + MCA3I(2,JACVI,JACVI) +
2 MCA3I(JACVI,3,JACVI)
HHCVS = AC1S(1) + AC2S(1,2) - AC2S(5,1) + A3S(1,1,3) + A3S(2,1,1)
1 + A3S(1,3,1)
GGDVS = AC1S(JACVI) + AC2S(JACVI,2) - AC2S(5,JACVI) +
1 A3S(JACVI,JACVI,3) + A3S(2,JACVI,JACVI) +
2 A3S(JACVI,3,JACVI)
WRITE (NUVI,508) NECVI, MDCVI, HHCVS, GGDVS
508 FORMAT (// 2(I9/) / 2(F11.1/) / 35H THE ANSWERS ABOVE SHOULD BE 0
1 FOR/31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 050
C***** WHEN EXECUTING ONLY SEGMENT 050, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C******
C****** SBB45 - (051)
C******
C***********************************************************************
C****** GENERAL PURPOSE ASA REF
C****** TEST FORMATION OF SUBSCRIPTS FOR INTEGER 5.1.3.3
C****** AND SINGLE PRECISION ARRAYS IN FORM V+K AND V-K
C*****
C***** S P E C I F I C A T I O N S SEGMENT 051
C*****
C***** WHEN EXECUTING ONLY SEGMENT 051, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DIMENSION IAC1I(5),IAC2I(2,7),AC1S(25),AC2S(5,6),A3S(3,3,3)
C= INTEGER MCA3I(2,3,3)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 051, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,511)
511 FORMAT (1H1,1X,36HSBB45 - (051) SUBSCRIPTS FOR INTEGER/
-16X,24HAND REAL ARRAYS,V+K, V-K//2X,16HASA REF. 5.1.3.3//2X,
-7HRESULTS)
JACVI=4
IAC1I(JACVI+1)=1
IAC1I(JACVI-1)=2
IAC2I(JACVI-2,1)=3
IAC2I(JACVI-2,2)=4
IAC2I(2,JACVI+ 3 )=5
IAC2I(1,JACVI-0)=-3
AC1S(JACVI+1)=1.0
AC1S(JACVI-1)=2.0
AC2S(JACVI+0,1)=3.0
AC2S(JACVI-2,2)=4.0
AC2S(2,JACVI+ 2 )=5.0
AC2S(1,JACVI-0) = -3.0E0
NECVI=IAC1I(5)+IAC1I(3)+IAC2I(2,1)+IAC2I(2,2)
-+IAC2I(2,7)+IAC2I(1,4)-12
KBCVI = IAC1I(JACVI+1) + IAC1I(JACVI-1) + IAC2I(JACVI-2,1) +
1 IAC2I(JACVI-2,2) + IAC2I(1,JACVI-0) + IAC2I(2,JACVI+3) -12
HHCVS = AC1S(5) + AC1S(3) + AC2S(4,1) + AC2S(2,2) + AC2S(2,6) +
1 AC2S(1,4) - 12.0
GGDVS = AC1S(JACVI+1) + AC1S(JACVI-1) + AC2S(JACVI+0,1) +
1 AC2S(JACVI-2,2) + AC2S(2,JACVI+2) + AC2S(1,JACVI-0) - 12.0
JACVI = 2
MCA3I(JACVI,JACVI+1,1) = 12
MCA3I(1,JACVI+1,3) = -4
MCA3I(1,2,JACVI+0) = +2
MCA3I(JACVI-1,1,JACVI-1) = -6
MCA3I(JACVI,JACVI-0,2) = 15
MCA3I(2,JACVI-1,JACVI-1) = -11
MCA3I(JACVI-0,JACVI+1,JACVI+0) = -8
MCA3I(JACVI,JACVI+1,JACVI+1) = MCA3I(JACVI,JACVI+1,1) +
1 MCA3I(1,JACVI+1,3) + MCA3I(1,2,JACVI+0) +
2 MCA3I(JACVI-1,1,JACVI-1) + MCA3I(JACVI,JACVI-0,2) +
3 MCA3I(2,JACVI-1,JACVI-1) + MCA3I(JACVI-0,JACVI+1,JACVI+0)
A3S(JACVI+1,1,1) = 12.0
A3S(1,JACVI+1,3) = -4.0
A3S(1,2,JACVI+0) = +2.0
A3S(JACVI-1,1,JACVI-1) = -6.0
A3S(JACVI+1,JACVI-0,2) = 15.0
A3S(2,JACVI-1,JACVI-1) = -11.0
A3S(JACVI-0,JACVI+1,JACVI+0) = -8.0
A3S(JACVI+1,JACVI+1,JACVI+1) = A3S(JACVI+1,1,1) +
1 A3S(1,JACVI+1,3) + A3S(1,2,JACVI+0) +
2 A3S(JACVI-1,1,JACVI-1) + A3S(JACVI+1,JACVI-0,2) +
3 A3S(2,JACVI-1,JACVI-1) + A3S(JACVI-0,JACVI+1,JACVI+0)
WRITE (NUVI,515) NECVI,KBCVI,MCA3I(2,3,3),HHCVS,GGDVS,A3S(3,3,3)
515 FORMAT (//3(I9/)/3(F11.1/)/35H THE ANSWERS ABOVE SHOULD BE 0 FOR/
1 31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 051
C***** WHEN EXECUTING ONLY SEGMENT 051, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** SBB13 - (052)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** TEST FORMATION OF SUBSCRIPTS FOR INTEGER 5.1.3.3
C***** AND SINGLE PRECISION ARRAYS
C***** FORM C*V, C*V-K, C*V+K
C*****
C***** S P E C I F I C A T I O N S SEGMENT 052
C*****
C***** WHEN EXECUTING ONLY SEGMENT 052, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DIMENSION IAC1I(5),IAC2I(2,7),AC1S(25),A3S(3,3,3),AC2S(5,6)
C= INTEGER MCA3I(2,3,3)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 052, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,520)
520 FORMAT (1H1,1X,36HSBB13 - (052) SUBSCRIPTS INTEGER AND/
-16X,23HREAL, C*V, C*V-K, C*V+K//2X,16HASA REF. 5.1.3.3//2X,
-7HRESULTS)
JACVI=2
KACVI= 1
LCCVI = -2
IAC1I(2*JACVI)=1
IAC2I(1*JACVI,1)=2
IAC2I(1,3*KACVI)=3
AC1S(2*JACVI)=1.0
AC2S(1*JACVI,1)=2.0
AC2S(3, 3*KACVI)=30.E-1
MDCVI = IAC1I(2*JACVI) + IAC2I(1*JACVI,1) + IAC2I(1,3*KACVI) - 6
NECVI=IAC1I(4) +IAC2I(2,1) +IAC2I(1,3) - 6
GGDVS = AC1S(2*JACVI) + AC2S(1*JACVI,1) + AC2S(3,3*KACVI) - 6.0
HHCVS = AC1S(4) + AC2S(2,1) + AC2S(3,3) - 6.0
WRITE (NUVI,524) MDCVI, NECVI, GGDVS, HHCVS
524 FORMAT (//2(I9/)/2(F11.1/))
IAC1I(2*JACVI+1) = -6
IAC1I(1*JACVI-1)=-4
IAC2I(1*JACVI-1,2)=3
IAC2I(2*JACVI-3,1)=4
IAC2I(2,1*JACVI+4)=2
IAC2I(1,3*JACVI-2)=1
AC1S(2*LCCVI+9) = -6.0
AC1S(1*LCCVI+3) = -4.0
AC2S(1*LCCVI+3,2) = 3.0
AC2S(2*JACVI+0,3)=4.0
AC2S(3,1*JACVI+3)=2.0
AC2S(3,3*JACVI-2)=1.0
MDCVI = IAC1I(2*JACVI+1) + IAC1I(1*JACVI-1) + IAC2I(1*JACVI-1,2) +
1 IAC2I(1*KACVI+0,1) + IAC2I(2,2*JACVI+2) +
2 IAC2I(1,3*JACVI-2)
NECVI = IAC1I(5) + IAC1I(1) + IAC2I(1,2)
-+ IAC2I(1,1) + IAC2I(2,6) + IAC2I(1,4)
GGDVS = AC1S(2*JACVI+1) + AC1S(1*JACVI-1) + AC2S(1*JACVI-1,2) +
1 AC2S(2*JACVI+0,3) + AC2S(3,1*JACVI+3) + AC2S(3,3*JACVI-2)
HHCVS = AC1S(5) + AC1S(1) + AC2S(1,2)
-+ AC2S(4,3) + AC2S(3,5) + AC2S(3,4)
WRITE (NUVI,524) MDCVI, NECVI, GGDVS, HHCVS
MCA3I(2*KACVI,1,1) = -1
MCA3I(2,2*KACVI,2) = -2
MCA3I(1,1,1*KACVI) = -3
MCA3I(1*KACVI+1,2,3) = 1
MCA3I(2,1*KACVI+2,2) = 2
MCA3I(1,2,3*KACVI+0) = 3
MCA3I(4*KACVI-2,1,3) = 40
MCA3I(1,6*KACVI-3,2) = 5
MCA3I(2,3,10*KACVI-9) = -40
MCA3I(2*KACVI,5*KACVI-4,2*KACVI+0)= -5
MCA3I(1*KACVI-0,3,2*KACVI+1) = MCA3I(2*KACVI,1,1) +
1 MCA3I(2,2*KACVI,2) + MCA3I(1,1,1*KACVI) + MCA3I(1*KACVI+1,2,3)
2 + MCA3I(2,1*KACVI+2,2) + MCA3I(1,2,3*KACVI+0)
3 + MCA3I(4*KACVI-2,1,3) + MCA3I(1,6*KACVI-3,2)
4 + MCA3I(2,3,10*KACVI-9) + MCA3I(2*KACVI,5*KACVI-4,2*KACVI+0)
A3S(3*KACVI,1,1) = -1.0
A3S(2,2*KACVI,2) = -2.0
A3S(1,1,1*KACVI) = -3.0
A3S(2*KACVI+1,2,3) = 1.0
A3S(3,1*KACVI+2,2) = 2.0
A3S(1,2,3*KACVI+0) = 3.0
A3S(4*KACVI-2,1,3) = 40.0
A3S(1,6*KACVI-3,2) = 5.0
A3S(2,3,10*KACVI-8) = -40.0
A3S(3*KACVI,5*KACVI-4,2*KACVI+0) = -5.0
A3S(1*KACVI-0,3,2*KACVI+1) = A3S(3*KACVI,1,1) + A3S(2,2*KACVI,2) +
1 A3S(1,1,1*KACVI) + A3S(2*KACVI+1,2,3) + A3S(3,1*KACVI+2,2) +
2 A3S(1,2,3*KACVI+0) + A3S(4*KACVI-2,1,3) + A3S(1,6*KACVI-3,2) +
3 A3S(2,3,10*KACVI-8) + A3S(3*KACVI,5*KACVI-4,2*KACVI+0)
WRITE (NUVI,525) MCA3I(1,3,3), A3S(1,3,3)
525 FORMAT (//I9 // F11.1 )
WRITE (NUVI,527)
527 FORMAT (// 35H THE ANSWERS ABOVE SHOULD BE 0 FOR/
1 31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 052
C***** WHEN EXECUTING ONLY SEGMENT 052, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** SBF17 - (053)
C*****
C***********************************************************************
C*****
C***** GENERAL PURPOSE ASA REF
C***** TEST FORMATION OF SUBSCRIPTS FOR DOUBLE PRECISION 5.1.3.3
C***** ARRAYS
C***** FORMS V, K, C*V, C*V-K, C*V+K, V+K, V-K
C*****
C***** S P E C I F I C A T I O N S SEGMENT 053
C*****
C***** WHEN EXECUTING ONLY SEGMENT 053, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS, MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AC1D(10),BC2D(7,4),CC3D(7,2,2),EP1D(43),
C= 1 VTAVD, WTAVD, AADVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 053, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,530)
530 FORMAT (1H1,1X,33HSBF17 - (053) SUBSCRIPTS FOR D.P./
-16X,17HARRAYS, ALL FORMS//2X,18HASA REF. - 5.1.3.3//2X,7HRESULTS)
NACVI = 10
JACVI=1
KACVI=+2
LCCVI = -1
EP1D(10)=1.00
BC2D(6,3)=4.0D0
CC3D(4,1,1)=-60.0D-1
AC1D(JACVI)=30.0D-1
BC2D(JACVI,3)=1.0D0
CC3D(JACVI,1,1)=2.0D0
BC2D(3,JACVI)=5.0D0
CC3D(2,JACVI,1)=-2.0D0
CC3D(3,2,JACVI)=.4D1
VTAVD = EP1D(10) + BC2D(6,3) + CC3D(4,1,1) + AC1D(1)
-+BC2D(1,3) + CC3D(1,1,1) + BC2D(3,1) + CC3D(2,1,1)
-+CC3D(3,2,1) - 12.0D0
AADVD = EP1D(10) + AC1D(JACVI) + BC2D(JACVI,3) + BC2D(6,3) +
1 CC3D(4,1,1) + CC3D(JACVI,1,1) + BC2D(3,JACVI) +
2 CC3D(2,JACVI,1) + CC3D(3,2,JACVI) - 12.0D0
AC1D(3*JACVI)=-0.6D+1
AC1D(3*JACVI-2)=70.0D-1
AC1D(5*JACVI+3) = 1.0D0
AC1D (JACVI+3) = 1.0D0
AC1D (NACVI-3) = -1.0D0
BC2D(6*JACVI,2*KACVI-1) =2.0D0
BC2D(8*JACVI-2,1*LCCVI+5) = 10.0D0
CC3D (3*JACVI,2,4*KACVI-6) = -8.0D0
CC3D(10*JACVI-3,1,1*LCCVI+3) = -6.0D0
WTAVD = AC1D(3) + AC1D(1) + AC1D(8) + BC2D(6,3) +
-BC2D(6,4) + CC3D(3,2,2) + CC3D(7,1,2) + AC1D(4) + AC1D(7)
CC3D(2*KACVI+1,NACVI-8,2*JACVI) = AC1D(3*JACVI) +
1 AC1D(3*JACVI-2) + AC1D(5*JACVI+3) + AC1D(JACVI+3) +
2 AC1D(NACVI-3) + BC2D(6*JACVI,2*KACVI-1) +
3 BC2D(8*JACVI-2,1*JACVI+3) + CC3D(3*JACVI,2,4*KACVI-6 ) +
4 CC3D(10*JACVI-3,1,1*JACVI+1)
WRITE (NUVI,531) VTAVD, WTAVD, AADVD, CC3D(5,2,2)
531 FORMAT (//4(D18.5/)/ 35H THE ANSWERS ABOVE SHOULD BE 0 FOR/
1 31H THIS SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 053
C***** WHEN EXECUTING ONLY SEGMENT 053, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
nbs05.d 480890333 170 2 100666 299 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2 . DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4 . DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6 DOUBLE SPACE ON OUTPUT ID 6
nbs05.f 480887323 170 2 100666 38641 `
C***** PART5 *****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 5 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** SIMIF - 054 ARITHMETIC IF, LOGICAL IF FOLLOWED BY GO TO
C*****
C***** IFABS - 055 ABS,IABS(ABSOLUTE VALUE)
C*****
C***** IFFLT - 056 FLOAT(CONVERT FROM INTEGER TO REAL)
C*****
C***** IFFIX - 057 IFIX(CONVERT FROM REAL TO INTEGER)
C*****
C***** IFSGN - 058 SIGN,ISIGN(TRANSFER OF SIGN)
C*****
C***** IFDAB - 059 DABS(ABSOLUTE VALUE)
C*****
C***** IFTRN - 060 AINT,INT,IDINT(TRUNCATION)
C*****
C***** IFMOD - 061 AMOD,MOD(REMAINDERING)
C*****
C***** IFMAX - 062 AMAXO,AMAX1,MAX0,MAX1,DMAX1(CHOOSE LARGEST VALUE)
C*****
C***** IFMIN - 063 AMIN0,AMIN1,MIN0,MIN1,DMIN1(CHOOSE SMALLEST VALUE
C*****
C***** IFDSG - 064 DSIGN(TRANSFER OF SIGN)
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN SEGMENTS
C***** 054, 055, 056, 057, 058, 059, 060, 061, 062, 063, 064
C***** ARE RUN AS ONE MAIN PROGRAM.
C*****
DOUBLE PRECISION DPAVD, DPBVD, DPCVD, DPEVD, DPFVD, DPGVD, DPDVD
1 ,MCAVD, MCBVD, MCCVD, MCDVD, MCEVD, MCFVD
LOGICAL LVB, L1B(10), LNVB
C*****
C***** END OF SPECIFICATIONS FOR SEGMENTS
C***** 054,055, 056, 057, 058, 059, 060, 061, 062, 063, 064
C*****
C***********************************************************************
C*****
C***** SIMIF - (054)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** TO TEST ARITHMETIC IF STATEMENT 7.1.2.2
C***** AND LOGICAL IF FOLLOWED BY GO TO 7.1.2.3
C***** SO THAT THESE STATEMENTS MAY BE USED 4.2
C***** IN SUBSEQUENT TEST SEGMENTS.
C*****
C***** ARITHMETIC EXPRESSIONS ARE -
C***** INTEGER VARIABLE
C***** INTEGER VARIABLE + OR - A CONSTANT
C***** LOGICAL EXPRESSIONS ARE -
C***** LOGICAL VARIABLE
C***** .NOT. LOGICAL VARIABLE
C*****
C***** S P E C I F I C A T I O N S SEGMENT 054
C*****
C***** WHEN EXECUTING ONLY SEGMENT 054, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH APPEAR
C***** AS COMMENTS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= LOGICAL LVB, L1B(10), LNVB
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS.
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 5 ///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
WRITE(NUVI,7540)
IVI = -8
JVI = 0
KVI = 2
MVI = -4
LVB = .TRUE.
LNVB = .FALSE.
C***** LOGICAL ARRAY L1B SHOULD CONTAIN ALL .TRUE. IF TEST IS CORRECT.
NVI = 1
IF (IVI) 541, 542, 542
544 IF (JVI) 542, 541, 542
545 IF (KVI) 542,542, 541
C***** ZERO IS NEITHER POSITIVE NOR NEGATIVE
546 NAVI = IVI * JVI
IF (NAVI) 542, 541, 542
547 NAVI = JVI * MVI
IF (NAVI) 542, 541, 542
548 NAVI = JVI / MVI
IF (NAVI) 542, 541, 542
549 IF (MVI + 4) 542, 541, 542
7543 IF (KVI - 2) 542, 541, 542
C***** LOGICAL IF FOLLOWED BY GO TO
7544 IF (LVB) GO TO 541
GO TO 542
7545 IF (.NOT.LNVB) GO TO 541
542 L1B(NVI) = .FALSE.
GO TO 543
541 L1B(NVI) = .TRUE.
543 NVI = NVI + 1
GO TO (544,544,545,546,547,548,549,7543,7544,7545,7546), NVI
7546 WRITE (NUVI,7541) L1B
WRITE (NUVI,7542)
7540 FORMAT (2H1 ,30HSIMIF - (054) SIMPLE ARITH. IF/19X,14HAND LOGICAL
-IF//20H ASA REF. - 7.1.2.2/ 13X, 7H7.1.2.3 //9H RESULTS)
7541 FORMAT (/L4)
7542 FORMAT (/36H THE TEN ANSWERS ABOVE MUST BE TRUE)
C***** END OF TEST SEGMENT 054
C***** WHEN EXECUTING ONLY SEGMENT 054, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFABS - (055)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION ABS,IABS (ABSOLUTE VALUE) 8.2
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 055, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE(NUVI,0550)
0550 FORMAT(37H1 IFABS - (055) INTRINSIC FUNCTIONS--/10X,26HABS, IABS (
1ABSOLUTE VALUE)//17H ASA REFS. - 8.2//9H RESULTS)
C***** HEADER FOR SEGMENT 055 WRITTEN
C***** SINGLE PRECISION REAL ARGUMENT
MCGVI = 1
CMAVS = 1.000789
CMBVS = -0.2E2
CMCVS = -2.0
CMDVS = 2.0
CMFVS = -4.0
CMEVS = ABS(CMAVS)
CMEVS = CMEVS - 1.000789
WRITE (NUVI,0557) CMEVS
CMBVS = ABS(CMBVS)
CMEVS = CMBVS - 0.2E2
WRITE (NUVI,0557) CMEVS
CMEVS = 2.0*CMCVS+ABS(2.0*CMFVS+ABS(CMCVS*CMDVS**MCGVI))
WRITE (NUVI,0557) CMEVS
CMEVS = CMFVS+CMDVS+ABS(CMCVS+ABS(CMFVS)-ABS(CMDVS-CMCVS))
WRITE (NUVI,0557) CMEVS
0557 FORMAT (/2X,F15.1)
0558 FORMAT (/2X,37HTHE ABOVE ANSWERS SHOULD ALL BE 0 FOR/2X,
1 35HTHIS TEST SEGMENT TO BE SUCCESSFUL.)
C***** INTEGER ARGUMENT
MCAVI = 25
MCBVI = 4
MCCVI = -129
MCDVI = -2
MCEVI = 2
MCFVI = IABS(MCAVI)
MCFVI = MCFVI -25
WRITE (NUVI,0551) MCFVI
MCFVI = IABS(MCDVI+IABS(MCBVI/MCDVI)-IABS(MCEVI**2))-MCBVI
WRITE (NUVI,0551) MCFVI
MCCVI = IABS(MCCVI)
MCFVI = MCCVI - 129
WRITE (NUVI,0551) MCFVI
0551 FORMAT (/10X,I5)
WRITE (NUVI,0558)
C***** END OF TEST SEGMENT 055
C***** WHEN EXECUTING ONLY SEGMENT 055, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFFLT - (056)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION FLOAT (CONVERSION FROM 8.2
C***** INTEGER TO REAL) (TABLE 3)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 056, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,0560)
0560 FORMAT (1H1,1X,34HIFFLT - (056) INTRINSIC FUNCTION--/16X,
15HFLOAT/ 2X,14HASA REF. - 8.2/2X,7HRESULTS)
C***** HEADER FOR SEGMENT 056
C***** ARGUMENT IS INTEGER, FUNCTION IS REAL
MCAVI = 64
MCBVI = -512
MCCVI = 2
MCDVI = 4
MCEVI = 8
CMAVS = FLOAT(MCAVI)
CMBVS = CMAVS - 64.0
WRITE (NUVI,0561) CMBVS
CMAVS = FLOAT(MCBVI)
CMBVS = CMAVS + 512.0
WRITE (NUVI,0561) CMBVS
CMBVS= FLOAT(-2*MCEVI)+FLOAT(MCCVI*MCDVI)*FLOAT(MCEVI/MCDVI)-
- FLOAT(MCDVI**MCCVI) + 16.0
WRITE (NUVI,0561) CMBVS
WRITE (NUVI,0562)
WRITE (NUVI,0563)
0561 FORMAT (/2X,F15.1)
0562 FORMAT (/2X,37HTHE ABOVE ANSWERS SHOULD ALL BE 0 FOR)
0563 FORMAT (2X,35HTHIS TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 056
C***** WHEN EXECUTING ONLY SEGMENT 056, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFFIX - (057)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION - IFIX - (CONVERSION FROM 8.2
C***** REAL TO INTEGER) (TABLE 3)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 057, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,0570)
0570 FORMAT (1H1,1X,34HIFFIX - (057) INTRINSIC FUNCTION--/16X, 4
1HIFIX//2X,14HASA REF. - 8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 057
C***** SINGLE PRECISION ARGUMENT, INTEGER FUNCTION
CMAVS = 2.4567
CMBVS = -0.2001E2
CMCVS = +5.61E-1
CMDVS = -123.456E0
CMEVS = 789.9876E-2
CMFVS = 2.0
CMGVS = -0.5
MCAVI = IFIX(CMAVS)
MCBVI = MCAVI -2
WRITE (NUVI,0571) MCBVI
MCAVI = IFIX(CMBVS)
MCBVI = MCAVI + 20
WRITE (NUVI,0571) MCBVI
MCAVI = IFIX(CMCVS)
WRITE (NUVI,0571) MCAVI
MCAVI = IFIX(CMDVS)
MCBVI = MCAVI + 123
WRITE (NUVI,0571) MCBVI
MCAVI = IFIX(CMEVS)
MCBVI = MCAVI - 7
WRITE (NUVI,0571) MCBVI
MCBVI = IFIX(CMBVS*CMGVS)*IFIX(CMDVS/CMFVS)-
- IFIX(CMBVS**IFIX(CMFVS))+1010
WRITE(NUVI,0571) MCBVI
WRITE (NUVI,0572)
WRITE (NUVI,0573)
0571 FORMAT (/10X,I6)
0572 FORMAT (/2X,37HTHE ABOVE ANSWERS SHOULD ALL BE 0 FOR)
0573 FORMAT (2X,35HTHIS TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 057
C***** WHEN EXECUTING ONLY SEGMENT 057, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFSGN - (058)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION - SIGN, ISIGN - (TRANSFER 8.2/31-32
C***** OF SIGN - SIGN OF A2 TIMES ABS(A1) ) (TABLE 3)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 058, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,0580)
0580 FORMAT (1H1 ,1X,35HIFSGN - (058) INTRINSIC FUNCTIONS--/16X, 24
1 HSIGN, ISIGN (TRANSFER OF/16X,14HARGUMENT SIGN)//2X,14HASA REF.
2- 8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 058
C***** ARGUMENTS AND FUNCTION ARE ALL REAL-TYPE (SIGN)
CMAVS = 1.078
CMBVS = -23.0E1
CMCVS = -5.4567
CMDVS = 7.567E-1
CMGVS = +2.0
CMHVS = -4.0
CMIVS = +8.0
CMEVS = SIGN(CMAVS,CMBVS)
CMFVS = CMEVS + 1.078
WRITE (NUVI,0581) CMFVS
CMEVS = SIGN(CMAVS,CMDVS)
CMFVS = CMEVS - 1.078
WRITE (NUVI,0581) CMFVS
CMEVS = SIGN(CMBVS,CMCVS)
CMFVS = CMEVS + 23.0E1
WRITE (NUVI,0581) CMFVS
CMEVS = SIGN(CMBVS,CMDVS)
CMFVS = CMEVS - 23.0E1
WRITE (NUVI,0581) CMFVS
CMFVS = SIGN(CMGVS,CMHVS)*SIGN(CMHVS,CMIVS)+
- SIGN(SIGN(CMIVS,CMBVS),SIGN(CMHVS,CMGVS))
WRITE(NUVI,0581) CMFVS
C***** ARGUMENTS AND FUNCTION ARE ALL INTEGER-TYPE (ISIGN)
MCAVI = 24
MCBVI = +167
MCCVI = -5980
MCDVI = -12345
MCGVI = 2
MCHVI = -4
MCIVI = 8
MCEVI = ISIGN(MCAVI,MCBVI)
MCFVI = MCEVI - 24
WRITE (NUVI,0582) MCFVI
MCEVI = ISIGN(MCBVI,MCCVI)
MCFVI = MCEVI + 167
WRITE (NUVI,0582) MCFVI
MCEVI = ISIGN(MCCVI,MCDVI)
MCFVI = MCEVI + 5980
WRITE (NUVI,0582) MCFVI
MCEVI = ISIGN(MCDVI,MCAVI)
MCFVI = MCEVI - 12345
WRITE (NUVI,0582) MCFVI
MCFVI = ISIGN(ISIGN(MCGVI*MCHVI+(2*MCIVI),MCIVI/MCGVI+MCCVI)+
1 ISIGN(+8,MCHVI/MCGVI+MCCVI),MCIVI) - MCHVI **2
WRITE(NUVI,0582)MCFVI
WRITE (NUVI,0583)
WRITE(NUVI,0584)
0581 FORMAT (/2X,F15.1)
0582 FORMAT (/10X,I5)
0583 FORMAT (/2X,37HTHE ABOVE ANSWERS SHOULD ALL BE 0 FOR)
0584 FORMAT (2X,35HTHIS TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 058
C***** WHEN EXECUTING ONLY SEGMENT 058, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFDAB - (059)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION DABS (ABSOLUTE VALUE OF 8.2
C***** A DOUBLE PRECISION ARGUMENT) (TABLE 3)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 059
C*****
C***** WHEN EXECUTING ONLY SEGMENT 059, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION DPAVD,DPBVD,DPCVD,DPDVD,DPEVD,DPFVD,DPGVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 059, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,0590)
0590 FORMAT (1H1,1X,34HIFDAB - (059) INTRINSIC FUNCTION--/16X,
123HDABS (ABSOLUTE VALUE OF/16X,16HA D.P. ARGUMENT)/ 2X,
214HASA REF. - 8.2//
32X,7HRESULTS)
C***** HEADER FOR SEGMENT 059 WRITTEN
C***** ARGUMENT AND FUNCTION ARE DOUBLE PRECISION
DPAVD = 1.2345678901234D0
DPBVD = -2.0D0
DPCVD = -39.468024681357D-1
DPDVD = 2.0D0
DPGVD = -4.0D0
DPEVD = 1.0D0
DPEVD = DABS(DPAVD)
DPFVD = DPEVD - 1.2345678901234D0
WRITE (NUVI,0591) DPFVD
DPEVD = 2.0D0*DPBVD+DABS(DPDVD*DPGVD+DABS(DPGVD/(2.0D0*DPDVD)
- *DPDVD**2))
WRITE (NUVI,0591) DPEVD
DPEVD = 3.0D0
DPEVD = DABS(DPCVD)
DPFVD = DPEVD - 39.468024681357D-1
WRITE (NUVI,0591) DPFVD
DPEVD = 4.0D0
DPEVD = DPGVD +DPDVD+DABS(DPBVD+DABS(DPGVD)-DABS(DPDVD-DPBVD))
WRITE (NUVI,0591) DPEVD
WRITE (NUVI,0592)
WRITE (NUVI,0593)
0591 FORMAT (/ D22.10)
0592 FORMAT (/ 39H THE ABOVE ANSWERS SHOULD ALL BE 0 FOR)
0593 FORMAT (36H THIS TEST SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 059
C***** WHEN EXECUTING ONLY SEGMENT 059, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFTRN - (060)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTIONS AINT,INT, AND IDINT -- 8.2
C***** TRUNCATION (SIGN OF A * LARGEST INTEGER LE ABS(A) ) (TABLE 3)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 060
C*****
C***** WHEN EXECUTING ONLY SEGMENT 060, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION DPAVD,DPBVD,DPCVD,DPDVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 060, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,0600)
0600 FORMAT (1H1, 1X,34HIFTRN - (060) INTRINSIC FUNCTION--/10X,29HAINT,
1 INT, IDINT (TRUNCATION)//16H ASA REF. - 8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 060 WRITTEN
C***** TEST OF AINT - REAL ARGUMENT AND REAL FUNCTION
CMAVS = 1.999
CMBVS = 999.001
CMCVS = -0.45678
CMDVS = -9876.0
CMEVS = 1.0
CMEVS = AINT(CMAVS)
CMFVS = CMEVS - 1.0
WRITE (NUVI,0601) CMFVS
CMEVS = 2.0
CMEVS = AINT(CMBVS)
CMFVS = CMEVS - 999.0
WRITE (NUVI,0601) CMFVS
CMEVS = 3.0
CMEVS = AINT(CMCVS)
CMFVS = CMEVS
WRITE (NUVI,0601) CMFVS
CMEVS = 4.0
CMEVS = AINT(CMDVS)
CMFVS = CMEVS + 9876.0
WRITE (NUVI,0601) CMFVS
WRITE (NUVI,0603)
C***** TEST OF INT - REAL ARGUMENT BUT INTEGER FUNCTION
MCAVI = 5
MCAVI = INT(CMAVS)
MCBVI = MCAVI - 1
WRITE (NUVI,0604) MCBVI
MCAVI = 6
MCAVI = INT(CMBVS)
MCBVI = MCAVI - 999
WRITE (NUVI,0604) MCBVI
MCAVI = 7
MCAVI = INT(CMCVS)
WRITE (NUVI,0604) MCAVI
MCAVI = 8
MCAVI = INT(CMDVS)
MCBVI = MCAVI + 9876
WRITE (NUVI,0604) MCBVI
WRITE (NUVI,0605)
C***** TEST OF IDINT - DOUBLE PRECISION ARGUMENT AND FUNCTION
DPAVD = 1.9999999999999D1
DPBVD = +99.000500189123D0
DPCVD = -0.9876543210198D0
DPDVD = -456.78909876514D2
MCAVI = 9
MCAVI = IDINT(DPAVD)
MCBVI = MCAVI - 19
WRITE (NUVI,0606) MCBVI
MCAVI = 10
MCAVI = IDINT(DPBVD)
MCBVI = MCAVI - 99
WRITE (NUVI,0606) MCBVI
MCAVI = 11
MCAVI = IDINT(DPCVD)
WRITE (NUVI,0606) MCAVI
MCAVI = 12
MCAVI = IDINT(DPDVD)
MCBVI = MCAVI + 45678
WRITE (NUVI,0606) MCBVI
WRITE (NUVI,0607)
WRITE (NUVI,0608)
0601 FORMAT (/F11.1)
0603 FORMAT ( 2X,16HEND OF AINT TEST)
0604 FORMAT (/I10)
0605 FORMAT ( 2X,15HEND OF INT TEST)
0606 FORMAT (/I10)
0607 FORMAT ( 2X,17HEND OF IDINT TEST)
0608 FORMAT ( 40H ALL ABOVE ANSWERS SHOULD BE 0 FOR THIS/
1 31H TEST SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 060
C***** WHEN EXECUTING ONLY SEGMENT 060, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFMOD - (061)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION AMOD AND MOD - REMAINDERING, 8.2
C***** WHICH IS DEFINED AS A1-(A1/A2)A2 WHERE (X) IS AN (TABLE 3)
C***** INTEGER WHOSE MAGNITUDE IS LE ABS(X) AND WHOSE SIGN
C***** IS THE SAME AS X.
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 061, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,0610)
0610 FORMAT (1H1, 1X,34HIFMOD - (061) INTRINSIC FUNCTION--/16X,24HAMOD,
1 MOD (REMAINDERING)//16H ASA REF. - 8.2//2X,
2 7HRESULTS)
C***** HEADER FOR SEGMENT 061 WRITTEN
C***** TEST OF AMOD - REAL ARGUMENTS AND REAL FUNCTION
CMAVS = 16.0625
CMBVS = -4.0
CMCVS = -8.125
CMDVS = 2.5
CMEVS = -1.0
CMFVS = 1.0
CMFVS = AMOD(CMAVS,CMBVS)
CMGVS = CMFVS - 0.0625
WRITE (NUVI,0611) CMGVS
CMFVS = 2.0
CMFVS = AMOD(CMCVS,CMDVS)
CMGVS = CMFVS + 0.625
WRITE (NUVI,0611) CMGVS
CMFVS = 3.0
CMFVS = AMOD(CMBVS,CMEVS)
CMGVS = CMFVS + 0.0
WRITE (NUVI,0611) CMGVS
CMFVS = 4.0
CMFVS = AMOD(CMBVS,CMAVS)
CMGVS = CMFVS + 4.0
WRITE (NUVI,0611) CMGVS
WRITE (NUVI,0612)
C***** TEST OF MOD - INTEGER ARGUMENTS AND INTEGER FUNCTION
MCAVI = 35
MCBVI = -5
MCCVI = -998
MCDVI = 9
MCEVI = 10
MCFVI = 1
MCFVI = MOD(MCAVI,MCBVI)
MCGVI = MCFVI + 0
WRITE (NUVI,0613) MCGVI
MCFVI = 2
MCFVI = MOD(MCCVI,MCDVI)
MCGVI = MCFVI + 8
WRITE (NUVI,0613) MCGVI
MCFVI = 3
MCFVI = MOD(MCAVI,MCDVI)
MCGVI = MCFVI - 8
WRITE (NUVI,0613) MCGVI
MCFVI = 4
MCFVI = MOD(MCBVI,MCEVI)
MCGVI = MCFVI + 5
WRITE (NUVI,0613) MCGVI
WRITE (NUVI,0614)
0611 FORMAT (/F11.1)
0612 FORMAT (//2X,17HEND OF AMOD TEST.)
0613 FORMAT (/I10)
0614 FORMAT (//2X,16HEND OF MOD TEST.//2X,
138HALL ABOVE ANSWERS SHOULD BE 0 FOR THIS/2X,
230HTEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 061
C***** WHEN EXECUTING ONLY SEGMENT 061, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFMAX - (062)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST OF INTRINSIC FUNCTION AMAX0,AMAX1,MAX0,MAX1 AND 8.2
C***** DMAX1 -- CHOOSING LARGEST VALUE (TABLE 3)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 062
C*****
C***** WHEN EXECUTING ONLY SEGMENT 062, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION MCAVD,MCBVD,MCCVD,MCDVD,MCEVD,MCFVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 062, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,0620)
0620 FORMAT (1H1, 1X,35HIFMAX - (062) INTRINSIC FUNCTIONS--/13X,28HAMAX
10,AMAX1,MAX0, MAX1,DMAX1 / 2X,14HASA REF. - 8.2//2X,7HRESULTS)
C***** TEST OF AMAX0 - INTEGER ARGUMENTS, REAL FUNCTION 8.2/19
C***** TWO ARGUMENTS FOR AMAX0
WRITE (NUVI,0625)
MCAVI = 128
MCBVI = 64
MCCVI = -8
MCDVI = -4096
CMEVS = 1.0
CMEVS = AMAX0(MCAVI,MCBVI)
CMFVS = CMEVS - 128.0
WRITE (NUVI,0621) CMFVS
CMEVS = 2.0
CMEVS = AMAX0(MCCVI,MCCVI)
CMFVS = CMEVS + 8.0
WRITE (NUVI,0621) CMFVS
CMEVS = 3.0
CMEVS = AMAX0(MCAVI,MCCVI)
CMFVS = CMEVS - 128.0
WRITE (NUVI,0621) CMFVS
CMEVS = 4.0
CMEVS = AMAX0(MCCVI,MCDVI)
CMFVS = CMEVS + 8.0
WRITE (NUVI,0621) CMFVS
CMEVS = 5.0
CMEVS = AMAX0(MCDVI,MCBVI)
CMFVS = CMEVS - 64.0
WRITE (NUVI,0621) CMFVS
MCGVI = 2
WRITE (NUVI,0622) MCGVI
C***** THREE ARGUMENTS FOR AMAX0
CMEVS = 6.0
CMEVS = AMAX0(MCCVI,MCBVI,MCAVI)
CMFVS = CMEVS - 128.0
WRITE (NUVI,0621) CMFVS
CMEVS = 7.0
CMEVS = AMAX0(MCDVI,MCBVI,MCCVI)
CMFVS = CMEVS - 64.0
WRITE (NUVI,0621) CMFVS
CMEVS = 8.0
CMEVS = AMAX0(MCDVI,MCCVI,MCCVI)
CMFVS = CMEVS + 8.0
WRITE (NUVI,0621) CMFVS
MCGVI = 3
WRITE (NUVI,0622) MCGVI
C***** FOUR OR FIVE ARGUMENTS FOR AMAX0
CMEVS = 9.0
CMEVS = AMAX0(MCAVI,MCBVI,MCCVI,MCDVI)
CMFVS = CMEVS - 128.0
WRITE (NUVI,0621) CMFVS
CMEVS = 10.0
CMEVS = AMAX0(MCAVI,MCBVI,MCCVI,MCDVI,MCAVI)
CMFVS = CMEVS - 128.0
WRITE (NUVI,0621) CMFVS
WRITE (NUVI,0623)
C***** TEST OF AMAX1 - REAL ARGUMENTS AND FUNCTION 8.2/20
C***** TWO ARGUMENTS FOR AMAX1
WRITE (NUVI,0624)
CMAVS = 102.0E0
CMBVS = +76.12
CMCVS = -85.43E1
CMDVS = -0.986
CMEVS = AMAX1(CMAVS,CMBVS)
CMFVS = CMEVS - 102.0E0
WRITE (NUVI,0621) CMFVS
CMEVS = AMAX1(CMBVS,CMCVS)
CMFVS = CMEVS - 76.12
WRITE (NUVI,0621) CMFVS
CMEVS = AMAX1(CMDVS,CMCVS)
CMFVS = CMEVS + 0.986
WRITE (NUVI,0621) CMFVS
MCGVI = 2
WRITE (NUVI,0622) MCGVI
C***** THREE ARGUMENTS FOR AMAX1
CMEVS = AMAX1(CMCVS,CMBVS,CMAVS)
CMFVS = CMEVS - 102.0E0
WRITE (NUVI,0621) CMFVS
CMEVS = AMAX1(CMDVS,CMBVS,CMCVS)
CMFVS = CMEVS - 76.12
WRITE (NUVI,0621) CMFVS
CMEVS = AMAX1(CMCVS,CMCVS,CMCVS)
CMFVS = CMEVS - CMCVS
WRITE (NUVI,0621) CMFVS
MCGVI = 3
WRITE (NUVI,0622) MCGVI
C***** FOUR OR FIVE ARGUMENTS FOR AMAX1
CMEVS = AMAX1(CMAVS,CMBVS,CMCVS,CMDVS)
CMFVS = CMEVS - 102.0E0
WRITE (NUVI,0621) CMFVS
CMEVS = AMAX1(CMAVS,CMCVS,CMDVS,CMBVS,CMAVS)
CMFVS = CMEVS - 102.0E0
WRITE (NUVI,0621) CMFVS
WRITE (NUVI,0623)
C***** TEST OF MAX0 - INTEGER ARGUMENTS AND FUNCTION 8.2/21
C***** TWO ARGUMENTS FOR MAX0
WRITE (NUVI,0628)
MCEVI = MAX0(MCAVI,MCBVI)
MCFVI = MCEVI - 128
WRITE (NUVI,0626) MCFVI
MCEVI = MAX0(MCCVI,MCDVI)
MCFVI = MCEVI + 8
WRITE (NUVI,0626) MCFVI
MCEVI = MAX0(MCBVI,MCCVI)
MCFVI = MCEVI - 64
WRITE (NUVI,0626) MCFVI
MCEVI = MAX0(MCCVI,MCCVI)
MCFVI = MCEVI - MCCVI
WRITE (NUVI,0626) MCFVI
MCGVI = 2
WRITE (NUVI,0622) MCGVI
C***** THREE ARGUMENTS FOR MAX0
MCEVI = MAX0(MCCVI,MCBVI,MCAVI)
MCFVI = MCEVI - 128
WRITE (NUVI,0626) MCFVI
MCEVI = MAX0(MCDVI,MCDVI,MCCVI)
MCFVI = MCEVI + 8
WRITE (NUVI,0626) MCFVI
MCGVI = 3
WRITE (NUVI,0622) MCGVI
C***** FOUR OR FIVE ARGUMENTS FOR MAX0
MCEVI = MAX0(MCDVI,MCCVI,MCBVI,MCAVI)
MCFVI = MCEVI - 128
WRITE (NUVI,0626) MCFVI
MCEVI = MAX0(MCAVI,MCCVI,MCBVI,MCDVI,MCBVI)
MCFVI = MCEVI - 128
WRITE (NUVI,0626) MCFVI
WRITE (NUVI,0623)
C***** TEST OF MAX1 - REAL ARGUMENTS AND INTEGER FUNCTION 8.2/22
C***** TWO ARGUMENTS FOR MAX1
WRITE (NUVI,0629)
MCEVI = MAX1(CMAVS,CMBVS)
MCFVI = MCEVI - 102
WRITE (NUVI,0626) MCFVI
MCEVI = MAX1(CMBVS,CMCVS)
MCFVI = MCEVI - 76
WRITE (NUVI,0626) MCFVI
MCEVI = MAX1(CMDVS,CMCVS)
MCFVI = MCEVI + 0
WRITE (NUVI,0626) MCFVI
MCGVI = 2
WRITE (NUVI,0622) MCGVI
C***** THREE ARGUMENTS FOR MAX1
MCEVI = MAX1(CMCVS,CMBVS,CMAVS)
MCFVI = MCEVI - 102
WRITE (NUVI,0626) MCFVI
MCEVI = MAX1(CMDVS,CMCVS,CMBVS)
MCFVI = MCEVI - 76
WRITE (NUVI,0626) MCFVI
MCGVI = 3
WRITE (NUVI,0622) MCGVI
C***** FOUR OR FIVE ARGUMENTS FOR MAX1
MCEVI = MAX1(CMAVS,CMBVS,CMCVS,CMDVS)
MCFVI = MCEVI - 102
WRITE (NUVI,0626) MCFVI
MCEVI = MAX1(CMAVS,CMCVS,CMBVS,CMAVS,CMDVS)
MCFVI = MCEVI - 102
WRITE (NUVI,0626) MCFVI
WRITE (NUVI,0623)
C***** TEST OF DMAX1 - DOUBLE PRECISION ARGUMENTS AND FUNCTION 8.2/23
C***** TWO ARGUMENTS FOR DMAX1
WRITE (NUVI,9999)
MCAVD = 23.0D-1
MCBVD = 111.789789D0
MCCVD = -99.66D-1
MCDVD = -456.123D0
MCEVD = DMAX1(MCAVD,MCBVD)
MCFVD = MCEVD - 111.789789D0
WRITE (NUVI,0627) MCFVD
MCEVD = DMAX1(MCAVD,MCCVD)
MCFVD = MCEVD - 23.0D-1
WRITE (NUVI,0627) MCFVD
MCEVD = DMAX1(MCDVD,MCCVD)
MCFVD = MCEVD + 99.66D-1
WRITE (NUVI,0627) MCFVD
MCEVD = DMAX1(MCDVD,MCDVD)
MCFVD = MCEVD - MCDVD
WRITE (NUVI,0627) MCFVD
MCGVI = 2
WRITE (NUVI,0622) MCGVI
C***** THREE ARGUMENTS FOR DMAX1
MCEVD = DMAX1(MCAVD,MCCVD,MCBVD)
MCFVD = MCEVD - 111.789789D0
WRITE (NUVI,0627) MCFVD
MCEVD = DMAX1(MCCVD,MCDVD,MCAVD)
MCFVD = MCEVD - 23.0D-1
WRITE (NUVI,0627) MCFVD
MCEVD = DMAX1(MCCVD,MCCVD,MCDVD)
MCFVD = MCEVD + 99.66D-1
WRITE (NUVI,0627) MCFVD
MCGVI = 3
WRITE (NUVI,0622) MCGVI
C***** FOUR OR FIVE ARGUMENTS FOR DMAX1
MCEVD = DMAX1(MCAVD,MCCVD,MCBVD,MCDVD)
MCFVD = MCEVD - 111.789789D0
WRITE (NUVI,0627) MCFVD
MCEVD = DMAX1(MCCVD,MCCVD,MCDVD,MCBVD,MCAVD)
MCFVD = MCEVD - 111.789789D0
WRITE (NUVI,0627) MCFVD
WRITE (NUVI,0623)
WRITE (NUVI,9998)
0621 FORMAT ( F11.1)
0622 FORMAT ( 15X,9H END OF ,I2,15H-ARGUMENT TEST.)
0623 FORMAT ( 15X,31H END OF 4- OR 5-ARGUMENT TEST.)
0624 FORMAT ( /2X,15HTEST OF AMAX1--)
0625 FORMAT ( /2X,15HTEST OF AMAX0--)
0626 FORMAT ( I10)
0627 FORMAT ( D22.10)
0628 FORMAT (2H1 ,14HTEST OF MAX0--)
0629 FORMAT ( /2X,14HTEST OF MAX1--)
9998 FORMAT (/ 39H THE ABOVE ANSWERS SHOULD ALL BE 0 FOR/2X,
135HTHIS TEST SEGMENT TO BE SUCCESSFUL.)
9999 FORMAT ( /2X,15HTEST OF DMAX1--)
C***** END OF TEST SEGMENT 062
C***** WHEN EXECUTING ONLY SEGMENT 062, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFMIN - (063)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTIONS AMIN0,AMIN1,MIN0,MIN1 AND 8.2
C***** DMIN1 -- CHOOSING SMALLEST VALUE. (TABLE 3)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 063
C*****
C***** WHEN EXECUTING ONLY SEGMENT 063, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION MCAVD,MCBVD,MCCVD,MCDVD,MCEVD,MCFVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 063, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,0630)
0630 FORMAT (1H1,1X,35HIFMIN - (063) INTRINSIC FUNCTIONS--/13X,27HAMIN0
1,AMIN1,MIN0,MIN1,DMIN1/ 2X,14HASA REF. - 8.2//2X,7HRESULTS)
C***** TEST OF AMIN0 - INTEGER ARGUMENTS, REAL FUNCTION 8.2/24
C***** TWO ARGUMENTS FOR AMIN0
WRITE (NUVI,0635)
MCAVI = 128
MCBVI = 64
MCCVI = -8
MCDVI = -4096
CMEVS = AMIN0(MCAVI,MCBVI)
CMFVS = CMEVS - 64.0
WRITE (NUVI,0631) CMFVS
CMEVS = AMIN0(MCDVI,MCCVI)
CMFVS = CMEVS + 4096.0
WRITE (NUVI,0631) CMFVS
CMEVS = AMIN0(MCBVI,MCCVI)
CMFVS = CMEVS + 8.0
WRITE (NUVI,0631) CMFVS
MCGVI = 2
WRITE (NUVI,0632) MCGVI
C***** THREE-ARGUMENT TEST FOR AMIN0
CMEVS = AMIN0(MCAVI,MCCVI,MCBVI)
CMFVS = CMEVS + 8.0
WRITE (NUVI,0631) CMFVS
CMEVS = AMIN0(MCBVI,MCBVI,MCDVI)
CMFVS = CMEVS + 4096.0
WRITE (NUVI,0631) CMFVS
MCGVI = 3
WRITE (NUVI,0632) MCGVI
C***** FOUR OR FIVE ARGUMENTS FOR AMIN0
CMEVS = AMIN0(MCAVI,MCCVI,MCDVI,MCBVI)
CMFVS = CMEVS + 4096.0
WRITE (NUVI,0631) CMFVS
CMEVS = AMIN0(MCCVI,MCBVI,MCCVI,MCAVI,MCDVI)
CMFVS = CMEVS + 4096.0
WRITE (NUVI,0631) CMFVS
WRITE (NUVI,0633)
C***** TEST OF AMIN1 - REAL ARGUMENTS, REAL FUNCTION 8.2/25
C***** TWO ARGUMENTS TEST FOR AMIN1
WRITE (NUVI,0634)
CMAVS = 26.5
CMBVS = 9.6666
CMCVS = -1.65
CMDVS = -10.001
CMEVS = AMIN1(CMBVS,CMDVS)
CMFVS = CMEVS + 10.001
WRITE (NUVI,0631) CMFVS
CMEVS = AMIN1(CMAVS,CMBVS)
CMFVS = CMEVS - 9.6666
WRITE (NUVI,0631) CMFVS
CMEVS = AMIN1(CMCVS,CMDVS)
CMFVS = CMEVS + 10.001
WRITE (NUVI,0631) CMFVS
CMEVS = AMIN1(CMCVS,CMCVS)
CMFVS = CMEVS + 1.65
WRITE (NUVI,0631) CMFVS
MCGVI = 2
WRITE (NUVI,0632) MCGVI
C***** THREE-ARGUMENT TEST FOR AMIN1
CMEVS = AMIN1(CMBVS,CMCVS,CMDVS)
CMFVS = CMEVS + 10.001
WRITE (NUVI,0631) CMFVS
CMEVS = AMIN1(CMBVS,CMBVS,CMBVS)
CMFVS = CMEVS - 9.6666
WRITE (NUVI,0631) CMFVS
CMEVS = AMIN1(CMAVS,CMBVS,CMCVS)
CMFVS = CMEVS + 1.65
WRITE (NUVI,0631) CMFVS
MCGVI = 3
WRITE (NUVI,0632) MCGVI
C***** FOUR OR FIVE-ARGUMENT TEST FOR AMIN1
CMEVS = AMIN1(CMAVS,CMBVS,CMCVS,CMDVS)
CMFVS = CMEVS + 10.001
WRITE (NUVI,0631) CMFVS
CMEVS = AMIN1(CMAVS,CMCVS,CMBVS,CMCVS,CMDVS)
CMFVS = CMEVS + 10.001
WRITE (NUVI,0631) CMFVS
WRITE (NUVI,0633)
C***** TEST OF MIN0 - INTEGER ARGUMENTS, INTEGER FUNCTION 8.2/26
C***** TWO-ARGUMENT TEST FOR MIN0
WRITE (NUVI,0636)
MCEVI = MIN0(MCBVI,MCAVI)
MCFVI = MCEVI - 64
WRITE (NUVI,0639) MCFVI
MCEVI = MIN0(MCBVI,MCCVI)
MCFVI = MCEVI + 8
WRITE (NUVI,0639) MCFVI
MCEVI = MIN0(MCCVI,MCDVI)
MCFVI = MCEVI + 4096
WRITE (NUVI,0639) MCFVI
MCEVI = MIN0(MCAVI,0)
WRITE (NUVI,0639) MCEVI
MCGVI = 2
WRITE (NUVI,0632) MCGVI
C***** THREE-ARGUMENT TEST FOR MIN0
MCEVI = MIN0(MCAVI,MCCVI,MCBVI)
MCFVI = MCEVI + 8
WRITE (NUVI,0639) MCFVI
MCEVI = MIN0(MCCVI,MCAVI,MCDVI)
MCFVI = MCEVI + 4096
WRITE (NUVI,0639) MCFVI
MCGVI = 3
WRITE (NUVI,0632) MCGVI
C***** FOUR OR FIVE-ARGUMENT TEST FOR MIN0
MCEVI = MIN0(MCBVI,MCAVI,MCCVI,MCDVI)
MCFVI = MCEVI + 4096
WRITE (NUVI,0639) MCFVI
MCEVI = MIN0(MCAVI,MCBVI,MCAVI,MCCVI,MCDVI)
MCFVI = MCEVI + 4096
WRITE (NUVI,0639) MCFVI
WRITE (NUVI,0633)
C***** TEST OF MIN1 - REAL ARGUMENTS, INTEGER FUNCTION 8.2/27
C***** TWO-ARGUMENT TEST FOR MIN1
WRITE (NUVI,0637)
MCEVI = MIN1(CMAVS,CMBVS)
MCFVI = MCEVI - 9
WRITE (NUVI,0639) MCFVI
MCEVI = MIN1(CMCVS,CMDVS)
MCFVI = MCEVI + 10
WRITE (NUVI,0639) MCFVI
MCEVI = MIN1(CMAVS,CMCVS)
MCFVI = MCEVI + 1
WRITE (NUVI,0639) MCFVI
MCGVI = 2
WRITE (NUVI,0632) MCGVI
C***** THREE-ARGUMENT TEST FOR MIN1
MCEVI = MIN1(CMAVS,CMCVS,CMBVS)
MCFVI = MCEVI + 1
WRITE (NUVI,0639) MCFVI
MCEVI = MIN1(CMAVS,CMCVS,CMDVS)
MCFVI = MCEVI + 10
WRITE (NUVI,0639) MCFVI
MCGVI = 3
WRITE (NUVI,0632) MCGVI
C***** FOUR OR FIVE-ARGUMENT TEST FOR MIN1
MCEVI = MIN1(CMAVS,CMBVS,CMDVS,CMCVS)
MCFVI = MCEVI + 10
WRITE (NUVI,0639) MCFVI
MCEVI = MIN1(CMAVS,CMBVS,CMCVS,CMCVS,CMDVS)
MCFVI = MCEVI + 10
WRITE (NUVI,0639) MCFVI
WRITE (NUVI,0633)
C***** TEST OF DMIN1 - DOUBLE PRECISION ARGUMENTS, FUNCTION 8.2/28
C***** TWO-ARGUMENT TEST FOR DMIN1
WRITE (NUVI,0638)
MCAVD = 61.1234D0
MCBVD = 2.0D1
MCCVD = -999.009D-1
MCDVD = -1.9D0
MCEVD = DMIN1(MCAVD,MCBVD)
MCFVD = MCEVD - 2.0D1
WRITE (NUVI,9996) MCFVD
MCEVD = DMIN1(MCCVD,MCDVD)
MCFVD = MCEVD + 999.009D-1
WRITE (NUVI,9996) MCFVD
MCEVD = DMIN1(MCAVD,MCDVD)
MCFVD = MCEVD + 1.9D0
WRITE (NUVI,9996) MCFVD
MCGVI = 2
WRITE (NUVI,0632) MCGVI
C***** THREE-ARGUMENT TEST FOR DMIN1
MCEVD = DMIN1(MCAVD,MCBVD,MCDVD)
MCFVD = MCEVD + 1.9D0
WRITE (NUVI,9996) MCFVD
MCEVD = DMIN1(MCAVD,MCCVD,MCBVD)
MCFVD = MCEVD + 999.009D-1
WRITE (NUVI,9996) MCFVD
MCGVI = 3
WRITE (NUVI,0632) MCGVI
C***** FOUR OR FIVE-ARGUMENT TEST FOR DMIN1
MCEVD = DMIN1(MCAVD,MCCVD,MCBVD,MCDVD)
MCFVD = MCEVD + 999.009D-1
WRITE (NUVI,9996) MCFVD
MCEVD = DMIN1(MCBVD,MCAVD,MCBVD,MCDVD,MCCVD)
MCFVD = MCEVD + 999.009D-1
WRITE (NUVI,9996) MCFVD
WRITE (NUVI,0633)
WRITE (NUVI,9997)
0631 FORMAT ( F11.1)
0632 FORMAT( 15X, 8H END OF,I2,15H-ARGUMENT TEST.)
0633 FORMAT ( 15X, 30H END OF 4 OR 5-ARGUMENT TEST.)
0634 FORMAT ( /16H TEST OF AMIN1 )
0635 FORMAT ( /16H TEST OF AMIN0 )
0636 FORMAT ( /16H TEST OF MIN0 )
0637 FORMAT ( 16H1 TEST OF MIN1 )
0638 FORMAT ( /16H TEST OF DMIN1 )
0639 FORMAT ( I10)
9996 FORMAT ( D22.10)
9997 FORMAT ( /39H THE ABOVE ANSWERS SHOULD ALL BE 0 FOR/1X,
1 36H THIS TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 063
C***** WHEN EXECUTING ONLY SEGMENT 063, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFDSG - (064)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION DSIGN (TRANSFER OF SIGN WITH 8.2/33
C***** DOUBLE PRECISION ARGUMENTS AND FUNCTION) (TABLE 3)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 064
C*****
C***** WHEN EXECUTING ONLY SEGMENT 064, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION MCAVD,MCBVD,MCCVD,MCDVD,MCEVD,MCFVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 064, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,0640)
0640 FORMAT (1H1,1X,34HIFDSG - (064) INTRINSIC FUNCTION--/16X,24HDSIGN
1(TRANSFER OF SIGN)/ 2X,14HASA REF. - 8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 064 WRITTEN
MCAVD = +9.5D0
MCBVD = 123.4567D1
MCCVD = -5.665D1
MCDVD = -75.57D-0
MCEVD = DSIGN(MCAVD,MCBVD)
MCFVD = MCEVD - 9.5D0
WRITE (NUVI,0641) MCFVD
MCEVD = DSIGN(MCBVD,MCCVD)
MCFVD = MCEVD + 123.4567D1
WRITE (NUVI,0641) MCFVD
MCEVD = DSIGN(MCCVD,MCDVD)
MCFVD = MCEVD + 5.665D1
WRITE (NUVI,0641) MCFVD
MCEVD = DSIGN(MCDVD,MCDVD)
MCFVD = MCEVD +75.57D0
WRITE (NUVI,0641) MCFVD
WRITE (NUVI,0642)
0641 FORMAT (1H0,D30.18)
0642 FORMAT (1H0,1X,38HALL ABOVE ANSWERS SHOULD BE 0 FOR THIS/
12X,30HTEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 064
C***** WHEN EXECUTING ONLY SEGMENT 064, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
nbs06.d 480890334 170 2 100666 275 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2. DOUBLE SPACE ON OUTPUT ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4. DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6. DOUBLE SPACE ON OUTPUT ID 6
nbs06.f 480887327 170 2 100666 35395 `
C***** PART6 *****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 6 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** IFDIM - 065 DIM, IDIM (POSITIVE DIFFERENCE)
C*****
C***** IFSGL - 066 SNGL (OBTAIN MOST SIGNIFICANT PART)
C*****
C***** IFREL - 067 REAL (OBTAIN REAL PART OF COMPLEX ARGUMENT)
C*****
C***** IFIMG - 068 AIMAG (OBTAIN IMAGINARY PART OF COMPLEX NO.)
C*****
C***** IFDBL - 069 DBLE (EXPRESS REAL ARGUMENT IN D.P. FORM)
C*****
C***** IFCPX - 070 CMPLX (EXPRESS TWO REAL ARG. IN COMPLEX FORM)
C*****
C***** IFCJG - 071 CONJG (OBTAIN CONJUGATE OF A COMPLEX NUMBER)
C*****
C***** IFBMS - 072 ALL INTRINSIC FUNCTIONS
C*****
C***** IFFMS - 073 ALL INTRINSIC FUNCTIONS
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN
C***** SEGMENTS 065, 066, 067, 068, 069, 070, 071, 072, 073
C***** ARE RUN AS ONE MAIN PROGRAM.
C*****
INTEGER MCA3I(2,3,3)
DIMENSION MCA1I(5), AC2S(5,6)
DOUBLE PRECISION MCAVD, MCBVD, MCCVD, MCDVD, MCEVD, MCFVD, MCGVD,
1 CMAVD, CMBVD, CMCVD , DPA1D(5), FC2D(5,5)
DOUBLE PRECISION DPAVD, DPBVD, DPCVD, DPDVD, DPEVD, DPFVD, DPGVD
COMPLEX CHAVC, CHBVC, CHCVC, CHDVC, CHEVC, CHFVC,
1 CHGVC, CHHVC, CHIVC, CHJVC, CHKVC, CHLVC
C*****
C***** END OF SPECIFICATIONS FOR SEGMENTS
C***** 065, 066, 067, 068, 069, 070, 071, 072, 073
C***********************************************************************
C*****
C***** IFDIM - (065)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA -EF
C***** TEST INTRINSIC FUNCTION DIM AND IDIM--POSITIVE 8.2
C***** DIFFERENCE, WHICH IS DEFINED AS A1 - MIN(A1,A2) (TABLE 3)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 065
C*****
C***** WHEN EXECUTING ONLY SEGMENT 065, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THIS SEGMENT HAS NO SPECIFICATION STATEMENTS.
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS.
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 6 ///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
WRITE (NUVI,0650)
0650 FORMAT (1H1,1X,39HIFDIM - (065) INTRINSIC FUNCTIONS - DIM/12X,
130HAND IDIM (POSITIVE DIFFERENCE)/ 2X,14HASA REF. - 8.2/
2/2X,7HRESULTS)
C***** HEADER FOR SEGMENT 065 WRITTEN
C***** TEST OF DIM - REAL ARGUMENTS, REAL FUNCTION 8.2/34
CMAVS = -4.0
CMBVS = 4.0
CMCVS = 16.25
CMDVS = -64.25
CMEVS = DIM(CMAVS,CMBVS)
CMFVS = CMEVS + 0.0
WRITE (NUVI,0651) CMFVS
CMEVS = DIM(CMCVS,CMDVS)
CMFVS = CMEVS - 80.5
WRITE (NUVI,0651) CMFVS
CMEVS = DIM(CMCVS,CMBVS)
CMFVS = CMEVS - 12.25
WRITE (NUVI,0651) CMFVS
CMEVS = DIM(CMDVS,CMAVS)
CMFVS = CMEVS - 0.0
WRITE (NUVI,0651) CMFVS
C***** TEST OF IDIM - INTEGER ARGUMENTS, INTEGER FUNCTION 8.2/35
MCAVI = 02468
MCBVI = +36
MCCVI = -3
MCDVI = -23
MCEVI = IDIM(MCAVI,MCBVI)
MCFVI = MCEVI - 2432
WRITE (NUVI,0652) MCFVI
MCEVI = IDIM(MCBVI,MCCVI)
MCFVI = MCEVI - 39
WRITE (NUVI,0652) MCFVI
MCEVI = IDIM(MCDVI,MCCVI)
MCFVI = MCEVI + 0
WRITE (NUVI,0652) MCFVI
MCEVI = IDIM(MCCVI,MCCVI)
WRITE (NUVI,0652) MCEVI
MCEVI = IDIM(MCCVI,MCBVI)
WRITE (NUVI,0652) MCEVI
WRITE (NUVI,0653)
0651 FORMAT (1H0,F17.2)
0652 FORMAT (1H0,10X,I5)
0653 FORMAT (1H0,1X,34H ALL ABOVE ANSWERS SHOULD BE 0 FOR/2X,
135HTHIS TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 065
C***** WHEN EXECUTING ONLY SEGMENT 065 THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFSGL - (066)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION SNGL - OBTAIN MOST SIGNIFICANT 8.2/36
C***** PART OF DOUBLE PRECISION ARGUMENT. (TABLE 3)
C***** GENERAL COMMENTS
C***** ASSIGNED GO TO STATEMENT ASSUMED WORKING.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 066
C*****
C***** WHEN EXECUTING ONLY SEGMENT 066, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION MCAVD,MCBVD,MCCVD,MCDVD,MCEVD,MCFVD,
C= 1 CMAVD, CMBVD,CMCVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 066, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI, 0660)
0660 FORMAT (1H1,1X,39HIFSGL - (066) INTRINSIC FUNCTION SNGL--/16X,
126HOBTAIN MOST SIGNIFICANT PT/16X,
218H OF D.P. ARGUMENT. //2X,15HASA REFS. - 8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 066 WRITTEN
MCAVD = .48748748748748D3+.57D-5+.5604645D-6+.31786509547D-7
MCBVD =-39.689539609539D1-.57D-5-.5604645D-6-.31786509547D-7
MCCVD = .33333333333333D0+.57D-5+.5604645D-6+.31786509547D-7
MCDVD =-.66666666666666D0-.57D-5+.5604645D-6-.31786509547D-7
MCEVD = .48748748748748D3+.57D-5+.5604645D-6+.31786509547D-7
MCFVD = -39.689539609539D+1
AVS = 0.0
BVS = 0.0
CVS = 0.0
IVI = 2
C***** EXPRESSION RESULTS ASSIGNED TO D.P. RESULT FOR VISUAL COMPARISON
C***** ARGUMENTS OF SNGL - VARIABLE, SIMPLE EXPRESSION
CMAVD = AVS + SNGL(MCAVD) - BVS
WRITE (NUVI,661) MCAVD,CMAVD
CMAVD = CVS + SNGL(MCBVD) + AVS
WRITE (NUVI,661) MCBVD, CMAVD
CMAVD = SNGL(MCCVD)
WRITE (NUVI,661) MCCVD,CMAVD
CMBVD = -MCBVD
CMAVD = -SNGL(MCBVD - CMBVD)
CMCVD = - (MCBVD + MCBVD)
WRITE (NUVI,661) CMCVD,CMAVD
CMCVD = MCDVD * MCDVD
CMAVD = BVS + SNGL(MCDVD**IVI) + CVS
WRITE (NUVI,661) CMCVD, CMAVD
C***** ARGUMENT OF SNGL - INTRINSIC FUNCTION WITH DIFFERENT NO. OF ARG
CMAVD = -(CVS + SNGL(DABS(MCDVD)) + BVS)
WRITE (NUVI,661) MCDVD, CMAVD
CMAVD = AVS - BVS + SNGL(DMIN1(MCEVD,MCFVD))
WRITE (NUVI,661) MCFVD, CMAVD
CMAVD = CVS + BVS + SNGL(DMAX1(MCCVD,MCEVD,MCFVD))
WRITE (NUVI,661) MCEVD, CMAVD
WRITE (NUVI, 662)
661 FORMAT(1H0,1X,6HLINE A,D25.14/2X,6HLINE B,D25.14)
662 FORMAT(33H0 LINE B SHOULD AGREE WITH LINE A /40H ONLY TO THE PREC
AISION OF A REAL DATUM. /37H REMAINING DIGITS RESULT FROM OUTPUT /
B 33H CONVERSION WHEN A REAL VALUE IS / 32H ASSIGNED TO D.P. FOR
CPRINTING. )
C***** END OF SEGMENT 066
C***** WHEN EXECUTING ONLY SEGMENT 066, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFREL - (067)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION REAL (OBTAIN REAL PART OF 8.2/39
C***** COMPLEX ARGUMENT ). (TABLE 3)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 067
C*****
C***** WHEN EXECUTING ONLY SEGMENT 067, THE SPEC+F+CAT+ON STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX CHAVC,CHBVC,CHCVC,CHDVC,CHEVC,CHFVC
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 067, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI,0670)
0670 FORMAT (1H1,1X,34HIFREL - (067) INTRINSIC FUNCTION--/ 16X, 4HREAL/
1 2X,14HASA REF. - 8.2//
2 2X,7HRESULTS)
C***** HEADER FOR SEGMENT 067 WRITTEN
CHAVC = (3.2,1.86)
CHBVC = (2.1,0.0)
CHCVC = (3.7,-1.2)
CHDVC = (+45.1,+2.2)
CHEVC = (-16.0, 0.0)
CHFVC = (-32.0, -1.1)
CMAVS = REAL(CHAVC)
CMBVS = CMAVS - 3.2
CMAVS = REAL(CHBVC)
CMCVS = CMAVS - 2.1
CMAVS = REAL(CHCVC)
CMDVS = CMAVS - 3.7
CMAVS = REAL(CHDVC)
CMEVS = CMAVS - 45.1
CMAVS = ABS(REAL(CHEVC) + REAL(CHFVC))
CMFVS = CMAVS - 48.0
CMAVS = AMAX1(REAL(CHAVC),REAL(CHBVC), REAL(CHEVC-CHFVC))
CMGVS = CMAVS - 16.0
WRITE (NUVI,0671) CMBVS,CMCVS,CMDVS,CMEVS,CMFVS,CMGVS
C***** REAL CONSTANTS HAVING ONLY FRACTIONAL PARTS(NO EXPONENT)
CHAVC = (.789,.12)
CHBVC = (.13,1.2)
CHCVC = (.507,-2.2)
CHDVC = (+.5401,+.5)
CHEVC = (-.5,0.25)
CHFVC = (-.0625, 1.1)
CMAVS = REAL(CHAVC)
CMBVS = CMAVS - .789
CMAVS = REAL(CHBVC)
CMCVS = CMAVS -0.13
CMAVS = REAL(CHCVC)
CMDVS = CMAVS -0.507
CMAVS = REAL(CHDVC)
CMEVS = CMAVS -0.5401
CMAVS = REAL(CHEVC+CHFVC)
CMFVS = CMAVS + 0.5625
CMAVS = REAL(CHEVC) - REAL(CHFVC)
CMGVS = CMAVS + 0.4375
WRITE (NUVI,0671) CMBVS,CMCVS,CMDVS,CMEVS,CMFVS,CMGVS
C***** REAL CONSTANTS HAVING ONLY INTEGRAL PARTS(NO EXPONENT)
C***** 5.1.1.2/22
CHAVC = (23.,0.1)
CHBVC = (12.,+1.2)
CHCVC = (1.,-2.3)
CHDVC = (+45.,+.6)
CHEVC = (19.0, 1.0)
CHFVC = (-32.0, 2.0)
CMAVS = REAL(CHAVC)
CMBVS = CMAVS - 23.0
CMAVS = REAL(CHBVC)
CMCVS = CMAVS - 12.0
CMAVS = REAL(CHCVC)
CMDVS = CMAVS - 1.0
CMAVS = REAL(CHDVC)
CMEVS = CMAVS - 45.0
CMAVS = SIGN(DIM(REAL(CHEVC),REAL(CHFVC)),REAL(CHFVC))
CMFVS = CMAVS + 51.0
CMAVS = REAL((16.0,1.0) + CHEVC + CHFVC)
CMGVS = CMAVS - 3.0
WRITE (NUVI,0671) CMBVS,CMCVS,CMDVS,CMEVS,CMFVS,CMGVS
WRITE (NUVI,0672)
0671 FORMAT (/6(F20.4/))
0672 FORMAT ( /40H ALL ABOVE ANSWERS SHOULD BE 0 FOR THIS /
132H TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 067
C***** WHEN EXECUTING ONLY SEGMENT 067, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFIMG - (068)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION AIMAG (OBTAIN IMAGINARY PART 8.2/41
C***** OF COMPLEX ARGUMENT ) (TABLE 3)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 068
C*****
C***** WHEN EXECUTING ONLY SEGMENT 068, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX CHAVC,CHBVC,CHCVC,CHDVC,CHEVC,CHFVC,CHGVC,CHHVC,CHIVC,
C= 1CHJVC,CHKVC,CHLVC
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 068, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI,0680)
0680 FORMAT (1H1,1X,40HIFIMG - (068) INTRINSIC FUNCTION - AIMAG/16X,
119HOBTAIN IMAGINARY PT/16X,19HOF COMPLEX ARGUMENT/ 2X,
213HASA REF.- 8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 068 WRITTEN
C***** IMAGINARY PARTS OF COMPLEX NUMBERS HAVING BOTH INTEGRAL
C***** AND FRACTIONAL PARTS. (NO EXPONENT)
CHAVC = (3.2,1.86)
CHBVC = (2.1,0.0)
CHCVC = (37.0,-1.2)
CHDVC = (+45.1,+2.2)
CMAVS = AIMAG(CHAVC)
CMBVS = CMAVS - 1.86
CMAVS = AIMAG(CHBVC)
CMCVS = CMAVS - 0.0
CMAVS = AIMAG(CHCVC)
CMDVS = CMAVS + 1.2
CMAVS = AIMAG(CHDVC)
CMEVS = CMAVS -2.2
WRITE (NUVI,0681) CMBVS,CMCVS,CMDVS,CMEVS
C***** IMAGINARY PARTS OF COMPLEX NUMBERS HAVING ONLY FRACTIONAL
C***** PARTS (NO EXPONENT)
CHAVC = (.789,.00)
CHBVC = (1.2,.789)
CHCVC = (+4.56,-.456)
CHDVC = (-12.3,+.001)
CMAVS = AIMAG(CHAVC)
CMBVS = CMAVS - 0.0
CMAVS = AIMAG(CHBVC)
CMCVS = CMAVS - .789
CMAVS = AIMAG(CHCVC)
CMDVS = CMAVS + .456
CMAVS = AIMAG(CHDVC)
CMEVS = CMAVS - 0.001
WRITE (NUVI,0681) CMBVS,CMCVS,CMDVS,CMEVS
C***** IMAGINARY PARTS OF COMPLEX NUMBERS HAVING ONLY INTEGRAL
C***** PARTS (NO EXPONENT)
CHAVC =(-12.,12.)
CHBVC = (+1.23,0.)
CHCVC = (0.0, -16.0)
CHDVC = (-1.1, -32.0)
CMAVS = AIMAG(CHAVC)
CMBVS = CMAVS - 12.0
CMAVS = AIMAG(CHBVC)
CMCVS = CMAVS + 0.0
CMAVS = ABS(AIMAG(CHCVC)+AIMAG(CHDVC))
CMDVS = CMAVS - 48.0
CMAVS = AMAX1(AIMAG(CHAVC), AIMAG(CHBVC), AIMAG(CHCVC-CHDVC))
CMEVS = CMAVS - 16.0
WRITE (NUVI,0681) CMBVS,CMCVS,CMDVS,CMEVS
C***** IMAGINARY PARTS OF COMPLEX NUMBERS HAVING A DECIMAL EXPONENT.
CHAVC = (2.3E0,1.2E0)
CHBVC = (1.2,.56E2)
CHCVC = (.24,1.E1)
CHDVC = (1.,+7.8E+1)
CHEVC = (1.5, 16.0)
CHFVC = (1.0, -32.0)
CHGVC = (1.E0,-7.99E-1)
CHHVC = (27.00,.55E-1)
CHIVC = (1.E0,2.E-0)
CHJVC = (1.2,1.E+1)
CHKVC = (1.E-1,+7.E0)
CHLVC = (1.7,-99.E-1)
CMAVS = AIMAG(CHAVC)
CMBVS = CMAVS - 1.2E0
CMAVS = AIMAG(CHBVC)
CMCVS = CMAVS - .56E2
CMAVS = AIMAG(CHCVC)
CMDVS = CMAVS - 1.E1
CMAVS = AIMAG(CHDVC)
CMEVS = CMAVS - 7.8E+1
WRITE (NUVI,0681) CMBVS,CMCVS,CMDVS,CMEVS
CMAVS = SIGN(DIM(AIMAG(CHEVC),AIMAG(CHFVC)), AIMAG(CHFVC))
CMBVS = CMAVS + 48.0
CMAVS = AIMAG((1.0, 16.0) + CHEVC + CHFVC)
CMCVS = CMAVS + 0.0
CMAVS = AIMAG(CHGVC)
CMDVS = CMAVS + 7.99E-1
CMAVS = AIMAG(CHHVC)
CMEVS = CMAVS - .55E-1
WRITE (NUVI,0681) CMBVS,CMCVS,CMDVS,CMEVS
CMAVS = AIMAG(CHIVC)
CMBVS = CMAVS - 2.E-0
CMAVS = AIMAG(CHJVC)
CMCVS = CMAVS - 1.E+1
CMAVS = AIMAG(CHKVC)
CMDVS = CMAVS - 7.E0
CMAVS = AIMAG(CHLVC)
CMEVS = CMAVS + 99.E-1
WRITE (NUVI,0681) CMBVS,CMCVS,CMDVS,CMEVS
WRITE (NUVI,0682)
0681 FORMAT ( / 4(F20.5 / ))
0682 FORMAT ( /40H ALL ABOVE ANSWERS SHOULD BE 0 FOR THIS /
132H TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 068
C***** WHEN EXECUTING ONLY SEGMENT 068, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFDBL - (069)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION DBLE (EXPRESS S.P. ARGUMENT 8.2/43
C***** IN DOUBLE PRECISION FORM ) (TABLE 3)
C***** INTRINSIC FUNCTIONS DABS,DSIGN,DMIN1,DMAX1,AMAX1
C***** ASSUMED WORKING.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 069
C*****
C***** WHEN EXECUTING ONLY SEGMENT 069, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION MCAVD,MCBVD,MCCVD,MCDVD,MCEVD,MCFVD,MCGVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 069, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI,0690)
0690 FORMAT (1H1,1X,39HIFDBL - (069) INTRINSIC FUNCTION - DBLE/16X,
126HS.P. ARGUMENT IN D.P. FORM / 2X,13HASA REF.- 8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 069 WRITTEN
CMAVS = 0.9765625E-3
CMBVS = -.1953125E-2
CMCVS = .5859375E-2
CMDVS = -.1048576E+7
CMEVS = +114688.0
MCAVD = 0.0D0
MCBVD = MCAVD * DBLE(CMAVS)
MCCVD = DMIN1(DBLE(CMAVS),DBLE(CMEVS))
MCDVD = MCAVD * MCBVD - DABS(DBLE(CMBVS))
MCEVD = MCAVD - DSIGN(DBLE(CMCVS),DBLE(CMBVS))
MCFVD = - DABS(DBLE(CMDVS)) + MCAVD
MCGVD = DMAX1(DBLE(AMAX1(CMDVS,CMEVS)),MCBVD)
WRITE(NUVI,691) CMAVS, MCCVD, CMBVS, MCDVD,
1 CMCVS, MCEVD, CMDVS, MCFVD, CMEVS, MCGVD
691 FORMAT(1H0,1X,6HLINE A, E18.7/ 8H LINE B, D25.14)
WRITE(NUVI, 692)
692 FORMAT(1H0,38H A COMPARISON OF LINE A AGAINST LINE B /1X,
1 40H IS NEEDED TO CHECK THE VALIDITY OF TEST)
C***** END OF TEST SEGMENT 069
C***** WHEN EXECUTING ONLY SEGMENT 069, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFCPX - (070)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION CMPLX (EXPRESS TWO REAL 8.2/45
C***** ARGUMENTS IN COMPLEX FORM) (TABLE 3)
C***** GENERAL COMMENTS
C***** SUBTRACTION OF COMPLEX NUMBERS ASSUMED WORKING
C*****
C***** S P E C I F I C A T I O N S SEGMENT 070
C*****
C***** WHEN EXECUTING ONLY SEGMENT 070, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX CHAVC,CHBVC,CHCVC,CHDVC,CHEVC,CHFVC,CHGVC
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C***** WHEN EXECUTING ONLY SEGMENT 070, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
WRITE (NUVI,0700)
0700 FORMAT (1H1, 1X,40HIFCPX - (070) INTRINSIC FUNCTION - CMPLX/16X,
126HEXPRESS TWO REAL ARGUMENTS/16X,15HIN COMPLEX FORM/15H ASA REF.
2- 8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 070 WRITTEN
CMAVS = 23.123
CMBVS = -.78
CMCVS = +17.
CMDVS = 157.E-1
CMEVS = -.985E1
CMFVS = +88.E+0
CHAVC = CMPLX(CMAVS,CMBVS)
CHBVC = CHAVC - (23.123,-.78)
CHAVC = CMPLX(CMBVS,15.0)
CHCVC = CHAVC - (-.78,15.0)
CHAVC = CMPLX(CMDVS,CMFVS)
CHDVC = CHAVC - (157.E-1,+88.E+0)
CHAVC = CMPLX(0.0,0.E0)
CHEVC = CHAVC
CHAVC = CMPLX(CMEVS,CMFVS)
CHFVC = CHAVC - (-.985E1,+88.E+0)
CHAVC = CMPLX(CMCVS,-0.0E-1)
CHGVC = CHAVC - (+17.0,0.0)
WRITE (NUVI,0702) CHBVC, CHCVC, CHDVC, CHEVC, CHFVC, CHGVC
WRITE (NUVI,0701)
0701 FORMAT (//2X,37HTHE ABOVE ANSWERS SHOULD ALL BE 0 FOR/1X,
136H THIS TEST SEGMENT TO BE SUCCESSFUL.)
0702 FORMAT (6(/F17.7,F17.7))
C***** END OF TEST SEGMENT 070
C***** WHEN EXECUTING ONLY SEGMENT 070, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFCJG - (071)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST INTRINSIC FUNCTION CONJG (OBTAIN CONJUGATE OF A 8.2/47
C***** COMPLEX ARGUMENT) (TABLE 3)
C***** GENERAL COMMENTS
C***** SUBTRACTION OF COMPLEX NUMBERS ASSUMED WORKING
C*****
C***** S P E C I F I C A T I O N S SEGMENT 071
C*****
C***** WHEN EXECUTING ONLY SEGMENT 071, THE SPECIFICATION STATEMENTS
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX CHAVC, CHBVC, CHCVC, CHDVC ,CHEVC
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 071, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI,0710)
0710 FORMAT (1H1, 1X,40HIFCJG - (071) INTRINSIC FUNCTION - CONJG/16X,
119HOBTAIN CONJUGATE OF/16X,16HA COMPLEX NUMBER/
217H ASA REFS. - 8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 071 WRITTEN
CHAVC = (1.1,+2.1)
CHBVC = CONJG(CHAVC)
CHCVC = CHBVC - (1.1,-2.1)
CHEVC = (-2.E0, -3.E-1)
CHBVC = CONJG(CHEVC)
CHDVC = CHBVC - (-2.E0,3.E-1)
WRITE (NUVI,0711) CHCVC, CHDVC
CHAVC = (-.2,+.3)
CHBVC = CONJG(CHAVC)
CHCVC = CHBVC - (-.2,-.3)
CHAVC = (23.1E-1,1.E-2)
CHBVC = CONJG(CHAVC)
CHDVC = CHBVC - (23.1E-1,-1.E-2)
WRITE (NUVI,0711) CHCVC,CHDVC
CHBVC = CONJG((1.2,2.2))
CHCVC = CHBVC - (1.2,-2.2)
CHBVC = CONJG((-1.0,2.0E-1))
CHDVC = CHBVC - (-1.0,-2.0E-1)
WRITE (NUVI,0711) CHCVC, CHDVC
CHBVC = CONJG((.1,.2E0))
CHCVC = CHBVC - (.1,-.2E0)
CHDVC = CONJG((.0,-0.E0))
WRITE (NUVI,0711) CHCVC, CHDVC
WRITE (NUVI,0712)
0711 FORMAT (4(/ F17.7, F10.7))
0712 FORMAT (//38H ALL ABOVE ANSWERS MUST BE 0 FOR THIS/1X,
131H TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 071
C***** WHEN EXECUTING ONLY SEGMENT 071, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFBMS - (072)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT ALL INTRINSIC FUNCTIONS WOULD ACCEPT 8.2/32
C***** ANY EXPRESSION OF THE TYPE SPECIFIED IN THE (TABLE 3)
C***** INTRINSIC FUNCTION TABLE - ASA REFS - 8.2/01-47
C***** GENERAL COMMENTS
C***** SEGMENTS 055 TO 071 ASSUMED WORKING
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 072, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI,0720)
0720 FORMAT (1H1,1X,37HIFBMS - (072) BASIC FORTRAN INTRINSIC/10X,
128HFUNCTIONS ACCEPT EXPRESSIONS/10X,30HOF TYPE SPECIFIED IN I.F.TA
2BLE//15H ASA REF.- 8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 072 WRITTEN
C***** TEST ABS - ABSOLUTE VALUE OF REAL ARGUMENT 8.2/11
CMAVS = 0.5
CMBVS = -.25
CMCVS = 16.0
CMDVS = -4.0
CMEVS = ABS(CMAVS + CMBVS) + 1.0
CMFVS = CMEVS - (0.5 - .25) - 1.0
CMEVS = ABS(0.0 -ABS(CMAVS - CMCVS+ CMDVS))
CMGVS = CMEVS + (0.5 - 16.0 - 4.0)
CMEVS = ABS(CMAVS + 1.0 - (CMCVS + CMDVS) + 0.5 * 8.0)
CMHVS = CMEVS + (0.5 + 1.0 - (16.0 - 4.0) + 4.0)
CMEVS = ABS(1.0E0 + (1.0 * 1.0 / 1.0) **2)
CMIVS = CMEVS - 2.0
WRITE (NUVI,0721) CMFVS , CMGVS , CMHVS , CMIVS
C***** TEST OF IABS - ABSOLUTE VALUE OF INTEGER ARGUMENT 8.2/12
MCAVI = 2
MCBVI = 10
MCCVI = IABS (MCAVI + MCBVI)
MCDVI = MCCVI - 12
MCCVI = IABS(MCAVI * 2 + MCBVI / 2) +1
MCEVI = MCCVI - 10
MCCVI = IABS(-MCBVI /(-2) - MCBVI ** 1 + (1 * 2 * 3 / 2 - 3) - 10
1 + 10 + MCBVI / MCAVI - 5)
MCFVI = MCCVI - 5
MCCVI = IABS(0 - IABS(-5 * 1 / 5 - 5 * IABS(-1)))
MCGVI = MCCVI - 6
WRITE (NUVI, 0722) MCDVI , MCEVI , MCFVI , MCGVI
C***** TEST OF FLOAT - CONVERSION FROM INTEGER TO REAL 8.2/29
CMEVS = FLOAT (MCAVI + MCBVI)
CMFVS = CMEVS - 12.0
CMEVS = FLOAT(MCAVI * 2 /4 + MCBVI ** 1)
CMGVS = CMEVS - 11.0
CMEVS = FLOAT((23 + 46)/69 + 10 - MCBVI) *2.0 + 1.5
CMHVS = CMEVS - 3.5
CMEVS = (76.5 * 1.0 - FLOAT (76 * 1)) * 4.0
CMIVS = CMEVS - 2.0
WRITE (NUVI,0723) CMFVS, CMGVS, CMHVS, CMIVS
C***** TEST OF IFIX - CONVERSION FROM REAL TO INTEGER 8.2/30
MCCVI = IFIX(CMAVS - CMBVS)
MCDVI = MCCVI
MCCVI = IFIX(CMAVS *1.0 + CMBVS/CMBVS - (CMCVS - CMDVS))
MCEVI = MCCVI + 18
MCCVI = 1 + IFIX(2.5 * 2.0) - IFIX(10.0 /2.0)
MCFVI = MCCVI - 1
MCCVI = 2 + IFIX(2.5 ** 1.0 + (10.65 + 3.45))
MCGVI = MCCVI - 18
WRITE (NUVI,0724) MCDVI, MCEVI, MCFVI, MCGVI
C***** TEST OF SIGN - TRANSFER OF SIGN WITH REAL ARGUMENTS 8.2/31
CMEVS = SIGN(CMAVS+CMDVS,CMDVS-CMBVS)
CMFVS = CMEVS - (CMAVS + CMDVS)
CMEVS = SIGN(25.0 + 0.0 * 4.0,-24.4/6.1 * 1.0)
CMGVS = CMEVS + 25.0
CMEVS = SIGN(10.5,SIGN(2.0,-4.5))
CMHVS = CMEVS + 10.5
CMEVS = SIGN(1.0,SIGN(-2.0,SIGN(2.0,-1.0)))
CMIVS = CMEVS + 1.0
WRITE (NUVI,0725) CMFVS, CMGVS, CMHVS, CMIVS
C***** TEST OF ISIGN - TRANSFER OF SIGN WITH INTEGER ARGUMENT 8.2/32
MCCVI = ISIGN(MCAVI,MCAVI + MCBVI - 13)
MCDVI = MCCVI + 2
MCCVI = ISIGN(10,-5 - 10/2 + 1**2)
MCEVI = MCCVI + 10
MCCVI = ISIGN( 1 + 2 + 3 , ISIGN(-2,7 + 5))
MCFVI = MCCVI - 6
MCCVI = ISIGN(1,ISIGN(-1,ISIGN(+1,-1)))
MCGVI = MCCVI + 1
WRITE (NUVI,0726) MCDVI, MCEVI, MCFVI, MCGVI
C***** TEST OF COMBINATION OF ABS,IABS,FLOAT,IFIX,SIGN,ISIGN
CMEVS = FLOAT(IABS(IFIX(ABS(-5.0 + SIGN(-1.0,2.0)))))
CMFVS = CMEVS - 4.0
MCCVI = IFIX(FLOAT(ISIGN(1+2,IABS(1 + ISIGN(1,-1)))))
MCDVI = MCCVI - 3
CMEVS = SIGN(ABS(1.0 + FLOAT(-20)), FLOAT(IFIX(1.0)))
CMGVS = CMEVS - 19.0
MCCVI = ISIGN(IABS(IFIX(1.0) - 2) , -((1 + IFIX(-1.0)) +1))
MCEVI = MCCVI + 1
WRITE (NUVI,0727) CMFVS, CMGVS, MCDVI, MCEVI
CMEVS = ABS(SIGN(1.0 + 2.0, FLOAT(IABS(-2))))
CMFVS = CMEVS - 3.0
MCCVI = IABS(IFIX(SIGN(-2.0,2.0)))
MCDVI = MCCVI - 2
CMEVS = 1.2 + FLOAT(1 + 5 - ISIGN(-1,6))
CMGVS = CMEVS - 6.2
MCCVI = 25 - ISIGN(IFIX(2.0),-IABS(-5))
MCEVI = MCCVI - 27
WRITE (NUVI,0728) CMFVS, CMGVS, MCDVI, MCEVI
C***** END OF TEST STATEMENTS
0721 FORMAT ( / 30H TEST OF ABS IN EXPRESSIONS -/ 4(F17.1/))
0722 FORMAT ( 31H TEST OF IABS IN EXPRESSIONS -/ 4(I15/))
0723 FORMAT ( 32H TEST OF FLOAT IN EXPRESSIONS -/ 4(F17.1/))
0724 FORMAT ( 31H TEST OF IFIX IN EXPRESSIONS -/ 4(I15/))
0725 FORMAT ( 31H TEST OF SIGN IN EXPRESSIONS -/ 4(F17.1/))
0726 FORMAT ( 32H TEST OF ISIGN IN EXPRESSIONS -/ 4(I15/))
0727 FORMAT ( 40H COMBINATION OF ALL INTRINSIC FUNCTIONS,
1 2(/F17.1), 2(/I15))
0728 FORMAT ( 2(F17.1/),2(I15/)/ 35H ALL ABOVE ANSWERS SHOULD BE 0 FO
1R/2X,35HTHIS TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 072
C***** WHEN EXECUTING ONLY SEGMENT 072, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IFFMS - (073)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST THAT ALL INTRINSIC FUNCTIONS IN FORTRAN WOULD 8.2/07
C***** ACCEPT ANY EXPRESSION OF THE TYPE SPECIFIED IN THE (PG 24)
C***** INTRINSIC FUNCTION TABLE - ASA REFS - 8.2/TABLE 3
C***** SEGMENTS 055 - 071 ASSUMED WORKING.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 073
C*****
C***** WHEN EXECUTING ONLY SEGMENT 073, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION MCA1I(5),AC2S(5,6)
C= INTEGER MCA3I(2,3,3)
C= DOUBLE PRECISION DPAVD,DPBVD,DPCVD,DPDVD,DPEVD,DPFVD,DPGVD,
C= 1DPA1D(5),FC2D(5,5)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 073, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI,0730)
0730 FORMAT (1H1,1X,41HIFFMS - (073) FORTRAN INTRINSIC FUNCTIONS/16X,
126HACCEPT EXPRESSIONS OF TYPE/16X,22HSPECIFIED IN I.F.TABLE/
223H ASA REF.- 8.2/TABLE 3//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 073 WRITTEN
C***** TEST OF DABS IN EXPRESSIONS 8.2/13
DPAVD = 1.25D0
DPBVD = - 10.0D0
DPCVD = DABS(DPAVD + DPBVD)
DPDVD = DPCVD - 10.0D0 + 1.25D0
DPCVD = DABS(1.0D0 + 2.D0 - 3.0D0 * 50.D-1)
DPEVD = DPCVD - 12.D0
DPCVD = DABS( DPAVD * 1.D0 - 1.25D0 + DPBVD/2.D0) + 1.D0
DPFVD = DPCVD - 6.0D0
DPGVD = 1.0D0 + DABS(2.5D0 - 1.5D0 * 1.0D0) - 2.D0
WRITE (NUVI,0731) DPDVD, DPEVD, DPFVD, DPGVD
C***** TEST OF AINT IN EXPRESSIONS 8.2/14
CMAVS = 1.23
CMBVS = 27.998
CMCVS = -9.007E0
CMDVS = AINT(CMAVS + CMBVS - CMCVS)
CMEVS = CMDVS - 38.0
CMDVS = AINT(1.0 + 2.0 /1.0 - 3.0 * 2.E0)
CMFVS = CMDVS + 3.0
CMDVS = AINT(4. + AINT(2.E0 + CMCVS))
CMGVS = CMDVS + 3.0
CMDVS = AINT(AINT(AINT( 1.4 - 2.7)))
CMHVS = CMDVS + 1.0
WRITE (NUVI,0732) CMEVS, CMFVS, CMGVS, CMHVS
C***** TEST OF INT IN EXPRESSIONS 8.2/15
MCAVI = INT(1.0 + 2.1 + 3.2 - 8.4 / 2.5 * 2.6)
MCBVI = MCAVI + 2
MCAVI = INT(100.0/6.0 - (2.0 **4.0) + (((2.0-3.0)+4.0) * 2.0))
MCCVI = MCAVI - 6
MCAVI = INT((100.2/6.1/5.0+4.10) / 2.0)
MCDVI = MCAVI - 3
MCAVI = INT(9.0/2.0) + INT(5.1/4.0)
MCEVI = MCAVI - 5
WRITE (NUVI,0733) MCBVI, MCCVI, MCDVI, MCEVI
C***** TEST OF IDINT IN EXPRESSIONS 8.2/16
DPA1D(1) = 2.5D1
MCAVI = IDINT(DPBVD / 2.0D0 + 1.5D0)
MCBVI = MCAVI + 3
MCAVI = IDINT( 1.0D1 + 5.D0 * 2.D1 / 49.D1) + 1
MCCVI = MCAVI - 11
MCAVI = IDINT(DPA1D(1))
MCDVI = MCAVI - 25
MCAVI = IDINT(DPA1D(1) + DPA1D(1)/4.0D0)
MCEVI = MCAVI - 31
WRITE (NUVI,0734) MCBVI, MCCVI, MCDVI, MCEVI
C***** TEST OF AMOD, MOD IN EXPRESSIONS 8.2/17-18
AC2S(1,1) = 27.0
CMDVS =AMOD(25.0 + AC2S(1,1), 1.0 * 5.0)
CMEVS = CMDVS - 2.0
CMDVS =AMOD(99.0,AMOD(25.0+ 27.0, 5.0))
CMFVS = CMDVS - 1.0
MCA3I(1,2,3) = 5
MCAVI = MOD(98 + 1, MOD(25 + 27,5))
MCBVI = MCAVI - 1
MCAVI = MOD (MCA3I (1,2,3), 2)
MCCVI = MCAVI - 1
WRITE (NUVI,0735) CMEVS, CMFVS, MCBVI, MCCVI
C***** TEST OF AMAX0, AMAX1, MAX0, MAX1 AND DMAX1 IN EXPRESSIONS
C***** 8.2/19-23
FC2D(1,1) = 27.0D0
CMDVS = AMAX0(5 + 9, MAX0(14 * 2, MAX1( 2.0 /1.0,1.0)))
CMEVS = CMDVS - 28.0
CMDVS = AMAX1((AMAX0((MAX0(29,-100)),5 + 10)), 2.0 * 2.0)
CMFVS = CMDVS - 29.0
MCAVI = MAX1((AMAX0(25, -(1 * 5))),100.0)
MCBVI = MCAVI - 100
DPCVD = DMAX1(FC2D(1,1),DMAX1(1.0D0, 0.D0 * FC2D(1,1)))
DPDVD = DPCVD - 27.0D0
WRITE (NUVI,0736) CMEVS, CMFVS, MCBVI, DPDVD
C***** TEST OF AMIN0, AMIN1, MIN0, MIN1 AND DMIN1 IN EXPRESSIONS
C***** 8.2/24-27
CMDVS = AMIN1(2.5 + AC2S(1,1), AMIN0(-5, MIN0(0,1)))
CMEVS = CMDVS + 5.0
MCAVI = MIN0((MIN1( -99., 100.0 - 1.0 * 99.)), 2)
MCBVI = MCAVI + 99
MCAVI = MIN1( 2.0,AMIN1( 5. * 3.0, -9.0 /(-9.0)))
MCCVI = MCAVI - 1
DPCVD = DMIN1(FC2D(1,1), DMIN1(2.0D-1,0.0D0))
DPDVD = DPCVD - 0.0D0
WRITE (NUVI,0737) CMEVS, MCBVI, MCCVI, DPDVD
C***** TEST OF DSIGN,AND DBLE IN EXPRESSIONS 8.2/33,8.2/43
DPCVD= DSIGN(FC2D(1,1) * 1.0D1, - 1.0D0)
DPDVD = DPCVD + 27.0D1
DPCVD = DSIGN((DSIGN(2.0D0, -1.0D0) + 0.0D0), 9.0D0)
DPEVD = DPCVD - 2.0D0
DPCVD = DBLE( 2.0 * 4.0 + AC2S(1,1))
DPFVD = DPCVD - 35.0D0
DPCVD = DBLE(-32.00 / 8.0) * DBLE(-2.0)
DPGVD = DPCVD - 8.0D0
WRITE (NUVI,0738) DPDVD, DPEVD, DPFVD, DPGVD
C***** TEST OF DIM AND IDIM IN EXPRESSIONS 8.2/34-35
CMDVS = DIM( 2.0 * 3.5 /7.0, AC2S(1,1))
CMEVS = CMDVS - 0.0
CMDVS = DIM(DIM(9.0,-5.5), DIM(6.0,0.0))
CMFVS = CMDVS - 8.5
MCA1I(1)=8
MCCVI = IDIM(MCA1I(1) * 1, - (IDIM(0, -3)))
MCDVI = MCCVI - 11
MCCVI = IDIM(((4 + 2 + 3)/3), - 2)
MCEVI = MCCVI - 5
WRITE (NUVI,9995) CMEVS, CMFVS, MCDVI, MCEVI
C***** TEST OF SNGL, REAL , AIMAG, CMPLX AND CONJG IN EXPRESSIONS
C***** 8.2/36-47
CMEVS = SNGL (1.0D0 * 2.D1 + AC2S(1,1))
CMFVS = CMEVS - 47.0
CMEVS = REAL( CONJG((1.0, -2.0)))+ AIMAG((99.0, -7.0))
CMGVS = CMEVS + 6.0
CMEVS = AIMAG(CMPLX(REAL((2.0,1.0)), SNGL (1.0D0)))
CMHVS = CMEVS - 1.0D0
WRITE (NUVI,0739) CMFVS, CMGVS, CMHVS
C***** SOME COMBINATIONS OF ABOVE INTRINSIC FUNCTIONS
CMEVS = AMIN1((FLOAT(IDIM(1+2,0))),(AIMAG(CMPLX(1.0,2.0))))
CMFVS = CMEVS - 2.0
CMEVS = REAL(CMPLX(SNGL(DABS(-DSIGN(DBLE(2.0),1.0D0))),CMAVS))
CMGVS = CMEVS - 2.0
WRITE (NUVI,9994) CMFVS, CMGVS
C***** END OF TEST STATEMENTS FOR SEGMENT 073
0731 FORMAT (/ 30H TEST OF DABS IN EXPRESSIONS //4(D23.8/))
0732 FORMAT ( 30H TEST OF AINT IN EXPRESSIONS //4(E19.6/))
0733 FORMAT ( 30H TEST OF INT IN EXPRESSIONS //4(I10/))
0734 FORMAT ( 30H TEST OF IDINT IN EXPRESSIONS//4(I10/))
0735 FORMAT ( 35H TEST OF AMOD, MOD IN EXPRESSIONS //
1 2(E19.6/), 2(I10/))
0736 FORMAT ( 40H TEST OF AMAX0,AMAX1,MAX0,MAX1 AND DMAX//
1 2(E19.6/), I10/ D23.8)
0737 FORMAT ( 40H1 TEST OF AMIN0,AMIN1,MIN0,MIN1 AND DMIN//
1 E19.6/ 2(I10/), D23.8)
0738 FORMAT (/ 39H TEST OF DSIGN AND DBLE IN EXPRESSIONS//4(D23.8/))
0739 FORMAT ( 35H TEST OF SNGL,REAL,AIMAG,CMPLX AND /
123H CONJG IN EXPRESSIONS //3(E19.6/))
9994 FORMAT ( 36H TEST OF SOME COMBINATIONS OF ABOVE/
122H INTRINSIC FUNCTIONS //2(E19.6/) /40H ALL ABOVE ANSWERS SHOUL
2D BE 0 FOR THIS/27H SEGMENT TO BE SUCCESSFUL.)
9995 FORMAT ( /37H TEST OF DIM AND IDIM IN EXPRESSIONS/2(E19.6/),
1 2(I10/))
C***** END OF TEST SEGMENT 073
C***** WHEN EXECUTING ONLY SEGMENT 073, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
nbs07.d 480890333 170 2 100666 299 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2 . DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4 . DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6 DOUBLE SPACE ON OUTPUT ID 6
nbs07.f 480887331 170 2 100666 39369 `
C***** PART7 *****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 7 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** EXPON - 080 EXP
C*****
C***** DEXPO - 081 DEXP
C*****
C***** CEXPO - 082 CEXP
C*****
C***** LOGTM - 083 ALOG
C*****
C***** DPLOG - 084 DLOG
C*****
C***** CXLOG - 085 CLOG
C*****
C***** COLOG - 086 ALOG10
C*****
C***** DCLOG - 087 DLOG10
C*****
C***** SINUS - 088 SIN
C*****
C***** DPSIN - 089 DSIN
C*****
C***** CSICO - 090 CSIN (AND CCOS)
C*****
C***** COSNS - 091 COS
C*****
C***** DPCOS - 092 DCOS
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN SEGMENTS
C***** 080,081,082,083,084,085,086,087,088,089,090,091,092
C***** ARE RUN AS ONE MAIN PROGRAM.
C*****
DIMENSION L1I (10)
DOUBLE PRECISION AVD, BVD, CVD, DVD, EVD, FVD, GVD, XVD, PIVD
COMPLEX EP1C(30), AVC, BVC
DATA LAZVI,LBZVI, LCZVI,LDZVI/2H0( ,2H, ,2H1/,1H)/
DATA L1I(1),L1I(2),L1I(3),L1I(4),L1I(5)/
- 2H1 , 2H2 , 2H3 , 2H4 , 2H5 /,
- L1I(6),L1I(7),L1I(8),L1I(9),L1I(10)/
- 2H6 , 2H7 , 2H8 , 2H9 , 2H10 /
C*****
C***** END OF SPECIFICATIONS FOR SEGMENTS
C***** 080,081,082,083,084,085,086,087,088,089,090,091,092
C***********************************************************************
C*****
C***** EXPON - 080
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** .TO TEST BASIC EXTERNAL FUNCTION - EXP - EXPONENTIAL 8.3.3
C***** .USED IN SIMPLE ARITHMETIC EXPRESSIONS TABLE 4
C***** .INTRINSIC FUNCTIONS ABS AND SIGN ASSUMED WORKING
C***** ARGUMENTS ARE POWERS OF 2
C*****
C***** S P E C I F I C A T I O N S SEGMENT 080
C*****
C***** WHEN EXECUTING ONLY SEGMENT 080, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THIS SEGMENT HAS NO SPECIFICATIONS.
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 7 ///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
WRITE(NUVI,800)
800 FORMAT(15H1 EXPON - (080)//31H BASIC EXTERNAL FUNCTION -EXP-
1//26H (EXPONENTIAL -TYPE REAL)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
C***** HEADER FOR SEGMENT 080 WRITTEN
C***** ARGUMENT RANGE FROM -16.0 TO +16.0
AVS = -16.0
CVS = 4.0
BVS = EXP(AVS)
WRITE (NUVI,801) BVS
BVS = EXP(2. * CVS + AVS)
WRITE (NUVI,802) BVS
BVS = EXP(AVS + (3. * CVS))
WRITE (NUVI, 803) BVS
BVS = EXP(ABS(AVS) + AVS)
WRITE (NUVI, 804) BVS
BVS = EXP(-AVS / CVS)
WRITE (NUVI, 805) BVS
BVS = EXP(SIGN(AVS + CVS * 2.0, CVS))
WRITE (NUVI, 806) BVS
BVS = EXP(CVS + ABS(AVS) - 4.0)
WRITE(NUVI, 807) BVS
WRITE (NUVI, 808)
801 FORMAT( 9H0 X=-16.0,5X,25H0.1125351747192591145E-06/E27.7)
802 FORMAT( 9H0 X= -8.0,5X,25H0.3354626279025118388E-03/E27.7)
803 FORMAT( 9H0 X= -4.0,5X,25H0.1831563888873418029E-01/E27.7)
804 FORMAT( 9H0 X= 0.0,5X,25H0.1000000000000000000E+01/E27.7)
805 FORMAT( 9H0 X= 4.0,5X,25H0.5459815003314423908E+02/E27.7)
806 FORMAT( 9H0 X= 8.0,5X,25H0.2980957987041728275E+04/E27.7)
807 FORMAT( 9H0 X= 16.0,5X,25H0.8886110520507872637E+07/E27.7)
808 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO ,8H7 DIGITS)
C***** END OF TEST SEGMENT 080
C***** WHEN EXECUTING ONLY SEGMENT 080, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DEXPO - 081
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** .TO TEST BASIC EXTERNAL FUNCTION - DEXP - EXPONENTIAL ASA REF
C***** USED IN SIMPLE ARITHMETIC EXPRESSIONS -SAME AS 8.3.3
C***** SEGMENT 080 EXCEPT DOUBLE PRECISION TABLE 4
C***** INTRINSIC FUNCTIONS DABS AND DSIGN ASSUMED WORKING
C***** ARGUMENTS RANGE FROM -16.0D0 TO +16.0D0, POWERS OF 2
C*****
C***** S P E C I F I C A T I O N S SEGMENT 081
C*****
C***** WHEN EXECUTING ONLY SEGMENT 081, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AVD, BVD, CVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 081, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
810 FORMAT(15H1 DEXPO - (081)//32H BASIC EXTERNAL FUNCTION -DEXP-
1//38H (EXPONENTIAL -TYPE DOUBLE PRECISION)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 810)
C***** HEADER FOR SEGMENT 081 WRITTEN
AVD = -16.0D0
CVD = 4.0D0
BVD = DEXP(AVD)
WRITE (NUVI, 811) BVD
BVD = DEXP(2. * CVD + AVD)
WRITE (NUVI, 812) BVD
BVD = DEXP(AVD + (3. * CVD))
WRITE (NUVI, 813) BVD
BVD = DEXP(DABS(AVD) + AVD)
WRITE( NUVI, 814) BVD
BVD = DEXP(-AVD / CVD)
WRITE (NUVI, 815) BVD
BVD = DEXP(DSIGN(AVD + CVD * 2.0D0, CVD))
WRITE (NUVI, 816) BVD
BVD = DEXP(CVD + DABS(AVD) - 4.0)
WRITE (NUVI, 817) BVD
WRITE (NUVI, 818)
811 FORMAT( 9H0 X=-16.0,5X,25H0.1125351747192591145D-06/D34.14)
812 FORMAT( 9H0 X= -8.0,5X,25H0.3354626279025118388D-03/D34.14)
813 FORMAT( 9H0 X= -4.0,5X,25H0.1831563888873418029D-01/D34.14)
814 FORMAT( 9H0 X= 0.0,5X,25H0.1000000000000000000D+01/D34.14)
815 FORMAT( 9H0 X= 4.0,5X,25H0.5459815003314423908D+02/D34.14)
816 FORMAT( 9H0 X= 8.0,5X,25H0.2980957987041728275D+04/D34.14)
817 FORMAT( 9H0 X= 16.0,5X,25H0.8886110520507872637D+07/D34.14)
818 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
A PRINTED TO ,9H14 DIGITS)
C***** END OF TEST SEGMENT 081
C***** WHEN EXECUTING ONLY SEGMENT 081, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C******
C***** CEXPO - (082)
C******
C***********************************************************************
C***** GENERAL PURPOSE ASA REF.
C***** .TO TEST THE BASIC EXTERNAL FUNCTION- CEXP 8.3.3
C***** .TESTING RANGE EXTENDS FROM 0 TO 16 FOR MODULUS (TABLE 4)
C***** AND ARGUMENT, VARIES BY STEPS OF PI/3 MAGNITUDE
C***** .INTRINSIC FUNCTIONS CMPLX, SNGL, MOD ASSUMED WORKING
C*****
C***** S P E C I F I C A T I O N S SEGMENT 082
C*****
C***** WHEN EXECUTING ONLY SEGMENT 082, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX EP1C(30), AVC, BVC
C= DOUBLE PRECISION AVD, BVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 082, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE(NUVI,820)
820 FORMAT(15H1 CEXPO - (082)//32H BASIC EXTERNAL FUNCTION -CEXP-
1// 29H (EXPONENTIAL -TYPE COMPLEX)//27H ASA REF.- 8.3.3 (TABLE 4
2)//20H (COMPLEX ARGUMENT)/8X,15HEXPECTED RESULT /8X,15HFUNCTION R
3ESULT)
C***** LOG OF 10
BVD = 2.3025850929940D0
C***** SINE OF 60 DEGREES
AVD = .86602540378444D0
C***** INITIALIZE EP1C (EXPECTED VALUES)
EP1C(1) = CMPLX(0.5E-7,SNGL(-AVD*1.D-7))
EP1C(2) = CMPLX(2.5E-7,SNGL(-AVD*5.D-7))
EP1C(3) = (1.E-6,0.0)
EP1C(4) = (5.E-6,0.0)
EP1C(5) = CMPLX(0.5E-5,SNGL(AVD*1.D-5))
EP1C(6) = CMPLX(2.5E-5,SNGL(AVD*5.D-5))
EP1C(7) = CMPLX(-.5E-4,SNGL(AVD * 1.D-4))
EP1C(8) = CMPLX(-2.5E-4,SNGL(AVD*5.D-4))
EP1C(9) = (-1.E-3,0.0)
EP1C(10) = (-5.E-3,0.0)
EP1C(11) = CMPLX(-0.5E-2,SNGL(-AVD*1.D-2))
EP1C(12) = CMPLX(-2.5E-2,SNGL(-AVD * 5.D-2))
EP1C(13) = CMPLX(0.5E-1,SNGL(-AVD*1.D-1))
EP1C(14) = CMPLX(2.5E-1,SNGL(-AVD*5.D-1))
EP1C(15) = (1.0,0.0)
EP1C(16) = (5.0,0.0)
EP1C(17) = CMPLX(0.5E1,SNGL(AVD * 1.D1))
EP1C(18) = CMPLX(2.5E1,SNGL(AVD * 5.D1))
EP1C(19) = CMPLX(-0.5E2,SNGL(AVD * 1.D2))
EP1C(20) = CMPLX(-2.5E2,SNGL(AVD * 5.D2))
EP1C(21) = (-1.E3,0.0)
EP1C(22) = (-5.E3,0.0)
EP1C(23) = CMPLX(-0.5E4,SNGL(-AVD * 1.D4))
EP1C(24) = CMPLX(-2.5E4,SNGL(-AVD * 5.D4))
EP1C(25) = CMPLX(0.5E5,SNGL(-AVD * 1.D5))
EP1C(26) = CMPLX(2.5E5,SNGL(-AVD * 5.D5))
EP1C(27) = (1.E6,0.0)
EP1C(28) = (5.E6,0.0)
EP1C(29) = CMPLX(0.5E7,SNGL(AVD * 1.D7))
EP1C(30) = CMPLX(2.5E7,SNGL(AVD * 5.D7))
IVI = 0
821 IVI = IVI + 1
IF ( MOD(IVI,2).EQ.0) GO TO 822
XIVS = ((IVI + 1)/2) - 8
AVS = BVD * XIVS
GO TO 823
C***** 1.609 IS LOG OF 5
822 XIVS = (IVI / 2) - 8
AVS = BVD * XIVS + 1.6094379124341D0
C***** 1.047 IS PI/3
823 AVC = CMPLX(AVS,SNGL(1.0471975511966D0 * XIVS))
BVC = CEXP(AVC)
WRITE(NUVI, 824) AVC, EP1C(IVI), BVC
IF (IVI - 10) 825, 827, 825
825 IF (IVI - 20) 826, 827, 826
826 IF (IVI - 30) 821, 828, 828
827 WRITE(NUVI, 829)
GO TO 821
828 CONTINUE
829 FORMAT(22H1 CEXPO - (082) -CEXP-)
824 FORMAT(3H0 (,E14.7,1H,,E14.7,1H),2(/8X,2E16.7))
C***** END OF TEST SEGMENT 082
C***** WHEN EXECUTING ONLY SEGMENT 082, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** LOGTM - 083
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** .TO TEST BASIC EXTERNAL FUNCTION - ALOG - ASA REF
C***** NATURAL LOG -USED IN SIMPLE ARITHMETIC EXPRESSIONS 8.3.3
C***** INTRINSIC FUNCTIONS ABS,AMIN1,INT,MIN0,FLOAT, TABLE 4
C***** SIGN ASSUMED WORKING
C***** ARGUMENTS ARE POWERS(OR SUMS) OF 2
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 083, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
830 FORMAT(15H1 LOGTM - (083)//32H BASIC EXTERNAL FUNCTION -ALOG-
1//26H (NATURAL LOG -TYPE REAL)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 830)
C***** HEADER FOR SEGMENT 083 WRITTEN
AVS = .25
CVS = 2.0
MVI = -2
BVS = ALOG(AVS / 2.0)
WRITE (NUVI, 831) BVS
BVS = ALOG(AVS)
WRITE (NUVI, 832) BVS
BVS = ALOG(AVS * CVS)
WRITE (NUVI, 833) BVS
BVS = ALOG(AVS * CVS ** 2)
WRITE (NUVI, 834) BVS
BVS = ALOG(AMIN1(AVS * 2.0 + ABS(FLOAT(MVI) / CVS),CVS))
WRITE (NUVI, 835) BVS
BVS = ALOG(SIGN(FLOAT(MIN0(MVI,INT(CVS))),AVS))
WRITE (NUVI, 836) BVS
831 FORMAT( 9H0 X=0.125,5X,19H-2.0794415416798359/14X,F9.6)
832 FORMAT( 9H0 X=0.25 ,5X,19H-1.3862943611198906/14X,F 9.6)
833 FORMAT( 9H0 X=0.5 ,5X,19H-0.6931471805599453/14X,F10.7)
834 FORMAT( 9H0 X=1.0 ,5X,19H 0.0000000000000000/14X,F10.7)
835 FORMAT( 9H0 X=1.5 ,5X,19H 0.4054651081081644/14X,F10.7)
836 FORMAT( 9H0 X=2.0 ,5X,19H 0.6931471805599453/14X,F10.7)
WRITE (NUVI, 837)
837 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO ,8H7 DIGITS)
C***** END OF TEST SEGMENT 083
C***** WHEN EXECUTING ONLY SEGMENT 083, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DPLOG - 084
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** TO TEST BASIC EXTERNAL FUNCTION - DLOG - ASA REF
C***** NATURAL LOG -TYPE DOUBLE PRECISION 8.3.3
C***** USED IN SIMPLE ARITHMETIC EXPRESSIONS TABLE 4
C***** INTRINSIC FUNCTIONS DMIN1,DABS,DBLE,FLOAT,DSIGN,
C***** MIN0,DINT, ASSUMED WORKING
C***** ARGUMENTS ARE POWERS OF 2
C*****
C***** S P E C I F I C A T I O N S SEGMENT 084
C*****
C***** WHEN EXECUTING ONLY SEGMENT 084, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AVD, BVD, CVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 084, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
840 FORMAT(15H1 DPLOG - (084)//32H BASIC EXTERNAL FUNCTION -DLOG-
1//38H (NATURAL LOG -TYPE DOUBLE PRECISION)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 840)
C***** HEADER FOR SEGMENT 084 WRITTEN
AVD = .25D0
CVD = 2.0D0
MVI = -2
BVD = DLOG(AVD / 2.0D0)
WRITE (NUVI, 841) BVD
BVD = DLOG(AVD)
WRITE( NUVI, 842) BVD
BVD = DLOG(AVD * CVD)
WRITE(NUVI, 843) BVD
BVD = DLOG(AVD * CVD ** 2)
WRITE (NUVI, 844) BVD
BVD = DLOG(DMIN1(AVD * 2.0D0 +DABS(DBLE(FLOAT(MVI))/CVD), CVD))
WRITE (NUVI, 845) BVD
BVD = DLOG(DSIGN(DBLE(FLOAT(MIN0(MVI,IDINT(CVD)))),AVD))
WRITE (NUVI, 846) BVD
WRITE (NUVI, 847)
841 FORMAT( 9H0 X=0.125,5X,23H-2.0794415416798359D+00/1PD34.13)
842 FORMAT( 9H0 X=0.25 ,5X,23H-1.3862943611198906D+00/1PD34.13)
843 FORMAT( 9H0 X=0.5 ,5X,23H-0.6931471805599453D+00/ D35.14)
844 FORMAT( 9H0 X=1.0 ,5X,23H 0.000000000000000 / D35.14)
845 FORMAT( 9H0 X=1.5 ,5X,23H 0.4054651081081644D+00/ D35.14)
846 FORMAT( 9H0 X=2.0 ,5X,23H 0.6931471805599453D+00/ D35.14)
847 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
A PRINTED TO ,9H14 DIGITS)
C***** END OF TEST SEGMENT 084
C***** WHEN EXECUTING ONLY SEGMENT 084, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CXLOG - (085)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** .TO TEST BASIC EXTERNAL FUNCTION - CLOG - ASA REF
C***** (COMPLEX LOG) 8.3.3
C***** TESTING RANGE EXTENDS FROM 0 TO 5.E7 FOR MODULUS TABLE 4
C***** AND ARGUMENT VARIES BY STEPS OF PI/3 MAGNITUDE
C***** INTRINSIC FUNCTIONS CMPLX, SNGL, MOD ASSUMED WORKING
C*****
C***** S P E C I F I C A T I O N S SEGMENT 085
C*****
C***** WHEN EXECUTING ONLY SEGMENT 085, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX EP1C(30), AVC, BVC
C= DOUBLE PRECISION AVD, BVD
C*****
C***** O U T P U T - T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 085, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI, 850)
850 FORMAT( 15H1 CXLOG - (085) //32H BASIC EXTERNAL FUNCTION -CLOG-
1// 29H (NATURAL LOG -TYPE COMPLEX)//27H ASA REF.- 8.3.3 (TABLE 4
2)//20H (COMPLEX ARGUMENT)/ 8X,15HEXPECTED RESULT /8X,15HFUNCTION
3RESULT)
C***** LOG OF 10
BVD = 2.3025850929940D0
C***** SINE OF 60 DEGREES
AVD = .86602540378444D0
C***** INITIALIZE EP1C (EXPECTED VALUES)
EP1C(1) = CMPLX(0.5E-7,SNGL(-AVD*1.D-7))
EP1C(2) = CMPLX(2.5E-7,SNGL(-AVD*5.D-7))
EP1C(3) = (1.E-6,0.0)
EP1C(4) = (5.E-6,0.0)
EP1C(5) = CMPLX(0.5E-5,SNGL(AVD*1.D-5))
EP1C(6) = CMPLX(2.5E-5,SNGL(AVD*5.D-5))
EP1C(7) = CMPLX(-.5E-4,SNGL(AVD * 1.D-4))
EP1C(8) = CMPLX(-2.5E-4,SNGL(AVD*5.D-4))
EP1C(9) = (-1.E-3,0.0)
EP1C(10) = (-5.E-3,0.0)
EP1C(11) = CMPLX(-0.5E-2,SNGL(-AVD*1.D-2))
EP1C(12) = CMPLX(-2.5E-2,SNGL(-AVD * 5.D-2))
EP1C(13) = CMPLX(0.5E-1,SNGL(-AVD*1.D-1))
EP1C(14) = CMPLX(2.5E-1,SNGL(-AVD*5.D-1))
EP1C(15) = (1.0,0.0)
EP1C(16) = (5.0,0.0)
EP1C(17) = CMPLX(0.5E1,SNGL(AVD * 1.D1))
EP1C(18) = CMPLX(2.5E1,SNGL(AVD * 5.D1))
EP1C(19) = CMPLX(-0.5E2,SNGL(AVD * 1.D2))
EP1C(20) = CMPLX(-2.5E2,SNGL(AVD * 5.D2))
EP1C(21) = (-1.E3,0.0)
EP1C(22) = (-5.E3,0.0)
EP1C(23) = CMPLX(-0.5E4,SNGL(-AVD * 1.D4))
EP1C(24) = CMPLX(-2.5E4,SNGL(-AVD * 5.D4))
EP1C(25) = CMPLX(0.5E5,SNGL(-AVD * 1.D5))
EP1C(26) = CMPLX(2.5E5,SNGL(-AVD * 5.D5))
EP1C(27) = (1.E6,0.0)
EP1C(28) = (5.E6,0.0)
EP1C(29) = CMPLX(0.5E7,SNGL(AVD * 1.D7))
EP1C(30) = CMPLX(2.5E7,SNGL(AVD * 5.D7))
C***** YVS COMPENSATES FOR -2PI AND +2PI GENERATED BY USE OF XIVS*PI/3
C***** FOR EXPECTED IMAGINARY VALUES, TAKES VALUES +6,0,-6 DURING RANGE
YVS = 6.
IVI = 0
851 IVI = IVI +1
IF (MOD(IVI, 2) .EQ. 0) GO TO 852
XIVS = ((IVI + 1)/2) - 8
AVS = BVD * XIVS
GO TO 853
C***** 1.609 IS LOG OF 5
852 XIVS = (IVI / 2) - 8
AVS = (BVD * XIVS) + 1.6094379124341D0
C***** 1.047 IS PI/3
853 AVC = CMPLX (AVS, SNGL(1.0471975511966D0 * (XIVS + YVS)))
BVC = CLOG (EP1C(IVI))
WRITE (NUVI, 854) EP1C(IVI), AVC, BVC
IF(IVI - 10) 855, 858, 855
855 IF (IVI - 20) 856, 859, 856
856 IF (IVI - 22) 857, 7850, 857
857 IF (IVI - 30) 851, 7851, 7851
858 YVS = 0.0
859 WRITE (NUVI, 7852)
GO TO 851
7850 YVS = -6.0
GO TO 851
7851 CONTINUE
854 FORMAT(3H0 (,E14.7,1H,,E14.7,1H),2(/8X,2E16.7))
7852 FORMAT(22H1 CXLOG - (085) -CLOG-)
C***** END OF TEST SEGMENT 085
C***** WHEN EXECUTING ONLY SEGMENT 085, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** COLOG - 086
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** TO TEST BASIC EXTERNAL FUNCTION - ALOG10 - ASA REF
C***** COMMON LOG - TYPE REAL 8.3.3
C***** USED IN SIMPLE ARITHMETIC EXPRESSIONS TABLE 4
C***** INTRINSIC FUNCTIONS ABS,AINT,AMAX1,SIGN, ASSUMED WORKING
C***** ARGUMENT RANGE 0.5 TO 16.0 ,POWERS OF 2
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 086, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
860 FORMAT(15H1 COLOG - (086)//34H BASIC EXTERNAL FUNCTION -ALOG10-
1//25H (COMMON LOG -TYPE REAL)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 860)
C***** HEADER FOR SEGMENT 086 WRITTEN
AVS = -2.0
CVS = -4.0
BVS = ALOG10(AVS / CVS)
WRITE (NUVI, 861) BVS
BVS = ALOG10(ABS(AVS + 1.0))
WRITE (NUVI, 862) BVS
BVS = ALOG10( -AVS)
WRITE (NUVI, 863) BVS
BVS = ALOG10(AINT(AVS + 2.0 - CVS))
WRITE (NUVI, 864) BVS
BVS = ALOG10(AMAX1(AVS * CVS, CVS * 2.0))
WRITE (NUVI, 865) BVS
BVS = ALOG10(SIGN(CVS,(-AVS)) **2)
WRITE (NUVI, 866) BVS
WRITE (NUVI, 867)
861 FORMAT( 8H0 X= 0.5,5X,25H-0.3010299956639811952137/8X, F15.7)
862 FORMAT( 8H0 X= 1.0,5X,25H 0.0000000000000000000000/8X, F15.7)
863 FORMAT( 8H0 X= 2.0,5X,25H 0.3010299956639811952137/8X, F15.7)
864 FORMAT( 8H0 X= 4.0,5X,25H 0.6020599913279623904275/8X, F15.7)
865 FORMAT( 8H0 X= 8.0,5X,25H 0.9030899869919435856412/8X, F15.7)
866 FORMAT( 8H0 X=16.0,5X,25H 1.2041199826559247808550/8X, F15.7)
867 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO ,8H7 DIGITS)
C***** END OF TEST SEGMENT 086
C***** WHEN EXECUTING ONLY SEGMENT 086, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DCLOG - 087
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** TO TEST BASIC EXTERNAL FUNCTION - DLOG10 - ASA REF
C***** COMMON LOG - TYPE DOUBLE PRECISION 8.3.3
C***** SAME AS SEGMENT 086 EXCEPT FOR TYPE TABLE 4
C***** INTRINSIC FUNCTIONS DABS,IDINT,FLOAT,DBLE,
C***** DMAX1,DSIGN ASSUMED WORKING
C***** ARGUMENT RANGE 0.5 TO 16.0 POWERS OF 2
C*****
C***** S P E C I F I C A T I O N S SEGMENT 087
C*****
C***** WHEN EXECUTING ONLY SEGMENT 087, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AVD, BVD, CVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 087, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
870 FORMAT(15H1 DCLOG - (087)//34H BASIC EXTERNAL FUNCTION -DLOG10-
1//37H (COMMON LOG -TYPE DOUBLE PRECISION)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 870)
C***** HEADER FOR SEGMENT 087 WRITTEN
AVD = -2.0D0
CVD = -4.0D0
BVD = DLOG10(AVD / CVD)
WRITE (NUVI, 871) BVD
BVD = DLOG10(DABS(AVD + 1.0D0))
WRITE (NUVI, 872) BVD
BVD = DLOG10( -AVD)
WRITE (NUVI, 873) BVD
BVD = DLOG10(DBLE(FLOAT(IDINT(AVD + 2.0D0 - CVD))))
WRITE (NUVI, 874) BVD
BVD = DLOG10(DMAX1(AVD * CVD, CVD * 2.0D0))
WRITE (NUVI, 875) BVD
BVD = DLOG10(DSIGN(CVD,(-AVD)) **2)
WRITE (NUVI, 876) BVD
WRITE (NUVI, 877)
871 FORMAT( 8H0 X= 0.5,5X,29H-0.3010299956639811952137D+00/D34.14)
872 FORMAT( 8H0 X= 1.0,5X,29H 0.0000000000000000000000 /D34.14)
873 FORMAT( 8H0 X= 2.0,5X,29H 0.3010299956639811952137D+00/D34.14)
874 FORMAT( 8H0 X= 4.0,5X,29H 0.6020599913279623904275D+00/D34.14)
875 FORMAT( 8H0 X= 8.0,5X,29H 0.9030899869919435856412D+00/D34.14)
876 FORMAT( 8H0 X=16.0,5X,29H 1.2041199826559247808550D+00/1PD33.13)
877 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
A PRINTED TO ,9H14 DIGITS)
C***** END OF TEST SEGMENT 087
C***** WHEN EXECUTING ONLY SEGMENT 087, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** SINUS - 088
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - SIN - 8.3.3
C***** TRIGONOMETRIC SINE - TYPE REAL TABLE 4
C***** INTRINSIC FUNCTION SNGL ASSUMED WORKING
C***** ARGUMENTS FROM 0 TO 2 PI
C*****
C***** S P E C I F I C A T I O N S SEGMENT 088
C*****
C***** WHEN EXECUTING ONLY SEGMENT 088, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AVD, BVD, CVD, DVD, EVD, PIVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 088, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI, 880)
880 FORMAT(15H1 SINUS - (088)//31H BASIC EXTERNAL FUNCTION -SIN-
1//33H (TRIGONOMETRIC SINE -TYPE REAL)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
C***** HEADER FOR SEGMENT 088 WRITTEN
AVD = 3.140625D+0
BVD = 0.9613037109375D-3
CVD = 0.57220458984375D-5
DVD = 0.596046447753906D-6
EVD = 0.31786509547056D-7
C*****PI IS SUM OF AVD TO EVD, PARTS ARE EXPRESSED IN SUMS OF POWERS OF
C*****2, TO PERMIT A POSSIBLE 20 DECIMAL DIGIT ARGUMENT TO BE CREATED
PIVD = EVD + DVD + CVD + BVD + AVD
AVS = 1.0
CVS = 2.0
BVS = SIN(CVS - 2.0 * AVS)
WRITE (NUVI, 881) BVS
BVS = SIN(AVS)
WRITE (NUVI, 882) BVS
BVS = SIN (CVS)
WRITE (NUVI, 883) BVS
BVS = SIN(AVS + CVS)
WRITE (NUVI,884) BVS
BVS = SIN(SNGL(PIVD))
WRITE (NUVI, 885) BVS
BVS = SIN(2. * CVS)
WRITE (NUVI, 886) BVS
BVS = SIN(2.0 + CVS + AVS)
WRITE (NUVI, 887) BVS
BVS = SIN(CVS * (AVS + CVS))
WRITE (NUVI, 888) BVS
BVS = SIN(SNGL(2.0D0 * PIVD))
WRITE (NUVI, 889) BVS
WRITE (NUVI, 7880)
881 FORMAT( 9H0 X= 0.0 ,5X,15H 0.000000000000 /14X, F10.7)
882 FORMAT( 9H0 X= 1.0 ,5X,15H+0.841470984808 /14X, F10.7)
883 FORMAT( 9H0 X= 2.0 ,5X,15H+0.909297426826 /14X, F10.7)
884 FORMAT( 9H0 X= 3.0 ,5X,15H+0.141120008060 /14X, F10.7)
885 FORMAT( 9H0 X= (PI),5X,15H 0.000000000000 /14X, F10.7)
886 FORMAT( 9H0 X= 4.0 ,5X,15H-0.756802495308 /14X, F10.7)
887 FORMAT( 9H0 X= 5.0 ,5X,15H-0.958924274663 /14X, F10.7)
888 FORMAT( 9H0 X= 6.0 ,5X,15H-0.279415498198 /14X, F10.7)
889 FORMAT( 9H0 X=(2PI),5X,15H 0.000000000000 /14X, F10.7)
7880 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO ,8H7 DIGITS)
C***** END OF TEST SEGMENT 088
C***** WHEN EXECUTING ONLY SEGMENT 088, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DPSIN - 089
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - DSIN - 8.3.3
C***** TRIGONOMETRIC SINE - TYPE DOUBLE PRECISION TABLE 4
C***** SAME AS SEGMENT 088 EXCEPT D.P.
C***** INTRINSIC FUNCTION DSIGN ASSUMED WORKING
C***** ARGUMENTS FROM 0 TO 2 PI
C*****
C***** S P E C I F I C A T I O N S SEGMENT 089
C*****
C***** WHEN EXECUTING ONLY SEGMENT 089, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AVD, BVD, CVD, DVD, EVD, PIVD, XVD, FVD, GVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 089, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
890 FORMAT(15H1 DPSIN - (089)//32H BASIC EXTERNAL FUNCTION -DSIN-
1//33H (TRIGONOMETRIC SINE -TYPE D.P.)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 890)
C***** HEADER FOR SEGMENT 089 WRITTEN
AVD = 3.140625D+0
BVD = 0.9613037109375D-3
CVD = 0.57220458984375D-5
DVD = 0.596046447753906D-6
EVD = 0.31786509547056D-7
C*****PI IS SUM OF AVD TO EVD, PARTS ARE EXPRESSED IN SUMS OF POWERS OF
C*****2, TO PERMIT A POSSIBLE 20 DECIMAL DIGIT ARGUMENT TO BE CREATED
PIVD = EVD + DVD + CVD + BVD + AVD
FVD = 1.0D0
GVD = 2.0D0
XVD = DSIN(GVD - 2.0D0 * FVD)
WRITE (NUVI, 891) XVD
XVD = DSIN(FVD)
WRITE (NUVI, 892) XVD
XVD = DSIN(GVD)
WRITE (NUVI, 893) XVD
XVD = DSIN(GVD + FVD)
WRITE (NUVI, 894) XVD
XVD = DSIN(PIVD)
WRITE (NUVI, 895) XVD
XVD = DSIN(2. * GVD)
WRITE (NUVI, 896) XVD
XVD = DSIN(2.0 +FVD + GVD)
WRITE (NUVI, 897) XVD
XVD = DSIN(GVD * (FVD + GVD))
WRITE (NUVI, 898) XVD
XVD = DSIN(DSIGN(2.0D0 * PIVD, GVD))
WRITE (NUVI, 899) XVD
WRITE (NUVI, 7890)
891 FORMAT(9H0 X= 0.0 , 31H 0.00000000000000000000000 / D31.14)
892 FORMAT(9H0 X= 1.0 , 31H +0.84147098480789650665250D+00 /D31.14)
893 FORMAT(9H0 X= 2.0 , 31H +0.90929742682568169539602D+00 /D31.14)
894 FORMAT(9H0 X= 3.0 , 31H +0.14112000805986722210074D+00 /D31.14)
895 FORMAT(9H0 X= (PI), 31H 0.00000000000000000000000 / D31.14)
896 FORMAT(9H0 X= 4.0 , 31H -0.75680249530792825137264D+00 /D31.14)
897 FORMAT(9H0 X= 5.0 , 31H -0.95892427466313846889315D+00 / D31.14)
898 FORMAT(9H0 X= 6.0 , 31H -0.27941549819892587281156D+00 / D31.14)
899 FORMAT(9H0 X=(2PI), 31H 0.00000000000000000000000 / D31.14)
7890 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
A PRINTED TO ,9H14 DIGITS)
C***** END OF TEST SEGMENT 089
C***** WHEN EXECUTING ONLY SEGMENT 089, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C**********************************************************************
C*****
C***** CSICO - (090)
C*****
C**********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTIONS -CSIN- AND -CCOS- 8.3.3
C***** COMPLEX SINE AND COSINE TABLE 4
C***** INTRINSIC FUNCTION CMPLX ASSUMED WORKING
C*****
C***** S P E C I F I C A T I O N S SEGMENT 090
C*****
C***** WHEN EXECUTING ONLY SEGMENT 090, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION L1I (10)
C= COMPLEX AVC, BVC
C*****
C***** O U T P U T - T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 090, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI, 900)
900 FORMAT(15H1 CSICO - (090)//40H BASIC EXTERNAL FUNCTIONS -CSIN , C
1COS- //39H (TRIG. SINE AND COSINE -TYPE COMPLEX)//26H ASA REF 8.
23.3 (TABLE 4) //10H FUNCTION, 10X,7HRESULTS //)
AVC = (1.0,1.0)
BVC = CSIN (AVC)
WRITE(NUVI, 901) BVC
BVC = CCOS(AVC)
WRITE (NUVI, 902) BVC
IVI = 0
905 IVI = IVI + 1
AVS = IVI
BVS = 1. / AVS
AVC = CMPLX (AVS,BVS)
BVC = CSIN(AVC) ** 2 + CCOS(AVC) ** 2
WRITE(NUVI, 904) LAZVI, L1I(IVI),LBZVI,LCZVI,L1I(IVI),LDZVI, BVC
904 FORMAT( A2,A2, A2,A2,A2,A1,4X,2F12.7)
IF(IVI - 10) 905, 906, 906
906 CONTINUE
901 FORMAT(/13H TABLE VALUE,4X,22H 1.2984576 0.6349639 /17H CSIN(1
1.,1.) = ,F10.7,F12.7)
902 FORMAT(/13H TABLE VALUE,4X,22H 0.8337300 -0.9888977 /17H CCOS(1
1.,1.) = ,F10.7,F12.7 ///35H CSIN(X)**2 + CCOS(X)**2 = 1.0,0.0 /
2 40H0 ARGUMENT RESULTS SHOULD BE 1.0,0.0 )
C***** END OF TEST SEGMENT 090
C***** WHEN EXECUTING ONLY SEGMENT 090, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** COSNS - 091
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - COS - 8.3.3
C***** TRIGONOMETRIC COSINE - TYPE REAL TABLE 4
C***** SAME AS SEGMENT EXCEPT FOR COSINE
C***** INTRINSIC FUNCTION SNGL ASSUMED WORKING
C***** ARGUMENTS FROM 0 TO 2 PI
C*****
C***** S P E C I F I C A T I O N S SEGMENT 091
C*****
C***** WHEN EXECUTING ONLY SEGMENT 091, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AVD, BVD, CVD, DVD, EVD, PIVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 091, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
910 FORMAT(15H1 COSNS - (091)//31H BASIC EXTERNAL FUNCTION -COS-
1//35H (TRIGONOMETRIC COSINE -TYPE REAL)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 910)
C***** HEADER FOR SEGMENT 091 WRITTEN
AVD = 3.140625D+0
BVD = 0.9613037109375D-3
CVD = 0.57220458984375D-5
DVD = 0.596046447753906D-6
EVD = 0.31786509547056D-7
C*****PI IS SUM OF AVD TO EVD, PARTS ARE EXPRESSED IN SUMS OF POWERS OF
C*****2, TO PERMIT A POSSIBLE 20 DECIMAL DIGIT ARGUMENT TO BE CREATED
PIVD = EVD + DVD + CVD + BVD + AVD
AVS = 1.0
CVS = 2.0
BVS = COS(CVS - 2.0 * AVS)
WRITE (NUVI, 911) BVS
BVS = COS(AVS)
WRITE (NUVI, 912) BVS
BVS = COS(CVS)
WRITE (NUVI, 913) BVS
BVS = COS(AVS + CVS)
WRITE (NUVI, 914) BVS
BVS = COS(SNGL(PIVD))
WRITE (NUVI, 915) BVS
BVS = COS(2. * CVS)
WRITE (NUVI, 916) BVS
BVS = COS(2.0 + CVS + AVS)
WRITE (NUVI, 917) BVS
BVS = COS(CVS * (AVS + CVS))
WRITE (NUVI, 918) BVS
BVS = COS(SNGL(2.0D0 * PIVD))
WRITE (NUVI, 919) BVS
WRITE (NUVI, 7910)
911 FORMAT( 9H0 X= 0.0 ,5X,15H+1.000000000000 /14X, F10.7)
912 FORMAT( 9H0 X= 1.0 ,5X,15H+0.540302305868 /14X, F10.7)
913 FORMAT( 9H0 X= 2.0 ,5X,15H-0.416146836547 /14X, F10.7)
914 FORMAT( 9H0 X= 3.0 ,5X,15H-0.989992496600 /14X, F10.7)
915 FORMAT( 9H0 X= (PI),5X,15H-1.000000000000 /14X, F10.7)
916 FORMAT(9H0 X= 4.0 ,5X,15H-0.653643620864 /14X, F10.7)
917 FORMAT( 9H0 X= 5.0 ,5X,15H+0.283662185463 /14X, F10.7)
918 FORMAT( 9H0 X= 6.0 ,5X,15H+0.960170286650 /14X, F10.7)
919 FORMAT( 9H0 X=(2PI),5X,15H+1.000000000000 /14X, F10.7)
7910 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO ,8H7 DIGITS)
C***** END OF TEST SEGMENT 091
C***** WHEN EXECUTING ONLY SEGMENT 091, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DPCOS - (092)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - DCOS - 8.3.3
C***** TRIGONOMETRIC COSINE -TYPE DOUBLE PRECISION TABLE 4
C***** SAME AS SEGMENT 091 EXCEPT D.P.
C***** INTRINSIC FUNCTION DMAX1 ASSUMED WORKING
C***** ARGUMENTS FROM 0 TO 2 PI
C*****
C***** S P E C I F I C A T I O N S SEGMENT 092
C*****
C***** WHEN EXECUTING ONLY SEGMENT 092, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AVD, BVD, CVD, DVD, EVD, FVD, GVD, PIVD, XVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 092, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
920 FORMAT(15H1 DPCOS - (092)//32H BASIC EXTERNAL FUNCTION -DCOS-
1//35H (TRIGONOMETRIC COSINE -TYPE D.P.)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 920)
AVD = 3.140625D+0
BVD = 0.9613037109375D-3
CVD = 0.57220458984375D-5
DVD = 0.596046447753906D-6
EVD = 0.31786509547056D-7
C*****PI IS SUM OF AVD TO EVD, PARTS ARE EXPRESSED IN SUMS OF POWERS OF
C*****2, TO PERMIT A POSSIBLE 20 DECIMAL DIGIT ARGUMENT TO BE CREATED
PIVD = EVD + DVD + CVD + BVD + AVD
FVD = 1.0D0
GVD = 2.0D0
XVD = DCOS(GVD - 2.0D0 * FVD)
WRITE (NUVI, 921) XVD
XVD = DCOS(FVD)
WRITE (NUVI, 922) XVD
XVD = DCOS(GVD)
WRITE (NUVI, 923) XVD
XVD = DCOS(GVD + FVD)
WRITE (NUVI, 924) XVD
XVD = DCOS(PIVD)
WRITE (NUVI, 925) XVD
XVD = DCOS(2. * GVD)
WRITE (NUVI, 926) XVD
XVD = DCOS(2.0 + FVD + GVD)
WRITE (NUVI, 927) XVD
XVD = DCOS(GVD * (FVD + GVD))
WRITE (NUVI, 928) XVD
XVD = DCOS(DMAX1(2.0D0 * PIVD, GVD))
WRITE (NUVI, 929) XVD
WRITE (NUVI, 7992)
921 FORMAT(9H0 X= 0.0 ,31H +0.10000000000000000000000D+01 / D31.14)
922 FORMAT(9H0 X= 1.0 ,31H +0.54030230586813971740094D+00 /D31.14)
923 FORMAT(9H0 X= 2.0 ,31H -0.41614683654714238699757D+00 / D31.14)
924 FORMAT(9H0 X= 3.0 ,31H -0.98999249660044545727157D+00 / D31.14)
925 FORMAT(9H0 X= (PI),31H -0.10000000000000000000000D+01 / D31.14)
926 FORMAT(9H0 X= 4.0 ,31H -0.65364362086361191463917D+00 / D31.14)
927 FORMAT(9H0 X= 5.0 ,31H +0.28366218546322626446664D+00 / D31.14)
928 FORMAT(9H0 X= 6.0 ,31H +0.96017028665036602054565D+00 / D31.14)
929 FORMAT(9H0 X=(2PI),31H +0.10000000000000000000000D+01 / D31.14)
7992 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
A PRINTED TO ,9H14 DIGITS)
C***** END OF SEGMENT 092
C***** WHEN EXECUTING ONLY SEGMENT 092, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
nbs08.d 480890336 170 2 100666 284 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2. DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4. DOUBLE SPACE ON OUTPUT. ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6. DOUBLE SPACE ON OUTPUT. ID 6
nbs08.f 480887337 170 2 100666 39377 `
C***** PART8 *****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 8 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** TANGH - 094 TANH
C*****
C***** SQROT - 095 SQRT
C*****
C***** DSQRO - 096 DSQRT
C*****
C***** CSQRO - 097 CSQRT
C*****
C***** ARCTG - 098 ATAN
C*****
C***** DACTG - 099 DATAN
C*****
C***** ACTG2 - 100 ATAN2
C*****
C***** DATN2 - 101 DATAN
C*****
C***** DMODA - 102 DMOD
C*****
C***** CABSA - 103 CABS
C*****
C***** BSFTS - 110 STATEMENT FUNCTIONS (REAL AND INTEGER)
C*****
C***** BSFDF - 005 STATEMENT FUNCTION DEFINITIONS
C*****
C***** FSFTS - 111 STATEMENT FUNCTIONS (D.P., COMPLEX AND LOGICAL)
C*****
C***** FSFDF - 006 STATEMENT FUNCTION DEFINITIONS
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN SEGMENTS
C***** 094, 095, 096, 097, 098, 099, 100, 101, 102, 103, 110
C***** AND 111 ARE RUN AS ONE MAIN PROGRAM.
C*****
INTEGER IFIX
REAL ABS, SQRT
DOUBLE PRECISION BVD, AVD, CVD, DVD, EVD, FVD, GVD
DOUBLE PRECISION DPAFD,DPBFD,DPCFD,DPDFD,DPFFD,DPGFD,DPEFD,DPHFD
1 , DPAVD, DPBVD, DPCVD, DPDVD, DAWVD, DBWVD, DCWVD
DOUBLE PRECISION DPA1D(5),FC2D(5,5)
COMPLEX CHAVC,CHBVC,CHCVC,CHDVC,CHEVC,CHFVC, EP1C(30), AVC, BVC
COMPLEX CHAFC, CHBFC, CHCFC, CHDFC,CAWVC, CBWVC
LOGICAL A3B(2,2,2)
LOGICAL MCFVB, MCHVB, ABFB, BCFB, IEFB, KLFB
- ,MCEVB,MCIVB,MCKVB,ATVB,AWVB,BWVB,CWVB,DWVB,EWVB,SWVB,TWVB
DOUBLE PRECISION DBLE, DEXP
COMPLEX CMPLX, CEXP
C*****
C***** END OF SPECIFICATIONS FOR SEGMENTS
C***** 094, 095, 096, 097, 098, 099, 100, 101, 102, 103, 110, 111
C***********************************************************************
C*****
C***** BSFDF - (005)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** DEFINING STATEMENT FUNCTIONS THAT ARE TO BE TESTED
C***** IN SEGMENT 110 (BASIC FORTRAN) AND 111 (FULL FORTRAN) 8.1.1
C***** HEADER FOR SEGMENT 005
C***** DEFINING EXPRESSION CONTAINS CONSTANTS AND VARIABLES
CMAFS(CAWVS,CBWVS) = CAWVS * 2. + CBWVS
CMBFS(MAWVI,MBWVI,MCWVI) =(MAWVI + MBWVI + MCWVI)/3
MCAFI(MAWVI,MBWVI) = MAWVI ** MBWVI
MCBFI(CAWVS,CBWVS,CCWVS) = (CAWVS + CBWVS + CCWVS) * 2.0
C***** DEFINING EXPRESSION CONTAINS CONSTANTS, VARIABLES AND
C***** INTRINSIC FUNCTIONS
CMCFS(CAWVS,CBWVS,CCWVS) = ABS(CAWVS**2 - (CBWVS+CCWVS)**2)
CMDFS(MAWVI,MBWVI) = ISIGN((MAWVI+MBWVI),(MAWVI-MBWVI))
MCCFI(MAWVI,MBWVI,CAWVS) = MAWVI**2 + MBWVI**2 + IFIX(CAWVS)**2
MCDFI(CAWVS,CBWVS,CCWVS,CDWVS,CEWVS) = (CAWVS + CBWVS + CCWVS +
1CDWVS +CEWVS) ** (ABS(CAWVS))
C***** DEFINING EXPRESSION CONTAINS PREVIOUSLY DEFINED STATEMENT
C***** FUNCTIONS AND/OR EXTERNAL FUNCTION REFERENCES
CMEFS(CAWVS,CBWVS) = CMBFS(1,2,3) + SQRT((CAWVS + CBWVS))
CMFFS(MAWVI,MBWVI,MCWVI) = MCCFI(MAWVI,MBWVI,3.0) + MCWVI **2
MCEFI(MAWVI,MBWVI) = MCAFI(MAWVI,MBWVI) ** MCAFI(MAWVI,MBWVI)
MCFFI(CAWVS,CBWVS,CCWVS) = SQRT(CAWVS) + SQRT(CBWVS) + EXP(CCWVS)
C***** DEFINING EXPRESSION CONTAINS CONSTANTS, VARIABLES, INTRINSIC
C***** OR EXTERNAL FUNCTION REFERENCES AND PREVIOUSLY DEFINED
C***** STATEMENT FUNCTIONS.
CMGFS(MAWVI,MBWVI,CAWVS,CBWVS) = FLOAT(MAWVI ** 2) - CMAFS(CAWVS,
1CBWVS) + SQRT((FLOAT(MAWVI + MBWVI)))
MCGFI(MAWVI,MBWVI,MCWVI,CAWVS) = MCEFI(MAWVI,MBWVI) - MCEFI(MAWVI,
1MCWVI) + IFIX(EXP(CAWVS))
C***** END OF TEST SEGMENT 005
C***********************************************************************
C*****
C***** FSFDF - (006)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** DEFINING STATEMENT FUNCTIONS THAT ARE TO BE TESTED 8.1.1
C***** IN SEGMENT 111 (FULL FORTRAN STATEMENT FUNCTION TEST)
C***** HEADER FOR SEGMENT 006
C***** D.P. STATEMENT FUNCTIONS CONTAINING CONSTANTS AND VARIABLES
DPAFD(DAWVD,DBWVD) = (DAWVD + DBWVD) ** 2
DPBFD(DAWVD,DBWVD,DCWVD) = (DAWVD + DBWVD - DCWVD) ** 3
DPCFD(DAWVD,DBWVD,DCWVD) = 3.0D0 * (DAWVD + DBWVD + DCWVD)/2.D0
C***** D.P. STATEMENT FUNCTIONS CONTAINING CONSTANTS, VARIABLES
C***** AND INTRINSIC FUNCTION REFERENCES
DPDFD(DAWVD,DBWVD) = DSIGN(DAWVD, -(DBWVD))
DPEFD(DAWVD,DBWVD,CAWVC,CAWVS) = DBLE(CAWVS + AIMAG(CAWVC))
1+ DMAX1(DAWVD,DBWVD + 1.D0)
C***** D.P. STATEMENT FUNCTIONS CONTAINING CONSTANTS, VARIABLES,
C***** INTRINSIC FUNCTION AND PREVIOUSLY DEFINED STATEMENT FUNCTION
C***** REFERENCES
DPFFD(DAWVD,DBWVD,CAWVS) = DPAFD(DAWVD,DBWVD) -(2.D0 * DAWVD *
1 DBWVD) + (DBLE(CAWVS) * 2.D0 )
DPGFD(DAWVD,DBWVD,CAWVS,CAWVC) = DPBFD(DAWVD,DBWVD,DBLE(CAWVS))
1 - DBLE(AIMAG(CAWVC)) + 5.0D0
C***** D.P. STATEMENT FUNCTIONS CONTAINING CONSTANTS, VARIABLES,
C***** INTRINSIC FUNCTION, PREVIOUSLY DEFINED STATEMENT FUNCTION
C***** AND EXTERNAL FUNCTION REFERENCES
DPHFD(DAWVD,DBWVD,CAWVS) = DPFFD(DAWVD,DBWVD +1.0D0, CAWVS) * 2.D0
1 + DEXP(DAWVD) - (DBLE(CAWVS) * 2 .D0)-DEXP(DAWVD)
C***** COMPLEX STATEMENT FUNCTIONS CONTAINING CONSTANTS AND VARIABLES
CHAFC(CAWVC,CBWVC) = CAWVC * (2.0,2.0) + CBWVC + (2.0,2.0)
C***** COMPLEX STATEMENT FUNCTION CONTAINING CONSTANTS, VARIABLES,
C***** AND INTRINSIC FUNCTION REFERENCES
CHBFC(CAWVC,CBWVC,CAWVS) = CAWVC - CBWVC + CMPLX(CAWVS,CAWVS)
C***** COMPLEX STATEMENT FUNCTION CONTAINING CONSTANTS,
C***** VARIABLES, INTRINSIC AND EXTERNAL FUNCTION REFERENCES
CHCFC(CAWVC,CBWVC,CAWVS,CBWVS) = (CAWVC - CBWVC) + CEXP (CMPLX
1 (CAWVS,CBWVS)) - CMPLX(CAWVS,CBWVS)
C***** COMPLEX STATEMENT FUNCTION CONTAINING CONSTANTS, VARIABLES,
C***** INTRINSIC, EXTERNAL AND PREVIOUSLY DEFINED STATEMENT FUNCTION
C***** REFERENCES
CHDFC(CAWVC,CBWVC,CAWVS,CBWVS) = CHCFC(CAWVC,CBWVC,CAWVS +CAWVS,
1 2.0 * CBWVS) + CMPLX(1.0,2.0)
C***** STATEMENT FUNCTION CONTAINING LOGICAL VARIABLES
ABFB(AWVB, BWVB, DWVB) = AWVB .AND. BWVB .OR. .FALSE..AND.DWVB
C***** STATEMENT FUNCTION CONTAINING CONSTANTS, VARIABLES AND
C***** INTRINSIC FUNCTIONS
BCFB(EWVB,CWVB,BAWVS,BCWVS) = EWVB .AND.(BAWVS * ABS(BCWVS) .GT.
1 0.5).AND..NOT. CWVB
C***** STATEMENT FUNCTION CONTAINING PREVIOUSLY DEFINED STATEMENT
C***** FUNCTION AND AN INTRINSIC FUNCTION REFERENCE
IEFB(EWVB,ATVB,CWVB,BAWVS,BCWVS) = ATVB .AND.EWVB .AND. CWVB .OR.
1 AMAX1(BAWVS,BCWVS) .GT. 600. .OR. BCFB (EWVB,CWVB,BAWVS,BCWVS)
C***** STATEMENT FUNCTION CONTAINING BASIC EXTERNAL FUNCTION REFERENCE
KLFB(SWVB,TWVB,ATVB,BAWVS) = SWVB .AND..NOT. TWVB.OR.(SQRT(BAWVS)
1 .GT. 9.0) .OR. ATVB
C***** END OF TEST SEGMENT 006
C***********************************************************************
C*****
C***** TANGH - 094
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - TANH - 8.3.3
C***** HYPERBOLIC TANGENT -TYPE REAL
C***** USED IN SIMPLE ARITHMETIC EXPRESSIONS
C***** INTRINSIC FUNCTIONS ABS,FLOAT,AMINO,AMAX0,INT
C***** ASSUMED WORKING
C***** ARGUMENTS FROM 0.0 TO 8.0
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 8 ///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
940 FORMAT(15H1 TANGH - (094)//32H BASIC EXTERNAL FUNCTION -TANH-
1//33H (HYPERBOLIC TANGENT -TYPE REAL)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 940)
C***** HEADER FOR SEGMENT 094 WRITTEN
AVS = 2.0
CVS = -0.5
IVI = 6
BVS = TANH(FLOAT(IVI) - 3.0 * AVS)
WRITE (NUVI, 941) BVS
BVS = TANH(AVS)
WRITE (NUVI, 942) BVS
BVS = TANH(AVS + ABS(CVS))
WRITE (NUVI, 943) BVS
BVS = TANH(AMIN0(IVI,8) - AVS)
WRITE (NUVI, 944) BVS
BVS = TANH(AMAX0(IVI,INT(AVS)))
WRITE (NUVI, 945) BVS
BVS = TANH(AVS ** 4 / AVS)
WRITE (NUVI, 946) BVS
WRITE (NUVI, 947)
941 FORMAT(7H0 X=0.0,5X,12H0.0000000000 /F21.7)
942 FORMAT(7H0 X=2.0,5X,12H0.9640275801 /F21.7)
943 FORMAT(7H0 X=2.5,5X,12H0.9866142982 /F21.7)
944 FORMAT(7H0 X=4.0,5X,12H0.9993292997 /F21.7)
945 FORMAT(7H0 X=6.0,5X,12H0.9999877117 /F21.7)
946 FORMAT(7H0 X=8.0,5X,12H0.9999997749 /F21.7)
947 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO , 8H7 DIGITS )
C***** END OF TEST SEGMENT 094
C***** WHEN EXECUTING ONLY SEGMENT 094, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** SQROT - (095)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - SQRT - 8.3.3
C***** (SQUARE ROOT - TYPE REAL) TABLE 4
C***** USED IN SIMPLE ARITHMETIC EXPRESSIONS
C***** INTRINSIC FUNCTIONS FLOAT,INT,AMIN0,MAX0
C***** ASSUMED WORKING
C***** ARGUMENTS ARE ALL PRIME NUMBERS
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 095, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
950 FORMAT(15H1 SQROT - (095)//32H BASIC EXTERNAL FUNCTION -SQRT-
1//26H (SQUARE ROOT -TYPE REAL)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 950)
C***** HEADER FOR SEGMENT 095 WRITTEN
AVS = 2.0
IVI = 3
CVS = 17.0
BVS = SQRT(FLOAT(( IVI + INT(AVS)) / 2))
WRITE (NUVI, 951) BVS
BVS = SQRT(AMIN0(MAX0(IVI,2), INT(CVS)))
WRITE (NUVI, 952) BVS
BVS = SQRT(CVS)
WRITE (NUVI, 953) BVS
BVS = SQRT(2.0 * CVS - FLOAT(IVI))
WRITE (NUVI, 954) BVS
BVS = SQRT(FLOAT(IVI + 1) + 5.0 * CVS)
WRITE (NUVI, 955) BVS
WRITE (NUVI, 956)
951 FORMAT ( 8H0 X= 2.0,4X,16H1.41421356237310 / F21.7)
952 FORMAT ( 8H0 X= 3.0,4X,16H1.73205080756888 / F21.7)
953 FORMAT ( 8H0 X=17.0,4X,16H4.12310562561766 / F21.7)
954 FORMAT ( 8H0 X=31.0,4X,16H5.56776436283002 / F21.7)
955 FORMAT ( 8H0 X=89.0,4X,16H9.43398113205660 / F21.7)
956 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO , 8H7 DIGITS )
C***** END OF TEST SEGMENT 095
C***** WHEN EXECUTING ONLY SEGMENT 095, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DSQRO - (096)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - DSQRT - 8.3.3
C***** (SQUARE ROOT - TYPE D.P.) TABLE 4
C***** USED IN SIMPLE EXPRESSIONS
C***** INTRINSIC FUNCTIONS DBLE,IABS,FLOAT ASSUMED WORKING
C***** ARGUMENTS ARE ALL PRIME NUMBERS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 096
C*****
C***** WHEN EXECUTING ONLY SEGMENT 096, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION BVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 096, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
960 FORMAT(15H1 DSQRO - (096)//33H BASIC EXTERNAL FUNCTION -DSQRT-
1//26H (SQUARE ROOT -TYPE D.P.)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
WRITE (NUVI, 960)
C***** HEADER FOR SEGMENT 096 WRITTEN
AVS = 3.0
IVI = -2
CVS = 17.0
BVD = DSQRT(DBLE(FLOAT(IABS(IVI)) + AVS - 3.0))
WRITE (NUVI, 961) BVD
BVD = DSQRT(0.0D0 + AVS)
WRITE (NUVI, 962) BVD
BVD = DSQRT(CVS - AVS + 3.0D0)
WRITE (NUVI, 963) BVD
BVD = DSQRT(2.0D0 * CVS - DBLE(AVS))
WRITE (NUVI, 964) BVD
BVD = DSQRT(DBLE(FLOAT(-IVI)+ AVS) * CVS + FLOAT(IVI ** 2))
WRITE (NUVI, 965) BVD
WRITE (NUVI, 966)
961 FORMAT ( 8H0 X= 2.0,5X,25H1.4142135623730950488D+00/8X,1PD24.13)
962 FORMAT ( 8H0 X= 3.0,5X,25H1.7320508075688772935D+00/8X,1PD24.13)
963 FORMAT ( 8H0 X=17.0,5X,25H4.1231056256176605498D+00/8X,1PD24.13)
964 FORMAT ( 8H0 X=31.0,5X,25H5.5677643628300219221D+00/8X,1PD24.13)
965 FORMAT ( 8H0 X=89.0,5X,25H9.4339811320566038113D+00/8X,1PD24.13)
966 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
A PRINTED TO ,9H14 DIGITS)
C***** END OF TEST SEGMENT 096
C***** WHEN EXECUTING ONLY SEGMENT 096, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CSQRO - (097)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C*****
C***** TO TEST BASIC EXTERNAL FUNCTION -CSQRT- 8.3.3
C***** (SQUARE ROOT OF A COMPLEX NUMBER ) TABLE 4
C***** ARGUMENTS ARE EP1C(11) TO EP1C(20)
C***** EXPECTED RESULTS ARE EP1C(1) TO EP1C(10)
C***** S P E C I F I C A T I O N S SEGMENT 097
C*****
C***** WHEN EXECUTING ONLY SEGMENT 097 THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX EP1C(30), AVC, BVC
C*****
C***** O U T P U T - T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 097, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI, 970)
970 FORMAT(15H1 CSQRO - (097)//33H BASIC EXTERNAL FUNCTION -CSQRT-
1//29H (SQUARE ROOT -TYPE COMPLEX)//27H ASA REF.- 8.3.3 (TABLE 4)
2//24H LINE 1 OF EACH PAIR IS /20H THE EXPECTED VALUE //9H RESUL
3T )
C***** INITIALIZE EP1C (EXACT VALUES)
EP1C(1) = (0.9950042,0.0998334)
EP1C(2) = (0.9800666,0.1986693)
EP1C(3) = (0.9553365,0.2955202)
EP1C(4) = (0.9210610,0.3894183)
EP1C(5) = (0.8775826,0.4794255)
EP1C(6) = (0.8253356,0.5646425)
EP1C(7) = (0.7648422,0.6442177)
EP1C(8) = (0.6967067,0.7173561)
EP1C(9) = (0.5403023,0.8414710)
EP1C(10) = (0.4161468,-0.9092974)
EP1C(11) = (0.9800666,0.1986693)
EP1C(12) = (0.9210610,0.3894183)
EP1C(13) = (0.8253356,0.5646425)
EP1C(14) = (0.6967067,0.7173561)
EP1C(15) = (0.5403023,0.8414710)
EP1C(16) = (0.3623577,0.9320391)
EP1C(17) = (0.1699671,0.9854497)
EP1C(18) = (-0.0291995,0.9995736)
EP1C(19) = (-0.4161468,0.9092974)
EP1C(20) = (-0.6536436,-0.7568025)
IVI = 0
971 JVI = 1
972 IVI = IVI + 1
JVI = JVI + 1
AVC = CSQRT(EP1C(IVI + 10) * (10. ** ((2 * JVI) - 8)))
BVC = EP1C(IVI) * 10. ** (JVI - 4)
WRITE (NUVI, 973) BVC, AVC
973 FORMAT( 2H0 2E14.7/2X,2E14.7)
IF (JVI - 6) 972, 974, 974
974 IF (IVI - 10) 971, 975, 975
975 WRITE (NUVI, 976)
976 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/13H CALCULATION
1)
C***** END OF TEST SEGMENT 097
C***** WHEN EXECUTING ONLY SEGMENT 097 THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ARCTG - (098)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - ATAN - 8.3.3
C***** (TRIGONOMETRIC ARCTANGENT, SINGLE ARGUMENT -TYPE REAL)TABLE 4
C***** USED IN SIMPLE ARITHMETIC EXPRESSIONS
C***** INTRINSIC FUNCTION ABS,FLOAT,AMAX1,INT
C***** ASSUMED WORKING
C***** ARGUMENTS ARE POWERS (OR SUMS) OF 2
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 098, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI, 980)
980 FORMAT(15H1 ARCTG - (098)//32H BASIC EXTERNAL FUNCTION -ATAN-
1//25H (ARCTANGENT -TYPE REAL)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
C***** HEADER FOR SEGMENT 098 WRITTEN
AVS = .125
CVS = -.25
IVI = 2
BVS = ATAN(AMAX1(AVS,CVS))
WRITE (NUVI, 981) BVS
BVS = ATAN(AVS * 2.0)
WRITE(NUVI, 982) BVS
BVS = ATAN (ABS(CVS) + AVS)
WRITE(NUVI, 983) BVS
BVS = ATAN(-CVS * AMAX0(IVI, INT(AVS)))
WRITE(NUVI, 984) BVS
BVS = ATAN (FLOAT(IVI) * CVS - (2.0 * AVS))
WRITE (NUVI, 985) BVS
BVS = ATAN(1.0)
WRITE (NUVI, 986) BVS
WRITE (NUVI, 987)
981 FORMAT(10H0 X= 0.125,5X,15H 0.124354994547,/10X,F15.7)
982 FORMAT(10H0 X= 0.250,5X,15H 0.244978663127,/10X,F15.7)
983 FORMAT(10H0 X= 0.375,5X,15H 0.358770670271,/10X,F15.7)
984 FORMAT(10H0 X= 0.500,5X,15H 0.463647609001,/10X,F15.7)
985 FORMAT(10H0 X=-0.750,5X,15H-0.643501108793,/10X,F15.7)
986 FORMAT(10H0 X= 1.000,5X,15H 0.785398163397,/10X,F15.7)
987 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO ,8H7 DIGITS )
C***** END OF TEST SEGMENT 098
C***** WHEN EXECUTING ONLY SEGMENT 098, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DACTG - (099)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - DATAN - 8.3.3
C***** (TRIGONOMETRIC ARCTANGENT,SINGLE ARGUMENT -TYPE D.P.) TABLE 4
C***** USED IN SIMPLE ARITHMETIC EXPRESSIONS
C***** INTRINSIC FUNCTIONS DSIGN,FLOAT,DBLE ASSUMED WORKING
C***** ARGUMENTS ARE POWERS (OR SUMS) OF 2
C*****
C***** S P E C I F I C A T I O N S SEGMENT 099
C*****
C***** WHEN EXECUTING ONLY SEGMENT 099, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AVD, BVD, CVD
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 099, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
C***** HEADER FOR SEGMENT 099 WRITTEN
WRITE(NUVI, 990)
990 FORMAT(15H1 DACTG - (099)//33H BASIC EXTERNAL FUNCTION -DATAN-
1//25H (ARCTANGENT -TYPE D.P.)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
AVD = -.125D0
CVD = .25D0
IVI = 2
BVD = DATAN(DSIGN(AVD,CVD))
WRITE (NUVI, 991) BVD
BVD = DATAN(2.0 * (-AVD))
WRITE(NUVI, 992) BVD
BVD = DATAN(CVD - AVD)
WRITE(NUVI, 993) BVD
BVD = DATAN(DBLE(FLOAT(IVI) / 4.0))
WRITE (NUVI, 994) BVD
BVD = DATAN (DSIGN(1.0D0 - CVD, AVD))
WRITE(NUVI, 995) BVD
BVD = DATAN(DBLE(FLOAT(IVI ** 2)) * CVD)
WRITE (NUVI, 996) BVD
WRITE (NUVI, 997)
991 FORMAT(10H0 X= 0.125,5X,19H 0.124354994547D+00 /10X,D24.12)
992 FORMAT(10H0 X= 0.250,5X,19H 0.244978663127D+00 /10X,D24.12)
993 FORMAT(10H0 X= 0.375,5X,19H 0.358770670271D+00 /10X,D24.12)
994 FORMAT(10H0 X= 0.500,5X,19H 0.463647609001D+00 /10X,D24.12)
995 FORMAT(10H0 X=-0.750,5X,19H-0.643501108793D+00 /10X,D24.12)
996 FORMAT(10H0 X= 1.000,5X,19H 0.785398163397D+00 /10X,D24.12)
997 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO ,9H12 DIGITS )
C***** END OF TEST SEGMENT 099
C***** WHEN EXECUTING ONLY SEGMENT 099, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** ACTG2 - (100)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - ATAN2 - 8.3.3
C***** (TRIGONOMETRIC ARCTANGENT, TWO ARGUMENTS -TYPE REAL) TABLE 4
C***** USED IN SIMPLE ARITHMETIC EXPRESSIONS
C***** INTRINSIC FUNCTIONS AMIN1,FLOAT,AMAX0 ASSUMED WORKING
C***** ARGUMENTS ARE POWERS (OR SUMS) OF 2
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENTS. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 100, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE(NUVI, 1000)
1000 FORMAT(15H1 ACTG2 - (100)//33H BASIC EXTERNAL FUNCTION -ATAN2-
1//37H (ARCTANGENT, 2 ARGUMENT -TYPE REAL)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
AVS = .125
CVS = -.25
IVI = 2
BVS = ATAN2(ABS(AMIN1(AVS,CVS)),FLOAT(IVI))
WRITE (NUVI, 1001) BVS
BVS = ATAN2(CVS ** 2, AVS * 2.0)
WRITE (NUVI, 1002) BVS
BVS = ATAN2 (AVS - CVS, -(4.0 * CVS))
WRITE (NUVI, 1003) BVS
BVS = ATAN2(-CVS/AVS, AMAX0(IVI,4))
WRITE (NUVI, 1004) BVS
BVS = ATAN2(-.09375,AVS)
WRITE (NUVI, 1005) BVS
BVS = ATAN2(FLOAT(IVI), 2.0)
WRITE (NUVI, 1006) BVS
WRITE (NUVI, 1007)
1001 FORMAT(10H0 X= 0.125,5X,15H 0.124354994547,/10X,F15.7)
1002 FORMAT(10H0 X= 0.250,5X,15H 0.244978663127,/10X,F15.7)
1003 FORMAT(10H0 X= 0.375,5X,15H 0.358770670271,/10X,F15.7)
1004 FORMAT(10H0 X= 0.500,5X,15H 0.463647609001,/10X,F15.7)
1005 FORMAT(10H0 X=-0.750,5X,15H-0.643501108793,/10X,F15.7)
1006 FORMAT(10H0 X= 1.000,5X,15H 0.785398163397,/10X,F15.7)
1007 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO ,8H7 DIGITS )
C***** END OF TEST SEGMENT 100
C***** WHEN EXECUTING ONLY SEGMENT 100, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DATN2 - (101)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - DATAN2 - 8.3.3
C***** (TRIGONOMETRIC ARCTANGENT, TWO ARGUMENT -TYPE D.P.) TABLE 4
C***** USED IN SIMPLE ARITHMETIC EXPRESSIONS
C***** INTRINSIC FUNCTIONS DMIN1,DMAX1,DSIGN,DBLE,FLOAT
C***** ASSUMED WORKING
C***** ARGUMENTS ARE POWERS (OR SUMS) OF 2
C*****
C***** S P E C I F I C A T I O N S SEGMENT 101
C*****
C***** WHEN EXECUTING ONLY SEGMENT 101, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS
C***** 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AVD, BVD, CVD
C*****
C***** O U T P U T - T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE
C*****
C***** WHEN EXECUTING ONLY SEGMENT 101, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI, 1010)
1010 FORMAT(15H1 DATN2 - (101)//36H BASIC EXTERNAL FUNCTION -DATAN2-
1//37H (ARCTANGENT, 2 ARGUMENT -TYPE D.P.)
2//27H ASA REF.- 8.3.3 (TABLE 4)//24H LINE 1 OF EACH PAIR IS/23H
3 HOLLERITH INFORMATION//9H RESULTS)
AVD = .125
CVD = -.25
IVI = 2
BVD = DATAN2( DMIN1( AVD,-CVD), 2.0D0/ DBLE(FLOAT(IVI)))
WRITE (NUVI, 1011) BVD
BVD = DATAN2( AVD, FLOAT( IVI) * (-CVD))
WRITE (NUVI, 1012) BVD
BVD = DATAN2 (DSIGN(2.0D0 * CVD + AVD, AVD), DMAX1(AVD,CVD,1.0D0))
WRITE (NUVI, 1013) BVD
BVD = DATAN2(DMIN1(AVD,.0625D0),DMAX1(AVD,CVD))
WRITE (NUVI, 1014) BVD
BVD = DATAN2(DABS(CVD) * DSIGN(AVD, CVD) * 6.D0, .25D0)
WRITE (NUVI, 1015) BVD
BVD = DATAN2 (DBLE(FLOAT(IVI)),AVD * FLOAT(IVI **4))
WRITE (NUVI, 1016) BVD
WRITE (NUVI, 1017)
1011 FORMAT(10H0 X= 0.125,5X,19H 0.124354994547D+00 /10X,D24.12)
1012 FORMAT(10H0 X= 0.250,5X,19H 0.244978663127D+00 /10X,D24.12)
1013 FORMAT(10H0 X= 0.375,5X,19H 0.358770670271D+00 /10X,D24.12)
1014 FORMAT(10H0 X= 0.500,5X,19H 0.463647609001D+00 /10X,D24.12)
1015 FORMAT(10H0 X=-0.750,5X,19H-0.643501108793D+00 /10X,D24.12)
1016 FORMAT(10H0 X= 1.000,5X,19H 0.785398163397D+00 /10X,D24.12)
1017 FORMAT(//37H LINE 2 OF EACH PAIR IS THE FUNCTION/25H CALCULATION
1 PRINTED TO ,9H12 DIGITS )
C***** END OF TEST SEGMENT 101
C***** WHEN EXECUTING ONLY SEGMENT 101 THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DMODA - (102)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BASIC EXTERNAL FUNCTION - DMOD - 8.3.3
C***** (REMAINDERING -TYPE DOUBLE PRECISION) TABLE 4
C***** INTRINSIC FUNCTIONS DBLE,FLOAT,IDINT, ASSUMED WORKING
C*****
C***** S P E C I F I C A T I O N S SEGMENT 102
C*****
C***** WHEN EXECUTING ONLY SEGMENT 102, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION AVD,BVD,CVD,DVD,EVD,FVD,GVD
C*****
C***** O U T P U T - T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 102 THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI, 1020)
1020 FORMAT(15H1 DMODA - (102)//32H BASIC EXTERNAL FUNCTION -DMOD-
1//39H (REMAINDERING -TYPE DOUBLE PRECISION)//27H ASA REF.- 8.3.3
2 (TABLE 4)// 9H RESULTS)
AVD = 16.0625D0
BVD = -4.0D0
CVD = -8.125D0
DVD = 2.5D0
EVD = -1.0D0
FVD = 1.0D0
FVD = DMOD(AVD, BVD)
GVD = FVD - 0.0625D0
WRITE (NUVI, 1021) GVD
FVD = 2.0D0
FVD = DMOD(CVD, DVD)
GVD = FVD + 0.625D0
WRITE (NUVI, 1021) GVD
FVD = 3.0D0
FVD = DMOD(BVD, EVD)
GVD = FVD + 0.0D0
WRITE (NUVI, 1021) GVD
FVD = 4.0D0
FVD = DMOD(BVD, AVD)
GVD = FVD - (BVD-(DBLE(FLOAT(IDINT(BVD/AVD)))) * AVD)
WRITE (NUVI, 1021) GVD
WRITE (NUVI, 1022)
1021 FORMAT(//D25.14)
1022 FORMAT(//18H END OF DMOD TEST//40H ALL ABOVE ANSWERS SHOULD BE 0
1 FOR THIS/32H TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 102
C***** WHEN EXECUTING ONLY SEGMENT 102 THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CABSA - (103)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** .TO TEST BASIC EXTERNAL FUNCTION -CABS- 8.3.3
C***** (MODULUS OF A COMPLEX NUMBER) TABLE 4
C***** ARGUMENTS ARE ARRAY EP1C(30), FUNCTIONS FROM
C***** ODD NUMBERED ARGUMENTS PRINTED AS SET 1 AND 2
C***** FROM EVEN NUMBERED ARGUMENTS
C***** SET 1 RESULTS SHOULD BE .1 E-6 TO .1 E+8
C***** SET 2 RESULTS SHOULD BE .5 E-6 TO .5 E+8
C*****
C***** S P E C I F I C A T I O N S SEGMENT 103
C*****
C***** WHEN EXECUTING ONLY SEGMENT 103 THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX EP1C(30)
C*****
C***** O U T P U T - T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 103 THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI, 1030)
1030 FORMAT(15H1 CABSA - (103)//32H BASIC EXTERNAL FUNCTION -CABS-
1//31H (MODULUS OF A COMPLEX NUMBER)//27H ASA REF.- 8.3.3 (TABLE
24)//9H RESULTS//10X,5HSET 1,15X,5HSET 2 )
C*****INITIALIZE EP1C(EXACT VALUES)
EP1C(1) = (0.5E-7,-0.866025E-7)
EP1C(2) = (2.5E-7,-4.330125E-7)
EP1C(3) = (1.E-6,0.0)
EP1C(4) = (5.E-6,0.0)
EP1C(5) = (0.5E-5,0.866025E-5)
EP1C(6) = (2.5E-5,4.330125E-5)
EP1C(7) = (-0.5E-4,0.866025E-4)
EP1C(8) = (-2.5E-4,4.330125E-4)
EP1C(9) = (-1.E-3,0.0)
EP1C(10) = (-5.E-3,0.0)
EP1C(11) = (-0.5E-2,-0.866025E-2)
EP1C(12) = (-2.5E-2,-4.330125E-2)
EP1C(13) = (0.5E-1,-0.866025E-1)
EP1C(14) = (2.5E-1,-4.330125E-1)
EP1C(15) = (1.0,0.0)
EP1C(16) = (5.0,0.0)
EP1C(17) = (0.5E1,0.866025E1)
EP1C(18) = (2.5E1,4.330125E1)
EP1C(19) = (-0.5E2,0.866025E2)
EP1C(20) = (-2.5E2,4.330125E2)
EP1C(21) = (-1.E3,0.0)
EP1C(22) = (-5.E3,0.0)
EP1C(23) = (-0.5E4,-0.866025E4)
EP1C(24) = (-2.5E4,-4.330125E4)
EP1C(25) = (0.5E5,-0.866025E5)
EP1C(26) = (2.5E5,-4.330125E5)
EP1C(27) = (1.E6,0.0)
EP1C(28) = (5.E6,0.0)
EP1C(29) = (0.5E7,0.866025E7)
EP1C(30) = (2.5E7,4.330125E7)
IVI = - 1
1031 IVI = IVI + 2
AVS = CABS (EP1C(IVI))
BVS = CABS (EP1C(IVI + 1))
WRITE (NUVI, 1032) AVS, BVS
1032 FORMAT(1H0, E17.6, 2X, E17.6)
IF (IVI - 29) 1031, 1033, 1033
1033 WRITE (NUVI, 1034)
1034 FORMAT(//39H VALUES IN EACH SET SHOULD BE POSITIVE /39H .1 FOR S
1ET 1 (.5 FOR SET 2), EXPONENT /35H RANGE FROM -06 TO +08 IN SEQUE
2NCE )
C***** END OF TEST SEGMENT 103
C***** WHEN EXECUTING ONLY SEGMENT 103 THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** BSFTS - (110)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST OF ALL STATEMENT FUNCTIONS THAT HAVE BEEN DEFINED
C***** IN TEST SEGMENT 005 8.1.2
C***** GENERAL COMMENTS
C***** INTRINSIC AND EXTERNAL FUNCTIONS ASSUMED WORKING
C***** INTRINSIC AND BASIC EXTERNAL FUNCTIONS DECLARED IN A 10.1.7
C***** TYPE STATEMENT OF SAME TYPE AS TABLES 3 AND 4 5.3
C*****
C***** S P E C I F I C A T I O N S SEGMENT 110
C*****
C***** WHEN EXECUTING ONLY SEGMENT 110, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= INTEGER IFIX
C= REAL ABS, SQRT
C*****
C***** WHEN EXECUTING ONLY SEGMENT 110, THE SEGMENT 005, WHICH
C***** CONTAINS THE STATEMENT FUNCTIONS BEING TESTED HERE MUST BE
C***** INSERTED AFTER THE SPECIFICATION STATEMENTS OF SEGMENT 110.
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 110, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI,1100)
1100 FORMAT(39H1 BSFTS - (110) STATEMENT FUNCTION TEST/23X,16HINTEGER A
1ND REAL//18H ASA REF. - 8.1.2// 9H RESULTS)
C***** HEADER FOR SEGMENT 110 WRITTEN
CMAVS = 9.0 - CMAFS(2.0, 3.0 + 2.0)
CMBVS = CMBFS(2/2, 1+1, 1*3) -2.0
MCAVI = MCAFI(IFIX(5.0),5) - (5 ** 5)
MCBVI = MCBFI(1.0,2.0,3.0) - MCAFI(6,2) + 24
WRITE (NUVI,1108) CMAVS, CMBVS, MCAVI, MCBVI
CMAVS = CMCFS(4.0,2.0,2.0)
CMBVS = CMDFS(-1,-4) - 5.0
MCAVI = MCCFI(9*2/18, (4**2)/8, 3.0) - 14
MCBVI = MCDFI(1.,2.1,3.,4.,5.) -15
WRITE (NUVI,1108) CMAVS, CMBVS, MCAVI, MCBVI
CMAVS = CMEFS(2.0,1.0 * 2.0) - 4.0
MCAVI = 3
CMBVS = CMFFS(1,2, MCAVI) - 23.
MCAVI = MCEFI(2,2) - (4 ** 4)
MCBVI = MCFFI(9.0,4.0,CMBVS * CMBVS * 0.0) - 6
WRITE (NUVI,1108) CMAVS, CMBVS, MCAVI, MCBVI
CMAVS = CMGFS(3,13,2.0,5.0) - 4.0
CMBVS = CMGFS(IFIX(SQRT(CMAFS(2.,5.))),IFIX(CMFFS(1,2,3) -10.),
1 CMBFS(1,2,3), CMDFS(-1,-4)) - 4.0
MCAVI = MCGFI(2,2,2,0.0) - 1
MCBVI = MCGFI(MCAFI(2,1), MCBFI(1.0,0.,.0), IFIX(SQRT(CMGFS(3,13,
12.0,5.0))),EXP(0.0) - 1.0)-1
WRITE (NUVI,1108) CMAVS, CMBVS, MCAVI, MCBVI
WRITE (NUVI,1109)
1108 FORMAT ( /2(F20.10 /),2(I19/ ))
1109 FORMAT ( /36H ALL ABOVE ANSWERS SHOULD BE 0 FOR /
137H THIS TEST SEGMENT TO BE SUCCESSFUL.)
C***** END OF TEST SEGMENT 110
C***** WHEN EXECUTING ONLY SEGMENT 110, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** FSFTS - (111)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST STATEMENT FUNCTIONS THAT HAVE BEEN DEFINED IN 8.1.2
C***** SEGMENT 006 (FOR FULL FORTRAN TEST ONLY)
C***** GENERAL COMMENTS
C***** INTRINSIC AND EXTERNAL FUNCTIONS ASSUMED WORKING
C***** INTRINSIC AND BASIC EXTERNAL FUNCTIONS DECLARED IN A 10.1.7
C***** TYPE STATEMENT OF SAME TYPE AS TABLES 3 AND 4 5.3
C*****
C***** S P E C I F I C A T I O N S SEGMENT 111
C*****
C***** WHEN EXECUTING ONLY SEGMENT 111, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION DPAFD,DPBFD,DPCFD,DPDFD,DPFFD,DPGFD,DPEFD,DPHFD
C= DOUBLE PRECISION DPAVD, DPBVD, DPCVD, DPDVD,DAWVD,DBWVD, DCWVD
C= DOUBLE PRECISION DPA1D(5),FC2D(5,5)
C= DOUBLE PRECISION DBLE, DEXP
C= COMPLEX CMPLX, CEXP
C= COMPLEX CHAVC,CHBVC,CHCVC,CHDVC,CHEVC,CHFVC
C= COMPLEX CHAFC, CHBFC, CHCFC, CHDFC, CAWVC, CBWVC
C= LOGICAL A3B(2,2,2)
C= LOGICAL MCFVB, MCHVB, ABFB, BCFB, IEFB, KLFB
C= - ,MCEVB,MCIVB,MCKVB,ATVB,AWVB, BWVB, CWVB, DWVB, EWVB, SWVB,TWVB
C*****
C***** WHEN EXECUTING ONLY SEGMENT 111, THE SEGMENT 006, WHICH
C***** CONTAINS THE STATEMENT FUNCTIONS BEING TESTED HERE MUST BE
C***** INSERTED AFTER THE SPECIFICATION STATEMENTS OF SEGMENT 111.
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 111, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
WRITE (NUVI,1110)
1110 FORMAT(39H1 FSFTS - (111) STATEMENT FUNCTION TEST//
1 39H DOUBLE PRECISION, COMPLEX AND LOGICAL//
218H ASA REF. - 8.1.2//10H RESULTS )
C***** HEADER FOR SEGMENT 111 WRITTEN
C***** CONSTANTS USED IN THIS SEGMENT
CHAVC = (1.0,2.0)
CHBVC = (-2.0,3.0)
DPA1D(2) = 3.5D0
ATVB = .FALSE.
PPDVS = 18.
RRDVS = 21.0
ATVS = 18.0
MCFVB = .TRUE.
FC2D(2,2) = 1.75D0
C***** TEST OF D.P. STATEMENT FUNCTIONS
DPAVD = DPAFD(3.5D0,DPA1D(2)) - 49.0D0
DPBVD = DPBFD(1.D0,DPA1D(2)- 2.5D0,DBLE(1.0)) - 1.0D0
DPCVD = DPCFD(0.D0,1.0D0,DPA1D(2)+ 0.5D0) - 7.5D0
DPDVD = DPDFD(DBLE(AIMAG(CHAVC)),FC2D(2,2)) + 2.0D0
WRITE (NUVI,1118) DPAVD, DPBVD, DPCVD, DPDVD
DPAVD = DPEFD(1.0D0, FC2D(2,2) *2.D0,(1.0,-4.),AMAX1(2.0,4.0))
1 - 4.5D0
DPBVD = DPFFD(DPA1D(2), FC2D(2,2)-1.75D0,5.00) - 22.25D0
DPCVD = DPGFD(2.D0/.2D1,DPA1D(2) - 2.5D0,1.0,CHAVC) - 4.0D0
DPDVD= DPHFD(3.5D0, FC2D(2,2) - 2.75D0,5.0) - 34.5D0
WRITE (NUVI,1118) DPAVD, DPBVD, DPCVD, DPDVD
C***** TEST OF COMPLEX STATEMENT FUNCTIONS
CHCVC = CHAFC((2.0,2.),CHAVC) - (3.0,12.0)
CHDVC = CHBFC((4.0,-8.5),CHBVC,1.0) - (7.0,-10.5)
CHEVC = CHCFC((1.0,1.0) **2,CHAVC, 0.000, AIMAG(CHAVC) -2.0)
CHFVC = CHDFC((0.0,0.0) ,CHAVC, 0.000 , SNGL (DMIN1(0.D0,4.D0))
1)-(1.0,0.0)
WRITE (NUVI,1117) CHCVC, CHDVC, CHEVC, CHFVC
WRITE (NUVI, 1119)
C***** TEST OF LOGICAL STATEMENT FUNCTION
MCEVB = PPDVS .GT. 60.0
A3B(1,1,1) = ATVS .LE. 20.9 .AND. ABFB(.TRUE.,.TRUE.,.FALSE.)
MCHVB = BCFB(.TRUE.,.FALSE.,PPDVS,21.0) .AND..NOT.PPDVS.GE.RRDVS
MCIVB = .NOT. (IEFB(.FALSE.,ATVB,.TRUE.,650.,-5.11).AND.ATVB)
MCKVB = MCFVB.AND.KLFB(.TRUE.,.TRUE.,.TRUE.,100.).AND..NOT.MCEVB
WRITE (NUVI,1116) A3B(1,1,1), MCHVB, MCIVB, MCKVB
1116 FORMAT(//4(L4)//38H THE FOUR ABOVE ANSWERS SHOULD BE TRUE/
1 35H FOR THIS SEGMENT TO BE SUCCESSFUL)
1117 FORMAT(/ 4(F16.7,F14.7/))
1118 FORMAT (/ 4(D30.18/))
1119 FORMAT (/ 40H ALL ABOVE ANSWERS SHOULD BE 0 FOR THIS/
140H TEST SEGMENT TO BE SUCCESSFUL. VALUES /40H WITH EXPONENTS LE
2SS THAN 10**(-14) /22H ARE CONSIDERED ZERO )
C***** END OF TEST SEGMENT 111
C***** WHEN EXECUTING ONLY SEGMENT 111, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
nbs09.d 480890337 170 2 100666 302 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2 . DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4 . DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6 DOUBLE SPACE ON OUTPUT ID 6
nbs09.f 480890341 170 2 100666 34168 `
C***** PART9 *****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 9 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** CPXAD - 140 ADDITION AND SUBTRACTION OF COMPLEX NUMBERS
C*****
C***** CPXMU - 141 MULTIPLICATION OF COMPLEX NUMBERS
C*****
C***** CPXDV - 142 DIVISION OF COMPLEX NUMBERS
C*****
C***** CPXEX - 143 EXPONENTIATION OF COMPLEX NUMBERS
C*****
C***** CPXOP - 144 ARITHMETIC OPERATIONS ON COMPLEX NUMBERS
C*****
C***** CREAD - 145 ADDITION, SUBTRACTION OF COMPLEX, REAL NUMBERS
C*****
C***** CREMU - 146 MULTIPLICATION OF COMPLEX BY REAL NUMBERS
C*****
C***** CREDV - 147 DIVISION OF REAL, COMPLEX BY COMPLEX, REAL NOS.
C*****
C***** CREOP - 148 COMBINED OPERATIONS ON COMPLEX AND REAL NOS.
C*****
C***** MISC3 - 149 BLANKS IN AND CONT. OF STATEMENT TO MAX. LINES
C*****
C***** MISC4 - 150 SPECIAL CHARACTERS FOR CONTINUATIONS
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN
C***** SEGMENTS 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150
C***** ARE RUN AS ONE MAIN PROGRAM.
C*****
DIMENSION A1S(5), A2S(2,2)
INTEGER AVI, I1I(5), I2I(2,2)
COMPLEX AVC, BVC, CVC, DVC, EVC, FVC, GVC, HVC, IVC, JVC,
1 PVC, RVC, SVC, TVC, UVC,
2 AAVC, ABVC, BAVC, BCVC, CAVC, CCVC, CDVC, DAVC, DCVC, ASVC,
3 BSVC, CSVC, DSVC, DBVC, DDVC, MAVC, MBVC, MCVC, MDVC, BBVC,
4 AAAVC, ABAVC, ACAVC, ADAVC, AASVC, ABSVC, ACSVC, ADSVC
COMPLEX NUMVC, DENVC, QAVC, QBVC, QCVC, QDVC
C*****
C*****
C***** END OF SPECIFICATIONS FOR SEGMENTS
C***** 140, 141, 142, 143, 144, 145, 146, 147, 148, 149, 150
C***********************************************************************
C*****
C***** CPXAD - (140)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** TO TEST ADDITION AND SUBTRACTION OF COMPLEX NUMBERS ASA REF
C***** INCLUDES OPERATIONS WITH UP TO 9 TERMS 6.1
C***** DOES NOT TEST FOR ACCURACY
C*****
C*****ADDITION AND SUBTRACTION OF 2 TERMS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 140
C*****
C***** WHEN EXECUTING ONLY SEGMENT 140, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH APPEAR
C***** AS COMMENTS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX AVC, BVC, CVC, DVC, EVC, FVC, GVC, HVC, IVC, JVC, AAVC,
C= 1 ABVC,BAVC,BBVC,CCVC,CDVC,BCVC,DCVC
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 9 ///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
WRITE (NUVI, 1401)
1401 FORMAT(1H1,1X,34HCPXAD - (140) COMPLEX ADDITION AND/16X,
111HSUBTRACTION//2X,14HASA REF. - 6.1//2X,7HRESULTS//)
AVC=(1.467,2.560)
BVC=(3.568,7.480)
CVC=AVC+BVC
DVC=AVC+(3.568,7.480)
EVC=(1.9467,2.9560)+BVC
FVC=(1.467,2.560)+(3.568,7.480)
GVC=AVC-BVC
HVC = (.1467E+1,.2560E1) - BVC
IVC = AVC - (3568E-3,.7480E+1)
JVC=(1.467,2.560)-(3.568,7.480)
C*****ADDITION AND SUBTRACTION OF 3 TERMS
AAVC=AVC+BVC-CVC
ABVC=AVC+(3.568,7.480)-DVC
BAVC=(1.467,2.560)+BVC-CVC
BBVC=(1.467,2.560)+(3.568,7.480)-FVC
BCVC=AVC-BVC-GVC
CCVC=(1.467,2.560)-BVC-HVC
CDVC=AVC-(3.568,7.480)-IVC
DCVC=(1.467,2.560)-(3.568,7.480)-JVC
WRITE(NUVI,1402) AAVC,ABVC,BAVC,BBVC,BCVC,CCVC,CDVC,DCVC
C*****ADDITION AND SUBTRACTION OF 5 TERMS
AAVC=AVC-(1.89,6.48)-AAVC-BVC+(0.0,9.830)
ABVC=AVC-(1.89,6.48)-AAVC-BVC+(0.0,9.830)
WRITE(NUVI,1402)ABVC
1402 FORMAT(2X,2F8.4)
AAVC=AVC-(1.89,6.48)-BVC+(0.0,9.83)+CVC
C*****ADDITION AND SUBTRACTION OF 6 TERMS
ABVC=AVC-(1.89,6.48)-BVC+(0.0,9.83)+CVC-AAVC
WRITE(NUVI,1402) ABVC
C*****ADDITION AND SUBTRACTION OF 8 TERMS
AAVC=AVC+BVC-CVC+(0.34,6.45)-(4.54,6.85)+DVC+(1.0,0.0)-EVC
C*****ADDITION AND SUBTRACTION OF 9 TERMS
ABVC=AVC+BVC-CVC+(0.34,6.45)-(4.54,6.85)+DVC+(1.0,0.0)-EVC-AAVC
WRITE (NUVI,1403) ABVC
1403 FORMAT(2X,2F8.4//2X,35HTEST IS POSITIVE IF NUMBERS PRINTED/2X ,
117HABOVE ARE 0.0,0.0)
C***** END OF TEST SEGMENT 140
C***** WHEN EXECUTING ONLY SEGMENT 140, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CPXMU - (141)
C***********************************************************************
C***** GENERAL PURPOSE
C***** TO TEST MULTIPLICATION OF COMPLEX NUMBERS ASA REF
C***** INCLUDES OPERATIONS WITH UP TO 10 TERMS 6.1
C***** DOES NOT TEST FOR ACCURACY
C*****
C*****
C***** S P E C I F I C A T I O N S SEGMENT 141
C*****
C***** WHEN EXECUTING ONLY SEGMENT 141, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX AVC, BVC, CVC, DVC, EVC, FVC, GVC, HVC, IVC, JVC
C= 1 ,AAVC, ABVC, BAVC, BBVC
C*****
C***** O U T O U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 141, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI, 1411)
1411 FORMAT (1H1,1 X,36HCPXMU - (141) COMPLEX MULTIPLICATION//2X,
114HASA REF. - 6.1//2X,7HRESULTS//)
C*****MULTIPLICATION OF TWO TERMS
AVC = (-0.5,0.86602)
BVC = (-0.5,-0.86602)
AAVC = (AVC * BVC )
ABVC = AVC * (-0.5,-0.86602)
BAVC = (-0.5,0.86602) * BVC
BBVC = (-0.5,0.86602)*(-0.5,-0.86602)
WRITE(NUVI,1412) AAVC,ABVC,BAVC,BBVC
C*****MULTIPLICATION OF 3 TERMS
AVC=(0.0,1.0)
BVC=(1.0,0.0)
CVC=(0.0,-1.0)
AAVC=AVC*BVC*CVC
ABVC=(0.0,1.0)*BVC*(0.0,-1.0)
WRITE(NUVI,1412) AAVC,ABVC
1412 FORMAT(2X,2F8.3)
C*****MULTIPLICATION OF 4 TERMS
AVC=(0.30901,0.95105)
BVC=(-0.80901,0.58778)
CVC=(-0.80901,-0.58778)
DVC=(0.30901,-0.95105)
AAVC=AVC*BVC*CVC*DVC
ABVC=AVC*(-0.80901,0.58778)*CVC*(0.30901,-0.95105)
WRITE(NUVI,1412) AAVC,ABVC
C*****MULTIPLICATION OF 5 TERMS
AVC=(0.5,0.86602)
BVC=(-0.5,0.86602)
CVC = (1.0,0.0)
DVC=(-0.5,-0.86602)
EVC=(0.5,-0.86602)
AAVC=AVC*BVC*CVC*DVC*EVC
ABVC=AVC*(-0.5,0.86602)*CVC*(-0.5,-0.86602)*EVC
WRITE(NUVI,1412) AAVC,ABVC
C*****MULTIPLICATION OF 6 TERMS
AVC = (0.98480,0.17364)
BVC=(-0.17364,0.98480)
CVC=(-0.86602,0.5)
DVC=(-0.93969,-0.34202)
EVC=(0.34202,-0.93969)
FVC=(0.86602,-0.5)
AAVC=AVC*BVC*CVC*DVC*EVC*FVC
ABVC=AVC*(-0.17364,0.98480)*CVC*(-0.93969,-0.34202)*EVC*(0.86602,
1-0.5)
WRITE(NUVI,1412) AAVC,ABVC
C*****MULTIPLICATION OF 7 TERMS
AVC=(0.70710,0.70710)
BVC=(0.0,1.0)
CVC=(-0.70710,0.70710)
DVC=(1.0,0.0)
EVC=(-0.70710,-0.70710)
FVC=(0.0,-1.0)
GVC=(0.70710,-0.70710)
AAVC=AVC*BVC*CVC*DVC*EVC*FVC*GVC
ABVC=AVC*(0.0,1.0)*CVC*( 1.0,0.0)*EVC*(0.0,-1.0)*GVC
WRITE(NUVI,1412) AAVC,ABVC
C*****MULTIPLICATION OF 8 TERMS
AVC=(0.76604,0.64278)
BVC=(0.17364,0.98480)
CVC=(-0.5,0.86602)
DVC=(-0.93969,0.34202)
EVC=(-0.93969,-0.34202)
FVC=(-0.5,-0.86602)
GVC=(0.17364,-0.98480)
HVC=(0.76604,-0.64278)
AAVC=AVC*BVC*CVC*DVC*EVC*FVC*GVC*HVC
ABVC=AVC*(0.17364,0.98480)*CVC*DVC*(-0.93969,-0.34202)*FVC*GVC*HVC
WRITE(NUVI,1412) AAVC,ABVC
C*****MULTIPLICATION OF 9 TERMS
AVC=(0.80901,0.58778)
BVC=(0.30901,0.95105)
CVC=(-0.94832,0.31730)
DVC=(-0.80901,0.58778)
EVC = (1.0,0.0)
FVC=(-0.80901,-0.58778)
GVC=(-0.94832,-0.31730)
HVC=(0.30901,-0.95105)
IVC=(0.80901,-0.58778)
AAVC=AVC*BVC*CVC*DVC*EVC*FVC*GVC*HVC*IVC
ABVC=AVC*(0.30901,0.95105)*CVC*(-0.80901,0.58778)*( 1.0,0.0)*FVC*
1GVC*HVC*IVC
WRITE(NUVI,1412) AAVC,ABVC
C*****MULTIPLICATION OF 10 TERMS
AVC=(0.86602,0.5)
BVC=(0.5,0.86602)
CVC=(0.0,1.0)
DVC=(-0.5,0.86602)
EVC=(-0.86602,0.5)
FVC=(-1.0,0.0)
GVC=(-0.86602,-0.5)
HVC=(-0.5,-0.86602)
IVC=(0.0,-1.0)
JVC=(0.0,1.0)
AAVC=AVC*BVC*CVC*DVC*EVC*FVC*GVC*HVC*IVC*JVC
ABVC=AVC*(0.5,0.86602)*CVC*(-0.5,0.86602)*EVC*FVC*GVC*HVC*(0.0,-1.
10)*JVC
WRITE(NUVI,1412) AAVC,ABVC
WRITE(NUVI,1413)
1413 FORMAT (1H0,35HTEST IS POSITIVE IF NUMBERS PRINTED/1X,
117HABOVE ARE 1.0,0.0)
WRITE(NUVI, 1414)
1414 FORMAT (//39H ERROR SHOULD NOT EXCEED + OR - .001 )
C***** END OF TEST SEGMENT 141
C***** WHEN EXECUTING ONLY SEGMENT 141, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CPXDV-(142)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** TO TEST DIVISION OF COMPLEX NUMBERS ASA REF
C***** 6.1
C*****
C***** S P E C I F I C A T I O N S SEGMENT 142
C*****
C***** WHEN EXECUTING ONLY SEGMENT 142, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX NUMVC,DENVC,QAVC,QBVC,QCVC,QDVC
C*****
C***** O U T O U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 142, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI, 1421)
1421 FORMAT(1H1,1X,25HCPXDX - (142) DIVISION OF/16X,
115HCOMPLEX NUMBERS//15H ASA REF.- 6.1//2X,7HRESULTS//)
C***** TEST NUMBER 1
NUMVC=(0.36602,1.36602)
DENVC=(0.86602,0.5)
QAVC=NUMVC/DENVC
QBVC=(0.36602,1.3660) /DENVC
QCVC=NUMVC/(0.86602,0.5)
QDVC=(0.36602,1.36602)/(0.86602,0.5)
WRITE(NUVI,1422) QAVC,QBVC,QCVC,QDVC
C*****TEST NUMBER 2
NUMVC=(0.0,1.41420)
DENVC=(0.70710,0.70710)
QAVC=NUMVC/DENVC
QBVC=(0.0,1.41420)/DENVC
QCVC=NUMVC/(0.70710,0.70710)
QDVC=(0.0,1.41420)/(0.70710,0.70710)
WRITE(NUVI,1422) QAVC,QBVC,QCVC,QDVC
1422 FORMAT(2X,2F8.4)
C*****TEST NUMBER 3
NUMVC=(-0.36602,1.36602)
DENVC=(0.5,0.86602)
QAVC=NUMVC/DENVC
QBVC=(-0.36602,1.36602)/DENVC
QCVC=NUMVC/(0.5,0.86602)
QDVC=(-0.36602,1.36602)/(0.5,0.86602)
WRITE(NUVI,1422) QAVC,QBVC,QCVC,QDVC
C*****TEST NUMBER 4
NUMVC=(0.73204,2.73204)
DENVC=(1.73204,1.0)
QAVC=NUMVC/DENVC
QBVC=(0.73204,2.73204)/DENVC
QCVC=NUMVC/(1.73204,1.0)
QDVC=(0.73204,2.73204)/(1.73204,1.0)
WRITE(NUVI,1422) QAVC,QBVC,QCVC,QDVC
C***** TEST NUMBER 5
NUMVC=(0.0,2.82840)
DENVC=(1.41420,1.41420)
QAVC=NUMVC/DENVC
QBVC=(0.0,2.82840)/DENVC
QCVC=NUMVC/(1.41420,1.41420)
QDVC=(0.0,2.82840)/(1.41420,1.41420)
WRITE(NUVI,1422) QAVC,QBVC,QCVC,QDVC
WRITE(NUVI,1423)
1423 FORMAT (//2X,35HTEST IS POSITIVE IF NUMBERS PRINTED/2X,
117HABOVE ARE 1.0,1.0)
WRITE (NUVI, 1424)
1424 FORMAT (//39H ERROR SHOULD NOT EXCEED + OR - .0001 )
C***** END OF TEST SEGMENT 142
C***** WHEN EXECUTING ONLY SEGMENT 142, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CPXEX(143)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** TO TEST EXPONENTIATION OF COMPLEX NUMBERS ASA REF
C***** BY INTEGERS 6.1
C***** EXPONENT VALUES VARY FROM 3 TO 100
C*****
C***** S P E C I F I C A T I O N S SEGMENT 143
C*****
C***** WHEN EXECUTING ONLY SEGMENT 143, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX AVC,BVC,CVC,DVC,EVC
C*****
C***** O U T O U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 143, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI, 1431)
1431 FORMAT(1H1,1 X,36HCPXEX - (143) COMPLEX EXPONENTIATION//
1 2X,11HASA.REF.6.1//2X,29HRESULTS BASED ON THE FUNCTION//
2 2X,25H1.0 = SIN**2(X)+COS**2(X)//)
C***** EXPONENT=3
AVC = (-0.5,0.8660254)
AVI=3
BVC=AVC**3
CVC = (-0.5,0.8660254) ** 3
DVC = (-0.5,0.8660254) ** AVI
EVC=AVC**AVI
WRITE(NUVI,1432) BVC,CVC,DVC,EVC
C***** EXPONENT=4
AVC=(0.0,1.0)
AVI=4
BVC=AVC**4
CVC=(0.0,1.0)**4
DVC=(0.0,1.0)**AVI
EVC=AVC**AVI
WRITE(NUVI,1432) BVC,CVC,DVC,EVC
1432 FORMAT (2X,2F8.4)
C***** EXPONENT=6
AVC = ( 0.5,0.8660254)
AVI=6
BVC=AVC**6
CVC = ( 0.5,0.8660254) ** 6
DVC = ( 0.5,0.8660254) ** AVI
EVC= AVC**AVI
WRITE(NUVI,1432) BVC,CVC,DVC,EVC
C***** EXPONENT=8
AVC = (0.7071068,0.7071068)
AVI=8
BVC=AVC**8
CVC = (0.7071068,0.7071068) ** 8
DVC = (0.7071068,0.7071068) ** AVI
EVC=AVC**AVI
WRITE(NUVI,1432) BVC,CVC,DVC,EVC
C***** EXPONENT=10
AVC = (0.8090170,0.5877853)
AVI=10
BVC=AVC**10
CVC = (0.8090170,0.5877853) ** 10
DVC = (0.8090170,0.5877853) ** AVI
EVC=AVC**AVI
WRITE(NUVI,1432) BVC,CVC,DVC,EVC
C*****EXPONENT=20
AVC = (0.9510565,0.3090170)
AVI=20
BVC=AVC**20
CVC = (0.9510565,0.3090170) ** 20
DVC = (0.9510565,0.3090170) ** AVI
EVC=AVC**AVI
WRITE(NUVI,1432) BVC,CVC,DVC,EVC
C***** EXPONENT=40
AVC = (0.9876883,0.1564345)
AVI=40
BVC=AVC**40
CVC = (0.9876883,0.1564345) ** 40
DVC = (0.9876883,0.1564345) ** AVI
EVC=AVC**AVI
WRITE(NUVI,1432) BVC,CVC,DVC,EVC
C***** EXPONENT=60
AVC = (0.9945219,0.1045285)
AVI=60
BVC=AVC**60
CVC = (0.9945219,0.1045285) ** 60
DVC = (0.9945219,0.1045285) ** AVI
EVC=AVC**AVI
WRITE(NUVI,1432) BVC,CVC,DVC,EVC
C*****EXPONENT=80
AVI = 80
AVC = (0.9969173,0.0784591)
BVC=AVC**80
CVC = (0.9969173,0.0784591) ** 80
DVC = (0.9969173,0.0784591) ** AVI
EVC=AVC**AVI
WRITE(NUVI,1432) BVC,CVC,DVC,EVC
C***** EXPONENT=100
AVC = (0.9980267,0.0627905)
AVI=100
BVC=AVC**100
CVC = (0.9980267,0.0627905) ** 100
DVC = (0.9980267,0.0627905) ** AVI
EVC=AVC**AVI
WRITE(NUVI,1432) BVC,CVC,DVC,EVC
WRITE (NUVI,1433)
1433 FORMAT (// 37H TEST IS POSITIVE IF NUMBERS PRINTED/2X,
1 26HABOVE ARE CLOSE TO 1.0,0.0)
WRITE (NUVI, 1434)
1434 FORMAT(// 39H ERROR SHOULD NOT EXCEED + OR - .0001 )
C***** END OF TEST SEGMENT 143
C***** WHEN EXECUTING ONLY SEGMENT 143, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CPXOP - (144)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST ARITHMETIC OPERATIONS ON COMPLEX NUMBERS. 6.1
C***** OPERATIONS INCLUDE ALL BASIC OPERATORS (+,-,*,**) ACTING
C***** ON COMPLEX NUMBERS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 144
C*****
C***** WHEN EXECUTING ONLY SEGMENT 144, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= INTEGER AVI
C= COMPLEX AVC, BVC, CVC, DVC, EVC, FVC, GVC,HVC,PVC,RVC,SVC,TVC,UVC
C*****
C***** O U T O U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 144, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI, 1441)
1441 FORMAT(1H1,1X,32HCPXOP - (144) COMPLEX OPERATIONS//2X,
111HASA REF 6.1//2X,7HRESULTS//)
AVC = (0.9396926,0.3420201)
BVC = (1.2817127,0.5976725)
CVC = (0.0, 1.4142136)
DVC = (0.7071068, 0.7071068)
EVC = (1.0986841, 0.4550899)
AVI = 2
RVC=(AVC*BVC+(0.9396926,0.3420201)*BVC+AVC*(1.2817127,0.5976725)-
1(0.9396926,0.3420201)*(1.2817127,0.5976725)+CVC/DVC+(0.0,1.4142136
2)/DVC+CVC/(0.7071068,0.7071068)-(0.0,1.4142136)/(0.7071068,
3 0.7071068)+EVC**2-EVC**AVI+(1.0986841,0.4550899)**2+(1.0986841,
4 0.4550899)**AVI)**2/(0.0, 72.0)
FVC=(0.0,4.0)
GVC=(0.43301,0.3)
HVC=(0.43301,0.2)
PVC=(1.73204,1.0)
SVC=FVC/((GVC+HVC)*(PVC**2))
TVC=(0.0,4.0)/(((0.43301,0.3)+(0.43301,0.2))*((1.73204,1.0)**2))
UVC=FVC/((GVC+(0.43301,0.2))*(PVC**2))
WRITE (NUVI,1442) RVC,SVC,TVC,UVC
1442 FORMAT ( 4(2X,2F8.4/) /37H TEST IS POSITIVE IF NUMBERS PRINTED /
12X, 17HABOVE ARE 1.0,0.0 )
WRITE (NUVI, 1443)
1443 FORMAT(// 39H ERROR SHOULD NOT EXCEED + OR - .0001 )
C***** END OF TEST SEGMENT 144
C***** WHEN EXECUTING ONLY SEGMENT 144, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CREAD-(145)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST ADDITION AND SUBTRACTION OF COMPLEX 6.1
C***** AND REAL NUMBERS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 145
C*****
C***** WHEN EXECUTING ONLY SEGMENT 145, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX AVC,BAVC,CAVC,DAVC,ASVC,BSVC,CSVC,AAVC
C= 2 , DSVC,AAAVC,ABAVC,ACAVC,ADAVC,AASVC,ABSVC,ACSVC,ADSVC
C*****
C***** O U T O U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 145, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI, 1450)
1450 FORMAT(1H1,1X,38HCREAD - (145) ADDITION AND SUBTRACTION/
1 10X,27HOF COMPLEX AND REAL NUMBERS//2X,
1 12HASA REF. 6.1//2X,7HRESULTS//)
AVC=(5.4,7.5)
AVS=4.2
C***** ADDITION AND SUBTRACTION OF 2 NUMBERS
AAVC=AVC-AVS
BAVC=(5.4,7.5)-AVS
CAVC=AVC-4.2
DAVC=(5.4,7.5)-4.2
ASVC=AVC+AVS
BSVC=(5.4,7.5)+AVS
CSVC=AVC+4.2
DSVC=(5.4,7.5)+4.2
C***** ADDITION AND SUBTRACTION OF 3 NUMBERS
AAAVC=AVC-AVS-AAVC
ABAVC=(5.4,7.5)-AVS-BAVC
ACAVC=AVC-4.2-(1.2,7.5)
ADAVC=(5.4,7.5)-4.2-(1.2,7.5)
AASVC=AVC+AVS-ASVC
ABSVC=(5.4,7.5)+AVS-BSVC
ACSVC=AVC+4.2-(9.6,7.5)
ADSVC=(5.4,7.5)+4.2-(9.6,7.5)
WRITE(NUVI,1451)ABAVC,ACAVC,ADAVC,AASVC,ABSVC,ACSVC,ADSVC,AAAVC
1451 FORMAT( 2X, 2F8.4)
C***** ADDITION AND SUBTRACTION OF 7 NUMBERS
ADSVC=AVC-(5.4,7.5)+AVS-4.2+ASVC-3.2-(6.4,7.5)
WRITE(NUVI,1452) ADSVC
1452 FORMAT(2X,2F8.4//37H TEST IS POSITIVE IF NUMBERS PRINTED/2X,
1 17HABOVE ARE 0.0,0.0)
C***** END OF TEST SEGMENT 145
C***** WHEN EXECUTING ONLY SEGMENT 145, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CREMU - (146)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST MULTIPLICATION OF COMPLEX NUMBERS BY 6.1
C***** REAL NUMBERS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 146
C*****
C***** WHEN EXECUTING ONLY SEGMENT 146, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX AVC,BVC, MAVC,MBVC,MCVC,MDVC
C*****
C***** O U T O U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 146, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI, 1461)
1461 FORMAT(1H1,1X,39HCREMU - (146) MULTIPLICATION OF COMPLEX/16X,
1 7HBY REAL //2X,
2 11HASA.REF.6.1//2X,7HRESULTS//)
C*****MULTIPLICATION OF A COMPLEX NUMBER BY A REAL NUMBER
AVC=(1.6,3.2)
AVS=0.625
MAVC=AVC*AVS
MBVC=(1.6,3.2)*AVS
MCVC=AVC*0.625
MDVC=(1.6,3.2)*0.625
WRITE (NUVI,1463) MAVC,MBVC,MCVC,MDVC
1463 FORMAT(4(2X,2F8.4/)//37H TEST IS POSITIVE IF NUMBERS PRINTED/,2X,
417HABOVE ARE 1.0,2.0 )
C*****MULTIPLICATION OF 4 TERMS
AVS=4.0
BVS=0.25
AVC=(0.93969,0.34202)
BVC=(1.28168,0.59764)
MAVC=AVS*AVC*BVS*BVC
MBVC=4.0*BVS*AVC*BVC
MCVC=4.0*BVS*(0.93969,0.34202)*BVC
MDVC=4.0*0.25*(0.93969,0.34202)*(1.28168,0.59764)
WRITE (NUVI,1462) MAVC,MBVC,MCVC,MDVC
1462 FORMAT(//4(2X,2F8.4/)//37H TEST IS POSITIVE IF NUMBERS PRINTED/
12X,17HABOVE ARE 1.0,1.0)
WRITE (NUVI, 1464)
1464 FORMAT(// 39H ERROR SHOULD NOT EXCEED + OR - .0001 )
C***** END OF TEST SEGMENT 146
C***** WHEN EXECUTING ONLY SEGMENT 146, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CREDV - (147)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST DIVISION OF REAL (COMPLEX) NUMBERS BY 6.1
C***** COMPLEX (REAL) NUMBERS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 147
C*****
C***** WHEN EXECUTING ONLY SEGMENT 147, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMPLEX AVC,DAVC,DBVC,DCVC,DDVC
C*****
C***** O U T O U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 147, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI, 1471)
1471 FORMAT (1H1,1X,33HCREDV - (147) DIVISION OF COMPLEX/16X,16HAND REA
1L NUMBERS//2X,11HASA REF 6.1//2X,7HRESULTS//)
C*****DIVISION OF REAL BY COMPLEX
AVS=2.0
AVC=(1.0, -1.0)
DAVC=AVS/AVC
DBVC=2.0/AVC
DCVC=AVS/(1.0, -1.0)
DDVC=2.0/(1.0, -1.0)
WRITE (NUVI,1473) DAVC,DBVC,DCVC,DDVC
1473 FORMAT( 2X, 2F8.4)
C*****DIVISION OF COMPLEX BY REAL
AVS=2.5463
AVC=(2.5463,2.5463)
DAVC=AVC/AVS
DBVC=(2.5463,2.5463)/AVS
DCVC=AVC/2.5463
DDVC=(2.5463,2.5463)/2.5463
WRITE (NUVI,1472) DAVC,DBVC,DCVC,DDVC
1472 FORMAT (4(2X,2F8.4/)//37H TEST IS POSITIVE IF NUMBERS PRINTED/
1 2X,17HABOVE ARE 1.0,1.0)
WRITE (NUVI, 1474)
1474 FORMAT(// 39H ERROR SHOULD NOT EXCEED + OR - .0001 )
C***** END OF TEST SEGMENT 147
C***** WHEN EXECUTING ONLY SEGMENT 147, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CREOP - (148)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST COMBINED OPERATIONS ON COMPLEX AND REAL NUMBERS 6.1
C*****DIVISION OF TWO POLYNOMIALS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 148
C*****
C***** WHEN EXECUTING ONLY SEGMENT 148, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= INTEGER AVI
C= COMPLEX AVC,BVC,CVC,DVC,RVC
C*****
C***** O U T O U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 148, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI, 1481)
1481 FORMAT(1H1,1X,36HCREOP - (148) OPERATIONS ON REAL AND/16X,15HCOMPL
1EX NUMBERS// 2X,12HASA REF. 6.1//2X, 7HRESULTS//)
AVC=(1.0,1.0)
AVS=1.0
BVS = 2.0
BVC=(1.0,-1.0)
RVC = (BVS + AVC *(1.+AVC * (-1.+(1.0,1.0)*(-1. +AVC))))/
1 (4.0+BVC*(2.0+BVC*(-AVS+BVC*(0.5+BVC))))
WRITE (NUVI,1483) RVC
1483 FORMAT( 2X,2F8.4//37H TEST IS POSITIVE IF NUMBERS PRI
3NTED/2X,18HABOVE ARE 2.0,-1.0//)
C*****COMPLEX ARITHMETIC EXPRESSION
AVC=(1.60,3.2)
AVS=0.625
BVS=2.0
BVC=(1.0,-1.0)
CVS=2.5
CVC=(2.5,2.5)
DVC = (1.09866,0.45508)
AVI = 2
RVC=(AVC*AVS+(1.6,3.2)*AVS-AVC*0.625-(1.6,3.2)*0.625+BVS/BVC
1-BVS/(1.0,-1.0)+2.0/BVC+2.0/(1.0,-1.0)+CVC/CVS-(2.5,2.5)/CVS+
2CVC/2.5+(2.5,2.5)/2.5+DVC**AVI-(1.09866,0.45508)**2+DVC**2+
3(1.09866,0.45508)**AVI)**2/(0.0,72.0)
WRITE (NUVI,1482) RVC
1482 FORMAT(2X,2F8.4// 37H TEST IS POSITIVE IF NUMBERS PRINTED/2X,
1 17HABOVE ARE 1.0,0.0)
WRITE (NUVI, 1484)
1484 FORMAT(// 39H ERROR SHOULD NOT EXCEED + OR - .0001 )
C***** END OF TEST SEGMENT 148
C***** WHEN EXECUTING ONLY SEGMENT 148, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** MISC3 - (149)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST EFFECT OF BLANKS WITHIN STATEMENT, 3.1.4.1
C***** CONTINUATION OF STATEMENT TO MAX.NO.OF LINES, 3.2.4,3.3
C***** AND USE OF SPECIAL CHARACTERS TO INDICATE CONTINUATION 3.2.4
C***** LINE -
C***** FOR BASIC INTEGERS AND REAL NUMBERS
C*****
C***** S P E C I F I C A T I O N S SEGMENT 149
C*****
C***** WHEN EXECUTING ONLY SEGMENT 149, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION A1S(5),A2S(2,2)
C= INTEGER I1I(5),I2I(2,2)
C*****
C***** O U T O U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 149, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,1490)
1490 FORMAT(1H1,1X,37HMISC3 - (149) EFFECT OF BLANKS WITHIN/16X,
122HSTMNT AND CONTINUATION/16X,20HOF STMNT TO 20 LINES//
239H ASA REFS. - 3.1.4.1 3.2.4.3.3 3.2.4//2X,7HRESULTS )
J A C V I = 1
I
=1
+I
-(
*2
/) =2
I 2I( 2 , 1) = 3
A CV S = - 1 .0 E 0
A 1 S ( 2) = -2 00 . E - 2
A 2 S ( 2 , 1 ) = - .0 3 E + 2
K B
* CVI
( =
) J A
$ C V
. I
, + I
/ 1 I
= ( 2
1 )
2 +
3I
4 2
5 I
6 (
7 2
8 ,
9 1
A )
B - 6
C M
= A
, V S
( =
$ A
* C
. V
) S
/+
1 A 1
2 S
3 (
42) +
5 A
6 2
7 S (
8 2 , 1
9)
A +
B 6 . 0
W RI T E (NU VI , 1 49 1 ) KB CVI , CMA VS
1 491 F O RM A T (//I10//F11.1// 2 X, 35HTEST IS POSITIVE IF NUMBERS PRI
1NTED/ 2 X, 1 1HABOVE ARE 0)
C***** END OF TEST SEGMENT 149
C***** WHEN EXECUTING ONLY SEGMENT 149, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** MISC4 - (150)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST EFFECT OF BLANKS WITHIN STATEMENT, 3.1.4.1
C***** CONTINUATION OF STATEMENT TO 20 LINES, 3.2.4.3.3
C***** AND USE OF SPECIAL CHARACTERS TO INDICATE CONTINUATION 3.2.4
C***** CONTINUATION LINE CAN CONTAIN FORTRAN CHARACTERS
C***** (OTHER THAN C IN COLUMN 1) IN COLUMNS 1 THRU 5 (CLARIFICATION 3)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 150
C*****
C***** WHEN EXECUTING ONLY SEGMENT 150, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= INTEGER AVI
C= COMPLEX AVC,BVC,CVC,DVC,RVC
C*****
C***** O U T O U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 150, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI, 1500)
1 500 F O RM A T( 1 H1 , 1 X , 13 HMISC4 - (150)
X,1X, 2 3 HEFFECT OF BLANKS WITHIN / 16X, 22HSTMNT AND CON
YTINUATION/ 16X, 20HOF STMNT TO 20 LINES//
I39H ASA REFS. - 3.1.4.1 3.2.4.3.3 3.2.4//2X,7HRESULTS//)
AVC = (1 .0 , 1 .0)
AVS = 1. 0
B V S = 2 . 0
BVC= (1 .0 ,- 1 .0)
RVC = (B VS +A V C*( 1 . +A VC *( - 1.+ (1 .0, 1
T. 0 ) *( - 1 .0+ A V C ) )) ) /(
U4 .0 + BV C * (2 . 0 + BVC *
V( - A V S + B V C *( 0 . 5 + B
WV C ) ) ) )
RVC = RV C +(-2.0, +1 .0)
W RI T E (N UV I , 15 02 ) R VC
1502 FORMAT( 2X, 2F8.4)
C*****COMPLEX ARITHMETIC EXPRESSION
C***** STATEMENT LABEL NOT REFERENCED 3.4
1503 A
VC=1.+V
-C
* =
/ (
(1
).
,6
.0
I,
J3
K.
L2
M )
C***** CONTINUE STATEMENT WITH NO LABEL 3.4
CONTINUE
AVS = 0.625
BVS = 2.0
BVC = (1.0,-1.0)
CVS = 2.5
CVC = (2.5,2.5)
DVC = (1.0986841, 0.4550899)
AVI = 2
RVC =
B(AVC*AVS
C+(1.6,3.2)
D*AVS-AVC
E*0.625
F-(1.6,3.2)
G*0.625
H+BVS/BVC
I-BVS/(1.0,-1.0)
J+2.0/BVC+2.0/
K(1.0,-1.0)+CVC/CVS
L-(2.5,2.5)/CVS+CVC/2.5
M+(2.5,2.5)/2.5+DVC**AVI
N-(1.0986841,0.4550899)**2
O+DVC**2
P+
Q(1.0986841,0.4550899)
R**AVI)
S**2/(0.0,72.0)
T -(1.0,0.0)
W R I T E ( N U V I , 1 5 0 1) R V C
15 01 FORM AT(/ /2 X , 2 F 8 . 4
1501 Z/ / 3 7H TEST IS POSITIVE IF NUMBERS PRINTED/ 2X
=, 1 7 HABOVE ARE 0.0,0.0 )
C***** END OF TEST SEGMENT 150
C***** WHEN EXECUTING ONLY SEGMENT 150, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
nbs10.d 480890343 170 2 100666 299 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2 . DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4 . DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6 DOUBLE SPACE ON OUTPUT ID 6
nbs10.f 535327858 170 2 100666 34707 `
C***** PART10 ****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 10 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** BRFCP - 160 REAL EXTERNAL FUNCTIONS
C*****
C***** AFS - 400 REAL ARGUMENT
C*****
C***** BFS - 420 REAL ARGUMENTS
C*****
C***** CFS - 430 INTEGER ARGUMENT
C*****
C***** DFS - 440 INTEGER ARGUMENTS
C*****
C***** EFS - 450 ARRAY NAME
C*****
C***** FFS - 460 DIFFERENT TYPES OF ARGUMENTS
C*****
C***** BIFCP - 161 INTEGER EXTERNAL FUNCTIONS
C*****
C***** IAFI - 401 REAL ARGUMENT
C*****
C***** IBFI - 421 REAL ARGUMENTS
C*****
C***** ICFI - 431 INTEGER ARGUMENT
C*****
C***** IDFI - 441 INTEGER ARGUMENTS
C*****
C***** IEFI - 451 ARRAY NAME
C*****
C***** IFFI - 461 DIFFERENT TYPES OF ARGUMENTS
C*****
C***** FRFCP - 162 REAL FUNCTIONS
C*****
C***** GFS - 402 D.P. ARGUMENT
C*****
C***** HFS - 422 COMPLEX ARGUMENTS
C*****
C***** IRFS - 432 LOGICAL ARGUMENT
C*****
C***** JRFS - 442 EXTERNAL PROCEDURE
C*****
C***** RFS - 452 DIFFERENT TYPES OF ARGUMENTS
C*****
C***** FIFCP - 163 INTEGER FUNCTIONS
C*****
C***** IFI - 403 D.P. ARGUMENT
C*****
C***** JFI - 423 COMPLEX ARGUMENTS
C*****
C***** KFI - 433 LOGICAL ARGUMENT
C*****
C***** LFI - 443 EXTERNAL PROCEDURE
C*****
C***** MFI - 453 DIFFERENT TYPES OF ARGUMENTS
C*****
C***** CFCCP - 164 COMPLEX FUNCTIONS
C*****
C***** AFC - 404 REAL ARGUMENT
C*****
C***** BFC - 414 INTEGER ARGUMENT
C*****
C***** CFC - 424 ARRAY NAME
C*****
C***** DFC - 434 D.P. ARGUMENT
C*****
C***** EFC - 444 COMPLEX ARGUMENT
C*****
C***** FFC - 454 LOGICAL ARGUMENT
C*****
C***** HFC - 464 DIFFERENT TYPES OF ARGUMENTS
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN
C***** SEGMENTS 160, 161, 162, 163, 164
C***** ARE RUN AS ONE MAIN PROGRAM.
C*****
DIMENSION A1S(5), A2S(2,2) , A3S(3,3,3)
INTEGER I1I(5), I2I(2,2), I3I(2,2,2)
REAL JRFS, IRFS
LOGICAL A1B(2), A2B(2,2), A3B(2,2,2), AVB, BVB
DOUBLE PRECISION AVD, A1D(4), A2D(2,2), A3D(2,2,2)
COMPLEX AVC, BVC,AFC, BFC, CFC, DFC, EFC, FFC, HFC
1 , A1C(12), A2C(2,2), A3C(2,2,1)
COMMON AXVS, CXVS
EXTERNAL GFS, BFC, IFI
C*****
C***** END OF SPECIFICATIONS FOR SEGMENTS
C***** 160,161, 162, 163, 164
C***********************************************************************
C*****
C***** BRFCP - (160)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** 1.TO TEST REAL FUNCTIONS 8.3.1
C***** 2.DUMMY ARGUMENTS ARE REAL OR INTEGER VARIABLES,OR
C***** ARRAY NAMES
C***** 3.FUNCTIONS CONTAIN UP TO 20 ARGUMENTS
C***** 4.IN REFERENCE, ACTUAL ARGUMENTS ARE VARIABLE NAME,
C***** ARRAY NAME, ARRAY ELEMENT NAME, OR AN ARITHMETIC
C***** EXPRESSION 8.3.2
C***** RESTRICTIONS OBSERVED
C***** 1.ITEMS(2),(3),(4),(5),(6) OF PARAGRAPH 8.3.1
C***** 2.LAST SENTENCE OF PARAGRAPH 3.2
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS
C***** 400, 420, 430, 440, 450, 460 WHICH
C***** CONTAINS ALL FUNCTIONS BEING TESTED HERE.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 160
C*****
C***** WHEN EXECUTING ONLY SEGMENT 160, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH
C***** APPEAR AS COMMENTS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION A1S(5),A2S(2,2)
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENT
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 10///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
WRITE(NUVI,1604)
1604 FORMAT(1H1,1X,37HBRFCP - (160) REAL EXTERNAL FUNCTIONS/
1 /2X,16HASA REF. - 8.3.1//28H RESULTS SHOULD BE POSITIVE)
IAVI=2
A1S(1)=1.0
A1S(2)=1.0
A2S(2,2)=1.0
A2S(2,1)=1.0
AVS=1.0
BVS=2.0
CVS=1.0
DVS=1.0
EVS=1.0
IVI=AFS(2.0)-8.0
MAVI=1
IF(IVI)1600,1601,1600
1605 IVI=BFS(2.0,BVS)-4.0
MAVI=2
IF(IVI)1600,1601,1600
1606 IVI = CFS(2) -16.0
MAVI=3
IF(IVI)1600,1601,1600
1607 IVI=DFS(2,IAVI)-1.0
MAVI=4
IF(IVI)1600,1601,1600
1608 IVI=EFS(A1S)-2.0
MAVI=5
IF(IVI)1600,1601,1600
1609 IVI=FFS(IAVI,AVS,+2,-1.0,A1S,IAVI,CVS,A1S,1.0,IAVI,A1S,A1S,BVS,DVS
1 ,A1S(1),A2S,A2S,A2S,EVS+1.0,IAVI-1) + 1.0
print *, IAVI,AVS,+2,-1.0,A1S,IAVI,CVS,A1S,1.0,IAVI,A1S,A1S,
& BVS,DVS,A1S(1),A2S,A2S,A2S,EVS+1.0,IAVI-1
MAVI=6
IF(IVI) 1600,1601,1600
1600 WRITE (NUVI,1602)MAVI
GO TO 7001
1601 WRITE (NUVI,1603)MAVI
1602 FORMAT (//2X,5HTEST ,I1,12H IS NEGATIVE)
1603 FORMAT (//2X,5HTEST ,I1,12H IS POSITIVE)
7001 GO TO (1605,1606,1607,1608,1609,7000 ),MAVI
7000 CONTINUE
C***** END OF TEST SEGMENT 160
C***** WHEN EXECUTING ONLY SEGMENT 160, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN
C***** COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** BIFCP - (161)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** 1-TO TEST INTEGER FUNCTIONS 8.3.1
C***** 2-DUMMY ARGUMENTS ARE REAL OR INTEGER VARIABLES OR
C***** ARRAY NAMES 8.3.1
C***** 3-FUNCTIONS CONTAIN UP TO 20 ARGUMENTS
C***** 4-IN REFERENCE,ACTUAL ARGUMENTS ARE VARIABLE NAME,
C***** ARRAY NAME,ARRAY ELEMENT NAME,OR AN ARITHMETIC
C***** EXPRESSION 8.3.2
C*****RESTRICTIONS OBSERVED
C***** 1-ITEMS (2),(3),(4),(5),(6) OF PARAGRAPH 8.3.1
C***** 2-LAST SENTENCE OF PARAGRAPH 3.2
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS
C***** 401, 421, 431, 441, 451, 461 WHICH
C***** CONTAINS ALL FUNCTIONS BEING TESTED HERE.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 161
C*****
C***** WHEN EXECUTING ONLY SEGMENT 161, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION A1S(5)
C= INTEGER I1I(5)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 161, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE(NUVI,1614)
1614 FORMAT(1H1,1X,40HBIFCP - (161) INTEGER EXTERNAL FUNCTIONS/
1 16X,26HWITH INTEGER AND REAL ARGS//2X,16HASA REF. - 8.3.1//
228H RESULTS SHOULD BE POSITIVE)
IAVI=2
A1S(1)=1.0
A1S(2)=1.0
I1I(1)=1
I1I(2)=1
AVS=1.0
BVS=2.0
CVS=1.0
DVS=1.0
EVS=1.0
IVI=IAFI(2.0) - 8
MAVI=1
IF (IVI) 1610,1611,1610
1615 IVI=IBFI(2.0,BVS)-4
MAVI=2
IF (IVI) 1610,1611,1610
1616 IVI = ICFI(2) - 16
MAVI=3
IF (IVI) 1610,1611,1610
1617 IVI=IDFI(2,IAVI)-1
MAVI=4
IF (IVI) 1610,1611,1610
1618 IVI=IEFI(I1I)-2
MAVI=5
IF (IVI) 1610,1611,1610
1619 IVI=IFFI(IAVI,AVS,2,-1.0,A1S,IAVI,CVS,A1S,1.0,IAVI,A1S,A1S,BVS,
1DVS,A1S(1),A1S,A1S,A1S,EVS+1.0,IAVI-1) + 1
MAVI=6
IF(IVI) 1610,1611,1610
1610 WRITE(NUVI,1612)MAVI
GO TO 7002
1611 WRITE(NUVI,1613)MAVI
1612 FORMAT (//2X,5HTEST ,I1,12H IS NEGATIVE)
1613 FORMAT (//2X,5HTEST ,I1,12H IS POSITIVE)
7002 GO TO (1615,1616,1617,1618,1619,7003),MAVI
7003 CONTINUE
C***** END OF TEST SEGMENT 161
C***** WHEN EXECUTING ONLY SEGMENT 161, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** FRFCP - (162)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** 1.TO TEST REAL FUNCTIONS IN FULL FORTRAN
C***** 2.THIS SEGMENT COMPLETES SEGMENT (160) IN ORDER TO TEST
C***** FOR ALL FEATURES REQUIRED IN FULL FORTRAN 8.3.1
C***** 3.DUMMY ARGUMENTS CAN BE INTEGER(TESTED IN 160),REAL(TESTED IN
C***** 160),ARRAY NAME(TESTED IN 160),DOUBLE PRECISION,COMPLEX,
C***** LOGICAL OR EXTERNAL PROCEDURE 8.3.1
C***** 4.DUMMY ARGUMENTS MAY BE REDEFINED IN SUBPROGRAM(ITEM 4) 8.3.1
C***** 5.IN REFERENCE, ACTUAL ARGUMENTS MAY BE AS IN (160) AND
C***** BESIDES EXTERNAL PROCEDURE. IN THIS CASE, EXTERNAL 8.3.2
C***** PROCEDURE IS REFERENCED BY AN EXTERNAL STATEMENT
C***** 6.USE CAN BE MADE OF ADJUSTABLE DIMENSION
C*****RESTRICTIONS OBSERVED
C***** 1.ITEMS (1), (2), (3), (5) OF 8.3.1
C***** 2.PARAGRAPH 8.3.2, LINE 18 TO END OF PARAGRAPH
C***** THIS SEGMENT USES 5 REAL FUNCTIONS
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS
C***** 402, 422, 432, 442, 452 WHICH
C***** WHICH CONTAINS ALL FUNCTIONS BEING TESTED HERE
C*****
C***** S P E C I F I C A T I O N S SEGMENT 162
C*****
C***** WHEN EXECUTING ONLY SEGMENT 162, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3)
C= INTEGER I1I(5),I2I(2,2),I3I(2,2,2)
C= REAL JRFS,IRFS
C= LOGICAL A1B(2),A2B(2,2),A3B(2,2,2),AVB,BVB
C= DOUBLE PRECISION AVD,A1D(4),A2D(2,2),A3D(2,2,2)
C= COMPLEX AVC,BVC,A1C(12),A2C(2,2),A3C(2,2,1)
C= COMMON AXVS,CXVS
C= EXTERNAL GFS
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 162, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,1624)
1624 FORMAT(1H1,1X,33HFRFCP - (162) REAL FUNCTIONS WITH/10X,31HLOGICAL,
1 D.P., AND COMPLEX ARGS//16H ASA REF. 8.3.1//
228H RESULTS SHOULD BE POSITIVE)
C*****TEST 1
AVD = 1.0D0
MAVI = 1
IVI = 1.0-GFS(AVD)
IF (IVI) 1620,1621,1620
C*****TEST 2
1625 MAVI =2
AVC = (1.0,-1.0)
BVC = (1.0,1.0)
IVI = HFS(AVC,BVC)
IF (IVI) 1620,1621,1620
C*****TEST 3
1626 MAVI=3
AVB = .TRUE.
IVI = IRFS(AVB)*2.0
AVB = .FALSE.
JVI = IRFS(AVB)*4.0
LVI = IVI + JVI - 4
IF (LVI) 1620,1621,1620
C*****TEST 4
1627 MAVI=4
IVI = JRFS(AVD,GFS)
IF (IVI-1) 1620,1621,1620
C*****TEST 5,6,7
1628 AXVS = 1.0
AVS = 1.0
A1S(1) = 1.0
A2S(1,1) = 1.0
A3S(1,1,1) = 1.0
AVB = .FALSE.
A1B(1) = .FALSE.
A2B(1,1) = .FALSE.
A3B(1,1,1) = .FALSE.
IAVI = 1
I1I(1) = 1
I2I(1,1) =1
I3I(1,1,1) =1
A1C(1) = (1.0,1.0)
A2C(1,1) = (1.0,1.0)
A3C(1,1,1) = (-2.0,-2.0)
AVD = 1.0D0
A1D(1) = 1.0D0
A2D(1,1) = 1.0D0
A3D(1,1,1) = 1.0D0
IVI= RFS(AVS,IAVI,AVB,AVC,AVD,A1S,A2S,A3S,I1I,I2I,I3I,A1B,A2B,A3B,
1 A1C,A2C,A3C,A1D,A2D,A3D,GFS)
MAVI = 5
IF (IVI) 1620,1621,1620
1629 MAVI = 6
BVB = AVB.AND.A1B(1).AND.A2B(1,1).AND.A3B(1,1,1)
IF (BVB) GO TO 1621
GO TO 1620
7010 IVI=REAL(AVC)
JVI = AIMAG(AVC)
MAVI = 7
BVB = IVI.EQ.0.AND.JVI.EQ.0
IF (BVB) GO TO 1621
1620 WRITE (NUVI,1622) MAVI
GO TO 7011
1621 WRITE (NUVI,1623) MAVI
1622 FORMAT(//2X,5HTEST ,I1,13H IS NEGATIVE.)
1623 FORMAT (//2X,5HTEST ,I1,13H IS POSITIVE.)
7011 GO TO (1625,1626,1627,1628,1629,7010,7012),MAVI
7012 CONTINUE
C***** END OF TEST SEGMENT 162
C***** WHEN EXECUTING ONLY SEGMENT 162, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** FIFCP - (163)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** 1.TO TEST INTEGER FUNCTIONS IN FULL FORTRAN
C***** 2.THIS SEGMENT COMPLETES SEGMENT (161) IN ORDER TO TEST
C***** FOR ALL FEATURES REQUIRED IN FULL FORTRAN. 8.3.1
C***** 3.DUMMY ARGUMENTS CAN BE INTEGER(TESTED IN 161),REAL(TESTED
C***** IN 161),DOUBLE PRECISION,COMPLEX,LOGICAL,OR EXTERNAL PROCEDURE
C***** 4.DUMMY ARGUMENTS MAY BE REDIFINED IN SUBPROGRAM(ITEM 4)
C***** 5. IN REFERENCE,ACTUAL ARGUMENTS MAY BE AS IN (161) AND BESIDES
C***** EXTERNAL PROCEDURE.IN THIS CASE,EXTERNAL PROCEDURE IS
C***** REFERENCED BY AN EXTERNAL STATEMENT.
C***** 6. USE CAN BE MADE OF ADJUSTABLE DIMENSION.
C*****RESTRICTIONS OBSERVED
C***** 1.ITEMS (1),(2),(3),(5), OF 8.3.1
C***** 2 PARAGRAPH 8.3.2,LINE 18 TO END OF PARAGRAPH
C***** THIS SEGMENT USES 5 INTEGER FUNCTIONS
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS
C***** 403, 423, 433, 443, 453 WHICH
C***** WHICH CONTAINS ALL FUNCTIONS BEING TESTED HERE
C*****
C***** S P E C I F I C A T I O N S SEGMENT 163
C*****
C***** WHEN EXECUTING ONLY SEGMENT 163, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= EXTERNAL IFI
C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3)
C= INTEGER I1I(5),I2I(2,2),I3I(2,2,2)
C= LOGICAL AVB,BVB,A1B(2),A2B(2,2),A3B(2,2,2)
C= DOUBLE PRECISION AVD,A1D(4),A2D(2,2),A3D(2,2,2)
C= COMPLEX AVC,BVC,A1C(12),A2C(2,2),A3C(2,2,1)
C= COMMON AXVS,CXVS
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 163, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE(NUVI,1634)
1634 FORMAT (1H1,1X,33HFIFCP - (163) INTEGER FUNCTION IN/ 16X,
1 12HFULL FORTRAN//2X,
214HASA REF. 8.3.1//28H RESULTS SHOULD BE POSITIVE)
C***** TEST 1
AVD=1.0D0
MAVI=1
IVI=1-IFI(AVD)
IF (IVI) 1630,1631,1630
C***** TEST 2
1635 MAVI=2
AVC=(1.0, 1.0)
BVC=(1.0,-1.0)
IVI=JFI(AVC,BVC)
IF (IVI) 1630,1631,1630
C*****TEST 3
1636 MAVI=3
AVB=.TRUE.
IVI=KFI(AVB)*2
AVB=.FALSE.
JVI=IVI+KFI(AVB)-4
IF (JVI) 1630,1631,1630
C***** TEST 4
1637 MAVI=4
IVI=LFI(AVD,IFI)-1
IF (IVI) 1630,1631,1630
C***** TESTS 5,6,7
1638 AXVS=1.0
AVS = 1.
A1S(1)=1.0
A2S(1,1)=1.0
A3S(1,1,1)=1.0
IAVI=1
I1I(1) = 1
I2I(1,1)=1
I3I(1,1,1)=1
A1C(1)=(1.0,1.0)
A2C(1,1)=(1.0,1.0)
A3C(1,1,1)=(-2.0,-2.0)
AVD=1.0D0
A1D(1)=1.0D0
A2D(1,1)=1.0D0
A3D(1,1,1)=1.0D0
IVI=MFI(AVS,IAVI,AVB,AVC,AVD,A1S,A2S,A3S,I1I,I2I,I3I,A1B,A2B,A3B,
1A1C,A2C,A3C,A1D,A2D,A3D,IFI)
MAVI=5
IF (IVI) 1630,1631,1630
1639 MAVI=6
BVB=AVB.AND.A1B(1).AND.A2B(1,1).AND.A3B(1,1,1)
IF (BVB) GO TO 1631
IF (.NOT.BVB) GO TO 1630
7007 IVI=REAL(AVC)
JVI=AIMAG(AVC)
MAVI=7
IF (IVI+JVI) 1630,1631,1630
1630 WRITE(NUVI,1632) MAVI
GO TO 7008
1631 WRITE(NUVI,1633) MAVI
1632 FORMAT (//2X,5HTEST ,I2,12H IS NEGATIVE)
1633 FORMAT(//2X,5HTEST , I2,12H IS POSITIVE)
7008 GO TO (1635,1636,1637,1638,1639,7007,7009),MAVI
7009 CONTINUE
C***** END OF TEST SEGMENT 163
C***** WHEN EXECUTING ONLY SEGMENT 163, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** CFCCP-(164)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** 1.TO TEST COMPLEX FUNCTIONS IN FULL FORTRAN 8.3.1
C***** 2.DUMMY ARGUMENTS ARE REAL,INTEGER,COMPLEX,LOGICAL,
C***** DOUBLE PRECISION,EXTERNAL PROCEDURE,ARRAY NAME.
C***** 3.FUNCTIONS CONTAIN UP TO 20 ARGUMENTS
C***** 4.IN REFERENCE ACTUAL ARGUMENTS ARE VARIABLE NAME
C***** ARRAY NAME,ARRAY ELEMENT NAME,ARITHMETIC EXPRESSION
C***** EXTERNAL PROCEDURE
C***** 6.USE CAN BE MADE OF ADJUSTABLE DIMENTION
C***** 7.ARGUMENTS CAN BE PASSED THROUGH COMMON
C*****RESTRICTIONS OBSERVED
C***** 1.ITEMS(2),(3),(4),(5),(6) OF PARAGRAPH
C***** 2.LAST SENTENCE OF PARAGRAPH 3.2
C***** THIS SEGMENT USES 8 COMPLEX FUNCTIONS
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS
C***** 404, 414, 424, 434, 444, 454, 464
C***** WHICH CONTAIN ALL FUNCTIONS BEING TESTED HERE
C*****
C***** S P E C I F I C A T I O N S SEGMENT 164
C*****
C***** WHEN EXECUTING ONLY SEGMENT 164, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3)
C= INTEGER I1I(5),I2I(2,2),I3I(2,2,2)
C= LOGICAL AVB,A1B(2),A3B(2,2,2),A2B(2,2),BVB
C= DOUBLE PRECISION AVD,A1D(4),A2D(2,2),A3D(2,2,2)
C= COMPLEX AFC,BFC,CFC,DFC,EFC,FFC,HFC,AVC,BVC
C= 1,A1C(12),A2C(2,2),A3C(2,2,1)
C= COMMON AXVS,CXVS
C= EXTERNAL BFC
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 164, THE STATEMENT NUVI = 6
C***** MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE(NUVI,1641)
1641 FORMAT(1H1,1X,31HCFCCP - (164) COMPLEX FUNCTIONS//2X,
1 21HASA REFS. 8.3.1,8.3.2//2X, 7HRESULTS)
C***** TEST 1
BVC=AFC(1.0)
MAVI=1
WRITE(NUVI,1642) BVC,MAVI
1642 FORMAT(1H0,2F5.1,9H -- TEST ,I2,20H POSITIVE IF 0.0,0.0)
C***** TEST 2
MAVI=2
BVC= BFC(1)-(1.0,1.0)
WRITE(NUVI,1642)BVC,MAVI
C***** TEST 3
MAVI=3
A1S(1)=1.0
A1S(2)=1.0
BVC=CFC(A1S)
WRITE(NUVI,1642)BVC,MAVI
C***** TEST 4
MAVI=4
BVC = DFC (1.D0)
WRITE(NUVI,1642)BVC,MAVI
C*****TEST 5
MAVI=5
AVC=(1.0,1.0)
BVC=EFC(AVC)
WRITE(NUVI,1642)BVC,MAVI
C*****TEST 6
MAVI=6
AVB=.TRUE.
BVC=FFC(AVB)-(1.0,1.0)
WRITE(NUVI,1642)BVC,MAVI
C***** TEST 7
MAVI=7
AVB=.FALSE.
BVC=FFC(AVB)
WRITE(NUVI,1642)BVC,MAVI
C***** TEST 8,9,10
IVI=1
AVD=1.0D0
A1D(1)=1.0D0
A2D(1,1)=1.0D0
A3D(1,1,1)=1.0D0
AVS=1.0
A1S(1)=1.0
A2S(1,1)=1.0
A3S(1,1,1)=1.0
A1C(1)=(1.0,1.0)
A2C(1,1)=(1.0,1.0)
A3C(1,1,1)=(1.0,1.0)
I1I(1)=1
I2I(1,1)=1
I3I(1,1,1)=1
AVC = (0.0,0.0)
BVC= HFC(AVS,IVI,AVB,AVC,AVD,A1S,A2S,A3S,I1I,I2I,I3I,A1B,A2B,A3B,
1A1C,A2C,A3C,A1D,A2D,A3D,BFC)
MAVI = 8
WRITE (NUVI,1642) BVC,MAVI
MAVI=9
IF(AXVS) 1643,1644,1643
1648 MAVI = 10
BVB=AVB.AND.A1B(1).AND.A2B(1,1).AND. A3B(1,1,1)
IF (BVB) GO TO 1644
1643 WRITE(NUVI,1645)MAVI
GO TO 1647
1644 WRITE(NUVI,1646)MAVI
1645 FORMAT(/15X,5HTEST ,I2,12H IS NEGATIVE)
1646 FORMAT(/15X,5HTEST ,I2,12H IS POSITIVE)
1647 IF (MAVI - 9) 1649,1648,1649
1649 CONTINUE
C***** END OF TEST SEGMENT 164
C***** WHEN EXECUTING ONLY SEGMENT 164, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
C***********************************************************************
C*****
C***** AFS - (400)
C*****
C***********************************************************************
C*****REAL FUNCTION OF REAL ARGUMENT (TEST 1)
FUNCTION AFS(AWVS)
AFS=4.0*AWVS
RETURN
END
C***********************************************************************
C*****
C***** BFS - (420)
C*****
C***********************************************************************
C*****REAL FUNCTION OF REAL ARGUMENTS (TEST 2)
FUNCTION BFS(AWVS,BWVS)
BFS=AWVS+BWVS
RETURN
END
C***********************************************************************
C*****
C***** CFS - (430)
C*****
C***********************************************************************
C*****REAL FUNCTION OF INTEGER ARGUMENT (TEST 3)
FUNCTION CFS(IWVI)
CFS=4.0**IWVI
RETURN
END
C***********************************************************************
C*****
C***** DFS - (440)
C*****
C***********************************************************************
C*****REAL FUNCTION OF INTEGER ARGUMENTS (TEST 4)
FUNCTION DFS(IWVI,JWVI)
KVI = IWVI - JWVI
DFS=4.6**KVI
RETURN
END
C***********************************************************************
C*****
C***** EFS - (450)
C*****
C***********************************************************************
C*****REAL FUNCTION OF ARRAY NAME(TEST 5)
FUNCTION EFS(AW1S)
DIMENSION AW1S(2)
EFS=AW1S(1)+AW1S(2)
RETURN
END
C***********************************************************************
C*****
C***** FFS - (460)
C*****
C***********************************************************************
C*****REAL FUNCTION OF DIFFERENT TYPES OF ARGUMENTS(TEST 6)
FUNCTION FFS(IWVI,AWVS,JWVI,BWVS,AW1S,KWVI,CWVS,BW1S,DWVS,LWVI,
1CW1S,DW1S,EWVS,FWVS,GWVS,BW2S,CW2S,DW2S,HWVS,MWVI)
DIMENSION AW1S(2),BW1S(2),CW1S(2),DW1S(2),BW2S(2,2),CW2S(2,2),
1DW2S(2,2)
print *, 'FUNCTION FFS:\n',IWVI,AWVS,JWVI,BWVS,AW1S,KWVI,CWVS,
1BW1S,DWVS,LWVI,CW1S,DW1S,EWVS,FWVS,GWVS,BW2S,CW2S,DW2S,HWVS,MWVI
FFS=AWVS**IWVI-BWVS**JWVI-AW1S(1)-CWVS**KWVI+BW1S(2)-DWVS+CW1S(1)
1**LWVI+DW1S(1)-EWVS+FWVS-GWVS+BW2S(2,1)-CW2S(2,2)+DW2S(2,2)-HWVS**
2MWVI
print *, 'ffs=', ffs
RETURN
END
C***********************************************************************
C*****
C***** IAFI - (401)
C*****
C***********************************************************************
C*****INTEGER FUNCTION OF REAL ARGUMENT (TEST 1)
FUNCTION IAFI(AWVS)
IAFI=4.0*AWVS
RETURN
END
C***********************************************************************
C*****
C***** IBFI - (421)
C*****
C***********************************************************************
C*****INTEGER FUNCTION OF TWO REAL ARGUMENTS (TEST 2)
FUNCTION IBFI(AWVS,BWVS)
IBFI=AWVS+BWVS
RETURN
END
C***********************************************************************
C*****
C***** ICFI - (431)
C*****
C***********************************************************************
C*****INTEGER FUNCTION OF INTEGER ARGUMENT(TEST 3)
FUNCTION ICFI(IWVI)
ICFI=4.0**IWVI
RETURN
END
C***********************************************************************
C*****
C***** IDFI - (441)
C*****
C***********************************************************************
C*****INTEGER FUNCTION OF INTEGER ARGUMENTS (TEST 4)
INTEGER FUNCTION IDFI (IWVI, JWVI)
REAL KUVS
DATA KUVS /4.6/
IDFI = IWVI - JWVI
IDFI = KUVS ** IDFI
RETURN
E N D
C***********************************************************************
C*****
C***** IEFI - (451)
C*****
C***********************************************************************
C*****INTEGER FUNCTION OF ARRAY NAME (TEST 5)
FUNCTION IEFI(IAW1I)
DIMENSION IAW1I(2)
IEFI=IAW1I(1)+IAW1I(2)
RETURN
END
C***********************************************************************
C*****
C***** IFFI - (461)
C*****
C***********************************************************************
C*****INTEGER FUNCTION OF DIFFERENT TYPES OF ARGUMENTS(TEST 6)
FUNCTION IFFI(IWVI,AWVS,JWVI,BWVS,AW1S,KWVI,CWVS,BW1S,DWVS,LWVI,
1CW1S,DW1S,EWVS,FWVS,GWVS,EW1S,GW1S,HW1S,HWVS,MWVI)
DIMENSION AW1S(2),BW1S(2),CW1S(2),DW1S(2),EW1S(5), GW1S(5),
1 HW1S(5)
IFFI=AWVS**IWVI-BWVS**JWVI+AW1S(1)-CWVS**KWVI+BW1S(2)-DWVS+CW1S(1)
1**LWVI+DW1S(1)-EWVS+FWVS-GWVS+EW1S(1) -GW1S(2) +HW1S(2) -HWVS**
2MWVI
RETURN
END
C***********************************************************************
C*****
C***** GFS - (402)
C*****
C***********************************************************************
C***** REAL FUNCTION OF DOUBLE PRECISION ARGUMENT (TEST 1)
FUNCTION GFS(AWVD)
DOUBLE PRECISION AWVD
GFS = AWVD
RETURN
END
C***********************************************************************
C*****
C***** HFS - (422)
C*****
C***********************************************************************
C*****REAL FUNCTION OF COMPLEX ARGUMENT (TEST 2)
FUNCTION HFS(AWVC,BWVC)
COMPLEX AWVC,BWVC,CVC
CVC = AWVC * BWVC
HFS = AIMAG(CVC)
RETURN
END
C***********************************************************************
C*****
C***** IRFS - (432)
C*****
C***********************************************************************
C*****REAL FUNCTION OF LOGICAL ARGUMENT (TEST 3)
REAL FUNCTION IRFS(AWVB)
LOGICAL AWVB
IF (AWVB) GO TO 4321
4320 IF (.NOT. AWVB) GO TO 4322
RETURN
4321 IRFS = 2.0
GO TO 4320
4322 IRFS = 0.0
RETURN
END
C***********************************************************************
C*****
C***** JRFS - (442)
C*****
C***********************************************************************
C*****REAL FUNCTION OF EXTERNAL PROCEDURE (TEST 4)
REAL FUNCTION JRFS( BWVD,BWFS)
DOUBLE PRECISION BWVD
JRFS = BWFS(BWVD)
RETURN
END
C***********************************************************************
C*****
C***** RFS - (452)
C*****
C***********************************************************************
C*****REAL FUNCTION OF DIFFERENT TYPES OF ARGUMENTS. USE IS MADE OF
C*****ADJUSTABLE DIMENSION (TEST 5, 6, 7)
FUNCTION RFS(AWVS,IWVI,AWVB,AWVC,AWVD,AW1S,AW2S,AW3S,IW1I,IW2I,
1IW3I,AW1B,AW2B,AW3B,AW1C,AW2C,AW3C,AW1D,AW2D,AW3D,AWFS)
LOGICAL AWVB,AW1B,AW2B,AW3B
COMPLEX AWVC,AW1C,AW2C,AW3C
DOUBLE PRECISION AWVD, AW1D,AW2D,AW3D
DIMENSION AW1S(IWVI),AW2S(IWVI,IWVI),AW3S(IWVI,IWVI,IWVI) ,
1 IW1I(IWVI),IW2I(IWVI,IWVI),IW3I(IWVI,IWVI,IWVI) ,
2 AW1B(IWVI),AW2B(IWVI,IWVI),AW3B(IWVI,IWVI,IWVI) ,
3 AW1C(IWVI),AW2C(IWVI,IWVI),AW3C(IWVI,IWVI,IWVI) ,
4 AW1D(IWVI),AW2D(IWVI,IWVI),AW3D(IWVI,IWVI,IWVI)
COMMON BXVS
RFS =AWVS**IWVI+AW1S(IWVI)**IW1I(IWVI)-AW2S(IWVI,IWVI)**IW2I
1 (IWVI,IWVI)+AW3S(IWVI,IWVI,IWVI)**IW3I(IWVI,IWVI,IWVI)-AWVD+
2 AW1D(IWVI)-AW2D(IWVI,IWVI)-AW3D(IWVI,IWVI,IWVI)+AWFS(AWVD)-BXVS
AWVB = IWVI.EQ.1
AW1B(IWVI) = IWVI .EQ. 1
AW2B(IWVI,IWVI) = IWVI .EQ. 1
AW3B(IWVI,IWVI,IWVI) = IWVI.EQ.1
AWVC = AW1C(IWVI) +AW2C(IWVI,IWVI)+AW3C(IWVI,IWVI,IWVI)
RETURN
C***** END OF TEST SEGMENT 402
END
C***********************************************************************
C*****
C***** IFI - (403)
C*****
C***********************************************************************
C***** INTEGER FUNCTION OF DOUBLE PRECISION ARGUMENT(TEST 1)
FUNCTION IFI(AWVD)
DOUBLE PRECISION AWVD
IFI=AWVD
RETURN
END
C***********************************************************************
C*****
C***** JFI - (423)
C*****
C***********************************************************************
C*****INTEGER FUNCTION OF COMPLEX ARGUMENT(TEST 2)
FUNCTION JFI(AWVC,BWVC)
COMPLEX AWVC,BWVC,CVC
CVC =AWVC*BWVC
JFI=AIMAG(CVC)
RETURN
END
C***********************************************************************
C*****
C***** KFI - (433)
C*****
C***********************************************************************
C*****INTEGER FUNCTION OF LOGICAL ARGUMENT(TEST 3)
FUNCTION KFI(AWVB)
LOGICAL AWVB
IF (AWVB) GO TO 4331
4330 IF (.NOT.AWVB) GO TO 4332
RETURN
4331 KFI = 2
GO TO 4330
4332 KFI = 0
RETURN
END
C***********************************************************************
C*****
C***** LFI - (443)
C*****
C***********************************************************************
C*****INTEGER FUNCTION OF EXTERNAL PROCEDURE(TEST 4)
FUNCTION LFI(BWVD,IWFI)
DOUBLE PRECISION BWVD
LFI=IWFI(BWVD)
RETURN
END
C***********************************************************************
C*****
C***** MFI - (453)
C*****
C***********************************************************************
C*****INTEGER FUNCTION OF DIFFERENT TYPES OF ARGUMENTS.USE IS MADE OF
C***** ADJUSTABLE DIMENSION(TEST 5,6,7)
FUNCTION MFI(AWVS,IWVI,AWVB,AWVC,AWVD,AW1S,AW2S,AW3S,IW1I,IW2I,
1IW3I,AW1B,AW2B,AW3B,AW1C,AW2C,AW3C,AW1D,AW2D,AW3D,IWFI)
DOUBLE PRECISION AWVD,AW1D,AW2D,AW3D
LOGICAL AWVB,AW1B,AW2B,AW3B
COMPLEX AWVC,AW1C,AW2C,AW3C
DIMENSION AW1S(IWVI),AW2S(IWVI,IWVI),AW3S(IWVI,IWVI,IWVI) ,
1 IW1I(IWVI),IW2I(IWVI,IWVI),IW3I(IWVI,IWVI,IWVI) ,
2 AW1B(IWVI),AW2B(IWVI,IWVI),AW3B(IWVI,IWVI,IWVI),
3 AW1C(IWVI),AW2C(IWVI,IWVI),AW3C(IWVI,IWVI,IWVI) ,
4 AW1D(IWVI),AW2D(IWVI,IWVI),AW3D(IWVI,IWVI,IWVI)
COMMON BXVS
MFI =AWVS**IWVI+AW1S(IWVI)**IW1I(IWVI)-AW2S(IWVI,IWVI)**IW2I
1 (IWVI,IWVI)+AW3S(IWVI,IWVI,IWVI)**IW3I(IWVI,IWVI,IWVI)-AWVD+
2 AW1D(IWVI)-AW2D(IWVI,IWVI)-AW3D(IWVI,IWVI,IWVI)+BXVS**IWFI(AWVD)
3 -1.0
AWVB=IWVI.EQ.1
AW1B(IWVI) = IWVI .EQ. 1
AW2B(IWVI,IWVI) = IWVI.EQ.1
AW3B(IWVI,IWVI,IWVI) = IWVI.EQ.1
AWVC = AW1C(IWVI) +AW2C(IWVI,IWVI)+AW3C(IWVI,IWVI,IWVI)
RETURN
END
C***********************************************************************
C*****
C***** AFC - (404)
C*****
C***********************************************************************
C*****COMPLEX FUNCTION OF REAL ARGUMENT (TEST 1)
COMPLEX FUNCTION AFC(AWVS)
AFC = (-1.0,0.0)+AWVS
RETURN
END
C***********************************************************************
C*****
C***** BFC - (414)
C*****
C***********************************************************************
C*****COMPLEX FUNCTION OF INTEGER ARGUMENT (TEST 2)
COMPLEX FUNCTION BFC(IWVI)
BFC=(1.0,1.0)**IWVI
RETURN
END
C***********************************************************************
C*****
C***** CFC - (424)
C*****
C***********************************************************************
C*****COMPLEX FUNCTION OF ARRAY NAME (TEST 3)
COMPLEX FUNCTION CFC(AW1S)
DIMENSION AW1S(2)
CFC = (2.0,0.0)-AW1S(1)-AW1S(2)
RETURN
END
C***********************************************************************
C*****
C***** DFC - (434)
C*****
C***********************************************************************
C*****COMPLEX FUNCTION OF DOUBLE PRECISION ARGUMENT (TEST 4)
COMPLEX FUNCTION DFC(AWVD)
DOUBLE PRECISION AWVD
AVS = AWVD
DFC = (1.0,1.0) * AVS - (1.0,1.0)
RETURN
END
C***********************************************************************
C*****
C***** EFC - (444)
C*****
C***********************************************************************
C*****COMPLEX FUNCTION OF COMPLEX ARGUMENT (TEST 5)
COMPLEX FUNCTION EFC(AWVC)
COMPLEX AWVC
EFC=AWVC- (1.0,1.0)
RETURN
END
C***********************************************************************
C*****
C***** FFC - (454)
C*****
C*****COMPLEX FUNCTION OF LOGICAL ARGUMENT(TESTS 6,7)
COMPLEX FUNCTION FFC(AWVB)
LOGICAL AWVB
IF (AWVB) GO TO 4541
4540 IF (.NOT.AWVB) GO TO 4542
RETURN
4541 FFC = (1.0,1.0)
GO TO 4540
4542 FFC = (0.0,0.0)
RETURN
END
C***********************************************************************
C*****
C***** HFC - (464)
C*****
C***********************************************************************
C*****COMPLEX FUNCTION OF DIFFERENT TYPES OF ARGUMENTS (TESTS 8,9,10
COMPLEX FUNCTION HFC(AWVS,IWVI,AWVB,AWVC,AWVD,AW1S,AW2S,AW3S,
1 IW1I,IW2I,IW3I,AW1B,AW2B,AW3B,AW1C,AW2C,AW3C,AW1D,AW2D,AW3D,AWFC)
DIMENSION AW1S(IWVI),AW2S(IWVI,IWVI),AW3S(IWVI,IWVI,IWVI),
1 IW1I(IWVI),IW2I(IWVI,IWVI),IW3I(IWVI,IWVI,IWVI),
2 AW1B(IWVI),AW2B(IWVI,IWVI),AW3B(IWVI,IWVI,IWVI),
3 AW1C(IWVI),AW2C(IWVI,IWVI),AW3C(IWVI,IWVI,IWVI),
4 AW1D(IWVI),AW2D(IWVI,IWVI),AW3D(IWVI,IWVI,IWVI)
COMMON BXVS
LOGICAL AWVB,AW1B,AW2B,AW3B
COMPLEX AWVC,AW1C,AW2C,AW3C, AWFC
DOUBLE PRECISION AWVD,AW1D,AW2D,AW3D
HFC = AWVC
BXVS=AWVS**IWVI+AW1S(IWVI)**IW1I(IWVI)-AW2S(IWVI,IWVI)**IW2I
1 (IWVI,IWVI)+AW3S(IWVI,IWVI,IWVI)**IW3I(IWVI,IWVI,IWVI)-AWVD+
2 AW1D(IWVI)-AW2D(IWVI,IWVI)-AW3D(IWVI,IWVI,IWVI)
AWVB = IWVI.EQ.1
AW1B(IWVI) = IWVI.EQ.1
AW2B(IWVI,IWVI) = IWVI .EQ. 1
AW3B(IWVI,IWVI,IWVI) = IWVI.EQ.1
RETURN
C***** END OF TEST SEGMENT 464
END
nbs11.d 480890343 170 2 100666 299 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2 . DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4 . DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6 DOUBLE SPACE ON OUTPUT ID 6
nbs11.f 480890360 170 2 100666 38476 `
C***** PART11 ****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 11 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** DPFCP - 165 DOUBLE PRECISION FUNCTIONS
C*****
C***** AFD - 405 REAL ARGUMENT
C*****
C***** BFD - 415 INTEGER ARGUMENT
C*****
C***** CFD - 425 D.P. ARGUMENT
C*****
C***** DFD - 435 COMPLEX ARGUMENTS
C*****
C***** EFD - 445 LOGICAL ARGUMENT
C*****
C***** FFD - 455 EXTERNAL PROCEDURE
C*****
C***** GFD - 465 ARRAY NAME
C*****
C***** HFD - 475 DIFFERENT TYPES OF ARGUMENTS
C*****
C***** BFCCP - 166 LOGICAL FUNCTIONS
C*****
C***** AFB - 406 REAL ARGUMENT
C*****
C***** BFB - 416 INTEGER ARGUMENT
C*****
C***** CFB - 426 D.P. ARGUMENT
C*****
C***** DFB - 436 LOGICAL ARGUMENT
C*****
C***** EFB - 446 COMPLEX ARGUMENT
C*****
C***** FFB - 456 ARRAY NAME
C*****
C***** GFB - 466 EXTERNAL PROCEDURE
C*****
C***** HFB - 476 DIFFERENT TYPES OF ARGUMENTS
C*****
C***** SBRTN - 167 SUBROUTINE SUBPROGRAM
C*****
C***** AAQ - 407 INTEGER AND REAL VARIABLES AND ARRAY ELEMENTS
C*****
C***** ABQ - 417 ARRAY ELEMENTS
C*****
C***** ACQ - 427 NO ARGUMENT LIST
C*****
C***** FSBRT - 168 SUBROUTINE SUBPROGRAM
C*****
C***** ADQ - 408 DIFFERENT TYPES OF ARGUMENTS
C*****
C***** AEQ - 418 ARRAY NAMES AND INTEGER ARGUMENTS
C*****
C***** AFQ - 428 NO ARGUMENT LIST
C*****
C***** BLKDT - 169 BLOCK DATA
C*****
C***** BLOKD - 409 BLOCK DATA SUBPROGRAM
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN
C***** SEGMENTS 165, 166, 167, 168, 169 ARE RUN AS ONE MAIN PROGRAM.
C*****
DIMENSION A1S(5), A2S(2,2), A3S(3,3,3)
DIMENSION IAB1I(4), IAB2I(3,3), IAB3I(2,2,2), AB1S(4)
1 ,AB2S(3,3), AB3S(2,2,2)
INTEGER I1I(5), I2I(2,2), I3I(2,2,2)
DOUBLE PRECISION AVD, A1D(4),A2D(2,2),A3D(2,2,2)
DOUBLE PRECISION AFD,BFD,CFD,DFD,EFD,FFD,GFD,HFD
DOUBLE PRECISION AXVD, AX1D, AX2D,AX3D
1 ,DXVD,DX1D,DX2D,DX3D
LOGICAL A1B(2), A2B(2,2), A3B(2,2,2),AXVB, AX1B, AX2B, AX3B,AVB
1 ,BVB,AFB,BFB,CFB,DFB,EFB,FFB,GFB,HFB , DXVB,DX1B,DX2B,DX3B
COMPLEX AVC,A1C(12),A2C(2,2), A3C(2,2,1)
COMPLEX AXVC, AX1C, AX2C, AX3C,DXVC, DX1C, DX2C, DZ3C
COMMON AXVS,CXVS
COMMON IXVI,IAX1I(4),IAX2I(3,3),IAX3I(2,2,2),BXVS,
- AX1S(4),AX2S(3,3),AX3S(2,2,2),AXVD,AX1D(2),AX2D(2,2),
B AX3D(2,2,2), AXVC, AX1C(2), AX2C(2,2), AX3C(2,2,2), AXVB,
C AX1B(2), AX2B(2,2), AX3B(2,2,2)
COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3)
A /BLK2/DXVS, DX1S(2), DX2S(2,2)
B /BLK3/DXVD, DX1D(2), DX2D(2,2)
C /BLK4/DXVC, DX1C(2), DX2C(2,2)
D /BLK5/DXVB, DX1B(2), DX2B(2,2)
E /BLK6/JAX3I(2,2,2), DX3S(2,2,2), DX3D(2,2,2),
F DZ3C(2,2,2), DX3B(2,2,2)
EXTERNAL AFB,CFD,AFD
INTRINSIC SQRT
C***** END OF SPECIFICATIONS FOR SEGMENTS
C***** 165, 166, 167, 168, 169
C*****
C***********************************************************************
C*****
C***** DPFCP-(165)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** 1.TO TEST DOUBLE PRECISION FUNCTIONS IN FULL FORTRAN 8.3.1
C***** 2.DUMMY ARGUMENTS ARE REAL,INTEGER,COMPLEX,LOGICAL,
C***** DOUBLE PRECISION,EXTERNAL PROCEDURE,ARRAY NAME
C***** 3.FUNCTIONS CONTAIN UP TO 20 ARGUMENTS
C***** 4.IN REFERENCE,ACTUAL ARGUMENTS ARE VARIABLE1NAME,
C***** ARRAY NAME,ARRAY ELEMENT NAME,OR ARITHMETIC EXPRESSION. 8.3.2
C*****RESTRICTIONS OBSERVED
C***** 1.ITEMS(2),(3),(4),(5),(6) OF PARAGRAPH 8.3.1
C***** 2 LAST SENTENCE OF PARAGRAPH 3.2
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS
C***** 405, 415, 425, 435, 445, 455, 465, 475 WHICH
C***** WHICH CONTAINS ALL FUNCTIONS BEING TESTED HERE
C*****
C***** S P E C I F I C A T I O N S SEGMENT 165
C*****
C***** WHEN EXECUTING ONLY SEGMENT 165, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH
C***** APPEAR AS COMMENTS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3)
C= INTEGER I1I(5),I2I(2,2),I3I(2,2,2)
C= LOGICAL A1B(2),A2B(2,2),A3B(2,2,2),AVB,BVB
C= DOUBLE PRECISION AFD, BFD, CFD, DFD, EFD, FFD, GFD, HFD,AVD
C= 1, A1D(4),A2D(2,2),A3D(2,2,2)
C= COMPLEX AVC,A1C(12),A2C(2,2),A3C(2,2,1)
C= COMMON AXVS,CXVS
C= EXTERNAL CFD,AFD
C*****
C***** I N P U T O U T P U T T A P E ASSIGNMENT STATEMENTS
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 11///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
C*****
WRITE (NUVI,1650)
1650 FORMAT(1H1,1X,30HDPFCP - (165) DOUBLE PRECISION/ 16X, 9HFUNCTIONS
1 //2X,21HASA REFS. 8.3.1,8.3.2//2X, 7HRESULTS)
C***** TEST 1
MAVI = 1
IVI = AFD(1.0) - 1.0D0
IF (IVI) 1652,1653,1652
C***** TEST 2
1657 MAVI =2
IVI=BFD(1)-1.0D0
IF(IVI)1652,1653,1652
C***** TEST 3
1658 MAVI =3
AVD=1.0D0
print *, 'TEST 3 ivi=',CFD(AVD)-1.0D0
IF(IVI) 1652,1653,1652
C***** TEST 4 .ONE ARGUMENT IS ARRAY ELEMENT NAME
1659 MAVI =4
AVC = (1.0,1.0)
A1C(1)=(1.0,-1.0)
IVI=DFD(AVC,A1C(1))
IF (IVI) 1652,1653,1652
C***** TEST 5,6
7014 MAVI =5
AVB=.TRUE.
IVI=EFD(AVB)-1.0D0
IF(IVI)1652,1653,1652
7015 MAVI = 6
AVB=.FALSE.
IVI=EFD(AVB)
IF(IVI)1652,1653,1652
C***** TEST 7
7016 MAVI = 7
IVI = FFD (1.E0,AFD) - 1.0D0
IF (IVI) 1652,1653,1652
C***** TEST 8
7017 MAVI = 8
A1D(1)=1.0D0
A1D(2)=-1.0D0
IVI=GFD(A1D)
IF (IVI) 1652,1653,1652
C***** TESTS 9,10,11,12
7018 IAVI = 1
AVD=1.0D0
A1D(1)=1.0D0
A2D(1,1)=1.0D0
A3D(1,1,1)= 1.0D0
AVS=1.0
A1S(1)=1.0
A2S(1,1)=1.0
A3S(1,1,1)=1.0
A1C(1)=(1.0,1.0)
A2C(1,1)=(1.0,1.0)
A3C(1,1,1)=(1.0,1.0)
I1I(1)=1
I2I(1,1)=1
I3I(1,1,1)=1
MAVI = 9
IVI=HFD(AVS,IAVI,AVB,AVC,AVD,A1S,A2S,A3S,I1I,I2I,I3I ,A1B,A2B,A3B,
1A1C,A2C,A3C,A1D,A2D,A3D,CFD)
IF (IVI) 1652,1653,1652
7019 MAVI = 10
IVI=AXVS
IF (IVI) 1652,1653,1652
7020 MAVI = 11
WRITE (NUVI,1656) AVC,MAVI
1656 FORMAT(//2F5.1//2X,5HTEST ,I2,31H IS POSITIVE IF NUMBERS PRINTED/
1 2X,17HABOVE ARE 0.0,0.0)
7021 MAVI = 12
BVB = AVB.AND.A1B(1).AND.A2B(1,1).AND.A3B(1,1,1)
IF(BVB) GO TO 1653
1652 WRITE(NUVI,1654)MAVI
GO TO 1651
1653 WRITE(NUVI,1655)MAVI
1654 FORMAT(/2X,5HTEST ,I2,12H IS NEGATIVE)
1655 FORMAT(/2X,5HTEST ,I2,12H IS POSITIVE)
1651 GO TO (1657,1658,1659,7014,7015,7016,7017,7018,7019,7020,7021,
1 7022) ,MAVI
7022 CONTINUE
C***** END OF TEST SEGMENT 165
C***** WHEN EXECUTING ONLY SEGMENT 165, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** BFCCP-(166)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** 1.TO TEST LOGICAL FUNCTIONS IN FULL FORTRAN
C***** 2.DUMMY ARGUMENTS ARE REAL,INTEGER,COMPLEX,LOGICAL,
C***** DOUBLE PRECISION,EXTERNAL PROCEDURE,ARRAY NAME.
C***** 3.FUNCTIONS CONTAIN UP TO 20 ARGUMENTS
C***** 4.IN REFERENCE ACTUAL ARGUMENTS ARE VARIABLE NAME
C***** ARRAY NAME,ARRAY ELEMENT NAME,ARITHMETIC EXPRESSION
C***** EXTERNAL PROCEDURE
C***** 6.USE CAN BE MADE OF ADJUSTABLE DIMENTION
C***** 7.ARGUMENTS CAN BE PASSED THROUGH COMMON
C*****RESTRICTIONS OBSERVED
C***** 1.ITEMS(2),(3),(4),(5),(6) OF PARAGRAPH
C***** 2.LAST SENTENCE OF PARAGRAPH 3.2
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS
C***** 406, 416, 426, 436, 446, 456, 466, 476 WHICH
C***** CONTAINS ALL FUNCTIONS BEING TESTED HERE.
C*****LOGICAL FUNCTION OF REAL ARGUMENT(TEST 1)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 166
C*****
C***** WHEN EXECUTING ONLY SEGMENT 166, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3)
C= INTEGER I1I(5),I2I(2,2),I3I(2,2,2)
C= LOGICAL AVB,AFB,BFB,CFB,DFB,EFB,FFB,GFB,HFB
C= 1, A1B(2),A2B(2,2),A3B(2,2,2)
C= DOUBLE PRECISION AVD,A1D(4),A2D(2,2),A3D(2,2,2)
C= COMPLEX AVC,A1C(12),A2C(2,2),A3C(2,2,1)
C= COMMON AXVS,CXVS
C= EXTERNAL AFB
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 166, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
MAVI=1
WRITE(NUVI,1662)
1662 FORMAT(1H1,1X,31HBFCCP - (166) LOGICAL FUNCTIONS//2X,
1 13HASA REF 8.3.1//2X,7HRESULTS)
AVB=AFB(1.0)
IF (AVB) GO TO 1664
WRITE(NUVI,1661) MAVI
GO TO 1665
1660 FORMAT (/7H TEST ,I2,12H IS POSITIVE)
1661 FORMAT (/7H TEST ,I2,12H IS NEGATIVE)
1664 WRITE(NUVI,1660) MAVI
GO TO (1665,1666,1667,1668,1669,7030,7031,7032,7033,7034), MAVI
C***** LOGICAL FUNCTION OF INTEGER ARGUMENT (TEST 2)
1665 MAVI=2
AVB=BFB(1)
IF (AVB) GO TO 1664
WRITE(NUVI,1661) MAVI
C*****LOGICAL FUNCTION OF DOUBLE PRECISION ARGUMENT(TEST 3)
1666 MAVI=3
AVD=1.0D0
AVB=CFB(AVD)
IF (AVB) GO TO 1664
WRITE(NUVI,1661) MAVI
C***** LOGICAL FUNCTION OF LOGICAL ARGUMENT(TEST 4)
1667 MAVI=4
AVB=DFB(.TRUE.)
IF (AVB) GO TO 1664
WRITE(NUVI,1661) MAVI
C*****LOGICAL FUNCTION OF COMPLEX ARGUMENT(TEST 5)
1668 MAVI=5
AVB=EFB((1.0,1.0))
IF (AVB) GO TO 1664
WRITE(NUVI,1661) MAVI
C***** LOGICAL FUNCTION OF ARRAY NAME (TEST 6)
1669 MAVI=6
A1S(1)=1.0
A1S(2)=0.0
AVB=FFB(A1S)
IF (AVB) GO TO 1664
WRITE(NUVI,1661) MAVI
C***** LOGICAL FUNCTION OF EXTERNAL PROCEDURE(TEST 7)
7030 MAVI=7
AVB= GFB(AFB,1.0)
IF (AVB) GO TO 1664
WRITE(NUVI,1661) MAVI
C*****LOGICAL FUNCTION OF DIFFERENT TYPES OF ARGUMENTS
7031 MAVI=8
AVD = 1.0D0
AVC = (1.0,1.0)
IAVI = 1
AVB=.TRUE.
A1B(1)=.TRUE.
A2B(1,1)=.TRUE.
A3B(1,1,1)=.TRUE.
A1C(1)=(1.0,1.0)
A2C(1,1)=(1.0,1.0)
A3C(1,1,1)=(-2.0,-2.0)
A1D(1)=1.0D0
A2D(1,1)=1.0D0
A3D(1,1,1)=-2.0D0
I1I(1)=1
I2I(1,1)=1
I3I(1,1,1)=1
A1S(1)=1.0
A2S(1,1)=1.0
A3S(1,1,1)=1.0
AXVS=1.0
AVB= HFB(AVS,IAVI,AVB,AVD,AVC,A1S,A2S,A3S,I1I,I2I,I3I,A1B,A2B,
1A3B,A1C,A2C,A3C,A1D,A2D,A3D,AFB)
IF (AVB) GO TO 1664
WRITE(NUVI,1661) MAVI
7032 MAVI = 9
IAVI=AVD
IF(IAVI.EQ.0) GO TO 1664
WRITE(NUVI,1661) MAVI
7033 IAVI=1
MAVI=10
IAVI=AVS
IF(IAVI.EQ.0) GO TO 1664
WRITE(NUVI,1661) MAVI
7034 MAVI=11
WRITE(NUVI,1663) AVC,MAVI
1663 FORMAT (//2F8.4//7H TEST ,I2,31H IS POSITIVE IF NUMBERS PRINTED/
119H ABOVE ARE 0.0,0.0//2X,12HEND OF (166))
C***** END OF TEST SEGMENT 166
C***** WHEN EXECUTING ONLY SEGMENT 166, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN
C***** COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** SBRTN - (167)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** TO TEST SUBROUTINE SUBPROGRAMS 8.4.1
C***** RESTRICTIONS OBSERVED
C***** SYMBOLIC NAME OF A SUBROUTINE MAY NOT APPEAR IN ANY 8.4.1.//19
C***** STATEMENT IN THIS SUBROUTINE EXCEPT IN THE
C***** SUBROUTINE STATEMENT ITSELF
C***** * SYMBOLIC NAMES OF DUMMY ARGUMENTS MAY NOT APPEAR 8.4.1.1/23
C***** IN EQUIVALENCE OR COMMON STATEMENTS IN THE SUBPROGRAM
C***** * SUBROUTINES MAY NOT CONTAIN A FUNCTION STATEMENT, 8.4.1.//29
C***** ANOTHER SUBROUTINE STATEMENT, OR ANY STATEMENT THAT
C***** DIRECTLY OR INDIRECTLY REFERENCES THE SUBROUTINE
C***** BEING DEFINED.
C***** * AT LEAST ONE RETURN STATEMENT MUST BE IN A SUBROUTINE
C***** 8.4.1.1/33
C***** GENERAL COMMENTS
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENT 407, 417, 427
C*****
C***** S P E C I F I C A T I O N S SEGMENT 167
C*****
C***** WHEN EXECUTING ONLY SEGMENT 167, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION IAB1I(4), IAB2I(3,3), AB1S(4), AB2S(3,3)
C= COMMON AXVS, CXVS, IXVI, IAX1I(4), IAX2I(3,3), IAX3I(2,2,2),
C= 1 BXVS, AX1S(4), AX2S(3,3)
C= EXTERNAL SQRT
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 167, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C*****
C***** WRITE HEADING
WRITE (NUVI,1670)
1670 FORMAT(1H1,1X,35HSBRTN - (167) SUBROUTINE SUBPROGRAM/
1 /2X,16HASA REF. - 8.4.1//2X,7HRESULTS)
C***** SET ALL VARIABLES AND SOME ELEMENTS IN ARRAYS TO ZERO
IAVI = 4
AVS = 0.0
IAB1I(1) = 0
IAB1I(3) = 0
IAB2I(1,2) = 0
IAB2I(3,3) = 0
C*****
AB1S(1) = 0.0
AB1S(4) = 0.0
AB2S(1,3) = 0.0
AB2S(2,3) = 0.0
C*****
IXVI = 0
BXVS = 0.0
IAX1I(2) = 0
IAX2I(1,2) = 0
C*****
AX1S(2) = 0.0
AX2S(1,2) = 0.0
C*****
C***** SET ELEMENTS IN INTEGER AND REAL ARRAY TO 1 TO TEST
C***** EXPRESSIONS IN SUBROUTINE ARGUMENT
IAB1I(2) = 1
IAB1I(4) = 1
IAB2I(2,1) = 1
IAB2I(2,2) = 1
C*****
AB1S(2) = 1.0
AB1S(3) = 1.0
AB2S(1,2) = 1.0
AB2S(2,2) = 1.0
C*****
CALL AAQ(IAVI, AVS, IAB1I, IAB2I, AB1S, AB2S, SQRT,
1IAB1I(2)+IAB1I(4)*IAB2I(2,1)-IAB2I(2,2),
2AB1S(2)+AB1S(3)*AB2S(1,2)-AB2S(2,2),1.0)
CALL ACQ
C***** WRITE RESULTS
WRITE (NUVI,1671) IAVI, AVS, IAB1I(1), IAB1I(3), IAB2I(1,2),
A IAB2I(3,3), AB1S(1), AB1S(4),
B AB2S(1,3), AB2S(2,3), IXVI, BXVS,
C IAX1I(2), IAX2I(1,2), AX1S(2),
D AX2S(1,2)
1671 FORMAT (//I10/F11.1/4(I10/),4(F11.1/),I10/F11.1/2(I10/),2(F11.1/
A))
WRITE (NUVI,1672)
1672 FORMAT (//2X,38HTEST SUCCESSFUL IF ALL RESULTS EQUAL 1//)
C***** END OF TEST SEGMENT 167
C***** WHEN EXECUTING ONLY SEGMENT 167, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** FSBRT - (168)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** TO TEST SUBROUTINE SUBPROGRAM IN FORTRAN 8.4.1
C***** RESTRICTIONS OBSERVED
C***** SYMBOLIC NAME OF A SUBROUTINE MAY NOT APPEAR IN ANY 8.4.1.1/56
C***** STATEMENT IN THIS SUBROUTINE EXCEPT IN THE
C***** SUBROUTINE STATEMENT ITSELF.
C***** * SYMBOLIC NAME OF DUMMY ARGUMENTS MAY NOT APPEAR 8.4.1.1/39
C***** IN EQUIVALENCE OR COMMON STATEMENTS IN THE SUBPROGRAM
C***** * SUBROUTINES MAY NOT CONTAIN A FUNCTION STATEMENT, 8.4.1.1/45
C***** ANOTHER SUBROUTINE STATEMENT, OR ANY STATEMENT THAT
C***** DIRECTLY OR INDIRECTLY REFERENCES THE SUBROUTINE
C***** BEING DEFINED.
C***** * AT LEAST ONE RETURN STATEMENT MUST BE IN A SUBROUTINE
C***** 8.4.1.1/49
C***** GENERAL COMMENTS
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENT 408 , 418, 428
C*****
C***** S P E C I F I C A T I O N S SEGMENT 168
C*****
C***** WHEN EXECUTING ONLY SEGMENT 168, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION IAB1I(4), IAB2I(3,3), IAB3I(2,2,2), AB1S(4), AB2S(3,3),
C= A AB3S(2,2,2)
C= COMMON AXVS, CXVS, IXVI, IAX1I(4), IAX2I(3,3), IAX3I(2,2,2),
C= A BXVS, AX1S(4), AX2S(3,3), AX3S(2,2,2), AXVD, AX1D(2),
C= B AX2D(2,2), AX3D(2,2,2), AXVC, AX1C(2), AX2C(2,2),
C= C AX3C(2,2,2), AXVB, AX1B(2), AX2B(2,2), AX3B(2,2,2)
C= DOUBLE PRECISION AXVD, AX1D, AX2D, AX3D
C= DOUBLE PRECISION AVD,A1D(4),A2D(2,2),A3D(2,2,2)
C= COMPLEX AXVC, AX1C, AX2C, AX3C
C= COMPLEX AVC,A1C(12),A2C(2,2),A3C(2,2,1)
C= LOGICAL AXVB, AX1B, AX2B, AX3B
C= LOGICAL A1B(2),A2B(2,2),A3B(2,2,2),AVB
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 168, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C***** SET INTEGER VARIABLES AND SOME ELEMENTS IN ARRAYS TO ZERO
C***** WRITE HEADING
WRITE (NUVI,1680)
1680 FORMAT (1H1,1X,36HFSBRT - (168) SUBROUTINE SUBPROGRAMS/
A/18H ASA REF. - 8.4.1//2X,7HRESULTS)
IAVI = 0
IAB1I(1) = 0
IAB2I(1,2) = 0
IAB3I(1,1,2) = 0
IXVI = 0
IAX1I(1) = 0
IAX2I(1,2) = 0
IAX3I(1,1,2) = 0
C***** SET REAL VARIABLES AND SOME ELEMENTS IN ARRAYS TO ONE
AVS = 1.
AB1S(1) = 1.
AB2S(1,2) = 1.
AB3S(1,1,2) = 1.
BXVS = 1.
AX1S(2) = 1.
AX2S(1,2) = 1.
AX3S(1,1,2) = 1.
C***** SET DP VARIABLES AND SOME ELEMENTS IN ARRAY TO TWO
AVD = 2.0D0
A1D(1) = 2.0D0
A2D(1,2) = 2.0D0
A3D(1,1,2) = 2.0D0
AXVD = 2.0D0
AX1D(1) = 2.0D0
AX2D(1,2) = 2.D0
AX3D(1,1,2) = 2.0D0
C***** SET COMPLEX VARIABLES AND SOME ELEMENTS IN ARRAYS TO (3.0,3.0)
AVC = (3.0,3.0)
A1C(1) = (3.0,3.0)
A2C(1,2) = (3.0,3.0)
A3C(1,2,1) = (3.0,3.0)
AXVC = (3.0,3.0)
AX1C(1) = (3.0,3.0)
AX2C(1,2) = (3.0,3.0)
AX3C(1,1,2) = (3.0,3.0)
C***** SET LOGICAL VARIABLES AND SOME ELEMENTS IN ARRAYS TO .FALSE.
AVB = .FALSE.
A1B(1) = .FALSE.
A2B(1,2) = .FALSE.
A3B(1,1,2) = .FALSE.
AXVB = .FALSE.
AX1B(1) = .FALSE.
AX2B(1,2) = .FALSE.
AX3B(1,1,2) = .FALSE.
C***** SET INTEGER AND REAL VARIABLES FOR EXPRESSION USAGE IN
C***** DUMMY ARGUMENT
IAB1I(4) = 0
IAB1I(2) = 0
AB1S(4) = 0.0
AB1S(2) = 0.0
JAVI = 1
KAVI = 1
LAVI = 1
MAVI = 1
NAVI = 1
ABVS = 1.
ACVS = 1.
ADVS = 2.
AEVS = 2.
AFVS = 2.
CALL ADQ(IAVI,IAB1I, IAB2I, IAB3I, AVS, AB1S, AB2S, AB3S, AVD,
A A1D, A2D, A3D, AVC, A1C, A2C, A3C, AVB, A1B, A2B, A3B,
B JAVI+KAVI*LAVI-MAVI/NAVI,1,ABVS+ACVS*ADVS-AEVS/AFVS,2.)
WRITE (NUVI,1681)
CALL AFQ
1681 FORMAT ( /28H TEST IS SUCCESSFUL IF EACH/
A28H GROUP CONTAINS SAME VALUES)
WRITE (NUVI,1682) IAVI, IAB1I(1), IAB1I(2), IAB1I(4), IAB2I(1,2),
A IAB3I(1,1,2), IXVI, IAX1I(1), IAX2I(1,2),
B IAX3I(1,1,2), AVS, AB1S(1), AB2S(1,2), AB3S(1,1,
C2),AB1S(2),AB1S(4), BXVS, AX1S(2), AX2S(1,2), AX3S(1,1,2), AVD,
D A1D(1), A2D(1,2), A3D(1,1,2), AXVD, AX1D(1),
E AX2D(1,2), AX3D(1,1,2), AVC, A1C(1), A2C(1,2),
F A3C(1,2,1), AXVC, AX1C(1), AX2C(1,2),
G AX3C(1,1,2), AVB, A1B(1), A2B(1,2), A3B(1,1,2),
H AXVB, AX1B(1), AX2B(1,2), AX3B(1,1,2)
1682 FORMAT ( 10(I10/)/
1 10(F11.1/)/
2 8(1PD15.1/)/
3 8(0PF5.1,F5.1/)/
4 8(L10/) )
C***** END OF TEST SEGMENT 168
C***** WHEN EXECUTING ONLY SEGMENT 168, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN
C***** COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** BLKDT - (169)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** TO TEST BLOCK DATA SUBPROGRAM 8.5
C***** GENERAL COMMENTS
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENT 409. THIS
C***** SEGMENT WRITES OUT THE DATA FORMED IN SEGMENT 409.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 169
C*****
C***** WHEN EXECUTING ONLY SEGMENT 169, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENTS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3)
C= A /BLK2/DXVS, DX1S(2), DX2S(2,2)
C= B /BLK3/DXVD, DX1D(2), DX2D(2,2)
C= C /BLK4/DXVC, DX1C(2), DX2C(2,2)
C= D /BLK5/DXVB, DX1B(2), DX2B(2,2)
C= E /BLK6/JAX3I(2,2,2), DX3S(2,2,2), DX3D(2,2,2),
C= F DZ3C(2,2,2), DX3B(2,2,2)
C= DOUBLE PRECISION DXVD, DX1D, DX2D, DX3D
C= COMPLEX DXVC, DX1C, DX2C, DZ3C
C= LOGICAL DXVB, DX1B, DX2B, DX3B
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 169, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C***** WRITE HEADING FOR SEGMENT 169
WRITE (NUVI,1690)
1690 FORMAT (1H1,1X,35HBLKDT - (169) BLOCK DATA SUBPROGRAM//
A16H ASA REF. - 8.5//2X,7HRESULTS)
WRITE (NUVI,1691)
1691 FORMAT ( /28H TEST IS SUCCESSFUL IF EACH/
A28H GROUP CONTAINS SAME VALUES)
WRITE (NUVI,1692) JAX2I(1,1), JAX1I(2), JAX2I(2,1), JAX3I(2,2,1)
A ,DX3S(1,2,1), DX1S(1), DX2S(1,1), DX3S(2,2,1), DX2D(2,2)
B ,DX1D(2), DX2D(2,1), DX3D(2,2,1), DX2C(2,2), DX1C(2)
C ,DX2C(2,1), DZ3C(2,1,1), DX2B(2,2), DX1B(2), DX2B(2,1)
D ,DX3B(2,2,1), JAX2I(3,1),
E DX3B(2,1,2), DX2S(2,2)
1692 FORMAT (// 4(I10/)//
A 4(F12.1/)//
B 4(1PD16.1/)//
C 4(0PF6.1,F6.1/)//
D 4(L10/)//
F 3(2H ,A2/))
C***** END OF TEST SEGMENT 169
C***** WHEN EXECUTING ONLY SEGMENT 169, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN
C***** COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
C***********************************************************************
C*****
C***** AFD - (405)
C*****
C***********************************************************************
C*****DOUBLE PRECISION FUNCTION OF REAL ARGUMENT (TEST 1)
DOUBLE PRECISION FUNCTION AFD(AWVS)
AFD=AWVS
RETURN
END
C***********************************************************************
C*****
C***** BFD -(415)
C*****
C***********************************************************************
C*****DOUBLE PRECISION FUNCTION OF INTEGER ARGUMENT(TEST2)
DOUBLE PRECISION FUNCTION BFD(IWVI)
BFD=1.0D0**IWVI
RETURN
END
C***********************************************************************
C*****
C***** CFD - (425)
C*****
C***********************************************************************
C*****DOUBLE PRECISION FUNCTION OF DOUBLE PRECISION ARGUMENT(TEST 3)
DOUBLE PRECISION FUNCTION CFD(AWVD)
DOUBLE PRECISION AWVD
CFD=AWVD
RETURN
END
C***********************************************************************
C*****
C***** DFD -(435)
C*****
C***********************************************************************
C*****DOUBLE PRECISION FUNCTION OF COMPLEX ARGUMENT(TEST 4)
DOUBLE PRECISION FUNCTION DFD(AWVC,BWVC)
COMPLEX AWVC,BWVC,CVC
CVC =BWVC*AWVC
DFD=AIMAG(CVC)
RETURN
END
C***********************************************************************
C*****
C***** EFD - (445)
C*****
C***********************************************************************
C*****DOUBLE PRECISION FUNCTION OF LOGICAL ARGUMENT(TEST 5,6)
DOUBLE PRECISION FUNCTION EFD(AWVB)
LOGICAL AWVB
IF(AWVB) GO TO 4451
4450 IF(.NOT.AWVB) GO TO 4452
RETURN
4451 EFD = 1.0D0
GO TO 4450
4452 EFD = 0.0D0
RETURN
END
C***********************************************************************
C*****
C***** FFD - (455)
C*****
C***********************************************************************
C*****DOUBLE PRECISION FUNCTION OF EXTERNAL PROCEDURE (TEST 7)
DOUBLE PRECISION FUNCTION FFD(BWVS,BWFD)
DOUBLE PRECISION BWFD
FFD = BWFD (BWVS)
RETURN
END
C***********************************************************************
C*****
C***** GFD - (465)
C*****
C***********************************************************************
C*****DOUBLE PRECISION FUNCTION OF ARRAY NAME (TEST 8)
DOUBLE PRECISION FUNCTION GFD(AW1D)
DIMENSION AW1D(2)
DOUBLE PRECISION AW1D
GFD= AW1D(1)+AW1D(2)
RETURN
END
C*****
C*****
C***** HFD - (475)
C*****
C***********************************************************************
C*****DOUBLE PRECISION FUNCTION OF DIFFERENT TYPES OF ARGUMENTS.USE CAN
C*****BE MADE OF ADJUSTABLE DIMENSION.SOME ARGUMENTS CAN BE PASSED
C*****THROUGH A COMMON STATEMENT.
DOUBLE PRECISION FUNCTION HFD(AWVS,IWVI,AWVB,AWVC,AWVD,AW1S,AW2S,
1 AW3S,IW1I,IW2I,IW3I,AW1B,AW2B,AW3B,AW1C,AW2C,AW3C,AW1D,AW2D,
2 AW3D,CWFD)
DIMENSION AW1S(IWVI),AW2S(IWVI,IWVI),AW3S(IWVI,IWVI,IWVI),
1 IW1I(IWVI),IW2I(IWVI,IWVI),IW3I(IWVI,IWVI,IWVI),
2 AW1C(IWVI),AW2C(IWVI,IWVI),AW3C(IWVI,IWVI,IWVI),
3 AW1D(IWVI),AW2D(IWVI,IWVI),AW3D(IWVI,IWVI,IWVI),
4 AW1B(IWVI),AW2B(IWVI,IWVI),AW3B(IWVI,IWVI,IWVI)
DOUBLE PRECISION AWVD,AW1D,AW2D,AW3D, CWFD, X
COMPLEX AWVC,AW1C,AW2C,AW3C
REAL AW1S, AW2S, AW3S
LOGICAL AWVB,AW1B,AW2B,AW3B
COMMON BXVS
X = AWVD - AW1D(IWVI)+AW2D(IWVI,IWVI)-AW3D(IWVI,IWVI,IWVI)
HFD = X
print *, 'TRACER X=',X ,AWVD , AW1D(IWVI),AW2D(IWVI,IWVI)
1 ,AW3D(IWVI,IWVI,IWVI)
1 + CWFD(AWVD) - 1.0D0
AWVC=AW1C(IWVI)+AW2C(IWVI,IWVI)-AW3C(IWVI,IWVI,IWVI)-(1.0,1.0)
BXVS=AWVS**IWVI-AW1S(IWVI)**IW1I(IWVI)+AW2S(IWVI,IWVI)**IW2I
1 (IWVI,IWVI)-AW3S(IWVI,IWVI,IWVI)**IW3I(IWVI,IWVI,IWVI)
AWVB=IWVI.EQ.1
AW1B(IWVI)=IWVI.EQ.1
AW2B(IWVI,IWVI)=IWVI.EQ.1
AW3B(IWVI,IWVI,IWVI)=IWVI.EQ.1
RETURN
END
C***********************************************************************
C*****
C***** AFB - (406)
C*****
C***********************************************************************
C*****LOGICAL FUNCTION OF REAL ARGUMENT (TEST 1)
LOGICAL FUNCTION AFB(AWVS)
AFB= AWVS.GT.0.0
RETURN
END
C***********************************************************************
C*****
C***** BFB - (416)
C*****
C***********************************************************************
C*****LOGICAL FUNCTION OF INTEGER ARGUMENT (TEST 2)
LOGICAL FUNCTION BFB(IWVI)
BFB= IWVI.GT.0
RETURN
END
C***********************************************************************
C*****
C***** CFB - (426)
C*****
C***********************************************************************
C*****LOGICAL FUNCTION OF DOUBLE PRECISION ARGUMENT(TEST 3)
LOGICAL FUNCTION CFB(AWVD)
DOUBLE PRECISION AWVD
CFB= AWVD.GT.0.0D0
RETURN
END
C***********************************************************************
C*****
C***** DFB - (436)
C*****
C***********************************************************************
C*****LOGICAL FUNCTION OF LOGICAL ARGUMENT (TEST 4)
LOGICAL FUNCTION DFB(AWVB)
LOGICAL AWVB
DFB=AWVB
RETURN
END
C***********************************************************************
C*****
C***** EFB - (446)
C*****
C***********************************************************************
C*****LOGICAL FUNCTION OF COMPLEX ARGUMENT (TEST 5)
LOGICAL FUNCTION EFB(AWVC)
COMPLEX AWVC
AVS =AIMAG(AWVC)
EFB = AVS .GT.0.0
RETURN
END
C***********************************************************************
C*****
C***** FFB - (456)
C*****
C***********************************************************************
C*****LOGICAL FUNCTION OF ARRAY NAME (TEST 6)
LOGICAL FUNCTION FFB(AW1S)
DIMENSION AW1S(2)
BVS =AW1S(1)+AW1S(2)
FFB= BVS .GT.0.0
RETURN
END
C***********************************************************************
C*****
C***** GFB - (466)
C*****
C***********************************************************************
C*****LOGICAL FUNCTION OF EXTERNAL PROCEDURE (TEST 7)
LOGICAL FUNCTION GFB(AWFB,AWVS)
LOGICAL AWFB
GFB= AWFB(AWVS)
RETURN
END
C***********************************************************************
C*****
C***** HFB - (476)
C*****
C***********************************************************************
C*****LOGICAL FUNCTION OF DIFFERENT TYPES OF ARGUMENTS(TEST 8,9,10,11)
LOGICAL FUNCTION HFB(AWVS,IWVI,AWVB,AWVD,AWVC,AW1S,AW2S,AW3S,
1IW1I,IW2I,IW3I,AW1B,AW2B,AW3B,AW1C,AW2C,AW3C,AW1D,AW2D,AW3D,AWFB)
COMMON BXVS
COMPLEX AWVC,AW1C,AW2C,AW3C
DOUBLE PRECISION AWVD,AW1D,AW3D, AW2D
LOGICAL AWVB,AW1B,AW2B,AW3B,AWFB
DIMENSION AW1C(IWVI),AW2C(IWVI,2),AW3C(IWVI,2,2),
1 AW1B(IWVI),AW2B(IWVI,2),AW3B(IWVI,2,2) ,
2 AW1S(IWVI),AW2S(IWVI,2),AW3S(IWVI,2,2) ,
3 AW1D(IWVI),AW2D(IWVI,2),AW3D(IWVI,2,2) ,
4 IW1I(IWVI),IW2I(IWVI,2),IW3I(IWVI,2,2)
HFB = AWVB.AND.AW1B(IWVI).AND.AW2B(IWVI,IWVI).AND.AW3B(IWVI,
1 IWVI,IWVI).AND.AWFB(1.0)
AWVC=AW1C(IWVI)+AW2C(IWVI,IWVI)+AW3C(IWVI,IWVI,IWVI)
AWVD=AW1D(IWVI)+AW2D(IWVI,IWVI)+AW3D(IWVI,IWVI,IWVI)
AWVS=BXVS+AW1S(IWVI)**IW1I(IWVI)-AW2S(IWVI,IWVI)**IW2I(IWVI,IWVI)
1 -AW3S(IWVI,IWVI,IWVI)**IW3I(IWVI,IWVI,IWVI)
RETURN
END
C***********************************************************************
C*****
C***** AAQ - (407)
C*****
C***********************************************************************
C***** THIS SUBROUTINE IS TO BE RUN WITH SEGMENT 167
SUBROUTINE AAQ (IWVI, AWVS, IAW1I, IAW2I, AW1S, AW2S, SQFI,
1MWVI, BWVS, CWVS)
DIMENSION IAW1I(4), IAW2I(3,3), AW1S(4),
1 AW2S(3,3)
IWVI = INT(SQFI(FLOAT(IWVI) + .5)) - 1
AWVS = AWVS + 1.0
IAVI = 5
IAW1I(1) = MWVI
IAW1I(3) = IAW1I(3) + 1
IAW2I(3,3) = IAW2I(3,3) + 1
AW1S(1) = BWVS
AW2S(1,3) = CWVS
C*****
C***** CALL A SUBROUTINE FROM ANOTHER SUBROUTINE
CALL ABQ(IAW2I, AW1S, AW2S)
RETURN
END
C***********************************************************************
C*****
C***** ABQ - (417)
C*****
C***********************************************************************
SUBROUTINE ABQ(ICW2I, CW1S, CW2S)
DIMENSION ICW2I(3,3), CW1S(4), CW2S(3,3)
ICW2I(1,2) = ICW2I(1,2) + 1
C*****
CW1S(4) = CW1S(4) + 1.0
CW2S(2,3) = CW2S(2,3) + 1.0
RETURN
END
C***********************************************************************
C*****
C***** ACQ - (427)
C*****
C***********************************************************************
SUBROUTINE ACQ
DIMENSION IDX1I(4), IDX2I(3,3), IDX3I(2,2,2)
1 ,AAX1S(4), AAX2S(3,3)
COMMON ABXVS, ACXVS, IAXVI, IDX1I, IDX2I, IDX3I,
1 AAXVS, AAX1S, AAX2S
IAXVI = IAXVI+1
AAXVS = AAXVS +1.0
IDX1I(2) = IDX1I(2) + 1
IDX2I(1,2) = IDX2I(1,2) + 1
C*****
AAX1S(2) = AAX1S(2) * 2. + 1.0
AAX2S(1,2) = AAX2S(1,2) + 4.0 - 3.0
C*****
RETURN
C***** END OF TEST SEGMENT 427
END
C***********************************************************************
C*****
C***** ADQ - (408)
C*****
C***********************************************************************
C***** SUBROUTINE ADQ CALLED BY SEG. FSBRT(168)
SUBROUTINE ADQ(IWVI,IAW1I,IAW2I,IAW3I,AWVS,AW1S,AW2S,AW3S,
A AWVD,AW1D,AW2D,AW3D,AWVC,AW1C,AW2C,AW3C,
B AWVB,AW1B,AW2B,AW3B,KWVI,MWVI,BWVS,CWVS)
DIMENSION IAW1I(4), IAW2I(3,3), IAW3I(2,2,2), AW1S(4), AW2S(3,3),
A AW3S(2,2,2), AW1D(2), AW2D(2,2), AW3D(2,2,2), AW1C(2),
B AW2C(2,2), AW3C(2,2,1), AW1B(2), AW2B(2,2),
C AW3B(2,2,2)
DOUBLE PRECISION AWVD, AW1D, AW2D, AW3D
COMPLEX AWVC, AW1C, AW2C, AW3C
LOGICAL AWVB, AW1B, AW2B, AW3B
C***** STORE INTEGER AND REAL EXPRESSIONS
IAW1I(4) = KWVI
IAW1I(2) = MWVI
AW1S(4) = BWVS
AW1S(2) = CWVS
CALL AEQ (IWVI,IAW1I,IAW2I,IAW3I,AWVS,AW1S,AW2S,AW3S)
C***** INCREMENT DOUBLE PRECISION
AWVD = AWVD + AWVD
AW1D(1) = AW1D(1) + AW1D(1)
AW2D(1,2) = AW2D(1,2) + AW2D(1,2)
AW3D(1,1,2) = AW3D(1,1,2) + AW3D(1,1,2)
C***** INCREMENT COMPLEX
AWVC = AWVC + AWVC
AW1C(1) = AW1C(1) + AW1C(1)
AW2C(1,2) = AW2C(1,2) + AW2C(1,2)
AW3C(1,2,1) = AW3C(1,2,1) + AW3C(1,2,1)
C***** CHANGE LOGICAL
AWVB = .NOT. AWVB
AW1B(1) = .NOT. AW1B(1)
AW2B(1,2) = .NOT. AW2B(1,2)
AW3B(1,1,2) = .NOT. AW3B(1,1,2)
RETURN
END
C***********************************************************************
C*****
C***** AEQ - (418)
C*****
C***********************************************************************
C***** SUBROUTINE AEQ CALLED BY SEG ADQ(408) WHICH IS
C***** CALLED BY SEG. FSBRT(168)
SUBROUTINE AEQ(KWVI, KAW1I, KAW2I, KAW3I, AAWVS, AAW1S, AAW2S,
A AAW3S)
DIMENSION KAW1I(4),KAW2I(3,3),KAW3I(2,2,2),AAW1S(4),AAW2S(3,3),
A AAW3S(2,2,2)
C***** INCREMENT INTEGERS
KWVI = KWVI + 1
KAW1I(1) = KAW1I(1) + 1
KAW2I(1,2) = KAW2I(1,2) + 1
KAW3I(1,1,2) = KAW3I(1,1,2)+1
C***** INCREMENT REAL
AAWVS = AAWVS + 1.
AAW1S(1) = AAW1S(1) + 1.
AAW2S(1,2) = AAW2S(1,2) + 1.
AAW3S(1,1,2) = AAW3S(1,1,2) + 1.
RETURN
END
C***********************************************************************
C*****
C***** AFQ - (428)
C*****
C***********************************************************************
C***** SUBROUTINE AFQ CALLED BY SEG. FSBRT(168)
SUBROUTINE AFQ
COMMON ABXVS, ACXVS, IAXVI, IAX1I(4), IAX2I(3,3), IAX3I(2,2,2),
A AXVS, AX1S(4), AX2S(3,3), AX3S(2,2,2), AXVD, AX1D(2),
2 AX2D(2,2), AX3D(2,2,2),AXVC, AX1C(2), AX2C(2,2), AX3C(2,2,2)
3 ,AXVB, AX1B(2), AX2B(2,2), AX3B(2,2,2)
DOUBLE PRECISION AXVD, AX1D, AX2D, AX3D
COMPLEX AXVC, AX1C, AX2C, AX3C
LOGICAL AXVB, AX1B, AX2B, AX3B
C***** SET INTEGERS TO 1
IAXVI = 1
IAX1I(1) = 1
IAX2I(1,2) = 1
IAX3I(1,1,2) = 1
C***** SET REAL TO 2
AXVS = 2.
AX1S(2) = 2.
AX2S(1,2) = 2.
AX3S(1,1,2) = 2.
C***** SET DP TO 4
AXVD = 4.0D0
AX1D(1) = 4.0D0
AX2D(1,2) = 4.0D0
AX3D(1,1,2) = 4.0D0
C***** SET COMPLEX TO 6
AXVC = (6.0,6.0)
AX1C(1) = (6.0,6.0)
AX2C(1,2) = (6.0,6.0)
AX3C(1,1,2) = (6.0,6.0)
C***** CHANGE LOGICAL
AXVB = .TRUE.
AX1B(1) = .TRUE.
AX2B(1,2) = .TRUE.
AX3B(1,1,2) = .TRUE.
RETURN
END
C***********************************************************************
C*****
C***** BLOKD - (409)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** THIS SEGMENT CONTAINS ONE BLOCK DATA SUBPROGRAM.
C***** IT IS TO BE RUN WITH SEGMENT 169
C***** GENERAL COMMENTS
C***** THIS SEGMENT USES ALL THE PERMISSIBLE STATEMENTS IN A
C***** BLOCK DATA SUBPROGRAM. THE DATA STATEMENT CONSISTS OF ALL
C***** TYPES OF VARIABLES AND ARRAYS. A HOLLERITH CONSTANT
C***** IS ASSIGNED TO INTEGER, REAL AND LOGICAL
BLOCK DATA
COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3)
A /BLK2/DXVS, DX1S(2), DX2S(2,2)
B /BLK3/DXVD, DX1D(2), DX2D(2,2)
C /BLK4/DXVC, DX1C(2), DX2C(2,2)
D /BLK5/DXVB, DX1B(2), DX2B(2,2)
E /BLK6/JAX3I(2,2,2), DX3S(2,2,2), DX3D(2,2,2),
F DZ3C(2,2,2), DX3B(2,2,2)
DIMENSION CY3C(2,2,2)
DOUBLE PRECISION DXVD, DX1D, DX2D, DX3D
COMPLEX DXVC, DX1C, DX2C, DZ3C, CY3C
LOGICAL DXVB, DX1B, DX2B, DX3B
INTEGER JXVI
REAL DXVS
EQUIVALENCE (DZ3C(1,1,1), CY3C(1,1,1))
DATA JAX2I(1,1), JAX1I(2), JAX2I(2,1), JAX3I(2,2,1),DX3S(1,2,1),
A DX1S(1), DX2S(1,1), DX3S(2,2,1), DX2D(2,2), DX1D(2),
B DX2D(2,1), DX3D(2,2,1), DX2C(2,2), DX1C(2), DX2C(2,1),
C DZ3C(2,1,1), DX2B(2,2), DX1B(2), DX2B(2,1), DX3B(2,2,1),
D JAX2I(3,1),DX3B(2,1,2),DX2S(2,2)/4*2,4*3.0,4*4.0D0,4*(4.,5.),
E 4*.TRUE., 2HAB, 2HAB, 2HAB/
C***** END OF TEST SEGMENT 409
END
nbs12.d 480890343 170 2 100666 299 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2 . DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4 . DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6 DOUBLE SPACE ON OUTPUT ID 6
nbs12.f 480890371 170 2 100666 53613 `
C***** PART12 ****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 12 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** BLKDA - 179 BLOCK DATA TEST
C*****
C***** BLAKD - 419 BLOCK DATA SUBPROGRAM
C*****
C***** BLBKD - 429 BLOCK DATA SUBPROGRAM
C*****
C***** BLCKD - 439 BLOCK DATA SUBPROGRAM
C*****
C***** UNFRW - 180 UNFORMATTED READ AND WRITE
C*****
C***** BACUP - 182 BACKSPACE TAPE
C*****
C***** DOTRM - 190 DO LOOPS (TERMINAL STATEMENTS)
C*****
C***** DOLMT - 191 DO LOOPS (INTEGER VARIABLES - PARAMETERS)
C*****
C***** DONSC - 192 DO LOOPS (COMPLETELY NESTED NEST)
C*****
C***** DONSI - 193 DO LOOPS (INCOMPLETE)
C*****
C***** DONSX - 194 DO LOOPS (EXTENDED RANGE)
C*****
C***** DONML - 195 DO LOOPS (NESTED NEST)
C*****
C***** DONIO - 196 DO LOOPS (I/O TERMINAL STATEMENTS)
C*****
C***** MORDO - 197 DO LOOPS (I/O, INTRINSIC FUNCTION, CALL)
C*****
C***** BSFDF - 005 STATEMENT FUNCTIONS
C*****
C***** MDQ - 412 SUBROUTINE SUBPROGRAM
C*****
C***** SUBR1 - 200 SUBROUTINE CALLED
C*****
C***** SUBRQ - 410 SUBROUTINE SUBPROGRAM
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN SEGMENTS
C***** 179, 180, 182, 190, 191, 192, 193, 194, 195, 196, 197, 200
C***** ARE RUN AS ONE MAIN PROGRAM.
C*****
DIMENSION MCA1I(5)
DIMENSION IV1I(1024), IAC1I(5), AC2S(5,6)
DIMENSION CMA1S(5), CMB1S(5), AC1S(25)
INTEGER MCA3I(2,3,3) , I3I(2,2,2)
LOGICAL MCAVB, MCBVB, GH2B(1,2)
DOUBLE PRECISION CC3D(7,2,2), DPAVD, DPBVD
COMPLEX NUMVC, DENVC, LL1C(32)
COMMON AXVS, CXVS
DOUBLE PRECISION DXVD, DX1D, DX2D, DX3D
COMPLEX DXVC, DX1C, DX2C, DZ3C
COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3)
A /BLK2/DXVS, DX1S(2), DX2S(2,2)
B /BLK3/DXVD, DX1D(2), DX2D(2,2)
C /BLK4/DXVC, DX1C(2), DX2C(2,2)
D /BLK5/DXVB, DX1B(2), DX2B(2,2)
E /BLK6/JAX3I(2,2,2), DX3S(2,2,2), DX3D(2,2,2),
F DZ3C(2,2,2), DX3B(2,2,2)// IXVI, IAX1I(4)
LOGICAL DXVB, DX1B, DX2B, DX3B
C*****
C***** END OF SPECIFICATIONS FOR SEGMENTS
C***** 179, 180, 182, 190, 191, 192, 193, 194, 195, 196, 197, 200
C***********************************************************************
C*****
C***** BSFDF - (005)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** DEFINING STATEMENT FUNCTIONS THAT ARE TO BE TESTED
C***** IN SEGMENT 197 8.1.1
C***** HEADER FOR SEGMENT 005
C***** DEFINING EXPRESSION CONTAINS CONSTANTS AND VARIABLES
CMAFS(CAWVS,CBWVS) = CAWVS * 2. + CBWVS
CMBFS(MAWVI,MBWVI,MCWVI) =(MAWVI + MBWVI + MCWVI)/3
MCAFI(MAWVI,MBWVI) = MAWVI ** MBWVI
MCBFI(CAWVS,CBWVS,CCWVS) = (CAWVS + CBWVS + CCWVS) * 2.0
C***** DEFINING EXPRESSION CONTAINS CONSTANTS, VARIABLES AND
C***** INTRINSIC FUNCTIONS
CMCFS(CAWVS,CBWVS,CCWVS) = ABS(CAWVS**2 - (CBWVS+CCWVS)**2)
CMDFS(MAWVI,MBWVI) = ISIGN((MAWVI+MBWVI),(MAWVI-MBWVI))
MCCFI(MAWVI,MBWVI,CAWVS) = MAWVI**2 + MBWVI**2 + IFIX(CAWVS)**2
MCDFI(CAWVS,CBWVS,CCWVS,CDWVS,CEWVS) = (CAWVS + CBWVS + CCWVS +
1CDWVS +CEWVS) ** (ABS(CAWVS))
C***** DEFINING EXPRESSION CONTAINS PREVIOUSLY DEFINED STATEMENT
C***** FUNCTIONS AND/OR EXTERNAL FUNCTION REFERENCES
CMEFS(CAWVS,CBWVS) = CMBFS(1,2,3) + SQRT((CAWVS + CBWVS))
CMFFS(MAWVI,MBWVI,MCWVI) = MCCFI(MAWVI,MBWVI,3.0) + MCWVI **2
MCEFI(MAWVI,MBWVI) = MCAFI(MAWVI,MBWVI) ** MCAFI(MAWVI,MBWVI)
MCFFI(CAWVS,CBWVS,CCWVS) = SQRT(CAWVS) + SQRT(CBWVS) + EXP(CCWVS)
C***** DEFINING EXPRESSION CONTAINS CONSTANTS, VARIABLES, INTRINSIC
C***** OR EXTERNAL FUNCTION REFERENCES AND PREVIOUSLY DEFINED
C***** STATEMENT FUNCTIONS.
CMGFS(MAWVI,MBWVI,CAWVS,CBWVS) = FLOAT(MAWVI ** 2) - CMAFS(CAWVS,
1CBWVS) + SQRT((FLOAT(MAWVI + MBWVI)))
MCGFI(MAWVI,MBWVI,MCWVI,CAWVS) = MCEFI(MAWVI,MBWVI) - MCEFI(MAWVI,
1MCWVI) + IFIX(EXP(CAWVS))
C***** END OF TEST SEGMENT 005
C***********************************************************************
C*****
C***** BLKDA - (179)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST BLOCK DATA SUBPROGRAMS 8.5
C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS 419, 429, 439. THIS
C***** SEGMENT WRITES OUT THE DATA FORMED IN SEGMENT 419, 429, 439
C*****
C***** S P E C I F I C A T I O N S SEGMENT 179
C*****
C***** WHEN EXECUTING ONLY SEGMENT 179, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH APPEAR
C***** AS COMMENTS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DOUBLE PRECISION DXVD, DX1D, DX2D, DX3D
C= COMPLEX DXVC, DX1C, DX2C, DZ3C
C= COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3)
C= A /BLK2/DXVS, DX1S(2), DX2S(2,2)
C= B /BLK3/DXVD, DX1D(2), DX2D(2,2)
C= C /BLK4/DXVC, DX1C(2), DX2C(2,2)
C= D /BLK5/DXVB, DX1B(2), DX2B(2,2)
C= E /BLK6/JAX3I(2,2,2), DX3S(2,2,2), DX3D(2,2,2),
C= F DZ3C(2,2,2), DX3B(2,2,2)
C= LOGICAL DXVB, DX1B, DX2B, DX3B
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS
IRVI = 5
NUVI = 6
INVI = 9
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 12///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
OPEN(UNIT=INVI,IOSTAT=IOS,ERR=4001,FILE="JUNK1",FORM="UN")
WRITE(NUVI,"('OPEN RETURNS ',I4)" ) IOS
GOTO 4002
4001 WRITE(NUVI,"('OPEN ERROR, ',I4)" ) IOS
4002 CONTINUE
C*****
C*****
C***** WRITE HEADING FOR SEGMENT 179
WRITE (NUVI,1790)
1790 FORMAT (1H1,1X,32HBLKDA - (179) SEVERAL BLOCK DATA/ 16X,
1 11HSUBPROGRAMS/ 2X, 14HASA REF. - 8.5// 9H RESULTS)
WRITE (NUVI,1791)
1791 FORMAT (//28H TEST IS SUCCESSFUL IF EACH/
A28H GROUP CONTAINS SAME VALUES)
WRITE (NUVI,1792) JXVI, JAX1I(1), JAX2I(1,2), JAX3I(1,1,2), DXVS,
A DX1S(2), DX2S(1,2), DX3S(1,1,2), DXVD, DX1D(1),
B DX2D(1,2), DX3D(1,1,2), DXVC, DX1C(1),DX2C(1,2),
C DZ3C(1,1,2), DXVB, DX1B(1), DX2B(1,2),
D DX3B(1,1,2), JAX2I(1,3),
E DX3B(2,2,2), DX2S(2,1)
1792 FORMAT (// 4(I10/)//
A 4(F12.1/)//
B 4(1PD16.1/)//
C 4(0PF6.1,F6.1/)//
D 4(L10/)//
E 3(2H ,A2/))
C***** END OF TEST SEGMENT 179
C***** WHEN EXECUTING ONLY SEGMENT 179, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** UNFRW - (180)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST OF UNFORMATTED READ AND WRITE STATEMENTS 7.1.3.2.4
C***** 7.1.3.2.5
C***** S P E C I F I C A T I O N S SEGMENT 180
C*****
C***** WHEN EXECUTING ONLY SEGMENT 180, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION CMA1S(5), CMB1S(5), AC1S(25)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENTS. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 180, THE FOLLOWING STATEMENTS
C***** NUVI=6 AND INVI=9 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C= INVI = 9
C*****
WRITE (NUVI,0180)
180 FORMAT(1H1,1X,30HUNFRW - (180) UNFORMATTED READ/ 14X,
122H AND WRITE STATEMENTS//36H ASA REFS - 7.1.3.2.4 AND 7.1.3.2.5
2//10H RESULTS )
C***** HEADER FOR SEGMENT 180 WRITTEN
CMAVS = 1.5E01
CMBVS = -2.75E-0
MCAVI = 5
MCBVI = -10
DPAVS = 1.02E0
DPBVS = 9876.0E-2
CMA1S(1) = 1.0E0
CMA1S(2) = 2.0E0
CMA1S(3) = 3.0E0
CMA1S(4) = 4.0E0
CMA1S(5) = 5.0E0
C***** WRITE AND READ VARIABLES OF THE SAME TYPE
REWIND INVI
WRITE (INVI) CMAVS, CMBVS
WRITE (INVI) MCAVI, MCBVI
WRITE (INVI) DPAVS, DPBVS
WRITE (INVI) CMA1S
WRITE (INVI) (CMA1S(IVI), IVI = 1,5,1 )
REWIND INVI
READ (INVI) CMCVS, CMDVS
READ (INVI) MCCVI, MCDVI
READ (INVI) DPCVS, DPDVS
READ (INVI) CMB1S
READ (INVI) (AC1S(IVI), IVI = 1,5,1 )
C***** CHECK RECORDS BY SUBTRACTING CORRESPONDING VALUES.
CMEVS = CMAVS - CMCVS
CMFVS = CMBVS - CMDVS
MCEVI = MCAVI - MCCVI
MCFVI = MCBVI - MCDVI
DPEVS = DPAVS - DPCVS
DPFVS = DPBVS - DPDVS
ACVS = CMA1S(1) - CMB1S(1)
BCVS = CMA1S(2) - CMB1S(2)
CCVS = CMA1S(3) - CMB1S(3)
DCVS = CMA1S(4) - CMB1S(4)
FFCVS = CMA1S(5)- CMB1S(5)
CMGVS = CMA1S(1) - AC1S(1)
CMHVS = CMA1S(2) - AC1S(2)
CMIVS = CMA1S(3) - AC1S(3)
CMJVS = CMA1S(4) - AC1S(4)
CMKVS = CMA1S(5) - AC1S(5)
WRITE (NUVI,181) CMEVS, CMFVS, MCEVI, MCFVI, DPEVS, DPFVS,
1 ACVS, BCVS, CCVS, DCVS, FFCVS, CMGVS, CMHVS, CMIVS, CMJVS,
2 CMKVS
0181 FORMAT (//2(F20.10/),2(I19/),7(F20.10/))
C***** READ AND WRITE VARIABLES OF DIFFERENT TYPES
REWIND INVI
WRITE (INVI) CMAVS, MCAVI
WRITE (INVI) CMA1S(1), CMA1S(2), CMBVS, MCBVI
WRITE (INVI) CMA1S(3), CMA1S(4), CMA1S(5), DPAVS, DPBVS
REWIND INVI
READ (INVI) CMCVS, MCCVI
READ (INVI) CMB1S(1), CMB1S(2), CMDVS, MCDVI
READ (INVI) CMB1S(3), CMB1S(4), CMB1S(5), DPCVS, DPDVS
CMEVS = CMAVS - CMCVS
CMFVS = CMBVS - CMDVS
MCEVI = MCAVI - MCCVI
MCFVI = MCBVI - MCDVI
DPEVS = DPAVS - DPCVS
DPFVS = DPBVS - DPDVS
CMGVS = CMA1S(1) - CMB1S(1)
CMHVS = CMA1S(2) - CMB1S(2)
CMIVS = CMA1S(3) - CMB1S(3)
CMJVS = CMA1S(4) -CMB1S(4)
CMKVS = CMA1S(5) - CMB1S(5)
WRITE (NUVI,0182) CMEVS, CMFVS, MCEVI, MCFVI, DPEVS, DPFVS, CMGVS,
1 CMHVS, CMIVS, CMJVS, CMKVS
0182 FORMAT (//2(F20.10/),2(I19/),7(F20.10/))
C***** TEST UNFORMATTED READ WITH NO LIST
REWIND INVI
WRITE (INVI) CMAVS, MCAVI
WRITE (INVI) CMA1S
WRITE (INVI) CMBVS, MCBVI
WRITE (INVI) CMA1S(5),CMA1S(4),CMA1S(3),CMA1S(2),CMA1S(1)
C***** ENDFILE CAN NOT BE TESTED, BUT INCLUDED FOR ACCEPTANCE AS
C***** A STATEMENT.
ENDFILE INVI
REWIND INVI
C*****CHECK THAT A RECORD IS READ WHEN NO LIST IS SUPPLIED BY COMPARING
C***** VALUES OF THE THIRD RECORD
READ (INVI) CMCVS, MCCVI
READ (INVI)
READ (INVI) CMDVS, MCDVI
CMEVS = CMAVS - CMCVS
CMFVS = CMBVS - CMDVS
MCEVI = MCAVI - MCCVI
MCFVI = MCBVI - MCDVI
WRITE (NUVI, 0183) CMEVS, CMFVS, MCEVI, MCFVI
183 FORMAT(//2(F20.10/),2(I19/))
WRITE (NUVI,0184)
184 FORMAT(37H0 ALL ABOVE ANSWERS SHOULD BE ZERO IF /
1 37H THE READ AND WRITE RECORDS COMPARE. )
REWIND INVI
C***** END OF TEST SEGMENT 180
C***** WHEN EXECUTING ONLY SEGMENT 180, THE STOP AND END
C***** CARDS WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** BACUP (182)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** WRITE A BLOCK, 1024 WORDS IN LENGTH, UNFORMATTED, 7.1.3.2.5
C***** TO TAPE,BACKSPACE, READ TO MEMORY 7.1.3.3.2
C***** 7.1.3.2.4
C***** S P E C I F I C A T I O N S SEGMENT 182
C*****
C***** WHEN EXECUTING ONLY SEGMENT 182, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION IV1I(1024)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENTS. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 182, THE FOLLOWING STATEMENTS
C***** NUVI=6 AND IRVI=9 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C= INVI = 9
C*****
1820 FORMAT(1H1,1X,28HBACUP - (182) BACKSPACE TAPE//2X,18HASA REF. 7.1.
33.3.2//9H RESULTS)
WRITE(NUVI,1820)
C***** HEADER FOR SEGMENT 182 WRITTEN
C*****
REWIND INVI
C***** CREATE A LIST, 1024 WORDS IN LENGTH, CONTAINING
C***** THE INTEGERS 1 TO 1024, ONE INTEGER PER WORD.
ISVI = 0
MRRVI = 1
1821 ISVI = ISVI + 1
IV1I(ISVI) = ISVI
IF (ISVI - 1024) 1821, 1822, 1823
C***** WRITE THE LIST TO AN INTERMEDIATE TAPE
1822 WRITE (INVI) IV1I
WRITE(NUVI,1828) MRRVI, (IV1I(JCVI), JCVI=1,9),
1 (IV1I(KCVI),KCVI=1016,1024)
C***** CHANGE MEMORY VALUES TO 5 TIMES THE ORIGINAL VALUES
MRRVI = 2
ISVI = 0
1825 ISVI = ISVI + 1
IV1I(ISVI) = 5 * ISVI
IF (ISVI - 1024) 1825,1826,1823
1826 BACKSPACE INVI
C***** WRITE THE CHANGED VALUES
WRITE(NUVI,1828) MRRVI, (IV1I(JCVI), JCVI=1,9),
1 (IV1I(KCVI),KCVI=1016,1024)
MRRVI = 3
C***** READ INTERMEDIATE TAPE WHICH HAS BEEN BACKSPACED
READ(INVI) IV1I
REWIND INVI
C***** WRITE INITIAL VALUES FROM BACKSPACED TAPE.
WRITE(NUVI,1828) MRRVI,(IV1I(LVI), LVI=1,9),(IV1I(KVI),KVI=
1 1016, 1024)
1823 WRITE (NUVI,1829)
1828 FORMAT(//7H GROUP,I3,3(/2X,3(I6)), 3(/2X,3(I6)))
1829 FORMAT(//2X,33HGROUPS 1 AND 3 SHOULD BE THE SAME/
I 30H AND GROUP 2, 5 TIMES GROUP 1)
C***** END OF TEST SEGMENT 182
C***** WHEN EXECUTING ONLY SEGMENT 182, THE STOP AND END
C***** CARDS WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DOTRM - (190)
C*****
C***********************************************************************
C*****
C***** GENERAL PURPOSE ASA REF
C***** DO LOOPS TESTED WITH ALL ALLOWABLE 7.1.2.8
C***** TERMINAL STATEMENTS (I/O TESTED SEPARATELY)
C***** CONTINUE, ASSIGN, LOGICAL IF
C***** RESTRICTIONS OBSERVED
C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/23
C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08
C***** THE DO AND IS IN THE SAME PROGRAM UNIT
C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07
C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10
C***** DO STATEMENT
C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.2/54
C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.2/01
C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST
C***** * CONTROL IS NEVER PASSED INTO RANGE OF DO FROM 7.1.2.8.2/44
C***** OUTSIDE ITS RANGE
C*****
C***** S P E C I F I C A T I O N S SEGMENT 190
C*****
C***** WHEN EXECUTING ONLY SEGMENT 190, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION IAC1I(5)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 190, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,8906)
8906 FORMAT (1H1,1X,25HDOTRM - (190) DO TERMINAL//2X,
-17HASA REF - 7.1.2.8//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 190
C***** CONTINUE WITH EXPLICIT INCREMENT**********************7.1.2.8
WRITE (NUVI,8905)
8905 FORMAT (//2X,23HTEST1 CONTINUE EXPLICIT)
C***** HEADER FOR CONTINUE EXPLICIT TEST
DO 1901 JACVI = 1,4,1
IAC1I(JACVI) = JACVI
1901 CONTINUE
IF (IAC1I(1)-1) 1909,1902,1909
1902 IF (IAC1I(2)-2) 1909,1903,1909
1903 IF (IAC1I(3)-3) 1909,1904,1909
1904 IF (IAC1I(4)-4) 1909,1905,1909
C***** WRITE OUT ERROR MESSAGE
1909 MRRVI=1
WRITE (NUVI,8904)MRRVI
8904 FORMAT (/2X,6H**TEST,I1,1X,17HINDICATES ERROR**)
C***** ERROR FOR CONTINUE EXPLICIT TEST
GO TO 8909
C***** NO ERROR
C***** WRITE OUT CONTINUE EXPLICIT TEST IS SUCCESS
1905 MRRVI=1
WRITE (NUVI,8903)MRRVI
8903 FORMAT (/2X,6H**TEST,I1,1X,12HSUCCESSFUL**)
C***** SUCCESS FOR CONTINUE EXPLICIT TEST
C***** CONTINUE TERMINAL IMPLIED TEST************************7.1.2.8
WRITE (NUVI,8902)
8902 FORMAT (//2X,22HTEST2 CONTINUE IMPLIED)
C***** HEADER FOR CONTINUE IMPLIED TEST
8909 LCCVI=2
DO 7900 KBCVI = LCCVI,4
7900 IAC1I(KBCVI) = KBCVI + 1
C***** CHECK VALUES IN IAC1I ARRAY
IF (IAC1I(2)-3) 7909,8900,7909
8900 IF (IAC1I(3)-4) 7909,8901,7909
8901 IF (IAC1I(4)-5) 7909,7901,7909
7909 MRRVI=2
WRITE (NUVI,8904)MRRVI
C***** ERROR IN CONTINUE IMPLIED TEST
GO TO 8908
C***** WRITE OUT CONTINUE IMPLIED IS SUCCESS
7901 MRRVI=2
WRITE (NUVI,8903)MRRVI
C***** SUCCESS IN CONTINUE IMPLIED TEST
C***** ASSIGN TERMINAL TEST *********************************7.1.2.8
WRITE (NUVI,9908)
9908 FORMAT (//2X,12HTEST3 ASSIGN)
C***** HEADER FOR ASSIGN TEST
8908 MDCVI = 0
ASSIGN 7904 TO JFCVI
DO 7902 NECVI = 2,5,2
MDCVI = MDCVI +1
7902 ASSIGN 7903 TO JFCVI
GO TO JFCVI, (7903,7904,7904)
C***** AN ERROR IN ASSIGN TEST
7904 MRRVI=3
WRITE (NUVI,8904)MRRVI
C***** ERROR FOR ASSIGN TEST
GO TO 8907
7903 IF (MDCVI-2) 7904,7905,7904
C***** ASSIGN TEST IS SUCCESS
7905 MRRVI=3
WRITE (NUVI,8903)MRRVI
C***** SUCCESS FOR ASSIGN TEST
C***** LOGICAL IF TERMINAL TEST******************************7.1.2.8
WRITE (NUVI,9905)
9905 FORMAT (//2X,16HTEST4 LOGICAL IF)
C***** HEADER FOR LOGICAL IF TEST
8907 KGCVI = 1
LHCVI = 3
ASSIGN 7908 TO KCVI
DO 7906 JCVI = 1,3
KGCVI = KGCVI +1
7906 IF (KGCVI .EQ. LHCVI) ASSIGN 7907 TO KCVI
GO TO KCVI, (7908,7907,7908)
C***** TEST IS SUCCESS
7907 MRRVI=4
WRITE (NUVI,8903)MRRVI
C***** SUCCESS FOR LOGICAL IF TEST
GO TO 9902
C***** LOGICAL IF IS NOT SUCCESS
7908 MRRVI=4
WRITE (NUVI,8904)MRRVI
C***** ERROR FOR LOGICAL IF TEST
9902 CONTINUE
C***** END OF TEST SEGMENT 190
C***** WHEN EXECUTING ONLY SEGMENT 190, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DOLMT - (191)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST DO LOOPS WHERE 7.1.2.8/18
C***** INITIAL
C***** TERMINAL
C***** INCREMENT VALUES
C***** ARE COMPUTED AND SET AT OBJECT TIME
C***** RESTRICTIONS OBSERVED
C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21
C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08
C***** THE DO AND IS IN THE SAME PROGRAM UNIT
C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07
C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10
C***** DO STATEMENT
C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.2/54
C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.2/01
C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST
C***** * CONTROL IS NEVER PASSED INTO RANGE OF DO FROM 7.1.2.8.2/44
C***** OUTSIDE ITS RANGE
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 191, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,1914)
1914 FORMAT (1H1,1X,27HDOLMT - (191) DO SET LIMITS//2X,
- 18HASA REF. - 7.1.2.8//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 191 WRITTEN
JACVI = 1
KBCVI = 3
LCCVI = 1
NECVI = 0
DO 1911 MDCVI = JACVI, KBCVI, LCCVI
NECVI = NECVI + JACVI + KBCVI + MDCVI + LCCVI
1911 CONTINUE
IF (NECVI-21) 1913,1912,1913
C***** ERROR
1913 WRITE (NUVI,1915)
1915 FORMAT (/2X,24H**TEST INDICATES ERROR**//2X,10H**********)
C***** DOLMT TEST FAILS,LIMIT VALUE SET INCORRECTLY
GO TO 1917
C***** CORRECT
1912 WRITE (NUVI,1916)
1916 FORMAT (/2X,19H**TEST SUCCESSFUL**)
C***** DOLMT TEST IS SUCCESSFUL
1917 CONTINUE
C***** END OF TEST SEGMENT 191
C***** WHEN EXECUTING ONLY SEGMENT 191, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DONSC - (192)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST NESTED DO LOOPS 7.1.2.8/28
C***** WITH 2, 3, 4, 5 LEVELS
C***** SPECIAL CONSIDERATION
C***** 5 LEVELS ARBITRARILY ASSIGNED AS MINIMUM REQUIREMENT
C***** RESTRICTIONS OBSERVED
C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21
C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08
C***** THE DO AND IS IN THE SAME PROGRAM UNIT
C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07
C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10
C***** DO STATEMENT
C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.2/54
C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.2/01
C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST
C*****
C***** S P E C I F I C A T I O N S SEGMENT 192
C*****
C***** WHEN EXECUTING ONLY SEGMENT 192, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= INTEGER MCA3I(2,3,3)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 192, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,8920)
8920 FORMAT (1H1,1X,26HDONSC - (192) NESTED LOOPS// 2X,
-18HASA REF. - 7.1.2.8//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 192 WRITTEN
C***** TWO LEVELS OF NESTING*****************************************
MRRVI=2
WRITE (NUVI,8921)MRRVI
8921 FORMAT (//2X,I1,1X,17HLEVELS OF NESTING)
C***** HEADER FOR TWO LEVELS
JACVI = 0
DO 1922 KBCVI = 1, 2, 1
JACVI = KBCVI*3 + JACVI
DO 1921 LCCVI = 1,5, 2
JACVI = JACVI + LCCVI
1921 CONTINUE
1922 CONTINUE
C***** TEST JACVI FOR VALUE OF 27
IF (JACVI-27) 1924,1923,1924
C***** CORRECT
1923 WRITE (NUVI,8922)
8922 FORMAT (2X,19H**TEST SUCCESSFUL**)
C***** TWO LEVELS OF NESTING IS CORRECT
GO TO 7927
C***** ERROR
1924 WRITE (NUVI,8923)
8923 FORMAT (2X,24H**TEST INDICATES ERROR**)
C***** TWO LEVELS OF NESTING IN ERROR
C***** THREE LEVELS OF NESTING***************************************
7927 MRRVI=3
WRITE (NUVI,8921)MRRVI
C***** HEADER FOR THREE LEVELS
MDCVI = 0
DO 1927 LCCVI = 6,7
DO 1926 KBCVI = 8,10,2
DO 1925 JACVI = 1,3,1
MDCVI = MDCVI + JACVI + KBCVI + LCCVI
1925 CONTINUE
1926 CONTINUE
1927 CONTINUE
C***** TEST MDCVI FOR VALUE OF 210
IF (MDCVI - 210) 1928,1929,1928
C***** ERROR
1928 WRITE (NUVI,8923)
C***** THREE LEVELS OF NESTING IN ERROR
GO TO 7928
C***** CORRECT
1929 WRITE (NUVI,8922)
C***** THREE LEVELS OF NESTING IS CORRECT
C***** FOUR LEVELS OF NESTING****************************************
7928 MRRVI=4
WRITE (NUVI,8921)MRRVI
C***** HEADER FOR FOUR LEVELS
IHDVI = 0
IGDVI = 0
IFDVI = 0
IEDVI = 0
ICVI = 1
DO 7920 MDCVI = 2,3
IHDVI = IHDVI + MDCVI + IEDVI
DO 7920 LCCVI = 3,5,3
IGDVI = IGDVI + LCCVI + IHDVI
DO 7920 KBCVI = 1,2,ICVI
IFDVI = IFDVI + KBCVI + IGDVI
DO 7920 JACVI = 4,5,2
IEDVI = IEDVI + JACVI + IFDVI
7920 CONTINUE
C***** TEST IEDVI FOR VALUE OF 185
IF (IEDVI - 185) 7921,7922,7921
C***** ERROR
7921 WRITE (NUVI,8923)
C***** FOUR LEVELS OF NESTING IN ERROR
GO TO 7929
C***** CORRECT
7922 WRITE (NUVI,8922)
C***** FOUR LEVELS OF NESTING IS CORRECT
C***** FIVE LEVELS OF NESTING****************************************
7929 MRRVI=5
WRITE (NUVI,8921)MRRVI
C***** HEADER FOR FIVE LEVELS
IGDVI = 0
DO 7923 NECVI = 10,11,1
DO 7923 MDCVI = 4,5,1
DO 7924 LCCVI = 1,2,3
DO 7924 KBCVI = 6, 8, 4
DO 7924 JACVI = 1,3,2
IGDVI=IGDVI+JACVI-KBCVI+LCCVI-MDCVI+NECVI
7924 CONTINUE
7923 CONTINUE
C***** TEST IGDVI FOR VALUE OF 24
IF (IGDVI - 24) 7925, 7926,7925
C***** ERROR
7925 WRITE (NUVI,8923)
C***** FIVE LEVELS IN ERROR
GO TO 9923
7926 WRITE (NUVI,8922)
C***** FIVE LEVELS CORRECT
C***** CONTROL VARIABLES FOR 3 DO LOOPS USED IN SUBSCRIPT EXPRESSIONS
C***** FOR A 3 DIMENSIONAL ARRAY
9923 WRITE(NUVI, 9920)
9920 FORMAT(//2X,34HCONTROL VARIABLE USED IN SUBSCRIPT )
IVI = 1
KVI = 0
8924 KVI = KVI + 1
JVI = 0
8925 JVI = JVI + 1
MCA3I(IVI,JVI,KVI) = IVI + 2*(JVI-1)+ 6*(KVI-1)
MCA3I(IVI+1,JVI,KVI) = IVI+1 +2*(JVI-1)+6*(KVI-1)
IF(JVI-3) 8925,8926,8929
8926 IF(KVI-3)8924,8927,8929
8927 IIVI = 1
DO 8928 KVI =1,3
DO 8928 JVI = 1,3
DO 8928 IVI = 1,2
IAVI =MCA3I(IVI,JVI,KVI) - IIVI
IF (IAVI) 8929, 8928, 8929
8929 WRITE (NUVI, 8923)
GO TO 9921
8928 IIVI = IIVI + 1
WRITE (NUVI, 8922)
9921 CONTINUE
C***** END OF TEST SEGMENT 192
C***** WHEN EXECUTING ONLY SEGMENT 192, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DONSI - (193)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TESTS INCOMPLETE DO LOOP 7.1.2.8.1/19
C***** RESTRICTIONS OBSERVED
C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21
C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08
C***** THE DO AND IS IN THE SAME PROGRAM UNIT
C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07
C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10
C***** DO STATEMENT
C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.1/54
C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.1/01
C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 193, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,1935)
1935 FORMAT (1H1,1X,27HDONSI - (193) INCOMPLETE DO//2X,
- 18HASA REF. - 7.1.2.8//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 193 WRITTEN
KBCVI = 0
DO 1931 JACVI = 1,5,1
KBCVI = KBCVI + JACVI
IF(KBCVI - 6) 1931, 1930, 1931
1930 GO TO 1932
1931 CONTINUE
C***** ERROR EXIT
WRITE (NUVI,1936)
1936 FORMAT (1H0,2X,28H**INCOMPLETE LOOP IN ERROR**)
C***** INCOMPLETE LOOP TEST IN ERROR
GO TO 1937
C***** TEST JACVI FOR VALUE OF 3 7.1.2.8.1/21
1932 IF (JACVI - 3) 1933,1934,1933
C***** ERROR IN INDUCTION VARIABLE
1933 WRITE (NUVI,1938)
1938 FORMAT (1H0,2X,31H**INDUCTION VARIABLE IN ERROR**)
C***** INDUCTION VARIABLE SET INCORRECTLY OUTSIDE LOOP
GO TO 1937
1934 WRITE (NUVI,1939)
1939 FORMAT (1H0,1X,30H**INCOMPLETE LOOP SUCCESSFUL**)
C***** INCOMPLETE LOOP TEST SUCCESS
1937 CONTINUE
C***** END OF TEST SEGMENT 193
C***** WHEN EXECUTING ONLY SEGMENT 193, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DONSX - (194)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TESTS EXTENDED RANGE OF DO LOOP VARIABLE 7.1.2.8.2
C***** RESTRICTIONS OBSERVED
C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21
C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08
C***** THE DO AND IS IN THE SAME PROGRAM UNIT
C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07
C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10
C***** DO STATEMENT
C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.2/54
C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.2/01
C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST
C***** * THE EXTENDED RANGE OF A DO DOES NOT CONTAIN A 7.1.2.8.2/48
C***** DO OF THE SAME PROGRAM UNIT THAT HAS AN
C***** EXTENDED RANGE.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 194
C*****
C***** WHEN EXECUTING ONLY SEGMENT 194, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION IAC1I(5)
C= INTEGER I3I(2,2,2)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 194, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,8944)
8944 FORMAT (1H1,1X,31HDONSX - (194) EXTENDED DO RANGE//2X,
120HASA REF. - 7.1.2.8.2//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 194 WRITTEN
C***** EXTENDED RANGE FROM SINGLE LEVEL******************************
MRRVI=1
WRITE (NUVI,8942)MRRVI
8942 FORMAT (//2X,26HEXTENDED RANGE FROM LEVEL ,I1)
C***** HEADER FOR SINGLE LEVEL WRITTEN
DO 1941 JACVI = 1,4,2
IAC1I(JACVI) = JACVI
GO TO 1942
1943 IF(JACVI-1) 1945,1941,1945
1941 CONTINUE
GO TO 1949
C***** TEST JACVI FOR VALUE OF 1
1942 IF (JACVI - 1) 1946,1943,1946
C***** TEST IAC1I(1) AND IAC1I(3) FOR VALUES OF 1 AND 3
1946 IF (IAC1I(1)-1) 1947,7946,1947
7946 IF (IAC1I(3)-3) 1947,1943,1947
C***** ERROR
1947 WRITE (NUVI,7947)
7947 FORMAT (/2X,24H**TEST INDICATES ERROR**)
C***** ERROR IN SETTING OF IAC1I ARRAY, LOOP NOT WORKING
GO TO 8940
C***** TEST JACVI FOR VALUE OF 3
1945 IF (JACVI - 3) 1948,1941,1948
C***** ERROR
1948 WRITE (NUVI,7947)
C***** ERROR IN SETTING OF INDUCTION VARIABLE
GO TO 8940
1949 WRITE (NUVI,7949)
7949 FORMAT (/2X,19H**TEST SUCCESSFUL**)
C***** EXTENDED RANGE SUCCESS FOR SINGLE LEVEL
8940 MRRVI=2
C***** EXTENDED RANGE FROM DOUBLE LEVEL******************************
WRITE (NUVI,8942)MRRVI
C***** HEADER FOR DOUBLE LEVEL WRITTEN
DO 7940 KBCVI = 3,4
DO 7940 JACVI = 1,2,3
GO TO 7941
8947 IGDVI= 1
7940 CONTINUE
C***** TEST JACVI FOR VALUE OF 1
7941 IF (JACVI-1) 7942,7943,7942
C***** ERROR
7942 WRITE (NUVI,7947)
C***** DOUBLE LEVEL NESTING IN ERROR
GO TO 8946
C***** TEST KBCVI FOR VALUE OF 3 OR 4
7943 IF (KBCVI-3) 7942,8947,7944
7944 IF (KBCVI-4) 7942,7945,7942
C***** CORRECT
7945 WRITE (NUVI,7949)
C***** DOUBLE LEVEL TEST CORRECT
8946 CONTINUE
I3I(1,1,1) = 2
I3I(2,1,1) = 4
I3I(1,2,1) = 1
I3I(2,2,1) = 2
I3I(1,1,2)= -2
I3I(2,1,2) = 0
I3I(1,2,2) = -3
I3I(2,2,2) = -2
8952 FORMAT(//2X,40HEXTENDED RANGE CONTAINING A DO STATEMENT)
WRITE(NUVI, 8952)
DO 8948 IVI = 1,2
I3I(1,1,IVI) = I3I(1,1,IVI) + 1
DO 8948 JVI = 1,2
I3I(1,JVI,IVI) = I3I(1,JVI,IVI) + 2
GO TO 8949
8951 CONTINUE
8948 CONTINUE
WRITE (NUVI, 8950) I3I
8950 FORMAT(8(/I5) /30H THE ABOVE 8 VALUES SHOULD BE/
1 33H IN DESCENDING ORDER FROM 8 TO 1)
GO TO 8953
8949 DO 8954 KVI = 1,2
I3I(KVI,JVI,IVI) = I3I(KVI,JVI,IVI) + 3
8954 CONTINUE
GO TO 8951
8953 CONTINUE
C***** END OF TEST SEGMENT 194
C***** WHEN EXECUTING ONLY SEGMENT 194, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DONML - (195)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TESTS TWO INDEPENDENT LOOPS NESTED 7.1.2.8/28
C***** WITHIN LARGER ONE
C***** RESTRICTIONS OBSERVED
C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21
C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08
C***** THE DO AND IS IN THE SAME PROGRAM UNIT
C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07
C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10
C***** DO STATEMENT
C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.1/54
C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.1/01
C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 195, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,1950)
1950 FORMAT (1H1,1X,30HDONML - (195) MULT-LEVEL LOOPS//2X,
- 18HASA REF. - 7.1.2.8//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 195 WRITTEN
IHDVI = 1
IGDVI = 2
IFDVI = 3
DO 1951 JACVI = 1,2
IFDVI = IFDVI + JACVI
DO 1952 KBCVI = 2,4,1
IGDVI = IGDVI + 1
1952 CONTINUE
IFDVI = IFDVI + IGDVI
DO 1953 LCCVI = 6,7,3
IHDVI = 1 + IHDVI
1953 CONTINUE
IFDVI = IFDVI + IHDVI
1951 CONTINUE
C***** TEST IFDVI FOR VALUE OF 24
IF (IFDVI - 24) 1954,1955,1954
C***** ERROR
1954 WRITE (NUVI,1956)
1956 FORMAT (/2X,24H**TEST INDICATES ERROR**)
C***** MULTI-LEVEL TEST IN ERROR
GO TO 1958
C***** CORRECT
1955 WRITE (NUVI,1957)
1957 FORMAT (/2X,19H**TEST SUCCESSFUL**)
C***** MULTI-LEVEL TEST CORRECT
1958 CONTINUE
C***** END OF TEST SEGMENT 195
C***** WHEN EXECUTING ONLY SEGMENT 195, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** DON10 - (196)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST DO LOOPS WHICH HAVE I/O TERMINAL 7.1.2.8
C***** STATEMENTS (FORMATTED READ, FORMATTED WRITE 7.1.3.2.2
C***** AND REWIND ARE USED AS TERMINAL STATEMENTS) 7.1.3.2.3
C***** 7.1.3.3.1
C***** RESTRICTIONS OBSERVED
C***** * M1, M2 AND M3 ARE GREATER THAN ZERO 7.1.2.8/21
C***** * TERMINAL STATEMENT OF EACH DO PHYSICALLY FOLLOWS 7.1.2.8/08
C***** THE DO AND IS IN THE SAME PROGRAM UNIT
C***** * TERMINAL STATEMENT IS EXECUTABLE BUT NOT A 7.1.2.8/07
C***** GO TO, ARITHMETIC IF, RETURN, STOP, PAUSE OR 7.1.2.8/10
C***** DO STATEMENT
C***** * M1, M2 AND M3 ARE NOT REDEFINED WITHIN DO 7.1.2.8.2/54
C***** * BRANCHES TO TERMINAL STATEMENT FOR MORE THAN 7.1.2.8.2/01
C***** ONE DO ARE CONTAINED IN INNERMOST DO OF A NEST
C*****
C***** S P E C I F I C A T I O N S SEGMENT 196
C*****
C***** WHEN EXECUTING ONLY SEGMENT 196, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION IAC1I(5),AC2S(5,6)
C= LOGICAL MCAVB,MCBVB,GH2B(1,2)
C= DOUBLE PRECISION CC3D(7,2,2),DPAVD,DPBVD
C= COMPLEX NUMVC,DENVC,LL1C(32)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENTS. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 196, THE FOLLOWING STATEMENTS
C***** NUVI=6 AND INVI=9 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C= INVI = 9
C*****
WRITE (NUVI,1960)
1960 FORMAT (1H1,1X,31HDONIO - (196) DO LOOPS WITH I/O/16X,
119HTERMINAL STATEMENTS/ 20H ASA REF. - 7.1.2.8/ 9H RESULTS)
C***** HEADER FOR SEGMENT 196 WRITTEN
KCAVI = 1
CKAVS = 1.0
DPBVD = 1.0D0
DENVC = (1.0,1.0)
MCBVB = .TRUE.
IAC1I(2) = 1
AC2S(4,3) = 1.
CC3D(5,1,2) = 1.0D0
LL1C(2) = (1.0,1.0)
GH2B(1,1) = .TRUE.
OPEN(INVI,FILE="JUNK2",IOSTAT=IOX,ERR=5001)
WRITE(NUVI,"('OPEN=',I4)") IOX
GOTO 5002
5001 WRITE(NUVI,"('OPEN ERROR',I4)") IOX
5002 CONTINUE
WRITE (INVI,1965) KCAVI, CKAVS, DPBVD, DENVC, MCBVB, IAC1I(2),
1 AC2S(4,3), CC3D(5,1,2), LL1C(2), GH2B(1,1)
REWIND INVI
DO 1964 JACVI = 1,3,1
C*****
DO 1961 KBCVI = 1,1,1
1961 READ (INVI,1965) MCAVI,CMAVS,DPAVD,NUMVC,MCAVB,IAC1I(KBCVI),
1 AC2S(5,4), CC3D(6,1,2), LL1C(3), GH2B(KBCVI,2)
C*****
DO 1962 LCCVI = 1,2,1
1962 REWIND INVI
C*****
DO 1963 MDCVI = 1,1,1
1963 WRITE (NUVI,1966) MCAVI, IAC1I(1), CMAVS, AC2S(5,4), DPAVD,
1 CC3D(6,1,2), NUMVC, LL1C(3), MCAVB,
2 GH2B(MDCVI, MDCVI+1)
1964 CONTINUE
WRITE (NUVI,1967)
C***** FORMAT STATEMENTS FOR THIS SEGMENT
1965 FORMAT (2(I5,F5.1,D8.1,2(F5.1),L5))
1966 FORMAT ( // 2(I10/),2(F11.1/),2(D15.1/),2(F5.1,F6.1/),2(L10/))
1967 FORMAT (//30H THIS TEST IS SUCCESSFUL IF 3/38H IDENTICAL GROUP
1S OF OUTPUT HAVE BEEN/12H GENERATED.)
C***** END OF SEGMENT 196
C***** WHEN EXECUTING ONLY SEGMENT 196, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** MORDO - (197)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** A MORE COMPLICATED SEGMENT TESTING THE DO STATEMENT 7.1.2.8
C*****
C***** S P E C I F I C A T I O N S SEGMENT 197
C*****
C***** WHEN EXECUTING ONLY SEGMENT 197 THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION IAC1I(5), MCA1I(5)
C*****
C***** WHEN EXECUTING ONLY SEGMENT 197, THE SEGMENT 005, WHICH
C***** CONTAINS THE STATEMENT FUNCTIONS BEING USED HERE, MUST BE
C***** INSERTED AFTER THE SPECIFICATION STATEMENTS OF SEGMENT 197.
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENTS. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 197, THE FOLLOWING STATEMENTS
C***** NUVI=6 AND INVI=9 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C= INVI = 9
C*****
WRITE (NUVI,1970)
1970 FORMAT (1H1, 1X,37HMORDO - (197) A MORE COMPLICATED SEG./16X,
1 16HOF DO STATEMENTS//
2 35H ASA REFS - 7.1.2.8 AND 7.1.2.8.1 // 9H RESULTS )
C***** HEADER FOR SEGMENT 197 WRITTEN
C***** TEST OF DO WITH STATEMENT FUNCTIONS AND INTRINSIC FUNCTIONS
C***** REFERENCED WITHIN ITS RANGE. TO BE RUN WITH SEG. 005 AND 412
OPEN(INVI,FILE="JUNK3",FORM="UNF",IOSTAT=IOX,ERR=6001)
WRITE(NUVI,"('OPEN=',I4)") IOX
GOTO 6002
6001 WRITE(NUVI,"('OPEN ERROR',I4)" ) IOX
6002 CONTINUE
ASSIGN 9190 TO MVI
MCBVI = 0
MCHVI = 1971
DO 1971 MCAVI = 4,8,4
CMAVS = CMAFS(1.0, FLOAT(MCAVI))
1971 MCBVI = MCBVI + MCAFI(MCAVI,IFIX(CMAVS) - (MCAVI+2))
IF (MCBVI - 2) 9966, 9190, 9966
9190 MCHVI = 1973
C***** TEST OF DO WITH CALL STATEMENTS REFERENCED WITHIN ITS RANGE
IVI = 0
ASSIGN 9968 TO MVI
DO 1973 MCAVI = 1,3
1973 CALL MDQ( MCAVI, IVI)
IF(IVI - 6) 9966, 9968, 9966
C***** TEST OF DO WITH THE FOLLOWING FEATURES COMBINED -
C***** 1. AN EXIT FROM THE RANGE OF A DO BY THE EXECUTION OF A
C***** GO-TO STATEMENT, THE CONTROL VARIABLE OF THE DO IS
C***** DEFINED 7.1.2.8.1/19-23
C***** 2. A GO TO STATEMENT CAUSES CONTROL TO PASS FROM AN
C***** INNER DO TO THE OUTER DO (WITHIN THE NESTED RANGE)
9968 MCHVI = 1976
ASSIGN 9191 TO MVI
MCBVI = 0
DO 1976 MCAVI = 1,1,1
9192 MCBVI = MCBVI + 1
DO 1975 MCCVI = 1,3,1
MCBVI = MCBVI + 1
IF(MCBVI - 4) 9197, 9192, 1975
9197 GO TO (1975, 1975, 9966), MCCVI
1975 CONTINUE
1976 CONTINUE
IF (MCBVI - 8) 9966, 9191, 9966
C***** TEST THAT THE STATEMENT LABEL OF THE TERMINAL STATEMENT
C***** OF MORE THAN ONE DO CAN BE USED IN ANY GO TO OR ARITHMETIC
C***** IF STATEMENT THAT OCCURS IN THE RANGE OF THE MOST DEEPLY
C***** CONTAINED DO WITH THAT TERMINAL STATEMENT. 7.1.2.8.2/1-6
C***** ALSO THE CONTROL VARIABLE IS DEFINED WHEN EXIT IS MADE BY THE
C***** EXECUTION OF AN ARITHMETIC IF STATEMENT.
9191 ASSIGN 9194 TO MVI
MCHVI = 1977
MCEVI = -24
DO 1977 MCAVI = 1,2
MCEVI = MCEVI + 1
DO 1977 MCBVI = 1,2
MCEVI = MCEVI + 1
DO 1977 MCCVI = 1,5,1
MCEVI = MCEVI + 1
IF(MCEVI ) 1977, 1977, 1978
1977 CONTINUE
C***** ERROR IF LOOP TERMINATES THRU CONTINUE
GO TO 9966
C***** CONTROL VARIABLE DEFINED ON FIRST LEVEL ON ARITH. IF
1978 MCEVI = MCAVI + MCBVI + MCCVI
MCHVI = 1978
IF(MCEVI -8) 9966,9194,9966
9194 MCHVI = 1974
MCEVI = 0
ASSIGN 9961 TO MVI
DO 1974 MCAVI = 1,2
DO 1974 MCBVI = 1,2,1
DO 1974 MCCVI = 4,5,1
DO 1974 MCDVI = 2,3
GO TO 9193
9195 GO TO 1974
9193 MCEVI = MCAVI + MCBVI + MCCVI + MCDVI + MCEVI
GO TO 9195
1974 CONTINUE
IF(MCEVI - 160) 9966, 9961, 9966
C***** TEST OF DO WITH I/O STATEMENTS REFERENCED WITHIN ITS RANGE.
C***** REWIND, UNFORMATTED READ AND WRITE ARE REFERENCED. THE
C***** FOLLOWING 3 DOS MUST BE KEPT TOGETHER FOR SELF-CHECKING
C***** PURPOSES
9961 MCHVI = 1972
ASSIGN 9196 TO MVI
REWIND INVI
DO 9963 MCAVI = 1,4
MCA1I(MCAVI) = MCAVI
WRITE ( INVI) (MCA1I(MCBVI), MCBVI = 1,MCAVI, 1)
9963 CONTINUE
DO 9964 MCCVI = 1,4
9964 REWIND INVI
DO 1972 MCDVI = 1,4
READ (INVI) (IAC1I(MCEVI),MCEVI = 1,MCDVI)
DO 1972 MCFVI = 1, MCDVI
MCGVI = IAC1I(MCFVI) - MCA1I(MCFVI)
IF (MCGVI) 9966, 1972, 9966
1972 CONTINUE
9196 WRITE(NUVI, 9969)
GO TO 9198
C***** ERROR MESSAGES IF DO STATEMENT IS EXECUTED IN ERROR.
9966 WRITE (NUVI,9967) MCHVI
9967 FORMAT (// 36H DO RANGE ENDING AT STATEMENT LABEL,I5,
114H IS IN ERROR.)
9969 FORMAT(// 35H THIS SEGMENT SUCCESSFULLY TESTED /
222H IF NO ERROR MESSAGES)
GO TO MVI,(9190,9968,9191,9194,9961,9196)
9198 REWIND INVI
C***** END OF TEST SEGMENT 197
C***** WHEN EXECUTING ONLY SEGMENT 197, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** SUBR1 - (200)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF.
C***** TO TEST SUBROUTINE SUBPROGRAM WITHOUT AN ARGUMENT LIST 8.4.1.1
C***** GENERAL COMMENTS
C***** IT IS TO BE RUN WITH SEGMENT 410
C***** RESTRICTIONS OBSERVED
C***** SYMBOLIC NAME OF A SUBROUTINE MAY NOT APPEAR IN ANY 8.4.1.1/56
C***** STATEMENT IN THIS SUBROUTINE EXCEPT IN THE
C***** SUBROUTINE STATEMENT ITSELF
C***** * SYMBOLIC NAMES OF DUMMY ARGUMENTS MAY NOT APPEAR 8.4.1.1/39
C***** IN EQUIVALENCE OR COMMON STATEMENTS IN THE SUBPROGRAM
C***** * SUBROUTINES MAY NOT CONTAIN A FUNCTION STATEMENT, 8.4.1.1/45
C***** ANOTHER SUBROUTINE STATEMENT, OR ANY STATEMENT THAT
C***** DIRECTLY OR INDIRECTLY REFERENCES THE SUBROUTINE
C***** BEING DEFINED
C***** * AT LEAST ONE RETURN STATEMENT MUST BE IN A SUBROUTINE
C***** 8.4.1.1/49
C***** S P E C I F I C A T I O N S SEGMENT 200
C*****
C***** WHEN EXECUTING ONLY SEGMENT 200, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= COMMON AXVS, CXVS, IXVI, IAX1I(4)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C***** WHEN EXECUTING ONLY SEGMENT 200, THE FOLLOWING STATEMENTS
C***** NUVI=6 AND INVI=9 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C= INVI = 9
WRITE(NUVI, 0200)
200 FORMAT(39H1 SUBR1 - (200) SUBROUTINE SUBPROGRAM /15X,
124HWITHOUT AN ARGUMENT LIST //18H ASA REF. - 8.4.1//9H RESULTS)
IXVI = NUVI
IAX1I(1) = INVI
CALL SUBRQ
CONTINUE
C***** END OF SEGMENT 200
C***** WHEN EXECUTING ONLY SEGMENT 200, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
C***********************************************************************
C*****
C***** SUBRQ - (410)
C*****
C***********************************************************************
C***** THIS SEGMENT TESTS THAT A VARIETY OF FORTRAN STATEMENTS
C***** CAN BE USED IN A SUBROUTINE. IT IS TO BE RUN WITH SEGMENT 200
SUBROUTINE SUBRQ
DIMENSION KCA1I(5), KAC1I(5)
COMMON BXVS, DXVS, NXVI, IXVI
C***** DEFINE ARITHMETIC STATEMENT FUNCTION
CKAFS(CEWVS,CFWVS) = CEWVS*2. + CFWVS
8868 FORMAT (//35H THIS SEGMENT SUCCESSFULLY TESTED /
1 23H IF NO ERROR MESSAGES.)
8867 FORMAT (//36H DO RANGE ENDING AT STATEMENT LABEL,I5,14H IS IN ER
1ROR.)
KCAFI(KEWVI,KFWVI) = KEWVI**KFWVI
C***** TEST OF DO WITH STATEMENT FUNCTIONS
KCHVI = 4101
ASSIGN 4102 TO MVI
KCBVI = 0
DO 4101 KCAVI = 4,8,4
CKAVS = CKAFS(1.0, FLOAT(KCAVI))
4101 KCBVI = KCBVI + KCAFI(KCAVI,IFIX(CKAVS) - (KCAVI + 2))
IF(KCBVI - 2) 8866, 4102, 8866
C***** TEST OF DO WITH THE FOLLOWING FEATURES COMBINED -
C***** 1. AN EXIT FROM THE RANGE OF A DO BY THE EXECUTION OF A
C***** GO-TO STATEMENT, THE CONTROL VARIABLE OF THE DO IS
C***** DEFINED
C***** 2. A GO TO STATEMENT CAUSES CONTROL TO PASS FROM AN
C***** INNER DO TO THE OUTER DO (WITHIN THE NESTED RANGE)
4102 KCHVI = 4106
ASSIGN 8870 TO MVI
KCBVI = 0
DO 4106 KCAVI = 1,1,1
8872 KCBVI = KCBVI + 1
DO 4105 KCCVI = 1,3,1
KCBVI = KCBVI + 1
IF (KCBVI - 4) 8873, 8872, 4105
8873 GO TO (4105,4105,8866), KCCVI
4105 CONTINUE
4106 CONTINUE
IF(KCBVI - 8) 8866, 8870, 8866
C***** TEST THAT THE STATEMENT LABEL OF THE TERMINAL STATEMENT
C***** OF MORE THAN ONE DO CAN BE USED IN ANY GO TO OR ARITHMETIC
C***** IF STATEMENT THAT OCCURS IN THE RANGE OF THE MOST DEEPLY
C***** CONTAINED DO WITH THAT TERMINAL STATEMENT
8870 ASSIGN 8876 TO MVI
KCHVI = 4107
KCEVI = -24
DO 4107 KCAVI = 1,2
KCEVI = KCEVI + 1
DO 4107 KCBVI = 1,2
KCEVI = KCEVI + 1
DO 4107 KCCVI = 1,5,1
KCEVI = KCEVI + 1
IF(KCEVI ) 4107,4107,4104
4107 CONTINUE
C*****ERROR IF LOOP TERMINATES THRU CONTINUE
GO TO 8866
C*****CONTROL VARIABLE DEFINED ON FIRST LEVEL ON ARITH. IF
4104 KCEVI = KCAVI + KCBVI + KCCVI
KCHVI = 4104
IF(KCEVI - 8) 8866,8876,8866
8876 KCHVI = 4103
KCEVI = 0
ASSIGN 8871 TO MVI
DO 4103 KCAVI =1,2
DO 4103 KCBVI = 1,2,1
DO 4103 KCCVI = 4,5,1
DO 4103 KCDVI = 2,3
GO TO 8878
8877 GO TO 4103
8878 KCEVI = KCAVI + KCBVI + KCCVI + KCDVI + KCEVI
GO TO 8877
4103 CONTINUE
IF(KCEVI - 160)8866,8871,8866
C***** TEST OF DO WITH I/O STATEMENTS
8871 ASSIGN 8860 TO MVI
KCHVI = 4108
REWIND IXVI
DO 8863 KCAVI = 1,4
KCA1I(KCAVI) = KCAVI
WRITE(IXVI)(KCA1I(KCBVI),KCBVI = 1,KCAVI,1)
8863 CONTINUE
DO 8864 KCCVI =1,4
8864 REWIND IXVI
DO 4108 KCDVI = 1,4
READ(IXVI)(KAC1I(KCEVI),KCEVI = 1,KCDVI )
DO 4108 KCFVI = 1, KCDVI
KCGVI = KAC1I(KCFVI)-KCA1I(KCFVI)
IF(KCGVI) 8866,4108,8866
4108 CONTINUE
8860 WRITE(NXVI,8868)
GO TO 8869
8866 WRITE(NXVI,8867) KCHVI
GO TO MVI,(8860,4102,8870,8871,8876)
8869 REWIND IXVI
RETURN
C***** END OF TEST SEGMENT 410
END
C***********************************************************************
C*****
C***** MDQ - (412)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** THIS SUBROUTINE IS USED WITH SEGMENT 197 TO
C***** SHOW THAT SUBROUTINES MAY BE CALLED FROM DO LOOPS
SUBROUTINE MDQ(MWVI,IWVI)
IWVI = MWVI + IWVI
RETURN
C***** END OF TEST SEGMENT 412
END
C***********************************************************************
C*****
C***** BLAKD - (419)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** THIS SEGMENT CONTAINS THE FIRST OF THREE BLOCK DATA SUBPROGRAMS
C***** TO BE RUN WITH SEGMENT 179
C***** THESE SEGMENTS USE ALL THE PERMISSIBLE STATEMENTS IN A
C***** BLOCK DATA SUBPROGRAM. THE DATA STATEMENTS CONSIST OF ALL
C***** TYPES OF VARIABLES AND ARRAYS. A HOLLERITH CONSTANT IS
C***** ASSIGNED TO INTEGER , REAL, AND LOGICAL
BLOCK DATA
DOUBLE PRECISION DXVD, DX1D, DX2D
COMMON /BLK1/JXVI, JAX1I(2), JAX2I(3,3)
A /BLK2/ DXVS, DX1S(2), DX2S(2,2)
B /BLK3/ DXVD, DX1D(2), DX2D(2,2)
INTEGER JXVI
REAL DXVS
DATA JXVI, JAX1I(1), JAX2I(1,2), DXVS, DX1S(2)
A ,DX2S(1,2), DXVD, DX1D(1), DX2D(1,2)/ 3 * 1
B ,3 * 2.0,3*4.0D0/, JAX2I(1,3),DX2S(2,1)/2HHP,2HHP/
C***** END OF TEST SEGMENT 419
END
C***********************************************************************
C*****
C***** BLBKD - (429)
C*****
C***********************************************************************
C***** TO BE RUN WITH SEGMENT 179
C***** THIS SEGMENT CONTAINS THE 2ND OF THREE BLOCK DATA SUBPROGRAMS
C***** TO BE RUN WITH SEGMENT 179
BLOCK DATA
COMPLEX DXVC, DX1C, DX2C
COMMON /BLK4/ DXVC,DX1C(2), DX2C(2,2)
C /BLK5/DXVB, DX1B(2), DX2B(2,2)
LOGICAL DXVB, DX1B, DX2B
DATA DXVC, DX1C(1), DX2C(1,2),DXVB, DX1B(1),DX2B(1,2)/
D 3 * (3.,4.), 3 *.FALSE./
C***** END OF TEST SEGMENT 429
END
C***********************************************************************
C*****
C***** BLCKD - (439)
C*****
C***********************************************************************
C***** THIS SEGMENT CONTAINS THE THIRD OF THREE BLOCK DATA SUBPROGRAMS
C***** TO BE RUN WITH SEGMENT 179
BLOCK DATA
COMMON /BLK6/JAX3I(2,2,2),DX3S(2,2,2),DX3D(2,2,2)
E ,DZ3C(2,2,2), DX3B(2,2,2)
DOUBLE PRECISION DX3D
DIMENSION CY3C(2,2,2)
COMPLEX DZ3C,CY3C
LOGICAL DX3B
EQUIVALENCE (DZ3C(1,1,1), CY3C(1,1,1))
DATA JAX3I(1,1,2),DX3S(1,1,2),DX3D(1,1,2),CY3C(1,1,2),DX3B(1,1,2)/
F 1, 2.0, 4.0D0, (3.,4.),.FALSE./ ,DX3B(2,2,2)/
G 2HHP/
C***** END OF TEST SEGMENT 439
END
nbs13.d 480890375 170 2 100666 1364 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2. DOUBLE SPACE ON OUTPUT ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4. DOUBLE SPACE ON OUTPUT ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6. DOUBLE SPACE ON OUTPUT ID 6
. . . 0. E+00 + + . E00
+ + . D+00 . D0
1.23456987654. +1.234E-0 -98.7654E+0 + 2345.67891011+2 -.109876-4
12345
12345
12345
12345
12345
1.1
1.1
1.1
1.1
+0.339567E+02
+ .339567+2
+ 3.395670E1
0.96295134244D+04
.96295134244D04
0.96295134244+4
0.96295134244D+04
31.23+0.14E+04+0.2D+02
31.23 .14E+04 +.2+2
-0.13579E+054444
4444
4444
4444
4444
-333 5.555+0.4545E-04
-6.666 .9989E+12
7.77-0.747E-02 +0.549E022
+0.662E-00 0.468-1011
0.59542D+04-44.6666-0.1234567890D-03
54.9327-0.1395624534D+00
65432.1
+0.848E+03 .848E3 + .1290D7+0.129D+07 0.412D21
22222222222222222222222222222222222222222222222222
-.987E0-0.987E+00 +0.6D0 + 0.6D+00 .368D-5
5 5 5 5
987654 8647.86 987.654
(I5,6X, I4, 2(I3), I2)
(E 9.2,3(E13.6))
( L1 , 2(L2),L3)
(2X,A2,5(A2))
(2X,F5.3, F4.0, 2(F7.2))
(2X , D 16.9,D9.2)
84756 -867224+39-6
23498.-77.27547.18
-.0076+11+08.93421E-13 893.421E-15+08.93421E-13
-0.357901246D+00 +0.52D-2
TTA FF9$
AB
CDE+*=123
nbs13.f 480890387 170 2 100666 43591 `
C***** PART13 ****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 13 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** LOGIF - 300 LOGICAL IF STATEMENTS
C*****
C***** SMCQ - 411 SUBROUTINE
C*****
C***** BARIF - 301 ARITHMETIC IF STATEMENTS
C*****
C***** FARIF - 302 ARITHMETIC IF STATEMENTS
C*****
C***** IOFMT - 310 FORMATTED READ, WRITE
C*****
C***** RDFMT - 312 FORMATS IN ARRAYS
C*****
C***** FMTQ - 462 SUBROUTINE
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN SEGMENTS
C***** 300, 301, 302, 310, 312 ARE RUN AS ONE MAIN PROGRAM.
C*****
REAL MVS
DIMENSION L1I(10)
DIMENSION IAC2I(2,7),ZU1S(13),ZU3S(3,2,2),ZU2S(4,2),ZT1S(4)
DIMENSION A1S(5 ),A2S(2,2),A3S(3,3,3),YER1S(7),EP1S(33)
DIMENSION IAC1I(5),MCA1I(5),AC1S(25),AC2S(5,6),CMA1S(5)
INTEGER AVI,IU2I(4,2),IT3I(4,2,2),IU3I(2,3,3), MCA3I(2,3,3)
LOGICAL MCAVB, MCBVB, MCA1B(7), AVB, BVB, CVB, GG1B(2), A1B(2)
COMPLEX CHAVC,CHBVC
DOUBLE PRECISION MCAVD, MCBVD, MCCVD, A1D(4), A2D(2,2), A3D(2,2,2)
1 ,DPAVD, DPBVD,DPCVD,DPEVD,DPFVD,DPHVD,DPDVD,AAAVD
DATA IU2I(1,1),IU2I(2,1),IU2I(3,1),IU2I(4,1),IU2I(1,2),IU2I(2,2),
1 IU2I(3,2)/2H(A,2H2/,2H2X,2H,5,2H(A,2H2),1H) /
DATA ZU1S(1),ZU1S(2),ZU1S(3),ZU1S(4),ZU1S(5),ZU1S(6),ZU1S(7),
1 ZU1S(8),ZU1S(9),ZU1S(10),ZU1S(11),ZU1S(12) /
2 2H( ,2H ,2HF3,2H.3,1H,,2HF3,2H.0,2H, ,2H2(,2HF6,2H.2,2H)) /
DATA IU3I(1,1,1),IU3I(2,1,1),IU3I(1,2,1),IU3I(2,2,1),IU3I(1,3,1),
1 IU3I(2,3,1),IU3I(1,1,2),IU3I(2,1,2) /
2 2H( ,2H D,2H16,2H.9,2H, ,1HD,2H9.,2H2) /
DATA IT3I(1,1,1),IT3I(2,1,1),IT3I(3,1,1),IT3I(4,1,1),IT3I(1,2,1),
1 IT3I(2,2,1),IT3I(3,2,1),IT3I(4,2,1),IT3I(1,1,2),IT3I(2,1,2),
2 IT3I(3,1,2),IT3I(4,1,2),IT3I(1,2,2) /2H(2,2HX,,2HI5,2H,1,
3 2HX,,2HI4,2H,I,2H4,,2H1X,2H,I,2H2,,2HI3,1H) /
DATA ZT1S(1),ZT1S(2),ZT1S(3),ZT1S(4)/2H(E,2H11,2H.2,1H) /
DATA ZU3S(1,1,1),ZU3S(2,1,1),ZU3S(3,1,1),ZU3S(1,2,1),ZU3S(2,2,1),
1 ZU3S(3,2,1) / 2H(4,2H(E,2H14,2H.6,2H/),1H) /
DATA ZU2S(1,1),ZU2S(2,1),ZU2S(3,1),ZU2S(4,1),ZU2S(1,2),ZU2S(2,2),
2 ZU2S(3,2) / 2H(L,2H3,,2H2(,2HL2,2H),,2HL3,1H) /
C*****
C***** END OF SPECIFICATIONS FOR SEGMENTS 300, 301, 302, 310, 312
C***********************************************************************
C*****
C***** LOGIF - (300)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST LOGICAL IF STATEMENT 7.1.2.3
C***** GENERAL COMMENT
C***** ASSIGNED GO TO,INTRINSIC FUNCTION,ARITHMETIC IF,CALL,
C***** COMPUTED GO TO AND I/O STATEMENTS ASSUMED WORKING.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 300
C*****
C***** WHEN EXECUTING ONLY SEGMENT 300, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS, WHICH APPEAR
C***** AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= LOGICAL MCAVB,MCBVB,MCA1B(7)
C= DOUBLE PRECISION DPAVD, DPBVD,DPCVD,DPDVD,DPEVD,DPFVD
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS.
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 13///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
WRITE (NUVI,3000)
3000 FORMAT (1H1, 1X,34HLOGIF - (300) LOGICAL IF STATEMENT//
120H ASA REF. - 7.1.2.3//10H RESULTS //
2/37H TEST EXPLICITLY WRITTEN SIGNED ZERO/2X)
C***** HEADER FOR SEGMENT 300 WRITTEN
MACVI = 0
MCAVB = .TRUE.
MCBVB = .FALSE.
MCA1B(1) = .TRUE.
MCA1B(2) = .FALSE.
C***** TEST THAT MINUS ZERO AND PLUS ZERO ARE TREATED 4.2/11
C***** AS EQUAL VALUES
IVI = -8
IIVI = -8
JVI = +0
JJVI = -0
KVI = 8
KKVI = 8
AVS = -0.5
AAVS = -0.5
BVS = +0.0
BBVS = -0.0
CVS = 0.5
CCVS = 0.5
DPAVD = -0.5D0
DPBVD = -0.5D0
DPCVD = +0.0D0
DPDVD = -0.0D0
DPEVD = 0.5D0
DPFVD = 0.5D0
C***** TEST FOR EXPLICITLY WRITTEN -0 EQUAL TO +0
IF((JVI) .EQ. (JJVI))MACVI = MACVI + 1
IF((JJVI) .EQ. (JVI)) MACVI = MACVI + 1
IF((+0) .EQ. (-0)) MACVI = MACVI + 1
IF((-0) .EQ. (+0)) MACVI = MACVI + 1
IF (MACVI - 4) 9951, 9954, 9951
9951 WRITE (NUVI, 9953)
GO TO 9955
9952 FORMAT(14H +0 EQUALS -0)
9953 FORMAT(17H +0 NOT EQUAL -0)
9954 WRITE (NUVI, 9952)
9955 MACVI = 0
C***** TEST EXPLICITLY WRITTEN +0.0 EQUALS -0.0
IF ((BVS) .EQ. (BBVS)) MACVI = MACVI + 1
IF ((BBVS) .EQ. (BVS)) MACVI = MACVI + 1
IF ((+0.0) .EQ. (-0.0)) MACVI = MACVI + 1
IF ((-0.0) .EQ. ( 0.0)) MACVI = MACVI + 1
IF (MACVI - 4) 9944, 9947, 9944
9944 WRITE (NUVI, 9946)
GO TO 9948
9945 FORMAT (18H +0.0 EQUALS -0.0)
9946 FORMAT (21H +0.0 NOT EQUAL -0.0)
9947 WRITE (NUVI, 9945)
C***** TEST EXPLICITLY WRITTEN +0.0D0 EQUALS -0.0D0
9948 MACVI = 0
IF ((DPCVD) .EQ. (DPDVD)) MACVI = MACVI +1
IF ((DPDVD).EQ. (DPCVD)) MACVI = MACVI + 1
C*****
IF ((+0.0D0) .EQ. (-0.0D0)) MACVI = MACVI + 1
IF ((-0.0D0) .EQ. (0.0D0)) MACVI = MACVI + 1
IF (MACVI - 4) 9949, 9957, 9949
9949 WRITE (NUVI, 9960)
GO TO 9958
9959 FORMAT (22H +0.0D0 EQUALS -0.0D0)
9960 FORMAT (25H +0.0D0 NOT EQUAL -0.0D0)
9957 WRITE (NUVI, 9959)
9958 MACVI = 0
WRITE (NUVI, 7950)
7950 FORMAT (33H0 TEST COMPUTATIONAL SIGN OF ZERO/2X)
C***** TEST FOR COMPUTATIONALLY CREATED +0 AND -0
IF((IVI * JVI) .EQ. (JVI))MACVI = MACVI + 1
IF((JVI) .EQ. (JVI * IIVI))MACVI = MACVI + 1
IF((JVI / IVI) .EQ. (+0) )MACVI = MACVI + 1
IF((IVI + KVI) .EQ. (JVI))MACVI = MACVI + 1
IF((KKVI + IIVI) .EQ. (JVI))MACVI = MACVI + 1
IF((IIVI - IVI) .EQ. (JVI))MACVI = MACVI + 1
IF((KVI - KKVI) .EQ. (JVI))MACVI = MACVI + 1
IF (MACVI - 7) 9956, 9940, 9956
9956 WRITE (NUVI,9953)
GO TO 7955
9940 WRITE (NUVI,9952)
C***** TEST FOR COMPUTATIONALLY CREATED +0.0 AND -0.0
7955 MACVI = 0
IF ((AVS * BVS) .EQ. (BVS)) MACVI = MACVI + 1
IF ((BVS) .EQ. (BVS * AAVS)) MACVI = MACVI + 1
IF ((BVS / AVS) .EQ. ( 0.0)) MACVI = MACVI + 1
IF ((AVS + CVS) .EQ. (BVS)) MACVI = MACVI + 1
IF ((CCVS + AAVS) .EQ. (BVS)) MACVI = MACVI + 1
IF ((AAVS - AVS) .EQ. (BVS)) MACVI = MACVI + 1
IF ((CVS - CCVS) .EQ. (BVS)) MACVI = MACVI + 1
IF (MACVI - 7) 7951, 7952, 7951
7951 WRITE (NUVI, 9946)
GO TO 7953
7952 WRITE (NUVI, 9945)
C***** TEST FOR COMPUTATIONALLY CREATED +0.0D0 AND -0.0D0
7953 MACVI = 0
IF ((DPAVD * DPCVD) .EQ. (DPCVD)) MACVI = MACVI + 1
IF ((DPCVD) .EQ. (DPCVD * DPBVD)) MACVI = MACVI + 1
IF ((DPCVD / DPAVD) .EQ. (0.0D0)) MACVI = MACVI + 1
IF ((DPAVD + DPEVD) .EQ. (DPCVD)) MACVI = MACVI + 1
IF ((DPFVD + DPBVD) .EQ. (DPCVD)) MACVI = MACVI + 1
IF ((DPBVD - DPAVD) .EQ. (DPCVD)) MACVI = MACVI + 1
IF ((DPEVD - DPFVD) .EQ. (DPCVD)) MACVI = MACVI + 1
IF (MACVI - 7) 7954, 9939, 7954
7954 WRITE (NUVI, 9960)
GO TO 9941
9939 WRITE (NUVI, 9959)
9941 MCAVI = 0
WRITE (NUVI, 9942)
9942 FORMAT(31H0 TEST -LOGICAL IF- FOLLOWED BY/
131H DIFFERENT KINDS OF STATEMENTS )
C***** TEST 1
C***** LOGICAL IF FOLLOWED BY SIMPLE ASSIGNMENT STATEMENT
C***** CORRECT RESULT = 0, OTHERWISE RESULT = 1
IF (MCA1B(2)) MCAVI = 1
WRITE (NUVI,3009) MCAVI
C***** TEST 2
C***** LOGICAL IF FOLLOWED BY USE OF INTRINSIC FUNCTION
C***** CORRECT RESULT =0, OTHERWISE RESULT =2
MCAVI = 2
IF (MCAVB) MCAVI = IFIX(5.0 - 4.0 - 1.0)
WRITE (NUVI,3009) MCAVI
MCAVI = 0
C***** TEST 3
C***** LOGICAL IF FOLLOWED BY ARITHMETIC STATEMENT
C***** CORRECT RESULT =0, OTHERWISE RESULT =3
IF (MCAVB .AND. MCBVB) MCAVI = 3* 2 / 2
WRITE (NUVI,3009) MCAVI
C***** TEST 4
C***** LOGICAL IF FOLLOWED BY GO TO STATEMENT
C***** CORRECT RESULT =0, OTHERWISE RESULT =4
MCAVI = 0
IF (MCAVB .AND. MCBVB .OR. MCA1B(1)) GO TO 3001
MCAVI = 4
3001 WRITE (NUVI,3009) MCAVI
C***** TEST 5
C***** LOGICAL IF FOLLOWED BY CALL STATEMENT
C***** CORRECT RESULT =0, OTHERWISE RESULT =5
MCAVI =0
IF (MCBVB .OR. (1 .GE. 2) .AND..FALSE.) CALL SMCQ(MCAVI)
WRITE (NUVI,3009) MCAVI
C***** TEST 6
C***** LOGICAL IF FOLLOWED BY NESTED USE OF INTRINSIC FUNCTIONS
C***** CORRECT RESULT =0, OTHERWISE RESULT =6
MCAVI = 6
IF (.TRUE. .OR. ((1. .LE. (0.1 + 1.5)) .AND. (MCA1B(1) .OR. .TRUE
1.)) .AND. MCBVB) MCAVI = IFIX(REAL((0.0,1.0)))
WRITE (NUVI,3009) MCAVI
C***** TEST 7
C***** LOGICAL IF FOLLOWED BY ASSIGNED GO TO STATEMENT
C***** CORRECT RESULT =0, OTHERWISE RESULT =7
ASSIGN 3002 TO MCBVI
MCAVI = 7
IF (.NOT. (MCAVB .AND. MCBVB .AND. .FALSE. .OR. (.NOT. .TRUE.)))
1GO TO MCBVI,(3001,3002,3003)
GO TO 3003
3002 MCAVI = 0
3003 WRITE (NUVI,3009) MCAVI
C***** TEST 8
C***** LOGICAL IF FOLLOWED BY ARITHMETIC IF STATEMENT
C***** CORRECT RESULT =0, OTHERWISE RESULT =8
MCAVI = 0
IF (.NOT. (.NOT.(.TRUE. .OR. MCAVB .AND. (8. .NE. 7.))))
1IF (MCAVI) 3004,3005,3004
3004 MCAVI = 8
3005 WRITE (NUVI,3009) MCAVI
C***** TEST 9
C***** LOGICAL IF FOLLOWED BY I/O STATEMENT
C***** CORRECT RESULT =0, OTHERWISE RESULT =9
MCAVI = 0
IF ((8.0D0 .EQ. (1. + 7.)) .AND. (.NOT. (3 .NE. 3)))
1WRITE (NUVI,3009) MCAVI
C***** TEST 10
C***** LOGICAL IF FOLLOWED BY COMPUTED GO TO STATEMENT
C***** CORRECT RESULT =0, OTHERWISE RESULT =10
MCAVI = 2
IF ( .TRUE. .AND. (8 .GE. 6) .OR. (.FALSE.)) GO TO (9950,3006),
1MCAVI
9950 MCAVI = 10
GO TO 3007
3006 MCAVI = 0
3007 WRITE (NUVI,3009) MCAVI
WRITE (NUVI,3008)
C***** TEST EXPRESSIONS IN LOGICAL IF STATEMENTS
C***** TEST 11 .LT. EXPRESSION, RELATION, EXPRESSION (TRUE)
MCAVI = 11
IF((SNGL(DABS(-DSIGN(DBLE(2.0),1.0D0)))).LT.AMIN1((FLOAT(IDIM
1 (1 + 2, 0))), (AIMAG(CMPLX(1.0,2.0)))) + 1.0) MCAVI = 0
WRITE (NUVI, 3009) MCAVI
C***** TEST 12 .LT. EXPRESSION, RELATION, CONSTANT (TRUE)
MACVI = 12
IF((AMIN1(FLOAT(IDIM(4 - 1,0)) , AIMAG(CMPLX(1.0,2.0)))).LT. 4.0)
1MACVI = 0
WRITE (NUVI, 3009) MACVI
C***** TEST 13 .LT. CONSTANT(D.P.),RELATION, EXPRESSION (REAL)(TRUE)
MACVI = 13
C*****IF (1.(D0).LT. (SNGL(DABS(DSIGN(DBLE(4.0),1.0D0))))) MACVI = 0
C*****WRITE (NUVI, 3009) MACVI
C***** TEST 14 .LE. .AND. .LE. (SHOULD BE LESS AND EQUAL) (TRUE)
MACVI = 14
IF((REAL(CONJG((1.0,-2.0))) + AIMAG((16.0,-4.0)) .LE.
1 AIMAG(CONJG((1.0,-2.0))) + REAL((-4.0,16.0)) + 1.0) .AND.
2 (AIMAG(CONJG((2.0,-4.0))) + REAL((-8.0,16.0)).LE.
3 REAL(CONJG((4.0,-2.0))) + AIMAG((16.0,-8.0))))MACVI = 0
WRITE (NUVI, 3009) MACVI
C***** TEST I5 .LE. (FALSE)
MACVI = 0
IF (MAX1((AMAX0(4,2,-(1 * 4))),16.0) .LE. 2 ** 3)MACVI = 15
WRITE (NUVI, 3009) MACVI
C***** TEST 16 .NE. .AND. .EQ. (TRUE)
MACVI = 16
IF(((AINT(AINT(AINT(1.4 + 2.9)+1.6)-8.1)).NE.(-8.0)).AND.(-1.0.EQ.
1AINT(AINT(AINT(2.6 + 4.8) + 1.4)-9.2)))MACVI = 0
WRITE (NUVI, 3009) MACVI
C***** TEST 17 .GT. (TRUE)
MACVI = 17
IF((FLOAT(IABS(IFIX(ABS(-5.0+ SIGN(-1.0,2.0)))))) .GT. 2.0D0)
1MACVI = 0
WRITE (NUVI, 3009) MACVI
C***** TEST 18 .GE. EQUAL (TRUE)
MACVI = 18
IF((8.0).GE.(FLOAT(IABS(IFIX(ABS(-4.0+SIGN(4.0,-2.0)))))))MACVI=0
WRITE (NUVI, 3009) MACVI
C***** TEST 19 .GE. GREATER (TRUE)
MACVI = 19
IF((MACVI).GE.(IABS(IFIX(ABS(-4.0 + SIGN(8.0,-4.0))))))MACVI = 0
WRITE (NUVI, 3009) MACVI
C***** TEST 20 .GT. (FALSE) .OR. .EQ. (TRUE)
MACVI = 20
IF((-MACVI) .GT. (MAX1 (AMAX0(8,-(2*4),4) ,16.0)).OR. .NOT.(IABS
1 (-20) .NE. MACVI))MACVI = 0
WRITE (NUVI, 3009) MACVI
WRITE (NUVI, 9943)
9943 FORMAT(28H0 ALL VALUES SHOULD BE ZERO./
137H A VALUE OTHER THAN ZERO WILL BE THE /
234H NUMBER OF THE TEST WHICH FAILED. )
3008 FORMAT(34H0 THERE SHOULD BE 10 VALUES ABOVE, /
131H IF ONLY 9, TEST 9 HAS FAILED.)
3009 FORMAT(12X, I10)
C***** END OF TEST SEGMENT 300
C***** WHEN EXECUTING ONLY SEGMENT 300, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** BARIF - (301)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST BASIC FORTRAN ARITHMETIC IF STATEMENT 7.1.2.2
C***** GENERAL COMMENTS
C***** BASIC INTRINSIC FUNCTIONS ASSUMED WORKING
C*****
C***** S P E C I F I C A T I O N S SEGMENT 301
C*****
C***** WHEN EXECUTING ONLY SEGMENT 301, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= DIMENSION L1I(10)
C= DIMENSION MCA1I(5),CMA1S(5)
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 301, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,3010)
3010 FORMAT (1H1,1X,27HBARIF - (301) BASIC FORTRAN/15X, 24H
1 ARITHMETIC IF STATEMENT/2X,18HASA REF. - 7.1.2.2/2X,7HRESULTS)
C***** HEADER FOR SEGMENT 301 WRITTEN
MCA1I(1) = 5
MCAVI = 0
MCBVI = 21
JACVI = -0
CMA1S(1) = 10.5
CMAVS = -0.0
CMBVS = -15.E0
C***** TEST FOR SIGN OF ZERO - TYPE INTEGER 4.2/11
DO 8335 IVI = 1,9
8335 L1I(IVI) = 0
MVI = 1
KVI = 0
JVI = -0
BVS = -0.0
NVI = 1
WRITE (NUVI, 8300)
IF (-0) 8311, 8314, 8317
8320 IF (0) 8312, 8315, 8318
8321 IF (+0) 8313, 8316, 8319
8322 NVI = 10
IF (JVI + (-0)) 8311, 8314, 8317
8323 IF (-IABS(JVI)) 8312, 8315, 8318
8324 IF (-JVI + (+0)) 8313, 8316, 8319
8325 WRITE (NUVI, 8303)(L1I(IVI), IVI = 1,9)
C***** TEST FOR SIGN OF ZERO - TYPE REAL
MVI = 2
KVI = 0
NVI = 1
DO 8336 IVI = 1,9
8336 L1I(IVI) = 0
WRITE (NUVI, 8304)
IF (-0.0) 8311, 8314, 8317
8326 IF (0.0) 8312, 8315, 8318
8327 IF (+0.0) 8313, 8316, 8319
8328 NVI = 10
IF (BVS +(-0.0)) 8311, 8314, 8317
8329 IF (-ABS(BVS)) 8312, 8315, 8318
8330 IF (-BVS + (+0.0)) 8313, 8316, 8319
8331 WRITE (NUVI, 8303) (L1I(IVI), IVI = 1,9)
WRITE (NUVI, 8337)
GO TO 8305
C***** SWITCH FOR INTEGER AND REAL TESTS
8332 KVI = KVI + 1
GO TO (8333, 8334) , MVI
C***** RETURNS FOR TEST SIGN OF INTEGER ZERO
8333 GO TO (8320, 8321, 8322, 8323, 8324, 8325), KVI
C***** RETURNS FOR TEST SIGN OF REAL ZERO
8334 GO TO (8326, 8327, 8328, 8329, 8330, 8331), KVI
C***** TALLY RESULTS OF CONTROL TRANSFERS
8311 L1I(1) = L1I(1) + NVI
GO TO 8332
8312 L1I(2) = L1I(2) + NVI
GO TO 8332
8313 L1I(3) = L1I(3) + NVI
GO TO 8332
8314 L1I(4) = L1I(4) + NVI
GO TO 8332
8315 L1I(5) = L1I(5) + NVI
GO TO 8332
8316 L1I(6) = L1I(6) + NVI
GO TO 8332
8317 L1I(7) = L1I(7) + NVI
GO TO 8332
8318 L1I(8) = L1I(8) + NVI
GO TO 8332
8319 L1I(9) = L1I(9) + NVI
GO TO 8332
8300 FORMAT(/ 38H TEST FOR SIGN OF ZERO - TYPE INTEGER// 29H PATH * F
1ORM OF EXPRESSION */ 29H OF IF * -0 * 0 * +0 * )
8303 FORMAT( 1H ,7(4H****)/ 1H ,4(6X,1H*)/ 8H NEG. *,3(I4,3H *)/1H ,4
1(6X,1H*)/8H ZERO *,3(I4,3H *)/1H ,4(6X,1H*)/8H POS. *,3(I4,
23H *)/1H , 4(6X,1H*)/1H )
8304 FORMAT(//35H TEST FOR SIGN OF ZERO - TYPE REAL // 29H PATH * FO
1RM OF EXPRESSION */ 29H OF IF * -0.0 * 0.0 * +0.0 * )
8337 FORMAT(/34H ALL ENTRIES SHOULD BE 0 EXCEPT /36H THE ZERO PATH,
1 WHICH SHOULD BE 11 /33H IN EACH COLUMN. OTHER TESTS MAY / 31H
2 FAIL IF THESE RESULTS DIFFER.///37H TEST EXPRESSIONS IN IF ST
3ATEMENTS /1H )
C***** ARITHMETIC IF WITH EXPRESSIONS OF TYPE INTEGER
C***** TEST 1 - SHOULD TAKE ZERO BRANCH
8305 IF (MCA1I(1) - 5) 9981,3011,9981
C***** TEST 2 - SHOULD TAKE ZERO BRANCH
3011 IF (MCA1I(1) + 5 - IFIX(CMA1S(1))) 9982,3012,9982
C***** TEST 3 - SHOULD TAKE MINUS BRANCH
3012 IF ((MCBVI * 2 / 7) - IABS(IFIX(10.5 - 10.4)) - 7) 3013,9983,9983
C***** TEST 4 - SHOULD TAKE PLUS BRANCH
3013 IF ((MCA1I(1) - 4) ** 99 /(MCBVI - 4 * MCA1I(1))) 9984,9984,3014
C***** ARITHMETIC IF WITH EXPRESSION OF TYPE REAL
C***** TEST 5 - SHOULD TAKE ZERO BRANCH
3014 IF (CMA1S(1) - 10.5) 9985,3015,9985
C***** TEST 6 - SHOULD TAKE MINUS BRANCH
3015 IF (CMA1S(1) * 2.0 -(FLOAT(MCBVI) **1) - 1.0) 3016,9986,9986
C***** TEST 7 - SHOULD TAKE PLUS BRANCH
3016 IF (CMBVS * (-2.0) ** (MCBVI - 4 * MCA1I(1)) - 29.0)9987,9987,3017
C***** TEST 8 - SHOULD TAKE ZERO BRANCH
3017 IF (MCAVI) 9988,3018,9980
3018 WRITE (NUVI,3019)
GO TO 9980
3019 FORMAT ( 18H TESTS SUCCESSFUL )
9981 MCAVI = 1
IF (IABS(MCA1I(1) - 5)) 8301,8302,8301
8301 WRITE (NUVI,9989) MCAVI
GO TO 3011
8302 WRITE (NUVI,8306) MCAVI
8306 FORMAT (//2X,14HERROR IN TEST ,I2,23H BECAUSE MINUS ZERO WAS/
1 30H TREATED AS A NEGATIVE NUMBER)
GO TO 3011
9982 MCAVI = 2
IF (IABS(MCA1I(1) + 5 - IFIX(CMA1S(1)))) 8307,8308,8307
8307 WRITE (NUVI,9989) MCAVI
GO TO 3012
8308 WRITE (NUVI,8306) MCAVI
GO TO 3012
9983 MCAVI = 3
WRITE (NUVI,9989) MCAVI
GO TO 3013
9984 MCAVI = 4
WRITE (NUVI,9989) MCAVI
GO TO 3014
9985 MCAVI = 5
IF (ABS(CMA1S(1) - 10.5)) 8309,8310,8309
8309 WRITE (NUVI,9989) MCAVI
GO TO 3015
8310 WRITE (NUVI,8306) MCAVI
GO TO 3015
9986 MCAVI = 6
WRITE (NUVI,9989) MCAVI
GO TO 3016
9987 MCAVI = 7
WRITE (NUVI,9989) MCAVI
GO TO 3017
9988 MCAVI = 8
WRITE (NUVI,9989) MCAVI
9989 FORMAT ( 6H TEST,I2,7H FAILED)
9980 CONTINUE
C***** END OF TEST SEGMENT 301
C***** WHEN EXECUTING ONLY SEGMENT 301, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** FARIF - (302)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TEST OF FULL FORTRAN ARITHMETIC IF STATEMENT 7.1.2.2
C***** GENERAL COMMENTS
C***** INTRINSIC FUNCTIONS ASSUMED WORKING
C*****
C***** S P E C I F I C A T I O N S SEGMENT 302
C*****
C***** WHEN EXECUTING ONLY SEGMENT 302, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION MCA1I(5),AC2S(5,6)
C= DOUBLE PRECISION MCAVD,MCBVD
C= COMPLEX CHAVC
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 302, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,3020)
3020 FORMAT (1H1,1X,26HFARIF - (302) FULL FORTRAN/ 16X,24HARITHMETIC I
1F STATEMENTS/
220H ASA REF. - 7.1.2.2/2X,7HRESULTS)
C***** HEADER FOR SEGMENT 302 WRITTEN
MCA1I(1) = 5
MCAVI = 0
AC2S(1,1) = 10.5
MCAVD = -15.0D0
CHAVC = (1.0,2.0)
MCBVD = -0.0D0
C***** ARITHMETIC IF WITH EXPRESSION OF TYPE DOUBLE PRECISION
C***** TEST THAT MINUS ZERO IS TREATED AS ZERO 4.2/11
IF (MCBVD) 9301,9303,9301
9301 WRITE (NUVI,9302)
9302 FORMAT (//2X,37HERROR, MINUS ZERO TREATED AS NEGATIVE/
1 36H NUMBER - OTHER TESTS MAY FAIL AS A/
2 8H RESULT)
MCAVI = 0
C***** TEST 1 - SHOULD TAKE ZERO BRANCH
9303 IF (MCAVD + 15.0D0) 3028,3021,3028
C***** TEST 2 - SHOULD TAKE MINUS BRANCH
3021 IF (MCAVD / DBLE(FLOAT(MCA1I(1))) * 2.D0) 3022,3029,3029
C***** TEST 3 - SHOULD TAKE MINUS BRANCH
3022 IF (MCAVD/(-15.0D0) + 6.0D0 - 2.0D0 ** 3) 3023,9971,9971
C***** TEST 4 - SHOULD TAKE PLUS BRANCH
3023 IF (DSIGN(1.0D0,DBLE(REAL(CHAVC)))) 9972,9972,3024
C***** TEST 5 - SHOULD TAKE ZERO BRANCH
3024 IF (2.0D0 ** 2 - 4.0D0/ 1.0D0) 9973, 3025, 9973
3025 IF (MCAVI) 9974,3026,9970
3026 WRITE (NUVI,3027)
GO TO 9970
3027 FORMAT (//34H SEGMENT 302 TESTED SUCCESSFULLY.)
3028 MCAVI = 1
IF (DABS(MCAVD + 15.0D0))9304,9305,9304
9304 WRITE (NUVI,9975) MCAVI
GO TO 3021
9305 WRITE (NUVI,9306) MCAVI
9306 FORMAT (//2X,14HERROR IN TEST ,I2,23H BECAUSE MINUS ZERO WAS/
1 30H TREATED AS A NEGATIVE NUMBER)
GO TO 3021
3029 MCAVI = 2
WRITE (NUVI,9975) MCAVI
GO TO 3022
9971 MCAVI = 3
WRITE (NUVI,9975) MCAVI
GO TO 3023
9972 MCAVI = 4
WRITE (NUVI,9975) MCAVI
GO TO 3024
9973 MCAVI = 5
IF (DABS(2.0D0 ** 2 - 4.0D0 / 1.0D0)) 9307, 9308, 9307
9307 WRITE (NUVI,9975) MCAVI
GO TO 3025
9308 WRITE (NUVI,9306) MCAVI
GO TO 3025
9974 MCAVI = 6
WRITE (NUVI,9975) MCAVI
9975 FORMAT (//6H TEST,I3,8H FAILED.)
9970 CONTINUE
C***** END OF TEST SEGMENT 302
C***** WHEN EXECUTING ONLY SEGMENT 302, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** IOFMT - (310)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** TO TEST ADDITIONAL FEATURES OF FORMATTED READ 7.1.3.2.2
C***** AND WRITE STATEMENTS AND FORMAT STATEMENTS 7.1.3.2.3
C***** RESTRICTIONS OBSERVED
C***** * ALL FORMAT STATEMENTS ARE LABELED 7.2.3 /57
C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 7.2.3.3/54
C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND 7.2.3.1/31
C***** W IS EQUAL TO OR GREATER THAN D 7.2.3.1/33
C***** * FIELD WIDTH IS NEVER ZERO 7.2.3 /18
C***** * IF THERE IS AN I/O LIST, THE FORMAT STATEMENT 7.2.3.4/22
C***** CONTAINS AT LEAST ONE FIELD DESCRIPTOR (OTHER
C***** THAN H OR X)
C***** * ITEMS IN I/O LIST CORRESPOND TO FORMAT DESCRIPTORS 7.2.3.4/36
C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 7.2.3.6/56
C***** * FIELD WIDTH NEVER EXCEEDED BY OUTPUT 7.2.3.6/01
C***** * FOR I CONVERSION, EXTERNAL INPUT FIELDS ARE 7.2.3.6.1/07
C***** INTEGER CONSTANTS
C INPUT DATA TO THIS SEGMENT CONSISTS OF 38 CARD IMAGES IN COL. 1 - 80
C COLS. 22 25 31 34-35 40-43 55 67 69 74-76
CARD 1 . . . 0. E+00 + + . E00
C COLS. 16 31 33 42-45 50 59-60
CARD 2 + + . D+00 . D0
C COLS. 1-----------14 18-----26 28-------38 42-------------58
CARD 3 1.23456987654. +1.234E-0 -98.7654E+0 + 2345.67891011+2
C COLS. 69-----78
CARD 3 -.109876-4
C COLS 1---5
CARDS 4,5,6,7,8 12345
C COLS. 1-3
CARDS 9,10,11,12 1.1
C COLS. 1------------------------------------------------------58
CARD 13 +0.339567E+02
CARD 14 + .339567+2
CARD 15 + 3.395670E1
CARD 16 0.96295134244D+04
CARD 17 .96295134244D04
CARD 18 0.96295134244+4
CARD 19 0.96295134244D+04
CARD 20 31.23+0.14E+04+0.2D+02
CARD 21 31.23 .14E+04 +.2+2
CARD 22 -0.13579E+054444
CARD 23 4444
CARD 24 4444
CARD 25 4444
CARD 26 4444
CARD 27 -333 5.555+0.4545E-04
CARD 28 -6.666 .9989E+12
CARD 29 7.77-0.747E-02 +0.549E022
CARD 30 +0.662E-00 0.468-1011
CARD 31 0.59542D+04-44.6666-0.1234567890D-03
CARD 32 54.9327-0.1395624534D+00
CARD 33 65432.1
CARD 34 +0.848E+03 .848E3 + .1290D7+0.129D+07 0.412D21
CARD 35 22222222222222222222222222222222222222222222222222
CARD 36 -.987E0-0.987E+00 +0.6D0 + 0.6D+00 .368D-5
CARD 37 5 5 5 5
CARD 38 987654 8647.86 987.654
CARD COLS. NOT MENTIONED ARE BLANK
C*****
C***** READ AND WRITE STATEMENTS FOR ENTIRE SEGMENT FOLLOW
C*****
C***** TEST THAT COMPLETELY BLANK FIELDS IN THE INPUT 7.2.3.6/45
C***** ARE TREATED AS ZEROS. (ALL VARIABLES AND ARRAY
C***** ELEMENTS USED IN THIS TEST ARE FIRST SET TO
C***** NON-ZERO VALUES. I, E, F AND D DESCRIPTORS
C***** APPEAR IN THE CORRESPONDING FORMAT STATEMENT
C*****
C***** S P E C I F I C A T I O N S SEGMENT 310
C*****
C***** WHEN EXECUTING ONLY SEGMENT 310, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3),EP1S(33)
C= DIMENSION IAC1I(5),IAC2I(2,7),AC1S(25),AC2S(5,6)
C= INTEGER MCA3I(2,3,3)
C= REAL MVS
C= DOUBLE PRECISION MCAVD,MCBVD,MCCVD,A1D(4),A2D(2,2),A3D(2,2,2)
C= DOUBLE PRECISION DPAVD,DPBVD,DPCVD,DPDVD,DPEVD,DPFVD,DPHVD,AAAVD
C*****
C***** I N P U T - O U T P U T TAPE ASSIGNMENT STATEMENTS
C*****
C***** WHEN EXECUTING ONLY SEGMENT 310, THE FOLLOWING STATEMENTS
C***** NUVI = 6 , IRVI = 5 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C= NUVI = 6
C= IRVI = 5
C*****
C***** HEADER FORMAT STATEMENT
3100 FORMAT (1H1,1X,38HIOFMT - (310) ADDITIONAL FORMATTED I/O
1 //2X,38HASA REFS - 7.1.3.2.2 7.1.3.2.3 7.2.3//2X,7HRESULTS)
WRITE (NUVI,3100)
JACVI = 11111
IAC1I(1) = -2345
IAC2I(1,1) = 99999
MCA3I(1,1,1) = 2
ACVS = 1.2
BCVS = -.34E-3
A1S(1) = 34.56
A1S(2) = 456.789E+02
A2S(1,1) = -7899.3
A2S(2,1) = +9876.543E-01
A3S(1,1,1) = .543
A3S(2,1,1) = 4.33E+1
AAAVD = +2.22D+01
A1D(1) = -.33456D-01
A2D(1,1) = 9987.76D+2
A3D(1,1,1) = 44.D-2
C***** FORMATS TO TEST THAT BLANK INPUT FIELDS ARE 7.2.3.6/45
C***** TREATED AS ZEROS. I, E, F AND D FIELDS ARE TESTED
C***** CARDS 1 AND 2
3101 FORMAT (4(I5), 4(F3.1), 4(E11.4)/ 4(D15.8))
READ (IRVI,3101) JACVI, IAC1I(1), IAC2I(1,1), MCA3I(1,1,1), ACVS,
1 A1S(1), A2S(1,1), A3S(1,1,1), BCVS, A1S(2), A2S(2,1),
2 A3S(2,1,1), AAAVD, A1D(1), A2D(1,1), A3D(1,1,1)
3102 FORMAT ( /2X,16HTEST BLANK INPUT/2X,26HEACH ANSWER SHOULD BE ZERO,
1 4(/I6) / 4(/F8.1) / 4(/E12.1) / 4(/D12.1))
WRITE (NUVI,3102) JACVI, IAC1I(1), IAC2I(1,1), MCA3I(1,1,1), ACVS,
1 A1S(1), A2S(1,1), A3S(1,1,1), BCVS, A1S(2), A2S(2,1),
2 A3S(2,1,1), AAAVD, A1D(1), A2D(1,1), A3D(1,1,1)
C***** TEST THAT DECIMAL POINTS APPEARING IN INPUT FIELDS 7.2.3.6/47
C***** OVERRIDE THE SPECIFICATIONS SUPPLIED BY E, F AND
C***** D FIELD DESCRIPTORS
3103 FORMAT (/34H TEST DEC. PT. SPECIFIED BY INPUT/ 36H 3 LINES IN EA
1CH GROUP SHOULD MATCH / 26H * LINE IS HOLLERITH DATA )
WRITE (NUVI,3103)
CMAVS = 1.23456
CMBVS = 987654.
CMEVS = 0.1234E+01
CMFVS = -0.987654E+02
DPAVD = 0.234567891011D+06
DPBVD = -0.109876D-04
C***** CARD 3
3104 FORMAT (2(F7.3), 2(E12.5), 2(D20.11))
READ (IRVI,3104) ACVS, BCVS, FFCVS, GGCVS, MCAVD, MCBVD
3105 FORMAT (/12H * 1.23456,2(/F12.5)//13H * 987654.0,2(/F13.1) /
1 /15H * 0.1234E+01,2(/E15.4)//17H * -0.987654E+02,2(/E17.6) /
2 /23H * 0.234567891011D+06, 2(/D23.12)//17H * -0.109876D-04,
3 2(/D17.6) )
WRITE (NUVI,3105) CMAVS, ACVS, CMBVS, BCVS, CMEVS, FFCVS, CMFVS,
1 GGCVS, DPAVD, MCAVD, DPBVD, MCBVD
C***** TEST SIMPLE REPETITION OF FORMAT DESCRIPTORS 7.2.3.4/
C***** WHEN ADDITIONAL ITEMS REMAIN IN AN I/O LIST 7.1.3.2.1/
C***** AND THE LAST RIGHT PARENTHESIS HAS BEEN REACHED
C***** IN THE CORRESPONDING FORMAT STATEMENT
3106 FORMAT ( 35H1 TEST FORMAT DESCRIPTOR REPETITION/ 32H ALL LINES
1IN EACH GROUP SHOULD/ 14H BE IDENTICAL)
WRITE (NUVI,3106)
JACVI = +12345
KBCVI = 3
CMAVS = 1.1
CMBVS = 1.23
CMEVS = 33.9567
CMGVS = 1.4E+03
DPAVD = 962951342.44D-5
DPBVD = 2.0D1
C***** CARDS 4, 5, 6, 7, 8
3107 FORMAT (I5)
READ (IRVI,3107) IAC1I
C***** CARDS 9, 10, 11, 12
3108 FORMAT (F3.1)
READ (IRVI,3108) A2S
C***** CARDS 13, 14, 15
9320 FORMAT (E13.6)
READ (IRVI,9320) A1S(1), HHCVS, A1S(2)
C***** CARDS 16, 17, 18, 19
9321 FORMAT (D18.11)
READ (IRVI,9321) A2D
C***** CARDS 20, 21
9322 FORMAT (I1,F4.2,E9.2,D8.1)
READ (IRVI,9322) LCCVI, DCVS, AC2S(5,6), A3D(1,2,2), MDCVI, FFCVS,
1 GGCVS, AAAVD
9323 FORMAT ( /10H * 12345)
WRITE (NUVI,9323)
9324 FORMAT (I10)
WRITE (NUVI,9324) JACVI, IAC1I
9325 FORMAT (/ 8H * 1.1)
WRITE (NUVI,9325)
9326 FORMAT (F8.1)
WRITE (NUVI,9326) CMAVS, A2S
9329 FORMAT (/17H * 0.339567E+02)
WRITE (NUVI,9329)
9330 FORMAT (E17.6)
WRITE (NUVI,9330) CMEVS, A1S(1), HHCVS, A1S(2)
9331 FORMAT (/22H * 0.96295134244D+04)
WRITE (NUVI,9331)
9332 FORMAT (D22.11)
WRITE (NUVI,9332) DPAVD, A2D
9333 FORMAT (/31H * 3 1.23 0.14E+04 0.2D+02)
WRITE (NUVI,9333)
9334 FORMAT (I6,F6.2,E10.2,D9.1)
WRITE (NUVI,9334) KBCVI, CMBVS, CMGVS, DPBVD, LCCVI, DCVS,
1 AC2S(5,6), A3D(1,2,2), MDCVI, FFCVS, GGCVS, AAAVD
C***** TEST THAT FORMAT CONTROL PASSES TO THE GROUP 7.2.3.4/03
C***** ENCLOSED BY THE LAST PRECEDING RIGHT PAREN. 7.1.3.2.1/39
C***** WHEN THE I/O LIST CONTAINS MORE ELEMENTS THAN
C***** THE NUMBER OF DESCRIPTORS IN THE FORMAT STMNT.
JACVI = +4444
KBCVI = -333
LCCVI = 22
MDCVI = 11
ACVS = 5.555
BCVS = -6.666
CCVS = +7.77
DCVS = 65432.1
CMAVS = -0.13579E+5
CMBVS = 0.4545E-04
CMCVS = 0.9989E12
CMDVS = -0.747E-2
CMEVS = +0.549E+00
CMFVS = 0.662E-0
CMGVS = 0.468E-10
DPAVD = +59.542D02
DPBVD = -0.0123456789D-2
DPCVD = -1395624534.D-10
DPDVD = +129.D4
DPEVD = 4.12D+20
DPFVD = 36.8D-7
DPHVD = 0.6D00
FFCVS = -44.6666
GGCVS = +.549327E+2
HHCVS = 848.
MVS = -.987
CMHVS = 1.23E-1
CMIVS = 646.E-2
C***** CARDS 22, 23, 24, 25, 26
9335 FORMAT ( E12.5, (I4))
READ (IRVI,9335) A1S(2), IAC1I
C***** CARDS 27, 28
9336 FORMAT (I4, (F6.3), E11.4)
READ (IRVI,9336) MRRVI, AC1S(1), EP1S(1), A3S(1,1,1), AC2S(2,2)
C***** CARDS 29, 30
9337 FORMAT (F4.2, (2(E10.3)), I2)
READ (IRVI,9337) A2S(2,2), A3S(2,1,1), EP1S(2), MCA3I(1,1,1),
1 BVS, AC2S(2,1), NECVI
C***** CARDS 31, 32
9338 FORMAT (D12.5, (F8.4, D17.10))
READ (IRVI,9338) MCAVD, EP1S(3), A1D(1), A2S(1,2), A2D(2,1)
C***** CARDS 33, 34, 35, 36
C***** THIS READ CAUSES AN INPUT DATA CARD TO BE SKIPPED
9339 FORMAT( F7.1, (/2(E10.3), 2(D10.3)), D10.3)
READ (IRVI,9339) CVS, A2S(2,1), A3S(1,2,2), A3D(1,1,1),
1 A3D(1,2,1), A2D(2,2), A3S(1,2,1), EP1S(4),
2 A1D(2), MCBVD, MCCVD
9340 FORMAT (/16H * -0.13579E+05,2(/E16.5)//9H * 4444,6(/I9))
WRITE (NUVI,9340) CMAVS, A1S(2), JACVI, IAC1I
9341 FORMAT (/ 8H * -333, 2(/I8)/ 10H1 * 5.555, 2(/F10.3) //
115H * 0.4545E-04, 2(/E15.4)// 10H * -6.666, 2(/F10.3) //
215H * 0.9989E+12, 2(/E15.4))
WRITE (NUVI,9341) KBCVI, MRRVI, ACVS, AC1S(1), CMBVS, EP1S(1),
1 BCVS, A3S(1,1,1), CMCVS, AC2S(2,2)
9342 FORMAT (/9H * 7.77 ,2(/F9.2)//14H * -0.747E-02, 2(/E14.3) //
1 14H * 0.549E+00, 2(/E14.3) //7H * 22, 2(/I7) //
2 14H * 0.662E+00, 2(/E14.3) //14H * 0.468E-10, 2(/E14.3) //
3 7H * 11, 2(/I7) )
WRITE (NUVI,9342) CCVS, A2S(2,2), CMDVS, A3S(2,1,1), CMEVS,
1 EP1S(2), LCCVI, MCA3I(1,1,1), CMFVS, BVS, CMGVS, AC2S(2,1),
2 MDCVI, NECVI
9343 FORMAT (/16H * 0.59542D+04,2(/D16.5)//12H * -44.6666,2(/F12.4)/
1/21H * -0.1234567890D-03,2(/D21.10)/12H1 * 54.9327,2(/F12.4)//
2 21H * -0.1395624534D+00,2(/D21.10) )
WRITE (NUVI,9343) DPAVD, MCAVD, FFCVS, EP1S(3), DPBVD, A1D(1),
1 GGCVS, A2S(1,2), DPCVD, A2D(2,1)
9344 FORMAT (/12H * 65432.1/ 2(F12.1/) / 14H * 0.848E+03/
1 3(E14.3/) / 14H * 0.129D+07/ 3(D14.3/) / 14H * 0.412D+21/
2 2(D14.3/) / 14H * -0.987E+00/ 3(E14.3/) / 12H * 0.6D+00/
3 3(D12.1/) / 14H * 0.368D-05, 2(/D14.3) )
WRITE (NUVI,9344) DCVS, CVS, HHCVS, A2S(2,1), A3S(1,2,2), DPDVD,
1 A3D(1,1,1), A3D(1,2,1), DPEVD, A2D(2,2),
2 MVS, A3S(1,2,1), EP1S(4), DPHVD, A1D(2), MCBVD,
3 DPFVD, MCCVD
9345 FORMAT (/14H * 0.777E+01/ (E14.3))
WRITE (NUVI,9345) CCVS, A2S(2,2)
9346 FORMAT (/ 22H * -333 0.59542D+04/I8, D14.5 )
WRITE (NUVI,9346) KBCVI, DPAVD, MRRVI, MCAVD
9347 IF (MRRVI - 5) 9348, 9349, 9348
C***** CARD 37
9348 READ (IRVI, 9336) MRRVI
GO TO 9347
C***** * ADDITIONAL SCALE FACTOR ON INPUT-OUTPUT
C***** CARD 38
9349 READ(IRVI, 9327) A1S(3), A1S(4), A1D(4)
9327 FORMAT ( 1PE10.3, -1PE10.2, D10.3)
WRITE(NUVI, 9328) A1S(3), A1S(4), A1D(4)
9328 FORMAT(//22H1 SCALE FACTOR ON READ/ 31H IN ORDER OF FORMAT OCCURR
2ENCE/28H NO EXPONENT ON INPUT DATA //
3 40H CARD 987654 8647.86 987.654/
4 40H DESC 1PE10.3 -1PE10.2 D10.3/
5 40H TO BE .988E+02 .8648E+05 .9877D+04/
6 4H IS, E12.3, E12.4, D12.4)
C***** END OF TEST SEGMENT 310
C***** WHEN EXECUTING ONLY SEGMENT 310, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** RDFMT - (312)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** TO TEST FORMATTED READ AND WRITE STATEMENTS 7.2.3.10
C***** IN WHICH THE FORMAT STATEMENT IS CONTAINED IN
C***** AN ARRAY
C***** RESTRICTIONS OBSERVED
C***** * AN H DESCRIPTOR MAY NOT BE PART OF A FORMAT 7.2.3.10/48
C***** STATEMENT IN AN ARRAY
C***** * ALL FORMAT STATEMENTS ARE LABELED 7.2.3 /57
C***** * H AND X DESCRIPTORS ARE NEVER REPEATED 7.2.3.3/54
C***** * FOR W.D DESCRIPTORS, D IS ALWAYS SPECIFIED AND 7.2.3.1/31
C***** W IS EQUAL TO OR GREATER THAN D 7.2.3.1/33
C***** * FIELD WIDTH IS NEVER ZERO 7.2.3 /18
C***** * IF THERE IS AN I/O LIST, THE FORMAT STATEMENT 7.2.3.4/22
C***** CONTAINS AT LEAST ONE FIELD DESCRIPTOR (OTHER
C***** THAN H OR X)
C***** * ITEMS IN I/O LIST CORRESPOND TO FORMAT DESCRIPTORS 7.2.3.4/36
C***** * NEGATIVE OUTPUT VALUES ARE SIGNED 7.2.3.6/56
C***** * FIELD WIDTH NEVER EXCEEDED BY OUTPUT 7.2.3.6/01
C***** * FOR I CONVERSION, EXTERNAL INPUT FIELDS ARE 7.2.3.6.1/07
C***** INTEGER CONSTANTS
C***** TEST HOLLERITH IN ARGUMENT OF A CALL
C***** ARRAY NAME IN ARGUMENT LIST USED AS FORMAT SPECIFIER
C***** SUBROUTINE FMTQ ALSO TESTS THE EMPTY FORMAT STATEMENT
C***** THE FOLLOWING DATA STATEMENTS INITIALIZE SOME 7.2.3.10/50
C***** ARRAYS WITH FORMAT STATEMENTS TO BE USED FOR
C***** READING WITH A, F AND D CONVERSION AND FOR
C***** WRITING WITH I, E AND L CONVERSION
C*****
C INPUT DATA TO THIS SEG. CONSISTS OF 13 CARD IMAGES IN COLS. 1 - 80
C COLS. 1-----------------------------------------------50
CARD 1 (I5,6X, I4, 2(I3), I2)
CARD 2 (E 9.2,3(E13.6))
CARD 3 ( L1 ,2(L2),L3)
CARD 4 (2X,A2,5(A2))
CARD 5 (2X,F5.3, F4.0, 2(F7.2))
CARD 6 (2X , D 16.9,D9.2)
CARD 7 84756 -867224+39-6
CARD 8 23498.-77.27547.18
CARD 9 -.0076+11+08.93421E-13 893.421E-15+08.93421E-13
CARD 10 -0.357901246D+00 +0.52D-2
CARD 11 TTA FF9$
CARD 12 AB
CARD 13 CDE+*=123
CARD COLS. NOT MENTIONED ARE BLANK
C*****
C***** S P E C I F I C A T I O N S SEGMENT 312
C*****
C***** WHEN EXECUTING ONLY SEGMENT 312, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION L1I(10),A3S(3,3,3),YER1S(7),IAC1I(5),AC1S(25)
C= DIMENSION ZU3S(3,2,2),ZT1S(4),ZU1S(12),ZU2S(4,2),IAC2I(2,7)
C= INTEGER AVI,IU2I(4,2),IT3I(4,2,2),IU3I(2,3,3),MCA3I(2,3,3)
C= LOGICAL AVB,BVB,CVB,GG1B(2),A1B(2)
C= DOUBLE PRECISION DPAVD,DPBVD,DPCVD,A1D(4)
C= COMPLEX CHAVC,CHBVC
C*****
C***** I N P U T - O U T P U T TAPE ASSIGNMENT STATEMENTS
C*****
C***** WHEN EXECUTING ONLY SEGMENT 312, THE FOLLOWING STATEMENTS
C***** NUVI=6 AND IRVI=5 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C= IRVI = 5
C*****
C***** THE FOLLOWING READ STATEMENTS INITIALIZE SOME 7.2.3.10/51
C***** ARRAYS WITH FORMAT STATEMENTS TO BE USED FOR
C***** READING WITH I, E AND L CONVERSIONS AND FOR
C***** WRITING WITH A, F AND D CONVERSIONS
C*****
WRITE (NUVI,3120)
C***** CARD 1
READ (IRVI,3121) AC1S(1), AC1S(2), AC1S(3), AC1S(4), AC1S(5),
1 AC1S(6),AC1S(7),AC1S(8),AC1S(9),AC1S(10),AC1S(11),AC1S(12)
C***** CARD 2
READ (IRVI,3122) L1I
C***** CARD 3
READ (IRVI,3121) A3S
C***** CARD 4
READ (IRVI,3123) YER1S
C***** CARD 5
READ (IRVI,3124) MCA3I
C***** CARD 6
READ (IRVI,3124) IAC2I
C*****
C*****
C***** THE FOLLOWING STATEMENTS MAKE USE OF THE FORMATS
C***** CONTAINED IN THE ARRAYS
C*****
C***** READ AND WRITE WITH I CONVERSION USING FORMATS IN ARRAYS
JACVI = 84756
KBCVI = -867
LCCVI = 224
MDCVI = +39
NECVI = -6
C***** CARD 7 WITH CARD 1 AS FORMAT
READ (IRVI,AC1S) AVI, MRRVI, IAC1I(1), IAC1I(2), IAC1I(3)
WRITE (NUVI,3125)
WRITE(NUVI,IT3I)JACVI, KBCVI, LCCVI, MDCVI, NECVI, AVI, MRRVI,
1 IAC1I(1), IAC1I(2), IAC1I(3)
C***** READ AND WRITE WITH F CONVERSION USING FORMATS IN ARRAYS
AVS = .234
BVS = 98.
CHAVC = (-77.27,+547.18E0)
C***** CARD 8 FORMAT IS (F3.3,F3.0,2(F6.2))
READ (IRVI,ZU1S) CVS, DVS, CHBVC
WRITE (NUVI,3127)
WRITE (NUVI,MCA3I) AVS, BVS, CHAVC
WRITE (NUVI,MCA3I) CVS, DVS, CHBVC
C***** READ AND WRITE WITH E CONVERSION USING FORMATS IN ARRAYS
AVS = -0.76E+9
BVS = +08.93421E-13
C***** CARD 9 WITH CARD 2 AS FORMAT
READ (IRVI,L1I) ZU3S(2,2,2),CVS,DVS,ZU3S(1,2,2)
WRITE (NUVI,3128)
WRITE(NUVI,ZT1S) AVS, ZU3S(2,2,2)
WRITE (NUVI,3129)
WRITE (NUVI, ZU3S) BVS,ZU3S(1,2,2),CVS, DVS
C***** READ AND WRITE WITH D CONVERSION USING FORMATS IN ARRAYS
DPAVD = -0.357901246D+00
DPBVD = +.00052D+1
C***** CARD 10 FORMAT IS (D16.9,D9.2)
READ (IRVI,IU3I) A1D(1), DPCVD
WRITE (NUVI,9930)
WRITE (NUVI,IAC2I) DPAVD,DPBVD,A1D(1),DPCVD
C***** READ AND WRITE WITH L CONVERSION USING FORMATS IN ARRAYS
AVB = .TRUE.
BVB = .FALSE.
C***** CARD 11 WITH CARD 3 AS FORMAT
READ (IRVI,A3S) A1B(1), A1B(2), CVB, GG1B(2)
WRITE (NUVI,9931)
WRITE (NUVI, ZU2S) AVB, AVB, BVB, BVB
WRITE (NUVI,ZU2S) A1B(1), A1B(2), CVB, GG1B(2)
C***** READ AND WRITE WITH A CONVERSION USING FORMATS IN ARRAYS
C***** CARDS 12 AND 13 FORMAT IS (A2/2X,5(A2))
READ (IRVI,IU2I) JACVI, AVS, IAC1I(1), GG1B, BVB
WRITE (NUVI,3126)
WRITE (NUVI,YER1S) JACVI, AVS, IAC1I(1), GG1B, BVB
C*****
CALL FMTQ (NUVI,ZT1S,0.9999,2HH0,2HLL,2HER,2HIT,2HH ,2HCO,2HNS,
1 2HTA,2HNT,2HS ,2HAS,2H C,2HAL,2HL ,2HAR,2HGU,2HME,2HNT,1HS)
C*****
C***** ADDITIONAL FORMAT STATEMENTS REQUIRED BY THIS SEGMENT
C*****
C***** THE FOLLOWING FORMAT STATEMENTS ARE USED TO 7.2.3.10/51
C***** READ FORMATS INTO ARRAYS
3121 FORMAT (27(A2))
3122 FORMAT (10(A2))
3123 FORMAT ( 7(A2))
3124 FORMAT (18(A2))
C***** THE FOLLOWING ARRAYS ARE USED TO WRITE OUT ALL 7.2.3.10/48
C***** HOLLERITH INFORMATION, SINCE H FIELD DESCRIPTORS
C***** MAY NOT BE PART OF A FORMAT WITHIN AN ARRAY
3120 FORMAT (1H1,1X,31HRDFMT - (312) FORMATS IN ARRAYS//
1 22H ASA REFS. - 7.2.3.10//34H EACH GROUP OF LINES SHOULD MATCH)
3125 FORMAT (/ 22H 84756 -867 224 39 -6)
3126 FORMAT (/ 13H ABCDE+*=123)
3127 FORMAT (/ 25H 0.234 98. -77.27 547.18)
3128 FORMAT (/11H -0.76E+09)
3129 FORMAT (/14H 0.893421E-12)
9930 FORMAT (/ 27H -0.357901246D+00 0.52D-02)
9931 FORMAT (/ 10H T T F F)
C***** END OF TEST SEGMENT 312
C***** WHEN EXECUTING ONLY SEGMENT 312, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP
END
C***********************************************************************
C*****
C***** SMCQ - (411)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** TO DEFINE SUBROUTINE SMCQ WHICH IS USED IN SEGMENT 300
SUBROUTINE SMCQ(MWVI)
MWVI = MWVI + 5
RETURN
C***** END OF TEST SEGMENT 411
END
C***********************************************************************
C*****
C***** FMTQ - (462)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** TO DEFINE SUBROUTINE FMTQ WHICH IS USED IN SEGMENT 312
C***** TO TEST FORMAT IN AN ARRAY PASSED AS AN ARGUMENT, AN
C***** EMPTY FORMAT STATEMENT, AND
C***** HOLLERITH IN A CALL ARGUMENT
SUBROUTINE FMTQ(NWVI,ZTW1S,AWVS,IWVH,JWVH,KWVH,LWVH,MWVH,NWVH,
1 IIWVH,JJWVH,KKWVH,LLWVH,MMWVH,NNWVH,IJWVH,IKWVH,
2 ILWVH,IMWVH,INWVH,JIWVH,JKWVH)
DIMENSION ZTW1S(4)
WRITE (NWVI, 4620)
4620 FORMAT(/11H +.10E+01 )
C*****FORMAT LABELED ZTW1S PASSED AS ARGUMENT IS (E11.2)
WRITE (NWVI, ZTW1S) AWVS
WRITE (NWVI, 4621)
4621 FORMAT(/39H HOLLERITH CONSTANTS AS CALL ARGUMENTS )
WRITE (NWVI,4622) IWVH, JWVH,KWVH,LWVH,MWVH,NWVH,IIWVH,JJWVH,
1 KKWVH, LLWVH,MMWVH,NNWVH,IJWVH,IKWVH,ILWVH,
2 IMWVH,INWVH,JIWVH,JKWVH
4622 FORMAT(2X, 19A2)
WRITE (NWVI,4623)
4623 FORMAT(//29H TEST EMPTY FORMAT STATEMENT /
136H THE FOLLOWING LINE SHOULD BE BLANK )
WRITE(NWVI,4624)
4624 FORMAT( )
WRITE(NWVI,4625)
4625 FORMAT(23H END EMPTY FORMAT TEST //22H END SEGMENT 312 TEST )
RETURN
END
nbs14.d 480890389 170 2 100666 285 `
SAMPLE COMPUTER, FORTRAN COMPILER LEVEL
DO NOT READ OR WRITE RECORD 2. DOUBLE SPACE ON OUTPUT. ID 2
OPERATING SYSTEM VERSION
DO NOT READ OR WRITE RECORD 4. DOUBLE SPACE ON OUTPUT. ID 4
DATE, INSTALLATION NAME
DO NOT READ OR WRITE RECORD 6. DOUBLE SPACE ON OUTPUT. ID 6
nbs14.f 480890397 170 2 100666 21295 `
C***** PART14 ****************************************************
C*****
C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS
C*****
C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3
C*****
C***** JUNE 1973
C*****
C***** PART 14 OF 14 PARTS
C*****
C***** SEGMENTS INCLUDED
C*****
C***** MISC5 - 350 SPECIFICATIONS FOR PROGRAM FORM
C*****
C***** FUNMX - 351 BASIC EXTERNAL FUNCTIONS USING TRIG FORMULAS
C*****
C***** NAMES - 352 NAMES RESEMBLE FORTRAN VERBS AND FUNCTION NAMES
C*****
C***** MAQQ - 413 SUBROUTINE CALLED FROM NAMES
C*****
C***** MBQQ - 463 SUBROUTINE CALLED FROM NAMES
C*****
C***** AMQQ - 473 SUBROUTINE CALLED FROM NAMES
C*****
C***** BMQQ - 483 SUBROUTINE CALLED FROM NAMES
C*****
C***** SPEC2 - 360 COMMON, DIMENSION, EQUIVALENCE
C*****
C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN SEGMENTS
C***** 350, 351, 352, 360 ARE RUN AS ONE MAIN PROGRAM.
C*****
DIMENSION J(2), JJ(1,1), JJJ(1,1,1), JJJJ(1,1),
1 JJJJJ(1), JJJJJJ(1)
DIMENSION GOTO(2,2), IF(5)
DIMENSION MX1I(3), TX1S(3)
DIMENSION MMY1I(400),NNY3I(20,10,2)
DIMENSION MX2I(2,3), TX2S(2,2), WAZ2S(3,2), RVY1S(2), RVY2S(1,2)
DIMENSION JY2I(2,2), JY1I(5), NZ1I(4), NZ2I(4,2), WAZ1S(2)
COMMON MX1I, MX2I, NZ1I, NZVI, NZ2I
COMMON MXVI
COMMON IAXVI
COMMON WAZ1S
COMMON TX1S, TX2S, JBZVI, WAZ2S
EQUIVALENCE (MMY1I(1),NNY3I(1,1,1)),(NZ1I(1),NNY3I(1))
EQUIVALENCE (MYVI,NZVI), (IYVI,NZ1I(1)), (NZ2I(4,1), JYVI)
EQUIVALENCE (NZ2I(3), KYVI), (AAYVS,JBZVI,JY2I(1), RVY1S(2))
EQUIVALENCE (RVY2S(1,1),WAZ1S(2))
EQUIVALENCE (JY1I(3),RVY1S(2))
EQUIVALENCE (WAZ2S(1),BBYVS,CCYVS), (WAZ2S(2,1),DDYVS)
C***** END OF SPECIFICATIONS FOR SEGMENTS 350, 351, 352, 360
C***********************************************************************
C*****
C***** MISC5 - (350)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST SPECIFICATIONS FOR PROGRAM FORM 3.2
C***** 3.2.1
C***** 3.4
C***** 3.5
C***** GENERAL COMMENTS
C***** * AMONG OTHER THINGS, THIS SEGMENT TESTS THAT COMMENTS ARE
C***** NOT EXECUTED AND, AS A RESULT OF THIS TEST, THE COMPILER
C***** MAY GENERATE SOME WARNING MESSAGES.
C***** * BECAUSE OF THE NATURE OF THE TESTS BEING PERFORMED, SOME
C***** LABELS AND NAMES DO NOT FOLLOW THE CONVENTIONS
C***** SPECIFIED IN THE USERS MANUAL.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 350
C*****
C***** WHEN EXECUTING ONLY SEGMENT 350, REMOVE THE PRECEDING
C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS, WHICH APPEAR
C***** AS COMMENT CARDS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION J(2), JJ(1,1), JJJ(1,1,1), JJJJ(1,1),JJJJJ(1), JJJJJJ(1)
C*****
C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENTS.
IRVI = 5
NUVI = 6
C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS
WRITE(NUVI,0071)
0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S//
1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS//
3 37H FOR USE ON LARGE FORTRAN PROCESSORS //
4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966//
5 23H VERSION 3 PART 14///)
C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
C PREPARED BY USER
C READ, NO LIST
READ(IRVI,0070)
READ(IRVI,0072)
READ(IRVI,0073)
0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /)
0072 FORMAT(40H TEST PROGRAMS /)
0073 FORMAT(40H FORTRAN COMPILER /)
WRITE(NUVI,0070)
WRITE(NUVI,0072)
WRITE(NUVI,0073)
WRITE (NUVI,3500)
3500 FORMAT (1H1,1X,32HMISC5 - (350) SPECIFICATIONS FOR/ 16X, 12HPRO
1GRAM FORM//2X,32HASA REFS. - 3.2 3.2.1 3.4 3.5//
2 2X,35HTEST THAT COMMENTS ARE NOT EXECUTED)
C***** HEADER FOR SEGMENT 350 WRITTEN
C***** TEST THAT COMMENTS ARE NOT EXECUTED 3.2.1/36
C*****WRITE (NUVI,3501)
3501 FORMAT (2X,34HERROR - COMMENT STATEMENT EXECUTED)
C*****GO TO 3504
3502 MRRVI = 0
C*****IF (MRRVI) 3504, 3504, 3504
3503 MRRVI = 1
C*****MRRVI = -1
IF (MRRVI) 3504,3504,3505
3504 WRITE (NUVI,3501)
3505 WRITE (NUVI,3506)
3506 FORMAT (2X,35HTEST SUCCESSFUL IF NO ERROR MESSAGE)
GO TO 3509
C***** TEST THAT ALL 72 CHARACTERS IN A LINE MAY BE USED 3.2/24
3509 WRITE (NUVI,8100)
8100 FORMAT(///2X,22HTEST 72 CHARACTER LINE)
WRITE (NUVI,8101)
8101 0FORMAT( /2X,29H12345678910111213141516171819/2X,29H123456789101112
113141516171819)
WRITE (NUVI,8102)
8102 FORMAT ( /2X,36HTEST SUCCESSFUL IF 2 LINES ABOVE ARE/2X,19HDIGITS
11 THROUGH 19)
C***** TEST THAT STATEMENT LABELS MAY BE 1, 2, 3, 4 OR 5 3.4/12
C***** DIGITS LONG
WRITE (NUVI,8112)
8112 FORMAT (//2X,37HTEST 1,2,3,4,5 CHARACTER STMNT. LABEL/)
GO TO 1
8113 GO TO 22
8114 GO TO 333
8115 GO TO 8099
8097 GO TO 22255
1 MRRVI = 1
WRITE (NUVI,8118) MRRVI
GO TO 8113
22 MRRVI = 2
WRITE (NUVI,8118) MRRVI
GO TO 8114
333 MRRVI = 3
WRITE (NUVI,8118) MRRVI
GO TO 8115
8099 MRRVI = 4
WRITE(NUVI, 8118) MRRVI
GO TO 8097
22255 MRRVI = 5
WRITE (NUVI,8118) MRRVI
8118 FORMAT ( 2X,I1,1X,24HCHARACTER LABEL ACCEPTED)
C***** TEST THAT VARIABLE AND ARRAY NAMES MAY BE 3.5/21
C***** 1, 2, 3, 4 OR 5 CHARACTERS LONG
WRITE (NUVI,8098)
8098 FORMAT (//2X,36HTEST 1,2,3,4,5,6 CHARACTER VARIABLES/2X,
115HAND ARRAY NAMES)
M = 1
MM = 1
MMM = 1
MMMM = 1
MMMMM = 1
MMMMMM = 1
J(1) = 1
JJ(1,1) = 1
JJJ(1,1,1) = 1
JJJJ(1,1) = 1
JJJJJ(1) = 1
JJJJJJ(1) = 1
IF (M-1) 8119, 8103, 8119
8103 IF (MM-1) 8119,8104,8119
8104 IF (MMM-1) 8119,8105,8119
8105 IF (MMMM-1) 8119, 8106,8119
8106 IF (MMMMM-1) 8119,8096,8119
8096 IF (MMMMMM-1) 8119, 8107, 8119
8107 IF (J(1)-1) 8119,8108,8119
8108 IF (JJ(1,1)-1) 8119,8109,8119
8109 IF (JJJ(1,1,1)-1) 8119,8110,8119
8110 IF (JJJJ(1,1)-1) 8119,8111,8119
8111 IF (JJJJJ(1)-1) 8119,8095,8119
8095 IF (JJJJJJ(1)-1) 8119,8121,8119
8119 WRITE (NUVI,8120)
8120 FORMAT (/ 2X,21H**TEST UNSUCCESSFUL**)
GO TO 8123
8121 WRITE (NUVI,8122)
8122 FORMAT (/ 2X,38H**TEST SUCCESSFUL-ALL NAMES ACCEPTED**)
C***** TEST THAT STATEMENT LABELS MAY BE PLACED 3.4/13
C***** ANYWHERE IN COLUMNS 1 TO 5 AND THAT LEADING 3.4/17
C***** ZEROS ON STATEMENT LABELS ARE NOT SIGNIFICANT
8123 WRITE (NUVI,8116)
8116 FORMAT (//2X,34HTEST PLACEMENT OF STATEMENT LABELS/2X,
1 29HAND LABELS WITH LEADING ZEROS/)
MRRVI = 1
GO TO 10
2 MRRVI = 2
GO TO 010
3 MRRVI = 3
GO TO 0010
4 MRRVI = 4
GO TO 0010
5 MRRVI = 5
GO TO 0010
06 MRRVI = 6
GO TO 0010
007 MRRVI = 7
GO TO 0010
0008 MRRVI = 8
GO TO 0010
0009 MRRVI = 9
0010 WRITE (NUVI,11) MRRVI
011 FORMAT ( I10)
GO TO (02,3,004,0005,6,7,8,009,8117), MRRVI
8117 WRITE (NUVI,012)
12 FORMAT (//2X,28HTEST SUCCESSFUL IF 9 NUMBERS/2X,
1 31HIN SEQUENTIAL ORDER FROM 1 TO 9/2X,
2 17HARE WRITTEN ABOVE///2X,18HEND OF SEGMENT 350)
C***** END OF TEST SEGMENT 350
C***** WHEN EXECUTING ONLY SEGMENT 350, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** FUNMX - (351)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** THIS SEGMENT FURTHER TESTS SOME 8.3.3
C***** BASIC EXTERNAL FUNCTIONS BY USING TRIGONOMETRIC
C***** FORMULAE
C*****
C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 351, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,3510)
3510 FORMAT (1H1,2X,13HFUNMX - (351)//1X,22H THIS SEGMENT FURTHER ,
1 5HTESTS /21H SOME BASIC EXTERNAL,
2 10H FUNCTIONS /33H BY USING TRIGONOMETRIC FORMULAE//
319H ASA REFS. - 8.3.3//2X,7HRESULTS)
C***** HEADER FOR SEGMENT 351 WRITTEN
C***** TEST STATEMENTS USING ORDINARY TRIGONOMETRIC FUNCTIONS
CMAVS = 1.75
CMCVS = ALOG(EXP(CMAVS)) - 1.75
CMDVS = EXP(ALOG(CMAVS)) - 1.75
CMEVS = (SIN(2.0)) ** 2 + (COS(2.0)) ** 2 - 1.0
CMFVS = (1.0/COS(1.2)) ** 2 -((SIN(1.2) / COS(1.2)) ** 2) - 1.0
WRITE (NUVI,3511) CMCVS, CMDVS, CMEVS, CMFVS
CMCVS = SIN(.78) - SQRT(1. - COS(0.78) ** 2)
CMDVS = COS(1.57) - SQRT(1.0 - SIN(1.57) ** 2)
CMEVS = SQRT((1.0/COS(0.5236))**2-1.0)-SIN(0.5236)/COS(0.5236)
CMFVS = ATAN2(SIN(0.5),COS(0.5)) - 0.5
WRITE (NUVI,3511) CMCVS, CMDVS, CMEVS, CMFVS
C***** TEST STATEMENTS USING HYPERBOLIC FUNCTIONS
CMAVS = EXP(1.85)
CMBVS = EXP(-1.85)
CMCVS = TANH(1.85) - ((CMAVS - CMBVS) / (CMAVS + CMBVS))
CMEVS = 2./(EXP(1.05) + EXP(-1.05)) - SQRT(1.0-TANH(1.05)**2)
CMFVS = TANH(2.01)/ (SQRT(1.0 - TANH(2.01)**2))-.5*(EXP(2.01) -
1 EXP(-2.01))
WRITE (NUVI,3512) CMCVS, CMEVS, CMFVS
WRITE (NUVI,3513)
3511 FORMAT (//4(F15.5/))
3512 FORMAT (//3(F15.5/))
3513 FORMAT (//39H ALL ABOVE ANSWERS SHOULD BE 0 PLUS OR /
1 40H MINUS AN ERROR FACTOR OF NOT MORE THAN /
2 12H 10 ** (-4))
C***** END OF TEST SEGMENT 351
C***** WHEN EXECUTING ONLY SEGMENT 351, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** NAMES - (352)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REF
C***** TO TEST THE CAPABILITY OF COMPILERS TO IDENTIFY DATA 10.1.7/54
C***** NAMES THAT RESEMBLE FORTRAN VERBS AND/OR PREDEFINED
C***** FUNCTION NAMES.
C***** GENERAL COMMENTS
C***** BECAUSE OF THE NATURE OF THIS TEST SEGMENT, NAMING
C***** CONVENTIONS THAT EXISTED IN OTHER SEGMENTS WILL NOT
C***** BE OBSERVED.
C*****
C***** S P E C I F I C A T I O N S SEGMENT 352
C*****
C***** WHEN EXECUTING ONLY SEGMENT 352, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION GOTO(2,2), IF(5)
C*****
C***** O U T P UT T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 352, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
WRITE (NUVI,3520)
3520 FORMAT (1H1 ,1X,13HNAMES - (352)//2X,36HTEST OF THE COMPILERS CAPA
1BILITY OF /2X,37HIDENTIFYING DATA NAMES THAT RESEMBLE /2X,
2 32HFORTRAN VERBS AND/OR PREDEFINED /2X,15HFUNCTION NAMES //
3 22H ASA REFS. - 10.1.7/4 //2X,7HRESULTS)
C***** HEADER FOR SEGMENT 352 WRITTEN
INTEG = 0
REAL = 2.0
GOTO5 = REAL - 2.0
GOTO(1,2) = 10.0 - 5.0 * 2.0
DO13I = INTEG
13 DO14J = INTEG +0
14 IF(2) = 5-5
CALL = 0
STOP7 = REAL - 2.0
PAUSE = REAL / 2.0 - 1.0
READ6 = 0.0 ** 5
WRITE = 7.0 - 7.0
WRITE (NUVI,3521) GOTO5, GOTO(1,2), DO13I, DO14J, IF(2), CALL,
1 STOP7, PAUSE, READ6, WRITE
3521 FORMAT (//10(F10.5/))
C***** TEST THAT THE SAME INTRINSIC FUNCTION NAMES OF
C***** A PROGRAM UNIT OF AN EXECUTABLE PROGRAM CAN BE
C***** USED TO IDENTIFY SOME OTHER ENTITY IN A DIFFERENT
C***** PROGRAM UNIT OF THAT EXECUTABLE PROGRAM
MCAVI = IABS(-5)
CALL MAQQ(MCAVI,IVI)
MCCVI = IVI
MCBVI = ISIGN(1,-2)
CALL MBQQ(MCBVI,IVI)
MCDVI = IVI
CMAVS = FLOAT(5 + 7)
CALL AMQQ(CMAVS,AVS)
CMCVS = AVS
CMBVS = ABS(-10.0 - 8.00)
CALL BMQQ(CMBVS,AVS)
CMDVS = AVS
WRITE (NUVI,3522) MCCVI, MCDVI, CMCVS, CMDVS
3522 FORMAT (/2(I10/)//2(F10.5/)//35H ALL ABOVE ANSWERS SHOULD BE 0 FO
1R/36H THIS TEST SEGMENT TO BE SUCCESSFUL)
C***** END OF TEST SEGMENT 352
C***** WHEN EXECUTING ONLY SEGMENT 352, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
C***********************************************************************
C*****
C***** SPEC2 - (360)
C*****
C***********************************************************************
C***** GENERAL PURPOSE ASA REFS
C***** * TO TEST COMMON, DIMENSION AND EQUIVALENCE 7.2.1.2
C***** STATEMENTS 7.2.1.3
C***** * TO TEST THAT VARIABLES AND ARRAYS WHICH ARE 7.2.1.4
C***** EQUATED AND/OR IN COMMON MAY BE USED IN A
C***** VARIETY OF FORTRAN STATEMENTS
C***** RESTRICTIONS OBSERVED
C***** * NO DUMMY ARGUMENTS APPEAR IN COMMON OR EQUIVALENCE 7.2.1.4/40
C***** STATEMENTS 8.4.1.1/23
C***** * NUMBER OF SUBSCRIPTS IN EQUIVALENCE STATEMENTS
C***** CORRESPONDS TO ARRAY DIMENSIONALITY OR IS ONE 7.2.1.4/09
C***** * COMMON NEVER LENGTHENED BY EQUIVALENCE IN A 7.2.1.4/31
C***** BACKWARD DIRECTION
C***** * ONLY ONE OF AN EQUATED PAIR OF ITEMS APPEARS 7.2.1.4/36
C***** IN COMMON
C***** * VARIABLES ARE NEVER EQUATED TO MORE THAN ONE 7.2.1.4/42
C***** ELEMENT OF THE SAME ARRAY
C***** GENERAL COMMENTS
C***** THIS SEGMENT FOLLOWS THE ORDER OF SPECIFICATION STATEMENTS
C***** REQUIRED IN BASIC FORTRAN (SEE 9.1.2/56 IN BASIC ASA BOOK)
C*****
C***** S P E C I F I C A T I O N S SEGMENT 360
C*****
C***** WHEN EXECUTING ONLY SEGMENT 360, THE SPECIFICATION STATEMENTS
C***** WHICH APPEAR AS COMMENT CARDS, MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C*****
C= DIMENSION MX1I(3), TX1S(3)
C= DIMENSION MX2I(2,3), TX2S(2,2), WAZ2S(3,2), RVY1S(2), RVY2S(1,2)
C= DIMENSION JY2I(2,2), JY1I(5), NZ1I(4), NZ2I(4,2), WAZ1S(2)
C= DIMENSION MMY1I(400),NNY3I(20,10,2)
C= EQUIVALENCE (MMY1I(1),NNY3I(1,1,1)),(NZ1I(1),NNY3I(1))
C= COMMON MX1I, MX2I, NZ1I, NZVI, NZ2I
C= COMMON MXVI
C= COMMON IAXVI
C= COMMON WAZ1S
C= COMMON TX1S, TX2S, JBZVI, WAZ2S
C= EQUIVALENCE (MYVI,NZVI), (IYVI,NZ1I(1)), (NZ2I(4,1), JYVI)
C= EQUIVALENCE (NZ2I(3), KYVI), (AAYVS,JBZVI,JY2I(1), RVY1S(2))
C= EQUIVALENCE (RVY2S(1,1),WAZ1S(2))
C= EQUIVALENCE (JY1I(3),RVY1S(2))
C= EQUIVALENCE (WAZ2S(1),BBYVS,CCYVS), (WAZ2S(2,1),DDYVS)
C*****
C***** SOME OF THE ITEMS DEFINED ABOVE ARE USED IN A VARIETY
C***** OF FORTRAN STATEMENTS
C*****
C***** DEFINE THE SYMBOLIC OUTPUT UNIT FOR USE IN THIS 7.1.3/22
C***** SEGMENT
C***** O U T P U T - T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE.
C*****
C***** WHEN EXECUTING ONLY SEGMENT 360, THE FOLLOWING STATEMENT
C***** NUVI = 6 MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED.
C*****
C= NUVI = 6
C*****
JY2I(1,1) = NUVI
C***** WRITE HEADER FOR THIS SEGMENT
WRITE (JBZVI,3600)
3600 FORMAT (1H1, 1X,36HSPEC2 - (360) COMMON AND EQUIVALENCE//
1 2X,36HASA REFS - 7.2.1.2 7.2.1.3 7.2.1.4// 2X,7HRESULTS)
C*****
C***** TEST THAT EQUIVALENCE WORKS - ASSOCIATED ITEM OF 10.2.2/51
C***** SAME TYPE BECOMES DEFINED WHEN EQUATED ITEM IS
C***** DEFINED
MYVI = 2
WAZ1S(2) = 2.0
WRITE (JBZVI,3601) NZVI, RVY2S(1,1)
3601 FORMAT(//27H LINE 1 BELOW IS HOLLERITH
1 // 11H 2 2.0/I6,F5.1)
C***** USE DEFINED ITEMS IN ARITHMETIC STATEMENTS 7.1.1.1
JYVI = 4
MXVI = 5
NZVI = 3
JY1I(1) = 1
MX1I(2) = 0
NZ1I(4) = 2
JY2I(2,1) = -8
MX2I(1,3) = 9
NZ2I(3,2) = 7
MX1I(3) = MX2I(1,3) * (NZVI - JY1I(1)) - 18
MX2I(1,1) = MX2I(1,3) * (MYVI - JY1I(1))- 18
MX1I(1) = JYVI + JY2I(2,1) + NZVI - MX1I(2) + JY1I(1)
IAXVI = NZ2I(4,1) + JY1I(4) + MYVI - MX1I(2) + JY1I(1)
NZ2I(1,1) = MXVI ** NZ1I(4) - MXVI ** NZ1I(4)
BBYVS = 2.0
TX1S(3) = 1.0E1
WAZ2S(1,2) = -3.0E00
RVY1S(1) = .04E+2
DDYVS = RVY1S(1) ** (WAZ2S(1,2)-5.0+TX1S(3)) -13.0 + WAZ2S(1,2)
WAZ2S(2,1) = TX2S(2,2)**(WAZ2S(1,2)-5.0+TX1S(3))-13.0+WAZ2S(1,2)
WRITE (JBZVI,3602) MX1I(3), MX1I(1), NZ2I(1,1), DDYVS
WRITE(JBZVI,7367) MX2I(1,1), IAXVI , NZ2I(1,1), WAZ2S(2,1)
3602 FORMAT (//34H ANSWERS BELOW SHOULD BE 0 OR 0.0//
1 3(I6/) , F8.1)
C***** USE ITEMS IN ARITHMETIC IF STATEMENTS 7.1.2.2
IF (WAZ2S(1,2)) 3603,3604,3604
3603 IF (MX1I(2)) 3604,3605,3604
3605 IF (TX2S(2,2) + CCYVS ** NZ1I(4) + TX1S(3)) 3604, 3604, 3606
3604 WRITE (JBZVI,3607)
3607 FORMAT (//22H ARITHMETIC IF FAILED)
GO TO 3609
3606 WRITE (JBZVI,3608)
3608 FORMAT (//26H ARITHMETIC IF SUCCESSFUL)
C***** USE ITEMS IN DO LOOP 7.1.2.8
3609 DO 7360 JYVI = 1,NZVI,1
TX1S(3) = TX1S(3) + 1.0
7360 CONTINUE
WRITE (JBZVI,7361) TX1S(3)
7361 FORMAT (//29H ANSWER BELOW SHOULD BE 13.0// F8.1)
C***** USE ITEM IN COMPUTED GO TO 7.1.2.1.3
GO TO (7362,7362,7364), NZVI
7362 WRITE (JBZVI,7363)
7363 FORMAT (//23H COMPUTED GO TO FAILED)
GO TO 7366
7364 WRITE (JBZVI,7365)
7365 FORMAT (//27H COMPUTED GO TO SUCCESSFUL)
7367 FORMAT (3(I6/), F8.1)
7366 CONTINUE
C***** TEST EQUIVALENCE EXTENDS COMMON
C***** ARRAYS- NNY3I(20,10,2) EQUIVALENCED TO ARRAY MMY1I(400) WHICH IS
C***** EQUIVALENCED TO THE 10TH STORAGE LOCATION IN BLANK 7.2.1.4/29
C***** COMMON (NZ1I(1))
WRITE (NUVI, 8366)
8366 FORMAT (34H0 TEST EQUIVALENCE EXTENDS COMMON )
DO 7368 IVI = 1, 400
7368 MMY1I(IVI) = IVI
IVI = 0
DO 7369 LVI = 1, 2
DO 7369 KVI = 1, 10
DO 7369 JVI = 1, 20
IF(NNY3I(JVI,KVI,LVI)-(JVI+20*(KVI+10*LVI) - 220))7369,8360,7369
8360 IVI = IVI + 1
7369 CONTINUE
IF (IVI - 400) 8363, 8361, 8363
8363 WRITE (NUVI, 8364)
8364 FORMAT(13H0 TEST FAILED )
GO TO 8365
8361 WRITE (NUVI, 8362)
8362 FORMAT(17H0 TEST SUCCESSFUL )
8365 CONTINUE
C***** END OF TEST SEGMENT 360
C***** WHEN EXECUTING ONLY SEGMENT 360, THE STOP AND END CARDS
C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C=
C***** IN COLUMNS 1 AND 2 REMOVED.
C= STOP
C= END
STOP 77777
END
C***********************************************************************
C*****
C***** MAQQ - (413)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** THIS SEGMENT CONTAINS A SUBROUTINE WHICH IS CALLED
C***** BY SEGMENT 352.
C***** GENERAL COMMENTS
C***** SUBROUTINE MAQQ BEING DEFINED
SUBROUTINE MAQQ(MWVI,IWVI)
IABS = MWVI
IWVI = IABS + ISIGN(MWVI, -MWVI)
RETURN
END
C***********************************************************************
C*****
C***** MBQQ - (463)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** THIS SEGMENT CONTAINS A SUBROUTINE WHICH IS CALLED
C***** BY SEGMENT 352
C***** GENERAL COMMENTS
C***** SUBROUTINE MBQQ BEING DEFINED
SUBROUTINE MBQQ(MWVI, IWVI)
ISIGN = -MWVI
IWVI = ISIGN + MWVI
RETURN
END
C***********************************************************************
C*****
C***** AMQQ - (473)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** THIS SEGMENT CONTAINS A SUBROUTINE WHICH IS CALLED
C***** BY SEGMENT 352
C***** GENERAL COMMENTS
C***** SUBROUTINE AMQQ BEING DEFINED
C*****STATEMENT FUNCTION NAME IS THE SAME AS SUBROUTINE NAME CALLED BY
C*****SEGMENT 352, STAT. FUNCTION DUMMY ARGUMENT NAME SAME AS SUBROUTINE
C*****DUMMY ARGUMENT NAME, VARIABLE IS REFERENCED IN STAT. FUNCTION
SUBROUTINE AMQQ(CWVS, AWVS)
DATA AVS /1.0/
BMQQ(CWVS) = CWVS + BVS
FLOAT = AVS
BVS = CWVS
AWVS = BMQQ(FLOAT) - (BVS + 1.0)
RETURN
END
C***********************************************************************
C*****
C***** BMQQ - (483)
C*****
C***********************************************************************
C***** GENERAL PURPOSE
C***** THIS SEGMENT CONTAINS A SUBROUTINE WHICH IS CALLED
C***** BY SEGMENT 352
C***** GENERAL COMMENTS
C***** SUBROUTINE BMQQ BEING DEFINED
SUBROUTINE BMQQ(CWVS, AWVS)
ABS = CWVS
AWVS = FLOAT(ISIGN(IFIX(ABS), - 2)) + 18.0
RETURN
C***** END OF TEST SEGMENT 483
END