pkg/aim_v23/aim_sice_impl.F

cdcb187d4c Jean*0001 #include "AIM_OPTIONS.h"
65d8b97200 Jean*0002 c#ifdef ALLOW_THSICE
                0003 c#include "THSICE_OPTIONS.h"
                0004 c#endif
cdcb187d4c Jean*0005
                0006 CBOP
                0007 C     !ROUTINE: AIM_SICE_IMPL
                0008 C     !INTERFACE:
                0009       SUBROUTINE AIM_SICE_IMPL(
                0010      I               FMASK, netSW, sFlx,
e749d70ece Jean*0011      I               Shf0, dShf, Evp0, dEvp, Slr0, dSlr,
                0012      U               Tsurf, SHF, EVAP, SLRU,
                0013      O               dTsurf,
cdcb187d4c Jean*0014      I               bi, bj, myTime, myIter, myThid)
                0015
                0016 C     !DESCRIPTION: \bv
                0017 C     *==========================================================*
                0018 C     | S/R AIM_SICE_IMPL
                0019 C     | o AIM Interface to the implicit part of the sea-ice model
                0020 C     *==========================================================*
                0021 C     \ev
                0022
                0023 C     !USES:
                0024       IMPLICIT NONE
                0025
                0026 C     == Global variables ===
                0027 C-- size for MITgcm & Physics package :
65d8b97200 Jean*0028 #include "AIM_SIZE.h"
cdcb187d4c Jean*0029
                0030 #include "EEPARAMS.h"
                0031 #include "PARAMS.h"
                0032
                0033 #include "AIM_FFIELDS.h"
                0034 #include "com_physcon.h"
                0035 c #include "com_physvar.h"
                0036
                0037 #ifdef ALLOW_THSICE
65d8b97200 Jean*0038 c#include "THSICE_SIZE.h"
                0039 c#include "THSICE_PARAMS.h"
                0040 c#include "THSICE_VARS.h"
cdcb187d4c Jean*0041 #endif
                0042
                0043 C     !INPUT/OUTPUT PARAMETERS:
                0044 C     == Routine arguments ==
                0045 C     FMASK    :: sea-ice fraction [0-1]
                0046 C     netSW    :: net Short Wave surf. flux (+=down) [W/m2]
                0047 C     sFlx     :: net heat flux (+=down) except SW, function of surf. temp Ts:
                0048 C                 0: Flux(Ts=0.oC) ; 1: Flux(Ts^n) ; 2: d.Flux/d.Ts(Ts^n)
e749d70ece Jean*0049 C     Shf0     :: sensible heat flux over freezing surf.
                0050 C     dShf     :: sensible heat flux derivative relative to surf. temp
cdcb187d4c Jean*0051 C     Evp0     :: evaporation computed over freezing surface (Ts=0.oC)
                0052 C     dEvp     :: evaporation derivative relative to surf. temp
                0053 C     Slr0     :: upward long wave radiation over freezing surf.
                0054 C     Tsurf    :: surface temperature        (2-dim)
e749d70ece Jean*0055 C     SHF      :: sensible heat flux              (2-dim)
cdcb187d4c Jean*0056 C     EVAP     :: evaporation [g/(m^2 s)]         (2-dim)
                0057 C     SLRU     :: sfc lw radiation (upward flux)  (2-dim)
e749d70ece Jean*0058 C     dTsurf   :: surf. temp change after 1 implicit time step [oC]
cdcb187d4c Jean*0059 C     bi,bj    :: Tile index
                0060 C     myTime   :: Current time of simulation ( s )
                0061 C     myIter   :: Current iteration number in simulation
                0062 C     myThid   :: Number of this instance of the routine
                0063       _RL  FMASK(NGP), netSW(NGP), sFlx(NGP,0:2)
e749d70ece Jean*0064       _RL  Shf0(NGP), dShf(NGP), Evp0(NGP), dEvp(NGP)
                0065       _RL  Slr0(NGP), dSlr(NGP)
                0066       _RL  Tsurf(NGP), SHF(NGP), EVAP(NGP), SLRU(NGP)
                0067       _RL  dTsurf(NGP)
cdcb187d4c Jean*0068       INTEGER bi, bj, myIter, myThid
                0069       _RL myTime
                0070 CEOP
                0071
                0072 #ifdef ALLOW_AIM
                0073 #ifdef ALLOW_THSICE
                0074 C     == Local variables ==
                0075 C       J          :: loop counters
                0076       INTEGER J
                0077
                0078 C--   Physics tendency term
                0079
                0080       IF ( useThSIce ) THEN
                0081
                0082        DO J=1,NGP
                0083 C-    total surface downward heat flux :
65d8b97200 Jean*0084
cdcb187d4c Jean*0085 C-    initialize temp. changes and fresh water flux :
                0086          dTsurf(J) = 0.
                0087        ENDDO
                0088
                0089        CALL THSICE_IMPL_TEMP(
                0090      I               netSW, sFlx,
                0091      O               dTsurf,
                0092      I               bi, bj, myTime, myIter, myThid)
                0093
                0094 C-     Update Surf.Temp., Evap, Upward SW according to surf. temp. changes
                0095        DO J=1,NGP
                0096         IF ( dTsurf(J) .GT. 999. ) THEN
e749d70ece Jean*0097          dTsurf(J)= tFreeze - Tsurf(J)
cdcb187d4c Jean*0098          Tsurf(J) = tFreeze
e749d70ece Jean*0099          SHF (J)  = Shf0(J)
cdcb187d4c Jean*0100          EVAP(J)  = Evp0(J)
                0101          SLRU(J)  = Slr0(J)
                0102         ELSE
                0103          Tsurf(J) = Tsurf(J)+ dTsurf(J)
e749d70ece Jean*0104          SHF (J)  = SHF (J) + dTsurf(J)*dShf(J)
cdcb187d4c Jean*0105          EVAP(J)  = EVAP(J) + dTsurf(J)*dEvp(J)
                0106          SLRU(J)  = SLRU(J) + dTsurf(J)*dSlr(J)
                0107         ENDIF
                0108        ENDDO
                0109
                0110       ENDIF
                0111
                0112 #endif /* ALLOW_THSICE */
                0113 #endif /* ALLOW_AIM */
                0114
                0115       RETURN
                0116       END