File indexing completed on 2018-03-02 18:36:41 UTC
view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
6d54cf9ca1 Ed H*0001 #include "PACKAGES_CONFIG.h"
b734cf7153 Chri*0002 #include "CPP_OPTIONS.h"
0003
985d9b22ad Jean*0004
0005
0006
0007
0008
0009
0010
0011
9366854e02 Chri*0012
0013
0014
b734cf7153 Chri*0015 SUBROUTINE EXTERNAL_FORCING_U(
285db1597f Jean*0016 I iMin,iMax, jMin,jMax, bi,bj, kLev,
0017 I myTime, myThid )
9366854e02 Chri*0018
0019
285db1597f Jean*0020
0021
9366854e02 Chri*0022
285db1597f Jean*0023
0024
9366854e02 Chri*0025
0026
0027
0028
1dbaea09ee Chri*0029 IMPLICIT NONE
b734cf7153 Chri*0030
0031 #include "SIZE.h"
0032 #include "EEPARAMS.h"
0033 #include "PARAMS.h"
0034 #include "GRID.h"
0035 #include "DYNVARS.h"
1dbaea09ee Chri*0036 #include "FFIELDS.h"
9366854e02 Chri*0037
0038
b734cf7153 Chri*0039
285db1597f Jean*0040
0041
0042
0043
0044
0045
b734cf7153 Chri*0046 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
285db1597f Jean*0047 _RL myTime
39b995119f Alis*0048 INTEGER myThid
b734cf7153 Chri*0049
b0340e9e76 Jean*0050 #ifdef USE_OLD_EXTERNAL_FORCING
9366854e02 Chri*0051
1dbaea09ee Chri*0052
285db1597f Jean*0053
015ef567d5 Jean*0054
285db1597f Jean*0055 INTEGER i, j
e305438401 Mart*0056 INTEGER kSurface
9366854e02 Chri*0057
1dbaea09ee Chri*0058
9669509dca Jean*0059 IF ( fluidIsAir ) THEN
861b393501 Jean*0060 kSurface = 0
9669509dca Jean*0061 ELSEIF ( usingPCoords ) THEN
e305438401 Mart*0062 kSurface = Nr
9669509dca Jean*0063 ELSE
e305438401 Mart*0064 kSurface = 1
9669509dca Jean*0065 ENDIF
e305438401 Mart*0066
1dbaea09ee Chri*0067
861b393501 Jean*0068 #ifdef ALLOW_AIM
0069 IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
45e6cba2ac Jean*0070 U gU(1-OLx,1-OLy,kLev,bi,bj),
0071 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0072 I myTime, 0, myThid )
861b393501 Jean*0073 #endif /* ALLOW_AIM */
285db1597f Jean*0074
123913d7e9 Jean*0075 #ifdef ALLOW_ATM_PHYS
0076 IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_U(
45e6cba2ac Jean*0077 U gU(1-OLx,1-OLy,kLev,bi,bj),
0078 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0079 I myTime, 0, myThid )
123913d7e9 Jean*0080 #endif /* ALLOW_ATM_PHYS */
0081
468f196fcd Andr*0082 #ifdef ALLOW_FIZHI
0083 IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
45e6cba2ac Jean*0084 U gU(1-OLx,1-OLy,kLev,bi,bj),
0085 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0086 I myTime, 0, myThid )
468f196fcd Andr*0087 #endif /* ALLOW_FIZHI */
861b393501 Jean*0088
015ef567d5 Jean*0089
e305438401 Mart*0090 IF ( kLev .EQ. kSurface ) THEN
2d2555797b Jean*0091
0092
0093 DO j=0,sNy+1
285db1597f Jean*0094 DO i=1,sNx+1
985d9b22ad Jean*0095 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
0096 & +foFacMom*surfaceForcingU(i,j,bi,bj)
0097 & *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
0098 ENDDO
0099 ENDDO
0100 ELSEIF ( kSurface.EQ.-1 ) THEN
0101 DO j=0,sNy+1
0102 DO i=1,sNx+1
0103 IF ( kSurfW(i,j,bi,bj).EQ.kLev ) THEN
0104 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
0105 & +foFacMom*surfaceForcingU(i,j,bi,bj)
0106 & *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
0107 ENDIF
1dbaea09ee Chri*0108 ENDDO
0109 ENDDO
0110 ENDIF
0111
43af9695da Gael*0112 #ifdef ALLOW_EDDYPSI
45e6cba2ac Jean*0113 CALL TAUEDDY_TENDENCY_APPLY_U(
0114 U gU(1-OLx,1-OLy,kLev,bi,bj),
0115 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0116 I myTime, 0, myThid )
ac957095b5 Patr*0117 #endif
0118
6515c77b5c Jean*0119 #ifdef ALLOW_RBCS
0120 IF (useRBCS) THEN
45e6cba2ac Jean*0121 CALL RBCS_ADD_TENDENCY(
0122 U gU(1-OLx,1-OLy,kLev,bi,bj),
0123 I kLev, bi, bj, -1,
0124 I myTime, 0, myThid )
0125
6515c77b5c Jean*0126 ENDIF
45e6cba2ac Jean*0127 #endif /* ALLOW_RBCS */
6515c77b5c Jean*0128
285db1597f Jean*0129 #ifdef ALLOW_OBCS
b275747e24 Patr*0130 IF (useOBCS) THEN
45e6cba2ac Jean*0131 CALL OBCS_SPONGE_U(
0132 U gU(1-OLx,1-OLy,kLev,bi,bj),
0133 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0134 I myTime, 0, myThid )
b275747e24 Patr*0135 ENDIF
45e6cba2ac Jean*0136 #endif /* ALLOW_OBCS */
4c6b97badf Patr*0137
2d9d0bc0a6 Jean*0138 #ifdef ALLOW_MYPACKAGE
45e6cba2ac Jean*0139 IF ( useMYPACKAGE ) THEN
0140 CALL MYPACKAGE_TENDENCY_APPLY_U(
0141 U gU(1-OLx,1-OLy,kLev,bi,bj),
0142 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0143 I myTime, 0, myThid )
0144 ENDIF
2d9d0bc0a6 Jean*0145 #endif /* ALLOW_MYPACKAGE */
0146
b0340e9e76 Jean*0147 #endif /* USE_OLD_EXTERNAL_FORCING */
b734cf7153 Chri*0148 RETURN
0149 END
285db1597f Jean*0150
0151
9366854e02 Chri*0152
0153
0154
b734cf7153 Chri*0155 SUBROUTINE EXTERNAL_FORCING_V(
285db1597f Jean*0156 I iMin,iMax, jMin,jMax, bi,bj, kLev,
0157 I myTime, myThid )
9366854e02 Chri*0158
0159
285db1597f Jean*0160
0161
9366854e02 Chri*0162
285db1597f Jean*0163
0164
9366854e02 Chri*0165
0166
0167
0168
1dbaea09ee Chri*0169 IMPLICIT NONE
b734cf7153 Chri*0170
0171 #include "SIZE.h"
0172 #include "EEPARAMS.h"
0173 #include "PARAMS.h"
0174 #include "GRID.h"
0175 #include "DYNVARS.h"
1dbaea09ee Chri*0176 #include "FFIELDS.h"
0177
9366854e02 Chri*0178
b734cf7153 Chri*0179
285db1597f Jean*0180
0181
0182
0183
0184
0185
b734cf7153 Chri*0186 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
285db1597f Jean*0187 _RL myTime
39b995119f Alis*0188 INTEGER myThid
9366854e02 Chri*0189
b0340e9e76 Jean*0190 #ifdef USE_OLD_EXTERNAL_FORCING
9366854e02 Chri*0191
1dbaea09ee Chri*0192
285db1597f Jean*0193
015ef567d5 Jean*0194
285db1597f Jean*0195 INTEGER i, j
e305438401 Mart*0196 INTEGER kSurface
9366854e02 Chri*0197
1dbaea09ee Chri*0198
9669509dca Jean*0199 IF ( fluidIsAir ) THEN
861b393501 Jean*0200 kSurface = 0
9669509dca Jean*0201 ELSEIF ( usingPCoords ) THEN
e305438401 Mart*0202 kSurface = Nr
9669509dca Jean*0203 ELSE
e305438401 Mart*0204 kSurface = 1
9669509dca Jean*0205 ENDIF
e305438401 Mart*0206
1dbaea09ee Chri*0207
861b393501 Jean*0208 #ifdef ALLOW_AIM
0209 IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
45e6cba2ac Jean*0210 U gV(1-OLx,1-OLy,kLev,bi,bj),
0211 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0212 I myTime, 0, myThid )
861b393501 Jean*0213 #endif /* ALLOW_AIM */
0214
123913d7e9 Jean*0215 #ifdef ALLOW_ATM_PHYS
0216 IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_V(
45e6cba2ac Jean*0217 U gV(1-OLx,1-OLy,kLev,bi,bj),
0218 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0219 I myTime, 0, myThid )
123913d7e9 Jean*0220 #endif /* ALLOW_ATM_PHYS */
0221
468f196fcd Andr*0222 #ifdef ALLOW_FIZHI
0223 IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
45e6cba2ac Jean*0224 U gV(1-OLx,1-OLy,kLev,bi,bj),
0225 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0226 I myTime, 0, myThid )
468f196fcd Andr*0227 #endif /* ALLOW_FIZHI */
285db1597f Jean*0228
015ef567d5 Jean*0229
e305438401 Mart*0230 IF ( kLev .EQ. kSurface ) THEN
285db1597f Jean*0231 DO j=1,sNy+1
2d2555797b Jean*0232
0233
0234 DO i=0,sNx+1
985d9b22ad Jean*0235 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
0236 & +foFacMom*surfaceForcingV(i,j,bi,bj)
0237 & *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
0238 ENDDO
0239 ENDDO
0240 ELSEIF ( kSurface.EQ.-1 ) THEN
0241 DO j=1,sNy+1
0242 DO i=0,sNx+1
0243 IF ( kSurfS(i,j,bi,bj).EQ.kLev ) THEN
0244 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
0245 & +foFacMom*surfaceForcingV(i,j,bi,bj)
0246 & *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
0247 ENDIF
1dbaea09ee Chri*0248 ENDDO
0249 ENDDO
0250 ENDIF
b734cf7153 Chri*0251
43af9695da Gael*0252 #ifdef ALLOW_EDDYPSI
45e6cba2ac Jean*0253 CALL TAUEDDY_TENDENCY_APPLY_V(
0254 U gV(1-OLx,1-OLy,kLev,bi,bj),
0255 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0256 I myTime, 0, myThid )
ac957095b5 Patr*0257 #endif
0258
6515c77b5c Jean*0259 #ifdef ALLOW_RBCS
0260 IF (useRBCS) THEN
45e6cba2ac Jean*0261 CALL RBCS_ADD_TENDENCY(
0262 U gV(1-OLx,1-OLy,kLev,bi,bj),
0263 I kLev, bi, bj, -2,
0264 I myTime, 0, myThid )
6515c77b5c Jean*0265 ENDIF
45e6cba2ac Jean*0266 #endif /* ALLOW_RBCS */
6515c77b5c Jean*0267
285db1597f Jean*0268 #ifdef ALLOW_OBCS
b275747e24 Patr*0269 IF (useOBCS) THEN
45e6cba2ac Jean*0270 CALL OBCS_SPONGE_V(
0271 U gV(1-OLx,1-OLy,kLev,bi,bj),
0272 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0273 I myTime, 0, myThid )
b275747e24 Patr*0274 ENDIF
45e6cba2ac Jean*0275 #endif /* ALLOW_OBCS */
4c6b97badf Patr*0276
2d9d0bc0a6 Jean*0277 #ifdef ALLOW_MYPACKAGE
45e6cba2ac Jean*0278 IF ( useMYPACKAGE ) THEN
0279 CALL MYPACKAGE_TENDENCY_APPLY_V(
0280 U gV(1-OLx,1-OLy,kLev,bi,bj),
0281 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0282 I myTime, 0, myThid )
0283 ENDIF
2d9d0bc0a6 Jean*0284 #endif /* ALLOW_MYPACKAGE */
0285
b0340e9e76 Jean*0286 #endif /* USE_OLD_EXTERNAL_FORCING */
b734cf7153 Chri*0287 RETURN
0288 END
285db1597f Jean*0289
0290
9366854e02 Chri*0291
0292
0293
b734cf7153 Chri*0294 SUBROUTINE EXTERNAL_FORCING_T(
285db1597f Jean*0295 I iMin,iMax, jMin,jMax, bi,bj, kLev,
0296 I myTime, myThid )
9366854e02 Chri*0297
0298
285db1597f Jean*0299
0300
9366854e02 Chri*0301
285db1597f Jean*0302
0303
9366854e02 Chri*0304
0305
0306
0307
1dbaea09ee Chri*0308 IMPLICIT NONE
b734cf7153 Chri*0309
0310 #include "SIZE.h"
0311 #include "EEPARAMS.h"
0312 #include "PARAMS.h"
0313 #include "GRID.h"
0314 #include "DYNVARS.h"
0315 #include "FFIELDS.h"
f2d1ba7d38 Davi*0316 #include "SURFACE.h"
77af23a186 Patr*0317
9366854e02 Chri*0318
b734cf7153 Chri*0319
285db1597f Jean*0320
0321
0322
0323
0324
0325
b734cf7153 Chri*0326 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
285db1597f Jean*0327 _RL myTime
39b995119f Alis*0328 INTEGER myThid
b734cf7153 Chri*0329
b0340e9e76 Jean*0330 #ifdef USE_OLD_EXTERNAL_FORCING
9366854e02 Chri*0331
1dbaea09ee Chri*0332
285db1597f Jean*0333
015ef567d5 Jean*0334
285db1597f Jean*0335 INTEGER i, j
e305438401 Mart*0336 INTEGER kSurface
015ef567d5 Jean*0337 INTEGER km, kc, kp
0338 _RL tmpVar(1:sNx,1:sNy)
0339 _RL tmpFac, delPI
faf82d94de Patr*0340 _RL recip_Cp
285db1597f Jean*0341
7b9cf8f7da Jean*0342 #ifdef SHORTWAVE_HEATING
0343 _RL minusone
015ef567d5 Jean*0344 PARAMETER (minusOne=-1.)
0345 _RL swfracb(2)
7b9cf8f7da Jean*0346 INTEGER kp1
0347 #endif
1dbaea09ee Chri*0348
9669509dca Jean*0349 IF ( fluidIsAir ) THEN
861b393501 Jean*0350 kSurface = 0
985d9b22ad Jean*0351 ELSEIF ( usingZCoords .AND. useShelfIce ) THEN
0352 kSurface = -1
9669509dca Jean*0353 ELSEIF ( usingPCoords ) THEN
e305438401 Mart*0354 kSurface = Nr
9669509dca Jean*0355 ELSE
e305438401 Mart*0356 kSurface = 1
9669509dca Jean*0357 ENDIF
faf82d94de Patr*0358 recip_Cp = 1. _d 0 / HeatCapacity_Cp
e305438401 Mart*0359
1dbaea09ee Chri*0360
861b393501 Jean*0361 #ifdef ALLOW_AIM
0362 IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
45e6cba2ac Jean*0363 U gT(1-OLx,1-OLy,kLev,bi,bj),
0364 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0365 I myTime, 0, myThid )
861b393501 Jean*0366 #endif /* ALLOW_AIM */
0367
123913d7e9 Jean*0368 #ifdef ALLOW_ATM_PHYS
0369 IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_T(
45e6cba2ac Jean*0370 U gT(1-OLx,1-OLy,kLev,bi,bj),
0371 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0372 I myTime, 0, myThid )
123913d7e9 Jean*0373 #endif /* ALLOW_ATM_PHYS */
0374
468f196fcd Andr*0375 #ifdef ALLOW_FIZHI
0376 IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
45e6cba2ac Jean*0377 U gT(1-OLx,1-OLy,kLev,bi,bj),
0378 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0379 I myTime, 0, myThid )
468f196fcd Andr*0380 #endif /* ALLOW_FIZHI */
d8206d87ee Patr*0381
1387d73548 Jean*0382 #ifdef ALLOW_ADDFLUID
80d98e0151 Dimi*0383 IF ( selectAddFluid.NE.0 .AND. temp_addMass.NE.UNSET_RL ) THEN
1387d73548 Jean*0384 IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
0385 & .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
0386 DO j=1,sNy
0387 DO i=1,sNx
0388 gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
0389 & + addMass(i,j,kLev,bi,bj)*mass2rUnit
80d98e0151 Dimi*0390 & *( temp_addMass - theta(i,j,kLev,bi,bj) )
1387d73548 Jean*0391 & *recip_rA(i,j,bi,bj)
0392 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0393
0394 ENDDO
0395 ENDDO
0396 ELSE
0397 DO j=1,sNy
0398 DO i=1,sNx
0399 gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
0400 & + addMass(i,j,kLev,bi,bj)*mass2rUnit
80d98e0151 Dimi*0401 & *( temp_addMass - tRef(kLev) )
1387d73548 Jean*0402 & *recip_rA(i,j,bi,bj)
0403 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0404
0405 ENDDO
0406 ENDDO
0407 ENDIF
0408 ENDIF
0409 #endif /* ALLOW_ADDFLUID */
0410
a7ae998c8d Jean*0411 #ifdef ALLOW_FRICTION_HEATING
0412 IF ( addFrictionHeating ) THEN
0413 IF ( fluidIsAir ) THEN
0414
0415 tmpFac = (atm_Po/rC(kLev))**atm_kappa
0416
0417 tmpFac = (tmpFac/atm_Cp) * mass2rUnit
0418 ELSE
0419
faf82d94de Patr*0420 tmpFac = recip_Cp * mass2rUnit
a7ae998c8d Jean*0421 ENDIF
0422 DO j=1,sNy
0423 DO i=1,sNx
0424 gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
e24c9bfc82 Jean*0425 & + frictionHeating(i,j,k,bi,bj)*tmpFac
a7ae998c8d Jean*0426 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0427 ENDDO
0428 ENDDO
0429 ENDIF
0430 #endif /* ALLOW_FRICTION_HEATING */
0431
015ef567d5 Jean*0432 IF ( fluidIsAir .AND. atm_Rq.NE.zeroRL .AND. Nr.NE.1 ) THEN
0433
0434
0435
0436
0437
0438
0439
0440
0441 tmpFac = (atm_Po/rC(kLev))**atm_kappa
0442
0443 tmpFac = tmpFac/atm_Cp
0444 km = kLev-1
0445 kc = kLev
0446 kp = kLev+1
0447 IF ( kLev.EQ.1 ) THEN
0448 DO j=1,sNy
0449 DO i=1,sNx
0450 tmpVar(i,j) = 0.
0451 ENDDO
0452 ENDDO
0453 ELSE
0454 delPI = atm_Cp*( (rC(km)/atm_Po)**atm_kappa
0455 & - (rC(kc)/atm_Po)**atm_kappa )
0456 DO j=1,sNy
0457 DO i=1,sNx
0458 tmpVar(i,j) = wVel(i,j,kc,bi,bj)*delPI*atm_Rq
0459 & *( theta(i,j,km,bi,bj)*salt(i,j,km,bi,bj)
0460 & + theta(i,j,kc,bi,bj)*salt(i,j,kc,bi,bj)
0461 & )*maskC(i,j,km,bi,bj)*0.25 _d 0
0462 ENDDO
0463 ENDDO
0464 ENDIF
0465 IF ( kLev.LT.Nr ) THEN
0466 delPI = atm_Cp*( (rC(kc)/atm_Po)**atm_kappa
0467 & - (rC(kp)/atm_Po)**atm_kappa )
0468 DO j=1,sNy
0469 DO i=1,sNx
0470 tmpVar(i,j) = tmpVar(i,j)
0471 & + wVel(i,j,kp,bi,bj)*delPI*atm_Rq
0472 & *( theta(i,j,kc,bi,bj)*salt(i,j,kc,bi,bj)
0473 & + theta(i,j,kp,bi,bj)*salt(i,j,kp,bi,bj)
0474 & )*maskC(i,j,kp,bi,bj)*0.25 _d 0
0475 ENDDO
0476 ENDDO
0477 ENDIF
0478 DO j=1,sNy
0479 DO i=1,sNx
0480 gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
0481 & + tmpVar(i,j)*tmpFac
0482 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0483 ENDDO
0484 ENDDO
0485 #ifdef ALLOW_DIAGNOSTICS
0486 IF ( useDiagnostics ) THEN
0487
0488 tmpFac = rUnit2mass
0489 CALL DIAGNOSTICS_SCALE_FILL( tmpVar, tmpFac, 1,
0490 & 'MoistCor', kc, 1, 3, bi,bj,myThid )
0491 ENDIF
0492 #endif /* ALLOW_DIAGNOSTICS */
0493 ENDIF
0494
0495
e305438401 Mart*0496 IF ( kLev .EQ. kSurface ) THEN
285db1597f Jean*0497 DO j=1,sNy
0498 DO i=1,sNx
985d9b22ad Jean*0499 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
0500 & +surfaceForcingT(i,j,bi,bj)
0501 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0502 ENDDO
0503 ENDDO
0504 ELSEIF ( kSurface.EQ.-1 ) THEN
0505 DO j=1,sNy
0506 DO i=1,sNx
0507 IF ( kSurfC(i,j,bi,bj).EQ.kLev ) THEN
0508 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
0509 & +surfaceForcingT(i,j,bi,bj)
0510 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0511 ENDIF
1dbaea09ee Chri*0512 ENDDO
0513 ENDDO
0514 ENDIF
0515
f2d1ba7d38 Davi*0516 IF (linFSConserveTr) THEN
0517 DO j=1,sNy
0518 DO i=1,sNx
a7ae998c8d Jean*0519 IF (kLev .EQ. kSurfC(i,j,bi,bj)) THEN
f2d1ba7d38 Davi*0520 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
0521 & +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0522 ENDIF
0523 ENDDO
0524 ENDDO
0525 ENDIF
0526
fb3dc7d949 Alis*0527 #ifdef SHORTWAVE_HEATING
0528
285db1597f Jean*0529
45e6cba2ac Jean*0530 swfracb(1)=abs(rF(kLev))
0531 swfracb(2)=abs(rF(kLev+1))
285db1597f Jean*0532 CALL SWFRAC(
015ef567d5 Jean*0533 I 2, minusOne,
70f67f70d4 Jean*0534 U swfracb,
0535 I myTime, 1, myThid )
45e6cba2ac Jean*0536 kp1 = kLev+1
0537 IF (kLev.EQ.Nr) THEN
0538 kp1 = kLev
7b9cf8f7da Jean*0539 swfracb(2)=0. _d 0
285db1597f Jean*0540 ENDIF
0541 DO j=1,sNy
0542 DO i=1,sNx
45e6cba2ac Jean*0543 gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
0544 & -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,kLev,bi,bj)
7b9cf8f7da Jean*0545 & -swfracb(2)*maskC(i,j,kp1, bi,bj))
faf82d94de Patr*0546 & *recip_Cp*mass2rUnit
45e6cba2ac Jean*0547 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
285db1597f Jean*0548 ENDDO
fb3dc7d949 Alis*0549 ENDDO
285db1597f Jean*0550
fb3dc7d949 Alis*0551 #endif
4c6b97badf Patr*0552
45e6cba2ac Jean*0553 #ifdef ALLOW_FRAZIL
0554 IF ( useFRAZIL )
0555 & CALL FRAZIL_TENDENCY_APPLY_T(
0556 U gT(1-OLx,1-OLy,kLev,bi,bj),
0557 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0558 I myTime, 0, myThid )
0559 #endif /* ALLOW_FRAZIL */
0560
0561 #ifdef ALLOW_SHELFICE
0562 IF ( useShelfIce )
0563 & CALL SHELFICE_FORCING_T(
0564 U gT(1-OLx,1-OLy,kLev,bi,bj),
0565 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0566 I myTime, 0, myThid )
0567 #endif /* ALLOW_SHELFICE */
0568
0569 #ifdef ALLOW_ICEFRONT
0570 IF ( useICEFRONT )
0571 & CALL ICEFRONT_TENDENCY_APPLY_T(
0572 U gT(1-OLx,1-OLy,kLev,bi,bj),
0573 I kLev, bi, bj, myTime, 0, myThid )
0574 #endif /* ALLOW_ICEFRONT */
0575
bbffc59522 An T*0576 #ifdef ALLOW_SALT_PLUME
0577 IF ( useSALT_PLUME )
0578 & CALL SALT_PLUME_TENDENCY_APPLY_T(
45e6cba2ac Jean*0579 U gT(1-OLx,1-OLy,kLev,bi,bj),
0580 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0581 I myTime, 0, myThid )
bbffc59522 An T*0582 #endif /* ALLOW_SALT_PLUME */
0583
c754af56ea Step*0584 #ifdef ALLOW_RBCS
45e6cba2ac Jean*0585 IF (useRBCS) THEN
0586 CALL RBCS_ADD_TENDENCY(
0587 U gT(1-OLx,1-OLy,kLev,bi,bj),
0588 I kLev, bi, bj, 1,
0589 I myTime, 0, myThid )
0590 ENDIF
0591 #endif /* ALLOW_RBCS */
c754af56ea Step*0592
285db1597f Jean*0593 #ifdef ALLOW_OBCS
b275747e24 Patr*0594 IF (useOBCS) THEN
45e6cba2ac Jean*0595 CALL OBCS_SPONGE_T(
0596 U gT(1-OLx,1-OLy,kLev,bi,bj),
0597 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0598 I myTime, 0, myThid )
b275747e24 Patr*0599 ENDIF
45e6cba2ac Jean*0600 #endif /* ALLOW_OBCS */
4c6b97badf Patr*0601
15338fa568 Dimi*0602 #ifdef ALLOW_BBL
0603 IF ( useBBL ) CALL BBL_TENDENCY_APPLY_T(
45e6cba2ac Jean*0604 U gT(1-OLx,1-OLy,kLev,bi,bj),
0605 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0606 I myTime, 0, myThid )
15338fa568 Dimi*0607 #endif /* ALLOW_BBL */
0608
2d9d0bc0a6 Jean*0609 #ifdef ALLOW_MYPACKAGE
45e6cba2ac Jean*0610 IF ( useMYPACKAGE ) THEN
0611 CALL MYPACKAGE_TENDENCY_APPLY_T(
0612 U gT(1-OLx,1-OLy,kLev,bi,bj),
0613 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0614 I myTime, 0, myThid )
0615 ENDIF
2d9d0bc0a6 Jean*0616 #endif /* ALLOW_MYPACKAGE */
0617
b0340e9e76 Jean*0618 #endif /* USE_OLD_EXTERNAL_FORCING */
b734cf7153 Chri*0619 RETURN
0620 END
285db1597f Jean*0621
0622
9366854e02 Chri*0623
0624
0625
b734cf7153 Chri*0626 SUBROUTINE EXTERNAL_FORCING_S(
285db1597f Jean*0627 I iMin,iMax, jMin,jMax, bi,bj, kLev,
0628 I myTime, myThid )
b734cf7153 Chri*0629
9366854e02 Chri*0630
0631
285db1597f Jean*0632
0633
9366854e02 Chri*0634
285db1597f Jean*0635
0636
9366854e02 Chri*0637
0638
0639
0640
0641 IMPLICIT NONE
b734cf7153 Chri*0642
0643 #include "SIZE.h"
0644 #include "EEPARAMS.h"
0645 #include "PARAMS.h"
0646 #include "GRID.h"
0647 #include "DYNVARS.h"
1dbaea09ee Chri*0648 #include "FFIELDS.h"
f2d1ba7d38 Davi*0649 #include "SURFACE.h"
b734cf7153 Chri*0650
9366854e02 Chri*0651
b734cf7153 Chri*0652
285db1597f Jean*0653
0654
0655
0656
0657
0658
b734cf7153 Chri*0659 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
285db1597f Jean*0660 _RL myTime
39b995119f Alis*0661 INTEGER myThid
b734cf7153 Chri*0662
b0340e9e76 Jean*0663 #ifdef USE_OLD_EXTERNAL_FORCING
9366854e02 Chri*0664
1dbaea09ee Chri*0665
285db1597f Jean*0666
015ef567d5 Jean*0667
285db1597f Jean*0668 INTEGER i, j
e305438401 Mart*0669 INTEGER kSurface
9366854e02 Chri*0670
1dbaea09ee Chri*0671
9669509dca Jean*0672 IF ( fluidIsAir ) THEN
861b393501 Jean*0673 kSurface = 0
985d9b22ad Jean*0674 ELSEIF ( usingZCoords .AND. useShelfIce ) THEN
0675 kSurface = -1
9669509dca Jean*0676 ELSEIF ( usingPCoords ) THEN
e305438401 Mart*0677 kSurface = Nr
9669509dca Jean*0678 ELSE
e305438401 Mart*0679 kSurface = 1
9669509dca Jean*0680 ENDIF
e305438401 Mart*0681
1dbaea09ee Chri*0682
861b393501 Jean*0683 #ifdef ALLOW_AIM
0684 IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
45e6cba2ac Jean*0685 U gS(1-OLx,1-OLy,kLev,bi,bj),
0686 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0687 I myTime, 0, myThid )
861b393501 Jean*0688 #endif /* ALLOW_AIM */
0689
123913d7e9 Jean*0690 #ifdef ALLOW_ATM_PHYS
0691 IF ( useAtm_Phys ) CALL ATM_PHYS_TENDENCY_APPLY_S(
45e6cba2ac Jean*0692 U gS(1-OLx,1-OLy,kLev,bi,bj),
0693 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0694 I myTime, 0, myThid )
123913d7e9 Jean*0695 #endif /* ALLOW_ATM_PHYS */
0696
468f196fcd Andr*0697 #ifdef ALLOW_FIZHI
0698 IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
45e6cba2ac Jean*0699 U gS(1-OLx,1-OLy,kLev,bi,bj),
0700 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0701 I myTime, 0, myThid )
468f196fcd Andr*0702 #endif /* ALLOW_FIZHI */
d8206d87ee Patr*0703
1387d73548 Jean*0704 #ifdef ALLOW_ADDFLUID
80d98e0151 Dimi*0705 IF ( selectAddFluid.NE.0 .AND. salt_addMass.NE.UNSET_RL ) THEN
1387d73548 Jean*0706 IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
0707 & .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
0708 DO j=1,sNy
0709 DO i=1,sNx
0710 gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
0711 & + addMass(i,j,kLev,bi,bj)*mass2rUnit
80d98e0151 Dimi*0712 & *( salt_addMass - salt(i,j,kLev,bi,bj) )
1387d73548 Jean*0713 & *recip_rA(i,j,bi,bj)
0714 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0715
0716 ENDDO
0717 ENDDO
0718 ELSE
0719 DO j=1,sNy
0720 DO i=1,sNx
0721 gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
0722 & + addMass(i,j,kLev,bi,bj)*mass2rUnit
80d98e0151 Dimi*0723 & *( salt_addMass - sRef(kLev) )
1387d73548 Jean*0724 & *recip_rA(i,j,bi,bj)
0725 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0726
0727 ENDDO
0728 ENDDO
0729 ENDIF
0730 ENDIF
0731 #endif /* ALLOW_ADDFLUID */
0732
015ef567d5 Jean*0733
e305438401 Mart*0734 IF ( kLev .EQ. kSurface ) THEN
285db1597f Jean*0735 DO j=1,sNy
0736 DO i=1,sNx
985d9b22ad Jean*0737 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
0738 & +surfaceForcingS(i,j,bi,bj)
0739 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0740 ENDDO
0741 ENDDO
0742 ELSEIF ( kSurface.EQ.-1 ) THEN
0743 DO j=1,sNy
0744 DO i=1,sNx
0745 IF ( kSurfC(i,j,bi,bj).EQ.kLev ) THEN
0746 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
0747 & +surfaceForcingS(i,j,bi,bj)
0748 & *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0749 ENDIF
1dbaea09ee Chri*0750 ENDDO
0751 ENDDO
0752 ENDIF
0753
f2d1ba7d38 Davi*0754 IF (linFSConserveTr) THEN
0755 DO j=1,sNy
0756 DO i=1,sNx
a7ae998c8d Jean*0757 IF (kLev .EQ. kSurfC(i,j,bi,bj)) THEN
f2d1ba7d38 Davi*0758 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
0759 & +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
0760 ENDIF
0761 ENDDO
0762 ENDDO
0763 ENDIF
0764
a6cbc7a360 Mart*0765 #ifdef ALLOW_SHELFICE
0766 IF ( useShelfIce )
0767 & CALL SHELFICE_FORCING_S(
45e6cba2ac Jean*0768 U gS(1-OLx,1-OLy,kLev,bi,bj),
0769 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0770 I myTime, 0, myThid )
a6cbc7a360 Mart*0771 #endif /* ALLOW_SHELFICE */
0772
5da8ce63fa Dimi*0773 #ifdef ALLOW_ICEFRONT
e5c5488a84 Dimi*0774 IF ( useICEFRONT )
0775 & CALL ICEFRONT_TENDENCY_APPLY_S(
45e6cba2ac Jean*0776 U gS(1-OLx,1-OLy,kLev,bi,bj),
0777 I kLev, bi, bj, myTime, 0, myThid )
5da8ce63fa Dimi*0778 #endif /* ALLOW_ICEFRONT */
0779
8c3259a14c Dimi*0780 #ifdef ALLOW_SALT_PLUME
b5aa60a554 Dimi*0781 IF ( useSALT_PLUME )
e4775240e5 Dimi*0782 & CALL SALT_PLUME_TENDENCY_APPLY_S(
45e6cba2ac Jean*0783 U gS(1-OLx,1-OLy,kLev,bi,bj),
0784 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0785 I myTime, 0, myThid )
8c3259a14c Dimi*0786 #endif /* ALLOW_SALT_PLUME */
0787
c754af56ea Step*0788 #ifdef ALLOW_RBCS
45e6cba2ac Jean*0789 IF (useRBCS) THEN
0790 CALL RBCS_ADD_TENDENCY(
0791 U gS(1-OLx,1-OLy,kLev,bi,bj),
0792 I kLev, bi, bj, 2,
0793 I myTime, 0, myThid )
0794 ENDIF
8c3259a14c Dimi*0795 #endif /* ALLOW_RBCS */
c754af56ea Step*0796
285db1597f Jean*0797 #ifdef ALLOW_OBCS
b275747e24 Patr*0798 IF (useOBCS) THEN
45e6cba2ac Jean*0799 CALL OBCS_SPONGE_S(
0800 U gS(1-OLx,1-OLy,kLev,bi,bj),
0801 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0802 I myTime, 0, myThid )
b275747e24 Patr*0803 ENDIF
8c3259a14c Dimi*0804 #endif /* ALLOW_OBCS */
4c6b97badf Patr*0805
15338fa568 Dimi*0806 #ifdef ALLOW_BBL
0807 IF ( useBBL ) CALL BBL_TENDENCY_APPLY_S(
45e6cba2ac Jean*0808 U gS(1-OLx,1-OLy,kLev,bi,bj),
0809 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0810 I myTime, 0, myThid )
15338fa568 Dimi*0811 #endif /* ALLOW_BBL */
0812
2d9d0bc0a6 Jean*0813 #ifdef ALLOW_MYPACKAGE
45e6cba2ac Jean*0814 IF ( useMYPACKAGE ) THEN
0815 CALL MYPACKAGE_TENDENCY_APPLY_S(
0816 U gS(1-OLx,1-OLy,kLev,bi,bj),
0817 I iMin,iMax,jMin,jMax, kLev, bi,bj,
0818 I myTime, 0, myThid )
0819 ENDIF
2d9d0bc0a6 Jean*0820 #endif /* ALLOW_MYPACKAGE */
0821
b0340e9e76 Jean*0822 #endif /* USE_OLD_EXTERNAL_FORCING */
b734cf7153 Chri*0823 RETURN
0824 END