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
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_LAND2AIM
                0008 C     !INTERFACE:
b3097ed02d Jean*0009       SUBROUTINE AIM_LAND2AIM(
                0010      I               land_frc, land_veg, grnd_alb, snowFld,
                0011      U               aimTld, aimSWA, aimAlb,
                0012      I               myTime, myIter, bi, bj, myThid ) 
a27dd2281d Jean*0013 
                0014 C     !DESCRIPTION: \bv
                0015 C     *================================================================*
                0016 C     | S/R AIM_LAND2AIM
                0017 C     | provide surface Boundary Conditions over land (from land pkg)
                0018 C     |  to atmospheric physics package AIM
                0019 C     *================================================================*
                0020 C     | note: by default, use AIM surf.B.C. fields as initial state
                0021 C     |   (myIter=0) for the land model 
                0022 C     *================================================================*
                0023 C     \ev
                0024 
                0025 C     !USES:
                0026       IMPLICIT NONE
                0027 
                0028 C     == Global variables ===
                0029 C-- size for MITgcm & Physics package :
                0030 #include "AIM_SIZE.h"
                0031 
                0032 C-- MITgcm
                0033 #include "EEPARAMS.h"
                0034 #include "PARAMS.h"
                0035 
                0036 C-- Physics package
                0037 #include "AIM_PARAMS.h"
b3097ed02d Jean*0038 #include "com_forcon.h"
a27dd2281d Jean*0039 
                0040 #ifdef ALLOW_LAND
                0041 C-- Land package
                0042 #include "LAND_SIZE.h"
                0043 #include "LAND_PARAMS.h"
                0044 #include "LAND_VARS.h"
                0045 #endif
                0046 
                0047 C     == Routine arguments ==
