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

Annotation of /MITgcm/pkg/thsice/thsice_advection.F

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


Revision 1.12 - (hide annotations) (download)
Tue Oct 26 22:26:59 2010 UTC (13 years, 7 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint62o, checkpoint62n
Changes since 1.11: +3 -1 lines
Some small changes to avoid "potential conflict" warning.
Works ok on weddell under MPI with nPx=6

1 heimbach 1.12 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_advection.F,v 1.11 2009/06/28 01:05:41 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "THSICE_OPTIONS.h"
5     #ifdef ALLOW_GENERIC_ADVDIFF
6     # include "GAD_OPTIONS.h"
7     #endif
8    
9     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
10     CBOP
11     C !ROUTINE: THSICE_ADVECTION
12    
13     C !INTERFACE: ==========================================================
14     SUBROUTINE THSICE_ADVECTION(
15     I tracerIdentity,
16     I advectionScheme,
17     I useGridVolume,
18     I uTrans, vTrans, maskOc, deltaTadvect, iceEps,
19     U iceVol, iceFld,
20     O afx, afy,
21     I bi, bj, myTime, myIter, myThid)
22    
23     C !DESCRIPTION:
24     C Calculates the tendency of a sea-ice field due to advection.
25     C It uses the multi-dimensional method given in \ref{sect:multiDimAdvection}
26     C and can only be used for the non-linear advection schemes such as the
27     C direct-space-time method and flux-limiters.
28     C
29     C This routine is an adaption of the GAD_ADVECTION for 2D-fields.
30     C for Area, effective thickness or other "extensive" sea-ice field,
31     C the contribution iceFld*div(u) (that is present in gad_advection)
32     C is not included here.
33     C
34     C The algorithm is as follows:
35     C \begin{itemize}
36     C \item{$\theta^{(n+1/2)} = \theta^{(n)}
37     C - \Delta t \partial_x (u\theta^{(n)}) + \theta^{(n)} \partial_x u$}
38     C \item{$\theta^{(n+2/2)} = \theta^{(n+1/2)}
39     C - \Delta t \partial_y (v\theta^{(n+1/2)}) + \theta^{(n)} \partial_y v$}
40     C \item{$G_\theta = ( \theta^{(n+2/2)} - \theta^{(n)} )/\Delta t$}
41     C \end{itemize}
42     C
43     C The tendency (output) is over-written by this routine.
44    
45     C !USES: ===============================================================
46     IMPLICIT NONE
47     #include "SIZE.h"
48     #include "EEPARAMS.h"
49     #include "PARAMS.h"
50     #include "GRID.h"
51     #include "THSICE_SIZE.h"
52     #ifdef ALLOW_GENERIC_ADVDIFF
53     # include "GAD.h"
54     #endif
55     #ifdef ALLOW_EXCH2
56 jmc 1.9 #include "W2_EXCH2_SIZE.h"
57 jmc 1.1 #include "W2_EXCH2_TOPOLOGY.h"
58     #endif /* ALLOW_EXCH2 */
59 heimbach 1.4 #ifdef ALLOW_AUTODIFF_TAMC
60     # include "THSICE_PARAMS.h"
61     # include "tamc.h"
62     # include "tamc_keys.h"
63     #endif
64 jmc 1.1
65     C !INPUT PARAMETERS: ===================================================
66     C tracerIdentity :: tracer identifier (required only for OBCS)
67     C advectionScheme :: advection scheme to use (Horizontal plane)
68     C useGridVolume :: use grid-cell Area & Volume (instead of "iceVol" field)
69     C uTrans,vTrans :: volume transports at U,V points
70     C maskOc :: oceanic mask
71     C iceVol :: sea-ice volume
72     C iceFld :: sea-ice field
73     C deltaTadvect :: time-step used for advection [s]
74     C iceEps :: small volume (to avoid division by zero if iceVol==0)
75     C bi,bj :: tile indices
76     C myTime :: current time in simulation [s]
77     C myIter :: current iteration number
78     C myThid :: my thread Id. number
79     INTEGER tracerIdentity
80     INTEGER advectionScheme
81     LOGICAL useGridVolume
82     _RL uTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
83     _RL vTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
84     _RS maskOc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
85     _RL iceFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
86     _RL iceVol(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
87     _RL deltaTadvect, iceEps
88     INTEGER bi,bj
89     _RL myTime
90     INTEGER myIter
91     INTEGER myThid
92    
93     C !OUTPUT PARAMETERS: ==================================================
94     C iceVol (Updated):: sea-ice volume
95     C iceFld (Updated):: sea-ice field
96     C afx :: horizontal advective flux, x direction
97     C afy :: horizontal advective flux, y direction
98     _RL afx (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
99     _RL afy (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
100    
101 jmc 1.2 #ifdef ALLOW_GENERIC_ADVDIFF
102 jmc 1.1 C !LOCAL VARIABLES: ====================================================
103     C maskLocW :: 2-D array for mask at West points
104     C maskLocS :: 2-D array for mask at South points
105     C iMin,iMax, :: loop range for called routines
106     C jMin,jMax :: loop range for called routines
107     C [iMin,iMax]Upd :: loop range to update sea-ice field
108     C [jMin,jMax]Upd :: loop range to update sea-ice field
109     C i,j :: loop indices
110     C uCfl :: CFL number, zonal direction
111     C vCfl :: CFL number, meridional direction
112     C af :: 2-D array for horizontal advective flux
113     C calc_fluxes_X :: logical to indicate to calculate fluxes in X dir
114     C calc_fluxes_Y :: logical to indicate to calculate fluxes in Y dir
115     C interiorOnly :: only update the interior of myTile, but not the edges
116     C overlapOnly :: only update the edges of myTile, but not the interior
117     C nipass :: number of passes in multi-dimensional method
118     C ipass :: number of the current pass being made
119     C myTile :: variables used to determine which cube face
120     C nCFace :: owns a tile for cube grid runs using
121     C :: multi-dim advection.
122     C [N,S,E,W]_edge :: true if N,S,E,W edge of myTile is an Edge of the cube
123     _RS maskLocW(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
124     _RS maskLocS(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
125     INTEGER iMin,iMax,jMin,jMax
126     INTEGER iMinUpd,iMaxUpd,jMinUpd,jMaxUpd
127     INTEGER i,j,k
128     _RL uCfl (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
129     _RL vCfl (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
130     _RL af (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
131     LOGICAL calc_fluxes_X, calc_fluxes_Y, withSigns
132     LOGICAL interiorOnly, overlapOnly
133     INTEGER nipass,ipass
134     INTEGER nCFace
135     LOGICAL N_edge, S_edge, E_edge, W_edge
136     #ifdef ALLOW_EXCH2
137     INTEGER myTile
138     #endif
139 jmc 1.10 LOGICAL dBugFlag
140     INTEGER idb,jdb,biDb
141 jmc 1.1 _RL tmpFac
142     _RL tmpVol
143     CEOP
144    
145 heimbach 1.4 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
146    
147     #ifdef ALLOW_AUTODIFF_TAMC
148     act1 = bi - myBxLo(myThid)
149     max1 = myBxHi(myThid) - myBxLo(myThid) + 1
150     act2 = bj - myByLo(myThid)
151     max2 = myByHi(myThid) - myByLo(myThid) + 1
152     act3 = myThid - 1
153     max3 = nTx*nTy
154     act4 = ikey_dynamics - 1
155     iicekey = (act1 + 1) + act2*max1
156     & + act3*max1*max2
157     & + act4*max1*max2*max3
158     #endif /* ALLOW_AUTODIFF_TAMC */
159    
160 jmc 1.3 k = 1
161 jmc 1.10 dBugFlag = debugLevel.GE.debLevB
162 jmc 1.1 & .AND. myIter.EQ.nIter0
163     & .AND. ( tracerIdentity.EQ.GAD_SI_HICE .OR.
164     & tracerIdentity.EQ.GAD_SI_QICE2 )
165 jmc 1.10 c & .AND. tracerIdentity.EQ.GAD_SI_FRAC
166     idb = MIN(13,sNx)
167     jdb = MOD(17,sNy)
168     biDb = nSx/2
169 jmc 1.1
170     C-- Set up work arrays with valid (i.e. not NaN) values
171     C These inital values do not alter the numerical results. They
172     C just ensure that all memory references are to valid floating
173     C point numbers. This prevents spurious hardware signals due to
174     C uninitialised but inert locations.
175    
176     C-- Set tile-specific parameters for horizontal fluxes
177     IF (useCubedSphereExchange) THEN
178     nipass=3
179     #ifdef ALLOW_EXCH2
180 jmc 1.11 myTile = W2_myTileList(bi,bj)
181 jmc 1.1 nCFace = exch2_myFace(myTile)
182     N_edge = exch2_isNedge(myTile).EQ.1
183     S_edge = exch2_isSedge(myTile).EQ.1
184     E_edge = exch2_isEedge(myTile).EQ.1
185     W_edge = exch2_isWedge(myTile).EQ.1
186     #else
187     nCFace = bi
188     N_edge = .TRUE.
189     S_edge = .TRUE.
190     E_edge = .TRUE.
191     W_edge = .TRUE.
192     #endif
193     ELSE
194     nipass=2
195     nCFace = bi
196     N_edge = .FALSE.
197     S_edge = .FALSE.
198     E_edge = .FALSE.
199     W_edge = .FALSE.
200     ENDIF
201    
202     iMin = 1-OLx
203     iMax = sNx+OLx
204     jMin = 1-OLy
205     jMax = sNy+OLy
206    
207     C-- Start horizontal fluxes
208    
209     C-- set mask West & South
210     DO j=1-OLy,sNy+OLy
211     maskLocW(1-Olx,j) = 0.
212     DO i=2-OLx,sNx+OLx
213     maskLocW(i,j) = MIN( maskOc(i-1,j), maskOc(i,j) )
214     ENDDO
215     ENDDO
216     DO i=1-OLx,sNx+OLx
217     maskLocS(i,1-Oly) = 0.
218     ENDDO
219     DO j=2-OLy,sNy+OLy
220     DO i=1-OLx,sNx+OLx
221     maskLocS(i,j) = MIN( maskOc(i,j-1), maskOc(i,j) )
222     ENDDO
223     ENDDO
224    
225 heimbach 1.4 #ifndef ALLOW_AUTODIFF_TAMC
226 jmc 1.1 IF (useCubedSphereExchange) THEN
227     withSigns = .FALSE.
228     CALL FILL_CS_CORNER_UV_RS(
229     & withSigns, maskLocW,maskLocS, bi,bj, myThid )
230     ENDIF
231 heimbach 1.4 #endif
232 jmc 1.1
233     C-- Multiple passes for different directions on different tiles
234     C-- For cube need one pass for each of red, green and blue axes.
235     DO ipass=1,nipass
236 heimbach 1.4 #ifdef ALLOW_AUTODIFF_TAMC
237     ikey_4 = ipass
238     & + nipass*act1
239     & + nipass*max1*act2
240     & + nipass*max1*max2*act3
241     & + nipass*max1*max2*max3*act4
242     #endif
243    
244     #ifdef ALLOW_AUTODIFF_TAMC
245     CADJ STORE iceFld(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
246     CADJ STORE iceVol(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
247     CADJ STORE af(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
248     #endif
249 jmc 1.1
250     interiorOnly = .FALSE.
251     overlapOnly = .FALSE.
252     IF (useCubedSphereExchange) THEN
253     C-- CubedSphere : pass 3 times, with partial update of local seaice field
254     IF (ipass.EQ.1) THEN
255     overlapOnly = MOD(nCFace,3).EQ.0
256     interiorOnly = MOD(nCFace,3).NE.0
257     calc_fluxes_X = nCFace.EQ.6 .OR. nCFace.EQ.1 .OR. nCFace.EQ.2
258     calc_fluxes_Y = nCFace.EQ.3 .OR. nCFace.EQ.4 .OR. nCFace.EQ.5
259     ELSEIF (ipass.EQ.2) THEN
260     overlapOnly = MOD(nCFace,3).EQ.2
261 jmc 1.7 interiorOnly = MOD(nCFace,3).EQ.1
262 jmc 1.1 calc_fluxes_X = nCFace.EQ.2 .OR. nCFace.EQ.3 .OR. nCFace.EQ.4
263     calc_fluxes_Y = nCFace.EQ.5 .OR. nCFace.EQ.6 .OR. nCFace.EQ.1
264     ELSE
265 jmc 1.7 interiorOnly = .TRUE.
266 jmc 1.1 calc_fluxes_X = nCFace.EQ.5 .OR. nCFace.EQ.6
267     calc_fluxes_Y = nCFace.EQ.2 .OR. nCFace.EQ.3
268     ENDIF
269     ELSE
270     C-- not CubedSphere
271     calc_fluxes_X = MOD(ipass,2).EQ.1
272     calc_fluxes_Y = .NOT.calc_fluxes_X
273     ENDIF
274 jmc 1.10 IF (dBugFlag.AND.bi.EQ.biDb ) WRITE(6,'(A,3I4,2I5,4L5)')
275     & 'ICE_adv:', tracerIdentity, ipass, bi, idb, jdb,
276     & calc_fluxes_X, calc_fluxes_Y, overlapOnly, interiorOnly
277 jmc 1.1
278     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
279     C-- X direction
280    
281     IF (calc_fluxes_X) THEN
282    
283     C- Do not compute fluxes if
284     C a) needed in overlap only
285     C and b) the overlap of myTile are not cube-face Edges
286 heimbach 1.4 #ifdef ALLOW_AUTODIFF_TAMC
287     CADJ STORE iceFld(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
288     CADJ STORE iceVol(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
289 heimbach 1.12 CADJ STORE af(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
290 heimbach 1.4 #endif
291 jmc 1.1 IF ( .NOT.overlapOnly .OR. N_edge .OR. S_edge ) THEN
292    
293     C- Advective flux in X
294     DO j=1-Oly,sNy+Oly
295     DO i=1-Olx,sNx+Olx
296     af(i,j) = 0.
297     ENDDO
298     ENDDO
299    
300 heimbach 1.4 #ifndef ALLOW_AUTODIFF_TAMC
301 jmc 1.1 C- Internal exchange for calculations in X
302 jmc 1.7 IF ( overlapOnly ) THEN
303 jmc 1.8 CALL FILL_CS_CORNER_TR_RL( 1, .FALSE.,
304 jmc 1.6 & iceFld, bi,bj, myThid )
305 jmc 1.1 IF ( .NOT.useGridVolume )
306 jmc 1.8 & CALL FILL_CS_CORNER_TR_RL( 1, .FALSE.,
307 jmc 1.6 & iceVol, bi,bj, myThid )
308 jmc 1.1 ENDIF
309 heimbach 1.4 #endif
310 jmc 1.1
311     C- Compute CFL number
312     IF ( useGridVolume ) THEN
313     DO j=1-Oly,sNy+Oly
314     DO i=2-Olx,sNx+Olx
315     uCfl(i,j) = deltaTadvect*(
316     & MAX( uTrans(i,j), 0. _d 0 )*recip_rA(i-1,j,bi,bj)
317     & +MAX(-uTrans(i,j), 0. _d 0 )*recip_rA( i ,j,bi,bj)
318     & )
319     ENDDO
320     ENDDO
321     ELSE
322     DO j=1-Oly,sNy+Oly
323     DO i=2-Olx,sNx+Olx
324     uCfl(i,j) = deltaTadvect*(
325     & MAX( uTrans(i,j), 0. _d 0 )/MAX( iceVol(i-1,j), iceEps )
326     & +MAX(-uTrans(i,j), 0. _d 0 )/MAX( iceVol( i ,j), iceEps )
327     & )
328     ENDDO
329     ENDDO
330     ENDIF
331    
332     IF ( advectionScheme.EQ.ENUM_UPWIND_1RST
333     & .OR. advectionScheme.EQ.ENUM_DST2 ) THEN
334     CALL GAD_DST2U1_ADV_X( bi,bj,k, advectionScheme, .FALSE.,
335     I deltaTadvect, uTrans, uCfl, iceFld,
336     O af, myThid )
337 jmc 1.10 IF (dBugFlag.AND.bi.EQ.biDb ) WRITE(6,'(A,1P4E14.6)')
338     & 'ICE_adv: xFx=', af(idb,jdb), iceFld(idb,jdb),
339     & uTrans(idb,jdb), af(idb,jdb)/uTrans(idb,jdb)
340 jmc 1.1 ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
341     CALL GAD_FLUXLIMIT_ADV_X( bi,bj,k, .FALSE., deltaTadvect,
342     I uTrans, uCfl, maskLocW, iceFld,
343     O af, myThid )
344     ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
345     CALL GAD_DST3_ADV_X( bi,bj,k, .FALSE., deltaTadvect,
346     I uTrans, uCfl, maskLocW, iceFld,
347     O af, myThid )
348     ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
349     CALL GAD_DST3FL_ADV_X( bi,bj,k, .FALSE., deltaTadvect,
350     I uTrans, uCfl, maskLocW, iceFld,
351     O af, myThid )
352     ELSE
353     STOP
354     & 'THSICE_ADVECTION: adv. scheme incompatibale with multi-dim'
355     ENDIF
356    
357 heimbach 1.4 #ifndef ALLOW_AUTODIFF_TAMC
358 jmc 1.1 C-- Internal exchange for next calculations in Y
359 jmc 1.7 IF ( overlapOnly .AND. ipass.EQ.1 ) THEN
360 jmc 1.8 CALL FILL_CS_CORNER_TR_RL( 2, .FALSE.,
361 jmc 1.7 & iceFld, bi,bj, myThid )
362     IF ( .NOT.useGridVolume )
363 jmc 1.8 & CALL FILL_CS_CORNER_TR_RL( 2, .FALSE.,
364 jmc 1.7 & iceVol, bi,bj, myThid )
365     ENDIF
366     #endif
367    
368     C-- Advective flux in X : done
369 jmc 1.1 ENDIF
370    
371     C- Update the local seaice field where needed:
372    
373     C update in overlap-Only
374     IF ( overlapOnly ) THEN
375     iMinUpd = 1-OLx+1
376     iMaxUpd = sNx+OLx-1
377     C-- notes: these 2 lines below have no real effect (because recip_hFac=0
378     C in corner region) but safer to keep them.
379     IF ( W_edge ) iMinUpd = 1
380     IF ( E_edge ) iMaxUpd = sNx
381    
382 heimbach 1.4 #ifdef ALLOW_AUTODIFF_TAMC
383     CADJ STORE iceFld(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
384     CADJ STORE iceVol(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
385     #endif
386 jmc 1.1 IF ( S_edge .AND. useGridVolume ) THEN
387     DO j=1-OLy,0
388     DO i=iMinUpd,iMaxUpd
389     iceFld(i,j) = iceFld(i,j)
390     & -deltaTadvect*maskOc(i,j)
391     & *recip_rA(i,j,bi,bj)
392     & *( af(i+1,j)-af(i,j) )
393     ENDDO
394     ENDDO
395     ELSEIF ( S_edge ) THEN
396     DO j=1-OLy,0
397     DO i=iMinUpd,iMaxUpd
398     tmpVol = iceVol(i,j)
399     iceVol(i,j) = iceVol(i,j)
400     & -deltaTadvect*maskOc(i,j)
401     & *( uTrans(i+1,j)-uTrans(i,j) )
402     IF ( iceVol(i,j).GT.iceEps )
403     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
404     & -deltaTadvect*maskOc(i,j)
405     & *( af(i+1,j)-af(i,j) )
406     & )/iceVol(i,j)
407     ENDDO
408     ENDDO
409     ENDIF
410     IF ( N_edge .AND. useGridVolume ) THEN
411     DO j=sNy+1,sNy+OLy
412     DO i=iMinUpd,iMaxUpd
413     iceFld(i,j) = iceFld(i,j)
414     & -deltaTadvect*maskOc(i,j)
415     & *recip_rA(i,j,bi,bj)
416     & *( af(i+1,j)-af(i,j) )
417     ENDDO
418     ENDDO
419     ELSEIF ( N_edge ) THEN
420     DO j=sNy+1,sNy+OLy
421     DO i=iMinUpd,iMaxUpd
422     tmpVol = iceVol(i,j)
423     iceVol(i,j) = iceVol(i,j)
424     & -deltaTadvect*maskOc(i,j)
425     & *( uTrans(i+1,j)-uTrans(i,j) )
426     IF ( iceVol(i,j).GT.iceEps )
427     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
428     & -deltaTadvect*maskOc(i,j)
429     & *( af(i+1,j)-af(i,j) )
430     & )/iceVol(i,j)
431     ENDDO
432     ENDDO
433     ENDIF
434     C-- keep advective flux (for diagnostics)
435     IF ( S_edge ) THEN
436     DO j=1-OLy,0
437     DO i=1-OLx+1,sNx+OLx
438     afx(i,j) = af(i,j)
439     ENDDO
440     ENDDO
441     ENDIF
442     IF ( N_edge ) THEN
443     DO j=sNy+1,sNy+OLy
444     DO i=1-OLx+1,sNx+OLx
445     afx(i,j) = af(i,j)
446     ENDDO
447     ENDDO
448     ENDIF
449    
450     ELSE
451     C do not only update the overlap
452     jMinUpd = 1-OLy
453     jMaxUpd = sNy+OLy
454     IF ( interiorOnly .AND. S_edge ) jMinUpd = 1
455     IF ( interiorOnly .AND. N_edge ) jMaxUpd = sNy
456     IF ( useGridVolume ) THEN
457     DO j=jMinUpd,jMaxUpd
458     DO i=1-OLx+1,sNx+OLx-1
459     iceFld(i,j) = iceFld(i,j)
460     & -deltaTadvect*maskOc(i,j)
461     & *recip_rA(i,j,bi,bj)
462     & *( af(i+1,j)-af(i,j) )
463     ENDDO
464     ENDDO
465     ELSE
466     DO j=jMinUpd,jMaxUpd
467     DO i=1-OLx+1,sNx+OLx-1
468     tmpVol = iceVol(i,j)
469     iceVol(i,j) = iceVol(i,j)
470     & -deltaTadvect*maskOc(i,j)
471     & *( uTrans(i+1,j)-uTrans(i,j) )
472     IF ( iceVol(i,j).GT.iceEps )
473     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
474     & -deltaTadvect*maskOc(i,j)
475     & *( af(i+1,j)-af(i,j) )
476     & )/iceVol(i,j)
477     ENDDO
478     ENDDO
479     ENDIF
480     C-- keep advective flux (for diagnostics)
481     DO j=jMinUpd,jMaxUpd
482     DO i=1-OLx+1,sNx+OLx
483     afx(i,j) = af(i,j)
484     ENDDO
485     ENDDO
486    
487     C- end if/else update overlap-Only
488     ENDIF
489    
490     C-- End of X direction
491     ENDIF
492    
493     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
494     C-- Y direction
495    
496     IF (calc_fluxes_Y) THEN
497    
498     C- Do not compute fluxes if
499     C a) needed in overlap only
500     C and b) the overlap of myTile are not cube-face edges
501 heimbach 1.4 #ifdef ALLOW_AUTODIFF_TAMC
502     CADJ STORE iceFld(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
503     CADJ STORE iceVol(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
504 heimbach 1.12 CADJ STORE af(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
505 heimbach 1.4 #endif
506 jmc 1.1 IF ( .NOT.overlapOnly .OR. E_edge .OR. W_edge ) THEN
507    
508     C- Advective flux in Y
509     DO j=1-OLy,sNy+OLy
510     DO i=1-OLx,sNx+OLx
511     af(i,j) = 0.
512     ENDDO
513     ENDDO
514    
515 heimbach 1.4 #ifndef ALLOW_AUTODIFF_TAMC
516 jmc 1.1 C- Internal exchange for calculations in Y
517 jmc 1.7 IF ( overlapOnly ) THEN
518 jmc 1.8 CALL FILL_CS_CORNER_TR_RL( 2, .FALSE.,
519 jmc 1.6 & iceFld, bi,bj, myThid )
520 jmc 1.1 IF ( .NOT.useGridVolume )
521 jmc 1.8 & CALL FILL_CS_CORNER_TR_RL( 2, .FALSE.,
522 jmc 1.6 & iceVol, bi,bj, myThid )
523 jmc 1.1 ENDIF
524 heimbach 1.4 #endif
525 jmc 1.1
526     C- Compute CFL number
527     IF ( useGridVolume ) THEN
528     DO j=2-Oly,sNy+Oly
529     DO i=1-Olx,sNx+Olx
530     vCfl(i,j) = deltaTadvect*(
531     & MAX( vTrans(i,j), 0. _d 0 )*recip_rA(i,j-1,bi,bj)
532     & +MAX(-vTrans(i,j), 0. _d 0 )*recip_rA(i, j ,bi,bj)
533     & )
534     ENDDO
535     ENDDO
536     ELSE
537     DO j=2-Oly,sNy+Oly
538     DO i=1-Olx,sNx+Olx
539     vCfl(i,j) = deltaTadvect*(
540     & MAX( vTrans(i,j), 0. _d 0 )/MAX( iceVol(i,j-1), iceEps )
541     & +MAX(-vTrans(i,j), 0. _d 0 )/MAX( iceVol(i, j ), iceEps )
542     & )
543     ENDDO
544     ENDDO
545     ENDIF
546    
547     IF ( advectionScheme.EQ.ENUM_UPWIND_1RST
548     & .OR. advectionScheme.EQ.ENUM_DST2 ) THEN
549     CALL GAD_DST2U1_ADV_Y( bi,bj,k, advectionScheme, .FALSE.,
550     I deltaTadvect, vTrans, vCfl, iceFld,
551     O af, myThid )
552 jmc 1.10 IF (dBugFlag.AND.bi.EQ.biDb ) WRITE(6,'(A,1P4E14.6)')
553     & 'ICE_adv: yFx=', af(idb,jdb), iceFld(idb,jdb),
554     & vTrans(idb,jdb), af(idb,jdb)/vTrans(idb,jdb)
555 jmc 1.1 ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
556     CALL GAD_FLUXLIMIT_ADV_Y( bi,bj,k, .FALSE., deltaTadvect,
557     I vTrans, vCfl, maskLocS, iceFld,
558     O af, myThid )
559     ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN
560     CALL GAD_DST3_ADV_Y( bi,bj,k, .FALSE., deltaTadvect,
561     I vTrans, vCfl, maskLocS, iceFld,
562     O af, myThid )
563     ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN
564     CALL GAD_DST3FL_ADV_Y( bi,bj,k, .FALSE., deltaTadvect,
565     I vTrans, vCfl, maskLocS, iceFld,
566     O af, myThid )
567     ELSE
568     STOP
569     & 'THSICE_ADVECTION: adv. scheme incompatibale with mutli-dim'
570     ENDIF
571    
572 jmc 1.7 #ifndef ALLOW_AUTODIFF_TAMC
573     IF ( overlapOnly .AND. ipass.EQ.1 ) THEN
574 jmc 1.8 CALL FILL_CS_CORNER_TR_RL( 1, .FALSE.,
575 jmc 1.7 & iceFld, bi,bj, myThid )
576     IF ( .NOT.useGridVolume )
577 jmc 1.8 & CALL FILL_CS_CORNER_TR_RL( 1, .FALSE.,
578 jmc 1.7 & iceVol, bi,bj, myThid )
579     ENDIF
580     #endif
581    
582 jmc 1.1 C- Advective flux in Y : done
583     ENDIF
584    
585     C- Update the local seaice field where needed:
586    
587     C update in overlap-Only
588     IF ( overlapOnly ) THEN
589     jMinUpd = 1-OLy+1
590     jMaxUpd = sNy+OLy-1
591     C- notes: these 2 lines below have no real effect (because recip_hFac=0
592     C in corner region) but safer to keep them.
593     IF ( S_edge ) jMinUpd = 1
594     IF ( N_edge ) jMaxUpd = sNy
595    
596 heimbach 1.4 #ifdef ALLOW_AUTODIFF_TAMC
597     CADJ STORE iceFld(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
598     CADJ STORE iceVol(:,:) = comlev1_thsice_4, key=ikey_4, byte=isbyte
599     #endif
600 jmc 1.1 IF ( W_edge .AND. useGridVolume ) THEN
601     DO j=jMinUpd,jMaxUpd
602     DO i=1-OLx,0
603     iceFld(i,j) = iceFld(i,j)
604     & -deltaTadvect*maskOc(i,j)
605     & *recip_rA(i,j,bi,bj)
606     & *( af(i,j+1)-af(i,j) )
607     ENDDO
608     ENDDO
609     ELSEIF ( W_edge ) THEN
610     DO j=jMinUpd,jMaxUpd
611     DO i=1-OLx,0
612     tmpVol = iceVol(i,j)
613     iceVol(i,j) = iceVol(i,j)
614     & -deltaTadvect*maskOc(i,j)
615     & *( vTrans(i,j+1)-vTrans(i,j) )
616     IF ( iceVol(i,j).GT.iceEps )
617     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
618     & -deltaTadvect*maskOc(i,j)
619     & *( af(i,j+1)-af(i,j) )
620     & )/iceVol(i,j)
621     ENDDO
622     ENDDO
623     ENDIF
624     IF ( E_edge .AND. useGridVolume ) THEN
625     DO j=jMinUpd,jMaxUpd
626     DO i=sNx+1,sNx+OLx
627     iceFld(i,j) = iceFld(i,j)
628     & -deltaTadvect*maskOc(i,j)
629     & *recip_rA(i,j,bi,bj)
630     & *( af(i,j+1)-af(i,j) )
631     ENDDO
632     ENDDO
633     ELSEIF ( E_edge ) THEN
634     DO j=jMinUpd,jMaxUpd
635     DO i=sNx+1,sNx+OLx
636     tmpVol = iceVol(i,j)
637     iceVol(i,j) = iceVol(i,j)
638     & -deltaTadvect*maskOc(i,j)
639     & *( vTrans(i,j+1)-vTrans(i,j) )
640     IF ( iceVol(i,j).GT.iceEps )
641     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
642     & -deltaTadvect*maskOc(i,j)
643     & *( af(i,j+1)-af(i,j) )
644     & )/iceVol(i,j)
645     ENDDO
646     ENDDO
647     ENDIF
648     C-- keep advective flux (for diagnostics)
649     IF ( W_edge ) THEN
650     DO j=1-OLy+1,sNy+OLy
651     DO i=1-OLx,0
652     afy(i,j) = af(i,j)
653     ENDDO
654     ENDDO
655     ENDIF
656     IF ( E_edge ) THEN
657     DO j=1-OLy+1,sNy+OLy
658     DO i=sNx+1,sNx+OLx
659     afy(i,j) = af(i,j)
660     ENDDO
661     ENDDO
662     ENDIF
663    
664     ELSE
665     C do not only update the overlap
666     iMinUpd = 1-OLx
667     iMaxUpd = sNx+OLx
668     IF ( interiorOnly .AND. W_edge ) iMinUpd = 1
669     IF ( interiorOnly .AND. E_edge ) iMaxUpd = sNx
670     IF ( useGridVolume ) THEN
671     DO j=1-OLy+1,sNy+OLy-1
672     DO i=iMinUpd,iMaxUpd
673     iceFld(i,j) = iceFld(i,j)
674     & -deltaTadvect*maskOc(i,j)
675     & *recip_rA(i,j,bi,bj)
676     & *( af(i,j+1)-af(i,j) )
677     ENDDO
678     ENDDO
679     ELSE
680     DO j=1-OLy+1,sNy+OLy-1
681     DO i=iMinUpd,iMaxUpd
682     tmpVol = iceVol(i,j)
683     iceVol(i,j) = iceVol(i,j)
684     & -deltaTadvect*maskOc(i,j)
685     & *( vTrans(i,j+1)-vTrans(i,j) )
686     IF ( iceVol(i,j).GT.iceEps )
687     & iceFld(i,j) = ( iceFld(i,j)*tmpVol
688     & -deltaTadvect*maskOc(i,j)
689     & *( af(i,j+1)-af(i,j) )
690     & )/iceVol(i,j)
691     ENDDO
692     ENDDO
693     ENDIF
694     C-- keep advective flux (for diagnostics)
695     DO j=1-OLy+1,sNy+OLy
696     DO i=iMinUpd,iMaxUpd
697     afy(i,j) = af(i,j)
698     ENDDO
699     ENDDO
700    
701     C end if/else update overlap-Only
702     ENDIF
703    
704     C-- End of Y direction
705     ENDIF
706    
707     C-- End of ipass loop
708     ENDDO
709    
710     C- explicit advection is done ; add some debugging print
711 jmc 1.10 IF ( dBugFlag ) THEN
712 jmc 1.1 DO j=1-OLy,sNy+OLy
713     DO i=1-OLx,sNx+OLx
714 jmc 1.10 IF ( i.EQ.idb .AND. j.EQ.jdb .AND. bi.EQ.biDb ) THEN
715 jmc 1.1 tmpFac= deltaTadvect*recip_rA(i,j,bi,bj)
716     WRITE(6,'(A,1P4E14.6)') 'ICE_adv:',
717     & afx(i,j)*tmpFac,afx(i+1,j)*tmpFac,
718     & afy(i,j)*tmpFac,afy(i,j+1)*tmpFac
719     ENDIF
720     ENDDO
721     ENDDO
722     ENDIF
723    
724     #ifdef ALLOW_DEBUG
725     IF ( debugLevel .GE. debLevB
726     & .AND. tracerIdentity.EQ.GAD_SI_HICE
727     & .AND. k.LE.3 .AND. myIter.EQ.1+nIter0
728     & .AND. nPx.EQ.1 .AND. nPy.EQ.1
729     & .AND. useCubedSphereExchange ) THEN
730     CALL DEBUG_CS_CORNER_UV( ' afx,afy from THSICE_ADVECTION',
731     & afx,afy, k, standardMessageUnit,bi,bj,myThid )
732     ENDIF
733     #endif /* ALLOW_DEBUG */
734    
735 jmc 1.2 #endif /* ALLOW_GENERIC_ADVDIFF */
736    
737 jmc 1.1 RETURN
738     END

  ViewVC Help
Powered by ViewVC 1.1.22