Test Program for Powerstation and Microsoft Fortran
===================================
C Test program for Powerstation and Microsoft Fortran.
C From Alison Boeckmann, Nonmem Project Group, Jan. 1994
c Compile and run with each of three sets of options:
C /Ox
C /Ox /Op
C no optimization
C After each run, copy "testout.txt" to a uniquely-named file.
C All three output files should be identical.
PROGRAM TEST
INTEGER ICALL
INTEGER NEWIND
DOUBLE PRECISION THETA(5)
REAL DATREC(9)
INTEGER INDXS(20)
DOUBLE PRECISION F,G(10,10),H(10,10)
INTEGER NETAS,NEPS
DATA THETA/0.03,0.15,0.1,1.0,2/
DATA DATREC/102,1,1802,60,0.50,6.210,1,0,0/
NETAS=5
NEPS=1
ICALL=2
NEWIND=1
CALL PRED(ICALL,NEWIND,THETA,DATREC(1),INDXS,F,G,H)
OPEN (8,FILE='TESTOUT.TXT')
WRITE (8,999) F
WRITE (8,999) (G(I,1),I=1,NETAS),
X ((G(I,J+1),J=1,I),I=1,NETAS)
WRITE (8,999) (H(I,1),(H(I,J+1),J=1,NETAS),I=1,NEPS)
999 FORMAT (5(E16.8))
END
SUBROUTINE GETETA(ETA)
DIMENSION ETA(10)
DO 10 I=1,10
ETA(I)=0.0
10 CONTINUE
RETURN
END
SUBROUTINE SIMETA(ETA)
DOUBLE PRECISION ETA(10)
RETURN
END
SUBROUTINE SIMEPS(EPS)
DOUBLE PRECISION EPS(10)
RETURN
END
SUBROUTINE PRED (ICALL,NEWIND,THETA,DATREC,INDXS,F,G,H)
IMPLICIT DOUBLE PRECISION (A-Z)
REAL DATREC
SAVE
INTEGER ICALL,NEWIND,INDXS
DIMENSION THETA(*),DATREC(*),INDXS(*),G(10,*),H(10,*)
DIMENSION ETA(10),EPS(10)
COMMON/NMPRD1/IERPRD,NETEXT
COMMON/NMPRD2/ETEXT(3)
INTEGER IERPRD,NETEXT
CHARACTER*132 ETEXT
COMMON/ROCM12/MSEC
INTEGER MSEC
COMMON/NMPRD4/A1,AL1,A2,AL2,KA,T1,FF1,F1,FF2,F2,CT,Y,A00012
COMMON/NMPRD4/A00014,A00016,A00018,A00020,A00026,A00029,A00033
COMMON/NMPRD4/A00034,A00040,A00043,A00047,A00048,A00058,A00059
COMMON/NMPRD4/A00055,A00056,A00057,A00066,A00065,A00069,A00068
COMMON/NMPRD4/A00067,C00011,A00071,A00070,A00074,A00073,A00072
COMMON/NMPRD4/BBBBBB(0959)
IF (ICALL.EQ.4) THEN
IF (NEWIND.NE.2) CALL SIMETA(ETA)
CALL SIMEPS(EPS)
ELSE
IF (NEWIND.NE.2) THEN
CALL GETETA(ETA)
EPS(01)=0.D0
ENDIF
ENDIF
DOS=DATREC(04)
TIME=DATREC(05)
B00001=DEXP(ETA(01))
A1=THETA(01)*B00001
A00012=THETA(01)*B00001
B00002=DEXP(ETA(02))
AL1=THETA(02)*B00002
A00014=THETA(02)*B00002
B00003=DEXP(ETA(03))
A2=THETA(03)*B00003
A00016=THETA(03)*B00003
B00004=DEXP(ETA(04))
AL2=THETA(04)*B00004
A00018=THETA(04)*B00004
B00005=DEXP(ETA(05))
KA=THETA(05)*B00005
A00020=THETA(05)*B00005
IF(KA.LT.AL1)THEN
IERPRD=1
RETURN
ENDIF
IF(KA.LT.AL2)THEN
IERPRD=1
RETURN
ENDIF
T1=TIME
B00006=-AL1*T1
B00007=-KA*T1
B00008=DEXP(B00006)
B00009=DEXP(B00007)
FF1=B00008-B00009
A00021=-T1*A00014
A00022=-T1*A00020
A00023=B00008*A00021
A00024=B00009*A00022
A00026=-A00024
B00010=KA-AL1
F1=A1*FF1*KA/B00010
A00028=-A00014
B00011=FF1*KA/B00010
A00029=B00011*A00012
B00012=A1*KA/B00010
A00030=B00012*A00026
A00031=B00012*A00023
B00013=A1*FF1/B00010
A00032=B00013*A00020+A00030
B00014=-A1*FF1*KA/B00010/B00010
A00033=B00014*A00028+A00031
A00034=B00014*A00020+A00032
B00015=-AL2*T1
B00016=-KA*T1
B00017=DEXP(B00015)
B00018=DEXP(B00016)
FF2=B00017-B00018
A00035=-T1*A00018
A00036=-T1*A00020
A00037=B00017*A00035
A00038=B00018*A00036
A00040=-A00038
B00019=KA-AL2
F2=A2*FF2*KA/B00019
A00042=-A00018
B00020=FF2*KA/B00019
A00043=B00020*A00016
B00021=A2*KA/B00019
A00044=B00021*A00040
A00045=B00021*A00037
B00022=A2*FF2/B00019
A00046=B00022*A00020+A00044
B00023=-A2*FF2*KA/B00019/B00019
A00047=B00023*A00042+A00045
A00048=B00023*A00020+A00046
B00024=F1+F2
CT=DOS*B00024
A00052=A00048+A00034
A00055=DOS*A00043
A00056=DOS*A00047
A00057=DOS*A00052
A00058=DOS*A00029
A00059=DOS*A00033
Y=CT+CT*EPS(01)
A00060=A00059
A00061=A00058
A00062=A00057
A00063=A00056
A00064=A00055
A00065=EPS(01)*A00059+A00060
A00066=EPS(01)*A00058+A00061
A00067=EPS(01)*A00057+A00062
A00068=EPS(01)*A00056+A00063
A00069=EPS(01)*A00055+A00064
C00011=CT
A00070=A00059
A00071=A00058
A00072=A00057
A00073=A00056
A00074=A00055
G(01,1)=A00066
G(02,1)=A00065
G(03,1)=A00069
G(04,1)=A00068
G(05,1)=A00067
H(01,1)=C00011
H(01,02)=A00071
H(01,03)=A00070
H(01,04)=A00074
H(01,05)=A00073
H(01,06)=A00072
F=Y
RETURN
END