pkg/aim_v23/aim_aim2sioce.F

cdcb187d4c Jean*0001 #include "AIM_OPTIONS.h"
                0002 #ifdef ALLOW_THSICE
                0003 #include "THSICE_OPTIONS.h"
                0004 #endif
                0005
                0006 CBOP
3dd105254f Jean*0007 C     !ROUTINE: AIM_AIM2SIOCE
cdcb187d4c Jean*0008 C     !INTERFACE:
3dd105254f Jean*0009       SUBROUTINE AIM_AIM2SIOCE(
78a4349940 Jean*0010      I               land_frc, siceFrac,
7d37b6de57 Jean*0011      O               prcAtm, snowPrc,
cdcb187d4c Jean*0012      I               bi, bj, myTime, myIter, myThid)
                0013
                0014 C     !DESCRIPTION: \bv
                0015 C     *==========================================================*
3dd105254f Jean*0016 C     | S/R AIM_AIM2SIOCE
                0017 C     | o Interface between AIM and thSIce pkg or (coupled) ocean
                0018 C     *==========================================================*
                0019 C     | o compute surface fluxes over ocean (ice-free + ice covered)
                0020 C     |   for diagnostics, thsice package and (slab, coupled) ocean
cdcb187d4c Jean*0021 C     *==========================================================*
                0022 C     \ev
                0023
                0024 C     !USES:
                0025       IMPLICIT NONE
                0026
                0027 C     == Global variables ===
                0028 C-- size for MITgcm & Physics package :
82cec189c9 Jean*0029 #include "AIM_SIZE.h"
cdcb187d4c Jean*0030
                0031 #include "EEPARAMS.h"
                0032 #include "PARAMS.h"
                0033 #include "FFIELDS.h"
                0034
                0035 C-- Physics package
                0036 #include "AIM_PARAMS.h"
                0037 #include "com_physcon.h"
                0038 #include "com_physvar.h"
                0039
                0040 #ifdef ALLOW_THSICE
82cec189c9 Jean*0041 #include "THSICE_SIZE.h"
cdcb187d4c Jean*0042 #include "THSICE_PARAMS.h"
                0043 #include "THSICE_VARS.h"
                0044 #endif
                0045
82cec189c9 Jean*0046 C updated fields (in commom blocks):
                0047 C  if using thSIce:
                0048 C      Qsw(inp)   :: SW radiation through the sea-ice down to the ocean (+=up)
                0049 C      Qsw(out)   :: SW radiation down to the ocean (ice-free + ice-covered)(+=up)
                0050 C      Qnet(out)  :: Net heat flux out of the ocean (ice-free ocean only)(+=up)
                0051 C             and the Ice-Covered contribution will be added in S/R THSICE_STEP_FWD
                0052 C      EmPmR(out) :: Net fresh water flux out off the ocean (ice-free ocean only)
                0053 C             and the Ice-Covered contribution will be added in S/R THSICE_STEP_FWD
                0054 C      sHeating(in/out) :: air - seaice surface heat flux left to melt the ice
65d8b97200 Jean*0055 C      icFrwAtm   :: Evaporation over sea-ice [kg/m2/s] (>0 if evaporate)
                0056 C      icFlxSW    :: net SW heat flux through the ice to the ocean [W/m2] (+=dw)
82cec189c9 Jean*0057 C  if not using thSIce:
                0058 C      Qsw(out)   :: SW radiation down to the ocean (ice-free + ice-covered)(+=up)
                0059 C      Qnet(out)  :: Net heat flux out of the ocean (ice-free + ice-covered)(+=up)
                0060 C      EmPmR(out) :: Net fresh water flux out off the ocean (ice-free + ice-covered)
                0061
cdcb187d4c Jean*0062 C     !INPUT/OUTPUT PARAMETERS:
                0063 C     == Routine arguments ==
                0064 C     land_frc :: land fraction [0-1]
78a4349940 Jean*0065 C     siceFrac :: sea-ice fraction (relative to full grid-cell) [0-1]
cdcb187d4c Jean*0066 C     prcAtm   :: total precip from the atmosphere [kg/m2/s]
7d37b6de57 Jean*0067 C     snowPrc  :: snow precip over sea-ice [kg/m2/s]
9ff24e670a Jean*0068 C     bi,bj    :: Tile indices
cdcb187d4c Jean*0069 C     myTime   :: Current time of simulation ( s )
                0070 C     myIter   :: Current iteration number in simulation
