model/src/load_fields_driver.F

a9bb88678f Jean*0001 #include "PACKAGES_CONFIG.h"
                0002 #include "CPP_OPTIONS.h"
517dbdc414 Jean*0003 #ifdef ALLOW_AUTODIFF
                0004 # include "AUTODIFF_OPTIONS.h"
                0005 #endif
                0006 #ifdef ALLOW_COST
                0007 # include "COST_OPTIONS.h"
                0008 #endif
                0009 #ifdef ALLOW_CTRL
                0010 # include "CTRL_OPTIONS.h"
                0011 #endif
                0012 #ifdef ALLOW_EXF
                0013 # include "EXF_OPTIONS.h"
                0014 #endif
a9bb88678f Jean*0015
                0016 CBOP
                0017 C     !ROUTINE: LOAD_FIELDS_DRIVER
                0018 C     !INTERFACE:
                0019       SUBROUTINE LOAD_FIELDS_DRIVER( myTime, myIter, myThid )
                0020
                0021 C     !DESCRIPTION: \bv
                0022 C     *==================================================================
                0023 C     | SUBROUTINE LOAD_FIELDS_DRIVER
                0024 C     | o Load external forcing fields from file
                0025 C     *==================================================================
                0026 C     *==================================================================
                0027 C     \ev
                0028
                0029 C     !CALLING SEQUENCE:
                0030 C     LOAD_FIELDS_DRIVER
                0031 C       |
5991c9a6ad Jean*0032 C       |-- CONVERT_CT2PT  (TEOS10 case)
                0033 C       |
                0034 C       |-- CTRL_MAP_GENTIM2D
                0035 C       |
a9bb88678f Jean*0036 C       |-- BULKF_FIELDS_LOAD
                0037 C       |
                0038 C       |-- EXF_GETFORCING
                0039 C       |
b4c132448c Jean*0040 C       |-- CHEAPAML_FIELDS_LOAD
                0041 C       |
a9bb88678f Jean*0042 C       |-- EXTERNAL_FIELDS_LOAD
                0043 C       |
                0044 C       |-- GCHEM_FIELDS_LOAD
                0045 C       |
                0046 C       |-- RBCS_FIELDS_LOAD
                0047 C       |
                0048 C       |-- AIM_FIELDS_LOAD
                0049
                0050 C     !USES:
                0051       IMPLICIT NONE
                0052 C     == Global variables ==
                0053 #include "SIZE.h"
                0054 #include "EEPARAMS.h"
                0055 #include "PARAMS.h"
701e10a905 Mart*0056 #include "GRID.h"
43e432aa51 Jean*0057 #include "FFIELDS.h"
701e10a905 Mart*0058 #include "DYNVARS.h"
a9bb88678f Jean*0059
517dbdc414 Jean*0060 #ifdef ALLOW_AUTODIFF
7c50f07931 Mart*0061 # ifdef ALLOW_AUTODIFF_TAMC
                0062 #  include "tamc.h"
                0063 # endif
cfdbfa0351 Gael*0064 # ifdef ALLOW_CTRL
                0065 #  include "CTRL_SIZE.h"
4d72283393 Mart*0066 #  include "CTRL.h"
9c41af81f6 Timo*0067 #  include "CTRL_GENARR.h"
edcd27be69 Mart*0068 #  include "CTRL_DUMMY.h"
cfdbfa0351 Gael*0069 # endif
                0070 # ifdef ALLOW_COST
                0071 #  include "cost.h"
                0072 # endif
a9bb88678f Jean*0073 # include "EOS.h"
                0074 # ifdef ALLOW_EXF
798a745844 Jean*0075 #  include "EXF_FIELDS.h"
517dbdc414 Jean*0076 #  include "EXF_CONSTANTS.h"
b4daa24319 Shre*0077 #  ifdef ALLOW_TAPENADE
                0078 #   include "EXF_PARAM.h"
                0079 #   include "EXF_INTERP_SIZE.h"
                0080 #   include "EXF_INTERP_PARAM.h"
                0081 #  endif
a9bb88678f Jean*0082 # endif
517dbdc414 Jean*0083 #endif /* ALLOW_AUTODIFF */
a9bb88678f Jean*0084
b4c132448c Jean*0085 C     !INPUT/OUTPUT PARAMETERS:
a9bb88678f Jean*0086 C     myTime :: time counter for this thread
                0087 C     myIter :: iteration counter for this thread
                0088 C     myThid :: thread number for this instance of the routine.
                0089       _RL     myTime
                0090       INTEGER myIter
                0091       INTEGER myThid
                0092
701e10a905 Mart*0093       _RL consTemp_to_poTemp
                0094       EXTERNAL consTemp_to_poTemp
                0095
b4c132448c Jean*0096 C     !LOCAL VARIABLES:
43e432aa51 Jean*0097 #if (defined ALLOW_ADDFLUID) || (defined ALLOW_FRICTION_HEATING)
701e10a905 Mart*0098       INTEGER k
43e432aa51 Jean*0099 #endif
701e10a905 Mart*0100       INTEGER ks
                0101       INTEGER i,j,bi,bj
