C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/seaice/seaice_advection.F,v 1.3 2006/06/19 15:48:35 jmc Exp $ C $Name: $ #include "GAD_OPTIONS.h" C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| CBOP C !ROUTINE: SEAICE_ADVECTION C !INTERFACE: ========================================================== SUBROUTINE SEAICE_ADVECTION( I advectionScheme, I tracerIdentity, I uVel, vVel, tracer, O gTracer, I bi, bj, myTime, myIter, myThid) C !DESCRIPTION: C Calculates the tendency of a tracer due to advection. C It uses the multi-dimensional method given in \ref{sect:multiDimAdvection} C and can only be used for the non-linear advection schemes such as the C direct-space-time method and flux-limiters. C C This routine is an adaption of the GAD_ADVECTION for 2D-fields. C Seaice velocities are not divergence free; therefore the contribution C tracer*div(u) that is present in gad_advection is removed in this routine. C C The algorithm is as follows: C \begin{itemize} C \item{$\theta^{(n+1/2)} = \theta^{(n)} C - \Delta t \partial_x (u\theta^{(n)}) + \theta^{(n)} \partial_x u$} C \item{$\theta^{(n+2/2)} = \theta^{(n+1/2)} C - \Delta t \partial_y (v\theta^{(n+1/2)}) + \theta^{(n)} \partial_y v$} C \item{$G_\theta = ( \theta^{(n+2/2)} - \theta^{(n)} )/\Delta t$} C \end{itemize} C C The tendency (output) is over-written by this routine. C !USES: =============================================================== IMPLICIT NONE #include "SIZE.h" #include "EEPARAMS.h" #include "PARAMS.h" #include "GRID.h" #include "GAD.h" #include "SEAICE_PARAMS.h" #ifdef ALLOW_AUTODIFF_TAMC # include "tamc.h" # include "tamc_keys.h" #endif #ifdef ALLOW_EXCH2 #include "W2_EXCH2_TOPOLOGY.h" #include "W2_EXCH2_PARAMS.h" #endif /* ALLOW_EXCH2 */ C !INPUT PARAMETERS: =================================================== C implicitAdvection :: implicit vertical advection (later on) C advectionScheme :: advection scheme to use (Horizontal plane) C tracerIdentity :: tracer identifier (required only for OBCS) C uVel :: velocity, zonal component C vVel :: velocity, meridional component C tracer :: tracer field C bi,bj :: tile indices C myTime :: current time C myIter :: iteration number C myThid :: thread number INTEGER advectionScheme INTEGER tracerIdentity _RL uVel (1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) _RL vVel (1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) _RL tracer(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) INTEGER bi,bj _RL myTime INTEGER myIter INTEGER myThid C !OUTPUT PARAMETERS: ================================================== C gTracer :: tendancy array _RL gTracer(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy) C !LOCAL VARIABLES: ==================================================== C maskLocW :: 2-D array for mask at West points C maskLocS :: 2-D array for mask at South points C iMin,iMax, :: loop range for called routines C jMin,jMax :: loop range for called routines C [iMin,iMax]Upd :: loop range to update tracer field C [jMin,jMax]Upd :: loop range to update tracer field C i,j,k :: loop indices C kp1 :: =k+1 for k maxcube. check tamc.h' ENDIF #endif /* ALLOW_AUTODIFF_TAMC */ interiorOnly = .FALSE. overlapOnly = .FALSE. IF (useCubedSphereExchange) THEN C-- CubedSphere : pass 3 times, with partial update of local tracer field IF (ipass.EQ.1) THEN overlapOnly = MOD(nCFace,3).EQ.0 interiorOnly = MOD(nCFace,3).NE.0 calc_fluxes_X = nCFace.EQ.6 .OR. nCFace.EQ.1 .OR. nCFace.EQ.2 calc_fluxes_Y = nCFace.EQ.3 .OR. nCFace.EQ.4 .OR. nCFace.EQ.5 ELSEIF (ipass.EQ.2) THEN overlapOnly = MOD(nCFace,3).EQ.2 calc_fluxes_X = nCFace.EQ.2 .OR. nCFace.EQ.3 .OR. nCFace.EQ.4 calc_fluxes_Y = nCFace.EQ.5 .OR. nCFace.EQ.6 .OR. nCFace.EQ.1 ELSE calc_fluxes_X = nCFace.EQ.5 .OR. nCFace.EQ.6 calc_fluxes_Y = nCFace.EQ.2 .OR. nCFace.EQ.3 ENDIF ELSE C-- not CubedSphere calc_fluxes_X = MOD(ipass,2).EQ.1 calc_fluxes_Y = .NOT.calc_fluxes_X ENDIF C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| C-- X direction C- Advective flux in X DO j=1-Oly,sNy+Oly DO i=1-Olx,sNx+Olx af(i,j) = 0. ENDDO ENDDO C #ifdef ALLOW_AUTODIFF_TAMC CADJ STORE localTij(:,:) = CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte # ifndef DISABLE_MULTIDIM_ADVECTION CADJ STORE af(:,:) = CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte # endif #endif /* ALLOW_AUTODIFF_TAMC */ C IF (calc_fluxes_X) THEN C- Do not compute fluxes if C a) needed in overlap only C and b) the overlap of myTile are not cube-face Edges IF ( .NOT.overlapOnly .OR. N_edge .OR. S_edge ) THEN #ifndef ALLOW_AUTODIFF_TAMC C- Internal exchange for calculations in X #ifdef MULTIDIM_OLD_VERSION IF ( useCubedSphereExchange ) THEN #else IF ( useCubedSphereExchange .AND. & ( overlapOnly .OR. ipass.EQ.1 ) ) THEN #endif CALL FILL_CS_CORNER_TR_RL( .TRUE., localTij, bi,bj, myThid ) ENDIF #endif #ifdef ALLOW_AUTODIFF_TAMC # ifndef DISABLE_MULTIDIM_ADVECTION CADJ STORE localTij(:,:) = CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte # endif #endif /* ALLOW_AUTODIFF_TAMC */ IF ( advectionScheme.EQ.ENUM_UPWIND_1RST & .OR. advectionScheme.EQ.ENUM_DST2 ) THEN CALL GAD_DST2U1_ADV_X( bi,bj,k, advectionScheme, I SEAICE_deltaTtherm,uTrans,uFld,localTij, O af, myThid ) ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN CALL GAD_FLUXLIMIT_ADV_X( bi,bj,k, SEAICE_deltaTtherm, I uTrans, uFld, maskLocW, localTij, O af, myThid ) ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN CALL GAD_DST3_ADV_X( bi,bj,k, SEAICE_deltaTtherm, I uTrans, uFld, maskLocW, localTij, O af, myThid ) ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN CALL GAD_DST3FL_ADV_X( bi,bj,k, SEAICE_deltaTtherm, I uTrans, uFld, maskLocW, localTij, O af, myThid ) ELSE STOP & 'SEAICE_ADVECTION: adv. scheme incompatibale with multi-dim' ENDIF C-- Advective flux in X : done ENDIF #ifndef ALLOW_AUTODIFF_TAMC C-- Internal exchange for next calculations in Y IF ( overlapOnly .AND. ipass.EQ.1 ) THEN CALL FILL_CS_CORNER_TR_RL(.FALSE., localTij, bi,bj, myThid ) ENDIF #endif C- Update the local tracer field where needed: C update in overlap-Only IF ( overlapOnly ) THEN iMinUpd = 1-Olx+1 iMaxUpd = sNx+Olx-1 C-- notes: these 2 lines below have no real effect (because recip_hFac=0 C in corner region) but safer to keep them. IF ( W_edge ) iMinUpd = 1 IF ( E_edge ) iMaxUpd = sNx IF ( S_edge ) THEN DO j=1-Oly,0 DO i=iMinUpd,iMaxUpd localTij(i,j)=localTij(i,j)-SEAICE_deltaTtherm* & maskC(i,j,k,bi,bj) & *recip_rA(i,j,bi,bj) & *( af(i+1,j)-af(i,j) & ) ENDDO ENDDO ENDIF IF ( N_edge ) THEN DO j=sNy+1,sNy+Oly DO i=iMinUpd,iMaxUpd localTij(i,j)=localTij(i,j)-SEAICE_deltaTtherm* & maskC(i,j,k,bi,bj) & *recip_rA(i,j,bi,bj) & *( af(i+1,j)-af(i,j) & ) ENDDO ENDDO ENDIF ELSE C do not only update the overlap jMinUpd = 1-Oly jMaxUpd = sNy+Oly IF ( interiorOnly .AND. S_edge ) jMinUpd = 1 IF ( interiorOnly .AND. N_edge ) jMaxUpd = sNy DO j=jMinUpd,jMaxUpd DO i=1-Olx+1,sNx+Olx-1 localTij(i,j)=localTij(i,j)-SEAICE_deltaTtherm* & maskC(i,j,k,bi,bj) & *recip_rA(i,j,bi,bj) & *( af(i+1,j)-af(i,j) & ) ENDDO ENDDO C-- keep advective flux (for diagnostics) DO j=1-Oly,sNy+Oly DO i=1-Olx,sNx+Olx afx(i,j) = af(i,j) ENDDO ENDDO C This is for later CML#ifdef ALLOW_OBCS CMLC- Apply open boundary conditions CML IF ( useOBCS ) THEN CML IF (tracerIdentity.EQ.GAD_HEFF) THEN CML CALL OBCS_APPLY_HEFF( bi, bj, k, localTij, myThid ) CML ELSEIF (tracerIdentity.EQ.GAD_AREA) THEN CML CALL OBCS_APPLY_AREA( bi, bj, k, localTij, myThid ) CML ENDIF CML ENDIF CML#endif /* ALLOW_OBCS */ C- end if/else update overlap-Only ENDIF C-- End of X direction ENDIF C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----| C-- Y direction cph-test C- Advective flux in Y DO j=1-Oly,sNy+Oly DO i=1-Olx,sNx+Olx af(i,j) = 0. ENDDO ENDDO C #ifdef ALLOW_AUTODIFF_TAMC # ifndef DISABLE_MULTIDIM_ADVECTION CADJ STORE localTij(:,:) = CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte CADJ STORE af(:,:) = CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte # endif #endif /* ALLOW_AUTODIFF_TAMC */ C IF (calc_fluxes_Y) THEN C- Do not compute fluxes if C a) needed in overlap only C and b) the overlap of myTile are not cube-face edges IF ( .NOT.overlapOnly .OR. E_edge .OR. W_edge ) THEN #ifndef ALLOW_AUTODIFF_TAMC C- Internal exchange for calculations in Y #ifdef MULTIDIM_OLD_VERSION IF ( useCubedSphereExchange ) THEN #else IF ( useCubedSphereExchange .AND. & ( overlapOnly .OR. ipass.EQ.1 ) ) THEN #endif CALL FILL_CS_CORNER_TR_RL(.FALSE., localTij, bi,bj, myThid ) ENDIF #endif C- Advective flux in Y DO j=1-Oly,sNy+Oly DO i=1-Olx,sNx+Olx af(i,j) = 0. ENDDO ENDDO #ifdef ALLOW_AUTODIFF_TAMC #ifndef DISABLE_MULTIDIM_ADVECTION CADJ STORE localTij(:,:) = CADJ & comlev1_bibj_k_gad_pass, key=passkey, byte=isbyte #endif #endif /* ALLOW_AUTODIFF_TAMC */ IF ( advectionScheme.EQ.ENUM_UPWIND_1RST & .OR. advectionScheme.EQ.ENUM_DST2 ) THEN CALL GAD_DST2U1_ADV_Y( bi,bj,k, advectionScheme, I SEAICE_deltaTtherm,vTrans,vFld,localTij, O af, myThid ) ELSEIF (advectionScheme.EQ.ENUM_FLUX_LIMIT) THEN CALL GAD_FLUXLIMIT_ADV_Y( bi,bj,k, SEAICE_deltaTtherm, I vTrans, vFld, maskLocS, localTij, O af, myThid ) ELSEIF (advectionScheme.EQ.ENUM_DST3 ) THEN CALL GAD_DST3_ADV_Y( bi,bj,k, SEAICE_deltaTtherm, I vTrans, vFld, maskLocS, localTij, O af, myThid ) ELSEIF (advectionScheme.EQ.ENUM_DST3_FLUX_LIMIT ) THEN CALL GAD_DST3FL_ADV_Y( bi,bj,k, SEAICE_deltaTtherm, I vTrans, vFld, maskLocS, localTij, O af, myThid ) ELSE STOP & 'SEAICE_ADVECTION: adv. scheme incompatibale with mutli-dim' ENDIF C- Advective flux in Y : done ENDIF #ifndef ALLOW_AUTODIFF_TAMC C- Internal exchange for next calculations in X IF ( overlapOnly .AND. ipass.EQ.1 ) THEN CALL FILL_CS_CORNER_TR_RL( .TRUE., localTij, bi,bj, myThid ) ENDIF #endif C- Update the local tracer field where needed: C update in overlap-Only IF ( overlapOnly ) THEN jMinUpd = 1-Oly+1 jMaxUpd = sNy+Oly-1 C- notes: these 2 lines below have no real effect (because recip_hFac=0 C in corner region) but safer to keep them. IF ( S_edge ) jMinUpd = 1 IF ( N_edge ) jMaxUpd = sNy IF ( W_edge ) THEN DO j=jMinUpd,jMaxUpd DO i=1-Olx,0 localTij(i,j)=localTij(i,j)-SEAICE_deltaTtherm* & maskC(i,j,k,bi,bj) & *recip_rA(i,j,bi,bj) & *( af(i,j+1)-af(i,j) & ) ENDDO ENDDO ENDIF IF ( E_edge ) THEN DO j=jMinUpd,jMaxUpd DO i=sNx+1,sNx+Olx localTij(i,j)=localTij(i,j)-SEAICE_deltaTtherm* & maskC(i,j,k,bi,bj) & *recip_rA(i,j,bi,bj) & *( af(i,j+1)-af(i,j) & ) ENDDO ENDDO ENDIF ELSE C do not only update the overlap iMinUpd = 1-Olx iMaxUpd = sNx+Olx IF ( interiorOnly .AND. W_edge ) iMinUpd = 1 IF ( interiorOnly .AND. E_edge ) iMaxUpd = sNx DO j=1-Oly+1,sNy+Oly-1 DO i=iMinUpd,iMaxUpd localTij(i,j)=localTij(i,j)-SEAICE_deltaTtherm* & maskC(i,j,k,bi,bj) & *recip_rA(i,j,bi,bj) & *( af(i,j+1)-af(i,j) & ) ENDDO ENDDO C-- keep advective flux (for diagnostics) DO j=1-Oly,sNy+Oly DO i=1-Olx,sNx+Olx afy(i,j) = af(i,j) ENDDO ENDDO C-- Save this for later CML#ifdef ALLOW_OBCS CMLC- Apply open boundary conditions CML IF (useOBCS) THEN CML IF (tracerIdentity.EQ.GAD_HEFF) THEN CML CALL OBCS_APPLY_HEFF( bi, bj, k, localTij, myThid ) CML ELSEIF (tracerIdentity.EQ.GAD_AREA) THEN CML CALL OBCS_APPLY_AREA( bi, bj, k, localTij, myThid ) CML ENDIF CML ENDIF CML#endif /* ALLOW_OBCS */ C end if/else update overlap-Only ENDIF C-- End of Y direction ENDIF C-- End of ipass loop ENDDO C- explicit advection is done ; store tendency in gTracer: DO j=1-Oly,sNy+Oly DO i=1-Olx,sNx+Olx gTracer(i,j,bi,bj)= & (localTij(i,j)-tracer(i,j,bi,bj))/SEAICE_deltaTtherm ENDDO ENDDO CML#ifdef ALLOW_DIAGNOSTICS CML IF ( useDiagnostics ) THEN CML diagName = 'ADVx'//diagSufx CML CALL DIAGNOSTICS_FILL(afx,diagName, k,1, 2,bi,bj, myThid) CML diagName = 'ADVy'//diagSufx CML CALL DIAGNOSTICS_FILL(afy,diagName, k,1, 2,bi,bj, myThid) CML ENDIF CML#endif #ifdef ALLOW_DEBUG IF ( debugLevel .GE. debLevB & .AND. tracerIdentity.EQ.GAD_HEFF & .AND. k.LE.3 .AND. myIter.EQ.1+nIter0 & .AND. nPx.EQ.1 .AND. nPy.EQ.1 & .AND. useCubedSphereExchange ) THEN CALL DEBUG_CS_CORNER_UV( ' afx,afy from SEAICE_ADVECTION', & afx,afy, k, standardMessageUnit,bi,bj,myThid ) ENDIF #endif /* ALLOW_DEBUG */ RETURN END