Back to home page

MITgcm

 
 

    


File indexing completed on 2021-11-06 05:16:52 UTC

view on githubraw file Latest commit 75c5b64b on 2021-11-03 02:00:03 UTC
d676f916b2 Jean*0001 #include "AIM_OPTIONS.h"
                0002 
cdcb187d4c Jean*0003 CBOP
                0004 C     !ROUTINE: AIM_DO_PHYSICS
                0005 C     !INTERFACE:
067df0e288 Jean*0006       SUBROUTINE AIM_DO_PHYSICS( myTime, myIter, myThid )
26eee352b3 Jean*0007 
cdcb187d4c Jean*0008 C     !DESCRIPTION: \bv
d676f916b2 Jean*0009 C     *==================================================================*
                0010 C     | S/R AIM_DO_PHYSICS
                0011 C     *==================================================================*
                0012 C     | Interface between atmospheric physics package and the
                0013 C     | dynamical model.
                0014 C     | Routine calls physics pacakge after setting surface BC.
                0015 C     | Package should derive and set tendency terms
                0016 C     | which can be included as external forcing terms in the dynamical
                0017 C     | tendency routines. Packages should communicate this information
                0018 C     | through common blocks.
                0019 C     *==================================================================*
cdcb187d4c Jean*0020 C     \ev
                0021 
                0022 C     !USES:
d676f916b2 Jean*0023       IMPLICIT NONE
                0024 
                0025 C     -------------- Global variables ------------------------------------
                0026 C-- size for MITgcm & Physics package :
                0027 #include "AIM_SIZE.h"
                0028 
                0029 C-- MITgcm
                0030 #include "EEPARAMS.h"
                0031 #include "PARAMS.h"
                0032 #include "DYNVARS.h"
                0033 #include "GRID.h"
                0034 #include "SURFACE.h"
                0035 
                0036 C-- Physics package
a27dd2281d Jean*0037 #include "AIM_PARAMS.h"
d676f916b2 Jean*0038 #include "AIM_FFIELDS.h"
                0039 #include "AIM_GRID.h"
                0040 #include "com_physvar.h"
                0041 #include "com_forcing.h"
fd89ae98c4 Jean*0042 #include "AIM2DYN.h"
d676f916b2 Jean*0043 
cdcb187d4c Jean*0044 C     !INPUT/OUTPUT PARAMETERS:
d676f916b2 Jean*0045 C     == Routine arguments ==
31206edf1f Jean*0046 C     myTime    :: Current time in simulation (s)
                0047 C     myIter    :: Current iteration number
                0048 C     myThid    :: My Thread Id. number
                0049       _RL     myTime
                0050       INTEGER myIter
                0051       INTEGER myThid
cdcb187d4c Jean*0052 CEOP
d676f916b2 Jean*0053 
                0054 #ifdef ALLOW_AIM
2a80e4d00e Jean*0055 C     !FUNCTIONS:
                0056 C     !LOCAL VARIABLES:
                0057 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0058 C--   Local Variables originally (Speedy) in common bloc (com_forcing.h):
                0059 C--   COMMON /FORFIX/ Time invariant forcing fields (initialise in INFORC)
                0060 C     phi0       :: surface geopotential
                0061       _RL     phi0   (NGP)
                0062 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d676f916b2 Jean*0063 C     == Local variables ==
067df0e288 Jean*0064 C     bi,bj      :: Tile indices
d0a9461855 Jean*0065 C     i,j,k,I2   :: Loop counters
                0066 C     tYear      :: Fraction into year
                0067 C     aim_sWght0 :: weight for time interpolation of surface BC
                0068 C     aim_sWght1 :: 0/1 = time period before/after the current time
                0069 C     prcAtm     :: total precip from the atmosphere [kg/m2/s]
