*IF DEF,W06_1A WTRAIN2.2
! WTRAIN2.3
! Description: WTRAIN2.4
! This subroutine is part of the wavetrain diagnostic output code WTRAIN2.5
! developed by Anne Guillaume at MeteoFrance and ECMWF. WTRAIN2.6
! Introduced into the unified wave moel at UM4.1 WTRAIN2.7
! WTRAIN2.8
! Method: WTRAIN2.9
! WTRAIN2.10
! WTRAIN2.11
! WTRAIN2.12
! Current Code Owner: Martin Holt WTRAIN2.13
! WTRAIN2.14
! History: WTRAIN2.15
! Version Date Comment WTRAIN2.16
! ------- ---- ------- WTRAIN2.17
! UM4.1 June 1996 Code introduced to UM. M Holt WTRAIN2.18
! WTRAIN2.19
! Code Description: WTRAIN2.20
! Language: FORTRAN 77 + common extensions. WTRAIN2.21
! WTRAIN2.22
!- End of header WTRAIN2.23
WTRAIN2.24
SUBROUTINE WTRAIN2(PSPEC,KBLO,KJS,KJL,KANG,KFRE,PRES,KDANG, 1,3WTRAIN2.25
% KWTRA,KWTMAX) WTRAIN2.26
C WTRAIN2.27
C**** *WTRAIN2* - WAVE TRAIN 2ND ROUTINE (FIND WAVE TRAINS) WTRAIN2.28
C WTRAIN2.29
C A.GUILLAUME WTRAIN2.30
C A.GUILLAUME ECMWF 02/94 modified to save memory space WTRAIN2.31
C WTRAIN2.32
C WTRAIN2.33
C* PURPOSE. WTRAIN2.34
C -------- WTRAIN2.35
C WTRAIN2.36
C FIND WAVE TRAINS. WTRAIN2.37
C WTRAIN2.38
C** INTERFACE. WTRAIN2.39
C ---------- WTRAIN2.40
C WTRAIN2.41
C *CALL* *WTRAIN2(PSPEC,KBLO,KJS,KJL,KANG,KFRE,PFREQ,KNRJ,PRES,KDANG, WTRAIN2.42
C PSPEWT,KWTMAX)* WTRAIN2.43
C WTRAIN2.44
C I/ *PSPEC* - SPECTRUM. WTRAIN2.45
C I/ *KBLO* - DIMENSION OF ONE BLOCK. WTRAIN2.46
C I/ *KJS* - INDEX OF FIRST POINT OF BLOCK TO USE. WTRAIN2.47
C I/ *KJL* - INDEX OF LAST POINT OF BLOCK TO USE. WTRAIN2.48
C I/ *KANG* - NUMBER OF DIRECTIONS. WTRAIN2.49
C I/ *KFRE* - NUMBER OF FREQUENCIES. WTRAIN2.50
C I/ *PRES* - INTERPOLLATION PRECISION WTRAIN2.51
C I/ *KDANG* - MAX NUMBER OF DIRECTIONS IN SPREADING OF THE WT WTRAIN2.52
C (TYPICALLY TO ACHIEVE 60DEG, KDANG=2 WHEN WTRAIN2.53
C KANG=12) WTRAIN2.54
C /O *KWTRA* - WAVE TRAIN INDEX OF EACH SPECTRUM BIN. WTRAIN2.55
C I/ *KWTMAX* - MAX NB OF WAVE TRAINS. WTRAIN2.56
C WTRAIN2.57
C METHOD. WTRAIN2.58
C ------- WTRAIN2.59
C WTRAIN2.60
C NONE. WTRAIN2.61
C WTRAIN2.62
C EXTERNALS. WTRAIN2.63
C ---------- WTRAIN2.64
C WTRAIN2.65
C FINDPIC WTRAIN2.66
C TRHOU WTRAIN2.67
C WTRAIN1 WTRAIN2.68
C WTRAIN2.69
C REFERENCE. WTRAIN2.70
C ---------- WTRAIN2.71
C WTRAIN2.72
C NONE. WTRAIN2.73
C WTRAIN2.74
DIMENSION PSPEC(KBLO,KANG,KFRE),KWTRA(KJL-KJS+1,KANG,KFRE) WTRAIN2.75
C WORKING ARRAYS : WTRAIN2.76
DIMENSION KPICA(KJL-KJS+1),KPICF(KJL-KJS+1) WTRAIN2.77
DIMENSION KNRJ(KJL-KJS+1,KANG,KFRE),KNR(KJL-KJS+1,KANG,KFRE) WTRAIN2.78
C WTRAIN2.79
C* 0. INITIALIZE KWTRA. WTRAIN2.80
C ---------------- WTRAIN2.81
C WTRAIN2.82
10 CONTINUE WTRAIN2.83
DO 11 JANG=1,KANG WTRAIN2.84
DO 11 JFRE=1,KFRE WTRAIN2.85
DO 11 J=1,KJL-KJS+1 WTRAIN2.86
KWTRA(J,JANG,JFRE)=KWTMAX+1 WTRAIN2.87
11 CONTINUE WTRAIN2.88
C WTRAIN2.89
C* 1. RE-SCALE SPECTRA TO INTEGER VALUES. WTRAIN2.90
C ----------------------------------- WTRAIN2.91
C WTRAIN2.92
100 CONTINUE WTRAIN2.93
WTRAIN2.94
CALL WTRAIN1
(PSPEC,KBLO,KJS,KJL,KANG,KFRE,PRES,KNRJ) WTRAIN2.95
CAG WRITE(6,*)' IN WTRAIN2, AFTER WTRAIN1 ' GIE0F403.702
C WTRAIN2.97
C* 2. START LOOP TO FIND WAVE TRAINS. WTRAIN2.98
C ------------------------------- WTRAIN2.99
C WTRAIN2.100
200 CONTINUE WTRAIN2.101
DO 201 IWT=1,KWTMAX WTRAIN2.102
CALL FINDPIC
(KNRJ,KJL-KJS+1,1,KJL-KJS+1,KANG,KFRE,KPICA,KPICF) WTRAIN2.103
WTRAIN2.104
WTRAIN2.105
CALL TRHOU
(KNRJ,KJL-KJS+1,1,KJL-KJS+1,KANG,KFRE,KPICA,KPICF, WTRAIN2.106
% KDANG,KNR) WTRAIN2.107
CAG WRITE(6,*)' IN WTRAIN2, AFTER TRHOU, IWT ',IWT GIE0F403.703
DO 202 JFRE=1,KFRE WTRAIN2.109
DO 202 JANG=1,KANG WTRAIN2.110
DO 202 J=1,KJL-KJS+1 WTRAIN2.111
KWTRA(J,JANG,JFRE)=IWT*KNR(J,JANG,JFRE) WTRAIN2.112
% +(1-KNR(J,JANG,JFRE))*KWTRA(J,JANG,JFRE) WTRAIN2.113
202 CONTINUE WTRAIN2.114
DO 203 JFRE=1,KFRE WTRAIN2.115
DO 203 JANG=1,KANG WTRAIN2.116
DO 203 J=1,KJL-KJS+1 WTRAIN2.117
KNRJ(J,JANG,JFRE)=KNRJ(J,JANG,JFRE) WTRAIN2.118
% *(1-KNR(J,JANG,JFRE)) WTRAIN2.119
203 CONTINUE WTRAIN2.120
201 CONTINUE WTRAIN2.121
RETURN WTRAIN2.122
END WTRAIN2.123
*ENDIF WTRAIN2.124