--- MITgcm/pkg/ptracers/ptracers_integrate.F 2002/06/15 03:37:44 1.3 +++ MITgcm/pkg/ptracers/ptracers_integrate.F 2004/11/19 01:34:27 1.20 @@ -1,16 +1,22 @@ -C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/ptracers/ptracers_integrate.F,v 1.3 2002/06/15 03:37:44 jmc Exp $ +C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/ptracers/ptracers_integrate.F,v 1.20 2004/11/19 01:34:27 mlosch Exp $ C $Name: $ #include "PTRACERS_OPTIONS.h" +cswdptr -- add --- +#ifdef ALLOW_GCHEM +# include "GCHEM_OPTIONS.h" +#endif +cswdptr -- end add --- CBOP -C !ROUTINE: PTRACERS_INTEGERATE +C !ROUTINE: PTRACERS_INTEGRATE C !INTERFACE: ========================================================== - SUBROUTINE PTRACERS_INTEGERATE( + SUBROUTINE PTRACERS_INTEGRATE( I bi,bj,k, - I xA,yA,uTrans,vTrans,rTrans,maskUp, - X KappaRtr, + I xA,yA,uTrans,vTrans,rTrans, + I rTransKp1,maskUp, + X rFlx,KappaRtr, I myIter,myTime,myThid ) C !DESCRIPTION: @@ -21,6 +27,9 @@ IMPLICIT NONE #include "SIZE.h" #include "EEPARAMS.h" +#include "PARAMS.h" +#include "DYNVARS.h" +#include "PTRACERS_SIZE.h" #include "PTRACERS.h" #include "GAD.h" @@ -31,13 +40,11 @@ C yA :: face area at V points in level k C uTrans :: zonal transport in level k C vTrans :: meridional transport in level k -C rTrans :: vertical transport across level k +C rTrans :: vertical volume transport at interface k +C rTransKp1 :: vertical volume transport at interface k+1 C maskUp :: mask for vertical transport -C KappaRtr :: vertical diffusion of passive tracers -C NOTE! This is infact KappaRS from thermodynamics() -C and is being used only temporarily -C until we removed the need to store -C a "3D" diffusivity +C rFlx :: vertical flux +C KappaRtr :: vertical diffusion of passive tracers, interf k C myIter :: time-step number C myTime :: model time C myThid :: thread number @@ -47,8 +54,10 @@ _RL uTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy) _RL vTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy) _RL rTrans (1-OLx:sNx+OLx,1-OLy:sNy+OLy) + _RL rTransKp1(1-OLx:sNx+OLx,1-OLy:sNy+OLy) _RS maskUp (1-OLx:sNx+OLx,1-OLy:sNy+OLy) - _RL KappaRtr(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr) + _RL rFlx(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2,PTRACERS_num) + _RL KappaRtr(1-Olx:sNx+Olx,1-Oly:sNy+Oly,PTRACERS_num) INTEGER myIter _RL myTime INTEGER myThid @@ -63,27 +72,17 @@ C iMin,iMax,jMin,jMax :: loop ranges C kUp,kDown :: toggle indices for even/odd level fluxes C km1 :: =min(1,k-1) -C rFlx :: vertical flux +C GAD_TR :: passive tracer id (GAD_TR1+iTracer-1) INTEGER i,j,iTracer INTEGER iMin,iMax,jMin,jMax INTEGER kUp,kDown,km1 - _RL rFlx(1-OLx:sNx+OLx,1-OLy:sNy+OLy,2,PTRACERS_num) + INTEGER GAD_TR LOGICAL calcAdvection CEOP C Loop over tracers DO iTracer=1,PTRACERS_numInUse -C Initialize vertical flux to zero and set no-flux across k=Nr+1 - IF (k.EQ.Nr) THEN - DO j=1-Oly,sNy+Oly - DO i=1-Olx,sNx+Olx - rFlx(i,j,1,iTracer)=0. - rFlx(i,j,2,iTracer)=0. - ENDDO - ENDDO - ENDIF - C Loop ranges for daughter routines iMin = 1-OLx+2 iMax = sNx+OLx-1 @@ -100,25 +99,44 @@ & .OR. PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND & .OR. PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD & .OR. PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH - CALL GAD_CALC_RHS( - I bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown, - I xA,yA,uTrans,vTrans,rTrans,maskUp, - I PTRACERS_diffKh(iTracer), - I PTRACERS_diffK4(iTracer), - I KappaRtr, - I pTracer(1-Olx,1-Oly,1,1,1,iTracer), - I GAD_TR1, - I PTRACERS_advScheme(iTracer),calcAdvection, - U rFlx(1-Olx,1-Oly,1,iTracer), - U gPtr(1-Olx,1-Oly,1,1,1,iTracer), - I myThid ) + GAD_TR = GAD_TR1 + iTracer - 1 + CALL GAD_CALC_RHS( + I bi,bj,iMin,iMax,jMin,jMax,k,kM1,kUp,kDown, + I xA,yA,uTrans,vTrans,rTrans,rTransKp1,maskUp, + I uVel, vVel, wVel, + I PTRACERS_diffKh(iTracer), + I PTRACERS_diffK4(iTracer), + I KappaRtr(1-Olx,1-Oly,iTracer), + I pTracer(1-Olx,1-Oly,1,1,1,iTracer), + I GAD_TR, + I PTRACERS_advScheme(iTracer), + I PTRACERS_advScheme(iTracer), + I calcAdvection, .FALSE., + U rFlx(1-Olx,1-Oly,1,iTracer), + U gPtr(1-Olx,1-Oly,1,1,1,iTracer), + I myTime, myIter, myThid ) C External forcing term(s) +cswdptr --add -- +#ifdef ALLOW_GCHEM +#ifndef PTRACERS_SEPARATE_FORCING + IF ( forcing_In_AB .AND. useGCHEM ) + & CALL GCHEM_FORCING_INT( + I bi,bj,iMin,iMax,jMin,jMax,k, + I iTracer, + I myTime,myIter, myThid) +#endif +#else +cswdptr - end add --- IF ( forcing_In_AB ) & CALL PTRACERS_FORCING( - I bi,bj,k,iTracer, - U gPtr(1-Olx,1-Oly,1,1,1,iTracer), - I myIter,myTime,myThid) + I bi,bj,iMin,iMax,jMin,jMax,k, + U gPtr(1-Olx,1-Oly,1,1,1,iTracer), + I surfaceForcingPtr(1-Olx,1-Oly,1,1,iTracer), + I myIter,myTime,myThid) +cswdptr --add--- +#endif +cswdptr -- end add --- C If using Adams-Bashforth II, then extrapolate tendancies IF ( PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND @@ -132,11 +150,26 @@ ENDIF C External forcing term(s) +cswdptr - add-- +#ifdef ALLOW_GCHEM +#ifndef PTRACERS_SEPARATE_FORCING + IF ( .NOT.forcing_In_AB .AND. useGCHEM ) + & CALL GCHEM_FORCING_INT( + I bi,bj,iMin,iMax,jMin,jMax,k, + I iTracer, + I myTime,myIter, myThid) +#endif +#else +cswdptr - end add --- IF ( .NOT.forcing_In_AB ) & CALL PTRACERS_FORCING( - I bi,bj,k,iTracer, - U gPtr(1-Olx,1-Oly,1,1,1,iTracer), - I myIter,myTime,myThid) + I bi,bj,iMin,iMax,jMin,jMax,k, + U gPtr(1-Olx,1-Oly,1,1,1,iTracer), + I surfaceForcingPtr(1-Olx,1-Oly,1,1,iTracer), + I myIter,myTime,myThid) +cswdptr - add-- +#endif +cswdptr -- end add --- #ifdef NONLIN_FRSURF C Account for change in level thickness @@ -145,6 +178,13 @@ I bi,bj,K, U gPtr(1-Olx,1-Oly,1,1,1,iTracer), I myThid ) + IF ( PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_2ND + & .OR.PTRACERS_advScheme(iTracer).EQ.ENUM_UPWIND_3RD + & .OR.PTRACERS_advScheme(iTracer).EQ.ENUM_CENTERED_4TH ) + & CALL FREESURF_RESCALE_G( + I bi,bj,K, + U gPtrNm1(1-Olx,1-Oly,1,1,1,iTracer), + I myThid ) ENDIF #endif /* NONLIN_FRSURF */