SUBROUTINE WTREORG(PSWH,PERIO,PDIR,KBLO,KJS,KJL, 3WTREORG.25
% KWTMAX,KWTOT,PFWIND,PDWIND,PDMAX,PMISS, WTREORG.26
% KFLAGWS,PMCOEF,KREOSP,KANG,KFRE,KWTRA) WTREORG.27
C WTREORG.28
C**** *WTREORG* - ROUTINE TO FIND WINDSEA AND CLASSIFY WAVE TRAINS WTREORG.29
C WTREORG.30
C A.GUILLAUME ECMWF 01/07/92 WTREORG.31
C A.GUILLAUME ECMWF save memory space 02/94 WTREORG.32
C WTREORG.33
C PURPOSE. WTREORG.34
C -------- WTREORG.35
C WTREORG.36
C *WTREORG* WTREORG.37
C WTREORG.38
C** INTERFACE. WTREORG.39
C ---------- WTREORG.40
C WTREORG.41
C *CALL* * WTREORG(PSWH,PERIO,PDIR,KBLO,KJS,KJL, WTREORG.42
C KWTMAX,KWTOT,PFWIND,PDWIND,PDMAX,PMISS, WTREORG.43
C KFLAGWS,PMCOEF,KREOSP,KANG,KFRE,KWTRA) WTREORG.44
C WTREORG.45
C I/O *PSWH* - PSWH OF WAVE TRAINS. WTREORG.46
C I/O *PERIO* - MEAN PERIOD OF WAVE TRAINS. WTREORG.47
C I/O *PDIR* - MEAN DIRECTION OF WAVE TRAINS. WTREORG.48
C I/ *KBLO* - DIMENSION OF ONE BLOCK. WTREORG.49
C I/ *KJS* - INDEX OF FIRST POINT OF BLOCK TO USE. WTREORG.50
C I/ *KJL* - INDEX OF LAST POINT OF BLOCK TO USE. WTREORG.51
C I/ *KWTMAX* - MAX NUMBER OF WAVE TRAINS. WTREORG.52
C I/O *KWTOT* - FINAL NB OF WAVE TRAINS WTREORG.53
C I/ *PFWIND* - WIND SPEED TO COMPUTE P.M.FREQUENCY WTREORG.54
C I/ *PDWIND* - WIND DIRECTION (RADIAN) WTREORG.55
C I/ *PDMAX* - MAX ANGULAR DISTANCE BETWEEN WIND AND WINDSEA. WTREORG.56
C NO WINDSEA FURTHER THAN ZTEMAX FROM WIND DIRECTION WTREORG.57
C I/ *PMISS* - MISSING VALUE WTREORG.58
C I/ *KFLAGWS* - FLAG VALUE TO ISOLATE WINDSEA (DONE IF KFLAGWS.EQ.1, WTREORG.59
C MUST BE SET TO 0 OTHERWISE,TO SAVE MEMORY SPACE) WTREORG.60
C I/ *PMCOEF* - TUNING FACTOR FOR FINDING WINDSEA (0.9, 0.8..) WTREORG.61
C I/ *KREOSP* - FLAG VALUE TO REORGANIZE WAVE TRAIN INDEX MATRIX WTREORG.62
C DONE IF KREOSP=1 WTREORG.63
C WTREORG.64
C I/ *KANG* - NUMBER OF DIRECTIONS. WTREORG.65
C I/ *KFRE* - NUMBER OF FREQUENCIES. WTREORG.66
C I/O *KWTRA* - WAVE TRAIN INDEX MATRIX (ONLY USED IF KREOSP=1) WTREORG.67
C WTREORG.68
C METHOD. WTREORG.69
C ------- WTREORG.70
C WTREORG.71
C WTREORG.72
C EXTERNALS. WTREORG.73
C ---------- WTREORG.74
C WTREORG.75
C NONE. WTREORG.76
C WTREORG.77
C REFERENCE. WTREORG.78
C ---------- WTREORG.79
C WTREORG.80
C NONE. WTREORG.81
C WTREORG.82
DIMENSION PSWH(KBLO,KWTMAX),PERIO(KBLO,KWTMAX), WTREORG.83
% PDIR(KBLO,KWTMAX),PFWIND(1),PDWIND(1), WTREORG.84
% KWTOT(KBLO),KWTRA(KJL-KJS+1,KANG,KFRE) WTREORG.85
C..WORKING ARRAYS: WTREORG.86
DIMENSION ZTET1(KBLO),ZTET2(KBLO),ZTEMAX(KBLO) WTREORG.87
DIMENSION ZPEMIN(KBLO*KFLAGWS),IWDSEA(KBLO*KFLAGWS) WTREORG.88
C WTREORG.89
C* *PARAMETER* OF GLOBAL CONSTANTS. WTREORG.90
C WTREORG.91
CCC PARAMETER (G = 9.806, PI = 3.14159265358978, CIRC = 40000000., WTREORG.92
CCc 1 ZPI = 2.*PI, RAD = PI/180., DEG = 180./PI, WTREORG.93
CCC 2 R = CIRC/ZPI) WTREORG.94
WTREORG.95
*CALL C_G 
WTREORG.96
*CALL C_PI WTREORG.97
WTREORG.98
C WTREORG.99
C..FUNCTION IN LINE WTREORG.100
C WTREORG.101
IDELTA(I,J)=(ISIGN(1,I-J)+ISIGN(1,J-I))/2 WTREORG.102
WTREORG.103
ZPI=2.*PI WTREORG.104
RAD=PI_OVER_180 WTREORG.105
DEG=RECIP_PI_OVER_180 WTREORG.106
WTREORG.107
WTREORG.108
IWTR1=1 WTREORG.109
CAG WRITE(6,*)' KFLAGWS ',KFLAGWS GIE0F403.704
CCMH UKMO calls with kflagws=0 so comment out lines to help memory probs WTREORG.111
IF(KFLAGWS.NE.1) GO TO 500 WTREORG.112
IWTR1=2 WTREORG.113
C WTREORG.114
C 1. COMPUTE P.M.FREQUENCY. WTREORG.115
C ---------------------- WTREORG.116
C WTREORG.117
100 CONTINUE WTREORG.118
ccc DO 101 J=KJS,KJL WTREORG.119
ccc ZPEMIN(J)=1./0.13/G*PFWIND(J)/PMCOEF WTREORG.120
ccc ZTEMAX(J)=PDMAX WTREORG.121
101 CONTINUE WTREORG.122
C WTREORG.123
C 2. SHIFT WAVE TRAINS TO PUT WIND SEA IN 1ST. WTREORG.124
C ---------------------------------------- WTREORG.125
C WTREORG.126
200 CONTINUE WTREORG.127
ccc DO 201 JWTR=KWTMAX-1,1,-1 WTREORG.128
cc DO 201 J=KJS,KJL WTREORG.129
cc PSWH(J,JWTR+1)=PSWH(J,JWTR) WTREORG.130
cc PDIR(J,JWTR+1)=PDIR(J,JWTR) WTREORG.131
cc PERIO(J,JWTR+1)=PERIO(J,JWTR) WTREORG.132
201 CONTINUE WTREORG.133
CCMH IF(KREOSP.EQ.1) THEN WTREORG.134
cc DO 202 JFRE=1,KFRE WTREORG.135
cc DO 202 JANG=1,KANG WTREORG.136
cc DO 202 JWTR=KWTMAX,1,-1 WTREORG.137
cc DO 202 J=1,KJL-KJS+1 WTREORG.138
cc KWTRA(J,JANG,JFRE)=(JWTR+1)*IDELTA(KWTRA(J,JANG,JFRE),JWTR) WTREORG.139
cc % +KWTRA(J,JANG,JFRE)*(1-IDELTA(KWTRA(J,JANG,JFRE),JWTR)) WTREORG.140
ccc202 CONTINUE WTREORG.141
CAG WRITE(6,*)'IN WTREORG, AFTER WINDSEA SHIFT' GIE0F403.705
CAG PRINT 1000,PERIO,PSWH,PDIR WTREORG.143
CAG PRINT 2000,KWTRA WTREORG.144
1000 FORMAT('PERIO =',5F9.2,/,'PSWH =',5F9.2,/,'PDIR =',5F9.2,/) WTREORG.145
2000 FORMAT(/,(24I2)) WTREORG.146
cc ENDIF WTREORG.147
cc DO 203 J=KJS,KJL WTREORG.148
cc PSWH(J,1)=0. WTREORG.149
cc PDIR(J,1)=PMISS WTREORG.150
cc PERIO(J,1)=PMISS WTREORG.151
cc KWTOT(J)=KWTOT(J)+1 WTREORG.152
203 CONTINUE WTREORG.153
C WTREORG.154
C 3. FIND WINDSEA WT. WTREORG.155
C THE CLOSER TO WIND DIRECTION WITH PERIOD LESS THAN PM PERIOD WTREORG.156
C ------------------------------------------------------------ WTREORG.157
C WTREORG.158
300 CONTINUE WTREORG.159
cc DO 301 J=KJS,KJL WTREORG.160
cc IWDSEA(J)=1 WTREORG.161
301 CONTINUE WTREORG.162
cc DO 302 JWTR=2,KWTMAX WTREORG.163
cc DO 303 J=KJS,KJL WTREORG.164
cc ZTET1(J)=MOD(PDIR(J,JWTR)-PDWIND(J)+ZPI,ZPI) WTREORG.165
cc ZTET2(J)=MOD(PDWIND(J)-PDIR(J,JWTR)+ZPI,ZPI) WTREORG.166
cc ZTET1(J)=AMIN1(ABS(ZTET1(J)),ABS(ZTET2(J))) WTREORG.167
303 CONTINUE WTREORG.168
cc DO 304 J=KJS,KJL WTREORG.169
cc IF((PERIO(J,JWTR).LT.ZPEMIN(J)) WTREORG.170
cc % .AND. WTREORG.171
cc % (PERIO(J,JWTR).GT.0.) WTREORG.172
cc % .AND. WTREORG.173
cc % (ZTET1(J).LT.ZTEMAX(J))) THEN WTREORG.174
cc IWDSEA(J)=JWTR WTREORG.175
cc ZTEMAX(J)=ZTET1(J) WTREORG.176
cc ENDIF WTREORG.177
304 CONTINUE WTREORG.178
302 CONTINUE WTREORG.179
C WTREORG.180
C 4. PUT FIND WINDSEA WT IN 1ST. WTREORG.181
C --------------------------- WTREORG.182
C WTREORG.183
400 CONTINUE WTREORG.184
cc DO 410 J=KJS,KJL WTREORG.185
cc PSWH(J,1)=PSWH(J,IWDSEA(J)) WTREORG.186
cc PDIR(J,1)=PDIR(J,IWDSEA(J)) WTREORG.187
cc PERIO(J,1)=PERIO(J,IWDSEA(J)) WTREORG.188
410 CONTINUE WTREORG.189
cc DO 420 J=KJS,KJL WTREORG.190
cc PSWH(J,IWDSEA(J))=0. WTREORG.191
cc PDIR(J,IWDSEA(J))=PMISS WTREORG.192
cc PERIO(J,IWDSEA(J))=PMISS WTREORG.193
420 CONTINUE WTREORG.194
cc IF(KREOSP.EQ.1) THEN WTREORG.195
cc DO 430 JFRE=1,KFRE WTREORG.196
cc DO 430 JANG=1,KANG WTREORG.197
cc DO 430 J=1,KJL-KJS+1 WTREORG.198
cc KWTRA(J,JANG,JFRE)=IDELTA(KWTRA(J,JANG,JFRE),IWDSEA(J)) WTREORG.199
cc % +KWTRA(J,JANG,JFRE)*(1-IDELTA(KWTRA(J,JANG,JFRE),IWDSEA(J))) WTREORG.200
430 CONTINUE WTREORG.201
CAG WRITE(6,*)'IN WTREORG, AFTER WINDSEA IN 1' GIE0F403.706
CAG PRINT 2000,KWTRA WTREORG.203
CAG WRITE(6,*)'IN WTREORG, AFTER SHIFT ' GIE0F403.707
CAG PRINT 1000,PERIO,PSWH,PDIR WTREORG.205
CAG PRINT 2000,KWTRA WTREORG.206
cc ENDIF WTREORG.207
C WTREORG.208
C 5. CLASSEMENT PAR ENERGIE DES AUTRES WT. WTREORG.209
C ------------------------------------- WTREORG.210
C WTREORG.211
500 CONTINUE WTREORG.212
c WTREORG.213
DO 501 ITR1=IWTR1,KWTMAX WTREORG.214
DO 501 ITR2=ITR1+1,KWTMAX WTREORG.215
DO 502 J=KJS,KJL WTREORG.216
C IF(PSWH(J,ITR1).LT.PSWH(J,ITR2)) ZTEMAX(J)=0 WTREORG.217
C ELSE ZTEMAX(J)=1 WTREORG.218
ZTEMAX(J)=AMAX1(0.,SIGN(1.,PSWH(J,ITR1)-PSWH(J,ITR2))) WTREORG.219
502 CONTINUE WTREORG.220
DO 503 J=KJS,KJL WTREORG.221
C IF(PSWH(J,ITR1).LT.PSWH(ITR2)) ZTET1(J)=PSWH(J,ITR2) WTREORG.222
C ZTET2(J)=PSWH(J,ITR1) WTREORG.223
C ELSE ZTET1(J)=PSWH(J,ITR1) WTREORG.224
C ZTET2(J)=PSWH(J,ITR2) WTREORG.225
C ENDIF WTREORG.226
ZTET1(J)=PSWH(J,ITR1)*ZTEMAX(J) WTREORG.227
% +PSWH(J,ITR2)*(1.-ZTEMAX(J)) WTREORG.228
ZTET2(J)=PSWH(J,ITR2)*ZTEMAX(J) WTREORG.229
% +PSWH(J,ITR1)*(1.-ZTEMAX(J)) WTREORG.230
503 CONTINUE WTREORG.231
DO 504 J=KJS,KJL WTREORG.232
PSWH(J,ITR1)=ZTET1(J) WTREORG.233
PSWH(J,ITR2)=ZTET2(J) WTREORG.234
504 CONTINUE WTREORG.235
DO 505 J=KJS,KJL WTREORG.236
ZTET1(J)=PDIR(J,ITR1)*ZTEMAX(J) WTREORG.237
% +PDIR(J,ITR2)*(1.-ZTEMAX(J)) WTREORG.238
ZTET2(J)=PDIR(J,ITR2)*ZTEMAX(J) WTREORG.239
% +PDIR(J,ITR1)*(1.-ZTEMAX(J)) WTREORG.240
505 CONTINUE WTREORG.241
DO 506 J=KJS,KJL WTREORG.242
PDIR(J,ITR1)=ZTET1(J) WTREORG.243
PDIR(J,ITR2)=ZTET2(J) WTREORG.244
506 CONTINUE WTREORG.245
DO 507 J=KJS,KJL WTREORG.246
ZTET1(J)=PERIO(J,ITR1)*ZTEMAX(J) WTREORG.247
% +PERIO(J,ITR2)*(1.-ZTEMAX(J)) WTREORG.248
ZTET2(J)=PERIO(J,ITR2)*ZTEMAX(J) WTREORG.249
% +PERIO(J,ITR1)*(1.-ZTEMAX(J)) WTREORG.250
507 CONTINUE WTREORG.251
DO 508 J=KJS,KJL WTREORG.252
PERIO(J,ITR1)=ZTET1(J) WTREORG.253
PERIO(J,ITR2)=ZTET2(J) WTREORG.254
508 CONTINUE WTREORG.255
IF(KREOSP.EQ.1) THEN WTREORG.256
DO 509 J=1,KJL-KJS+1 WTREORG.257
JJZZ=NINT(ZTEMAX(J+KJS-1)) WTREORG.258
ITR11=ITR1*JJZZ+ITR2*(1-JJZZ) WTREORG.259
ITR22=ITR2*JJZZ+ITR1*(1-JJZZ) WTREORG.260
DO 509 JFRE=1,KFRE WTREORG.261
DO 509 JANG=1,KANG WTREORG.262
KWTRA(J,JANG,JFRE)=ITR11*IDELTA(KWTRA(J,JANG,JFRE),ITR1) WTREORG.263
% +ITR22*IDELTA(KWTRA(J,JANG,JFRE),ITR2) WTREORG.264
% +KWTRA(J,JANG,JFRE)*(1-IDELTA(KWTRA(J,JANG,JFRE),ITR1))* WTREORG.265
% (1-IDELTA(KWTRA(J,JANG,JFRE),ITR2)) WTREORG.266
509 CONTINUE WTREORG.267
CAG WRITE(6,*)' AFTER classification, ITR1,ITR2 ',ITR1,ITR2 GIE0F403.708
CAG PRINT 599,KWTRA WTREORG.269
599 FORMAT('KWTRA IN WTREORG, AFTER classification ',/,(24I2)) WTREORG.270
ENDIF WTREORG.271
501 CONTINUE WTREORG.272
RETURN WTREORG.273
END WTREORG.274
*ENDIF WTREORG.275