82cec189c9 Jean*0071 C     myThid   :: My Thread Id number
cdcb187d4c Jean*0072       _RS land_frc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
78a4349940 Jean*0073       _RL siceFrac(sNx,sNy)
7d37b6de57 Jean*0074       _RL prcAtm (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0075       _RL snowPrc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
cdcb187d4c Jean*0076       INTEGER bi, bj, myIter, myThid
                0077       _RL myTime
                0078 CEOP
                0079
                0080 #ifdef ALLOW_AIM
                0081 C     == Local variables ==
6206cdb986 Jean*0082 C     i,j,I2      :: loop counters
7d37b6de57 Jean*0083 C     convPrcEvp  :: units conversion factor for Precip & Evap:
6206cdb986 Jean*0084 C                 :: from AIM units (g/m2/s) to model EmPmR units ( kg/m2/s )
                0085       _RL convPrcEvp
cdcb187d4c Jean*0086       _RL icFrac, opFrac
                0087       INTEGER i,j,I2
                0088
                0089 C--   Initialisation :
                0090
                0091 C--   Atmospheric Physics Fluxes
                0092
78a4349940 Jean*0093 C     from g/m2/s to kg/m2/s :
6206cdb986 Jean*0094       convPrcEvp = 1. _d -3
cdcb187d4c Jean*0095
                0096       DO j=1,sNy
881999706d Jean*0097        DO i=1,sNx
                0098         IF ( land_frc(i,j,bi,bj).GE.1. _d 0 ) THEN
                0099 C-    Full Land grid-cell: set all fluxes to zero (this has no effect on the
                0100 C        model integration and just put this to get meaningfull diagnostics)
                0101          prcAtm(i,j)     = 0. _d 0
                0102          Qnet(i,j,bi,bj) = 0. _d 0
                0103          EmPmR(i,j,bi,bj)= 0. _d 0
                0104          Qsw(i,j,bi,bj)  = 0. _d 0
                0105         ELSE
cdcb187d4c Jean*0106          I2 = i+(j-1)*sNx
                0107
82cec189c9 Jean*0108 C-    Total Precip (no distinction between ice-covered / ice-free fraction):
cdcb187d4c Jean*0109          prcAtm(i,j) = ( PRECNV(I2,myThid)
                0110      &                 + PRECLS(I2,myThid) )
                0111
                0112 C-    Net surface heat flux over ice-free ocean (+=down)
82cec189c9 Jean*0113 C     note: with aim_splitSIOsFx=F, ice-free & ice covered contribution are
                0114 C     already merged together and Qnet is the mean heat flux over the grid box.
                0115          Qnet(i,j,bi,bj) =
cdcb187d4c Jean*0116      &                         SSR(I2,2,myThid)
                0117      &                       - SLR(I2,2,myThid)
                0118      &                       - SHF(I2,2,myThid)
                0119      &                       - EVAP(I2,2,myThid)*ALHC
                0120
82cec189c9 Jean*0121 C-    E-P over ice-free ocean [m/s]: (same as above is aim_splitSIOsFx=F)
cdcb187d4c Jean*0122          EmPmR(i,j,bi,bj) = ( EVAP(I2,2,myThid)
6206cdb986 Jean*0123      &                      - prcAtm(i,j) ) * convPrcEvp
cdcb187d4c Jean*0124
                0125 C-    Net short wave (ice-free ocean) into the ocean (+=down)
                0126          Qsw(i,j,bi,bj) = SSR(I2,2,myThid)
                0127
881999706d Jean*0128         ENDIF
                0129        ENDDO
cdcb187d4c Jean*0130       ENDDO
                0131
3dd105254f Jean*0132 #ifdef ALLOW_THSICE
cdcb187d4c Jean*0133       IF ( useThSIce ) THEN
                0134        DO j=1,sNy
                0135         DO i=1,sNx
                0136          I2 = i+(j-1)*sNx
82cec189c9 Jean*0137 C-    Mixed-Layer Ocean: (for thsice slab_ocean and coupler)
9ff24e670a Jean*0138 C     NOTE: masking is now applied much earlier, during initialisation
                0139 c        IF (land_frc(i,j,bi,bj).EQ.1. _d 0) hOceMxL(i,j,bi,bj) = 0.
cdcb187d4c Jean*0140
82cec189c9 Jean*0141 C-    Evaporation over sea-ice: (for thsice)
6206cdb986 Jean*0142          icFrwAtm(i,j,bi,bj) = EVAP(I2,3,myThid)*convPrcEvp
cdcb187d4c Jean*0143
82cec189c9 Jean*0144 C-    short-wave downward heat flux (ice-free ocean + ice-covered):
65d8b97200 Jean*0145 C     note: at this point we already called THSICE_IMPL_TEMP to solve for
82cec189c9 Jean*0146 C     seaice temp and SW flux through the ice. SW is not modified after, and
                0147 C     can therefore combine the open-ocean & ice-covered ocean SW fluxes.
cdcb187d4c Jean*0148          icFrac = iceMask(i,j,bi,bj)
                0149          opFrac = 1. _d 0 - icFrac
65d8b97200 Jean*0150          Qsw(i,j,bi,bj) = icFrac*icFlxSW(i,j,bi,bj)
                0151      &                  + opFrac*Qsw(i,j,bi,bj)
cdcb187d4c Jean*0152
                0153         ENDDO
                0154        ENDDO
                0155
82cec189c9 Jean*0156        IF ( aim_energPrecip ) THEN
cdcb187d4c Jean*0157 C--   Add energy flux related to Precip. (snow, T_rain) over sea-ice
82cec189c9 Jean*0158          DO j=1,sNy
                0159           DO i=1,sNx
                0160            IF ( iceMask(i,j,bi,bj).GT.0. _d 0 ) THEN
                0161             I2 = i+(j-1)*sNx
                0162             IF ( EnPrec(I2,myThid).GE.0. _d 0 ) THEN
cdcb187d4c Jean*0163 C-    positive => add to surface heating
82cec189c9 Jean*0164               sHeating(i,j,bi,bj) = sHeating(i,j,bi,bj)
                0165      &                            + EnPrec(I2,myThid)*prcAtm(i,j)
7d37b6de57 Jean*0166               snowPrc(i,j) = 0. _d 0
82cec189c9 Jean*0167             ELSE
cdcb187d4c Jean*0168 C-    negative => make snow
7d37b6de57 Jean*0169               snowPrc(i,j) = prcAtm(i,j)*convPrcEvp
82cec189c9 Jean*0170             ENDIF
                0171            ELSE
7d37b6de57 Jean*0172               snowPrc(i,j) = 0. _d 0
82cec189c9 Jean*0173            ENDIF
                0174           ENDDO
                0175          ENDDO
                0176        ENDIF
                0177
78a4349940 Jean*0178       ELSEIF ( aim_splitSIOsFx ) THEN
                0179 #else /* ALLOW_THSICE */
                0180       IF ( aim_splitSIOsFx ) THEN
3dd105254f Jean*0181 #endif /* ALLOW_THSICE */
82cec189c9 Jean*0182 C-    aim_splitSIOsFx=T: fluxes over sea-ice (3) & ice-free ocean (2) were
                0183 C     computed separately and here we merge the 2 fractions
78a4349940 Jean*0184        DO j=1,sNy
                0185         DO i=1,sNx
                0186          I2 = i+(j-1)*sNx
                0187          IF ( siceFrac(i,j) .GT. 0. ) THEN
                0188           icFrac = siceFrac(i,j)/(1. _d 0 - land_frc(i,j,bi,bj))
                0189           opFrac = 1. _d 0 - icFrac
                0190
                0191 C-    Net surface heat flux over sea-ice + ice-free ocean (+=down)
                0192           Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj)*opFrac
                0193      &                    + (  SSR(I2,3,myThid)
                0194      &                       - SLR(I2,3,myThid)
                0195      &                       - SHF(I2,3,myThid)
                0196      &                       - EVAP(I2,3,myThid)*ALHC
                0197      &                      )*icFrac
                0198 C-    E-P over sea-ice + ice-free ocean [m/s]:
                0199           EmPmR(i,j,bi,bj) = EmPmR(i,j,bi,bj)*opFrac
                0200      &                     + ( EVAP(I2,3,myThid)
6206cdb986 Jean*0201      &                       - prcAtm(i,j) ) * convPrcEvp * icFrac
78a4349940 Jean*0202
                0203 C-    Net short wave (ice-free ocean) into the ocean (+=down)
                0204           Qsw(i,j,bi,bj) = opFrac*Qsw(i,j,bi,bj)
                0205      &                   + icFrac*SSR(I2,3,myThid)
                0206
                0207          ENDIF
                0208         ENDDO
                0209        ENDDO
