Back to home page

MITgcm

 
 

    


File indexing completed on 2023-02-03 06:10:36 UTC

view on githubraw file Latest commit edb66560 on 2023-02-02 23:32:31 UTC
fc7306ba7d Jean*0001 #include "THSICE_OPTIONS.h"
14de9be26e Jeff*0002 #ifdef ALLOW_ATM2D
                0003 # include "ctrparam.h"
                0004 #endif
6b47d550f4 Mart*0005 #ifdef ALLOW_AUTODIFF
                0006 # include "AUTODIFF_OPTIONS.h"
                0007 #endif
87ea84cac6 Jean*0008 
                0009 CBOP
fc7306ba7d Jean*0010 C     !ROUTINE: THSICE_STEP_FWD
                0011 C     !INTERFACE:
17fd302697 Jean*0012       SUBROUTINE THSICE_STEP_FWD(
fc7306ba7d Jean*0013      I             bi, bj, iMin, iMax, jMin, jMax,
c8bafbe9ad Jean*0014      I             prcAtm, snowPrc, qPrcRnO,
fc7306ba7d Jean*0015      I             myTime, myIter, myThid )
87ea84cac6 Jean*0016 C     !DESCRIPTION: \bv
fc7306ba7d Jean*0017 C     *==========================================================*
17fd302697 Jean*0018 C     | S/R  THSICE_STEP_FWD
fc7306ba7d Jean*0019 C     | o Step Forward Therm-SeaIce model.
                0020 C     *==========================================================*
87ea84cac6 Jean*0021 C     \ev
fc7306ba7d Jean*0022 
                0023 C     !USES:
                0024       IMPLICIT NONE
87ea84cac6 Jean*0025 
fc7306ba7d Jean*0026 C     === Global variables ===
                0027 #include "SIZE.h"
                0028 #include "EEPARAMS.h"
                0029 #include "PARAMS.h"
                0030 #include "FFIELDS.h"
14de9be26e Jeff*0031 #ifdef  ALLOW_ATM2D
                0032 # include "ATMSIZE.h"
                0033 # include "ATM2D_VARS.h"
                0034 #endif
fc7306ba7d Jean*0035 #include "THSICE_SIZE.h"
                0036 #include "THSICE_PARAMS.h"
87ea84cac6 Jean*0037 #include "THSICE_VARS.h"
d6f06800ae Patr*0038 #ifdef ALLOW_AUTODIFF_TAMC
                0039 # include "tamc.h"
                0040 #endif
                0041 
7269783f6f Jean*0042       INTEGER siLo, siHi, sjLo, sjHi
                0043       PARAMETER ( siLo = 1-OLx , siHi = sNx+OLx )
                0044       PARAMETER ( sjLo = 1-OLy , sjHi = sNy+OLy )
17fd302697 Jean*0045 
fc7306ba7d Jean*0046 C     !INPUT/OUTPUT PARAMETERS:
                0047 C     === Routine arguments ===
7269783f6f Jean*0048 C- input:
87ea84cac6 Jean*0049 C     bi,bj   :: tile indices
                0050 C   iMin,iMax :: computation domain: 1rst index range
                0051 C   jMin,jMax :: computation domain: 2nd  index range
17fd302697 Jean*0052 C     prcAtm  :: total precip from the atmosphere [kg/m2/s]
c8bafbe9ad Jean*0053 C     snowPrc :: snow precipitation               [kg/m2/s]
bd7be113e1 Jean*0054 C     qPrcRnO :: Energy content of Precip+RunOff (+=down) [W/m2]
7269783f6f Jean*0055 C     myTime  :: current Time of simulation [s]
                0056 C     myIter  :: current Iteration number in simulation
                0057 C     myThid  :: my Thread Id number
                0058 C-- Use fluxes hold in commom blocks
                0059 C- input:
                0060 C     icFlxSW :: net short-wave heat flux (+=down) below sea-ice, into ocean
                0061 C     icFlxAtm  :: net Atmospheric surf. heat flux over sea-ice [W/m2], (+=down)
