subroutine shape(nfre,nang,df, WV_SHAPE.43
*CALL ARGWVFD 
WV_SHAPE.44
*CALL ARGWVJO WV_SHAPE.45
& icode) WV_SHAPE.46
C WV_SHAPE.47
C WV_SHAPE.48
C subroutine to calculate JONSWAP spectral shape array for use is WV_SHAPE.49
C UKMO wave height assimilation routines WV_SHAPE.50
C WV_SHAPE.51
C WV_SHAPE.52
ccc REAL jonswap_shape(24,220,nfre) ! out WV_SHAPE.53
*CALL TYPWVJO WV_SHAPE.54
WV_SHAPE.55
WV_SHAPE.56
WV_SHAPE.57
REAL shnor(24,220) ! local WV_SHAPE.58
REAL df(nfre) ! local WV_SHAPE.59
WV_SHAPE.60
*CALL TYPWVFD WV_SHAPE.61
WV_SHAPE.62
integer l,ifj,igam WV_SHAPE.63
real a,b,d WV_SHAPE.64
WV_SHAPE.65
*CALL C_PI WV_SHAPE.66
WV_SHAPE.67
WRITE(6,*)'subroutine shape called to set array jonswap_shape' GIE0F403.709
WV_SHAPE.69
mfj=220 WV_SHAPE.70
sigma=0.08 WV_SHAPE.71
WV_SHAPE.72
CCC pi=3.1415926 WV_SHAPE.73
rpio2=2.0/pi WV_SHAPE.74
WV_SHAPE.75
C ---------------------------------------------------------------------- WV_SHAPE.76
CL 2.5 CREATE A LOOKUP TABLE OF JONSWAP SHAPE FUNCTIONS. A THREE WV_SHAPE.77
C *** PARAMETER FORM OF THE JONSWAP SPECTRUM IS USED: EJ(F,FJ,GAMMA) WV_SHAPE.78
C *** AND THE SHAPE FUNCTION IS NORMALISED OVER FREQUENCY WV_SHAPE.79
C WV_SHAPE.80
C *** ZERO LOOKUP TABLE WV_SHAPE.81
DO L=1,nfre WV_SHAPE.82
DO IFJ=1,mfj WV_SHAPE.83
DO IGAM=1,24 WV_SHAPE.84
SHNOR(IGAM,IFJ)=0.0 WV_SHAPE.85
jonswap_shape(IGAM,IFJ,L)=0.0 WV_SHAPE.86
enddo WV_SHAPE.87
enddo WV_SHAPE.88
enddo WV_SHAPE.89
WV_SHAPE.90
WV_SHAPE.91
C WV_SHAPE.92
C *** FILL LOOKUP TABLE AND INTEGRATE OVER FREQUENCY WV_SHAPE.93
C *** NEW IMPROVED LOOKUP TABLE IGAM FROM 1.0 TO 3.3,220 FREQUENCIES. WV_SHAPE.94
WV_SHAPE.95
F1L = ALOG10(fr(1)) WV_SHAPE.96
ffac=1.8 WV_SHAPE.97
FN1L=ALOG10(ffac*fr(nfre-1)) WV_SHAPE.98
DFLOOK = (F1L-FN1L)/(MFJ-1.) WV_SHAPE.99
RDFLK = 1./DFLOOK WV_SHAPE.100
WV_SHAPE.101
C WV_SHAPE.102
C WV_SHAPE.103
C WV_SHAPE.104
C *** SET UP ARRAY OF MODEL FREQUENCY INTERVALS WV_SHAPE.105
DO L=3,NFRE WV_SHAPE.106
DF(L-1)=(fr(L)-fr(L-2))*0.5 WV_SHAPE.107
ENDDO WV_SHAPE.108
DF(1)=(fr(2)-fr(1))*0.5+0.005 WV_SHAPE.109
C *** TOP INTERVAL CONTAINS CORRECTION FACTOR BASED ON INTEGRATION OF WV_SHAPE.110
C *** PHILLIPS SPECTRUM ABOVE TOP FREQUENCY WV_SHAPE.111
DF(NFRE)=fr(NFRE)-fr(NFRE-1)-DF(NFRE-1)*0.5+fr(NFRE)*0.25 WV_SHAPE.112
WV_SHAPE.113
WV_SHAPE.114
DO L=1,nfre WV_SHAPE.115
DO IFJ=1,MFJ WV_SHAPE.116
FJ = 10.**(FN1L+(IFJ-1)*DFLOOK) WV_SHAPE.117
WV_SHAPE.118
IF (fr(L).GE.FJ*0.8) THEN WV_SHAPE.119
DO IGAM=1,24 WV_SHAPE.120
IGG = IGAM+9 WV_SHAPE.121
GAM = FLOAT(IGG)*0.1 WV_SHAPE.122
A = -1.25*(FJ/fr(L))**4 WV_SHAPE.123
B = 0.0 WV_SHAPE.124
d = ((fr(L)-FJ)/(FJ*SIGMA))**2 WV_SHAPE.125
IF (d.LT.50.) then WV_SHAPE.126
B = ALOG(GAM)*EXP(-d*0.5) WV_SHAPE.127
endif WV_SHAPE.128
jonswap_shape(IGAM,IFJ,L) = EXP(A+B)/fr(L)**5 WV_SHAPE.129
SHNOR(IGAM,IFJ) = SHNOR(IGAM,IFJ) WV_SHAPE.130
& + jonswap_shape(IGAM,IFJ,L)*DF(L) WV_SHAPE.131
enddo WV_SHAPE.132
END IF WV_SHAPE.133
enddo WV_SHAPE.134
enddo WV_SHAPE.135
WV_SHAPE.136
C WV_SHAPE.137
C *** NORMALIZE OVER FREQUENCY AND MULTIPLY BY 2/PI TO ALLOW FOR LATER WV_SHAPE.138
C *** COS SQUARED DISTRIBUTION WV_SHAPE.139
WV_SHAPE.140
DO L=1,nfre WV_SHAPE.141
DO IFJ=1,MFJ WV_SHAPE.142
DO IGAM=1,24 WV_SHAPE.143
IF (SHNOR(IGAM,IFJ).GE.0.0000001) THEN WV_SHAPE.144
jonswap_shape(IGAM,IFJ,L) = RPIO2 * jonswap_shape(IGAM,IFJ,L) WV_SHAPE.145
& / SHNOR(IGAM,IFJ) WV_SHAPE.146
END IF WV_SHAPE.147
enddo WV_SHAPE.148
enddo WV_SHAPE.149
enddo WV_SHAPE.150
WV_SHAPE.151
WV_SHAPE.152
return WV_SHAPE.153
end WV_SHAPE.154
*ENDIF WV_SHAPE.155