/[MITgcm]/MITgcm/pkg/thsice/thsice_impl_temp.F
ViewVC logotype

Contents of /MITgcm/pkg/thsice/thsice_impl_temp.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.6 - (show annotations) (download)
Fri Jun 2 02:01:02 2006 UTC (17 years, 11 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58l_post, mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint60, checkpoint61, checkpoint62, checkpoint58r_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58h_post, checkpoint58q_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint58j_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint59, checkpoint58f_post, checkpoint58i_post, checkpoint58g_post, checkpoint58o_post, checkpoint62c, checkpoint62b, checkpoint62a, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62l, checkpoint58y_post, checkpoint58k_post, checkpoint58v_post, checkpoint58s_post, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint58p_post, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q, checkpoint61z, checkpoint61x, checkpoint61y, checkpoint58m_post
Changes since 1.5: +2 -2 lines
fill icFlxSW over the whole domain (ice-covered & ice-free).

1 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_impl_temp.F,v 1.5 2006/05/30 22:49:00 mlosch 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 icFlxSW(i,j,bi,bj) = netSW(i,j)
84 IF (iceMask(i,j,bi,bj).GT.0. _d 0) THEN
85 tFrzOce(i,j) = -mu_Tf*sOceMxL(i,j,bi,bj)
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

  ViewVC Help
Powered by ViewVC 1.1.22