a9bb88678f Jean*0102 CEOP
                0103
                0104 #ifdef ALLOW_DEBUG
8440e8ae5d Jean*0105       IF (debugMode) CALL DEBUG_ENTER( 'LOAD_FIELDS_DRIVER', myThid )
a9bb88678f Jean*0106 #endif
                0107
43e432aa51 Jean*0108 C--   Initialise forcing arrays that may receive multiple contributions
                0109 #ifdef ALLOW_ADDFLUID
79b5d5775c Jean*0110 C-- 3 cases: a) prescribe constant 3-D field "addMass" (loaded from addMassFile)
                0111 C            b) prescribe time-variable 3-D field "addMass" (not yet coded)
                0112 C            c) compute "addMass" at each time-step (sum of contrib from pkgs)
                0113 C-  Note: Condition below might need an update once (b) is made available
f4d71cd088 Jean*0114       IF ( selectAddFluid.NE.0 .AND. addMassFile.EQ.' ' ) THEN
43e432aa51 Jean*0115         DO bj=myByLo(myThid),myByHi(myThid)
                0116          DO bi=myBxLo(myThid),myBxHi(myThid)
                0117           DO k=1,Nr
                0118            DO j=1-OLy,sNy+OLy
                0119             DO i=1-OLx,sNx+OLx
                0120              addMass(i,j,k,bi,bj) =  0. _d 0
                0121             ENDDO
                0122            ENDDO
                0123           ENDDO
                0124          ENDDO
                0125         ENDDO
                0126       ENDIF
                0127 #endif /* ALLOW_ADDFLUID */
                0128
                0129 #ifdef ALLOW_FRICTION_HEATING
f4d71cd088 Jean*0130       IF ( addFrictionHeating .AND. staggerTimeStep ) THEN
43e432aa51 Jean*0131         DO bj=myByLo(myThid),myByHi(myThid)
                0132          DO bi=myBxLo(myThid),myBxHi(myThid)
                0133           DO k=1,Nr
                0134            DO j=1-OLy,sNy+OLy
                0135             DO i=1-OLx,sNx+OLx
                0136              frictionHeating(i,j,k,bi,bj) = 0. _d 0
                0137             ENDDO
                0138            ENDDO
                0139           ENDDO
                0140          ENDDO
                0141         ENDDO
                0142       ENDIF
                0143 #endif /* ALLOW_FRICTION_HEATING */
                0144
701e10a905 Mart*0145 C--   Determine surface temperature, usually just a copy of the surface
                0146 C--   level of theta, but for eosType='TEOS10', we need to convert from
                0147 C--   conservative temperature to in-situ surface temperature
                0148       IF ( usingPCoords ) THEN
                0149        ks = Nr
                0150       ELSE
                0151        ks = 1
                0152       ENDIF
                0153       IF ( fluidIsWater .AND. eosType .EQ. 'TEOS10' ) THEN
                0154         DO bj=myByLo(myThid),myByHi(myThid)
                0155          DO bi=myBxLo(myThid),myBxHi(myThid)
                0156           CALL CONVERT_CT2PT(
                0157      I         theta(1-OLx,1-OLy,ks,bi,bj),
                0158      I         salt(1-OLx,1-OLy,ks,bi,bj),
                0159      O         gcmSST(1-OLx,1-OLy,bi,bj),
                0160      I         myTime, myIter, myThid )
                0161 C     apply mask (because theta=0 will lead to gcmSST<0)
                0162           DO j=1-OLy,sNy+OLy
                0163            DO i=1-OLx,sNx+OLx
                0164             gcmSST(i,j,bi,bj) = gcmSST(i,j,bi,bj)*maskC(i,j,ks,bi,bj)
                0165            ENDDO
                0166           ENDDO
                0167          ENDDO
                0168         ENDDO
                0169 #ifdef ALLOW_AUTODIFF
                0170       ELSE
                0171 #else
                0172       ELSEIF ( fluidIsWater ) THEN
                0173 #endif
                0174         DO bj=myByLo(myThid),myByHi(myThid)
                0175          DO bi=myBxLo(myThid),myBxHi(myThid)
                0176           DO j=1-OLy,sNy+OLy
                0177            DO i=1-OLx,sNx+OLx
                0178             gcmSST(i,j,bi,bj) = theta(i,j,ks,bi,bj)
                0179            ENDDO
                0180           ENDDO
                0181          ENDDO
                0182         ENDDO
                0183       ENDIF
                0184
d50b75bb8d Gael*0185 C--   Map generic time varying controls to xx_gentim2d
                0186 #ifdef ALLOW_CTRL
5991c9a6ad Jean*0187       IF ( useCTRL ) THEN
                0188 #ifdef ALLOW_DEBUG
                0189         IF (debugMode) CALL DEBUG_CALL('CTRL_MAP_GENTIM2D',myThid)
d50b75bb8d Gael*0190 #endif
5991c9a6ad Jean*0191         CALL CTRL_MAP_GENTIM2D( myTime, myIter, myThid )
                0192       ENDIF
                0193 #endif /* ALLOW_CTRL */
