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

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

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


Revision 1.9 - (show annotations) (download)
Tue May 30 22:49:00 2006 UTC (18 years ago) by mlosch
Branch: MAIN
CVS Tags: checkpoint58f_post
Changes since 1.8: +10 -1 lines
o couple pkg/thsice and pkg/exf (as a preparation for coupling pkg/thsice
  to pkg/seaice):
  - new routines thsice_map_exf and thsice_get_exf provide the interface
  - add an additional formal parameter to thsice_solve4temp

1 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_main.F,v 1.8 2006/05/25 18:03:24 jmc Exp $
2 C $Name: $
3
4 #include "THSICE_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: THSICE_MAIN
8 C !INTERFACE:
9 SUBROUTINE THSICE_MAIN(
10 I myTime, myIter, myThid )
11 C !DESCRIPTION: \bv
12 C *==========================================================*
13 C | S/R THSICE_MAIN
14 C | o Therm_SeaIce main routine.
15 C | step forward Thermodynamic_SeaIce variables and modify
16 C | ocean surface forcing accordingly.
17 C *==========================================================*
18
19 C !USES:
20 IMPLICIT NONE
21
22 C === Global variables ===
23 #include "SIZE.h"
24 #include "EEPARAMS.h"
25 #include "PARAMS.h"
26 #include "GRID.h"
27 #include "SURFACE.h"
28 #include "DYNVARS.h"
29 #include "FFIELDS.h"
30 #include "THSICE_PARAMS.h"
31 #include "THSICE_VARS.h"
32 #ifdef ALLOW_AUTODIFF_TAMC
33 # include "tamc.h"
34 # include "tamc_keys.h"
35 #endif
36
37 C !INPUT/OUTPUT PARAMETERS:
38 C === Routine arguments ===
39 C myIter :: iteration counter for this thread
40 C myTime :: time counter for this thread
41 C myThid :: thread number for this instance of the routine.
42 _RL myTime
43 INTEGER myIter
44 INTEGER myThid
45 CEOP
46
47 #ifdef ALLOW_THSICE
48 C !LOCAL VARIABLES:
49 C === Local variables ===
50 INTEGER i,j
51 INTEGER bi,bj
52 INTEGER iMin, iMax
53 INTEGER jMin, jMax
54 _RL prcAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
55 c _RL evpAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
56 c _RL flxAtm(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
57 c _RL flxSW (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
58
59 _RL tauFac
60
61 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
62
63 IF ( stressReduction.GT. 0. _d 0 ) THEN
64 C- needs new Ice Fraction in halo region to apply wind-stress reduction
65 iMin = 1-OLx
66 iMax = sNx+OLx-1
67 jMin = 1-OLy
68 jMax = sNy+OLy-1
69 #ifdef ATMOSPHERIC_LOADING
70 ELSEIF ( useRealFreshWaterFlux ) THEN
71 C- needs sea-ice loading in part of the halo regions for grad.Phi0surf
72 C to be valid at the boundaries ( d/dx 1:sNx+1 ; d/dy 1:sNy+1 )
73 iMin = 0
74 iMax = sNx+1
75 jMin = 0
76 jMax = sNy+1
77 #endif /* ATMOSPHERIC_LOADING */
78 ELSE
79 iMin = 1
80 iMax = sNx
81 jMin = 1
82 jMax = sNy
83 ENDIF
84
85 DO bj=myByLo(myThid),myByHi(myThid)
86 DO bi=myBxLo(myThid),myBxHi(myThid)
87
88 #ifdef ALLOW_AUTODIFF_TAMC
89 act1 = bi - myBxLo(myThid)
90 max1 = myBxHi(myThid) - myBxLo(myThid) + 1
91 act2 = bj - myByLo(myThid)
92 max2 = myByHi(myThid) - myByLo(myThid) + 1
93 act3 = myThid - 1
94 max3 = nTx*nTy
95 act4 = ikey_dynamics - 1
96 iicekey = (act1 + 1) + act2*max1
97 & + act3*max1*max2
98 & + act4*max1*max2*max3
99 #endif /* ALLOW_AUTODIFF_TAMC */
100
101 C-- Mixed layer thickness: take the 1rst layer
102 #ifdef NONLIN_FRSURF
103 IF ( staggerTimeStep .AND. nonlinFreeSurf.GT.0 ) THEN
104 IF ( select_rStar.GT.0 ) THEN
105 DO j = jMin, jMax
106 DO i = iMin, iMax
107 hOceMxL(i,j,bi,bj) = drF(1)*h0FacC(i,j,1,bi,bj)
108 & *rStarFacC(i,j,bi,bj)
109 ENDDO
110 ENDDO
111 ELSE
112 DO j = jMin, jMax
113 DO i = iMin, iMax
114 IF ( ksurfC(i,j,bi,bj).EQ.1 ) THEN
115 hOceMxL(i,j,bi,bj) = drF(1)*hFac_surfC(i,j,bi,bj)
116 ELSE
117 hOceMxL(i,j,bi,bj) = drF(1)*hfacC(i,j,1,bi,bj)
118 ENDIF
119 ENDDO
120 ENDDO
121 ENDIF
122 ELSE
123 #else /* ndef NONLIN_FRSURF */
124 IF (.TRUE.) THEN
125 #endif /* NONLIN_FRSURF */
126 DO j = jMin, jMax
127 DO i = iMin, iMax
128 hOceMxL(i,j,bi,bj) = drF(1)*hfacC(i,j,1,bi,bj)
129 ENDDO
130 ENDDO
131 ENDIF
132
133 #ifdef ALLOW_AUTODIFF_TAMC
134 CADJ STORE uvel (:,:,1,bi,bj) = comlev1_bibj, key=iicekey, byte=isbyte
135 CADJ STORE vvel (:,:,1,bi,bj) = comlev1_bibj, key=iicekey, byte=isbyte
136 #endif
137
138 DO j = jMin, jMax
139 DO i = iMin, iMax
140 tOceMxL(i,j,bi,bj) = theta(i,j,1,bi,bj)
141 sOceMxL(i,j,bi,bj) = salt (i,j,1,bi,bj)
142 v2ocMxL(i,j,bi,bj) =
143 & ( uvel(i,j,1,bi,bj)*uvel(i,j,1,bi,bj)
144 & + uvel(i+1,j,1,bi,bj)*uvel(i+1,j,1,bi,bj)
145 & + vvel(i,j+1,1,bi,bj)*vvel(i,j+1,1,bi,bj)
146 & + vvel(i,j,1,bi,bj)*vvel(i,j,1,bi,bj)
147 & )*0.5 _d 0
148 prcAtm(i,j) = 0.
149 icFrwAtm(i,j,bi,bj) = 0. _d 0
150 icFlxAtm(i,j,bi,bj) = 0. _d 0
151 icFlxSW (i,j,bi,bj) = 0. _d 0
152 snowPrc(i,j,bi,bj) = 0. _d 0
153 siceAlb(i,j,bi,bj) = 0. _d 0
154 ENDDO
155 ENDDO
156
157 #ifdef ALLOW_AUTODIFF_TAMC
158 CADJ STORE iceMask = comlev1, key = iicekey
159 CADJ STORE iceHeight = comlev1, key = iicekey
160 CADJ STORE snowHeight = comlev1, key = iicekey
161 CADJ STORE Tsrf = comlev1, key = iicekey
162 CADJ STORE Qice1 = comlev1, key = iicekey
163 CADJ STORE Qice2 = comlev1, key = iicekey
164 CADJ STORE snowAge = comlev1, key = iicekey
165
166 CADJ STORE sHeating = comlev1, key = iicekey
167 CADJ STORE flxCndBt = comlev1, key = iicekey
168 CADJ STORE snowPrc = comlev1, key = iicekey
169
170 CADJ STORE hOceMxL = comlev1, key = iicekey
171 CADJ STORE tOceMxL = comlev1, key = iicekey
172 CADJ STORE sOceMxL = comlev1, key = iicekey
173 CADJ STORE v2ocMxL = comlev1, key = iicekey
174
175 CADJ STORE empmr = comlev1, key = iicekey
176 CADJ STORE qnet = comlev1, key = iicekey
177 #endif
178
179 #ifdef ALLOW_BULK_FORCE
180 IF ( useBulkforce ) THEN
181 CALL THSICE_GET_PRECIP(
182 I iceMask,
183 O prcAtm, snowPrc(1-OLx,1-OLy,bi,bj),
184 O icFlxSW(1-OLx,1-OLy,bi,bj),
185 I iMin,iMax,jMin,jMax, bi,bj, myThid )
186 ENDIF
187 #endif
188 #ifdef ALLOW_EXF
189 IF ( useEXF ) THEN
190 CALL THSICE_MAP_EXF(
191 I iceMask,
192 O prcAtm, snowPrc(1-OLx,1-OLy,bi,bj),
193 O icFlxSW(1-OLx,1-OLy,bi,bj),
194 I iMin,iMax,jMin,jMax, bi,bj, myThid )
195 ENDIF
196 #endif
197
198
199 CALL THSICE_STEP_TEMP(
200 I bi, bj, iMin, iMax, jMin, jMax,
201 I myTime, myIter, myThid )
202
203 CALL THSICE_STEP_FWD(
204 I bi, bj, iMin, iMax, jMin, jMax,
205 I prcAtm,
206 I myTime, myIter, myThid )
207
208 CALL THSICE_AVE(
209 I bi,bj, myTime, myIter, myThid )
210
211 c ENDDO
212 c ENDDO
213
214 c IF ( .FALSE. ) THEN
215 #ifdef ALLOW_AUTODIFF_TAMC
216 CADJ STORE fu(:,:,bi,bj) = comlev1_bibj, key=iicekey, byte=isbyte
217 CADJ STORE fv(:,:,bi,bj) = comlev1_bibj, key=iicekey, byte=isbyte
218 #endif
219 IF ( stressReduction.GT. 0. _d 0 ) THEN
220 DO j = jMin, jMax
221 DO i = iMin+1,iMax
222 tauFac = stressReduction
223 & *(iceMask(i-1,j,bi,bj)+iceMask(i,j,bi,bj))*0.5 _d 0
224 fu(i,j,bi,bj) = (1. _d 0 - tauFac)*fu(i,j,bi,bj)
225 ENDDO
226 ENDDO
227 DO j = jMin+1, jMax
228 DO i = iMin, iMax
229 tauFac = stressReduction
230 & *(iceMask(i,j-1,bi,bj)+iceMask(i,j,bi,bj))*0.5 _d 0
231 fv(i,j,bi,bj) = (1. _d 0 - tauFac)*fv(i,j,bi,bj)
232 ENDDO
233 ENDDO
234 ENDIF
235
236 C-- end bi,bj loop
237 ENDDO
238 ENDDO
239
240 #ifdef ATMOSPHERIC_LOADING
241 c IF (useRealFreshWaterFlux) _EXCH_XY_RS(sIceLoad, myThid)
242 #endif
243
244 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
245 #endif /*ALLOW_THSICE*/
246
247 RETURN
248 END

  ViewVC Help
Powered by ViewVC 1.1.22