pkg/aim_v23/aim_aim2land.F

a27dd2281d Jean*0001 #include "AIM_OPTIONS.h"
                0002 #ifdef ALLOW_LAND
                0003 #include "LAND_OPTIONS.h"
                0004 #endif
                0005
                0006 CBOP
                0007 C     !ROUTINE: AIM_AIM2LAND
                0008 C     !INTERFACE:
                0009       SUBROUTINE AIM_AIM2LAND(
                0010      I               land_frc, bi, bj, myTime, myIter, myThid)
                0011
                0012 C     !DESCRIPTION: \bv
                0013 C     *==========================================================*
                0014 C     | S/R AIM_AIM2LAND
                0015 C     | o Export land surface fluxes to Land package
                0016 C     *==========================================================*
                0017 C     \ev
                0018
                0019 C     !USES:
                0020       IMPLICIT NONE
                0021
                0022 C     == Global variables ===
                0023 C-- size for MITgcm & Physics package :
                0024 #include "AIM_SIZE.h"
                0025
                0026 #include "EEPARAMS.h"
                0027 #include "PARAMS.h"
                0028
b3097ed02d Jean*0029 C-- Physics package
                0030 #include "AIM_PARAMS.h"
a27dd2281d Jean*0031 #include "com_physcon.h"
                0032 #include "com_physvar.h"
                0033
                0034 #ifdef ALLOW_LAND
                0035 #include "LAND_SIZE.h"
                0036 #include "LAND_PARAMS.h"
                0037 #include "LAND_VARS.h"
                0038 #endif
                0039
                0040 C     !INPUT/OUTPUT PARAMETERS:
                0041 C     == Routine arguments ==
                0042 C     land_frc :: land fraction [0-1]
                0043 C     bi,bj    :: Tile index
                0044 C     myTime   :: Current time of simulation ( s )
                0045 C     myIter   :: Current iteration number in simulation
                0046 C     myThid   :: Number of this instance of the routine
                0047       _RS land_frc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0048       INTEGER bi, bj, myIter, myThid
                0049       _RL myTime
                0050 CEOP
                0051
                0052 #ifdef ALLOW_AIM
                0053 #ifdef ALLOW_LAND
                0054 C     == Local variables ==
b3097ed02d Jean*0055 C     i,j,k,I2     :: loop counters
                0056 C     conv_precip  :: conversion factor for precip: from g/m2/s to kg/m2/s
a27dd2281d Jean*0057       _RL conv_precip
b3097ed02d Jean*0058       INTEGER i,j,k,I2
a27dd2281d Jean*0059
b3097ed02d Jean*0060 C--   Initialisation :
                0061       IF ( .NOT.land_impl_grT ) THEN
                0062        DO j=1,sNy
                0063         DO i=1,sNx
                0064          land_Pr_m_Ev(i,j,bi,bj) = 0. _d 0
1b19160514 Jean*0065          land_EnWFlux(i,j,bi,bj) = 0. _d 0
b3097ed02d Jean*0066         ENDDO
                0067        ENDDO
                0068       ENDIF
                0069
                0070 C--   Atmospheric Physics Fluxes
a27dd2281d Jean*0071
                0072 c     IF ( useLand ) THEN
                0073
b3097ed02d Jean*0074 C      from g/m2/s to kg/m2/s :
                0075        conv_Precip = 1. _d -3
a27dd2281d Jean*0076
1b19160514 Jean*0077       IF ( land_calc_grT .AND. .NOT.land_impl_grT ) THEN
                0078 C--   Surface heat flux to compute ground temperature explicitely:
b3097ed02d Jean*0079        k = 0
                0080        IF (aim_splitSIOsFx) k = 1
                0081        DO j=1,sNy
                0082         DO i=1,sNx
                0083          I2 = i+(j-1)*sNx
                0084
                0085 C-    total surface downward heat flux :
1b19160514 Jean*0086          land_HeatFlx(i,j,bi,bj) =
b3097ed02d Jean*0087      &                         SSR(I2,k,myThid)
                0088      &                       - SLR(I2,k,myThid)
                0089      &                       - SHF(I2,1,myThid)
                0090      &                       - EVAP(I2,1,myThid)*ALHC
                0091         ENDDO
                0092        ENDDO
                0093
1b19160514 Jean*0094        IF ( land_calc_snow ) THEN
b3097ed02d Jean*0095 C-     Evap of snow: substract Latent Heat of freezing from heatFlux
                0096         DO j=1,sNy
                0097          DO i=1,sNx
                0098           I2 = i+(j-1)*sNx
1b19160514 Jean*0099           IF ( land_skinT(i,j,bi,bj).LT. 0. _d 0 .OR.
                0100      &         land_hSnow(i,j,bi,bj).GT. 0. _d 0 ) THEN
                0101            land_HeatFlx(i,j,bi,bj) = land_HeatFlx(i,j,bi,bj)
b3097ed02d Jean*0102      &                       - EVAP(I2,1,myThid)*ALHF
1b19160514 Jean*0103            land_EnWFlux(i,j,bi,bj) =
                0104      &                         EVAP(I2,1,myThid)*ALHF
                0105           ENDIF
b3097ed02d Jean*0106          ENDDO
                0107         ENDDO
                0108        ENDIF
                0109
                0110 C--   to compute ground temperature explicitely: end
                0111       ENDIF
                0112
1b19160514 Jean*0113 C--   Fresh water fluxes
                0114        DO j=1,sNy
                0115         DO i=1,sNx
                0116          I2 = i+(j-1)*sNx
                0117
                0118 C-    total Precip minus Evap surface flux :
                0119 C        convert from g.m-2.s-1 to kg/m2/s
                0120          land_Pr_m_Ev(i,j,bi,bj) = land_Pr_m_Ev(i,j,bi,bj)
                0121      &       + conv_precip*(   PRECNV(I2,myThid)
                0122      &                       + PRECLS(I2,myThid)
                0123      &                       - EVAP(I2,1,myThid)
                0124      &                     )
                0125
                0126         ENDDO
                0127        ENDDO
                0128
                0129       IF ( aim_energPrecip ) THEN
                0130 C-     Compute energy flux related to Precip. (snow, T_rain)
                0131 C      Evap of snow: add Latent Heat of freezing
                0132        DO j=1,sNy
                0133         DO i=1,sNx
                0134          I2 = i+(j-1)*sNx
                0135          land_EnWFlux(i,j,bi,bj) = land_EnWFlux(i,j,bi,bj)
                0136      &       + EnPrec(I2,myThid)*( PRECNV(I2,myThid)
                0137      &                            +PRECLS(I2,myThid) )
                0138         ENDDO
                0139        ENDDO
                0140       ENDIF
                0141
a27dd2281d Jean*0142 C- end (if useLand)
                0143 c     ENDIF
                0144
                0145 #endif /* ALLOW_LAND */
                0146 #endif /* ALLOW_AIM */
                0147
                0148       RETURN
                0149       END