SUBROUTINE NLWEIGT (ml,kl, 1,2NLWEIGT.4
*CALL ARGWVAL 
NLWEIGT.5
*CALL ARGWVFD NLWEIGT.6
*CALL ARGWVNL NLWEIGT.7
& icode) NLWEIGT.8
NLWEIGT.9
*CALL PARCONS NLWEIGT.10
C* *PARAMETER* FOR DISCRETE APPROXIMATION OF NONLINEAR TRANSFER NLWEIGT.11
C NLWEIGT.12
PARAMETER (ALAMD=0.25, CON=3000., DELPHI1=-11.48, DELPHI2=33.56) NLWEIGT.13
PARAMETER (CO = 1.1) NLWEIGT.14
NLWEIGT.15
*CALL TYPWVFD NLWEIGT.16
*CALL TYPWVNL NLWEIGT.17
*CALL TYPWVAL NLWEIGT.18
NLWEIGT.19
C ---------------------------------------------------------------------- NLWEIGT.20
C NLWEIGT.21
C**** *NLWEIGT* - COMPUTATION OF INDEX ARRAYS AND WEIGHTS FOR THE NLWEIGT.22
C COMPUTATION OF THE NONLINEAR TRANSFER RATE. NLWEIGT.23
C NLWEIGT.24
C SUSANNE HASSELMANN JUNE 86. NLWEIGT.25
C NLWEIGT.26
C H. GUNTHER ECMWF/GKSS DECEMBER 90 - CYCLE_4 MODIFICATIONS. NLWEIGT.27
C 4 FREQUENCIES ADDED. NLWEIGT.28
C NLWEIGT.29
C* PURPOSE. NLWEIGT.30
C -------- NLWEIGT.31
C NLWEIGT.32
C COMPUTATION OF PARAMETERS USED IN DISCRETE INTERACTION NLWEIGT.33
C PARAMETERIZATION OF NONLINEAR TRANSFER. NLWEIGT.34
C NLWEIGT.35
C** INTERFACE. NLWEIGT.36
C ---------- NLWEIGT.37
C NLWEIGT.38
C *CALL* *NLWEIGT (ML, KL)* NLWEIGT.39
C *ML* INTEGER NUMBER OF FREQUENCIES. NLWEIGT.40
C *KL* INTEGER NUMBER OF DIRECTIONS. NLWEIGT.41
C NLWEIGT.42
C METHOD. NLWEIGT.43
C ------- NLWEIGT.44
C NLWEIGT.45
C NONE. NLWEIGT.46
C NLWEIGT.47
C EXTERNALS. NLWEIGT.48
C ---------- NLWEIGT.49
C NLWEIGT.50
C *JAFU* - FUNCTION FOR COMPUTATION OF ANGULAR INDICES NLWEIGT.51
C OF K(F,THET). NLWEIGT.52
C NLWEIGT.53
C REFERENCE. NLWEIGT.54
C ---------- NLWEIGT.55
C S. HASSELMANN AND K. HASSELMANN, JPO, 1985 B. NLWEIGT.56
C NLWEIGT.57
C NLWEIGT.58
C ---------------------------------------------------------------------- NLWEIGT.59
C NLWEIGT.60
C* *PARAMETER* FOR DISCRETE APPROXIMATION OF NONLINEAR TRANSFER NLWEIGT.61
C NLWEIGT.62
C* VARIABLE. TYPE. PURPOSE. NLWEIGT.63
C --------- ------- -------- NLWEIGT.64
C *ALAMD* REAL LAMBDA NLWEIGT.65
C *CON* REAL WEIGHT FOR DISCRETE APPROXIMATION OF NLWEIGT.66
C NONLINEAR TRANSFER NLWEIGT.67
C *DELPHI1* REAL NLWEIGT.68
C *DELPHI2* REAL NLWEIGT.69
C NLWEIGT.70
C ---------------------------------------------------------------------- NLWEIGT.71
C NLWEIGT.72
C* VARIABLE. TYPE. PURPOSE. NLWEIGT.73
C --------- ------- -------- NLWEIGT.74
C *CO* REAL FREQUENCY RATIO. NLWEIGT.75
C NLWEIGT.76
C ---------------------------------------------------------------------- NLWEIGT.77
C NLWEIGT.78
DIMENSION JA1(NANG,2), JA2(NANG,2), FRLON(2*NFRE+2) NLWEIGT.79
C NLWEIGT.80
iu06=6 NLWEIGT.81
C ---------------------------------------------------------------------- NLWEIGT.82
C NLWEIGT.83
C* 1. COMPUTATION FOR ANGULAR GRID. NLWEIGT.84
C ----------------------------- NLWEIGT.85
C NLWEIGT.86
1000 CONTINUE NLWEIGT.87
C NLWEIGT.88
DELTHA = DELTH*DEG NLWEIGT.89
CL1 = DELPHI1/DELTHA NLWEIGT.90
CL2 = DELPHI2/DELTHA NLWEIGT.91
C NLWEIGT.92
C* 1.1 COMPUTATION OF INDICES OF ANGULAR CELL. NLWEIGT.93
C --------------------------------------- NLWEIGT.94
C NLWEIGT.95
KLP1 = KL+1 NLWEIGT.96
IC = 1 NLWEIGT.97
DO 1001 KH=1,2 NLWEIGT.98
KLH = KL NLWEIGT.99
IF (KH.EQ.2) KLH=KLP1 NLWEIGT.100
DO 1002 K=1,KLH NLWEIGT.101
KS = K NLWEIGT.102
IF (KH.GT.1) KS=KLP1-K+1 NLWEIGT.103
IF (KS.GT.KL) GO TO 1002 NLWEIGT.104
CH = IC*CL1 NLWEIGT.105
JA1(KS,KH) = JAFU(CH,K,KLP1) NLWEIGT.106
CH = IC*CL2 NLWEIGT.107
JA2(KS,KH) = JAFU(CH,K,KLP1) NLWEIGT.108
1002 CONTINUE NLWEIGT.109
IC = -1 NLWEIGT.110
1001 CONTINUE NLWEIGT.111
C NLWEIGT.112
C* 1.2 COMPUTATION OF ANGULAR WEIGHTS. NLWEIGT.113
C ------------------------------- NLWEIGT.114
C NLWEIGT.115
ICL1 = CL1 NLWEIGT.116
CL1 = CL1-ICL1 NLWEIGT.117
ICL2 = CL2 NLWEIGT.118
CL2 = CL2-ICL2 NLWEIGT.119
ACL1 = ABS(CL1) NLWEIGT.120
ACL2 = ABS(CL2) NLWEIGT.121
CL11 = 1.-ACL1 NLWEIGT.122
CL21 = 1.-ACL2 NLWEIGT.123
AL11 = (1.+ALAMD)**4 NLWEIGT.124
AL12 = (1.-ALAMD)**4 NLWEIGT.125
DAL1 = 1./AL11 NLWEIGT.126
DAL2 = 1./AL12 NLWEIGT.127
C NLWEIGT.128
C* 1.3 COMPUTATION OF ANGULAR INDICES. NLWEIGT.129
C ------------------------------- NLWEIGT.130
C NLWEIGT.131
ISG = 1 NLWEIGT.132
DO 1301 KH=1,2 NLWEIGT.133
CL1H = ISG*CL1 NLWEIGT.134
CL2H = ISG*CL2 NLWEIGT.135
DO 1302 K=1,KL NLWEIGT.136
KS = K NLWEIGT.137
IF (KH.EQ.2) KS = KL-K+2 NLWEIGT.138
IF(K.EQ.1) KS = 1 NLWEIGT.139
K1 = JA1(K,KH) NLWEIGT.140
K1W(KS,KH) = K1 NLWEIGT.141
IF (CL1H.LT.0.) THEN NLWEIGT.142
K11 = K1-1 NLWEIGT.143
IF (K11.LT.1) K11 = KL NLWEIGT.144
ELSE NLWEIGT.145
K11 = K1+1 NLWEIGT.146
IF (K11.GT.KL) K11 = 1 NLWEIGT.147
ENDIF NLWEIGT.148
K11W(KS,KH) = K11 NLWEIGT.149
K2 = JA2(K,KH) NLWEIGT.150
K2W(KS,KH) = K2 NLWEIGT.151
IF (CL2H.LT.0) THEN NLWEIGT.152
K21 = K2-1 NLWEIGT.153
IF(K21.LT.1) K21 = KL NLWEIGT.154
ELSE NLWEIGT.155
K21 = K2+1 NLWEIGT.156
IF (K21.GT.KL) K21 = 1 NLWEIGT.157
ENDIF NLWEIGT.158
K21W(KS,KH) = K21 NLWEIGT.159
1302 CONTINUE NLWEIGT.160
ISG = -1 NLWEIGT.161
1301 CONTINUE NLWEIGT.162
C NLWEIGT.163
C* 2. COMPUTATION FOR FREQUENCY GRID. NLWEIGT.164
C ------------------------------- NLWEIGT.165
C NLWEIGT.166
2000 CONTINUE NLWEIGT.167
C NLWEIGT.168
DO 2001 M=1,ML NLWEIGT.169
FRLON(M) = FR(M) NLWEIGT.170
2001 CONTINUE NLWEIGT.171
DO 2002 M=ML+1,2*ML+2 NLWEIGT.172
FRLON(M) = CO*FRLON(M-1) NLWEIGT.173
2002 CONTINUE NLWEIGT.174
F1P1 = ALOG10(CO) NLWEIGT.175
DO 2003 M=1,ML+4 NLWEIGT.176
FRG = FRLON(M) NLWEIGT.177
AF11(M) = CON * FRG**11 NLWEIGT.178
FLP = FRG*(1.+ALAMD) NLWEIGT.179
FLM = FRG*(1.-ALAMD) NLWEIGT.180
IKN = IFIX(ALOG10(1.+ALAMD)/F1P1+.000001) NLWEIGT.181
IKN = M+IKN NLWEIGT.182
IKP(M) = IKN NLWEIGT.183
FKP = FRLON(IKP(M)) NLWEIGT.184
IKP1(M) = IKP(M)+1 NLWEIGT.185
FKLAP(M) = (FLP-FKP)/(FRLON(IKP1(M))-FKP) NLWEIGT.186
FKLAP1(M) = 1.-FKLAP(M) NLWEIGT.187
IF (FRLON(1).GE.FLM) THEN NLWEIGT.188
IKM(M) = 1 NLWEIGT.189
IKM1(M) = 1 NLWEIGT.190
FKLAM(M) = 0. NLWEIGT.191
FKLAM1(M) = 0. NLWEIGT.192
ELSE NLWEIGT.193
IKN = IFIX(ALOG10(1.-ALAMD)/F1P1+.0000001) NLWEIGT.194
IKN = M+IKN-1 NLWEIGT.195
IF (IKN.LT.1) IKN = 1 NLWEIGT.196
IKM(M) = IKN NLWEIGT.197
FKM = FRLON(IKM(M)) NLWEIGT.198
IKM1(M) = IKM(M)+1 NLWEIGT.199
FKLAM(M) = (FLM-FKM)/(FRLON(IKM1(M))-FKM) NLWEIGT.200
FKLAM1(M) = 1.-FKLAM(M) NLWEIGT.201
ENDIF NLWEIGT.202
2003 CONTINUE NLWEIGT.203
C NLWEIGT.204
C* 3. COMPUTE TAIL FREQUENCY RATIOS. NLWEIGT.205
C ------------------------------ NLWEIGT.206
C NLWEIGT.207
3000 CONTINUE NLWEIGT.208
IE = MIN(30,ML+3) NLWEIGT.209
DO 3001 I=1,IE NLWEIGT.210
M = ML+I-1 NLWEIGT.211
FRH(I) = (FRLON(ML)/FRLON(M))**5 NLWEIGT.212
3001 CONTINUE NLWEIGT.213
C NLWEIGT.214
C* 4. PRINTER PROTOCOL. NLWEIGT.215
C ----------------- NLWEIGT.216
C NLWEIGT.217
4000 CONTINUE NLWEIGT.218
WRITE(IU06,'(1H1,'' NON LINEAR INTERACTION PARAMETERS:'')') NLWEIGT.219
WRITE(IU06,'(1H0,'' COMMON INDNL: CONSTANTS'')') NLWEIGT.220
WRITE(IU06,'(1X,'' ACL1 ACL2 '', NLWEIGT.221
1 '' CL11 CL21 '', NLWEIGT.222
2 '' DAL1 DAL2'')') NLWEIGT.223
WRITE(IU06,'(1X,6F11.8)') ACL1, ACL2, CL11, CL21, DAL1, DAL2 NLWEIGT.224
NLWEIGT.225
WRITE(IU06,'(1H0,'' COMMON INDNL: FREQUENCY ARRAYS'')') NLWEIGT.226
WRITE(IU06,'(1X,'' M IKP IKP1 IKM IKM1'', NLWEIGT.227
1 '' FKLAP FKLAP1 '', NLWEIGT.228
2 '' FKLAM FKLAM1 AF11'')') NLWEIGT.229
DO 4001 M=1,ML+4 NLWEIGT.230
WRITE(IU06,'(1X,I2,4I5,4F11.8,E11.3)') NLWEIGT.231
1 M, IKP(M), IKP1(M), IKM(M), IKM1(M), NLWEIGT.232
2 FKLAP(M), FKLAP1(M), FKLAM(M), FKLAM1(M), AF11(M) NLWEIGT.233
4001 CONTINUE NLWEIGT.234
NLWEIGT.235
WRITE(IU06,'(1H0,'' COMMON INDNL: ANGULAR ARRAYS'')') NLWEIGT.236
WRITE(IU06,'(1X,'' |--------KH = 1----------|'', NLWEIGT.237
1 ''|--------KH = 2----------|'')') NLWEIGT.238
WRITE(IU06,'(1X,'' K K1W K2W K11W K21W'', NLWEIGT.239
1 '' K1W K2W K11W K21W'')') NLWEIGT.240
DO 4002 K=1,KL NLWEIGT.241
WRITE(IU06,'(1X,I2,8I6)') K,(K1W(K,KH), K2W(K,KH), K11W(K,KH), NLWEIGT.242
2 K21W(K,KH),KH=1,2) NLWEIGT.243
4002 CONTINUE NLWEIGT.244
WRITE(IU06,'(1H0,'' COMMON INDNL: TAIL ARRAY FRH'')') NLWEIGT.245
WRITE(IU06,'(1X,8F10.7)') (FRH(M),M=1,30) NLWEIGT.246
RETURN NLWEIGT.248
END NLWEIGT.249
C NLWEIGT.250
INTEGER FUNCTION JAFU (CL, J, IAN) 2NLWEIGT.251
NLWEIGT.252
C ---------------------------------------------------------------------- NLWEIGT.253
C NLWEIGT.254
C**** *JAFU* - FUNCTION TO COMPUTE THE INDEX ARRAY FOR THE NLWEIGT.255
C ANGLES OF THE INTERACTING WAVENUMBERS. NLWEIGT.256
C NLWEIGT.257
C S. HASSELMANN MPIFM 01/12/1985. NLWEIGT.258
C NLWEIGT.259
C* PURPOSE. NLWEIGT.260
C -------- NLWEIGT.261
C NLWEIGT.262
C INDICES DEFINING BINS IN FREQUENCY AND DIRECTION PLANE INTO NLWEIGT.263
C WHICH NONLINEAR ENERGY TRANSFER INCREMENTS ARE STORED. NEEDED NLWEIGT.264
C FOR COMPUTATION OF THE NONLINEAR ENERGY TRANSFER. NLWEIGT.265
C NLWEIGT.266
C** INTERFACE. NLWEIGT.267
C ---------- NLWEIGT.268
C NLWEIGT.269
C *FUNCTION* *JAFU (CL, J, IAN)* NLWEIGT.270
C *CL* - WEIGHTS. NLWEIGT.271
C *J* - INDEX IN ANGULAR ARRAY. NLWEIGT.272
C *IAN* - NUMBER OF ANGLES IN ARRAY. NLWEIGT.273
C NLWEIGT.274
C METHOD. NLWEIGT.275
C ------- NLWEIGT.276
C NLWEIGT.277
C SEE REFERENCE. NLWEIGT.278
C NLWEIGT.279
C EXTERNALS. NLWEIGT.280
C ---------- NLWEIGT.281
C NLWEIGT.282
C NONE. NLWEIGT.283
C NLWEIGT.284
C REFERENCE. NLWEIGT.285
C ---------- NLWEIGT.286
C NLWEIGT.287
C S. HASSELMANN AND K. HASSELMANN,JPO, 1985 B. NLWEIGT.288
C NLWEIGT.289
C ---------------------------------------------------------------------- NLWEIGT.290
C NLWEIGT.291
IDPH = CL NLWEIGT.292
JA = J+IDPH NLWEIGT.293
IF (JA.LE.0) JA = IAN+JA-1 NLWEIGT.294
IF (JA.GE.IAN) JA = JA-IAN+1 NLWEIGT.295
JAFU = JA NLWEIGT.296
NLWEIGT.297
RETURN NLWEIGT.298
END NLWEIGT.299
*ENDIF NLWEIGT.300