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

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

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

revision 1.5 by jmc, Fri Oct 14 21:51:05 2005 UTC revision 1.6 by jmc, Sat Oct 22 20:12:23 2005 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "GAD_OPTIONS.h"  #include "GAD_OPTIONS.h"
5    
6    CBOP
7    C !ROUTINE: GAD_DST3_ADV_R
8    
9    C !INTERFACE: ==========================================================
10        SUBROUTINE GAD_DST3_ADV_R(        SUBROUTINE GAD_DST3_ADV_R(
11       I           bi_arg,bj_arg,k,dTarg,       I           bi,bj,k,dTarg,
12       I           rTrans, wVel,       I           rTrans, wVel,
13       I           tracer,       I           tracer,
14       O           wT,       O           wT,
15       I           myThid )       I           myThid )
16  C     /==========================================================\  
17  C     | SUBROUTINE GAD_DST3_ADV_R                                |  C !DESCRIPTION:
18  C     | o Compute Vertical advective Flux of Tracer using        |  C  Calculates the area integrated vertical flux due to advection of a tracer
19  C     |   3rd Order DST Sceheme                                  |  C  using 3rd-order Direct Space and Time (DST-3) Advection Scheme
20  C     |==========================================================|  
21    C !USES: ===============================================================
22        IMPLICIT NONE        IMPLICIT NONE
23    
24  C     == GLobal variables ==  C     == GLobal variables ==
# Line 24  C     == GLobal variables == Line 29  C     == GLobal variables ==
29  #include "GAD.h"  #include "GAD.h"
30    
31  C     == Routine arguments ==  C     == Routine arguments ==
32        INTEGER bi_arg,bj_arg,k  C !INPUT PARAMETERS: ===================================================
33    C  bi,bj             :: tile indices
34    C  k                 :: vertical level
35    C  deltaTloc         :: local time-step (s)
36    C  rTrans            :: vertical volume transport
37    C  wVel              :: vertical flow
38    C  tracer            :: tracer field
39    C  myThid            :: thread number
40          INTEGER bi,bj,k
41        _RL dTarg        _RL dTarg
42        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rTrans(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
43        _RL wVel(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL wVel(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
44        _RL tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL tracer(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
       _RL wT    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
45        INTEGER myThid        INTEGER myThid
46    
47    C !OUTPUT PARAMETERS: ==================================================
48    C  wT                :: vertical advective flux
49          _RL wT    (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
50    
51  C     == Local variables ==  C     == Local variables ==
52  C     wFld     :: velocity, vertical component  C !LOCAL VARIABLES: ====================================================
53        INTEGER i,j,kp1,km1,km2,bi,bj  C  i,j               :: loop indices
54    C  km1               :: =max( k-1 , 1 )
55    C  rLimit            :: centered (vs upwind) fraction
56    C  wFld              :: velocity, vertical component
57    C  wCFL              :: Courant-Friedrich-Levy number
58          INTEGER i,j,kp1,km1,km2
59        _RL Rjm,Rj,Rjp,cfl,d0,d1        _RL Rjm,Rj,Rjp,cfl,d0,d1
60        _RL psiP,psiM,thetaP,thetaM        _RL psiP,psiM,thetaP,thetaM
61        _RL wFld        _RL wFld
62        _RL smallNo        _RL smallNo
 c     _RL Rjjm,Rjjp  
   
       IF (.NOT. multiDimAdvection) THEN  
 C      If using the standard time-stepping/advection schemes (ie. AB-II)  
 C      then the data-structures are all global arrays  
        bi=bi_arg  
        bj=bj_arg  
       ELSE  
 C      otherwise if using the multi-dimensional advection schemes  
 C      then the data-structures are all local arrays except  
 C      for maskC(...) and wVel(...)  
        bi=1  
        bj=1  
       ENDIF  
63    
64        IF (inAdMode) THEN        IF (inAdMode) THEN
65         smallNo = 1.0D-20         smallNo = 1.0D-20
# Line 66  C      for maskC(...) and wVel(...) Line 73  C      for maskC(...) and wVel(...)
73    
74        DO j=1-Oly,sNy+Oly        DO j=1-Oly,sNy+Oly
75         DO i=1-Olx,sNx+Olx         DO i=1-Olx,sNx+Olx
76          Rjp=(tracer(i,j,k,bi,bj)-tracer(i,j,kp1,bi,bj))          Rjp=(tracer(i,j,k)-tracer(i,j,kp1))
77       &         *maskC(i,j,kp1,bi_arg,bj_arg)       &         *maskC(i,j,kp1,bi,bj)
78          Rj =(tracer(i,j,km1,bi,bj)-tracer(i,j,k,bi,bj))          Rj =(tracer(i,j,km1)-tracer(i,j,k))
79       &         *maskC(i,j,k,bi_arg,bj_arg)*maskC(i,j,km1,bi_arg,bj_arg)       &         *maskC(i,j,k,bi,bj)*maskC(i,j,km1,bi,bj)
80          Rjm=(tracer(i,j,km2,bi,bj)-tracer(i,j,km1,bi,bj))          Rjm=(tracer(i,j,km2)-tracer(i,j,km1))
81       &         *maskC(i,j,km1,bi_arg,bj_arg)       &         *maskC(i,j,km1,bi,bj)
82    
83  c       wFld = wVel(i,j,k,bi_arg,bj_arg)  c       wFld = wVel(i,j,k,bi,bj)
84          wFld = rTrans(i,j)*recip_rA(i,j,bi_arg,bj_arg)          wFld = rTrans(i,j)*recip_rA(i,j,bi,bj)
85          cfl=abs(wFld*dTarg*recip_drC(k))          cfl=abs(wFld*dTarg*recip_drC(k))
86          d0=(2.-cfl)*(1.-cfl)*oneSixth          d0=(2.-cfl)*(1.-cfl)*oneSixth
87          d1=(1.-cfl*cfl)*oneSixth          d1=(1.-cfl*cfl)*oneSixth
# Line 99  c       wFld = wVel(i,j,k,bi_arg,bj_arg) Line 106  c       wFld = wVel(i,j,k,bi_arg,bj_arg)
106          ENDIF          ENDIF
107           wT(i,j)=           wT(i,j)=
108       &    0.5*(rTrans(i,j)+abs(rTrans(i,j)))       &    0.5*(rTrans(i,j)+abs(rTrans(i,j)))
109       &       *( Tracer(i,j, k ,bi,bj) + psiM*Rj )       &       *( tracer(i,j, k ) + psiM*Rj )
110       &   +0.5*(rTrans(i,j)-abs(rTrans(i,j)))       &   +0.5*(rTrans(i,j)-abs(rTrans(i,j)))
111       &       *( Tracer(i,j,km1,bi,bj) - psiP*Rj )       &       *( tracer(i,j,km1) - psiP*Rj )
112  #ifdef ALLOW_MATRIX  #ifdef ALLOW_MATRIX
113          ELSE          ELSE
114            wT(i,j)=            wT(i,j)=
115       &     0.5*(rTrans(i,j)+abs(rTrans(i,j)))       &     0.5*(rTrans(i,j)+abs(rTrans(i,j)))
116       &        *( Tracer(i,j, k ,bi,bj) + (d0*Rj+d1*Rjp) )       &        *( tracer(i,j, k ) + (d0*Rj+d1*Rjp) )
117       &    +0.5*(rTrans(i,j)-abs(rTrans(i,j)))       &    +0.5*(rTrans(i,j)-abs(rTrans(i,j)))
118       &        *( Tracer(i,j,km1,bi,bj) - (d0*Rj+d1*Rjm) )       &        *( tracer(i,j,km1) - (d0*Rj+d1*Rjm) )
119          ENDIF          ENDIF
120  #endif /* ALLOW_MATRIX */  #endif /* ALLOW_MATRIX */
121    
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22