-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathtest2
173 lines (153 loc) · 7.7 KB
/
test2
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
#include "wwm_functions.h"
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE ST4_PRE (IP, WALOC, PHI, DPHIDN, SSINE, DSSINE, SSDS, DSSDS, SSNL4, DSSNL4, SSINL)
USE DATAPOOL
USE W3SRC4MD
IMPLICIT NONE
INTEGER, INTENT(IN) :: IP
REAL(rkind), INTENT(IN) :: WALOC(NUMSIG,NUMDIR)
REAL(rkind), INTENT(OUT) :: PHI(NUMSIG,NUMDIR), DPHIDN(NUMSIG,NUMDIR)
REAL(rkind), INTENT(OUT) :: SSINE(NUMSIG,NUMDIR), DSSINE(NUMSIG,NUMDIR)
REAL(rkind), INTENT(OUT) :: SSDS(NUMSIG,NUMDIR),DSSDS(NUMSIG,NUMDIR)
REAL(rkind), INTENT(OUT) :: SSNL4(NUMSIG,NUMDIR),DSSNL4(NUMSIG,NUMDIR)
REAL(rkind), INTENT(OUT) :: SSINL(NUMSIG,NUMDIR)
INTEGER :: IS, ID, ITH, IK, IS0
REAL(rkind) :: AWW3(NSPEC)
REAL(rkind) :: VDDS(NSPEC), VSDS(NSPEC), BRLAMBDA(NSPEC)
REAL(rkind) :: WN2(NUMSIG*NUMDIR), WHITECAP(1:4)
REAL(rkind) :: VSIN(NSPEC), VDIN(NSPEC)
REAL(rkind) :: ETOT, FAVG, FMEAN1, WNMEAN, AS, SUMWALOC, FAVGWS
REAL(rkind) :: TAUWAX, TAUWAY, AMAX, FPM, WIND10, WINDTH
REAL(rkind) :: HS,SME01,SME10,KME01,KMWAM,KMWAM2
DO IS = 1, NUMSIG
DO ID = 1, NUMDIR
AWW3(ID + (IS-1) * NUMDIR) = WALOC(IS,ID) * CG(IS,IP)
END DO
END DO
DO IK=1, NK
WN2(1+(IK-1)*NTH) = WK(IK,IP)
END DO
DO IK=1, NK
IS0 = (IK-1)*NTH
DO ITH=2, NTH
WN2(ITH+IS0) = WN2(1+IS0)
END DO
END DO
!
! wind input
!
TAUWX(IP) = ZERO
TAUWY(IP) = ZERO
SSINL = ZERO
NUMSIG_HF(IP) = NUMSIG
AS = 0.
BRLAMBDA = ZERO
IF (MESIN .GT. 0) THEN
CALL SET_WIND( IP, WIND10, WINDTH )
CALL SET_FRICTION( IP, WALOC, WIND10, WINDTH, FPM )
LLWS=.TRUE.
#ifdef DEBUGSRC
WRITE(740+myrank,*) '1: input value USTAR=', UFRIC(IP), ' USTDIR=', USTDIR(IP)
#endif
CALL W3SPR4 ( AWW3, CG(:,IP), WK(:,IP), EMEAN(IP), FMEAN(IP), FMEAN1, WNMEAN, AMAX, WIND10, WINDTH, UFRIC(IP), USTDIR(IP), TAUWX(IP), TAUWY(IP), CD(IP), Z0(IP), ALPHA_CH(IP), LLWS, FMEANWS(IP))
#ifdef DEBUGSRC
WRITE(740+myrank,*) '1: out value USTAR=', UFRIC(IP), ' USTDIR=', USTDIR(IP)
WRITE(740+myrank,*) '1: out value EMEAN=', EMEAN(IP), ' FMEAN=', FMEAN(IP)
WRITE(740+myrank,*) '1: out value FMEAN1=', FMEAN1, ' WNMEAN=', WNMEAN
WRITE(740+myrank,*) '1: out value CD=', CD(IP), ' Z0=', Z0(IP)
WRITE(740+myrank,*) '1: out value ALPHA=', ALPHA_CH(IP), ' FMEANWS=', FMEANWS(IP)
#endif
IF (EMEAN(IP) .LT. THR .AND. WIND10 .GT. THR) CALL SIN_LIN_CAV(IP,WINDTH,FPM,SSINL)
CALL W3SIN4 ( IP, AWW3, CG(:,IP), WN2, WIND10, UFRIC(IP), RHOAW, AS, WINDTH, Z0(IP), CD(IP), TAUWX(IP), TAUWY(IP), TAUWAX, TAUWAY, VSIN, VDIN, LLWS, BRLAMBDA)
#ifdef DEBUGSRC
WRITE(740+myrank,*) '1: WINDTH=', WINDTH, ' Z0=', Z0(IP), ' CD=', CD(IP)
WRITE(740+myrank,*) '1: UFRIC=', UFRIC(IP), 'WIND10=', WIND10, ' RHOAW=', RHOAW
WRITE(740+myrank,*) '1: TAUWX=', TAUWX(IP), ' TAUWY=', TAUWY(IP)
WRITE(740+myrank,*) '1: TAUWAX=', TAUWAX, ' TAUWAY=', TAUWAY
WRITE(740+myrank,*) '1: W3SIN4min/max/sum(VSIN)=', minval(VSIN), maxval(VSIN), sum(VSIN)
WRITE(740+myrank,*) '1: W3SIN4min/max/sum(VDIN)=', minval(VDIN), maxval(VDIN), sum(VDIN)
#endif
CALL W3SPR4 ( AWW3, CG(:,IP), WK(:,IP), EMEAN(IP), FMEAN(IP), FMEAN1, WNMEAN, AMAX, WIND10, WINDTH, UFRIC(IP), USTDIR(IP), TAUWX(IP), TAUWY(IP), CD(IP), Z0(IP), ALPHA_CH(IP), LLWS, FMEANWS(IP))
CALL W3SIN4 ( IP, AWW3, CG(:,IP), WN2, WIND10, UFRIC(IP), RHOAW, AS, WINDTH, Z0(IP), CD(IP), TAUWX(IP), TAUWY(IP), TAUWAX, TAUWAY, VSIN, VDIN, LLWS, BRLAMBDA)
#ifdef DEBUGSRC
WRITE(740+myrank,*) '2: W3SIN4min/max/sum(VSIN)=', minval(VSIN), maxval(VSIN), sum(VSIN)
WRITE(740+myrank,*) '2: W3SIN4min/max/sum(VDIN)=', minval(VDIN), maxval(VDIN), sum(VDIN)
#endif
CALL CONVERT_VS_VD_WWM(IP, VSIN, VDIN, SSINE, DSSINE)
ENDIF
IF (MESNL .GT. 0) THEN
CALL MEAN_WAVE_PARAMETER(IP,WALOC,HS,ETOT,SME01,SME10,KME01,KMWAM,KMWAM2)
CALL DIASNL4WW3(IP, KMWAM, WALOC, SSNL4, DSSNL4)
END IF
IF (MESDS .GT. 0) THEN
CALL W3SDS4(AWW3,WK(:,IP),CG(:,IP),UFRIC(IP),USTDIR(IP),DEP(IP),VSDS,VDDS,BRLAMBDA,WHITECAP)
#ifdef DEBUGSRC
WRITE(740+myrank,*) '2: W3SDS4min/max/sum(VSDS)=', minval(VSDS), maxval(VSDS), sum(VSDS)
WRITE(740+myrank,*) '2: W3SDS4min/max/sum(VDDS)=', minval(VDDS), maxval(VDDS), sum(VDDS)
#endif
CALL CONVERT_VS_VD_WWM(IP, VSDS, VDDS, SSDS, DSSDS)
ENDIF
!
PHI = SSINL + SSINE + SSNL4 + SSDS
DPHIDN = DSSINE + DSSNL4 + DSSDS
!
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************
SUBROUTINE ST4_POST (IP, WALOC, SSINE, DSSINE, SSDS, DSSDS, SSINL)
USE DATAPOOL
USE W3SRC4MD
IMPLICIT NONE
INTEGER, INTENT(IN) :: IP
REAL(rkind), INTENT(IN) :: WALOC(NUMSIG,NUMDIR)
REAL(rkind), INTENT(OUT) :: SSINE(NUMSIG,NUMDIR),DSSINE(NUMSIG,NUMDIR)
REAL(rkind), INTENT(OUT) :: SSDS(NUMSIG,NUMDIR),DSSDS(NUMSIG,NUMDIR)
REAL(rkind), INTENT(OUT) :: SSINL(NUMSIG,NUMDIR)
INTEGER :: IS, ID, IK, ITH, ITH2, IS0
REAL(rkind) :: PHI(NUMSIG,NUMDIR), DPHIDN(NUMSIG,NUMDIR)
REAL(rkind) :: AWW3(NSPEC), WN2(NUMSIG*NUMDIR), BRLAMBDA(NSPEC)
REAL(rkind) :: DPHIDN1D(NSPEC), PHI1D(NSPEC), TMP_DS(NUMSIG)
REAL(rkind) :: ETOT, FAVG, FMEAN1, WNMEAN, AS, FAVGWS
REAL(rkind) :: TAUWAX, TAUWAY, AMAX, WIND10, WINDTH
REAL(rkind) :: WHITECAP(1:4), SUMWALOC, FPM
DO IS = 1, NUMSIG
DO ID = 1, NUMDIR
AWW3(ID + (IS-1) * NUMDIR) = WALOC(IS,ID) * CG(IS,IP)
END DO
END DO
DO IK=1, NK
WN2(1+(IK-1)*NTH) = WK(IK,IP)
END DO
DO IK=1, NK
IS0 = (IK-1)*NTH
DO ITH=2, NTH
WN2(ITH+IS0) = WN2(1+IS0)
END DO
END DO
!
! wind input
!
AS = 0.
NUMSIG_HF(IP) = NUMSIG
CALL SET_WIND( IP, WIND10, WINDTH )
CALL SET_FRICTION( IP, WALOC, WIND10, WINDTH, FPM )
CALL W3SPR4 ( AWW3, CG(:,IP), WK(:,IP), EMEAN(IP), FMEAN(IP), FMEAN1, WNMEAN, AMAX, WIND10, WINDTH, UFRIC(IP), USTDIR(IP), TAUWX(IP), TAUWY(IP), CD(IP), Z0(IP), ALPHA_CH(IP), LLWS, FMEANWS(IP))
IF (EMEAN(IP) .LT. THR .AND. WIND10 .GT. THR) CALL SIN_LIN_CAV(IP,WINDTH,FPM,SSINL)
CALL W3SIN4 ( IP, AWW3, CG(:,IP), WN2, WIND10, UFRIC(IP), RHOAW, AS, WINDTH, Z0(IP), CD(IP), TAUWX(IP), TAUWY(IP), TAUWAX, TAUWAY, PHI1D, DPHIDN1D, LLWS, BRLAMBDA)
CALL W3SPR4 ( AWW3, CG(:,IP), WK(:,IP), EMEAN(IP), FMEAN(IP), FMEAN1, WNMEAN, AMAX, WIND10, WINDTH, UFRIC(IP), USTDIR(IP), TAUWX(IP), TAUWY(IP), CD(IP), Z0(IP), ALPHA_CH(IP), LLWS, FMEANWS(IP))
CALL CONVERT_VS_VD_WWM(IP, PHI1D, DPHIDN1D, SSINE, DSSINE)
!
! dissipation
!
CALL W3SDS4(AWW3,WK(:,IP),CG(:,IP),UFRIC(IP),USTDIR(IP),DEP(IP),PHI1D,DPHIDN1D,BRLAMBDA,WHITECAP)
CALL CONVERT_VS_VD_WWM(IP,PHI1D,DPHIDN1D,SSDS,DSSDS)
!
! missing high freq. tail contribution -> 2do
!
END SUBROUTINE
!**********************************************************************
!* *
!**********************************************************************