/[MITgcm]/MITgcm/pkg/generic_advdiff/gad_advection.F
ViewVC logotype

Diff of /MITgcm/pkg/generic_advdiff/gad_advection.F

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

revision 1.5 by adcroft, Fri Sep 21 13:11:43 2001 UTC revision 1.6 by heimbach, Thu Sep 27 20:12:11 2001 UTC
# Line 66  C !USES: =============================== Line 66  C !USES: ===============================
66  #include "DYNVARS.h"  #include "DYNVARS.h"
67  #include "GRID.h"  #include "GRID.h"
68  #include "GAD.h"  #include "GAD.h"
69    #ifdef ALLOW_AUTODIFF_TAMC
70    # include "tamc.h"
71    # include "tamc_keys.h"
72    #endif
73    
74  C !INPUT PARAMETERS: ===================================================  C !INPUT PARAMETERS: ===================================================
75  C  bi,bj                :: tile indices  C  bi,bj                :: tile indices
# Line 122  C  ipass                :: number of the Line 126  C  ipass                :: number of the
126        INTEGER nipass,ipass        INTEGER nipass,ipass
127  CEOP  CEOP
128    
129    #ifdef ALLOW_AUTODIFF_TAMC
130              act1 = bi - myBxLo(myThid)
131              max1 = myBxHi(myThid) - myBxLo(myThid) + 1
132              act2 = bj - myByLo(myThid)
133              max2 = myByHi(myThid) - myByLo(myThid) + 1
134              act3 = myThid - 1
135              max3 = nTx*nTy
136              act4 = ikey_dynamics - 1
137              ikey = (act1 + 1) + act2*max1
138         &                      + act3*max1*max2
139         &                      + act4*max1*max2*max3
140    #endif /* ALLOW_AUTODIFF_TAMC */
141    
142  C--   Set up work arrays with valid (i.e. not NaN) values  C--   Set up work arrays with valid (i.e. not NaN) values
143  C     These inital values do not alter the numerical results. They  C     These inital values do not alter the numerical results. They
144  C     just ensure that all memory references are to valid floating  C     just ensure that all memory references are to valid floating
# Line 146  C     uninitialised but inert locations. Line 163  C     uninitialised but inert locations.
163    
164  C--   Start of k loop for horizontal fluxes  C--   Start of k loop for horizontal fluxes
165        DO k=1,Nr        DO k=1,Nr
166    #ifdef ALLOW_AUTODIFF_TAMC
167             kkey = (ikey-1)*Nr + k
168    CADJ STORE tracer(:,:,k,bi,bj) = comlev1_bibj_k, key=kkey, byte=isbyte
169    #endif /* ALLOW_AUTODIFF_TAMC */
170    
171  C--   Get temporary terms used by tendency routines  C--   Get temporary terms used by tendency routines
172        CALL CALC_COMMON_FACTORS (        CALL CALC_COMMON_FACTORS (
# Line 165  C--   Make local copy of tracer array Line 186  C--   Make local copy of tracer array
186        ELSE        ELSE
187         nipass=1         nipass=1
188        ENDIF        ENDIF
189         nipass=1  cph       nipass=1
190    
191  C--   Multiple passes for different directions on different tiles  C--   Multiple passes for different directions on different tiles
192        DO ipass=1,nipass        DO ipass=1,nipass
193    #ifdef ALLOW_AUTODIFF_TAMC
194             passkey = ipass + (k-1)   *maxpass
195         &                   + (ikey-1)*maxpass*Nr
196             IF (nipass .GT. maxpass) THEN
197              STOP 'GAD_ADVECTION: nipass > maxpass. check tamc.h'
198             ENDIF
199    #endif /* ALLOW_AUTODIFF_TAMC */
200    
201        IF (nipass.EQ.3) THEN        IF (nipass.EQ.3) THEN
202         calc_fluxes_X=.FALSE.         calc_fluxes_X=.FALSE.
# Line 212  C-    Advective flux in X Line 240  C-    Advective flux in X
240          af(i,j) = 0.          af(i,j) = 0.
241         ENDDO         ENDDO
242        ENDDO        ENDDO
243    
244    #ifdef ALLOW_AUTODIFF_TAMC
245    #ifdef ALLOW_MULTIDIM_ADVECTION
246    CADJ STORE localTij(:,:)  = comlev1_bibj_pass, key=passkey, byte=isbyte
247    #endif
248    #endif /* ALLOW_AUTODIFF_TAMC */
249    
250        IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN        IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
251         CALL GAD_FLUXLIMIT_ADV_X(         CALL GAD_FLUXLIMIT_ADV_X(
252       &      bi,bj,k,deltaTtracer,uTrans,uVel,localTij,af,myThid)       &      bi,bj,k,deltaTtracer,uTrans,uVel,localTij,af,myThid)
# Line 224  C-    Advective flux in X Line 259  C-    Advective flux in X
259        ELSE        ELSE
260         STOP 'GAD_ADVECTION: adv. scheme incompatibale with mutli-dim'         STOP 'GAD_ADVECTION: adv. scheme incompatibale with mutli-dim'
261        ENDIF        ENDIF
262    
263        DO j=1-Oly,sNy+Oly        DO j=1-Oly,sNy+Oly
264         DO i=1-Olx,sNx+Olx-1         DO i=1-Olx,sNx+Olx-1
265          localTij(i,j)=localTij(i,j)-deltaTtracer*          localTij(i,j)=localTij(i,j)-deltaTtracer*
# Line 270  C-    Advective flux in Y Line 306  C-    Advective flux in Y
306          af(i,j) = 0.          af(i,j) = 0.
307         ENDDO         ENDDO
308        ENDDO        ENDDO
309    
310    #ifdef ALLOW_AUTODIFF_TAMC
311    #ifdef ALLOW_MULTIDIM_ADVECTION
312    CADJ STORE localTij(:,:)  = comlev1_bibj_pass, key=passkey, byte=isbyte
313    #endif
314    #endif /* ALLOW_AUTODIFF_TAMC */
315    
316        IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN        IF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN
317         CALL GAD_FLUXLIMIT_ADV_Y(         CALL GAD_FLUXLIMIT_ADV_Y(
318       &       bi,bj,k,deltaTtracer,vTrans,vVel,localTij,af,myThid)       &       bi,bj,k,deltaTtracer,vTrans,vVel,localTij,af,myThid)
# Line 282  C-    Advective flux in Y Line 325  C-    Advective flux in Y
325        ELSE        ELSE
326         STOP 'GAD_ADVECTION: adv. scheme incompatibale with mutli-dim'         STOP 'GAD_ADVECTION: adv. scheme incompatibale with mutli-dim'
327        ENDIF        ENDIF
328    
329        DO j=1-Oly,sNy+Oly-1        DO j=1-Oly,sNy+Oly-1
330         DO i=1-Olx,sNx+Olx         DO i=1-Olx,sNx+Olx
331          localTij(i,j)=localTij(i,j)-deltaTtracer*          localTij(i,j)=localTij(i,j)-deltaTtracer*
# Line 321  C--   End of K loop for horizontal fluxe Line 365  C--   End of K loop for horizontal fluxe
365    
366  C--   Start of k loop for vertical flux  C--   Start of k loop for vertical flux
367        DO k=Nr,1,-1        DO k=Nr,1,-1
368    #ifdef ALLOW_AUTODIFF_TAMC
369             kkey = (ikey-1)*Nr + k
370    #endif /* ALLOW_AUTODIFF_TAMC */
371    
372  C--   kup    Cycles through 1,2 to point to w-layer above  C--   kup    Cycles through 1,2 to point to w-layer above
373  C--   kDown  Cycles through 2,1 to point to w-layer below  C--   kDown  Cycles through 2,1 to point to w-layer below
# Line 340  C-    Advective flux in R Line 387  C-    Advective flux in R
387         ENDDO         ENDDO
388        ENDDO        ENDDO
389    
390    #ifdef ALLOW_AUTODIFF_TAMC
391    CADJ STORE localTijk(:,:,k)  
392    CADJ &     = comlev1_bibj_k, key=kkey, byte=isbyte
393    #endif /* ALLOW_AUTODIFF_TAMC */
394    
395  C     Note: wVel needs to be masked  C     Note: wVel needs to be masked
396        IF (K.GE.2) THEN        IF (K.GE.2) THEN
397  C-    Compute vertical advective flux in the interior:  C-    Compute vertical advective flux in the interior:
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22