b3097ed02d Jean*0048 C     land_frc :: land fraction [0-1]
                0049 C     land_veg :: vegetation fraction [0-1]
                0050 C     grnd_alb :: ground albedo [0-1]
                0051 C     aimTld   :: land surface temp (K), used in AIM
                0052 C     snowFld  :: prescribed snow thickness (from AIM input data) [m]
                0053 C     aimSWA   :: soil wetness availability [0-1], used in AIM
                0054 C     aimAlb   :: land albedo [0-1], used in AIM
                0055 C     myTime   :: Current time of simulation ( s )
                0056 C     myIter   :: Current iteration number in simulation
                0057 C     bi,bj    :: Tile index 
                0058 C     myThid   :: Number of this instance of the routine
                0059       _RS  land_frc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0060       _RS  land_veg(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0061       _RS  grnd_alb(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0062       _RL  snowFld(sNx,sNy)
                0063       _RL  aimTld(sNx,sNy)
                0064       _RL  aimSWA(sNx,sNy)
                0065       _RL  aimAlb(sNx,sNy)
a27dd2281d Jean*0066       INTEGER myIter, bi, bj, myThid
                0067       _RL myTime
                0068 CEOP
                0069 
                0070 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0071 
                0072 #ifdef ALLOW_AIM
                0073 #ifdef ALLOW_LAND
                0074 
                0075 C     == Local variables ==
b3097ed02d Jean*0076 C     i,j,k        :: Loop counters
                0077 C     grd_HeatCp   :: Heat capacity of the ground [J/m3/K]
                0078 C     mWater       :: water content of the ground [kg/m3]
bea6259b65 Jean*0079 C     recip_hSnWet :: reciprol effective snow depth for wetness (m^-1)
                0080 C     recip_mSnWet :: reciprol effective snow cover for wetness (mm^-1)
b3097ed02d Jean*0081       INTEGER i,j,k
cb4802039f Jean*0082       INTEGER kFillW
b3097ed02d Jean*0083       _RL grd_HeatCp, mWater
                0084       _RL RSD
bea6259b65 Jean*0085       _RL recip_hSnWet, recip_mSnWet
a27dd2281d Jean*0086 
                0087 c     IF (useLand) THEN
                0088 
f55a588e76 Jean*0089        IF ( land_calc_grT ) THEN
a27dd2281d Jean*0090 C-    Use land-pkg output instead of prescribed ground Temp
                0091         DO j=1,sNy
                0092          DO i=1,sNx
b3097ed02d Jean*0093            aimTld(i,j) = land_skinT(i,j,bi,bj)+celsius2K
a27dd2281d Jean*0094          ENDDO
                0095         ENDDO
                0096        ELSE
                0097 C-    Fill in land-pkg ground Temp. using AIM surf. fields
                0098         DO k=1,land_nLev
                0099          DO j=1,sNy
                0100           DO i=1,sNx
b3097ed02d Jean*0101            land_groundT(i,j,k,bi,bj) = aimTld(i,j)-celsius2K
a27dd2281d Jean*0102           ENDDO
                0103          ENDDO
                0104         ENDDO
b3097ed02d Jean*0105         DO j=1,sNy
                0106          DO i=1,sNx
                0107            land_skinT(i,j,bi,bj) = land_groundT(i,j,1,bi,bj)
                0108          ENDDO
                0109         ENDDO
a27dd2281d Jean*0110        ENDIF
                0111 
f55a588e76 Jean*0112        IF (land_calc_grW) THEN
a27dd2281d Jean*0113 C-    Use land-pkg output instead of prescribed soil moisture
bea6259b65 Jean*0114         IF ( land_calc_snow ) THEN
                0115 C        Units: hSnow & hSnowWetness are in meter (of snow)
                0116          recip_hSnWet = 0. _d 0
                0117          IF ( hSnowWetness .NE. 0. _d 0 )
                0118      &   recip_hSnWet = 1. _d 0 / hSnowWetness
                0119          DO j=1,sNy
                0120           DO i=1,sNx
b3097ed02d Jean*0121            aimSWA(i,j) = land_groundW(i,j,1,bi,bj)
bea6259b65 Jean*0122      &                 + land_hSnow(i,j,bi,bj)*recip_hSnWet
c2ff084b73 Jean*0123            aimSWA(i,j) = MIN( MAX(0. _d 0, aimSWA(i,j)), 1. _d 0 )
bea6259b65 Jean*0124           ENDDO
a27dd2281d Jean*0125          ENDDO
bea6259b65 Jean*0126         ELSE
                0127 C        Units: snowFld is in milimeter of equivalent liquid water
                0128          recip_mSnWet = 0. _d 0
                0129          IF ( hSnowWetness .NE. 0. _d 0 )
                0130      &   recip_mSnWet = land_rhoLiqW 
                0131      &                / (land_rhoSnow*hSnowWetness*1000. _d 0)
                0132          DO j=1,sNy
                0133           DO i=1,sNx
                0134            aimSWA(i,j) = land_groundW(i,j,1,bi,bj)
                0135      &                 + snowFld(i,j)*recip_mSnWet
c2ff084b73 Jean*0136            aimSWA(i,j) = MIN( MAX(0. _d 0, aimSWA(i,j)), 1. _d 0 )
bea6259b65 Jean*0137           ENDDO
                0138          ENDDO
                0139         ENDIF
a27dd2281d Jean*0140        ELSE
                0141 C-    Fill in land-pkg soil moisture using AIM surf. fields
cb4802039f Jean*0142         kFillW = land_nLev
                0143         IF (land_calc_grT) kFillW = 1
                0144         DO k=1,kFillW
a27dd2281d Jean*0145          DO j=1,sNy
                0146           DO i=1,sNx
b3097ed02d Jean*0147            land_groundW(i,j,k,bi,bj) = aimSWA(i,j)
a27dd2281d Jean*0148           ENDDO
                0149          ENDDO
                0150         ENDDO
b3097ed02d Jean*0151 c       IF ( land_calc_grT ) THEN
                0152 C-      needs to recompute enthalpy since grdW has changed:
                0153 C       not a good idea: frozen water in the ground will be lost !
                0154         IF ( .FALSE. ) THEN
                0155          DO j=1,sNy
                0156           DO i=1,sNx
                0157 c          IF ( land_frc(i,j,bi,bj).GT.0. ) THEN
                0158             DO k=1,land_nLev
                0159              mWater = land_rhoLiqW*land_waterCap
                0160      &               *land_groundW(i,j,k,bi,bj)
                0161              grd_HeatCp = land_heatCs + land_CpWater*mWater
                0162 
                0163              land_enthalp(i,j,k,bi,bj) =
                0164      &                     grd_HeatCp*land_groundT(i,j,k,bi,bj)
                0165             ENDDO
                0166 c          ENDIF
                0167           ENDDO
                0168          ENDDO
                0169         ENDIF
                0170 
                0171 C- end: if land_calc_grW
                0172        ENDIF
                0173 
                0174        IF (land_calc_snow) THEN
                0175 
                0176         IF (land_calc_alb) THEN
                0177 C-     Compute albedo of snow ; and replace albedo of land.
                0178          CALL LAND_ALBEDO(
                0179      I                land_frc, grnd_alb,
                0180      O                aimAlb,
                0181      I                bi,bj, myTime, myIter, myThid )
                0182 
                0183         ELSE
                0184 C-    Surface Albedo : (from F.M. FORDATE S/R)
                0185          RSD = 1. _d 0/SDALB
                0186          DO j=1,sNy
                0187           DO i=1,sNx
                0188            aimAlb(i,j) = grnd_alb(i,j,bi,bj)
                0189      &       + MAX( 0. _d 0, ALBSN-grnd_alb(i,j,bi,bj) )
                0190      &        *MIN( 1. _d 0, RSD*snowFld(i,j) )
                0191           ENDDO
                0192          ENDDO
                0193         ENDIF
                0194 
a27dd2281d Jean*0195        ENDIF
                0196 
                0197 c     ENDIF
                0198 
                0199 #endif /* ALLOW_LAND */
                0200 #endif /* ALLOW_AIM */
                0201 
                0202       RETURN
                0203       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!