File indexing completed on 2025-02-02 06:11:05 UTC
view on githubraw file Latest commit 701e10a9 on 2025-02-01 19:15:20 UTC
6d54cf9ca1 Ed H*0001 #include "EXF_OPTIONS.h"
3a255f48df Gael*0002 #ifdef ALLOW_AUTODIFF
0003 # include "AUTODIFF_OPTIONS.h"
0004 #endif
7f861c1808 Patr*0005
9fe4461eea Patr*0006
0007
0008
14a20b48a3 Jean*0009
9fe4461eea Patr*0010
0011
0012
14a20b48a3 Jean*0013
0014
0015
0016
0017
0018
0019
0020
0021
0022
0023
9fe4461eea Patr*0024
14a20b48a3 Jean*0025
423768d890 Jean*0026
14a20b48a3 Jean*0027
423768d890 Jean*0028
14a20b48a3 Jean*0029
0030
0031
0032
0033
0034
423768d890 Jean*0035
14a20b48a3 Jean*0036
0037
0038
0039
0040
0041
0042
0043
0044
0045
0046
0047
0048
0049
423768d890 Jean*0050
0051
0052
14a20b48a3 Jean*0053
0054
423768d890 Jean*0055
0056
0057
0058
0059
0060
0061
0062
14a20b48a3 Jean*0063
0064
0065
0066
0067
0068
423768d890 Jean*0069
0070
0071
0072
14a20b48a3 Jean*0073
0074
0075
0076
423768d890 Jean*0077
0078
0079
0080
14a20b48a3 Jean*0081
0082
423768d890 Jean*0083
0084
0085
0086
14a20b48a3 Jean*0087
0088
0089
9fe4461eea Patr*0090
0091
0092
14a20b48a3 Jean*0093
9fe4461eea Patr*0094
14a20b48a3 Jean*0095 SUBROUTINE EXF_GETFORCING( myTime, myIter, myThid )
9fe4461eea Patr*0096
0097
14a20b48a3 Jean*0098
0099
0100
0101
0102
0103
0104
0105
0106
0107
0108
0109
0110
0111
0112
0113
0114
9fe4461eea Patr*0115
7f861c1808 Patr*0116
9fe4461eea Patr*0117
14a20b48a3 Jean*0118 IMPLICIT NONE
7f861c1808 Patr*0119
14a20b48a3 Jean*0120
bdec91d862 Patr*0121 #include "EEPARAMS.h"
0122 #include "SIZE.h"
0123 #include "PARAMS.h"
0124 #include "GRID.h"
0125
082e18c36c Jean*0126 #include "EXF_PARAM.h"
0127 #include "EXF_FIELDS.h"
0128 #include "EXF_CONSTANTS.h"
a0a3896567 Patr*0129 #ifdef ALLOW_AUTODIFF_TAMC
0130 # include "tamc.h"
0131 #endif
b4daa24319 Shre*0132 #ifdef ALLOW_TAPENADE
0133 # include "EXF_INTERP_SIZE.h"
0134 # include "EXF_INTERP_PARAM.h"
0135 #endif /* ALLOW_TAPENADE */
701e10a905 Mart*0136 #if ( defined ALLOW_DOWNWARD_RADIATION ) || \
0137 ( defined ALLOW_ATM_TEMP && defined ALLOW_BULKFORMULAE )
0138 # include "FFIELDS.h"
0139 # include "DYNVARS.h"
0140 #endif
bdec91d862 Patr*0141
9fe4461eea Patr*0142
14a20b48a3 Jean*0143
0144 _RL myTime
0145 INTEGER myIter
0146 INTEGER myThid
7f861c1808 Patr*0147
9fe4461eea Patr*0148
14a20b48a3 Jean*0149
0150 INTEGER bi,bj
0320e25227 Mart*0151 INTEGER i,j,ks
701e10a905 Mart*0152 #if ( defined ALLOW_DOWNWARD_RADIATION ) || \
0153 ( defined ALLOW_ATM_TEMP && defined ALLOW_BULKFORMULAE )
0154 INTEGER kl
0155 _RL deltaSST
0156
0157
0158 _RL exf_Tsf (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
0159 #endif
14a20b48a3 Jean*0160
9fe4461eea Patr*0161
7f861c1808 Patr*0162
701e10a905 Mart*0163 ks = 1
0164 IF ( usingPCoords ) ks = Nr
0165 #if ( defined ALLOW_DOWNWARD_RADIATION ) || \
0166 ( defined ALLOW_ATM_TEMP && defined ALLOW_BULKFORMULAE )
0167
0168
0169
0170 kl = 2
0171 IF ( usingPCoords ) kl = Nr-1
0172 DO bj = myByLo(myThid),myByHi(myThid)
0173 DO bi = myBxLo(myThid),myBxHi(myThid)
0174 IF ( Nr.GE.2 .AND. sstExtrapol.GT.0. _d 0 ) THEN
0175 DO j = 1-OLy,sNy+OLy
0176 DO i = 1-OLx,sNx+OLx
0177 deltaSST = sstExtrapol
0178 & *( theta(i,j,ks,bi,bj)-theta(i,j,kl,bi,bj) )
0179 & * maskC(i,j,kl,bi,bj)
0180 exf_Tsf(i,j,bi,bj) = gcmSST(i,j,bi,bj) + cen2kel
0181 & + MAX( deltaSST, 0. _d 0 )
0182 ENDDO
0183 ENDDO
0184 ELSE
0185 DO j = 1-OLy,sNy+OLy
0186 DO i = 1-OLx,sNx+OLx
0187 exf_Tsf(i,j,bi,bj) = gcmSST(i,j,bi,bj) + cen2kel
0188 ENDDO
0189 ENDDO
0190 ENDIF
0191 ENDDO
0192 ENDDO
0193 #endif
0194
14a20b48a3 Jean*0195
423768d890 Jean*0196 CALL EXF_GETCLIM( myTime, myIter, myThid )
7f861c1808 Patr*0197
14a20b48a3 Jean*0198
423768d890 Jean*0199 CALL EXF_GETFFIELDS( myTime, myIter, myThid )
358649780a Gael*0200 IF ( .NOT.useAtmWind ) THEN
423768d890 Jean*0201 IF ( stressIsOnCgrid .AND. ustressfile.NE.' '
0202 & .AND. vstressfile.NE.' ' )
9c3e24f78c Jean*0203 & CALL EXCH_UV_XY_RL( ustress, vstress, .TRUE., myThid )
358649780a Gael*0204 ENDIF
7f861c1808 Patr*0205
98238efc8b Patr*0206 #ifdef ALLOW_AUTODIFF_TAMC
9c41af81f6 Timo*0207
0208
0209
0210
0211
0212
0213
0214
0215
0216
0217 # ifdef ALLOW_ATM_TEMP
0218
0219
0220
0221
0222
0223
0224 # ifdef ALLOW_READ_TURBFLUXES
0225
0226
0227 # endif /* ALLOW_READ_TURBFLUXES */
0228 # ifdef EXF_READ_EVAP
0229
0230 # endif /* EXF_READ_EVAP */
0231 # ifdef ALLOW_DOWNWARD_RADIATION
0232
0233
0234 # endif
0235 # else /* ALLOW_ATM_TEMP undef */
0236 # ifdef SHORTWAVE_HEATING
0237
0238 # endif
0239 # endif /* ALLOW_ATM_TEMP */
0240 # ifdef ATMOSPHERIC_LOADING
0241
0242 # endif
0243 # ifdef ALLOW_RUNOFF
0244
0245 # endif
0246 # ifdef ALLOW_SALTFLX
0247
0248 # endif
0249 # ifdef EXF_SEAICE_FRACTION
0250
0251 # endif
0252 #endif /* ALLOW_AUTODIFF_TAMC */
0253
5d96c49326 Jean*0254 #ifdef ALLOW_AUTODIFF
14a20b48a3 Jean*0255 # ifdef ALLOW_AUTODIFF_MONITOR
98238efc8b Patr*0256 CALL EXF_ADJOINT_SNAPSHOTS( 2, myTime, myIter, myThid )
0257 # endif
5d96c49326 Jean*0258 #endif /* ALLOW_AUTODIFF */
98238efc8b Patr*0259
423768d890 Jean*0260 #ifdef ALLOW_DOWNWARD_RADIATION
14a20b48a3 Jean*0261
701e10a905 Mart*0262 CALL EXF_RADIATION( exf_Tsf, myTime, myIter, myThid )
423768d890 Jean*0263 #endif
3752238fd8 Patr*0264
14a20b48a3 Jean*0265
423768d890 Jean*0266 CALL EXF_WIND( myTime, myIter, myThid )
0267
0268 #ifdef ALLOW_ATM_TEMP
0269 # ifdef ALLOW_BULKFORMULAE
0270 # ifdef ALLOW_AUTODIFF_TAMC
9c41af81f6 Timo*0271
0272
358649780a Gael*0273
0274
0275
9c41af81f6 Timo*0276
0277
0278
423768d890 Jean*0279 # endif
14a20b48a3 Jean*0280
701e10a905 Mart*0281 CALL EXF_BULKFORMULAE( exf_Tsf, myTime, myIter, myThid )
9c41af81f6 Timo*0282 # ifdef ALLOW_AUTODIFF_TAMC
0283
0284 # endif
423768d890 Jean*0285 # endif /* ALLOW_BULKFORMULAE */
0286 #endif /* ALLOW_ATM_TEMP */
bdec91d862 Patr*0287
14a20b48a3 Jean*0288 DO bj = myByLo(myThid), myByHi(myThid)
0289 DO bi = myBxLo(myThid), myBxHi(myThid)
423768d890 Jean*0290
0291 #ifdef ALLOW_ATM_TEMP
0292
0320e25227 Mart*0293 DO j = 1,sNy
0294 DO i = 1,sNx
0295
0296 hflux(i,j,bi,bj) =
0297 & - hs(i,j,bi,bj)
0298 & - hl(i,j,bi,bj)
0299 & + lwflux(i,j,bi,bj)
3752238fd8 Patr*0300 #ifndef SHORTWAVE_HEATING
0320e25227 Mart*0301 & + swflux(i,j,bi,bj)
3752238fd8 Patr*0302 #endif
14a20b48a3 Jean*0303
0320e25227 Mart*0304 sflux(i,j,bi,bj) = evap(i,j,bi,bj) - precip(i,j,bi,bj)
0305 ENDDO
0306 ENDDO
3752238fd8 Patr*0307 #endif /* ALLOW_ATM_TEMP */
423768d890 Jean*0308
0309
0320e25227 Mart*0310 DO j = 1,sNy
0311 DO i = 1,sNx
bdec91d862 Patr*0312 #ifdef ALLOW_RUNOFF
0320e25227 Mart*0313 sflux(i,j,bi,bj) = sflux(i,j,bi,bj) - runoff(i,j,bi,bj)
bdec91d862 Patr*0314 #endif
0320e25227 Mart*0315 hflux(i,j,bi,bj) = hflux(i,j,bi,bj)*maskC(i,j,ks,bi,bj)
0316 sflux(i,j,bi,bj) = sflux(i,j,bi,bj)*maskC(i,j,ks,bi,bj)
0317 ENDDO
14a20b48a3 Jean*0318 ENDDO
0320e25227 Mart*0319
0320 ENDDO
14a20b48a3 Jean*0321 ENDDO
bdec91d862 Patr*0322
14a20b48a3 Jean*0323
0324
0325
0326
0327
9c3e24f78c Jean*0328 IF ( stressIsOnCgrid ) THEN
0320e25227 Mart*0329 CALL EXCH_UV_XY_RL( ustress, vstress, .TRUE., myThid )
9c3e24f78c Jean*0330 ELSE
0320e25227 Mart*0331 CALL EXCH_UV_AGRID_3D_RL(ustress, vstress, .TRUE., 1, myThid)
9c3e24f78c Jean*0332 ENDIF
bdec91d862 Patr*0333 #ifdef SHORTWAVE_HEATING
14a20b48a3 Jean*0334
bdec91d862 Patr*0335 #endif
0336 #ifdef ATMOSPHERIC_LOADING
14a20b48a3 Jean*0337
bdec91d862 Patr*0338 #endif
24da7525ba Jean*0339 #ifdef EXF_SEAICE_FRACTION
14a20b48a3 Jean*0340
8f277f2728 Gael*0341 #endif
bdec91d862 Patr*0342
14a20b48a3 Jean*0343
423768d890 Jean*0344 CALL EXF_GETSURFACEFLUXES( myTime, myIter, myThid )
7f861c1808 Patr*0345
14a20b48a3 Jean*0346 IF ( useExfCheckRange .AND.
9f46642c85 Jean*0347 & ( myIter.EQ.nIter0 .OR. exf_debugLev.GE.debLevC ) ) THEN
0320e25227 Mart*0348 CALL EXF_CHECK_RANGE( myTime, myIter, myThid )
14a20b48a3 Jean*0349 ENDIF
d7ee8fe52e Patr*0350
423768d890 Jean*0351 #ifdef ALLOW_AUTODIFF
14a20b48a3 Jean*0352 # ifdef ALLOW_AUTODIFF_MONITOR
0320e25227 Mart*0353 CALL EXF_ADJOINT_SNAPSHOTS( 1, myTime, myIter, myThid )
98238efc8b Patr*0354 # endif
423768d890 Jean*0355 #endif /* ALLOW_AUTODIFF */
98238efc8b Patr*0356
da754645e6 Jean*0357 #ifdef ALLOW_ATM_TEMP
0358 # ifdef SHORTWAVE_HEATING
14a20b48a3 Jean*0359
da754645e6 Jean*0360
14a20b48a3 Jean*0361
0362
0363
0364 DO bj = myByLo(myThid), myByHi(myThid)
0365 DO bi = myBxLo(myThid), myBxHi(myThid)
0320e25227 Mart*0366 DO j = 1-OLy,sNy+OLy
0367 DO i = 1-OLx,sNx+OLx
92db8eb413 Patr*0368 hflux(i,j,bi,bj) = hflux(i,j,bi,bj) + swflux(i,j,bi,bj)
14a20b48a3 Jean*0369 ENDDO
0370 ENDDO
0371 ENDDO
0372 ENDDO
da754645e6 Jean*0373 # endif /* SHORTWAVE_HEATING */
0374 #endif /* ALLOW_ATM_TEMP */
b7bd8a1e5a Patr*0375
14a20b48a3 Jean*0376
423768d890 Jean*0377 CALL EXF_DIAGNOSTICS_FILL( myTime, myIter, myThid )
b1e3781773 Patr*0378
14a20b48a3 Jean*0379
423768d890 Jean*0380 CALL EXF_MONITOR( myTime, myIter, myThid )
d9263fe447 Jean*0381
14a20b48a3 Jean*0382
423768d890 Jean*0383 CALL EXF_MAPFIELDS( myTime, myIter, myThid )
7f861c1808 Patr*0384
423768d890 Jean*0385 #ifdef ALLOW_AUTODIFF
14a20b48a3 Jean*0386 # ifdef ALLOW_AUTODIFF_MONITOR
0387 IF ( .NOT. useSEAICE )
7e9378bd0f Patr*0388 & CALL EXF_ADJOINT_SNAPSHOTS( 3, myTime, myIter, myThid )
0389 # endif
423768d890 Jean*0390 #endif /* ALLOW_AUTODIFF */
7e9378bd0f Patr*0391
e1fb02e8f0 Jean*0392 RETURN
0393 END