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
7f5e08d1f6 Jean*0003
0004
0005
0006
0007
0008
0009
0010
b4656da4c6 Jean*0011
7f5e08d1f6 Jean*0012
b4656da4c6 Jean*0013
7f5e08d1f6 Jean*0014 SUBROUTINE APPLY_FORCING_U(
0015 U gU_arr,
0016 I iMin,iMax,jMin,jMax, k, bi, bj,
0017 I myTime, myIter, myThid )
b4656da4c6 Jean*0018
0019
7f5e08d1f6 Jean*0020
b4656da4c6 Jean*0021
0022
0023
0024
0025
0026
42c525bfb4 Alis*0027
b4656da4c6 Jean*0028
0029 IMPLICIT NONE
42c525bfb4 Alis*0030
0031 #include "SIZE.h"
0032 #include "EEPARAMS.h"
0033 #include "PARAMS.h"
0034 #include "GRID.h"
87b33dbab2 Jean*0035 #include "SURFACE.h"
42c525bfb4 Alis*0036 #include "DYNVARS.h"
0037 #include "FFIELDS.h"
0038
b4656da4c6 Jean*0039
7f5e08d1f6 Jean*0040
b4656da4c6 Jean*0041
0042
7f5e08d1f6 Jean*0043
b4656da4c6 Jean*0044
0045
7f5e08d1f6 Jean*0046
0047
0048 _RL gU_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0049 INTEGER iMin, iMax, jMin, jMax
0050 INTEGER k, bi, bj
0051 _RL myTime
0052 INTEGER myIter
42c525bfb4 Alis*0053 INTEGER myThid
0054
b4656da4c6 Jean*0055
0056
0057 INTEGER i, j
0058
87b33dbab2 Jean*0059 _RL recip_P0g, termP, rFullDepth
0060 _RL kV, kF, sigma_b
42c525bfb4 Alis*0061
7f5e08d1f6 Jean*0062
0063 kF = 1. _d 0/86400. _d 0
b4656da4c6 Jean*0064 sigma_b = 0.7 _d 0
87b33dbab2 Jean*0065 rFullDepth = rF(1)-rF(Nr+1)
b4656da4c6 Jean*0066
0067
0068 DO j=0,sNy+1
0069 DO i=1,sNx+1
7f5e08d1f6 Jean*0070 IF ( maskW(i,j,k,bi,bj).EQ.oneRS ) THEN
87b33dbab2 Jean*0071 IF ( selectSigmaCoord.EQ.0 ) THEN
0072 recip_P0g = MAX(recip_Rcol(i,j,bi,bj),recip_Rcol(i-1,j,bi,bj))
0073 termP = 0.5 _d 0*( MIN( rF(k)*recip_P0g, oneRL )
0074 & +rF(k+1)*recip_P0g )
0075
0076 ELSE
0077
0078
0079
0080
0081
0082
0083
0084
0085 termP = aHybSigmC(k)*rFullDepth
0086 #ifdef NONLIN_FRSURF
0087 & /(etaHw(i,j,bi,bj)+rSurfW(i,j,bi,bj)-rLowW(i,j,bi,bj))
0088 #else
0089 & /(rSurfW(i,j,bi,bj)-rLowW(i,j,bi,bj))
0090 #endif
0091 & + bHybSigmC(k)
0092 ENDIF
7f5e08d1f6 Jean*0093 kV = kF*MAX( zeroRL, (termP-sigma_b)/(1. _d 0-sigma_b) )
0094 gU_arr(i,j) = gU_arr(i,j)
0095 & - kV*uVel(i,j,k,bi,bj)
42c525bfb4 Alis*0096 ENDIF
0097 ENDDO
0098 ENDDO
0099
0100 RETURN
0101 END
b4656da4c6 Jean*0102
0103
0104
7f5e08d1f6 Jean*0105
b4656da4c6 Jean*0106
7f5e08d1f6 Jean*0107 SUBROUTINE APPLY_FORCING_V(
0108 U gV_arr,
0109 I iMin,iMax,jMin,jMax, k, bi, bj,
0110 I myTime, myIter, myThid )
b4656da4c6 Jean*0111
0112
7f5e08d1f6 Jean*0113
b4656da4c6 Jean*0114
0115
0116
0117
0118
0119
42c525bfb4 Alis*0120
b4656da4c6 Jean*0121
0122 IMPLICIT NONE
42c525bfb4 Alis*0123
0124 #include "SIZE.h"
0125 #include "EEPARAMS.h"
0126 #include "PARAMS.h"
0127 #include "GRID.h"
87b33dbab2 Jean*0128 #include "SURFACE.h"
42c525bfb4 Alis*0129 #include "DYNVARS.h"
0130 #include "FFIELDS.h"
0131
b4656da4c6 Jean*0132
7f5e08d1f6 Jean*0133
b4656da4c6 Jean*0134
0135
7f5e08d1f6 Jean*0136
b4656da4c6 Jean*0137
0138
7f5e08d1f6 Jean*0139
0140
0141 _RL gV_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0142 INTEGER iMin, iMax, jMin, jMax
0143 INTEGER k, bi, bj
0144 _RL myTime
0145 INTEGER myIter
42c525bfb4 Alis*0146 INTEGER myThid
b4656da4c6 Jean*0147
0148
0149
0150 INTEGER i, j
0151
87b33dbab2 Jean*0152 _RL recip_P0g, termP, rFullDepth
0153 _RL kV, kF, sigma_b
42c525bfb4 Alis*0154
7f5e08d1f6 Jean*0155
0156 kF = 1. _d 0/86400. _d 0
b4656da4c6 Jean*0157 sigma_b = 0.7 _d 0
87b33dbab2 Jean*0158 rFullDepth = rF(1)-rF(Nr+1)
b4656da4c6 Jean*0159 DO j=1,sNy+1
0160
0161
0162 DO i=0,sNx+1
7f5e08d1f6 Jean*0163 IF ( maskS(i,j,k,bi,bj).EQ.oneRS ) THEN
87b33dbab2 Jean*0164 IF ( selectSigmaCoord.EQ.0 ) THEN
0165 recip_P0g = MAX(recip_Rcol(i,j,bi,bj),recip_Rcol(i,j-1,bi,bj))
0166 termP = 0.5 _d 0*( MIN( rF(k)*recip_P0g, oneRL )
0167 & +rF(k+1)*recip_P0g )
0168
0169 ELSE
0170
0171
0172
0173
0174
0175
0176
0177
0178 termP = aHybSigmC(k)*rFullDepth
0179 #ifdef NONLIN_FRSURF
0180 & /(etaHs(i,j,bi,bj)+rSurfS(i,j,bi,bj)-rLowS(i,j,bi,bj))
0181 #else
0182 & /(rSurfS(i,j,bi,bj)-rLowS(i,j,bi,bj))
0183 #endif
0184 & + bHybSigmC(k)
0185 ENDIF
7f5e08d1f6 Jean*0186 kV = kF*MAX( zeroRL, (termP-sigma_b)/(1. _d 0-sigma_b) )
0187 gV_arr(i,j) = gV_arr(i,j)
0188 & - kV*vVel(i,j,k,bi,bj)
42c525bfb4 Alis*0189 ENDIF
0190 ENDDO
0191 ENDDO
0192
0193 RETURN
0194 END
b4656da4c6 Jean*0195
0196
0197
7f5e08d1f6 Jean*0198
b4656da4c6 Jean*0199
7f5e08d1f6 Jean*0200 SUBROUTINE APPLY_FORCING_T(
0201 U gT_arr,
0202 I iMin,iMax,jMin,jMax, k, bi, bj,
0203 I myTime, myIter, myThid )
b4656da4c6 Jean*0204
0205
7f5e08d1f6 Jean*0206
b4656da4c6 Jean*0207
0208
0209
0210
0211
0212
42c525bfb4 Alis*0213
b4656da4c6 Jean*0214
0215 IMPLICIT NONE
42c525bfb4 Alis*0216
0217 #include "SIZE.h"
0218 #include "EEPARAMS.h"
0219 #include "PARAMS.h"
0220 #include "GRID.h"
0221 #include "DYNVARS.h"
0222 #include "FFIELDS.h"
0223
b4656da4c6 Jean*0224
7f5e08d1f6 Jean*0225
b4656da4c6 Jean*0226
0227
7f5e08d1f6 Jean*0228
b4656da4c6 Jean*0229
0230
7f5e08d1f6 Jean*0231
0232
0233 _RL gT_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0234 INTEGER iMin, iMax, jMin, jMax
0235 INTEGER k, bi, bj
0236 _RL myTime
0237 INTEGER myIter
42c525bfb4 Alis*0238 INTEGER myThid
0239
b4656da4c6 Jean*0240
0241
7f5e08d1f6 Jean*0242
b4656da4c6 Jean*0243 INTEGER i, j
0244
87b33dbab2 Jean*0245 _RL thetaLim, kT, ka, ks, sigma_b, term1, term2, thetaEq
0246 _RL termP, rFullDepth
42c525bfb4 Alis*0247
7f5e08d1f6 Jean*0248
0249 ka = 1. _d 0/(40. _d 0*86400. _d 0)
0250 ks = 1. _d 0/(4. _d 0 *86400. _d 0)
b4656da4c6 Jean*0251 sigma_b = 0.7 _d 0
87b33dbab2 Jean*0252 rFullDepth = rF(1)-rF(Nr+1)
0253 DO j=0,sNy+1
0254 DO i=0,sNx+1
7f5e08d1f6 Jean*0255 term1 = 60. _d 0*(SIN(yC(i,j,bi,bj)*deg2rad)**2)
0256 termP = 0.5 _d 0*( rF(k) + rF(k+1) )
0257 term2 = 10. _d 0*LOG(termP/atm_po)
b4656da4c6 Jean*0258 & *(COS(yC(i,j,bi,bj)*deg2rad)**2)
0259 thetaLim = 200. _d 0/ ((termP/atm_po)**atm_kappa)
87b33dbab2 Jean*0260 thetaEq = 315. _d 0 - term1 - term2
7f5e08d1f6 Jean*0261 thetaEq = MAX(thetaLim,thetaEq)
87b33dbab2 Jean*0262 IF ( selectSigmaCoord.EQ.0 ) THEN
0263 termP = 0.5 _d 0*( MIN(rF(k),Ro_surf(i,j,bi,bj))
0264 & + rF(k+1) )
0265 & *recip_Rcol(i,j,bi,bj)
0266 ELSE
0267
0268
0269
0270
0271
0272
0273
0274
0275 termP = aHybSigmC(k)*rFullDepth
0276 #ifdef NONLIN_FRSURF
0277 & /(etaH(i,j,bi,bj)+Ro_surf(i,j,bi,bj)-R_low(i,j,bi,bj))
0278 #else
0279 & /(Ro_surf(i,j,bi,bj)-R_low(i,j,bi,bj))
0280 #endif
0281 & + bHybSigmC(k)
0282 ENDIF
7f5e08d1f6 Jean*0283 kT = ka+(ks-ka)
87b33dbab2 Jean*0284 & *MAX( zeroRL, (termP-sigma_b)/(1. _d 0-sigma_b) )
7f5e08d1f6 Jean*0285 & *COS((yC(i,j,bi,bj)*deg2rad))**4
0286 gT_arr(i,j) = gT_arr(i,j)
0287 & - kT*( theta(i,j,k,bi,bj)-thetaEq )
0288 & *maskC(i,j,k,bi,bj)
42c525bfb4 Alis*0289 ENDDO
0290 ENDDO
0291
0292 RETURN
0293 END
b4656da4c6 Jean*0294
0295
0296
7f5e08d1f6 Jean*0297
b4656da4c6 Jean*0298
7f5e08d1f6 Jean*0299 SUBROUTINE APPLY_FORCING_S(
0300 U gS_arr,
0301 I iMin,iMax,jMin,jMax, k, bi, bj,
0302 I myTime, myIter, myThid )
b4656da4c6 Jean*0303
0304
7f5e08d1f6 Jean*0305
b4656da4c6 Jean*0306
0307
0308
0309
0310
0311
0312
0313
0314 IMPLICIT NONE
42c525bfb4 Alis*0315
0316 #include "SIZE.h"
0317 #include "EEPARAMS.h"
0318 #include "PARAMS.h"
0319 #include "GRID.h"
0320 #include "DYNVARS.h"
0321 #include "FFIELDS.h"
7f5e08d1f6 Jean*0322 #include "SURFACE.h"
42c525bfb4 Alis*0323
b4656da4c6 Jean*0324
7f5e08d1f6 Jean*0325
b4656da4c6 Jean*0326
0327
7f5e08d1f6 Jean*0328
b4656da4c6 Jean*0329
0330
7f5e08d1f6 Jean*0331
0332
0333 _RL gS_arr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
0334 INTEGER iMin, iMax, jMin, jMax
0335 INTEGER k, bi, bj
0336 _RL myTime
0337 INTEGER myIter
42c525bfb4 Alis*0338 INTEGER myThid
0339
b4656da4c6 Jean*0340
0341
0342
0343
42c525bfb4 Alis*0344
7f5e08d1f6 Jean*0345
42c525bfb4 Alis*0346
0347 RETURN
0348 END