subroutine wavetr(energ,pswh,perio,pdir,kwtot,pfreq,dff,ptheta, 1,1WAVETR.39
+len1,ndata,kwtmax,nfreq,ntheta,rmdi,icode) WAVETR.40
c WAVETR.41
c top level subroutine to interface wavetrain programs with UKMO wave WAVETR.42
c model. This subroutine is called by waveh from fldout. WAVETR.43
c WAVETR.44
c arguments WAVETR.45
c ######### WAVETR.46
c energ in energy array - one-dimensional - length len1 WAVETR.47
c nfreq in number of frequencies WAVETR.48
c ntheta in number of directions WAVETR.49
c ndata in number of data points WAVETR.50
c len1 in length of energy array = nfreq*ntheta*ndata WAVETR.51
c pfreq in frequency array WAVETR.52
c dff in frequency intervals array WAVETR.53
c ptheta in direction array WAVETR.54
c rmdi in real - missing data indicator WAVETR.55
c kwtmax in max number of wavetrains searched for WAVETR.56
c WAVETR.57
c OUT WAVETR.58
c pswh out sig wave height (ndata by kwtmax) WAVETR.59
c perio out wave period ( " ) WAVETR.60
c pdir out wave direction ( " ) WAVETR.61
C radians TO/ zero=east WAVETR.62
c kwtot out number of wave trains at each gridpoint WAVETR.63
C icode return code from this subroutine WAVETR.64
c WAVETR.65
C * local but passed to main wavetrain processing* results not used WAVETR.66
c pfwind wind speeds (ndata) ) removed from input list WAVETR.67
c pdwind wind directions (ndata) ) WAVETR.68
C not used at present. resized to (1) WAVETR.69
WAVETR.70
integer nfreq,ntheta,ndata,kblo,kjs,kjl,kdang,nblok WAVETR.71
integer kwtra(ndata,ntheta,nfreq),kwtot(ndata) WAVETR.72
C WAVETR.73
real pfwind(1),pdwind(1),pfreq(nfreq),energ(len1) WAVETR.74
real pdmax,pecut,peminr,pemaxr,pdtmin,pfbin WAVETR.75
real pmiss,pres,ptheta(ntheta),dff(nfreq) WAVETR.76
real pswh(ndata,kwtmax),perio(ndata,kwtmax),pdir(ndata,kwtmax) WAVETR.77
c WAVETR.78
c WAVETR.79
WAVETR.80
*CALL C_PI 
WAVETR.81
WAVETR.82
C WAVETR.83
c # set blocking information # WAVETR.84
c # note - process ndata/3 points per call WAVETR.85
C # because of memory restriction WAVETR.86
c # if larger grid used may need ndata/4 or whatever. WAVETR.87
c # at present, for oper global this runs in 16Mw WAVETR.88
WAVETR.89
icode=-1 WAVETR.90
WAVETR.91
kblo=ndata WAVETR.92
WAVETR.93
nblok=8 WAVETR.94
kjs=1 WAVETR.95
kjl=int(ndata/nblok) WAVETR.96
c WAVETR.97
do ip=1,ndata WAVETR.98
kwtot(ip)=0 WAVETR.99
enddo WAVETR.100
WAVETR.101
c # set arguments # - see wavetrain.prog for details # WAVETR.102
c kdang is max spread of direction bins per wave train # WAVETR.103
kdang=4 WAVETR.104
kflagws=0 WAVETR.105
pdmax=0.33333*pi WAVETR.106
pecut=0.001 WAVETR.107
peminr=1/1.3 WAVETR.108
pemaxr=1.3 WAVETR.109
pdtmin=0.25*pi WAVETR.110
pfbin=0.0 WAVETR.111
pres=1000. WAVETR.112
WAVETR.113
c # note the wavetrain routine requires pmiss negative WAVETR.114
pmiss=-32768. WAVETR.115
WAVETR.116
pmcoef=0.8 WAVETR.117
kreosp=0 WAVETR.118
WAVETR.119
do j=1,kwtmax WAVETR.120
do ip=1,ndata WAVETR.121
pswh(ip,j)=pmiss WAVETR.122
perio(ip,j)=pmiss WAVETR.123
pdir(ip,j)=pmiss WAVETR.124
enddo WAVETR.125
enddo WAVETR.126
c WAVETR.127
do ii=1,nblok WAVETR.128
WAVETR.129
c do the first block of points * WAVETR.130
WRITE(6,*)' processing kjs to kjl ',kjs,kjl GIE0F403.677
WRITE(6,*)' kwtmax is ',kwtmax GIE0F403.678
call wtrain(energ,kblo,kjs,kjl,ntheta,nfreq,pfwind,pdwind, WAVETR.133
+ pfreq,pfbin,ptheta,pres,kdang,pdmax, WAVETR.134
+ pecut,peminr,pemaxr,pdtmin,kwtmax, WAVETR.135
+ pmiss,pswh,perio,pdir,kwtot, WAVETR.136
+ kflagws,pmcoef,kreosp,kwtra,dff) WAVETR.137
c WAVETR.138
c WAVETR.139
c do the second block of points * WAVETR.140
kjs=kjl+1 WAVETR.141
kjl=int((ii+1)*ndata/nblok) WAVETR.142
if(kjl.ge.ndata) kjl=ndata WAVETR.143
WAVETR.144
enddo WAVETR.145
WAVETR.146
WAVETR.147
cc here replace pmiss with mdi WAVETR.148
WAVETR.149
do j=1,kwtmax WAVETR.150
do ip=1,ndata WAVETR.151
if(pswh(ip,j).eq.pmiss) pswh(ip,j)=rmdi WAVETR.152
if(perio(ip,j).eq.pmiss) perio(ip,j)=rmdi WAVETR.153
if(pdir(ip,j).eq.pmiss) pdir(ip,j)=0. WAVETR.154
enddo WAVETR.155
enddo WAVETR.156
WAVETR.157
WRITE(6,*)'setting mdis for absent trains : routine wavetr' GIE0F403.679
do ip=1,ndata WAVETR.159
jstart=min(kwtot(ip)+1,kwtmax) WAVETR.160
do j=jstart,kwtmax WAVETR.161
pdir(ip,j)=rmdi WAVETR.162
perio(ip,j)=rmdi WAVETR.163
pswh(ip,j)=0. WAVETR.164
enddo WAVETR.165
enddo WAVETR.166
c WAVETR.167
icode=0 WAVETR.168
return WAVETR.169
end WAVETR.170
*ENDIF WAVETR.171