/[MITgcm]/MITgcm/model/src/impldiff.F
ViewVC logotype

Diff of /MITgcm/model/src/impldiff.F

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

revision 1.13 by adcroft, Wed Nov 29 22:38:31 2000 UTC revision 1.20 by jmc, Fri Jan 2 23:07:14 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6  C     /==========================================================\  CBOP
7  C     | S/R IMPLDIFF                                             |  C     !ROUTINE: IMPLDIFF
8  C     | o Solve implicit diffusion equation for vertical         |  C     !INTERFACE:
 C     |   diffusivity.                                           |  
 C     | o Recoded from 2d intermediate fields to 3d to reduce    |  
 C     |   TAMC storage                                           |  
 C     | o Fixed missing masks for fields a(), c()                |  
 C     \==========================================================/  
9        SUBROUTINE IMPLDIFF( bi, bj, iMin, iMax, jMin, jMax,        SUBROUTINE IMPLDIFF( bi, bj, iMin, iMax, jMin, jMax,
10       I                     deltaTX,KappaRX,recip_hFac,       I                     deltaTX,KappaRX,recip_hFac,
11       U                     gXNm1,       U                     gXNm1,
12       I                     myThid )       I                     myThid )
13    C     !DESCRIPTION: \bv
14    C     *==========================================================*
15    C     | S/R IMPLDIFF                                              
16    C     | o Solve implicit diffusion equation for vertical          
17    C     |   diffusivity.                                            
18    C     *==========================================================*
19    C     | o Recoded from 2d intermediate fields to 3d to reduce    
20    C     |   TAMC storage                                            
21    C     | o Fixed missing masks for fields a(), c()                
22    C     *==========================================================*
23    C     \ev
24    
25    C     !USES:
26        IMPLICIT NONE        IMPLICIT NONE
27  C     == Global data ==  C     == Global data ==
28  #include "SIZE.h"  #include "SIZE.h"
# Line 21  C     == Global data == Line 30  C     == Global data ==
30  #include "EEPARAMS.h"  #include "EEPARAMS.h"
31  #include "PARAMS.h"  #include "PARAMS.h"
32  #include "GRID.h"  #include "GRID.h"
   
33  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
34  #include "tamc_keys.h"  #include "tamc_keys.h"
35  #endif  #endif
36    
37    C     !INPUT/OUTPUT PARAMETERS:
38  C     == Routine Arguments ==  C     == Routine Arguments ==
39        INTEGER bi,bj,iMin,iMax,jMin,jMax        INTEGER bi,bj,iMin,iMax,jMin,jMax
40        _RL deltaTX        _RL deltaTX
41        _RL KappaRX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL KappaRX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
42        _RS recip_hFac(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)        _RS recip_hFac(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
43        _RL gXnm1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)        _RL gXnm1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
       _RL gYnm1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)  