d50b75bb8d Gael*0194
a9bb88678f Jean*0195 #ifdef ALLOW_BULK_FORCE
                0196       IF ( useBulkForce ) THEN
                0197 C--   Bulk-Formulae pkg: load all forcing fields at current time
                0198 #ifdef ALLOW_DEBUG
8440e8ae5d Jean*0199         IF (debugMode) CALL DEBUG_CALL('BULKF_FIELDS_LOAD',myThid)
a9bb88678f Jean*0200 #endif
                0201         CALL TIMER_START('BULKF_FIELDS_LOAD  [LOAD_FLDS_DRIVER]',myThid)
                0202         CALL BULKF_FIELDS_LOAD( myTime, myIter, myThid )
                0203         CALL TIMER_STOP ('BULKF_FIELDS_LOAD  [LOAD_FLDS_DRIVER]',myThid)
                0204       ENDIF
                0205 #endif /* ALLOW_BULK_FORCE */
                0206
                0207 C--   Call external forcing package
                0208 #ifdef ALLOW_EXF
342da43f96 Patr*0209       IF (useEXF) THEN
a9bb88678f Jean*0210 # ifdef ALLOW_DEBUG
8440e8ae5d Jean*0211         IF (debugMode) CALL DEBUG_CALL('EXF_GETFORCING',myThid)
a9bb88678f Jean*0212 # endif
                0213         CALL TIMER_START('EXF_GETFORCING     [LOAD_FLDS_DRIVER]',myThid)
                0214         CALL EXF_GETFORCING( myTime, myIter, myThid )
                0215         CALL TIMER_STOP ('EXF_GETFORCING     [LOAD_FLDS_DRIVER]',myThid)
342da43f96 Patr*0216       ENDIF
1a09ceef82 Jean*0217 #endif /* ALLOW_EXF */
                0218
86f14fa6df Jean*0219 C--   Call external CheapAML forcing package
                0220 #ifdef ALLOW_CHEAPAML
                0221       IF ( useCheapAML  ) THEN
                0222 #ifdef ALLOW_DEBUG
8440e8ae5d Jean*0223         IF (debugMode) CALL DEBUG_CALL('CHEAPAML_FIELDS_LOAD',myThid)
86f14fa6df Jean*0224 #endif
8440e8ae5d Jean*0225         CALL CHEAPAML_FIELDS_LOAD( myTime, myIter, myThid )
                0226       ENDIF
86f14fa6df Jean*0227 #endif /*ALLOW_CHEAPAML */
                0228
3fb95cc0ad Jean*0229       IF ( fluidIsWater ) THEN
1a09ceef82 Jean*0230 #ifdef ALLOW_DEBUG
8440e8ae5d Jean*0231         IF (debugMode) CALL DEBUG_CALL('EXTERNAL_FIELDS_LOAD',myThid)
1a09ceef82 Jean*0232 #endif
a9bb88678f Jean*0233         CALL TIMER_START('EXTERNAL_FLDS_LOAD [LOAD_FLDS_DRIVER]',myThid)
                0234         CALL EXTERNAL_FIELDS_LOAD( myTime, myIter, myThid )
                0235         CALL TIMER_STOP ('EXTERNAL_FLDS_LOAD [LOAD_FLDS_DRIVER]',myThid)
3fb95cc0ad Jean*0236       ENDIF
a9bb88678f Jean*0237
                0238 #ifdef ALLOW_GCHEM
                0239       IF ( useGCHEM ) THEN
                0240 #ifdef ALLOW_DEBUG
8440e8ae5d Jean*0241         IF (debugMode) CALL DEBUG_CALL('GCHEM_FIELDS_LOAD',myThid)
a9bb88678f Jean*0242 #endif /* ALLOW_DEBUG */
                0243         CALL GCHEM_FIELDS_LOAD( myTime, myIter, myThid )
                0244       ENDIF
                0245 #endif /* ALLOW_GCHEM */
                0246
                0247 #ifdef ALLOW_RBCS
                0248       IF ( useRBCS ) THEN
                0249         CALL RBCS_FIELDS_LOAD( myTime, myIter, myThid )
                0250       ENDIF
                0251 #endif
                0252
                0253 #ifdef ALLOW_AIM
                0254       IF ( useAIM ) THEN
                0255 C-     Update AIM bottom boundary data
                0256         CALL AIM_FIELDS_LOAD( myTime, myIter, myThid )
                0257       ENDIF
                0258 #endif
                0259
701e10a905 Mart*0260 #ifdef ALLOW_DIAGNOSTICS
                0261       IF ( fluidIsWater .AND. useDiagnostics ) THEN
                0262         CALL DIAGNOSTICS_FILL( gcmSST, 'GCM_SST ',
                0263      &                               0, 1, 0, 1, 1, myThid )
                0264       ENDIF
                0265 #endif /* ALLOW_DIAGNOSTICS */
                0266
a9bb88678f Jean*0267 #ifdef ALLOW_DEBUG
8440e8ae5d Jean*0268       IF (debugMode) CALL DEBUG_LEAVE( 'LOAD_FIELDS_DRIVER', myThid )
a9bb88678f Jean*0269 #endif
                0270
                0271       RETURN
                0272       END