pkg/thsice/thsice_map_exf.F

2a9474d935 Mart*0001 #include "THSICE_OPTIONS.h"
                0002 #ifdef ALLOW_EXF
                0003 #include "EXF_OPTIONS.h"
                0004 #endif
                0005
                0006 CBOP
                0007 C     !ROUTINE: THSICE_MAP_EXF
                0008 C     !INTERFACE:
                0009       SUBROUTINE THSICE_MAP_EXF(
bd7be113e1 Jean*0010      I                  iceMsk, locSST,
                0011      O                  totPrc, snowPrc, qPrcRnO, flxSW,
2a9474d935 Mart*0012      I                  iMin,iMax,jMin,jMax, bi,bj, myThid )
                0013 C     !DESCRIPTION: \bv
                0014 C     *==========================================================*
                0015 C     | S/R  THSICE_MAP_EXF
7f3e8d8dce Jean*0016 C     | Interface S/R : map Precip, Snow and shortwave fluxes
2a9474d935 Mart*0017 C     |                 from pkg EXF to thsice variables
                0018 C     *==========================================================*
                0019 C     \ev
                0020
                0021 C     !USES:
                0022       IMPLICIT NONE
                0023
                0024 C     == Global data ==
                0025 #include "SIZE.h"
                0026 #include "EEPARAMS.h"
                0027 #include "PARAMS.h"
                0028 #include "FFIELDS.h"
                0029 #ifdef ALLOW_EXF
681d55b157 Jean*0030 # include "EXF_CONSTANTS.h"
                0031 # include "EXF_PARAM.h"
                0032 # include "EXF_FIELDS.h"
2a9474d935 Mart*0033 #endif
                0034
                0035 C     !INPUT/OUTPUT PARAMETERS:
                0036 C     === Routine arguments ===
                0037 C     iceMsk    :: sea-ice fraction: no ice=0, grid all ice 1  []
bd7be113e1 Jean*0038 C     locSST    :: local Sea-Surface Temperature [deg.C]
2a9474d935 Mart*0039 C     totPrc    :: Total Precipitation (including run-off) [kg/m2/s]
                0040 C     snowPrc   :: Snow Precipitation [kg/m2/s]
bd7be113e1 Jean*0041 C     qPrcRnO   :: Energy content of Precip+RunOff (+=down) [W/m2]
7f3e8d8dce Jean*0042 C     flxSW     :: Downward short-wave surface flux (+=down) [W/m2]
2a9474d935 Mart*0043 C     iMin,iMax :: range of indices of computation domain
                0044 C     jMin,jMax :: range of indices of computation domain
                0045 C     bi,bj     :: current tile indices
                0046 C     myThid      :: Thread no. that called this routine.
                0047       _RL iceMsk (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
bd7be113e1 Jean*0048       _RL locSST (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
2a9474d935 Mart*0049       _RL totPrc (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0050       _RL snowPrc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
bd7be113e1 Jean*0051       _RL qPrcRnO(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
2a9474d935 Mart*0052       _RL flxSW  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0053       INTEGER iMin,iMax
                0054       INTEGER jMin,jMax
                0055       INTEGER bi,bj
                0056       INTEGER myThid
                0057 CEOP
                0058
                0059 #ifdef ALLOW_EXF
                0060
                0061 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0062 C     === Local variables ===
                0063 C     i,j   :: current grid point indices
                0064       INTEGER i,j
                0065
                0066       DO j = jMin, jMax
                0067        DO i = iMin, iMax
5465695fc7 Jean*0068 #ifdef ALLOW_ATM_TEMP
2a9474d935 Mart*0069         totPrc(i,j) = precip(i,j,bi,bj)*rhoConstFresh
5465695fc7 Jean*0070 #endif
ee05de5537 Jean*0071 #ifdef ALLOW_RUNOFF
2a9474d935 Mart*0072         totPrc(i,j) = totPrc(i,j) + runoff(i,j,bi,bj)*rhoConstFresh
ee05de5537 Jean*0073 #else
                0074         STOP 'ABNORMAL END: S/R THSICE_MAP_EXF: ALLOW_RUNOFF undef'
2a9474d935 Mart*0075 #endif
5465695fc7 Jean*0076 #ifdef ALLOW_DOWNWARD_RADIATION
7f3e8d8dce Jean*0077         flxSW (i,j) = swdown(i,j,bi,bj)
5465695fc7 Jean*0078 #else
                0079       STOP 'ABNORMAL END: S/R THSICE_MAP_EXF: DOWNWARD_RADIATION undef'
                0080 #endif
2a9474d935 Mart*0081        ENDDO
                0082       ENDDO
7f3e8d8dce Jean*0083
5465695fc7 Jean*0084 #ifdef ALLOW_ATM_TEMP
2a9474d935 Mart*0085       IF ( snowPrecipFile .NE. ' ' ) THEN
                0086        DO j = jMin, jMax
                0087         DO i = iMin, iMax
                0088          snowPrc(i,j) = snowPrecip(i,j,bi,bj)*rhoConstFresh
                0089         ENDDO
                0090        ENDDO
                0091       ELSE
9b61e0a2f0 Jean*0092 C     If specific snow precipitiation is not available, use
2a9474d935 Mart*0093 C     precipitation when ever the air temperature is below 0 degC
                0094        DO j = jMin, jMax
                0095         DO i = iMin, iMax
                0096          IF ( iceMsk(i,j,bi,bj).GT.0. _d 0
                0097      &        .AND. atemp(i,j,bi,bj).LE.cen2kel )  THEN
9b61e0a2f0 Jean*0098 cML     &        .AND. atemp(i,j,bi,bj).LE.Tf0kel )  THEN
2a9474d935 Mart*0099           snowPrc(i,j) = precip(i,j,bi,bj)*rhoConstFresh
                0100          ENDIF
                0101         ENDDO
                0102        ENDDO
                0103       ENDIF
bd7be113e1 Jean*0104       IF ( temp_EvPrRn .NE. UNSET_RL ) THEN
                0105 C--   Account for energy content of Precip + RunOff :
                0106 C     assume 1) rain has same temp as Air (higher altitude, e.g., 850.mb would
                0107 C      be better); 2) Snow has no heat capacity (+ is counted separately)
                0108 C     3) no distinction between sea-water Cp and fresh-water Cp
                0109 C     4) Run-Off comes at the temp of surface water (with same Cp)
                0110        DO j = jMin, jMax
                0111         DO i = iMin, iMax
                0112          qPrcRnO(i,j) = HeatCapacity_Cp
                0113      &          *( atemp(i,j,bi,bj) - cen2kel - temp_EvPrRn )
                0114      &          *( precip(i,j,bi,bj)*rhoConstFresh - snowPrc(i,j) )
                0115      &
                0116 #ifdef ALLOW_RUNOFF
                0117          qPrcRnO(i,j) = qPrcRnO(i,j)
                0118      &                + HeatCapacity_Cp
                0119      &                 *( locSST(i,j,bi,bj) - temp_EvPrRn )
                0120      &                 *runoff(i,j,bi,bj)*rhoConstFresh
                0121 #endif
                0122         ENDDO
                0123        ENDDO
                0124       ENDIF
5465695fc7 Jean*0125 #else /* ALLOW_ATM_TEMP */
9b61e0a2f0 Jean*0126       STOP 'ABNORMAL END: S/R THSICE_MAP_EXF: ATM_TEMP undef'
5465695fc7 Jean*0127 #endif /* ALLOW_ATM_TEMP */
2a9474d935 Mart*0128
                0129 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0130
                0131 #endif /* ALLOW_EXF */
                0132
                0133       RETURN
                0134       END