44        INTEGER myThid        INTEGER myThid
45    
46    C     !LOCAL VARIABLES:
47  C     == Local variables ==  C     == Local variables ==
48        INTEGER i,j,k        INTEGER i,j,k
49          _RL gYnm1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
50        _RL a(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL a(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
51        _RL b(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL b(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
52        _RL c(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL c(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
53        _RL bet(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL bet(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
54        _RL gam(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)        _RL gam(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
55    CEOP
56    
57  #ifdef ALLOW_AUTODIFF_TAMC        IF (Nr.LE.1) RETURN
       INTEGER kkey  
 #endif  
58    
59  C--   Initialise  C--   Initialise
60          DO k=1,Nr
61           DO j=jMin,jMax
62            DO i=iMin,iMax
63             gYNm1(i,j,k,bi,bj) = 0. _d 0
64            ENDDO
65           ENDDO
66          ENDDO
67    
68  C--   Old aLower  C--   Old aLower
69        DO j=1-Oly,sNy+Oly        DO j=jMin,jMax
70         DO i=1-Olx,sNx+Olx         DO i=iMin,iMax
71           a(i,j,1) = 0. _d 0           a(i,j,1) = 0. _d 0
72         ENDDO         ENDDO
73        ENDDO        ENDDO
74        DO k=2,Nr        DO k=2,Nr
75         DO j=1-Oly,sNy+Oly         DO j=jMin,jMax
76          DO i=1-Olx,sNx+Olx          DO i=iMin,iMax
77            a(i,j,k) = -deltaTX*recip_hFac(i,j,k,bi,bj)*recip_drF(k)            a(i,j,k) = -deltaTX*recip_hFac(i,j,k,bi,bj)*recip_drF(k)
78       &               *KappaRX(i,j, k )*recip_drC( k )       &               *KappaRX(i,j, k )*recip_drC( k )
79              IF (recip_hFac(i,j,k-1,bi,bj).EQ.0.) a(i,j,k)=0.
80          ENDDO          ENDDO
81         ENDDO         ENDDO
82        ENDDO        ENDDO
83    
84  C--   Old aUpper  C--   Old aUpper
85        DO k=1,Nr-1        DO k=1,Nr-1
86         DO j=1-Oly,sNy+Oly         DO j=jMin,jMax
87          DO i=1-Olx,sNx+Olx          DO i=iMin,iMax
88            c(i,j,k) = -deltaTX*recip_hFac(i,j,k,bi,bj)*recip_drF(k)            c(i,j,k) = -deltaTX*recip_hFac(i,j,k,bi,bj)*recip_drF(k)
89       &               *KappaRX(i,j,k+1)*recip_drC(k+1)       &               *KappaRX(i,j,k+1)*recip_drC(k+1)
90            IF (recip_hFac(i,j,k+1,bi,bj).EQ.0.) c(i,j,k)=0.            IF (recip_hFac(i,j,k+1,bi,bj).EQ.0.) c(i,j,k)=0.
91          ENDDO          ENDDO
92         ENDDO         ENDDO
93        ENDDO        ENDDO
94        DO j=1-Oly,sNy+Oly        DO j=jMin,jMax
95         DO i=1-Olx,sNx+Olx         DO i=iMin,iMax
96           c(i,j,Nr) = 0. _d 0           c(i,j,Nr) = 0. _d 0
97         ENDDO         ENDDO
98        ENDDO        ENDDO
99    
100  C--   Old aCenter  C--   Old aCenter
101        DO k=1,Nr        DO k=1,Nr
102         DO j=1-Oly,sNy+Oly         DO j=jMin,jMax
103          DO i=1-Olx,sNx+Olx          DO i=iMin,iMax
104            b(i,j,k) = 1. _d 0 - c(i,j,k) - a(i,j,k)            b(i,j,k) = 1. _d 0 - c(i,j,k) - a(i,j,k)
105          ENDDO          ENDDO
106         ENDDO         ENDDO
# Line 91  C--   Old aCenter Line 108  C--   Old aCenter
108    
109  C--   Old and new gam, bet are the same  C--   Old and new gam, bet are the same
110        DO k=1,Nr        DO k=1,Nr
111         DO j=1-Oly,sNy+Oly         DO j=jMin,jMax
112          DO i=1-Olx,sNx+Olx          DO i=iMin,iMax
113            bet(i,j,k) = 0. _d 0            bet(i,j,k) = 0. _d 0
114            gam(i,j,k) = 0. _d 0            gam(i,j,k) = 0. _d 0
115          ENDDO          ENDDO
# Line 113  C--    Beginning of forward sweep (top l Line 130  C--    Beginning of forward sweep (top l
130        ENDIF        ENDIF
131    
132  C--   Middle of forward sweep  C--   Middle of forward sweep
133        IF (Nr.GT.2) THEN        IF (Nr.GE.2) THEN
134    
135  CADJ loop = sequential  CADJ loop = sequential
136         DO k=2,Nr         DO k=2,Nr
137    
 #ifdef ALLOW_AUTODIFF_TAMC  
         kkey = (idkey-1)*(Nr-2) + k-1  
 #endif  
   
138          DO j=jMin,jMax          DO j=jMin,jMax
139           DO i=iMin,iMax           DO i=iMin,iMax
140            gam(i,j,k) = c(i,j,k-1)*bet(i,j,k-1)            gam(i,j,k) = c(i,j,k-1)*bet(i,j,k-1)
Legend:
Removed from v.1.13  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22