File indexing completed on 2018-03-02 18:45:36 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
42c525bfb4 Alis*0001 #include "CPP_OPTIONS.h"
0002
b4656da4c6 Jean*0003
0004
0005
42c525bfb4 Alis*0006 SUBROUTINE EXTERNAL_FORCING_U(
b4656da4c6 Jean*0007 I iMin,iMax, jMin,jMax, bi,bj, kLev,
0008 I myTime, myThid )
0009
0010
0011
0012
0013
0014
0015
0016
0017
42c525bfb4 Alis*0018
b4656da4c6 Jean*0019
0020 IMPLICIT NONE
42c525bfb4 Alis*0021
0022 #include "SIZE.h"
0023 #include "EEPARAMS.h"
0024 #include "PARAMS.h"
0025 #include "GRID.h"
0026 #include "DYNVARS.h"
0027 #include "FFIELDS.h"
0028
b4656da4c6 Jean*0029
42c525bfb4 Alis*0030
b4656da4c6 Jean*0031
0032
0033
0034
0035
0036
42c525bfb4 Alis*0037 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
b4656da4c6 Jean*0038 _RL myTime
42c525bfb4 Alis*0039 INTEGER myThid
0040
b4656da4c6 Jean*0041
42c525bfb4 Alis*0042
b4656da4c6 Jean*0043
0044 INTEGER i, j
0045
0046 _RL recip_P0g, termP, kV, kF, sigma_b
42c525bfb4 Alis*0047
aea29c8517 Alis*0048
aea360aa02 Jean*0049 kF=1. _d 0/86400. _d 0
0050 sigma_b = 0.7 _d 0
b4656da4c6 Jean*0051
0052
0053 DO j=0,sNy+1
0054 DO i=1,sNx+1
aea360aa02 Jean*0055 IF ( hFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN
b4656da4c6 Jean*0056 recip_P0g=MAX(recip_Rcol(i,j,bi,bj),recip_Rcol(i-1,j,bi,bj))
aea360aa02 Jean*0057 termP=0.5 _d 0*( MIN(rF(kLev)*recip_P0g,1. _d 0)
0058 & +rF(kLev+1)*recip_P0g )
b4656da4c6 Jean*0059
aea360aa02 Jean*0060 kV=kF*MAX( 0. _d 0, (termP-sigma_b)/(1. _d 0-sigma_b) )
42c525bfb4 Alis*0061 gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)
b4656da4c6 Jean*0062 & -kV*uVel(i,j,kLev,bi,bj)
42c525bfb4 Alis*0063 ENDIF
0064 ENDDO
0065 ENDDO
0066
0067 RETURN
0068 END
b4656da4c6 Jean*0069
0070
0071
0072
0073
42c525bfb4 Alis*0074 SUBROUTINE EXTERNAL_FORCING_V(
b4656da4c6 Jean*0075 I iMin,iMax, jMin,jMax, bi,bj, kLev,
0076 I myTime, myThid )
0077
0078
0079
0080
0081
0082
0083
0084
0085
42c525bfb4 Alis*0086
b4656da4c6 Jean*0087
0088 IMPLICIT NONE
42c525bfb4 Alis*0089
0090 #include "SIZE.h"
0091 #include "EEPARAMS.h"
0092 #include "PARAMS.h"
0093 #include "GRID.h"
0094 #include "DYNVARS.h"
0095 #include "FFIELDS.h"
0096
b4656da4c6 Jean*0097
42c525bfb4 Alis*0098
b4656da4c6 Jean*0099
0100
0101
0102
0103
0104
42c525bfb4 Alis*0105 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
b4656da4c6 Jean*0106 _RL myTime
42c525bfb4 Alis*0107 INTEGER myThid
b4656da4c6 Jean*0108
0109
42c525bfb4 Alis*0110
b4656da4c6 Jean*0111
0112 INTEGER i, j
0113
0114 _RL recip_P0g, termP, kV, kF, sigma_b
42c525bfb4 Alis*0115
aea29c8517 Alis*0116
aea360aa02 Jean*0117 kF=1. _d 0/86400. _d 0
0118 sigma_b = 0.7 _d 0
b4656da4c6 Jean*0119 DO j=1,sNy+1
0120
0121
0122 DO i=0,sNx+1
aea360aa02 Jean*0123 IF ( hFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN
b4656da4c6 Jean*0124 recip_P0g=MAX(recip_Rcol(i,j,bi,bj),recip_Rcol(i,j-1,bi,bj))
aea360aa02 Jean*0125 termP=0.5 _d 0*( MIN(rF(kLev)*recip_P0g,1. _d 0)
0126 & +rF(kLev+1)*recip_P0g )
b4656da4c6 Jean*0127
aea360aa02 Jean*0128 kV=kF*MAX( 0. _d 0, (termP-sigma_b)/(1. _d 0-sigma_b) )
42c525bfb4 Alis*0129 gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)
0130 & -kV*vVel(i,j,kLev,bi,bj)
0131 ENDIF
0132 ENDDO
0133 ENDDO
0134
0135 RETURN
0136 END
b4656da4c6 Jean*0137
0138
0139
0140
0141
42c525bfb4 Alis*0142 SUBROUTINE EXTERNAL_FORCING_T(
b4656da4c6 Jean*0143 I iMin,iMax, jMin,jMax, bi,bj, kLev,
0144 I myTime, myThid )
0145
0146
0147
0148
0149
0150
0151
0152
0153
42c525bfb4 Alis*0154
b4656da4c6 Jean*0155
0156 IMPLICIT NONE
42c525bfb4 Alis*0157
0158 #include "SIZE.h"
0159 #include "EEPARAMS.h"
0160 #include "PARAMS.h"
0161 #include "GRID.h"
0162 #include "DYNVARS.h"
0163 #include "FFIELDS.h"
0164
b4656da4c6 Jean*0165
42c525bfb4 Alis*0166
b4656da4c6 Jean*0167
0168
0169
0170
0171
0172
42c525bfb4 Alis*0173 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
b4656da4c6 Jean*0174 _RL myTime
42c525bfb4 Alis*0175 INTEGER myThid
0176
b4656da4c6 Jean*0177
42c525bfb4 Alis*0178
b4656da4c6 Jean*0179
0180 INTEGER i, j
0181
aea360aa02 Jean*0182 _RL thetaLim,kT,ka,ks,sigma_b,term1,term2,thetaEq,termP
42c525bfb4 Alis*0183
aea29c8517 Alis*0184
0b7f1f1573 Alis*0185 ka=1. _d 0/(40. _d 0*86400. _d 0)
0186 ks=1. _d 0/(4. _d 0 *86400. _d 0)
aea360aa02 Jean*0187 sigma_b = 0.7 _d 0
b4656da4c6 Jean*0188 DO j=1,sNy
0189 DO i=1,sNx
0190 term1=60. _d 0*(SIN(yC(i,j,bi,bj)*deg2rad)**2)
aea360aa02 Jean*0191 termP=0.5 _d 0*( rF(kLev) + rF(kLev+1) )
b4656da4c6 Jean*0192 term2=10. _d 0*LOG(termP/atm_po)
0193 & *(COS(yC(i,j,bi,bj)*deg2rad)**2)
aea360aa02 Jean*0194 thetaLim = 200. _d 0/ ((termP/atm_po)**atm_kappa)
0195 thetaEq=315. _d 0-term1-term2
0196 thetaEq=MAX(thetaLim,thetaEq)
b4656da4c6 Jean*0197 termP=0.5 _d 0*( MIN(rF(kLev),Ro_surf(i,j,bi,bj))+rF(kLev+1) )
aea360aa02 Jean*0198 kT=ka+(ks-ka)
0199 & *MAX(0. _d 0,
b4656da4c6 Jean*0200 & (termP*recip_Rcol(i,j,bi,bj)-sigma_b)/(1. _d 0-sigma_b) )
0201 & *COS((yC(i,j,bi,bj)*deg2rad))**4
42c525bfb4 Alis*0202 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
b4656da4c6 Jean*0203 & - kT*( theta(i,j,kLev,bi,bj)-thetaEq )
aea29c8517 Alis*0204 & *maskC(i,j,kLev,bi,bj)
42c525bfb4 Alis*0205 ENDDO
0206 ENDDO
0207
0208 RETURN
0209 END
b4656da4c6 Jean*0210
0211
0212
0213
0214
42c525bfb4 Alis*0215 SUBROUTINE EXTERNAL_FORCING_S(
b4656da4c6 Jean*0216 I iMin,iMax, jMin,jMax, bi,bj, kLev,
0217 I myTime, myThid )
0218
0219
0220
0221
0222
0223
0224
0225
0226
0227
42c525bfb4 Alis*0228
b4656da4c6 Jean*0229
0230 IMPLICIT NONE
42c525bfb4 Alis*0231
0232 #include "SIZE.h"
0233 #include "EEPARAMS.h"
0234 #include "PARAMS.h"
0235 #include "GRID.h"
0236 #include "DYNVARS.h"
0237 #include "FFIELDS.h"
0238
b4656da4c6 Jean*0239
42c525bfb4 Alis*0240
b4656da4c6 Jean*0241
0242
0243
0244
0245
0246
42c525bfb4 Alis*0247 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
b4656da4c6 Jean*0248 _RL myTime
42c525bfb4 Alis*0249 INTEGER myThid
0250
b4656da4c6 Jean*0251
42c525bfb4 Alis*0252
b4656da4c6 Jean*0253
0254
0255
42c525bfb4 Alis*0256
aea29c8517 Alis*0257
42c525bfb4 Alis*0258
0259 RETURN
0260 END