pkg/thsice/thsice_impl_temp.F

C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_impl_temp.F,v 1.4 2006/05/25 18:03:24 jmc Exp $
C $Name:  $

#include "THSICE_OPTIONS.h"

C     !ROUTINE: THSICE_IMPL_TEMP
C     !INTERFACE:
      SUBROUTINE THSICE_IMPL_TEMP(
     I                netSW, sFlx,
     O                dTsurf,
     I                bi, bj, myTime, myIter, myThid)
C     *==========================================================*
C     | S/R  THSICE_IMPL_TEMP
C     | o Calculate sea-ice and surface temp. implicitly
C     *==========================================================*
C     | o return surface fluxes for atmosphere boundary layer
C     |  physics (and therefore called within atmospheric physics)
C     *==========================================================*

C     !USES:
      IMPLICIT NONE
C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "FFIELDS.h"
#include "THSICE_SIZE.h"
#include "THSICE_PARAMS.h"
#include "THSICE_VARS.h"
      INTEGER siLo, siHi, sjLo, sjHi
      PARAMETER ( siLo = 1-OLx , siHi = sNx+OLx )
      PARAMETER ( sjLo = 1-OLy , sjHi = sNy+OLy )

C     !INPUT/OUTPUT PARAMETERS:
C     === Routine arguments ===
C     netSW   :: net Short Wave surf. flux (+=down) [W/m2]
C     sFlx    :: surf. heat flux (+=down) except SW, function of surf. temp Ts:
C                0: Flx(Ts=0) ; 1: Flx(Ts=Ts^n) ; 2: d.Flx/dTs(Ts=Ts^n)
C     dTsurf  :: surf. temp adjusment: Ts^n+1 - Ts^n
C     bi,bj   :: Tile index
C     myIter  :: iteration counter for this thread
C     myTime  :: time counter for this thread
C     myThid  :: thread number for this instance of the routine.
      _RL netSW  (sNx,sNy)
      _RL sFlx   (sNx,sNy,0:2)
      _RL dTsurf (sNx,sNy)
      INTEGER bi,bj
      _RL  myTime
      INTEGER myIter
      INTEGER myThid