82cec189c9 Jean*0210
                0211 C--   end of If useThSIce / elseif aim_splitSIOsFx blocks
78a4349940 Jean*0212       ENDIF
                0213
                0214       IF ( aim_energPrecip ) THEN
82cec189c9 Jean*0215 C--   Ice free fraction: Add energy flux related to Precip. (snow, T_rain):
78a4349940 Jean*0216         DO j=1,sNy
                0217          DO i=1,sNx
                0218           I2 = i+(j-1)*sNx
                0219           Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj)
                0220      &                    + EnPrec(I2,myThid)*prcAtm(i,j)
                0221          ENDDO
                0222         ENDDO
                0223       ENDIF
cdcb187d4c Jean*0224
                0225       DO j=1,sNy
                0226         DO i=1,sNx
                0227 C-    Total Precip : convert units
6206cdb986 Jean*0228           prcAtm(i,j) = prcAtm(i,j) * convPrcEvp
cdcb187d4c Jean*0229 C-    Oceanic convention: Heat flux are > 0 upward ; reverse sign.
                0230           Qsw(i,j,bi,bj) = -Qsw(i,j,bi,bj)
                0231           Qnet(i,j,bi,bj)= -Qnet(i,j,bi,bj)
                0232         ENDDO
                0233       ENDDO
                0234
                0235 #endif /* ALLOW_AIM */
                0236
                0237       RETURN
                0238       END