SUBROUTINE WTRAIN(PSPEC,KBLO,KJS,KJL,KANG,KFRE,PFWIND, 1,7WTRAIN.25
% PDWIND, WTRAIN.26
% PFREQ,PFBIN,PTHETA,PRES,KDANG,PDMAX, WTRAIN.27
% PECUT,PEMINR,PEMAXR,PDTMIN,KWTMAX, WTRAIN.28
% PMISS,PSWH,PERIO,PDIR,KWTOT WTRAIN.29
% ,KFLAGWS,PMCOEF,KREOSP,KWTRA,df WTRAIN.30
% ) WTRAIN.31
C WTRAIN.32
C**** *WTRAIN* - FIND WAVE TRAINS AND COMPUTE INTEGRATED PARAMETERS. WTRAIN.33
C WTRAIN.34
C A.GUILLAUME ECMWF 02/07/92 WTRAIN.35
C A.GUILLAUME ECMWF save memory space 2/94 WTRAIN.36
C M.Holt UKMO included array DF - use in calculation of WTRAIN.37
C spectral integrated parameters (ukmo freqs) WTRAIN.38
C WTRAIN.39
C* PURPOSE. WTRAIN.40
C -------- WTRAIN.41
C WTRAIN.42
C FIND WAVE TRAINS. WTRAIN.43
C WTRAIN.44
C** INTERFACE. WTRAIN.45
C ---------- WTRAIN.46
C WTRAIN.47
C *CALL* *WTRAIN(PSPEC,KBLO,KJS,KJL,KANG,KFRE,PFWIND,PDWIND, WTRAIN.48
C PFREQ,PFBIN,PTHETA,PRES,KDANG,PDMAX,PECUT, WTRAIN.49
C PEMINR,PEMAXR,PDTMIN,KWTMAX,PSWH,PERIO,PDIR, WTRAIN.50
C KWTOT,KFLAGWS,PMCOEF,KREOSP,KWTRA,df) WTRAIN.51
C WTRAIN.52
C I/ *PSPEC* - SPECTRUM. WTRAIN.53
C I/ *KBLO* - DIMENSION OF ONE BLOCK. WTRAIN.54
C I/ *KJS* - INDEX OF FIRST POINT OF BLOCK TO USE. WTRAIN.55
C I/ *KJL* - INDEX OF LAST POINT OF BLOCK TO USE. WTRAIN.56
C I/ *KANG* - NUMBER OF DIRECTIONS. WTRAIN.57
C I/ *KFRE* - NUMBER OF FREQUENCIES. WTRAIN.58
C I/ *PFWIND* - WIND SPEED WTRAIN.59
C I/ *PDWIND* - WIND DIRECTION (IN RADIAN) WTRAIN.60
C I/ *PFREQ* - FREQUENCY MATRIX. WTRAIN.61
C I/ *PFBIN* - PFREQ(IF+1)=PFREQ(IF)*(1+PFBIN) WTRAIN.62
C I/ *PTHETA* - DIRECTION MATRIX (RADIAN) WTRAIN.63
C I/ *PRES* - INTERPOLLATION PRECISION (TYPICALLY PRES=1000.) WTRAIN.64
C I/ *KDANG* - MAX NUMBER OF DIRECTIONS IN SPREADING OF THE WT WTRAIN.65
C (TYPICALLY TO ACHIEVE 60DEG, KDANG=2 WHEN WTRAIN.66
C KANG=12) WTRAIN.67
C I/ *PDMAX* - MAX ANGULAR DISTANCE BETWEEN WIND AND WINDSEA. WTRAIN.68
C (TYPICALLY PI/3) WTRAIN.69
C I/ *PECUT* - WAVE TRAINS WITH ENERGY LESS THAN PECUT*ETOT WTRAIN.70
C ARE DISCARDED AT THE END(TYPICALLY, 0.04) WTRAIN.71
C I/ *PEMINR* - FOR MERGING WAVE TRAINS WITH CLOSE PERIODS WTRAIN.72
C (TYPICALLY 1./(1.+3.*PFBIN) ) WTRAIN.73
C I/ *PEMAXR* - FOR MERGING WAVE TRAINS WITH CLOSE PERIODS WTRAIN.74
C (TYPICALLY (1.+3.*PFBIN) ) WTRAIN.75
C I/ *PDTMIN* - FOR MERGING WAVE TRAINS WITH CLOSE DIRECTIONS WTRAIN.76
C (TYPICALLY PI/4) WTRAIN.77
C I/ *KWTMAX* - MAX NB OF WAVE TRAINS (TYPICALLY 5) WTRAIN.78
C I/ *PMISS* - MISSING VALUE, SHOULD BE NEGATIVE. WTRAIN.79
C /O *PSWH* - SWH OF WAVE TRAINS. WTRAIN.80
C /O *PERIO* - MEAN PERIOD OF WAVE TRAINS. WTRAIN.81
C /O *PDIR* - MEAN DIRECTION OF WAVE TRAINS. WTRAIN.82
C /O *KWTOT* - FINAL NB OF WAVE TRAINS WTRAIN.83
C I/ *KFLAGWS* - FLAG VALUE TO ISOLATE WINDSEA WTRAIN.84
C (DONE IF KFLAGWS.EQ.1,MUST BE SET TO 0 OTHERWISE,TO SAVE MEMORY SPACE) WTRAIN.85
C I/ *PMCOEF* - TUNING FACTOR FOR FINDING WINDSEA (0.9, 0.8..) WTRAIN.86
C I/ *KREOSP* - FLAG VALUE TO REORGANIZE WAVE TRAIN INDEX MATRIX WTRAIN.87
C DONE IF KREOSP=1 WTRAIN.88
C NOTE there are calls to wtreorg with KREOSP=1 WTRAIN.89
C hard wired in the arg list WTRAIN.90
C /O *KWTRA* - WAVE TRAIN INDEX MATRIX (ONLY USEFUL LATER IF KREOSP=1) WTRAIN.91
C I/ *df* - array of frequency intervals (ie as for UKMO) WTRAIN.92
C WTRAIN.93
C METHOD. WTRAIN.94
C ------- WTRAIN.95
C WTRAIN.96
C NONE. WTRAIN.97
C WTRAIN.98
C EXTERNALS. WTRAIN.99
C ---------- WTRAIN.100
C WTRAIN.101
C FINDPIC WTRAIN.102
C TRHOU WTRAIN.103
C VAGDIRT WTRAIN.104
C VTOTT WTRAIN.105
C WTRAIN1 WTRAIN.106
C WTRAIN2 WTRAIN.107
C WTRAIN.108
C REFERENCE. WTRAIN.109
C ---------- WTRAIN.110
C WTRAIN.111
C NONE. WTRAIN.112
C WTRAIN.113
DIMENSION PFREQ(KFRE),df(kfre),PTHETA(KANG) WTRAIN.114
DIMENSION PSPEC(KBLO,KANG,KFRE) WTRAIN.115
DIMENSION KWTRA(KJL-KJS+1,KANG,KFRE) WTRAIN.116
DIMENSION PFWIND(1),PDWIND(1),KWTOT(KBLO) WTRAIN.117
DIMENSION PSWH(KBLO,KWTMAX), WTRAIN.118
% PDIR(KBLO,KWTMAX),PERIO(KBLO,KWTMAX) WTRAIN.119
C WORKING ARRAYS : WTRAIN.120
C *ZETOF* - 1)TOTAL ENERGY 2)MIN ENERGY TO DISCARD WT WTRAIN.121
C *ZWORK* - WTRAIN.122
C WTRAIN.123
DIMENSION ZETOF(KBLO) WTRAIN.124
DIMENSION ZWORK(KJL-KJS+1,KANG,KFRE) WTRAIN.125
C WTRAIN.126
C* *PARAMETER* OF GLOBAL CONSTANTS. WTRAIN.127
C WTRAIN.128
CCC PARAMETER (G = 9.806, PI = 3.14159265358978, CIRC = 40000000., WTRAIN.129
CCC 1 ZPI = 2.*PI, RAD = PI/180., DEG = 180./PI, WTRAIN.130
CCC 2 R = CIRC/ZPI) WTRAIN.131
WTRAIN.132
*CALL C_G 
WTRAIN.133
*CALL C_PI WTRAIN.134
WTRAIN.135
C WTRAIN.136
C..FUNCION IN LINE WTRAIN.137
IDELTA(I,J)=(ISIGN(1,I-J)+ISIGN(1,J-I))/2 WTRAIN.138
XPI=2.*PI/FLOAT(KANG) WTRAIN.139
C WTRAIN.140
C --------------------------------------------------------------- WTRAIN.141
C WTRAIN.142
ZPI=2.*PI WTRAIN.143
RAD=PI_OVER_180 WTRAIN.144
DEG=RECIP_PI_OVER_180 WTRAIN.145
C* 0. INITIALIZE KWTOT. WTRAIN.146
C ----------------- WTRAIN.147
C WTRAIN.148
DO 10 J=KJS,KJL WTRAIN.149
KWTOT(J)=KWTMAX WTRAIN.150
10 CONTINUE WTRAIN.151
C WTRAIN.152
C --------------------------------------------------------------- WTRAIN.153
C WTRAIN.154
C* 1. COMPUTE TOTAL ENERGY. WTRAIN.155
C --------------------- WTRAIN.156
C WTRAIN.157
c array zetof holds the gridpoint energy scaled by pecut. this array WTRAIN.158
c is passed into regroup and used as array pemin WTRAIN.159
c WTRAIN.160
100 CONTINUE WTRAIN.161
WTRAIN.162
CALL VTOTT(PSPEC,KBLO,KJS,KJL,KANG,KFRE,PFREQ,PFBIN,ZETOF,df) WTRAIN.163
DO 101 J=KJS,KJL WTRAIN.164
ZETOF(J)=PECUT*ZETOF(J) WTRAIN.165
101 CONTINUE WTRAIN.166
C WTRAIN.167
C --------------------------------------------------------------- WTRAIN.168
C WTRAIN.169
C* 2. FIND WAVE TRAINS. WTRAIN.170
C ---------------- WTRAIN.171
C WTRAIN.172
200 CONTINUE WTRAIN.173
CALL WTRAIN2(PSPEC,KBLO,KJS,KJL,KANG,KFRE,PRES,KDANG, WTRAIN.174
% KWTRA,KWTMAX-1) WTRAIN.175
CAG PRINT*,'AFTER WTRAIN2' WTRAIN.176
CAG PRINT 201,KWTRA WTRAIN.177
201 FORMAT('KWTRA AFTER WTRAIN2',/,(24I2)) WTRAIN.178
C WTRAIN.179
C --------------------------------------------------------------- WTRAIN.180
C WTRAIN.181
C* 3. COMPUTE INTEGRATED PARAMETERS AND WTRAIN.182
C CLASSIFY WT.SPECTRA BY PERIOD. WTRAIN.183
C ------------------------------ WTRAIN.184
C WTRAIN.185
300 CONTINUE WTRAIN.186
DO 301 IWT=1,KWTMAX WTRAIN.187
DO 311 JFRE=1,KFRE WTRAIN.188
DO 311 JANG=1,KANG WTRAIN.189
DO 311 J=KJS,KJL WTRAIN.190
ZWORK(J-KJS+1,JANG,JFRE)= WTRAIN.191
% PSPEC(J,JANG,JFRE)*IDELTA(KWTRA(J-KJS+1,JANG,JFRE),IWT) WTRAIN.192
311 CONTINUE WTRAIN.193
CALL VINTPAR(ZWORK,PSWH(KJS,IWT),PERIO(KJS,IWT), WTRAIN.194
% PDIR(KJS,IWT),KJL-KJS+1,1,KJL-KJS+1,KANG,KFRE, WTRAIN.195
% PFREQ,PFBIN,PTHETA,PMISS,df) WTRAIN.196
301 CONTINUE WTRAIN.197
CAG PRINT*,'BEFORE WTREORG' WTRAIN.198
CAG PRINT 312,PERIO,PSWH,PDIR WTRAIN.199
312 FORMAT('PERIO =',5F9.2,/,'PSWH =',5F9.2,/,'PDIR =',5F9.2,/) WTRAIN.200
C WTRAIN.201
CCMH note the hardwired arguments here WTRAIN.202
c WTRAIN.203
CALL WTREORG(PERIO,PSWH,PDIR,KBLO,KJS,KJL, WTRAIN.204
% KWTMAX-1,KWTOT,PFWIND,PDWIND,0.,PMISS, WTRAIN.205
% 0,1.,1,KANG,KFRE,KWTRA) WTRAIN.206
C WTRAIN.207
CAG PRINT*,'AFTER WTREORG PERIOD' WTRAIN.208
CAG PRINT 312,PERIO,PSWH,PDIR WTRAIN.209
CAG PRINT 321,KWTRA WTRAIN.210
321 FORMAT('KWTRA AFTER WTREORG',/,(24I2)) WTRAIN.211
C WTRAIN.212
C --------------------------------------------------------------- WTRAIN.213
C WTRAIN.214
C* 4. REDUCE NB WAVE TRAINS BY MERGING CLOSE ONES. WTRAIN.215
C ------------------------------------------- WTRAIN.216
C WTRAIN.217
400 CONTINUE WTRAIN.218
ccc print*,'before calling regroup aray pfreq kfre' WTRAIN.219
ccc print*,kfre,pfreq WTRAIN.220
CALL REGROUP(PSPEC,KWTRA,PSWH,PERIO,PDIR,KBLO,KJS,KJL, WTRAIN.221
% KANG,KFRE,KWTMAX-1,KWTOT, WTRAIN.222
% PEMINR,PEMAXR,PDTMIN,PFREQ,PFBIN,PTHETA, WTRAIN.223
% ZETOF,PMISS,df) WTRAIN.224
CAG PRINT*,'AFTER REGROUP' WTRAIN.225
CAG PRINT 312,PERIO,PSWH,PDIR WTRAIN.226
CAG PRINT 401,KWTRA WTRAIN.227
401 FORMAT('KWTRA AFTER REGROUP',/,(24I2)) WTRAIN.228
C WTRAIN.229
C --------------------------------------------------------------- WTRAIN.230
C WTRAIN.231
C* 5. COMPUTE SWH PSWH. WTRAIN.232
C ----------------- WTRAIN.233
C WTRAIN.234
500 CONTINUE WTRAIN.235
ccmh why kwtmax-1 ?? WTRAIN.236
DO 501 IWT=1,KWTMAX-1 WTRAIN.237
DO 501 J=KJS,KJL WTRAIN.238
ccmh PSWH(J,IWT)=4.004*SQRT(AMAX1(0.,PSWH(J,IWT)*XPI*PFBIN/2.)) WTRAIN.239
ccmh use this when peto is filled using UKMO df() in vTOTT ? WTRAIN.240
CCmh pswh is set with peto in the call to regroup / vintpar / vtott WTRAIN.241
PSWH(J,IWT)=4.004*SQRT(MAX(0.,PSWH(J,IWT)*XPI)) WTRAIN.242
501 CONTINUE WTRAIN.243
c WTRAIN.244
CAG PRINT*,'AFTER swh' WTRAIN.245
CAG PRINT 312,PERIO,PSWH,PDIR WTRAIN.246
C WTRAIN.247
C --------------------------------------------------------------- WTRAIN.248
C WTRAIN.249
C* 6. FIND WIND SEA AND CLASSE LES WT PAR PSWH DECROISSANTS. WTRAIN.250
C ----------------------------------------------------- WTRAIN.251
C WTRAIN.252
600 CONTINUE WTRAIN.253
CALL WTREORG(PSWH,PERIO,PDIR,KBLO,KJS,KJL, WTRAIN.254
% KWTMAX,KWTOT,PFWIND,PDWIND,PDMAX,PMISS, WTRAIN.255
% 0,PMCOEF,KREOSP,KANG,KFRE,KWTRA) WTRAIN.256
C WTRAIN.257
ccmh but i have set kflagws to zero so could comment out these calls ? WTRAIN.258
CALL WTREORG(PSWH,PERIO,PDIR,KBLO,KJS,KJL, WTRAIN.259
% KWTMAX,KWTOT,PFWIND,PDWIND,PDMAX,PMISS, WTRAIN.260
% KFLAGWS,PMCOEF,KREOSP,KANG,KFRE,KWTRA) WTRAIN.261
ccc PRINT*,'AFTER WTREORG WINDSEA' WTRAIN.262
ccc PRINT 312,PERIO,PSWH,PDIR WTRAIN.263
ccc PRINT 601,KWTRA WTRAIN.264
601 FORMAT('KWTRA AFTER WTREORG',/,(24I2)) WTRAIN.265
C WTRAIN.266
C --------------------------------------------------------------- WTRAIN.267
C WTRAIN.268
C* 7. CONVERT DIRECTION IN DEGREE. WTRAIN.269
C --------------------------- WTRAIN.270
C WTRAIN.271
700 CONTINUE WTRAIN.272
DO 701 IWT=1,KWTMAX WTRAIN.273
DO 701 J=KJS,KJL WTRAIN.274
C WTRAIN.275
c first convert to degrees in 0 to 360 WTRAIN.276
C WAM / UM convention is zero=north / incr clockwise WTRAIN.277
c WTRAIN.278
IF (PDIR(J,IWT).NE.PMISS)then WTRAIN.279
PDIR(J,IWT)=MOD(PDIR(J,IWT)*180./PI,360.) WTRAIN.280
ccc PDIR(J,IWT)=MOD(270. - PDIR(J,IWT),360.) WTRAIN.281
endif WTRAIN.282
701 CONTINUE WTRAIN.283
WTRAIN.284
RETURN WTRAIN.285
END WTRAIN.286
*ENDIF WTRAIN.287