Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:37:20 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
b3097ed02d Jean*0001 #include "AIM_OPTIONS.h"
                0002 #ifdef ALLOW_LAND
                0003 #include "LAND_OPTIONS.h"
                0004 #endif
                0005 
                0006 CBOP
                0007 C     !ROUTINE: AIM_LAND_IMPL
                0008 C     !INTERFACE:
                0009       SUBROUTINE AIM_LAND_IMPL(
1b19160514 Jean*0010      I               FMASK, dTskin,
e749d70ece Jean*0011      I               Shf0, dShf, Evp0, dEvp, Slr0, dSlr,
1b19160514 Jean*0012      U               sFlx,
e749d70ece Jean*0013      U               Tsurf, SHF, EVAP, SLRU,
                0014      O               dTsurf,
b3097ed02d Jean*0015      I               bi, bj, myTime, myIter, myThid)
                0016 
                0017 C     !DESCRIPTION: \bv
                0018 C     *==========================================================*
                0019 C     | S/R AIM_LAND_IMPL
                0020 C     | o AIM Interface to the implicit part of the land model
                0021 C     *==========================================================*
                0022 C     \ev
                0023 
                0024 C     !USES:
                0025       IMPLICIT NONE
                0026 
                0027 C     == Global variables ===
                0028 C-- size for MITgcm & Physics package :
                0029 #include "AIM_SIZE.h" 
                0030 
                0031 #include "EEPARAMS.h"
                0032 #include "PARAMS.h"
                0033 
                0034 #include "AIM_FFIELDS.h"
                0035 #include "com_physcon.h"
                0036 c #include "com_physvar.h"
                0037 
                0038 #ifdef ALLOW_LAND
                0039 #include "LAND_SIZE.h" 
                0040 #include "LAND_PARAMS.h"
                0041 #include "LAND_VARS.h"
                0042 #endif
                0043 
                0044 C     !INPUT/OUTPUT PARAMETERS:
                0045 C     == Routine arguments ==
                0046 C     FMASK    :: land fraction [0-1]
                0047 C     dTskin   :: temp. correction for daily-cycle heating [K]
e749d70ece Jean*0048 C     Shf0     :: sensible heat flux over freezing surf.
                0049 C     dShf     :: sensible heat flux derivative relative to surf. temp
b3097ed02d Jean*0050 C     Evp0     :: evaporation computed over freezing surface (Ts=0.oC)
                0051 C     dEvp     :: evaporation derivative relative to surf. temp
                0052 C     Slr0     :: upward long wave radiation over freezing surf.
1b19160514 Jean*0053 C     dSlr     :: upward long wave derivative relative to surf. temp
                0054 C     sFlx     :: net surface flux (+=down) function of surf. temp Ts:
                0055 C                 0: Flux(Ts=0.oC) ; 1: Flux(Ts^n) ; 2: d.Flux/d.Ts(Ts^n)
b3097ed02d Jean*0056 C     Tsurf    :: surface temperature        (2-dim)
e749d70ece Jean*0057 C     SHF      :: sensible heat flux              (2-dim)
b3097ed02d Jean*0058 C     EVAP     :: evaporation [g/(m^2 s)]         (2-dim)
                0059 C     SLRU     :: sfc lw radiation (upward flux)  (2-dim)
e749d70ece Jean*0060 C     dTsurf   :: surf. temp change after 1 implicit time step [oC]
b3097ed02d Jean*0061 C     bi,bj    :: Tile index
                0062 C     myTime   :: Current time of simulation ( s )
                0063 C     myIter   :: Current iteration number in simulation
                0064 C     myThid   :: Number of this instance of the routine
1b19160514 Jean*0065       _RL  FMASK(NGP), dTskin(NGP)
e749d70ece Jean*0066       _RL  Shf0(NGP), dShf(NGP), Evp0(NGP), dEvp(NGP)
                0067       _RL  Slr0(NGP), dSlr(NGP), sFlx(NGP,0:2)
                0068       _RL  Tsurf(NGP), SHF(NGP), EVAP(NGP), SLRU(NGP)
                0069       _RL  dTsurf(NGP)
b3097ed02d Jean*0070       INTEGER bi, bj, myIter, myThid
                0071       _RL myTime
                0072 CEOP
                0073 
                0074 #ifdef ALLOW_AIM
                0075 #ifdef ALLOW_LAND
                0076 C     == Local variables ==
                0077 C     i,j, I2      :: loop counters
                0078       INTEGER i,j, I2
                0079 
