SUBROUTINE STRESSO (F, IJS, IJL, IG, IGL, 1STRESSO.4
*CALL ARGWVAL 
STRESSO.5
*CALL ARGWVCP STRESSO.6
*CALL ARGWVFD STRESSO.7
*CALL ARGWVSR STRESSO.8
*CALL ARGWVTB STRESSO.9
*CALL ARGWVWD STRESSO.10
& icode) STRESSO.11
STRESSO.12
*CALL PARWVTB STRESSO.13
*CALL PARCONS STRESSO.14
*CALL PARWVSTR STRESSO.15
STRESSO.16
*CALL TYPWVCP STRESSO.17
*CALL TYPWVFD STRESSO.18
*CALL TYPWVSR STRESSO.19
*CALL TYPWVTB STRESSO.20
*CALL TYPWVWD STRESSO.21
*CALL TYPWVAL STRESSO.22
STRESSO.23
C ---------------------------------------------------------------------- STRESSO.24
C STRESSO.25
C**** *STRESSO* - COMPUTATION OF WAVE STRESS. STRESSO.26
C STRESSO.27
C H. GUNTHER GKSS/ECMWF NOVEMBER 1989 CODE MOVED FROM SINPUT. STRESSO.28
C P.A.E.M. JANSSEN KNMI AUGUST 1990 STRESSO.29
C STRESSO.30
C* PURPOSE. STRESSO.31
C -------- STRESSO.32
C STRESSO.33
C COMPUTE NORMALIZED WAVE STRESS FROM INPUT SOURCE FUNCTION STRESSO.34
C STRESSO.35
C** INTERFACE. STRESSO.36
C ---------- STRESSO.37
C STRESSO.38
C *CALL* *STRESSO (F, IJS, IJL, IG, IGL)* STRESSO.39
C *F* - WAVE SPECTRUM. STRESSO.40
C *IJS* - INDEX OF FIRST GRIDPOINT. STRESSO.41
C *IJL* - INDEX OF LAST GRIDPOINT. STRESSO.42
C *IG* - ACTUAL BLOCK NUMBER. STRESSO.43
C *IGL* - NUMBER OF BLOCKS. STRESSO.44
C STRESSO.45
C METHOD. STRESSO.46
C ------- STRESSO.47
C STRESSO.48
C THE INPUT SOURCE FUNCTION IS INTEGRATED OVER FREQUENCY STRESSO.49
C AND DIRECTIONS. STRESSO.50
C BECAUSE ARRAY *SL* IS USED, ONLY THE INPUT SOURCE STRESSO.51
C HAS TO BE STORED IN *SL* (CALL FIRST SINPUT, THEN STRESSO.52
C STRESSO, AND THEN THE REST OF THE SOURCE FUNCTIONS) STRESSO.53
C STRESSO.54
C EXTERNALS. STRESSO.55
C ----------- STRESSO.56
C STRESSO.57
C NONE. STRESSO.58
C STRESSO.59
C REFERENCE. STRESSO.60
C ---------- STRESSO.61
C STRESSO.62
C R SNYDER ET AL,1981. STRESSO.63
C G. KOMEN, S. HASSELMANN AND K. HASSELMANN, JPO, 1984. STRESSO.64
C P. JANSSEN, JPO, 1985 STRESSO.65
C STRESSO.66
C ---------------------------------------------------------------------- STRESSO.67
C STRESSO.68
DIMENSION F(0:NIBLO,NANG,NFRE) STRESSO.69
C STRESSO.70
C ---------------------------------------------------------------------- STRESSO.71
C STRESSO.72
DIMENSION CONSTF(NFRE), TAUHF(NIBLO), TEMP(NIBLO), STRESSO.73
1 XSTRESS(NIBLO), YSTRESS(NIBLO) STRESSO.74
C ---------------------------------------------------------------------- STRESSO.75
C STRESSO.76
C* 1. PRECOMPUTE FREQUENCY SCALING. STRESSO.77
C ----------------------------- STRESSO.78
C STRESSO.79
CONST0 = DELTH*(ZPI)**4*FR(NFRE)**5/G**2 STRESSO.80
C STRESSO.81
DO 1000 M=1,NFRE STRESSO.82
CONSTF(M) =ZPI*XINVEPS*FR(M)*DFIM(M) STRESSO.83
1000 CONTINUE STRESSO.84
C STRESSO.85
C* 2. COMPUTE WAVE STRESS OF ACTUEL BLOCK. STRESSO.86
C ------------------------------------ STRESSO.87
C STRESSO.88
C* 2.1 PRESET STRESS ARRAYS. STRESSO.89
C --------------------- STRESSO.90
C STRESSO.91
DO 2100 IJ=IJS,IJL STRESSO.92
XSTRESS(IJ)=0. STRESSO.93
YSTRESS(IJ)=0. STRESSO.94
2100 CONTINUE STRESSO.95
C STRESSO.96
C* 2.2 INTEGRATE INPUT SOURCE FUNCTION OVER FREQUENCY AND DIRECTIONS. STRESSO.97
C -------------------------------------------------------------- STRESSO.98
C STRESSO.99
DO 2200 K=1,NANG STRESSO.100
DO 2210 M=1,NFRE STRESSO.101
CONST1=CONSTF(M)*SINTH(K) STRESSO.102
CONST2=CONSTF(M)*COSTH(K) STRESSO.103
DO 2220 IJ=IJS,IJL STRESSO.104
XSTRESS(IJ)=XSTRESS(IJ)+SL(IJ,K,M)*CONST1 STRESSO.105
YSTRESS(IJ)=YSTRESS(IJ)+SL(IJ,K,M)*CONST2 STRESSO.106
2220 CONTINUE STRESSO.107
2210 CONTINUE STRESSO.108
2200 CONTINUE STRESSO.109
C STRESSO.110
C* 2.3 CALCULATE HIGH-FREQUENCY CONTRIBUTION TO STRESS. STRESSO.111
C ---------------------------------------------------- STRESSO.112
C STRESSO.113
DO 2300 IJ=IJS,IJL STRESSO.114
TEMP(IJ) = 0. STRESSO.115
2300 CONTINUE STRESSO.116
C STRESSO.117
DO 2310 K=1,NANG STRESSO.118
TKD = TH(K) STRESSO.119
DO 2320 IJ=IJS,IJL STRESSO.120
COSW = MAX(COS(TKD-THWNEW(IJ,ig)),0.) STRESSO.121
TEMP(IJ) = TEMP(IJ)+F(IJ,K,NFRE)*COSW**3 STRESSO.122
2320 CONTINUE STRESSO.123
2310 CONTINUE STRESSO.124
C STRESSO.125
DO 2330 IJ=IJS,IJL STRESSO.126
UST = USNEW(IJ,ig) STRESSO.127
XI = UST / DELUST STRESSO.128
I = MIN (IUSTAR-1, INT(XI)) STRESSO.129
DELI1 = MIN (1. ,XI-FLOAT(I)) STRESSO.130
DELI2 = 1. - DELI1 STRESSO.131
C STRESSO.132
XJ = (G*Z0NEW(IJ,ig)/UST**2-ALPHA) / DELALP STRESSO.133
J = MIN (IALPHA-1, INT(XJ)) STRESSO.134
DELJ1 = MIN (1. ,XJ-FLOAT(J)) STRESSO.135
DELJ2 = 1. - DELJ1 STRESSO.136
C STRESSO.137
TAU1 = (TAUHFT(I,J )*DELI2 + TAUHFT(I+1,J )*DELI1)*DELJ2 STRESSO.138
1 + (TAUHFT(I,J+1)*DELI2 + TAUHFT(I+1,J+1)*DELI1)*DELJ1 STRESSO.139
C STRESSO.140
TAUHF(IJ) = CONST0*TEMP(IJ)*UST**2*TAU1 STRESSO.141
2330 CONTINUE STRESSO.142
C STRESSO.143
DO 2340 IJ=IJS,IJL STRESSO.144
XSTRESS(IJ) = XSTRESS(IJ)+TAUHF(IJ)*SIN(THWNEW(IJ,ig)) STRESSO.145
YSTRESS(IJ) = YSTRESS(IJ)+TAUHF(IJ)*COS(THWNEW(IJ,ig)) STRESSO.146
TAUW(IJ,IG) = SQRT(XSTRESS(IJ)**2+YSTRESS(IJ)**2) STRESSO.147
2340 CONTINUE STRESSO.148
STRESSO.149
RETURN STRESSO.150
END STRESSO.151
*ENDIF STRESSO.152