pkg/thsice/thsice_impl_temp.F

87ea84cac6 Jean*0001 #include "THSICE_OPTIONS.h"
17fd302697 Jean*0002
87ea84cac6 Jean*0003 C     !ROUTINE: THSICE_IMPL_TEMP
                0004 C     !INTERFACE:
17fd302697 Jean*0005       SUBROUTINE THSICE_IMPL_TEMP(
87ea84cac6 Jean*0006      I                netSW, sFlx,
                0007      O                dTsurf,
                0008      I                bi, bj, myTime, myIter, myThid)
                0009 C     *==========================================================*
17fd302697 Jean*0010 C     | S/R  THSICE_IMPL_TEMP
87ea84cac6 Jean*0011 C     | o Calculate sea-ice and surface temp. implicitly
                0012 C     *==========================================================*
17fd302697 Jean*0013 C     | o return surface fluxes for atmosphere boundary layer
87ea84cac6 Jean*0014 C     |  physics (and therefore called within atmospheric physics)
                0015 C     *==========================================================*
                0016
                0017 C     !USES:
                0018       IMPLICIT NONE
                0019 C     === Global variables ===
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
                0023 #include "FFIELDS.h"
                0024 #include "THSICE_SIZE.h"
                0025 #include "THSICE_PARAMS.h"
                0026 #include "THSICE_VARS.h"
7269783f6f Jean*0027       INTEGER siLo, siHi, sjLo, sjHi
                0028       PARAMETER ( siLo = 1-OLx , siHi = sNx+OLx )
                0029       PARAMETER ( sjLo = 1-OLy , sjHi = sNy+OLy )
17fd302697 Jean*0030
87ea84cac6 Jean*0031 C     !INPUT/OUTPUT PARAMETERS:
                0032 C     === Routine arguments ===
                0033 C     netSW   :: net Short Wave surf. flux (+=down) [W/m2]
                0034 C     sFlx    :: surf. heat flux (+=down) except SW, function of surf. temp Ts:
                0035 C                0: Flx(Ts=0) ; 1: Flx(Ts=Ts^n) ; 2: d.Flx/dTs(Ts=Ts^n)
                0036 C     dTsurf  :: surf. temp adjusment: Ts^n+1 - Ts^n
                0037 C     bi,bj   :: Tile index
                0038 C     myIter  :: iteration counter for this thread
                0039 C     myTime  :: time counter for this thread
                0040 C     myThid  :: thread number for this instance of the routine.
                0041       _RL netSW  (sNx,sNy)
                0042       _RL sFlx   (sNx,sNy,0:2)
                0043       _RL dTsurf (sNx,sNy)
                0044       INTEGER bi,bj
                0045       _RL  myTime
                0046       INTEGER myIter
                0047       INTEGER myThid
                0048
                0049 #ifdef ALLOW_THSICE
                0050 C     !LOCAL VARIABLES:
                0051 C     === Local variables ===
7269783f6f Jean*0052 C     tFrzOce  :: sea-water freezing temperature [oC] (function of S)
                0053 C     dTsrf    :: surf. temp adjusment: Ts^n+1 - Ts^n
87ea84cac6 Jean*0054       INTEGER i,j
                0055       INTEGER iMin, iMax
                0056       INTEGER jMin, jMax
7269783f6f Jean*0057       _RL tFrzOce(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0058 c     _RL dTsrf  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
                0059       LOGICAL dBugFlag
                0060
                0061 C-    define grid-point location where to print debugging values
                0062 #include "THSICE_DEBUG.h"
                0063
                0064  1010 FORMAT(A,1P4E14.6)
87ea84cac6 Jean*0065
7269783f6f Jean*0066 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
87ea84cac6 Jean*0067
                0068       iMin = 1
                0069       iMax = sNx
                0070       jMin = 1
                0071       jMax = sNy
ae605e558b Jean*0072       dBugFlag = debugLevel.GE.debLevC
87ea84cac6 Jean*0073
                0074 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
17fd302697 Jean*0075 C    part.1 : ice-covered fraction ;
87ea84cac6 Jean*0076 C     Solve for surface and ice temperature (implicitly) ; compute surf. fluxes
                0077 C-------
7269783f6f Jean*0078       DO j = jMin, jMax
                0079        DO i = iMin, iMax
9a4730443c Jean*0080         icFlxSW(i,j,bi,bj) = netSW(i,j)
17fd302697 Jean*0081         IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN
7269783f6f Jean*0082           tFrzOce(i,j) = -mu_Tf*sOceMxL(i,j,bi,bj)
                0083 #ifdef ALLOW_DBUG_THSICE
                0084           IF ( dBug(i,j,bi,bj) ) THEN
46a14d8906 Jean*0085            WRITE(6,'(A,2I4,2I2)') 'ThSI_IMPL_T: i,j=',i,j,bi,bj
                0086            WRITE(6,1010) 'ThSI_IMPL_T:-0- iceMask,hIc,hSn,Tsf=',
7269783f6f Jean*0087      &                   iceMask(i,j,bi,bj), iceHeight(i,j,bi,bj),
                0088      &                   snowHeight(i,j,bi,bj), Tsrf(i,j,bi,bj)
17fd302697 Jean*0089            WRITE(6,1010) 'ThSI_IMPL_T:-0- Tice(1,2),Qice(1,2)=',
7269783f6f Jean*0090      &           Tice1(i,j,bi,bj), Tice2(i,j,bi,bj),
                0091      &           Qice1(i,j,bi,bj), Qice2(i,j,bi,bj)
46a14d8906 Jean*0092           ENDIF
7269783f6f Jean*0093 #endif
87ea84cac6 Jean*0094         ENDIF
                0095        ENDDO
                0096       ENDDO
                0097
7269783f6f Jean*0098       CALL THSICE_SOLVE4TEMP(
6dc8890c80 Patr*0099      I          bi, bj,
2a9474d935 Mart*0100      I          iMin,iMax, jMin,jMax, dBugFlag, .FALSE.,.FALSE.,
7269783f6f Jean*0101      I          iceMask(siLo,sjLo,bi,bj), iceHeight(siLo,sjLo,bi,bj),
                0102      I          snowHeight(siLo,sjLo,bi,bj), tFrzOce, sFlx,
                0103      U          icFlxSW(siLo,sjLo,bi,bj), Tsrf(siLo,sjLo,bi,bj),
                0104      U          Qice1(siLo,sjLo,bi,bj), Qice2(siLo,sjLo,bi,bj),
                0105      O          Tice1(siLo,sjLo,bi,bj), Tice2(siLo,sjLo,bi,bj), dTsurf,
                0106      O          sHeating(siLo,sjLo,bi,bj), flxCndBt(siLo,sjLo,bi,bj),
                0107      O          icFlxAtm(siLo,sjLo,bi,bj), icFrwAtm(siLo,sjLo,bi,bj),
                0108      I          myTime, myIter, myThid )
                0109
87ea84cac6 Jean*0110 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0111 #endif /* ALLOW_THSICE */
                0112
                0113       RETURN
                0114       END