C ECMWF PERFORMANCE EVALUATION TEST 21 PROGRAM SCK SCK 1
PROGRAM SCK
COMMON T,T1,T2,E1(4),J,K,L SCK 2
T=0.499975 SCK 3
T1=0.50025 SCK 4
T2=2.0 SCK 5
I = 1000
N1=0 SCK 8
N2=12*I SCK 9
N3=14*I SCK 10
N4=345*I SCK 11
N5=0 SCK 12
N6=210*I SCK 13
N7=32*I SCK 14
N8=899*I SCK 15
N9=616*I SCK 16
N10=0 SCK 17
N11=93*I SCK 18
N12=0 SCK 19
X1=1.0 SCK 20
X2=-1.0 SCK 21
X3=-1.0 SCK 22
X4=-1.0 SCK 23
IF(N1)19,19,11 SCK 24
11 DO 18 I=1,N1,1 SCK 25
X1=(X1+X2+X3-X4)*T SCK 26
X2=(X1+X2-X3+X4)*T SCK 27
X3=(X1-X2+X3+X4)*T SCK 28
X4=(-X1+X2+X3+X4)*T SCK 29
18 CONTINUE SCK 30
19 CONTINUE SCK 31
CALL POUT(N1,N1,N1,X1,X2,X3,X4) SCK 32
E1(1)=1.0 SCK 33
E1(2)=-1.0 SCK 34
E1(3)=-1.0 SCK 35
E1(4)=-1.0 SCK 36
IF(N2)29,29,21 SCK 37
21 DO 28 I=1,N2,1 SCK 38
E1(1)=(E1(1)+E1(2)+E1(3)-E1(4))*T SCK 39
E1(2)=(E1(1)+E1(2)-E1(3)+E1(4))*T SCK 40
E1(3)=(E1(1)-E1(2)+E1(3)+E1(4))*T SCK 41
E1(4)=(-E1(1)+E1(2)+E1(3)+E1(4))*T SCK 42
28 CONTINUE SCK 43
29 CONTINUE SCK 44
CALL POUT(N2,N3,N2,E1(1),E1(2),E1(3),E1(4)) SCK 45
IF(N3)39,39,31 SCK 46
31 DO 38 I=1,N3,1 SCK 47
38 CALL PA(E1) SCK 48
39 CONTINUE SCK 49
CALL POUT(N3,N2,N2,E1(1),E1(2),E1(3),E1(4)) SCK 50
J=1 SCK 51
IF(N4)49,49,41 SCK 52
41 DO 48 I=1,N4,1 SCK 53
IF(J-1)43,42,43 SCK 54
42 J=2 SCK 55
GO TO 44 SCK 56
43 J=3 SCK 57
44 IF(J-2)46,46,45 SCK 58
45 J=0 SCK 59
GO TO 47 SCK 60
46 J=1 SCK 61
47 IF(J-1)411,412,412 SCK 62
411 J=1 SCK 63
GO TO 48 SCK 64
412 J=0 SCK 65
48 CONTINUE SCK 66
49 CONTINUE SCK 67
CALL POUT(N4,J,J,X1,X2,X3,X4) SCK 68
J=1 SCK 69
K=2 SCK 70
L=3 SCK 71
IF(N6)69,69,61 SCK 72
61 DO 68 I=1,N6,1 SCK 73
J=J*(K-J)*(L-K) SCK 74
K=L*K-(L-J)*K SCK 75
L=(L-K)*(K+J) SCK 76
E1(L-1)=J+K+L SCK 77
E1(K-1)=J*K*L SCK 78
68 CONTINUE SCK 79
69 CONTINUE SCK 80
CALL POUT(N6,J,K,E1(1),E1(2),E1(3),E1(4)) SCK 81
C X=0.5 SCK 82
C Y=0.5 SCK 83
C IF(N7)79,79,71 SCK 84
C 71 DO 78 I=1,N7,1 SCK 85
C X=T*ATAN(T2*SIN(X)*COS(X)/(COS(X+Y)+COS(X-Y)-1.0)) SCK 86
C Y=T*ATAN(T2*SIN(Y)*COS(Y)/(COS(X+Y)+COS(X-Y)-1.0)) SCK 87
C 78 CONTINUE SCK 88
C 79 CONTINUE SCK 89
C CALL POUT(N7,J,K,X,X,Y,Y) SCK 90
X=1.0 SCK 91
Y=1.0 SCK 92
Z=1.0 SCK 93
IF(N8)89,89,81 SCK 94
81 DO 88 I=1,N8,1 SCK 95
88 CALL P3(X,Y,Z) SCK 96
89 CONTINUE SCK 97
CALL POUT(N8,J,K,X,Y,Z,Z) SCK 98
J=1 SCK 99
K=2 SCK 100
L=3 SCK 101
E1(1)=1.0 SCK 102
E1(2)=2.0 SCK 103
E1(3)=3.0 SCK 104
IF(N9)99,99,91 SCK 105
91 DO 98 I=1,N9,1 SCK 106
98 CALL P0 SCK 107
99 CONTINUE SCK 108
CALL POUT(N9,J,K,E1(1),E1(2),E1(3),E1(4)) SCK 109
J=2 SCK 110
K=3 SCK 111
IF(N10)109,109,101 SCK 112
101 DO 108 I=1,N10,1 SCK 113
J=J+K SCK 114
K=J+K SCK 115
J=J-K SCK 116
K=K-J-J SCK 117
108 CONTINUE SCK 118
109 CONTINUE SCK 119
CALL POUT(N10,J,K,X1,X2,X3,X4) SCK 120
C X=0.75 SCK 121
C IF(N11)119,119,111 SCK 122
C 111 DO 118 I=1,N11,1 SCK 123
C 118 X=SQRT(EXP(ALOG(X)/T1)) SCK 124
C 119 CONTINUE SCK 125
C CALL POUT(N11,J,K,X,X,X,X) SCK 126
STOP SCK 127
END SCK 128
SUBROUTINE PA(E) SCK 129
COMMON T,T1,T2 SCK 130
DIMENSION E(4) SCK 131
J=0 SCK 132
1 E(1)=(E(1)+E(2)+E(3)-E(4))*T SCK 133
E(2)=(E(1)+E(2)-E(3)+E(4))*T SCK 134
E(3)=(E(1)-E(2)+E(3)+E(4))*T SCK 135
E(4)=(-E(1)+E(2)+E(3)+E(4))/T2 SCK 136
J=J+1 SCK 137
IF(J-6)1,2,2 SCK 138
2 CONTINUE SCK 139
RETURN SCK 140
END SCK 141
SUBROUTINE P0 SCK 142
COMMON T,T1,T2,E1(4),J,K,L SCK 143
E1(J)=E1(K) SCK 144
E1(K)=E1(L) SCK 145
E1(L)=E1(J) SCK 146
RETURN SCK 147
END SCK 148
SUBROUTINE P3(X,Y,Z) SCK 149
COMMON T,T1,T2 SCK 150
X1=X SCK 151
Y1=Y SCK 152
X1=T*(X1+Y1) SCK 153
Y1=T*(X1+Y1) SCK 154
Z=(X1+Y1)/T2 SCK 155
RETURN SCK 156
END SCK 157
SUBROUTINE POUT(N,J,K,X1,X2,X3,X4)
PRINT *,N,J,K
PRINT *,X1,X2,X3,X4
RETURN
END