/[MITgcm]/MITgcm/pkg/ptracers/ptracers_implicit.F
ViewVC logotype

Diff of /MITgcm/pkg/ptracers/ptracers_implicit.F

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

revision 1.3 by heimbach, Fri Mar 25 00:29:17 2005 UTC revision 1.9 by jmc, Thu Dec 1 14:27:53 2011 UTC
# Line 7  CBOP Line 7  CBOP
7  C !ROUTINE: PTRACERS_IMPLICIT  C !ROUTINE: PTRACERS_IMPLICIT
8    
9  C !INTERFACE: ==========================================================  C !INTERFACE: ==========================================================
10        SUBROUTINE PTRACERS_IMPLICIT(        SUBROUTINE PTRACERS_IMPLICIT(
11       U                              kappaRk,       U                              kappaRk,
12         I                              recip_hFac,
13       I                              bi, bj, myTime, myIter, myThid )       I                              bi, bj, myTime, myIter, myThid )
14    
15  C !DESCRIPTION:  C !DESCRIPTION:
16  C     Calls the implicit vertical advection/diffusion routine  C     Calls the implicit vertical advection/diffusion routine
17  C     for each passive tracer.  C     for each passive tracer.
18    C     And apply open boundary conditions for each passive tracer
19    C Note: would be better to apply OBC in a dedicated S/R ;
20    C     can be done here assuming no other contribution modify passive
21    C     tracer after implicit vertical diffus/advect is applied.
22    
23  C !USES: ===============================================================  C !USES: ===============================================================
24        IMPLICIT NONE        IMPLICIT NONE
25  #include "SIZE.h"  #include "SIZE.h"
26  #include "EEPARAMS.h"  #include "EEPARAMS.h"
27    #ifdef ALLOW_LONGSTEP
28    #include "LONGSTEP_PARAMS.h"
29    #include "LONGSTEP.h"
30    #endif
31  #include "PTRACERS_SIZE.h"  #include "PTRACERS_SIZE.h"
32  #include "PTRACERS.h"  #include "PTRACERS_PARAMS.h"
33    #include "PTRACERS_FIELDS.h"
34  #include "PARAMS.h"  #include "PARAMS.h"
35  #include "GRID.h"  #include "GRID.h"
36  #include "GAD.h"  #include "GAD.h"
# Line 31  C !USES: =============================== Line 41  C !USES: ===============================
41  #endif  #endif
42    
43  C !INPUT PARAMETERS: ===================================================  C !INPUT PARAMETERS: ===================================================
44  C  bi,bj   :: tile indices  C  recip_hFac :: Inverse of cell open-depth factor
45  C  myTime  :: time in simulation  C  bi,bj      :: tile indices
46  C  myIter  :: iteration number in simulation  C  myTime     :: time in simulation
47  C  myThid  :: thread number  C  myIter     :: iteration number in simulation
48    C  myThid     :: thread number
49          _RS     recip_hFac(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
50        INTEGER bi,bj        INTEGER bi,bj
51        _RL     myTime        _RL     myTime
52        INTEGER myIter        INTEGER myIter
53        INTEGER myThid        INTEGER myThid
54    
55  C !OUTPUT PARAMETERS: ==================================================  C !OUTPUT PARAMETERS: ==================================================
56  C  KappaRk :: vertical diffusion coefficient  C  KappaRk    :: vertical diffusion coefficient
57        _RL kappaRk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)        _RL     kappaRk(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr)
58    
59  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
60    
# Line 71  C Loop over tracers Line 83  C Loop over tracers
83            act3 = myThid - 1            act3 = myThid - 1
84            max3 = nTx*nTy            max3 = nTx*nTy
85            act4 = ikey_dynamics - 1            act4 = ikey_dynamics - 1
86            iptrkey = (act0 + 1)            iptrkey = (act0 + 1)
87       &                      + act1*max0       &                      + act1*max0
88       &                      + act2*max0*max1       &                      + act2*max0*max1
89       &                      + act3*max0*max1*max2       &                      + act3*max0*max1*max2
# Line 89  C Loop over tracers Line 101  C Loop over tracers
101          ENDIF          ENDIF
102    
103  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
104  CADJ STORE kappaRk(:,:,:) = comlev1_bibj_ptracers,  CADJ STORE kappaRk(:,:,:) = comlev1_bibj_ptracers,
105  CADJ &     key=iptrkey, byte=isbyte  CADJ &     key=iptrkey, byte=isbyte
106  CADJ STORE gPtr(:,:,:,bi,bj,iTracer) = comlev1_bibj_ptracers,  CADJ STORE gPtr(:,:,:,bi,bj,iTracer) = comlev1_bibj_ptracers,
107  CADJ &     key=iptrkey, byte=isbyte  CADJ &     key=iptrkey, byte=isbyte
108  #endif /* ALLOW_AUTODIFF_TAMC */  #endif /* ALLOW_AUTODIFF_TAMC */
109    
# Line 99  CADJ &     key=iptrkey, byte=isbyte Line 111  CADJ &     key=iptrkey, byte=isbyte
111          IF ( PTRACERS_ImplVertAdv(iTracer) ) THEN          IF ( PTRACERS_ImplVertAdv(iTracer) ) THEN
112    
113            CALL GAD_IMPLICIT_R(            CALL GAD_IMPLICIT_R(
114       I         PTRACERS_ImplVertAdv(iTracer),       I         PTRACERS_ImplVertAdv(iTracer),
115       I         PTRACERS_advScheme(iTracer), GAD_TR,       I         PTRACERS_advScheme(iTracer), GAD_TR,
116       I         kappaRk, wVel, pTracer(1-Olx,1-Oly,1,1,1,iTracer),       I         PTRACERS_dTLev, kappaRk, recip_hFac,
117       U         gPtr(1-Olx,1-Oly,1,1,1,iTracer),  #ifdef ALLOW_LONGSTEP
118         I         LS_wVel,
119    #else
120         I         wVel,
121    #endif
122         I         pTracer(1-OLx,1-OLy,1,1,1,iTracer),
123         U         gPtr(1-OLx,1-OLy,1,1,1,iTracer),
124       I         bi, bj, myTime, myIter, myThid )       I         bi, bj, myTime, myIter, myThid )
125    
126          ELSEIF ( implicitDiffusion ) THEN          ELSEIF ( implicitDiffusion ) THEN
# Line 112  CADJ &     key=iptrkey, byte=isbyte Line 130  CADJ &     key=iptrkey, byte=isbyte
130    
131            CALL IMPLDIFF(            CALL IMPLDIFF(
132       I         bi, bj, iMin, iMax, jMin, jMax,       I         bi, bj, iMin, iMax, jMin, jMax,
133       I         GAD_TR, kappaRk, recip_HFacC,       I         GAD_TR, kappaRk, recip_hFac,
134       U         gPtr(1-Olx,1-Oly,1,1,1,iTracer),       U         gPtr(1-OLx,1-OLy,1,1,1,iTracer),
135       I         myThid )       I         myThid )
136            ENDIF
137    
138    #ifdef ALLOW_OBCS
139    C--     Apply open boundary conditions
140            IF ( useOBCS ) THEN
141              CALL OBCS_APPLY_PTRACER(
142         I         bi, bj, 0, iTracer,
143         U         gPtr(1-OLx,1-OLy,1,bi,bj,iTracer),
144         I         myThid )
145          ENDIF          ENDIF
146    #endif /* ALLOW_OBCS */
147    
148  C End of tracer loop  C End of tracer loop
149        ENDDO        ENDDO
150    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22