7d37b6de57 Jean*0070 C     snowPr     :: snow precipitation               [kg/m2/s]
067df0e288 Jean*0071       INTEGER bi,bj
65d8b97200 Jean*0072       INTEGER i,j,k,I2
d676f916b2 Jean*0073       _RL     tYear, yearLength
d0a9461855 Jean*0074       _RL     aim_sWght0, aim_sWght1
cdcb187d4c Jean*0075       _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
7d37b6de57 Jean*0076       _RL snowPr(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
fdb98eff0e Jean*0077 #ifdef ALLOW_THSICE
                0078       _RL qPrcRn(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0079 #endif
d676f916b2 Jean*0080 
2a80e4d00e Jean*0081 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0082 
870deba1f6 Davi*0083 #ifdef ALLOW_AIM_CO2
                0084       CALL AIM_DO_CO2( myTime, myIter, myThid )
                0085 #endif
                0086 
067df0e288 Jean*0087 C--   Start loops on tile indices
                0088       DO bj=myByLo(myThid),myByHi(myThid)
                0089        DO bi=myBxLo(myThid),myBxHi(myThid)
                0090 
d676f916b2 Jean*0091 C_jmc: Because AIM physics LSC is not applied in the stratosphere (top level),
                0092 C      ==> move water wapor from the stratos to the surface level.
fd89ae98c4 Jean*0093         DO j = 1-OLy, sNy+OLy
                0094          DO i = 1-OLx, sNx+OLx
                0095           k = kSurfC(i,j,bi,bj)
                0096           IF (k.LE.Nr)
d676f916b2 Jean*0097      &    salt(i,j,k,bi,bj) = salt(i,j,k,bi,bj)
                0098      &                      + salt(i,j,Nr,bi,bj)*drF(Nr)*recip_drF(k)
                0099      &                  *hFacC(i,j,Nr,bi,bj)*recip_hFacC(i,j,k,bi,bj)
fd89ae98c4 Jean*0100           salt(i,j,Nr,bi,bj) = 0.
                0101          ENDDO
                0102         ENDDO
d676f916b2 Jean*0103 
                0104 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0105 
                0106 C-    Physics package needs to know time of year as a fraction
fd89ae98c4 Jean*0107         yearLength = 86400.*360.
                0108         tYear = MOD(myTime/yearLength, 1. _d 0)
d676f916b2 Jean*0109 
65007c221b Jean*0110 C--   Set surface Boundary Conditions for atmos. physics package:
                0111 C     (Albedo, Soil moisture, Surf Temp, Land sea mask)
                0112 C     includes some parts of S/R FORDATE from F.Molteni SPEDDY code (ver23)
fd89ae98c4 Jean*0113         CALL AIM_SURF_BC(
                0114      U                    tYear,
                0115      O                    aim_sWght0, aim_sWght1,
                0116      I                    bi, bj, myTime, myIter, myThid )
d676f916b2 Jean*0117 
                0118 C--   Set surface geopotential: (g * orographic height)
fd89ae98c4 Jean*0119         DO j=1,sNy
                0120          DO i=1,sNx
                0121            I2 = i+(j-1)*sNx
                0122            PHI0(I2) = gravity*topoZ(i,j,bi,bj)
                0123          ENDDO
                0124         ENDDO
d676f916b2 Jean*0125 
                0126 C--   Set topographic dependent FOROG var (originally in common SFLFIX);
                0127 C      used to compute for wind stress over land
                0128 
                0129 c_FM  IF (IDAY.EQ.0) THEN
                0130 c_FM    CALL SFLSET (PHIS0)
                0131         CALL SFLSET (PHI0, fOrogr(1,myThid), bi,bj,myThid)
                0132 c_FM  ENDIF
                0133 c_FM  CALL SOL_OZ (SOLC,TYEAR)
                0134 
                0135 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0136 
                0137 C-    Compute atmospheric-physics tendencies (call the main AIM S/R)
fd89ae98c4 Jean*0138         CALL PHY_DRIVER( tYear, useDiagnostics,
                0139      I                    bi, bj, myTime, myIter, myThid )
d676f916b2 Jean*0140 
fd89ae98c4 Jean*0141         CALL AIM_AIM2DYN( bi, bj, myTime, myIter, myThid )
d676f916b2 Jean*0142 
a27dd2281d Jean*0143 #ifdef ALLOW_LAND
fd89ae98c4 Jean*0144         IF (useLand) THEN
a27dd2281d Jean*0145 C-    prepare Surface flux over land for land package
fd89ae98c4 Jean*0146           CALL AIM_AIM2LAND( aim_landFr, bi, bj,
                0147      I                       myTime, myIter, myThid )
a27dd2281d Jean*0148 
                0149 C-    Step forward land model
fd89ae98c4 Jean*0150           CALL LAND_STEPFWD( aim_landFr, bi, bj,
                0151      I                       myTime, myIter, myThid )
a27dd2281d Jean*0152 
                0153 C-    Land diagnostics : write snap-shot & cumulate for TimeAve output
fd89ae98c4 Jean*0154           CALL LAND_DO_DIAGS( aim_landFr, bi, bj,
                0155      I                        myTime, myIter, myThid )
a27dd2281d Jean*0156 
fd89ae98c4 Jean*0157         ENDIF
a27dd2281d Jean*0158 #endif /* ALLOW_LAND */
                0159 
65d8b97200 Jean*0160 C-    surface fluxes over ocean (ice-free & ice covered)
3dd105254f Jean*0161 C       used for diagnostics, thsice package and coupler
b08caedd9d Jean*0162         CALL AIM_AIM2SIOCE( aim_landFr, fmask1(1,3,myThid),
7d37b6de57 Jean*0163      O                      prcAtm, snowPr,
3dd105254f Jean*0164      I                      bi, bj, myTime, myIter, myThid )
                0165 
cdcb187d4c Jean*0166 #ifdef ALLOW_THSICE
fd89ae98c4 Jean*0167         IF ( useThSIce ) THEN
cdcb187d4c Jean*0168 C-    Step forward sea-ice model
fdb98eff0e Jean*0169           DO j = 1-OLy, sNy+OLy
                0170            DO i = 1-OLx, sNx+OLx
                0171             qPrcRn(i,j) = 0.
                0172            ENDDO
                0173           ENDDO
fd89ae98c4 Jean*0174           CALL THSICE_STEP_FWD( bi, bj, 1, sNx, 1, sNy,
7d37b6de57 Jean*0175      I                          prcAtm, snowPr, qPrcRn,
fd89ae98c4 Jean*0176      I                          myTime, myIter, myThid )
                0177         ENDIF
                0178 #endif /* ALLOW_THSICE */
cdcb187d4c Jean*0179 
fd89ae98c4 Jean*0180 C-    AIM diagnostics : write snap-shot & cumulate for TimeAve output
                0181         CALL AIM_DIAGNOSTICS( bi, bj, myTime, myIter, myThid )
cdcb187d4c Jean*0182 
fd89ae98c4 Jean*0183 C--   end bi,bj loops.
                0184        ENDDO
                0185       ENDDO
cdcb187d4c Jean*0186 
fd89ae98c4 Jean*0187 #ifdef ALLOW_THSICE
                0188       IF ( useThSIce ) THEN
                0189 C--   Exchange fields that are advected by seaice dynamics
                0190         CALL THSICE_DO_EXCH( myThid )
                0191 C-    do sea-ice advection after sea-ice thermodynamics
                0192         CALL THSICE_DO_ADVECT(
                0193      I                         0, 0, myTime, myIter, myThid )
3559edb19a Jean*0194         DO bj=myByLo(myThid),myByHi(myThid)
                0195          DO bi=myBxLo(myThid),myBxHi(myThid)
fd89ae98c4 Jean*0196 C-    Slab Ocean : step forward ocean mixed-layer temp. & salinity
                0197           CALL THSICE_SLAB_OCEAN(
                0198      I                        aim_sWght0, aim_sWght1,
                0199      O                        dTsurf(1,2,myThid),
                0200      I                        bi, bj, myTime, myIter, myThid )
3559edb19a Jean*0201          ENDDO
                0202         ENDDO
                0203       ENDIF
                0204 #endif /* ALLOW_THSICE */
fd89ae98c4 Jean*0205 
                0206 C--   do exchanges for AIM related quantities:
                0207       _EXCH_XY_RL( aim_drag, myThid )
                0208 
                0209 #ifdef COMPONENT_MODULE
                0210       IF ( useCoupler ) THEN
3559edb19a Jean*0211        CALL ATM_STORE_MY_DATA( myTime, myIter, myThid )
fd89ae98c4 Jean*0212       ENDIF
                0213 #endif /* COMPONENT_MODULE */
                0214 
d676f916b2 Jean*0215 #endif /* ALLOW_AIM */
                0216 
                0217       RETURN
                0218       END