281cce82f4 Jean*0062 C     icFrwAtm  :: evaporation over sea-ice to the atmosphere   [kg/m2/s] (+=up)
87ea84cac6 Jean*0063 C- output
7269783f6f Jean*0064 C     icFlxAtm  :: net Atmospheric surf. heat flux over ice+ocean [W/m2], (+=down)
281cce82f4 Jean*0065 C     icFrwAtm  :: net fresh-water flux (E-P) from the atmosphere [kg/m2/s] (+=up)
fc7306ba7d Jean*0066       INTEGER bi,bj
                0067       INTEGER iMin, iMax
                0068       INTEGER jMin, jMax
bd7be113e1 Jean*0069       _RL prcAtm (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
c8bafbe9ad Jean*0070       _RL snowPrc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
bd7be113e1 Jean*0071       _RL qPrcRnO(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
fc7306ba7d Jean*0072       _RL  myTime
                0073       INTEGER myIter
                0074       INTEGER myThid
87ea84cac6 Jean*0075 CEOP
fc7306ba7d Jean*0076 
                0077 #ifdef ALLOW_THSICE
                0078 C     !LOCAL VARIABLES:
                0079 C     === Local variables ===
7269783f6f Jean*0080 C     iceFrac   :: fraction of grid area covered in ice
87ea84cac6 Jean*0081 C     flx2oc    :: net heat flux from the ice to the ocean (+=down) [W/m2]
281cce82f4 Jean*0082 C     frw2oc    :: fresh-water flux from the ice to the ocean (+=down)
                0083 C     fsalt     :: mass salt flux to the ocean                (+=down)
                0084 C     frzSeaWat :: seawater freezing rate (expressed as mass flux) [kg/m^2/s]
87ea84cac6 Jean*0085 C     frzmltMxL :: ocean mixed-layer freezing/melting potential [W/m2]
7269783f6f Jean*0086 C     tFrzOce   :: sea-water freezing temperature [oC] (function of S)
8d92b2862f Jean*0087 C     isIceFree :: true for ice-free grid-cell that remains ice-free
7269783f6f Jean*0088 C     ageFac    :: snow aging factor [1]
                0089 C     snowFac   :: snowing refreshing-age factor [units of 1/snowPr]
a85293d087 Mart*0090 #ifdef ALLOW_BULK_FORCE
8d92b2862f Jean*0091       LOGICAL isIceFree(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
a85293d087 Mart*0092 #endif
7269783f6f Jean*0093       _RL     iceFrac  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0094       _RL     flx2oc   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0095       _RL     frw2oc   (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0096       _RL     fsalt    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
281cce82f4 Jean*0097       _RL     frzSeaWat(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
7269783f6f Jean*0098       _RL     tFrzOce  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0099       _RL     frzmltMxL(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0100       _RL ageFac
                0101       _RL snowFac
                0102       _RL cphm
                0103       _RL opFrac, icFrac
                0104       INTEGER i,j
                0105       LOGICAL dBugFlag
fc7306ba7d Jean*0106 
7c50f07931 Mart*0107 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0108 C     tkey  :: tape key (depends on tiles)
                0109       INTEGER tkey
7c50f07931 Mart*0110 #endif
7269783f6f Jean*0111 C-    define grid-point location where to print debugging values
                0112 #include "THSICE_DEBUG.h"
fc7306ba7d Jean*0113 
17fd302697 Jean*0114  1010 FORMAT(A,1P4E14.6)
7269783f6f Jean*0115 
                0116 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0117 
d6f06800ae Patr*0118 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0119       tkey = bi + (bj-1)*nSx + (ikey_dynamics-1)*nSx*nSy
d6f06800ae Patr*0120 #endif /* ALLOW_AUTODIFF_TAMC */
                0121 
7269783f6f Jean*0122 C-    Initialise
ae605e558b Jean*0123       dBugFlag = debugLevel.GE.debLevC
7269783f6f Jean*0124       DO j = 1-OLy, sNy+OLy
1271d2846f Jean*0125        DO i = 1-OLx, sNx+OLx
a85293d087 Mart*0126 #ifdef ALLOW_BULK_FORCE
8d92b2862f Jean*0127           isIceFree(i,j) = .FALSE.
a85293d087 Mart*0128 #endif
14de9be26e Jeff*0129 #ifdef ALLOW_ATM2D
                0130           sFluxFromIce(i,j) = 0. _d 0
                0131 #else
7269783f6f Jean*0132           saltFlux(i,j,bi,bj) = 0. _d 0
14de9be26e Jeff*0133 #endif
281cce82f4 Jean*0134           frzSeaWat(i,j) = 0. _d 0
6b47d550f4 Mart*0135 #ifdef ALLOW_AUTODIFF
7269783f6f Jean*0136           iceFrac(i,j) = 0.
0707ba3b3d Jean*0137 C-   set these arrays everywhere: overlap are not set and not used,
                0138 C     but some arrays are stored and storage includes overlap.
                0139           flx2oc(i,j) = 0. _d 0
                0140           frw2oc(i,j) = 0. _d 0
                0141           fsalt (i,j) = 0. _d 0
                0142 c         tFrzOce  (i,j) = 0. _d 0
                0143 c         frzmltMxL(i,j) = 0. _d 0
c567874792 Patr*0144 #endif
1271d2846f Jean*0145        ENDDO
7269783f6f Jean*0146       ENDDO
87ea84cac6 Jean*0147 
7269783f6f Jean*0148       ageFac = 1. _d 0 - thSIce_deltaT/snowAgTime
                0149       snowFac = thSIce_deltaT/(rhos*hNewSnowAge)
77008a74ba Patr*0150 
                0151 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0152 CADJ STORE iceMask(:,:,bi,bj) = comlev1_bibj,key=tkey,kind=isbyte
77008a74ba Patr*0153 #endif
7269783f6f Jean*0154       DO j = jMin, jMax
                0155        DO i = iMin, iMax
                0156         IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN
                0157 C--  Snow aging :
                0158           snowAge(i,j,bi,bj) = thSIce_deltaT
                0159      &                       + snowAge(i,j,bi,bj)*ageFac
c8bafbe9ad Jean*0160           IF ( snowPrc(i,j).GT.0. _d 0 )
7269783f6f Jean*0161      &      snowAge(i,j,bi,bj) = snowAge(i,j,bi,bj)
c8bafbe9ad Jean*0162      &          * EXP( - snowFac*snowPrc(i,j) )
87ea84cac6 Jean*0163 C-------
7269783f6f Jean*0164 C note: Any flux of mass (here fresh water) that enter or leave the system
                0165 C       with a non zero energy HAS TO be counted: add snow precip.
                0166           icFlxAtm(i,j,bi,bj) = icFlxAtm(i,j,bi,bj)
c8bafbe9ad Jean*0167      &                        - Lfresh*snowPrc(i,j)
bd7be113e1 Jean*0168      &                        + qPrcRnO(i,j)
7269783f6f Jean*0169 C--
                0170         ENDIF
87ea84cac6 Jean*0171        ENDDO
7269783f6f Jean*0172       ENDDO
87ea84cac6 Jean*0173 
a4e6fa7055 Jean*0174 #ifdef ALLOW_DIAGNOSTICS
                0175       IF ( useDiagnostics ) THEN
668d2abf21 Jean*0176         CALL DIAGNOSTICS_FRACT_FILL( snowPrc,
                0177      I                       iceMask(1-OLx,1-OLy,bi,bj), oneRL, 1,
                0178      I                              'SIsnwPrc', 0,1,2,bi,bj,myThid )
                0179         CALL DIAGNOSTICS_FRACT_FILL( siceAlb, iceMask, oneRL, 1,
                0180      I                              'SIalbedo', 0,1,1,bi,bj,myThid )
a4e6fa7055 Jean*0181       ENDIF
                0182 #endif /* ALLOW_DIAGNOSTICS */
0cef907193 Jean*0183       DO j = jMin, jMax
                0184        DO i = iMin, iMax
                0185           siceAlb(i,j,bi,bj) = iceMask(i,j,bi,bj)*siceAlb(i,j,bi,bj)
                0186        ENDDO
                0187       ENDDO
a4e6fa7055 Jean*0188 
87ea84cac6 Jean*0189 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
17fd302697 Jean*0190 C    part.2 : ice-covered fraction ;
                0191 C     change in ice/snow thickness and ice-fraction
87ea84cac6 Jean*0192 C     note: can only reduce the ice-fraction but not increase it.
                0193 C-------
fc7306ba7d Jean*0194       DO j = jMin, jMax
                0195        DO i = iMin, iMax
87ea84cac6 Jean*0196 
7269783f6f Jean*0197         tFrzOce(i,j) = -mu_Tf*sOceMxL(i,j,bi,bj)
87ea84cac6 Jean*0198         cphm    = cpwater*rhosw*hOceMxL(i,j,bi,bj)
7269783f6f Jean*0199         frzmltMxL(i,j) = ( tFrzOce(i,j)-tOceMxL(i,j,bi,bj) )
                0200      &                 * cphm/ocean_deltaT
                0201         iceFrac(i,j) = iceMask(i,j,bi,bj)
bd7be113e1 Jean*0202         flx2oc(i,j)  = icFlxSW(i,j,bi,bj) + qPrcRnO(i,j)
87ea84cac6 Jean*0203 C-------
7269783f6f Jean*0204 #ifdef ALLOW_DBUG_THSICE
                0205         IF ( dBug(i,j,bi,bj) ) THEN
                0206          IF (frzmltMxL(i,j).GT.0. .OR. iceFrac(i,j).GT.0.) THEN
46a14d8906 Jean*0207           WRITE(6,'(A,2I4,2I2)') 'ThSI_FWD: i,j=',i,j,bi,bj
                0208           WRITE(6,1010) 'ThSI_FWD:-1- iceMask, hIc, hSn, Tsf  =',
7269783f6f Jean*0209      &                  iceFrac(i,j), iceHeight(i,j,bi,bj),
a83ee9767c Jean*0210      &                  snowHeight(i,j,bi,bj), Tsrf(i,j,bi,bj)
7269783f6f Jean*0211           WRITE(6,1010) 'ThSI_FWD: ocTs,tFrzOce,frzmltMxL,Qnet=',
                0212      &                     tOceMxL(i,j,bi,bj), tFrzOce(i,j),
                0213      &                     frzmltMxL(i,j), Qnet(i,j,bi,bj)
                0214          ENDIF
                0215          IF (iceFrac(i,j).GT.0.)
                0216      &    WRITE(6,1010) 'ThSI_FWD: icFrac,flxAtm,evpAtm,flxSnw=',
                0217      &      iceFrac(i,j), icFlxAtm(i,j,bi,bj),
c8bafbe9ad Jean*0218      &      icFrwAtm(i,j,bi,bj),-Lfresh*snowPrc(i,j)
fc7306ba7d Jean*0219         ENDIF
7269783f6f Jean*0220 #endif
                0221        ENDDO
                0222       ENDDO
fc7306ba7d Jean*0223 
d6f06800ae Patr*0224 #ifdef ALLOW_AUTODIFF_TAMC
edb6656069 Mart*0225 CADJ STORE iceHeight (:,:,bi,bj) = comlev1_bibj,key=tkey,kind=isbyte
                0226 CADJ STORE snowHeight(:,:,bi,bj) = comlev1_bibj,key=tkey,kind=isbyte
                0227 CADJ STORE iceMask   (:,:,bi,bj) = comlev1_bibj,key=tkey,kind=isbyte
                0228 CADJ STORE icFrwAtm  (:,:,bi,bj) = comlev1_bibj,key=tkey,kind=isbyte
                0229 CADJ STORE tFrzOce               = comlev1_bibj,key=tkey,kind=isbyte
                0230 CADJ STORE frzMltMxl             = comlev1_bibj,key=tkey,kind=isbyte
                0231 CADJ STORE iceFrac               = comlev1_bibj,key=tkey,kind=isbyte
d6f06800ae Patr*0232 #endif
7269783f6f Jean*0233       CALL THSICE_CALC_THICKN(
6dc8890c80 Patr*0234      I          bi, bj,
7269783f6f Jean*0235      I          iMin,iMax, jMin,jMax, dBugFlag,
                0236      I          iceMask(siLo,sjLo,bi,bj), tFrzOce,
                0237      I          tOceMxL(siLo,sjLo,bi,bj), v2ocMxL(siLo,sjLo,bi,bj),
c8bafbe9ad Jean*0238      I          snowPrc(siLo,sjLo), prcAtm,
7269783f6f Jean*0239      I          sHeating(siLo,sjLo,bi,bj), flxCndBt(siLo,sjLo,bi,bj),
                0240      U          iceFrac, iceHeight(siLo,sjLo,bi,bj),
                0241      U          snowHeight(siLo,sjLo,bi,bj), Tsrf(siLo,sjLo,bi,bj),
                0242      U          Qice1(siLo,sjLo,bi,bj), Qice2(siLo,sjLo,bi,bj),
                0243      U          icFrwAtm(siLo,sjLo,bi,bj), frzmltMxL, flx2oc,
281cce82f4 Jean*0244      O          frw2oc, fsalt, frzSeaWat,
7269783f6f Jean*0245      I          myTime, myIter, myThid )
486e9de820 Jean*0246 #ifdef ALLOW_AUTODIFF_TAMC
a85293d087 Mart*0247 C     these stores avoid recomputing s/r thsice_calc_thickn
                0248 CADJ STORE icFrwAtm(:,:,bi,bj)
edb6656069 Mart*0249 CADJ &               = comlev1_bibj, key = tkey, kind = isbyte
                0250 CADJ STORE frzSeaWat = comlev1_bibj, key = tkey, kind = isbyte
                0251 CADJ STORE fsalt     = comlev1_bibj, key = tkey, kind = isbyte
                0252 CADJ STORE flx2oc    = comlev1_bibj, key = tkey, kind = isbyte
                0253 CADJ STORE frw2oc    = comlev1_bibj, key = tkey, kind = isbyte
                0254 CADJ STORE frzmltMxL = comlev1_bibj, key = tkey, kind = isbyte
486e9de820 Jean*0255 #endif
a85293d087 Mart*0256 
                0257 C--   Net fluxes :
7269783f6f Jean*0258       DO j = jMin, jMax
                0259        DO i = iMin, iMax
                0260         IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN
87ea84cac6 Jean*0261 C-     weighted average net fluxes:
                0262           icFrac = iceMask(i,j,bi,bj)
                0263           opFrac= 1. _d 0-icFrac
14de9be26e Jeff*0264 #ifdef ALLOW_ATM2D
                0265           pass_qnet(i,j) = pass_qnet(i,j) - icFrac*flx2oc(i,j)
                0266           pass_evap(i,j) = pass_evap(i,j) - icFrac*frw2oc(i,j)/rhofw
                0267           sFluxFromIce(i,j) = -icFrac*fsalt(i,j)
                0268 #else
7269783f6f Jean*0269           icFlxAtm(i,j,bi,bj) = icFrac*icFlxAtm(i,j,bi,bj)
                0270      &                        - opFrac*Qnet(i,j,bi,bj)
                0271           icFrwAtm(i,j,bi,bj) = icFrac*icFrwAtm(i,j,bi,bj)
6206cdb986 Jean*0272      &                        + opFrac*EmPmR(i,j,bi,bj)
7269783f6f Jean*0273           Qnet(i,j,bi,bj) = -icFrac*flx2oc(i,j) + opFrac*Qnet(i,j,bi,bj)
6206cdb986 Jean*0274           EmPmR(i,j,bi,bj)= -icFrac*frw2oc(i,j)
7269783f6f Jean*0275      &                    +  opFrac*EmPmR(i,j,bi,bj)
                0276           saltFlux(i,j,bi,bj) = -icFrac*fsalt(i,j)
14de9be26e Jeff*0277 #endif
a85293d087 Mart*0278 #if defined(ALLOW_SALT_PLUME) || defined(ALLOW_ATM_COMPON_INTERF)
281cce82f4 Jean*0279 C-    All seawater freezing (no reduction by surf. melting) from CALC_THICKN
                0280 c         frzSeaWat(i,j) = icFrac*frzSeaWat(i,j)
                0281 C-    Net seawater freezing (underestimated if there is surf. melting or rain)
                0282           frzSeaWat(i,j) = MAX( -icFrac*frw2oc(i,j), 0. _d 0 )
a85293d087 Mart*0283 #endif
7269783f6f Jean*0284 
                0285 #ifdef ALLOW_DBUG_THSICE
                0286           IF (dBug(i,j,bi,bj)) WRITE(6,1010)
                0287      &          'ThSI_FWD:-3- iceFrac, hIc, hSn, Qnet =',
                0288      &           iceFrac(i,j), iceHeight(i,j,bi,bj),
                0289      &           snowHeight(i,j,bi,bj), Qnet(i,j,bi,bj)
                0290 #endif
fc7306ba7d Jean*0291 
6206cdb986 Jean*0292         ELSEIF (hOceMxL(i,j,bi,bj).GT.0. _d 0) THEN
7269783f6f Jean*0293           icFlxAtm(i,j,bi,bj) = -Qnet(i,j,bi,bj)
6206cdb986 Jean*0294           icFrwAtm(i,j,bi,bj) = EmPmR(i,j,bi,bj)
87ea84cac6 Jean*0295         ELSE
7269783f6f Jean*0296           icFlxAtm(i,j,bi,bj) = 0. _d 0
                0297           icFrwAtm(i,j,bi,bj) = 0. _d 0
fc7306ba7d Jean*0298         ENDIF
7269783f6f Jean*0299        ENDDO
                0300       ENDDO
fc7306ba7d Jean*0301 
                0302 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
87ea84cac6 Jean*0303 C    part.3 : freezing of sea-water
fc7306ba7d Jean*0304 C     over ice-free fraction and what is left from ice-covered fraction
                0305 C-------
1271d2846f Jean*0306       DO j = 1-OLy, sNy+OLy
                0307        DO i = 1-OLx, sNx+OLx
                0308          flx2oc(i,j) = 0. _d 0
                0309          frw2oc(i,j) = 0. _d 0
                0310          fsalt (i,j) = 0. _d 0
                0311        ENDDO
                0312       ENDDO
7269783f6f Jean*0313       CALL THSICE_EXTEND(
6dc8890c80 Patr*0314      I          bi, bj,
7269783f6f Jean*0315      I          iMin,iMax, jMin,jMax, dBugFlag,
                0316      I          frzmltMxL, tFrzOce,
                0317      I          tOceMxL(siLo,sjLo,bi,bj),
                0318      U          iceFrac, iceHeight(siLo,sjLo,bi,bj),
                0319      U          snowHeight(siLo,sjLo,bi,bj), Tsrf(siLo,sjLo,bi,bj),
                0320      U          Tice1(siLo,sjLo,bi,bj), Tice2(siLo,sjLo,bi,bj),
                0321      U          Qice1(siLo,sjLo,bi,bj), Qice2(siLo,sjLo,bi,bj),
                0322      O          flx2oc, frw2oc, fsalt,
                0323      I          myTime, myIter, myThid )
87ea84cac6 Jean*0324 
77008a74ba Patr*0325 #ifdef ALLOW_AUTODIFF_TAMC
a85293d087 Mart*0326 C     these stores avoid recomputing s/r thsice_extend
edb6656069 Mart*0327 CADJ STORE snowHeight(:,:,bi,bj) = comlev1_bibj,key=tkey,kind=isbyte
                0328 CADJ STORE iceHeight (:,:,bi,bj) = comlev1_bibj,key=tkey,kind=isbyte
                0329 CADJ STORE iceMask   (:,:,bi,bj) = comlev1_bibj,key=tkey,kind=isbyte
                0330 CADJ STORE iceFrac               = comlev1_bibj,key=tkey,kind=isbyte
77008a74ba Patr*0331 #endif
7269783f6f Jean*0332       DO j = jMin, jMax
                0333        DO i = iMin, iMax
ecbcb862f1 Jean*0334 C--    Net fluxes : (only non-zero contribution where frzmltMxL > 0 )
14de9be26e Jeff*0335 #ifdef ALLOW_ATM2D
                0336           pass_qnet(i,j) = pass_qnet(i,j) - flx2oc(i,j)
                0337           pass_evap(i,j) = pass_evap(i,j) - frw2oc(i,j)/rhofw
                0338           sFluxFromIce(i,j)= sFluxFromIce(i,j) - fsalt(i,j)
                0339 #else
7269783f6f Jean*0340           Qnet(i,j,bi,bj) = Qnet(i,j,bi,bj) - flx2oc(i,j)
6206cdb986 Jean*0341           EmPmR(i,j,bi,bj)= EmPmR(i,j,bi,bj)- frw2oc(i,j)
7269783f6f Jean*0342           saltFlux(i,j,bi,bj)=saltFlux(i,j,bi,bj) - fsalt(i,j)
14de9be26e Jeff*0343 #endif
a85293d087 Mart*0344 #if defined(ALLOW_SALT_PLUME) || defined(ALLOW_ATM_COMPON_INTERF)
281cce82f4 Jean*0345           frzSeaWat(i,j) = frzSeaWat(i,j) + MAX(-frw2oc(i,j), 0. _d 0 )
a85293d087 Mart*0346 #endif
7269783f6f Jean*0347 
                0348 #ifdef ALLOW_DBUG_THSICE
ecbcb862f1 Jean*0349         IF (dBug(i,j,bi,bj)) WRITE(6,1010)
7269783f6f Jean*0350      &         'ThSI_FWD:-4- iceFrac, hIc, hSn, Qnet =',
                0351      &           iceFrac(i,j), iceHeight(i,j,bi,bj),
                0352      &           snowHeight(i,j,bi,bj), Qnet(i,j,bi,bj)
                0353 #endif
fc7306ba7d Jean*0354 
a85293d087 Mart*0355 #ifdef ALLOW_BULK_FORCE
8d92b2862f Jean*0356         IF ( hOceMxL(i,j,bi,bj).GT.0. _d 0 )
                0357      &    isIceFree(i,j) = iceMask(i,j,bi,bj).LE.0. _d 0
a4eca6e929 Jean*0358      &                  .AND.   iceFrac(i,j) .LE.0. _d 0
a85293d087 Mart*0359 #endif
7269783f6f Jean*0360         IF ( iceFrac(i,j) .GT. 0. _d 0 ) THEN
                0361           iceMask(i,j,bi,bj)=iceFrac(i,j)
                0362           IF ( snowHeight(i,j,bi,bj).EQ.0. _d 0 )
                0363      &     snowAge(i,j,bi,bj) = 0. _d 0
fc7306ba7d Jean*0364         ELSE
                0365           iceMask(i,j,bi,bj)  = 0. _d 0
                0366           iceHeight(i,j,bi,bj)= 0. _d 0
                0367           snowHeight(i,j,bi,bj)=0. _d 0
87ea84cac6 Jean*0368           snowAge(i,j,bi,bj)  = 0. _d 0
7269783f6f Jean*0369           Tsrf(i,j,bi,bj)     = tOceMxL(i,j,bi,bj)
fc7306ba7d Jean*0370           Tice1(i,j,bi,bj)    = 0. _d 0
                0371           Tice2(i,j,bi,bj)    = 0. _d 0
9d4bfda7d0 Jean*0372           Qice1(i,j,bi,bj)    = Lfresh
                0373           Qice2(i,j,bi,bj)    = Lfresh
fc7306ba7d Jean*0374         ENDIF
77008a74ba Patr*0375        ENDDO
                0376       ENDDO
fc7306ba7d Jean*0377 
ae89a28819 Jean*0378 #if defined(ALLOW_SALT_PLUME) || defined(ALLOW_ATM_COMPON_INTERF)
                0379       IF ( useSALT_PLUME .OR. useCoupler ) THEN
f141670dc2 Jean*0380         CALL THSICE_SALT_PLUME(
1271d2846f Jean*0381      I          sOceMxL(1-OLx,1-OLy,bi,bj),
281cce82f4 Jean*0382      I          frzSeaWat,
1271d2846f Jean*0383      I          iMin,iMax, jMin,jMax, bi, bj,
281cce82f4 Jean*0384      I          myTime, myIter, myThid )
f141670dc2 Jean*0385       ENDIF
ae89a28819 Jean*0386 #endif /* ALLOW_SALT_PLUME or ALLOW_ATM_COMPON_INTERF */
f141670dc2 Jean*0387 
96502f6244 Jean*0388       IF ( thSIceAdvScheme.LE.0 ) THEN
                0389 C- note: 1) regarding sIceLoad in ocean-dynamics, in case thSIceAdvScheme > 0,
                0390 C          compute sIceLoad in THSICE_DO_ADVECT after seaice advection is done.
                0391 C        2) regarding sIceLoad in seaice-dynamics, probably better not to update
                0392 C          sIceLoad here, to keep the balance between sIceLoad and adjusted Eta.
                0393 C        3) not sure in the case of no advection (thSIceAdvScheme=0) but using
                0394 C          seaice dynamics (unlikely senario anyway).
                0395 C--   Compute Sea-Ice Loading (= mass of sea-ice + snow / area unit)
                0396        DO j = jMin, jMax
                0397         DO i = iMin, iMax
                0398           sIceLoad(i,j,bi,bj) = ( snowHeight(i,j,bi,bj)*rhos
                0399      &                           + iceHeight(i,j,bi,bj)*rhoi
                0400      &                          )*iceMask(i,j,bi,bj)
35780a5bdd Jeff*0401 #ifdef ALLOW_ATM2D
96502f6244 Jean*0402           pass_sIceLoad(i,j)=sIceLoad(i,j,bi,bj)
35780a5bdd Jeff*0403 #endif
96502f6244 Jean*0404         ENDDO
fc7306ba7d Jean*0405        ENDDO
96502f6244 Jean*0406       ENDIF
fc7306ba7d Jean*0407 
8d92b2862f Jean*0408 #ifdef ALLOW_BULK_FORCE
                0409       IF ( useBulkForce ) THEN
                0410         CALL BULKF_FLUX_ADJUST(
                0411      I                          bi, bj, iMin, iMax, jMin, jMax,
                0412      I                          isIceFree, myTime, myIter, myThid )
                0413       ENDIF
                0414 #endif /* ALLOW_BULK_FORCE */
                0415 
fc7306ba7d Jean*0416 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0417 #endif /* ALLOW_THSICE */
                0418 
                0419       RETURN
                0420       END