C***** PART10 ****************************************************H0004300 C***** H0004305 C***** ANSI FORTRAN (X3.9-1966) TEST PROGRAMS H0004310 C***** H0004315 C***** PREPARED BY THE NATIONAL BUREAU OF STANDARDS VERSION 3 H0004320 C***** H0004325 C***** JUNE 1973 H0004330 C***** H0004335 C***** PART 10 OF 14 PARTS H0004340 C***** H0004345 C***** SEGMENTS INCLUDED H0004350 C***** H0004355 C***** BRFCP - 160 REAL EXTERNAL FUNCTIONS H0004360 C***** H0004365 C***** AFS - 400 REAL ARGUMENT H0004370 C***** H0004375 C***** BFS - 420 REAL ARGUMENTS H0004380 C***** H0004385 C***** CFS - 430 INTEGER ARGUMENT H0004390 C***** H0004395 C***** DFS - 440 INTEGER ARGUMENTS H0004400 C***** H0004405 C***** EFS - 450 ARRAY NAME H0004410 C***** H0004415 C***** FFS - 460 DIFFERENT TYPES OF ARGUMENTS H0004420 C***** H0004425 C***** BIFCP - 161 INTEGER EXTERNAL FUNCTIONS H0004430 C***** H0004435 C***** IAFI - 401 REAL ARGUMENT H0004440 C***** H0004445 C***** IBFI - 421 REAL ARGUMENTS H0004450 C***** H0004455 C***** ICFI - 431 INTEGER ARGUMENT H0004460 C***** H0004465 C***** IDFI - 441 INTEGER ARGUMENTS H0004470 C***** H0004475 C***** IEFI - 451 ARRAY NAME H0004480 C***** H0004485 C***** IFFI - 461 DIFFERENT TYPES OF ARGUMENTS H0004490 C***** H0004495 C***** FRFCP - 162 REAL FUNCTIONS H0004500 C***** H0004505 C***** GFS - 402 D.P. ARGUMENT H0004510 C***** H0004515 C***** HFS - 422 COMPLEX ARGUMENTS H0004520 C***** H0004525 C***** IRFS - 432 LOGICAL ARGUMENT H0004530 C***** H0004535 C***** JRFS - 442 EXTERNAL PROCEDURE H0004540 C***** H0004545 C***** RFS - 452 DIFFERENT TYPES OF ARGUMENTS H0004550 C***** H0004555 C***** FIFCP - 163 INTEGER FUNCTIONS H0004560 C***** H0004565 C***** IFI - 403 D.P. ARGUMENT H0004570 C***** H0004575 C***** JFI - 423 COMPLEX ARGUMENTS H0004580 C***** H0004585 C***** KFI - 433 LOGICAL ARGUMENT H0004590 C***** H0004595 C***** LFI - 443 EXTERNAL PROCEDURE H0004600 C***** H0004605 C***** MFI - 453 DIFFERENT TYPES OF ARGUMENTS H0004610 C***** H0004615 C***** CFCCP - 164 COMPLEX FUNCTIONS H0004620 C***** H0004625 C***** AFC - 404 REAL ARGUMENT H0004630 C***** H0004635 C***** BFC - 414 INTEGER ARGUMENT H0004640 C***** H0004645 C***** CFC - 424 ARRAY NAME H0004650 C***** H0004655 C***** DFC - 434 D.P. ARGUMENT H0004660 C***** H0004665 C***** EFC - 444 COMPLEX ARGUMENT H0004670 C***** H0004675 C***** FFC - 454 LOGICAL ARGUMENT H0004680 C***** H0004685 C***** HFC - 464 DIFFERENT TYPES OF ARGUMENTS H0004690 C***** H0014300 C***** THE FOLLOWING SPECIFICATIONS ARE TO BE USED ONLY WHEN H0014305 C***** SEGMENTS 160, 161, 162, 163, 164 H0014310 C***** ARE RUN AS ONE MAIN PROGRAM. H0014315 C***** H0014320 DIMENSION A1S(5), A2S(2,2) , A3S(3,3,3) H0014325 INTEGER I1I(5), I2I(2,2), I3I(2,2,2) H0014330 REAL JRFS, IRFS H0014335 LOGICAL A1B(2), A2B(2,2), A3B(2,2,2), AVB, BVB H0014340 DOUBLE PRECISION AVD, A1D(4), A2D(2,2), A3D(2,2,2) H0014345 COMPLEX AVC, BVC,AFC, BFC, CFC, DFC, EFC, FFC, HFC H0014350 1 , A1C(12), A2C(2,2), A3C(2,2,1) H0014355 COMMON AXVS, CXVS H0014360 EXTERNAL GFS, BFC, IFI H0014365 C***** H0014370 C***** END OF SPECIFICATIONS FOR SEGMENTS H0014375 C***** 160,161, 162, 163, 164 H0014380 C***********************************************************************H1600010 C***** H1600020 C***** BRFCP - (160) H1600030 C***** H1600040 C***********************************************************************H1600050 C***** GENERAL PURPOSE ASA REFH1600060 C***** 1.TO TEST REAL FUNCTIONS 8.3.1H1600070 C***** 2.DUMMY ARGUMENTS ARE REAL OR INTEGER VARIABLES,OR H1600080 C***** ARRAY NAMES H1600090 C***** 3.FUNCTIONS CONTAIN UP TO 20 ARGUMENTS H1600100 C***** 4.IN REFERENCE, ACTUAL ARGUMENTS ARE VARIABLE NAME, H1600110 C***** ARRAY NAME, ARRAY ELEMENT NAME, OR AN ARITHMETIC H1600120 C***** EXPRESSION 8.3.2H1600130 C***** RESTRICTIONS OBSERVED H1600140 C***** 1.ITEMS(2),(3),(4),(5),(6) OF PARAGRAPH 8.3.1 H1600150 C***** 2.LAST SENTENCE OF PARAGRAPH 3.2 H1600160 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS H1600170 C***** 400, 420, 430, 440, 450, 460 WHICH H1600180 C***** CONTAINS ALL FUNCTIONS BEING TESTED HERE. H1600190 C***** H1600200 C***** S P E C I F I C A T I O N S SEGMENT 160 H1600210 C***** H0014385 C***** WHEN EXECUTING ONLY SEGMENT 160, REMOVE THE PRECEDING H0014390 C***** SPECIFICATIONS. THE FOLLOWING SPECIFICATIONS WHICH H0014395 C***** APPEAR AS COMMENTS MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0014400 C***** H0014405 C= DIMENSION A1S(5),A2S(2,2) H0014410 C***** H0014415 C***** I N P U T - O U T P U T T A P E ASSIGNMENT STATEMENT H1600220 IRVI = 5 H0074300 NUVI = 6 H0074305 C***** IDENTIFY THE SOURCE OF THE TEST PROGRAMS H0074310 WRITE(NUVI,0071) H0074315 0071 FORMAT (41H1 F O R T R A N T E S T P R O G R A M S// H0074320 1 42H PREPARED BY NATIONAL BUREAU OF STANDARDS// H0074325 3 37H FOR USE ON LARGE FORTRAN PROCESSORS // H0074330 4 42H IN ACCORDANCE WITH ASA FORTRAN X3.9-1966// H0074335 5 23H VERSION 3 PART 10///) H0074340 C***** 3 OF 6 INPUT CARDS IDENTIFY THE USERS SYSTEM AND COMPILER H0074345 C PREPARED BY USER H0074350 C READ, NO LIST H0074355 C PREPARED BY USER H0074360 C READ, NO LIST H0074365 C PREPARED BY USER H0074370 C READ, NO LIST H0074375 C READ(IRVI,0070) H0074380 C READ(IRVI,0072) H0074385 C READ(IRVI,0073) H0074390 0070 FORMAT(40H BASED ON ASA FORTRAN X3.9-1966 /) H0074395 0072 FORMAT(40H TEST PROGRAMS /) H0074400 0073 FORMAT(40H FORTRAN COMPILER /) H0074405 WRITE(NUVI,0070) H0074410 WRITE(NUVI,0072) H0074415 WRITE(NUVI,0073) H0074420 WRITE(NUVI,1604) H1600230 1604 FORMAT(1H1,1X,37HBRFCP - (160) REAL EXTERNAL FUNCTIONS/ H1600240 1 /2X,16HASA REF. - 8.3.1//28H RESULTS SHOULD BE POSITIVE) H1600250 IAVI=2 H1600260 A1S(1)=1.0 H1600270 A1S(2)=1.0 H1600280 A2S(2,2)=1.0 H1600290 A2S(2,1)=1.0 H1600300 AVS=1.0 H1600310 BVS=2.0 H1600320 CVS=1.0 H1600330 DVS=1.0 H1600340 EVS=1.0 H1600350 IVI=AFS(2.0)-8.0 H1600360 MAVI=1 H1600370 IF(IVI)1600,1601,1600 H1600380 1605 IVI=BFS(2.0,BVS)-4.0 H1600390 MAVI=2 H1600400 IF(IVI)1600,1601,1600 H1600410 1606 IVI = CFS(2) -16.0 H1600420 MAVI=3 H1600430 IF(IVI)1600,1601,1600 H1600440 1607 IVI=DFS(2,IAVI)-1.0 H1600450 MAVI=4 H1600460 IF(IVI)1600,1601,1600 H1600470 1608 IVI=EFS(A1S)-2.0 H1600480 MAVI=5 H1600490 IF(IVI)1600,1601,1600 H1600500 1609 IVI=FFS(IAVI,AVS,+2,-1.0,A1S,IAVI,CVS,A1S,1.0,IAVI,A1S,A1S,BVS,DVSH1600510 1 ,A1S(1),A2S,A2S,A2S,EVS+1.0,IAVI-1) + 1.0 H1600520 MAVI=6 H1600530 IF(IVI) 1600,1601,1600 H1600540 1600 WRITE (NUVI,1602)MAVI H1600550 GO TO 7001 H1600560 1601 WRITE (NUVI,1603)MAVI H1600570 1602 FORMAT (//2X,5HTEST ,I1,12H IS NEGATIVE) H1600580 1603 FORMAT (//2X,5HTEST ,I1,12H IS POSITIVE) H1600590 7001 GO TO (1605,1606,1607,1608,1609,7000 ),MAVI H1600600 7000 CONTINUE H1600610 C***** END OF TEST SEGMENT 160 H1600620 C***** WHEN EXECUTING ONLY SEGMENT 160, THE STOP AND END CARDS H1600630 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= IN H1600640 C***** COLUMNS 1 AND 2 REMOVED. H1600650 C= STOP H1600660 C= END H1600670 C***********************************************************************H1610010 C***** H1610020 C***** BIFCP - (161) H1610030 C***** H1610040 C***********************************************************************H1610050 C***** GENERAL PURPOSE ASA REFH1610060 C***** 1-TO TEST INTEGER FUNCTIONS 8.3.1H1610070 C***** 2-DUMMY ARGUMENTS ARE REAL OR INTEGER VARIABLES OR H1610080 C***** ARRAY NAMES 8.3.1H1610090 C***** 3-FUNCTIONS CONTAIN UP TO 20 ARGUMENTS H1610100 C***** 4-IN REFERENCE,ACTUAL ARGUMENTS ARE VARIABLE NAME, H1610110 C***** ARRAY NAME,ARRAY ELEMENT NAME,OR AN ARITHMETIC H1610120 C***** EXPRESSION 8.3.2H1610130 C*****RESTRICTIONS OBSERVED H1610140 C***** 1-ITEMS (2),(3),(4),(5),(6) OF PARAGRAPH 8.3.1 H1610150 C***** 2-LAST SENTENCE OF PARAGRAPH 3.2 H1610160 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS H1610170 C***** 401, 421, 431, 441, 451, 461 WHICH H1610180 C***** CONTAINS ALL FUNCTIONS BEING TESTED HERE. H1610190 C***** H1610200 C***** S P E C I F I C A T I O N S SEGMENT 161 H1610210 C***** H0014420 C***** WHEN EXECUTING ONLY SEGMENT 161, THE SPECIFICATION STATEMENTS H0014425 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H0014430 C***** IN COLUMNS 1 AND 2 REMOVED. H0014435 C***** H0014440 C= DIMENSION A1S(5) H0014445 C= INTEGER I1I(5) H0014450 C***** H0014455 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1610220 C***** H0074425 C***** WHEN EXECUTING ONLY SEGMENT 161, THE STATEMENT NUVI = 6 H0074430 C***** MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0074435 C***** H0074440 C= NUVI = 6 H0074445 C***** H0074450 WRITE(NUVI,1614) H1610230 1614 FORMAT(1H1,1X,40HBIFCP - (161) INTEGER EXTERNAL FUNCTIONS/ H1610240 1 16X,26HWITH INTEGER AND REAL ARGS//2X,16HASA REF. - 8.3.1// H1610250 228H RESULTS SHOULD BE POSITIVE) H1610260 IAVI=2 H1610270 A1S(1)=1.0 H1610280 A1S(2)=1.0 H1610290 I1I(1)=1 H1610300 I1I(2)=1 H1610310 AVS=1.0 H1610320 BVS=2.0 H1610330 CVS=1.0 H1610340 DVS=1.0 H1610350 EVS=1.0 H1610360 IVI=IAFI(2.0) - 8 H1610370 MAVI=1 H1610380 IF (IVI) 1610,1611,1610 H1610390 1615 IVI=IBFI(2.0,BVS)-4 H1610400 MAVI=2 H1610410 IF (IVI) 1610,1611,1610 H1610420 1616 IVI = ICFI(2) - 16 H1610430 MAVI=3 H1610440 IF (IVI) 1610,1611,1610 H1610450 1617 IVI=IDFI(2,IAVI)-1 H1610460 MAVI=4 H1610470 IF (IVI) 1610,1611,1610 H1610480 1618 IVI=IEFI(I1I)-2 H1610490 MAVI=5 H1610500 IF (IVI) 1610,1611,1610 H1610510 1619 IVI=IFFI(IAVI,AVS,2,-1.0,A1S,IAVI,CVS,A1S,1.0,IAVI,A1S,A1S,BVS, H1610520 1DVS,A1S(1),A1S,A1S,A1S,EVS+1.0,IAVI-1) + 1 H1610530 MAVI=6 H1610540 IF(IVI) 1610,1611,1610 H1610550 1610 WRITE(NUVI,1612)MAVI H1610560 GO TO 7002 H1610570 1611 WRITE(NUVI,1613)MAVI H1610580 1612 FORMAT (//2X,5HTEST ,I1,12H IS NEGATIVE) H1610590 1613 FORMAT (//2X,5HTEST ,I1,12H IS POSITIVE) H1610600 7002 GO TO (1615,1616,1617,1618,1619,7003),MAVI H1610610 7003 CONTINUE H1610620 C***** END OF TEST SEGMENT 161 H1610630 C***** WHEN EXECUTING ONLY SEGMENT 161, THE STOP AND END CARDS H1610640 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1610650 C***** IN COLUMNS 1 AND 2 REMOVED. H1610660 C= STOP H1610670 C= END H1610680 C***********************************************************************H1620010 C***** H1620020 C***** FRFCP - (162) H1620030 C***** H1620040 C***********************************************************************H1620050 C***** GENERAL PURPOSE ASA REF H1620060 C***** 1.TO TEST REAL FUNCTIONS IN FULL FORTRAN H1620070 C***** 2.THIS SEGMENT COMPLETES SEGMENT (160) IN ORDER TO TEST H1620080 C***** FOR ALL FEATURES REQUIRED IN FULL FORTRAN 8.3.1H1620090 C***** 3.DUMMY ARGUMENTS CAN BE INTEGER(TESTED IN 160),REAL(TESTED IN H1620100 C***** 160),ARRAY NAME(TESTED IN 160),DOUBLE PRECISION,COMPLEX, H1620110 C***** LOGICAL OR EXTERNAL PROCEDURE 8.3.1H1620120 C***** 4.DUMMY ARGUMENTS MAY BE REDEFINED IN SUBPROGRAM(ITEM 4) 8.3.1H1620130 C***** 5.IN REFERENCE, ACTUAL ARGUMENTS MAY BE AS IN (160) AND H1620140 C***** BESIDES EXTERNAL PROCEDURE. IN THIS CASE, EXTERNAL 8.3.2H1620150 C***** PROCEDURE IS REFERENCED BY AN EXTERNAL STATEMENT H1620160 C***** 6.USE CAN BE MADE OF ADJUSTABLE DIMENSION H1620170 C*****RESTRICTIONS OBSERVED H1620180 C***** 1.ITEMS (1), (2), (3), (5) OF 8.3.1 H1620190 C***** 2.PARAGRAPH 8.3.2, LINE 18 TO END OF PARAGRAPH H1620200 C***** THIS SEGMENT USES 5 REAL FUNCTIONS H1620210 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS H1620220 C***** 402, 422, 432, 442, 452 WHICH H1620230 C***** WHICH CONTAINS ALL FUNCTIONS BEING TESTED HERE H1620240 C***** H1620250 C***** S P E C I F I C A T I O N S SEGMENT 162 H1620260 C***** H0014460 C***** WHEN EXECUTING ONLY SEGMENT 162, THE SPECIFICATION STATEMENTS H0014465 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H0014470 C***** IN COLUMNS 1 AND 2 REMOVED. H0014475 C***** H0014480 C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3) H0014485 C= INTEGER I1I(5),I2I(2,2),I3I(2,2,2) H0014490 C= REAL JRFS,IRFS H0014495 C= LOGICAL A1B(2),A2B(2,2),A3B(2,2,2),AVB,BVB H0014500 C= DOUBLE PRECISION AVD,A1D(4),A2D(2,2),A3D(2,2,2) H0014505 C= COMPLEX AVC,BVC,A1C(12),A2C(2,2),A3C(2,2,1) H0014510 C= COMMON AXVS,CXVS H0014515 C= EXTERNAL GFS H0014520 C***** H0014525 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1620270 C***** H0074455 C***** WHEN EXECUTING ONLY SEGMENT 162, THE STATEMENT NUVI = 6 H0074460 C***** MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0074465 C***** H0074470 C= NUVI = 6 H0074475 C***** H0074480 WRITE (NUVI,1624) H1620280 1624 FORMAT(1H1,1X,33HFRFCP - (162) REAL FUNCTIONS WITH/10X,31HLOGICAL,H1620290 1 D.P., AND COMPLEX ARGS//16H ASA REF. 8.3.1// H1620300 228H RESULTS SHOULD BE POSITIVE) H1620310 C*****TEST 1 H1620320 AVD = 1.0D0 H1620330 MAVI = 1 H1620340 IVI = 1.0-GFS(AVD) H1620350 IF (IVI) 1620,1621,1620 H1620360 C*****TEST 2 H1620370 1625 MAVI =2 H1620380 AVC = (1.0,-1.0) H1620390 BVC = (1.0,1.0) H1620400 IVI = HFS(AVC,BVC) H1620410 IF (IVI) 1620,1621,1620 H1620420 C*****TEST 3 H1620430 1626 MAVI=3 H1620440 AVB = .TRUE. H1620450 IVI = IRFS(AVB)*2.0 H1620460 AVB = .FALSE. H1620470 JVI = IRFS(AVB)*4.0 H1620480 LVI = IVI + JVI - 4 H1620490 IF (LVI) 1620,1621,1620 H1620500 C*****TEST 4 H1620510 1627 MAVI=4 H1620520 IVI = JRFS(AVD,GFS) H1620530 IF (IVI-1) 1620,1621,1620 H1620540 C*****TEST 5,6,7 H1620550 1628 AXVS = 1.0 H1620560 AVS = 1.0 H1620570 A1S(1) = 1.0 H1620580 A2S(1,1) = 1.0 H1620590 A3S(1,1,1) = 1.0 H1620600 AVB = .FALSE. H1620610 A1B(1) = .FALSE. H1620620 A2B(1,1) = .FALSE. H1620630 A3B(1,1,1) = .FALSE. H1620640 IAVI = 1 H1620650 I1I(1) = 1 H1620660 I2I(1,1) =1 H1620670 I3I(1,1,1) =1 H1620680 A1C(1) = (1.0,1.0) H1620690 A2C(1,1) = (1.0,1.0) H1620700 A3C(1,1,1) = (-2.0,-2.0) H1620710 AVD = 1.0D0 H1620720 A1D(1) = 1.0D0 H1620730 A2D(1,1) = 1.0D0 H1620740 A3D(1,1,1) = 1.0D0 H1620750 IVI= RFS(AVS,IAVI,AVB,AVC,AVD,A1S,A2S,A3S,I1I,I2I,I3I,A1B,A2B,A3B,H1620760 1 A1C,A2C,A3C,A1D,A2D,A3D,GFS) H1620770 MAVI = 5 H1620780 IF (IVI) 1620,1621,1620 H1620790 1629 MAVI = 6 H1620800 BVB = AVB.AND.A1B(1).AND.A2B(1,1).AND.A3B(1,1,1) H1620810 IF (BVB) GO TO 1621 H1620820 GO TO 1620 H1620830 7010 IVI=REAL(AVC) H1620840 JVI = AIMAG(AVC) H1620850 MAVI = 7 H1620860 BVB = IVI.EQ.0.AND.JVI.EQ.0 H1620870 IF (BVB) GO TO 1621 H1620880 1620 WRITE (NUVI,1622) MAVI H1620890 GO TO 7011 H1620900 1621 WRITE (NUVI,1623) MAVI H1620910 1622 FORMAT(//2X,5HTEST ,I1,13H IS NEGATIVE.) H1620920 1623 FORMAT (//2X,5HTEST ,I1,13H IS POSITIVE.) H1620930 7011 GO TO (1625,1626,1627,1628,1629,7010,7012),MAVI H1620940 7012 CONTINUE H1620950 C***** END OF TEST SEGMENT 162 H1620960 C***** WHEN EXECUTING ONLY SEGMENT 162, THE STOP AND END CARDS H1620970 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1620980 C***** IN COLUMNS 1 AND 2 REMOVED. H1620990 C= STOP H1621000 C= END H1621010 C***********************************************************************H1630010 C***** H1630020 C***** FIFCP - (163) H1630030 C***** H1630040 C***********************************************************************H1630050 C***** GENERAL PURPOSE ASA REF H1630060 C***** 1.TO TEST INTEGER FUNCTIONS IN FULL FORTRAN H1630070 C***** 2.THIS SEGMENT COMPLETES SEGMENT (161) IN ORDER TO TEST H1630080 C***** FOR ALL FEATURES REQUIRED IN FULL FORTRAN. 8.3.1 H1630090 C***** 3.DUMMY ARGUMENTS CAN BE INTEGER(TESTED IN 161),REAL(TESTED H1630100 C***** IN 161),DOUBLE PRECISION,COMPLEX,LOGICAL,OR EXTERNAL PROCEDUREH1630110 C***** 4.DUMMY ARGUMENTS MAY BE REDIFINED IN SUBPROGRAM(ITEM 4) H1630120 C***** 5. IN REFERENCE,ACTUAL ARGUMENTS MAY BE AS IN (161) AND BESIDES H1630130 C***** EXTERNAL PROCEDURE.IN THIS CASE,EXTERNAL PROCEDURE IS H1630140 C***** REFERENCED BY AN EXTERNAL STATEMENT. H1630150 C***** 6. USE CAN BE MADE OF ADJUSTABLE DIMENSION. H1630160 C*****RESTRICTIONS OBSERVED H1630170 C***** 1.ITEMS (1),(2),(3),(5), OF 8.3.1 H1630180 C***** 2 PARAGRAPH 8.3.2,LINE 18 TO END OF PARAGRAPH H1630190 C***** THIS SEGMENT USES 5 INTEGER FUNCTIONS H1630200 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS H1630210 C***** 403, 423, 433, 443, 453 WHICH H1630220 C***** WHICH CONTAINS ALL FUNCTIONS BEING TESTED HERE H1630230 C***** H1630240 C***** S P E C I F I C A T I O N S SEGMENT 163 H1630250 C***** H0014530 C***** WHEN EXECUTING ONLY SEGMENT 163, THE SPECIFICATION STATEMENTS H0014535 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H0014540 C***** IN COLUMNS 1 AND 2 REMOVED. H0014545 C***** H0014550 C= EXTERNAL IFI H0014555 C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3) H0014560 C= INTEGER I1I(5),I2I(2,2),I3I(2,2,2) H0014565 C= LOGICAL AVB,BVB,A1B(2),A2B(2,2),A3B(2,2,2) H0014570 C= DOUBLE PRECISION AVD,A1D(4),A2D(2,2),A3D(2,2,2) H0014575 C= COMPLEX AVC,BVC,A1C(12),A2C(2,2),A3C(2,2,1) H0014580 C= COMMON AXVS,CXVS H0014585 C***** H0014590 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1630260 C***** H0074485 C***** WHEN EXECUTING ONLY SEGMENT 163, THE STATEMENT NUVI = 6 H0074490 C***** MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0074495 C***** H0074500 C= NUVI = 6 H0074505 C***** H0074510 WRITE(NUVI,1634) H1630270 1634 FORMAT (1H1,1X,33HFIFCP - (163) INTEGER FUNCTION IN/ 16X, H1630280 1 12HFULL FORTRAN//2X, H1630290 214HASA REF. 8.3.1//28H RESULTS SHOULD BE POSITIVE) H1630300 C***** TEST 1 H1630310 AVD=1.0D0 H1630320 MAVI=1 H1630330 IVI=1-IFI(AVD) H1630340 IF (IVI) 1630,1631,1630 H1630350 C***** TEST 2 H1630360 1635 MAVI=2 H1630370 AVC=(1.0, 1.0) H1630380 BVC=(1.0,-1.0) H1630390 IVI=JFI(AVC,BVC) H1630400 IF (IVI) 1630,1631,1630 H1630410 C*****TEST 3 H1630420 1636 MAVI=3 H1630430 AVB=.TRUE. H1630440 IVI=KFI(AVB)*2 H1630450 AVB=.FALSE. H1630460 JVI=IVI+KFI(AVB)-4 H1630470 IF (JVI) 1630,1631,1630 H1630480 C***** TEST 4 H1630490 1637 MAVI=4 H1630500 IVI=LFI(AVD,IFI)-1 H1630510 IF (IVI) 1630,1631,1630 H1630520 C***** TESTS 5,6,7 H1630530 1638 AXVS=1.0 H1630540 AVS = 1. H1630550 A1S(1)=1.0 H1630560 A2S(1,1)=1.0 H1630570 A3S(1,1,1)=1.0 H1630580 IAVI=1 H1630590 I1I(1) = 1 H1630600 I2I(1,1)=1 H1630610 I3I(1,1,1)=1 H1630620 A1C(1)=(1.0,1.0) H1630630 A2C(1,1)=(1.0,1.0) H1630640 A3C(1,1,1)=(-2.0,-2.0) H1630650 AVD=1.0D0 H1630660 A1D(1)=1.0D0 H1630670 A2D(1,1)=1.0D0 H1630680 A3D(1,1,1)=1.0D0 H1630690 IVI=MFI(AVS,IAVI,AVB,AVC,AVD,A1S,A2S,A3S,I1I,I2I,I3I,A1B,A2B,A3B, H1630700 1A1C,A2C,A3C,A1D,A2D,A3D,IFI) H1630710 MAVI=5 H1630720 IF (IVI) 1630,1631,1630 H1630730 1639 MAVI=6 H1630740 BVB=AVB.AND.A1B(1).AND.A2B(1,1).AND.A3B(1,1,1) H1630750 IF (BVB) GO TO 1631 H1630760 IF (.NOT.BVB) GO TO 1630 H1630770 7007 IVI=REAL(AVC) H1630780 JVI=AIMAG(AVC) H1630790 MAVI=7 H1630800 IF (IVI+JVI) 1630,1631,1630 H1630810 1630 WRITE(NUVI,1632) MAVI H1630820 GO TO 7008 H1630830 1631 WRITE(NUVI,1633) MAVI H1630840 1632 FORMAT (//2X,5HTEST ,I2,12H IS NEGATIVE) H1630850 1633 FORMAT(//2X,5HTEST , I2,12H IS POSITIVE) H1630860 7008 GO TO (1635,1636,1637,1638,1639,7007,7009),MAVI H1630870 7009 CONTINUE H1630880 C***** END OF TEST SEGMENT 163 H1630890 C***** WHEN EXECUTING ONLY SEGMENT 163, THE STOP AND END CARDS H1630900 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1630910 C***** IN COLUMNS 1 AND 2 REMOVED. H1630920 C= STOP H1630930 C= END H1630940 C***********************************************************************H1640010 C***** H1640020 C***** CFCCP-(164) H1640030 C***** H1640040 C***********************************************************************H1640050 C***** GENERAL PURPOSE ASA REFH1640060 C***** 1.TO TEST COMPLEX FUNCTIONS IN FULL FORTRAN 8.3.1 H1640070 C***** 2.DUMMY ARGUMENTS ARE REAL,INTEGER,COMPLEX,LOGICAL, H1640080 C***** DOUBLE PRECISION,EXTERNAL PROCEDURE,ARRAY NAME. H1640090 C***** 3.FUNCTIONS CONTAIN UP TO 20 ARGUMENTS H1640100 C***** 4.IN REFERENCE ACTUAL ARGUMENTS ARE VARIABLE NAME H1640110 C***** ARRAY NAME,ARRAY ELEMENT NAME,ARITHMETIC EXPRESSION H1640120 C***** EXTERNAL PROCEDURE H1640130 C***** 6.USE CAN BE MADE OF ADJUSTABLE DIMENTION H1640140 C***** 7.ARGUMENTS CAN BE PASSED THROUGH COMMON H1640150 C*****RESTRICTIONS OBSERVED H1640160 C***** 1.ITEMS(2),(3),(4),(5),(6) OF PARAGRAPH H1640170 C***** 2.LAST SENTENCE OF PARAGRAPH 3.2 H1640180 C***** THIS SEGMENT USES 8 COMPLEX FUNCTIONS H1640190 C***** THIS SEGMENT IS TO BE RUN WITH SEGMENTS H1640200 C***** 404, 414, 424, 434, 444, 454, 464 H1640210 C***** WHICH CONTAIN ALL FUNCTIONS BEING TESTED HERE H1640220 C***** H1640230 C***** S P E C I F I C A T I O N S SEGMENT 164 H1640240 C***** H0014595 C***** WHEN EXECUTING ONLY SEGMENT 164, THE SPECIFICATION STATEMENTS H0014600 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H0014605 C***** IN COLUMNS 1 AND 2 REMOVED. H0014610 C***** H0014615 C= DIMENSION A1S(5),A2S(2,2),A3S(3,3,3) H0014620 C= INTEGER I1I(5),I2I(2,2),I3I(2,2,2) H0014625 C= LOGICAL AVB,A1B(2),A3B(2,2,2),A2B(2,2),BVB H0014630 C= DOUBLE PRECISION AVD,A1D(4),A2D(2,2),A3D(2,2,2) H0014635 C= COMPLEX AFC,BFC,CFC,DFC,EFC,FFC,HFC,AVC,BVC H0014640 C= 1,A1C(12),A2C(2,2),A3C(2,2,1) H0014645 C= COMMON AXVS,CXVS H0014650 C= EXTERNAL BFC H0014655 C***** H0014660 C***** O U T P U T T A P E ASSIGNMENT STATEMENT. NO INPUT TAPE. H1640250 C***** H0074515 C***** WHEN EXECUTING ONLY SEGMENT 164, THE STATEMENT NUVI = 6 H0074520 C***** MUST HAVE THE C= IN COLUMNS 1 AND 2 REMOVED. H0074525 C***** H0074530 C= NUVI = 6 H0074535 C***** H0074540 WRITE(NUVI,1641) H1640260 1641 FORMAT(1H1,1X,31HCFCCP - (164) COMPLEX FUNCTIONS//2X, H1640270 1 21HASA REFS. 8.3.1,8.3.2//2X, 7HRESULTS) H1640280 C***** TEST 1 H1640290 BVC=AFC(1.0) H1640300 MAVI=1 H1640310 WRITE(NUVI,1642) BVC,MAVI H1640320 1642 FORMAT(1H0,2F5.1,9H -- TEST ,I2,20H POSITIVE IF 0.0,0.0) H1640330 C***** TEST 2 H1640340 MAVI=2 H1640350 BVC= BFC(1)-(1.0,1.0) H1640360 WRITE(NUVI,1642)BVC,MAVI H1640370 C***** TEST 3 H1640380 MAVI=3 H1640390 A1S(1)=1.0 H1640400 A1S(2)=1.0 H1640410 BVC=CFC(A1S) H1640420 WRITE(NUVI,1642)BVC,MAVI H1640430 C***** TEST 4 H1640440 MAVI=4 H1640450 BVC = DFC (1.D0) H1640460 WRITE(NUVI,1642)BVC,MAVI H1640470 C*****TEST 5 H1640480 MAVI=5 H1640490 AVC=(1.0,1.0) H1640500 BVC=EFC(AVC) H1640510 WRITE(NUVI,1642)BVC,MAVI H1640520 C*****TEST 6 H1640530 MAVI=6 H1640540 AVB=.TRUE. H1640550 BVC=FFC(AVB)-(1.0,1.0) H1640560 WRITE(NUVI,1642)BVC,MAVI H1640570 C***** TEST 7 H1640580 MAVI=7 H1640590 AVB=.FALSE. H1640600 BVC=FFC(AVB) H1640610 WRITE(NUVI,1642)BVC,MAVI H1640620 C***** TEST 8,9,10 H1640630 IVI=1 H1640640 AVD=1.0D0 H1640650 A1D(1)=1.0D0 H1640660 A2D(1,1)=1.0D0 H1640670 A3D(1,1,1)=1.0D0 H1640680 AVS=1.0 H1640690 A1S(1)=1.0 H1640700 A2S(1,1)=1.0 H1640710 A3S(1,1,1)=1.0 H1640720 A1C(1)=(1.0,1.0) H1640730 A2C(1,1)=(1.0,1.0) H1640740 A3C(1,1,1)=(1.0,1.0) H1640750 I1I(1)=1 H1640760 I2I(1,1)=1 H1640770 I3I(1,1,1)=1 H1640780 AVC = (0.0,0.0) H1640790 BVC= HFC(AVS,IVI,AVB,AVC,AVD,A1S,A2S,A3S,I1I,I2I,I3I,A1B,A2B,A3B, H1640800 1A1C,A2C,A3C,A1D,A2D,A3D,BFC) H1640810 MAVI = 8 H1640820 WRITE (NUVI,1642) BVC,MAVI H1640830 MAVI=9 H1640840 IF(AXVS) 1643,1644,1643 H1640850 1648 MAVI = 10 H1640860 BVB=AVB.AND.A1B(1).AND.A2B(1,1).AND. A3B(1,1,1) H1640870 IF (BVB) GO TO 1644 H1640880 1643 WRITE(NUVI,1645)MAVI H1640890 GO TO 1647 H1640900 1644 WRITE(NUVI,1646)MAVI H1640910 1645 FORMAT(/15X,5HTEST ,I2,12H IS NEGATIVE) H1640920 1646 FORMAT(/15X,5HTEST ,I2,12H IS POSITIVE) H1640930 1647 IF (MAVI - 9) 1649,1648,1649 H1640940 1649 CONTINUE H1640950 C***** END OF TEST SEGMENT 164 H1640960 C***** WHEN EXECUTING ONLY SEGMENT 164, THE STOP AND END CARDS H1640970 C***** WHICH APPEAR AS COMMENT CARDS MUST HAVE THE C= H1640980 C***** IN COLUMNS 1 AND 2 REMOVED. H1640990 C= STOP H1641000 C= END H1641010 STOP H9999995 END H9999999 C***********************************************************************H4000010 C***** H4000020 C***** AFS - (400) H4000030 C***** H4000040 C***********************************************************************H4000050 C*****REAL FUNCTION OF REAL ARGUMENT (TEST 1) H4000060 FUNCTION AFS(AWVS) H4000070 AFS=4.0*AWVS H4000080 RETURN H4000090 END H4000100 C***********************************************************************H4200010 C***** H4200020 C***** BFS - (420) H4200030 C***** H4200040 C***********************************************************************H4200050 C*****REAL FUNCTION OF REAL ARGUMENTS (TEST 2) H4200060 FUNCTION BFS(AWVS,BWVS) H4200070 BFS=AWVS+BWVS H4200080 RETURN H4200090 END H4200100 C***********************************************************************H4300010 C***** H4300020 C***** CFS - (430) H4300030 C***** H4300040 C***********************************************************************H4300050 C*****REAL FUNCTION OF INTEGER ARGUMENT (TEST 3) H4300060 FUNCTION CFS(IWVI) H4300070 CFS=4.0**IWVI H4300080 RETURN H4300090 END H4300100 C***********************************************************************H4400010 C***** H4400020 C***** DFS - (440) H4400030 C***** H4400040 C***********************************************************************H4400050 C*****REAL FUNCTION OF INTEGER ARGUMENTS (TEST 4) H4400060 FUNCTION DFS(IWVI,JWVI) H4400070 KVI = IWVI - JWVI H4400080 DFS=4.6**KVI H4400090 RETURN H4400100 END H4400110 C***********************************************************************H4500010 C***** H4500020 C***** EFS - (450) H4500030 C***** H4500040 C***********************************************************************H4500050 C*****REAL FUNCTION OF ARRAY NAME(TEST 5) H4500060 FUNCTION EFS(AW1S) H4500070 DIMENSION AW1S(2) H4500080 EFS=AW1S(1)+AW1S(2) H4500090 RETURN H4500100 END H4500110 C***********************************************************************H4600010 C***** H4600020 C***** FFS - (460) H4600030 C***** H4600040 C***********************************************************************H4600050 C*****REAL FUNCTION OF DIFFERENT TYPES OF ARGUMENTS(TEST 6) H4600060 FUNCTION FFS(IWVI,AWVS,JWVI,BWVS,AW1S,KWVI,CWVS,BW1S,DWVS,LWVI, H4600070 1CW1S,DW1S,EWVS,FWVS,GWVS,BW2S,CW2S,DW2S,HWVS,MWVI) H4600080 DIMENSION AW1S(2),BW1S(2),CW1S(2),DW1S(2),BW2S(2,2),CW2S(2,2), H4600090 1DW2S(2,2) H4600100 FFS=AWVS**IWVI-BWVS**JWVI+AW1S(1)-CWVS**KWVI+BW1S(2)-DWVS+CW1S(1) H4600110 1**LWVI+DW1S(1)-EWVS+FWVS-GWVS+BW2S(2,1)-CW2S(2,2)+DW2S(2,2)-HWVS**H4600120 2MWVI H4600130 RETURN H4600140 END H4600150 C***********************************************************************H4010010 C***** H4010020 C***** IAFI - (401) H4010030 C***** H4010040 C***********************************************************************H4010050 C*****INTEGER FUNCTION OF REAL ARGUMENT (TEST 1) H4010060 FUNCTION IAFI(AWVS) H4010070 IAFI=4.0*AWVS H4010080 RETURN H4010090 END H4010100 C***********************************************************************H4210010 C***** H4210020 C***** IBFI - (421) H4210030 C***** H4210040 C***********************************************************************H4210050 C*****INTEGER FUNCTION OF TWO REAL ARGUMENTS (TEST 2) H4210060 FUNCTION IBFI(AWVS,BWVS) H4210070 IBFI=AWVS+BWVS H4210080 RETURN H4210090 END H4210100 C***********************************************************************H4310010 C***** H4310020 C***** ICFI - (431) H4310030 C***** H4310040 C***********************************************************************H4310050 C*****INTEGER FUNCTION OF INTEGER ARGUMENT(TEST 3) H4310060 FUNCTION ICFI(IWVI) H4310070 ICFI=4.0**IWVI H4310080 RETURN H4310090 END H4310100 C***********************************************************************H4410010 C***** H4410020 C***** IDFI - (441) H4410030 C***** H4410040 C***********************************************************************H4410050 C*****INTEGER FUNCTION OF INTEGER ARGUMENTS (TEST 4) H4410060 INTEGER FUNCTION IDFI (IWVI, JWVI) H4410070 REAL KUVS H4410080 IDFI = IWVI - JWVI H4410090 IDFI = KUVS ** IDFI H4410100 RETURN H4410110 DATA KUVS /4.6/ H4410120 E N D H4410130 C***********************************************************************H4510010 C***** H4510020 C***** IEFI - (451) H4510030 C***** H4510040 C***********************************************************************H4510050 C*****INTEGER FUNCTION OF ARRAY NAME (TEST 5) H4510060 FUNCTION IEFI(IAW1I) H4510070 DIMENSION IAW1I(2) H4510080 IEFI=IAW1I(1)+IAW1I(2) H4510090 RETURN H4510100 END H4510110 C***********************************************************************H4610010 C***** H4610020 C***** IFFI - (461) H4610030 C***** H4610040 C***********************************************************************H4610050 C*****INTEGER FUNCTION OF DIFFERENT TYPES OF ARGUMENTS(TEST 6) H4610060 FUNCTION IFFI(IWVI,AWVS,JWVI,BWVS,AW1S,KWVI,CWVS,BW1S,DWVS,LWVI, H4610070 1CW1S,DW1S,EWVS,FWVS,GWVS,EW1S,GW1S,HW1S,HWVS,MWVI) H4610080 DIMENSION AW1S(2),BW1S(2),CW1S(2),DW1S(2),EW1S(5), GW1S(5), H4610090 1 HW1S(5) H4610100 IFFI=AWVS**IWVI-BWVS**JWVI+AW1S(1)-CWVS**KWVI+BW1S(2)-DWVS+CW1S(1)H4610110 1**LWVI+DW1S(1)-EWVS+FWVS-GWVS+EW1S(1) -GW1S(2) +HW1S(2) -HWVS**H4610120 2MWVI H4610130 RETURN H4610140 END H4610150 C***********************************************************************H4020010 C***** H4020020 C***** GFS - (402) H4020030 C***** H4020040 C***********************************************************************H4020050 C***** REAL FUNCTION OF DOUBLE PRECISION ARGUMENT (TEST 1) H4020060 FUNCTION GFS(AWVD) H4020070 DOUBLE PRECISION AWVD H4020080 GFS = AWVD H4020090 RETURN H4020100 END H4020110 C***********************************************************************H4220010 C***** H4220020 C***** HFS - (422) H4220030 C***** H4220040 C***********************************************************************H4220050 C*****REAL FUNCTION OF COMPLEX ARGUMENT (TEST 2) H4220060 FUNCTION HFS(AWVC,BWVC) H4220070 COMPLEX AWVC,BWVC,CVC H4220080 CVC = AWVC * BWVC H4220090 HFS = AIMAG(CVC) H4220100 RETURN H4220110 END H4220120 C***********************************************************************H4320010 C***** H4320020 C***** IRFS - (432) H4320030 C***** H4320040 C***********************************************************************H4320050 C*****REAL FUNCTION OF LOGICAL ARGUMENT (TEST 3) H4320060 REAL FUNCTION IRFS(AWVB) H4320070 LOGICAL AWVB H4320080 IF (AWVB) GO TO 4321 H4320090 4320 IF (.NOT. AWVB) GO TO 4322 H4320100 RETURN H4320110 4321 IRFS = 2.0 H4320120 GO TO 4320 H4320130 4322 IRFS = 0.0 H4320140 RETURN H4320150 END H4320160 C***********************************************************************H4420010 C***** H4420020 C***** JRFS - (442) H4420030 C***** H4420040 C***********************************************************************H4420050 C*****REAL FUNCTION OF EXTERNAL PROCEDURE (TEST 4) H4420060 REAL FUNCTION JRFS( BWVD,BWFS) H4420070 DOUBLE PRECISION BWVD H4420080 JRFS = BWFS(BWVD) H4420090 RETURN H4420100 END H4420110 C***********************************************************************H4520010 C***** H4520020 C***** RFS - (452) H4520030 C***** H4520040 C***********************************************************************H4520050 C*****REAL FUNCTION OF DIFFERENT TYPES OF ARGUMENTS. USE IS MADE OF H4520060 C*****ADJUSTABLE DIMENSION (TEST 5, 6, 7) H4520070 FUNCTION RFS(AWVS,IWVI,AWVB,AWVC,AWVD,AW1S,AW2S,AW3S,IW1I,IW2I, H4520080 1IW3I,AW1B,AW2B,AW3B,AW1C,AW2C,AW3C,AW1D,AW2D,AW3D,AWFS) H4520090 LOGICAL AWVB,AW1B,AW2B,AW3B H4520100 COMPLEX AWVC,AW1C,AW2C,AW3C H4520110 DOUBLE PRECISION AWVD, AW1D,AW2D,AW3D H4520120 DIMENSION AW1S(IWVI),AW2S(IWVI,IWVI),AW3S(IWVI,IWVI,IWVI) , H4520130 1 IW1I(IWVI),IW2I(IWVI,IWVI),IW3I(IWVI,IWVI,IWVI) , H4520140 2 AW1B(IWVI),AW2B(IWVI,IWVI),AW3B(IWVI,IWVI,IWVI) , H4520150 3 AW1C(IWVI),AW2C(IWVI,IWVI),AW3C(IWVI,IWVI,IWVI) , H4520160 4 AW1D(IWVI),AW2D(IWVI,IWVI),AW3D(IWVI,IWVI,IWVI) H4520170 COMMON BXVS H4520180 RFS =AWVS**IWVI+AW1S(IWVI)**IW1I(IWVI)-AW2S(IWVI,IWVI)**IW2I H4520190 1 (IWVI,IWVI)+AW3S(IWVI,IWVI,IWVI)**IW3I(IWVI,IWVI,IWVI)-AWVD+ H4520200 2 AW1D(IWVI)-AW2D(IWVI,IWVI)-AW3D(IWVI,IWVI,IWVI)+AWFS(AWVD)-BXVS H4520210 AWVB = IWVI.EQ.1 H4520220 AW1B(IWVI) = IWVI .EQ. 1 H4520230 AW2B(IWVI,IWVI) = IWVI .EQ. 1 H4520240 AW3B(IWVI,IWVI,IWVI) = IWVI.EQ.1 H4520250 AWVC = AW1C(IWVI) +AW2C(IWVI,IWVI)+AW3C(IWVI,IWVI,IWVI) H4520260 RETURN H4520270 C***** END OF TEST SEGMENT 402 H4520280 END H4520290 C***********************************************************************H4030010 C***** H4030020 C***** IFI - (403) H4030030 C***** H4030040 C***********************************************************************H4030050 C***** INTEGER FUNCTION OF DOUBLE PRECISION ARGUMENT(TEST 1) H4030060 FUNCTION IFI(AWVD) H4030070 DOUBLE PRECISION AWVD H4030080 IFI=AWVD H4030090 RETURN H4030100 END H4030110 C***********************************************************************H4230010 C***** H4230020 C***** JFI - (423) H4230030 C***** H4230040 C***********************************************************************H4230050 C*****INTEGER FUNCTION OF COMPLEX ARGUMENT(TEST 2) H4230060 FUNCTION JFI(AWVC,BWVC) H4230070 COMPLEX AWVC,BWVC,CVC H4230080 CVC =AWVC*BWVC H4230090 JFI=AIMAG(CVC) H4230100 RETURN H4230110 END H4230120 C***********************************************************************H4330010 C***** H4330020 C***** KFI - (433) H4330030 C***** H4330040 C***********************************************************************H4330050 C*****INTEGER FUNCTION OF LOGICAL ARGUMENT(TEST 3) H4330060 FUNCTION KFI(AWVB) H4330070 LOGICAL AWVB H4330080 IF (AWVB) GO TO 4331 H4330090 4330 IF (.NOT.AWVB) GO TO 4332 H4330100 RETURN H4330110 4331 KFI = 2 H4330120 GO TO 4330 H4330130 4332 KFI = 0 H4330140 RETURN H4330150 END H4330160 C***********************************************************************H4430010 C***** H4430020 C***** LFI - (443) H4430030 C***** H4430040 C***********************************************************************H4430050 C*****INTEGER FUNCTION OF EXTERNAL PROCEDURE(TEST 4) H4430060 FUNCTION LFI(BWVD,IWFI) H4430070 DOUBLE PRECISION BWVD H4430080 LFI=IWFI(BWVD) H4430090 RETURN H4430100 END H4430110 C***********************************************************************H4530010 C***** H4530020 C***** MFI - (453) H4530030 C***** H4530040 C***********************************************************************H4530050 C*****INTEGER FUNCTION OF DIFFERENT TYPES OF ARGUMENTS.USE IS MADE OF H4530060 C***** ADJUSTABLE DIMENSION(TEST 5,6,7) H4530070 FUNCTION MFI(AWVS,IWVI,AWVB,AWVC,AWVD,AW1S,AW2S,AW3S,IW1I,IW2I, H4530080 1IW3I,AW1B,AW2B,AW3B,AW1C,AW2C,AW3C,AW1D,AW2D,AW3D,IWFI) H4530090 DOUBLE PRECISION AWVD,AW1D,AW2D,AW3D H4530100 LOGICAL AWVB,AW1B,AW2B,AW3B H4530110 COMPLEX AWVC,AW1C,AW2C,AW3C H4530120 DIMENSION AW1S(IWVI),AW2S(IWVI,IWVI),AW3S(IWVI,IWVI,IWVI) , H4530130 1 IW1I(IWVI),IW2I(IWVI,IWVI),IW3I(IWVI,IWVI,IWVI) , H4530140 2 AW1B(IWVI),AW2B(IWVI,IWVI),AW3B(IWVI,IWVI,IWVI), H4530150 3 AW1C(IWVI),AW2C(IWVI,IWVI),AW3C(IWVI,IWVI,IWVI) , H4530160 4 AW1D(IWVI),AW2D(IWVI,IWVI),AW3D(IWVI,IWVI,IWVI) H4530170 COMMON BXVS H4530180 MFI =AWVS**IWVI+AW1S(IWVI)**IW1I(IWVI)-AW2S(IWVI,IWVI)**IW2I H4530190 1 (IWVI,IWVI)+AW3S(IWVI,IWVI,IWVI)**IW3I(IWVI,IWVI,IWVI)-AWVD+ H4530200 2 AW1D(IWVI)-AW2D(IWVI,IWVI)-AW3D(IWVI,IWVI,IWVI)+BXVS**IWFI(AWVD) H4530210 3 -1.0 H4530220 AWVB=IWVI.EQ.1 H4530230 AW1B(IWVI) = IWVI .EQ. 1 H4530240 AW2B(IWVI,IWVI) = IWVI.EQ.1 H4530250 AW3B(IWVI,IWVI,IWVI) = IWVI.EQ.1 H4530260 AWVC = AW1C(IWVI) +AW2C(IWVI,IWVI)+AW3C(IWVI,IWVI,IWVI) H4530270 RETURN H4530280 END H4530290 C***********************************************************************H4040010 C***** H4040020 C***** AFC - (404) H4040030 C***** H4040040 C***********************************************************************H4040050 C*****COMPLEX FUNCTION OF REAL ARGUMENT (TEST 1) H4040060 COMPLEX FUNCTION AFC(AWVS) H4040070 AFC = (-1.0,0.0)+AWVS H4040080 RETURN H4040090 END H4040100 C***********************************************************************H4140010 C***** H4140020 C***** BFC - (414) H4140030 C***** H4140040 C***********************************************************************H4140050 C*****COMPLEX FUNCTION OF INTEGER ARGUMENT (TEST 2) H4140060 COMPLEX FUNCTION BFC(IWVI) H4140070 BFC=(1.0,1.0)**IWVI H4140080 RETURN H4140090 END H4140100 C***********************************************************************H4240010 C***** H4240020 C***** CFC - (424) H4240030 C***** H4240040 C***********************************************************************H4240050 C*****COMPLEX FUNCTION OF ARRAY NAME (TEST 3) H4240060 COMPLEX FUNCTION CFC(AW1S) H4240070 DIMENSION AW1S(2) H4240080 CFC = (2.0,0.0)-AW1S(1)-AW1S(2) H4240090 RETURN H4240100 END H4240110 C***********************************************************************H4340010 C***** H4340020 C***** DFC - (434) H4340030 C***** H4340040 C***********************************************************************H4340050 C*****COMPLEX FUNCTION OF DOUBLE PRECISION ARGUMENT (TEST 4) H4340060 COMPLEX FUNCTION DFC(AWVD) H4340070 DOUBLE PRECISION AWVD H4340080 AVS = AWVD H4340090 DFC = (1.0,1.0) * AVS - (1.0,1.0) H4340100 RETURN H4340110 END H4340120 C***********************************************************************H4440010 C***** H4440020 C***** EFC - (444) H4440030 C***** H4440040 C***********************************************************************H4440050 C*****COMPLEX FUNCTION OF COMPLEX ARGUMENT (TEST 5) H4440060 COMPLEX FUNCTION EFC(AWVC) H4440070 COMPLEX AWVC H4440080 EFC=AWVC- (1.0,1.0) H4440090 RETURN H4440100 END H4440110 C***********************************************************************H4540010 C***** H4540020 C***** FFC - (454) H4540030 C***** H4540040 C*****COMPLEX FUNCTION OF LOGICAL ARGUMENT(TESTS 6,7) H4540050 COMPLEX FUNCTION FFC(AWVB) H4540060 LOGICAL AWVB H4540070 IF (AWVB) GO TO 4541 H4540080 4540 IF (.NOT.AWVB) GO TO 4542 H4540090 RETURN H4540100 4541 FFC = (1.0,1.0) H4540110 GO TO 4540 H4540120 4542 FFC = (0.0,0.0) H4540130 RETURN H4540140 END H4540150 C***********************************************************************H4640010 C***** H4640020 C***** HFC - (464) H4640030 C***** H4640040 C***********************************************************************H4640050 C*****COMPLEX FUNCTION OF DIFFERENT TYPES OF ARGUMENTS (TESTS 8,9,10 H4640060 COMPLEX FUNCTION HFC(AWVS,IWVI,AWVB,AWVC,AWVD,AW1S,AW2S,AW3S, H4640070 1 IW1I,IW2I,IW3I,AW1B,AW2B,AW3B,AW1C,AW2C,AW3C,AW1D,AW2D,AW3D,AWFC)H4640080 DIMENSION AW1S(IWVI),AW2S(IWVI,IWVI),AW3S(IWVI,IWVI,IWVI), H4640090 1 IW1I(IWVI),IW2I(IWVI,IWVI),IW3I(IWVI,IWVI,IWVI), H4640100 2 AW1B(IWVI),AW2B(IWVI,IWVI),AW3B(IWVI,IWVI,IWVI), H4640110 3 AW1C(IWVI),AW2C(IWVI,IWVI),AW3C(IWVI,IWVI,IWVI), H4640120 4 AW1D(IWVI),AW2D(IWVI,IWVI),AW3D(IWVI,IWVI,IWVI) H4640130 COMMON BXVS H4640140 LOGICAL AWVB,AW1B,AW2B,AW3B H4640150 COMPLEX AWVC,AW1C,AW2C,AW3C, AWFC H4640160 DOUBLE PRECISION AWVD,AW1D,AW2D,AW3D H4640170 HFC = AWVC H4640180 BXVS=AWVS**IWVI+AW1S(IWVI)**IW1I(IWVI)-AW2S(IWVI,IWVI)**IW2I H4640190 1 (IWVI,IWVI)+AW3S(IWVI,IWVI,IWVI)**IW3I(IWVI,IWVI,IWVI)-AWVD+ H4640200 2 AW1D(IWVI)-AW2D(IWVI,IWVI)-AW3D(IWVI,IWVI,IWVI) H4640210 AWVB = IWVI.EQ.1 H4640220 AW1B(IWVI) = IWVI.EQ.1 H4640230 AW2B(IWVI,IWVI) = IWVI .EQ. 1 H4640240 AW3B(IWVI,IWVI,IWVI) = IWVI.EQ.1 H4640250 RETURN H4640260 C***** END OF TEST SEGMENT 464 H4640270 END H4640280