Trailing-Edge
-
PDP-10 Archives
-
DEC-20-OT20A-D-MC9
-
2-exercise-libary/ctestf.for
There are no other files named ctestf.for in the archive.
COMMON/BLOCK5/A1,B1,C1
COMMON/BLOCK1/LA,LB,LC,LD/BLOCK2/COMPL1
COMMON /BLOCK3/STERN,BLANK,KOMMA,DPKT/BLOCK4/TEXT(4),Z
DIMENSION A(10)
COMPLEX FCPLX
COMPLEX COMPL1(10),COMPL2(10)
LOGICAL LA,LB,LC,LD,F(4),LOG
LOGICAL FLOGIC
DOUBLE PRECISION FDBLPR,DX
DOUBLE PRECISION Z,Z1(10)
DO 2 I=1,10
2 COMPL2(I)=FCPLX(I,COMPL2)
WRITE(6,3)((COMPL1(I),COMPL2(I)),I=1,10)
3 FORMAT(1H ,2F7.5,5X,2F7.5)
DO 4 I=1,10
4 A(I)=FUNC(I)
WRITE(6,5) (A(I),I=1,10)
5 FORMAT(1H ,(F8.3,3X))
DO 6 I=1,4
Z1(I)=FDBLPR(I)
6 F(I)=FLOGIC(I)
WRITE(6,7) (F(I),I=1,4)
7 FORMAT(1H ,4(L5,3X))
WRITE(6,8) (Z1(I),I=1,4)
8 FORMAT(1H ,4(1PD22.16))
NMAX=10
CALL SUBROU(NMAX,LOG,A)
IF(LOG) CALL EQUIV
CALL VARFOR
CALL UNIT
DX=Z+SIN(3.5)
X=Z+SIN(3.5)
WRITE(6,9) X,DX
9 FORMAT(1H ,1E12.4,4X,1D22.16)
STOP
END
!@ELT,IL PF.FDBLPR
DOUBLE PRECISION FUNCTION FDBLPR(I)
COMMON/BLOCK4/TEXT(4),Z
II=II+1
IF(II.GT.1) GO TO 6
WRITE(6,5) (TEXT(K),K=1,4)
5 FORMAT(1H ,4A6)
6 GO TO (1,2,3,4),I
1 FDBLPR=Z*21.987654321
RETURN
2 FDBLPR=Z*.203D0
RETURN
3 FDBLPR=Z*5.0D3
RETURN
4 FDBLPR=Z*5D2
RETURN
END
!@ELT,IL PF.FLOGIC
LOGICAL FUNCTION FLOGIC(K)
COMMON /BLOCK1/LA,LB,LC,LD
LOGICAL LA,LB,LC,LD
GO TO (1,2,3,4),K
1 FLOGIC=.NOT.LA
RETURN
2 FLOGIC=.NOT.LB
RETURN
3 FLOGIC=.NOT.LC
RETURN
4 FLOGIC=.NOT.LD
RETURN
END
!@ELT,IL PF.FUNC .
REAL FUNCTION FUNC(I)
DIMENSION B(10)
EXTERNAL SIN,COS,SQRT
DATA B/1.,2.,3.,4.,5.,6.,7.,8.,9.,10./
FUNC=B(I)*I
II=II+1
IF(II.GT.1) RETURN
CALL EXTERN(SIN,B,1,ERG)
WRITE(6,1) ERG
CALL EXTERN(COS,B,-2,ERG)
WRITE(6,1) ERG
CALL EXTERN(SQRT,B,3,ERG)
WRITE(6,1) ERG
1 FORMAT(1H ,F14.8)
RETURN
END
!@ELT,IL PF.FCPLX .
COMPLEX FUNCTION FCPLX(I,COMPL2)
COMMON /BLOCK2/COMPL1
COMPLEX COMPL1(10),HILF,COMPL2(10)
HILF=COMPL1(I)
COMPL1(I)=COMPL2(I)
FCPLX=HILF
RETURN
END