#ifdef ALLOW_THSICE
C     !LOCAL VARIABLES:
C     === Local variables ===
C     tFrzOce  :: sea-water freezing temperature [oC] (function of S)
C     dTsrf    :: surf. temp adjusment: Ts^n+1 - Ts^n
      INTEGER i,j
      INTEGER iMin, iMax
      INTEGER jMin, jMax
      _RL tFrzOce(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
c     _RL dTsrf  (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      LOGICAL dBugFlag

C-    define grid-point location where to print debugging values
#include "THSICE_DEBUG.h"

 1010 FORMAT(A,1P4E14.6)

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      iMin = 1
      iMax = sNx
      jMin = 1
      jMax = sNy
      dBugFlag = debugLevel.GE.debLevB

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C    part.1 : ice-covered fraction ;
C     Solve for surface and ice temperature (implicitly) ; compute surf. fluxes
C-------
      DO j = jMin, jMax
       DO i = iMin, iMax
        IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN
          tFrzOce(i,j) = -mu_Tf*sOceMxL(i,j,bi,bj)
          icFlxSW(i,j,bi,bj) = netSW(i,j)
#ifdef ALLOW_DBUG_THSICE
          IF ( dBug(i,j,bi,bj) ) THEN
           WRITE(6,'(A,2I4,2I2)') 'ThSI_IMPL_T: i,j=',i,j,bi,bj
           WRITE(6,1010) 'ThSI_IMPL_T:-0- iceMask,hIc,hSn,Tsf=',
     &                   iceMask(i,j,bi,bj), iceHeight(i,j,bi,bj),
     &                   snowHeight(i,j,bi,bj), Tsrf(i,j,bi,bj)
           WRITE(6,1010) 'ThSI_IMPL_T:-0- Tice(1,2),Qice(1,2)=',
     &           Tice1(i,j,bi,bj), Tice2(i,j,bi,bj),
     &           Qice1(i,j,bi,bj), Qice2(i,j,bi,bj)
          ENDIF
#endif
        ENDIF
       ENDDO
      ENDDO

      CALL THSICE_SOLVE4TEMP(
     I          bi, bj, siLo, siHi, sjLo, sjHi,
     I          iMin,iMax, jMin,jMax, dBugFlag, .FALSE.,.FALSE.,
     I          iceMask(siLo,sjLo,bi,bj), iceHeight(siLo,sjLo,bi,bj),
     I          snowHeight(siLo,sjLo,bi,bj), tFrzOce, sFlx,
     U          icFlxSW(siLo,sjLo,bi,bj), Tsrf(siLo,sjLo,bi,bj),
     U          Qice1(siLo,sjLo,bi,bj), Qice2(siLo,sjLo,bi,bj),
     O          Tice1(siLo,sjLo,bi,bj), Tice2(siLo,sjLo,bi,bj), dTsurf,
     O          sHeating(siLo,sjLo,bi,bj), flxCndBt(siLo,sjLo,bi,bj),
     O          icFlxAtm(siLo,sjLo,bi,bj), icFrwAtm(siLo,sjLo,bi,bj),
     I          myTime, myIter, myThid )

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
#endif /* ALLOW_THSICE */

      RETURN
      END
1	C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_impl_temp.F,v 1.4 2006/05/25 18:03:24 jmc Exp $
2	C $Name: $
3
4	#include "THSICE_OPTIONS.h"
5
6	C !ROUTINE: THSICE_IMPL_TEMP
7	C !INTERFACE:
8	SUBROUTINE THSICE_IMPL_TEMP(
9	I netSW, sFlx,
10	O dTsurf,
11	I bi, bj, myTime, myIter, myThid)
12	C ==========================================================
13	C \| S/R THSICE_IMPL_TEMP
14	C \| o Calculate sea-ice and surface temp. implicitly
15	C ==========================================================
16	C \| o return surface fluxes for atmosphere boundary layer
17	C \| physics (and therefore called within atmospheric physics)
18	C ==========================================================
19
20	C !USES:
21	IMPLICIT NONE
22	C === Global variables ===
23	#include "SIZE.h"
24	#include "EEPARAMS.h"
25	#include "PARAMS.h"
26	#include "FFIELDS.h"
27	#include "THSICE_SIZE.h"
28	#include "THSICE_PARAMS.h"
29	#include "THSICE_VARS.h"
30	INTEGER siLo, siHi, sjLo, sjHi
31	PARAMETER ( siLo = 1-OLx , siHi = sNx+OLx )
32	PARAMETER ( sjLo = 1-OLy , sjHi = sNy+OLy )
33
34	C !INPUT/OUTPUT PARAMETERS:
35	C === Routine arguments ===
36	C netSW :: net Short Wave surf. flux (+=down) [W/m2]
37	C sFlx :: surf. heat flux (+=down) except SW, function of surf. temp Ts:
38	C 0: Flx(Ts=0) ; 1: Flx(Ts=Ts^n) ; 2: d.Flx/dTs(Ts=Ts^n)
39	C dTsurf :: surf. temp adjusment: Ts^n+1 - Ts^n
40	C bi,bj :: Tile index
41	C myIter :: iteration counter for this thread
42	C myTime :: time counter for this thread
43	C myThid :: thread number for this instance of the routine.
44	_RL netSW (sNx,sNy)
45	_RL sFlx (sNx,sNy,0:2)
46	_RL dTsurf (sNx,sNy)
47	INTEGER bi,bj
48	_RL myTime
49	INTEGER myIter
50	INTEGER myThid
51
52	#ifdef ALLOW_THSICE
53	C !LOCAL VARIABLES:
54	C === Local variables ===
55	C tFrzOce :: sea-water freezing temperature [oC] (function of S)
56	C dTsrf :: surf. temp adjusment: Ts^n+1 - Ts^n
57	INTEGER i,j
58	INTEGER iMin, iMax
59	INTEGER jMin, jMax
60	_RL tFrzOce(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
61	c _RL dTsrf (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
62	LOGICAL dBugFlag
63
64	C- define grid-point location where to print debugging values
65	#include "THSICE_DEBUG.h"
66
67	1010 FORMAT(A,1P4E14.6)
68
69	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
70
71	iMin = 1
72	iMax = sNx
73	jMin = 1
74	jMax = sNy
75	dBugFlag = debugLevel.GE.debLevB
76
77	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
78	C part.1 : ice-covered fraction ;
79	C Solve for surface and ice temperature (implicitly) ; compute surf. fluxes
80	C-------
81	DO j = jMin, jMax
82	DO i = iMin, iMax
83	IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN
84	tFrzOce(i,j) = -mu_Tf*sOceMxL(i,j,bi,bj)
85	icFlxSW(i,j,bi,bj) = netSW(i,j)
86	#ifdef ALLOW_DBUG_THSICE
87	IF ( dBug(i,j,bi,bj) ) THEN
88	WRITE(6,'(A,2I4,2I2)') 'ThSI_IMPL_T: i,j=',i,j,bi,bj
89	WRITE(6,1010) 'ThSI_IMPL_T:-0- iceMask,hIc,hSn,Tsf=',
90	& iceMask(i,j,bi,bj), iceHeight(i,j,bi,bj),
91	& snowHeight(i,j,bi,bj), Tsrf(i,j,bi,bj)
92	WRITE(6,1010) 'ThSI_IMPL_T:-0- Tice(1,2),Qice(1,2)=',
93	& Tice1(i,j,bi,bj), Tice2(i,j,bi,bj),
94	& Qice1(i,j,bi,bj), Qice2(i,j,bi,bj)
95	ENDIF
96	#endif
97	ENDIF
98	ENDDO
99	ENDDO
100
101	CALL THSICE_SOLVE4TEMP(
102	I bi, bj, siLo, siHi, sjLo, sjHi,
103	I iMin,iMax, jMin,jMax, dBugFlag, .FALSE.,.FALSE.,
104	I iceMask(siLo,sjLo,bi,bj), iceHeight(siLo,sjLo,bi,bj),
105	I snowHeight(siLo,sjLo,bi,bj), tFrzOce, sFlx,
106	U icFlxSW(siLo,sjLo,bi,bj), Tsrf(siLo,sjLo,bi,bj),
107	U Qice1(siLo,sjLo,bi,bj), Qice2(siLo,sjLo,bi,bj),
108	O Tice1(siLo,sjLo,bi,bj), Tice2(siLo,sjLo,bi,bj), dTsurf,
109	O sHeating(siLo,sjLo,bi,bj), flxCndBt(siLo,sjLo,bi,bj),
110	O icFlxAtm(siLo,sjLo,bi,bj), icFrwAtm(siLo,sjLo,bi,bj),
111	I myTime, myIter, myThid )
112
113	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
114	#endif /* ALLOW_THSICE */
115
116	RETURN
117	END