1b19160514 Jean*0080       IF ( useLand .AND. land_impl_grT ) THEN
b3097ed02d Jean*0081 
1b19160514 Jean*0082 C-     Initialisation :
b3097ed02d Jean*0083        DO j=1,sNy
                0084         DO i=1,sNx
                0085          I2 = i+(j-1)*sNx
                0086 
                0087 C-    initialize temp. changes and fresh water flux :
                0088          dTsurf(I2) = 0.
                0089          land_Pr_m_Ev(i,j,bi,bj) = 0. _d 0
1b19160514 Jean*0090          land_EnWFlux(i,j,bi,bj) = 0. _d 0
b3097ed02d Jean*0091 
                0092         ENDDO
                0093        ENDDO
                0094 
1b19160514 Jean*0095        IF ( land_calc_snow ) THEN
                0096 C-     Evap of snow: substract Latent Heat of freezing from heatFlux
                0097         DO j=1,sNy
                0098          DO i=1,sNx
                0099           I2 = i+(j-1)*sNx
                0100           IF ( land_skinT(i,j,bi,bj).LT. 0. _d 0 .OR.
                0101      &         land_hSnow(i,j,bi,bj).GT. 0. _d 0 ) THEN
                0102            sFlx(I2,0) = sFlx(I2,0) - ALHF*Evp0(I2)
                0103            sFlx(I2,1) = sFlx(I2,1) - ALHF*EVAP(I2)
                0104            sFlx(I2,2) = sFlx(I2,2) - ALHF*dEvp(I2)
                0105            land_EnWFlux(i,j,bi,bj) = -ALHF
                0106           ENDIF
                0107          ENDDO
                0108         ENDDO
                0109        ENDIF
                0110 
b3097ed02d Jean*0111        CALL LAND_IMPL_TEMP(
                0112      I               aim_landFr, 
                0113      I               dTskin, sFlx,
                0114      O               dTsurf,
                0115      I               bi, bj, myTime, myIter, myThid)
                0116 
1b19160514 Jean*0117 C--    Surface B.C. for atmospheric physics:
e749d70ece Jean*0118 C-     Update Evap, Upward SW according to surf. temp. changes
b3097ed02d Jean*0119        DO J=1,NGP
                0120         IF ( dTsurf(J) .GT. 999. ) THEN
e749d70ece Jean*0121          SHF (J)  = Shf0(J)
b3097ed02d Jean*0122          EVAP(J)  = Evp0(J)
                0123          SLRU(J)  = Slr0(J)
                0124         ELSE
e749d70ece Jean*0125          SHF (J)  = SHF (J) + dTsurf(J)*dShf(J)
b3097ed02d Jean*0126          EVAP(J)  = EVAP(J) + dTsurf(J)*dEvp(J)
                0127          SLRU(J)  = SLRU(J) + dTsurf(J)*dSlr(J)
                0128         ENDIF
                0129        ENDDO
                0130 
e749d70ece Jean*0131 C--    Update surface fluxes for Land model: 
1b19160514 Jean*0132        DO j=1,sNy
                0133         DO i=1,sNx
                0134          I2 = i+(j-1)*sNx
                0135 C-     net surface downward heat flux :
                0136          IF ( dTsurf(I2) .GT. 999. ) THEN
                0137           land_HeatFlx(i,j,bi,bj) = sFlx(I2,0)
                0138          ELSE
                0139           land_HeatFlx(i,j,bi,bj) = sFlx(I2,1)+dTsurf(I2)*sFlx(I2,2)
                0140          ENDIF
                0141 C-     energy flux associated with Evap of Snow
                0142          land_EnWFlux(i,j,bi,bj) = -land_EnWFlux(i,j,bi,bj)*EVAP(I2)
                0143         ENDDO
                0144        ENDDO
                0145 
e749d70ece Jean*0146 C-     Update Surf.Temp.:
                0147        DO J=1,NGP
                0148         IF ( dTsurf(J) .GT. 999. ) THEN
                0149          dTsurf(J)= tFreeze - Tsurf(J)
                0150          Tsurf(J) = tFreeze
                0151         ELSE
                0152          Tsurf(J) = Tsurf(J)+ dTsurf(J)
                0153         ENDIF
                0154        ENDDO
                0155 
1b19160514 Jean*0156 C- end (if useLand & land_impl_grT)
b3097ed02d Jean*0157       ENDIF
                0158 
                0159 #endif /* ALLOW_LAND */
                0160 #endif /* ALLOW_AIM */
                0161 
                0162       RETURN
                0163       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!