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

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

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

Revision 1.17 - (hide annotations) (download)
Wed Sep 26 18:09:15 2001 UTC (22 years, 8 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint44e_post, checkpoint46l_post, checkpoint46g_pre, checkpoint47c_post, checkpoint46f_post, checkpoint44f_post, checkpoint46b_post, checkpoint43a-release1mods, checkpoint46l_pre, chkpt44d_post, release1_p1, checkpoint44e_pre, release1_b1, checkpoint43, checkpoint47d_pre, release1_chkpt44d_post, checkpoint47a_post, checkpoint46d_pre, release1-branch_tutorials, checkpoint45d_post, checkpoint46j_pre, chkpt44a_post, checkpoint44h_pre, checkpoint46a_post, checkpoint46j_post, checkpoint46k_post, chkpt44c_pre, checkpoint45a_post, ecco_c44_e19, ecco_c44_e18, ecco_c44_e17, ecco_c44_e16, checkpoint44g_post, checkpoint46e_pre, checkpoint45b_post, checkpoint46b_pre, release1-branch-end, release1_final_v1, checkpoint46c_pre, checkpoint46, checkpoint47b_post, checkpoint44b_post, checkpoint46h_pre, checkpoint46m_post, checkpoint46a_pre, checkpoint45c_post, checkpoint44h_post, checkpoint46g_post, ecco_c44_e22, chkpt44a_pre, checkpoint46i_post, ecco_c44_e20, ecco_c44_e21, checkpoint46c_post, ecco-branch-mod1, ecco-branch-mod2, ecco-branch-mod3, ecco-branch-mod4, ecco-branch-mod5, checkpoint46e_post, release1_beta1, checkpoint44b_pre, checkpoint42, checkpoint41, checkpoint47, checkpoint44, checkpoint45, checkpoint46h_post, chkpt44c_post, checkpoint44f_pre, checkpoint46d_post, release1-branch_branchpoint
Branch point for: release1_final, release1-branch, release1, ecco-branch, release1_coupled
Changes since 1.16: +22 -12 lines 
Bringing comments up to data and formatting for document extraction.
1 cnh 1.17 C $Header: /u/gcmpack/models/MITgcmUV/model/src/impldiff.F,v 1.16 2001/05/14 21:46:17 heimbach Exp $
2     C $Name: $
3 adcroft 1.1
4 cnh 1.7 #include "CPP_OPTIONS.h"
5 adcroft 1.1
6 cnh 1.17 CBOP
7     C !ROUTINE: IMPLDIFF
8     C !INTERFACE:
9 adcroft 1.1 SUBROUTINE IMPLDIFF( bi, bj, iMin, iMax, jMin, jMax,
10 adcroft 1.8 I deltaTX,KappaRX,recip_hFac,
11     U gXNm1,
12 adcroft 1.1 I myThid )
13 cnh 1.17 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 cnh 1.5 IMPLICIT NONE
27     C == Global data ==
28 adcroft 1.1 #include "SIZE.h"
29     #include "DYNVARS.h"
30 cnh 1.2 #include "EEPARAMS.h"
31 adcroft 1.1 #include "PARAMS.h"
32     #include "GRID.h"
33 heimbach 1.9 #ifdef ALLOW_AUTODIFF_TAMC
34     #include "tamc_keys.h"
35     #endif
36    
37 cnh 1.17 C !INPUT/OUTPUT PARAMETERS:
38 adcroft 1.1 C == Routine Arguments ==
39     INTEGER bi,bj,iMin,iMax,jMin,jMax
40 adcroft 1.8 _RL deltaTX
41     _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)
43     _RL gXnm1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
44 adcroft 1.1 INTEGER myThid
45 cnh 1.5
46 cnh 1.17 C !LOCAL VARIABLES:
47 adcroft 1.1 C == Local variables ==
48     INTEGER i,j,k
49 cnh 1.17 _RL gYnm1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
50 heimbach 1.12 _RL a(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
51     _RL b(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
52     _RL c(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
53     _RL bet(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
54 cnh 1.6 _RL gam(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
55 cnh 1.17 CEOP
56 adcroft 1.1
57 heimbach 1.12 C-- Initialise
58 heimbach 1.16 DO k=1,Nr
59     DO j=jMin,jMax
60     DO i=iMin,iMax
61     gYNm1(i,j,k,bi,bj) = 0. _d 0
62     ENDDO
63     ENDDO
64     ENDDO
65 heimbach 1.12
66     C-- Old aLower
67 heimbach 1.14 DO j=jMin,jMax
68     DO i=iMin,iMax
69 heimbach 1.12 a(i,j,1) = 0. _d 0
70     ENDDO
71     ENDDO
72     DO k=2,Nr
73 heimbach 1.14 DO j=jMin,jMax
74     DO i=iMin,iMax
75 heimbach 1.12 a(i,j,k) = -deltaTX*recip_hFac(i,j,k,bi,bj)*recip_drF(k)
76     & *KappaRX(i,j, k )*recip_drC( k )
77     ENDDO
78     ENDDO
79     ENDDO
80    
81     C-- Old aUpper
82     DO k=1,Nr-1
83 heimbach 1.14 DO j=jMin,jMax
84     DO i=iMin,iMax
85 heimbach 1.12 c(i,j,k) = -deltaTX*recip_hFac(i,j,k,bi,bj)*recip_drF(k)
86     & *KappaRX(i,j,k+1)*recip_drC(k+1)
87 adcroft 1.13 IF (recip_hFac(i,j,k+1,bi,bj).EQ.0.) c(i,j,k)=0.
88 heimbach 1.12 ENDDO
89     ENDDO
90     ENDDO
91 heimbach 1.14 DO j=jMin,jMax
92     DO i=iMin,iMax
93 heimbach 1.12 c(i,j,Nr) = 0. _d 0
94     ENDDO
95     ENDDO
96    
97     C-- Old aCenter
98     DO k=1,Nr
99 heimbach 1.14 DO j=jMin,jMax
100     DO i=iMin,iMax
101 heimbach 1.12 b(i,j,k) = 1. _d 0 - c(i,j,k) - a(i,j,k)
102     ENDDO
103     ENDDO
104     ENDDO
105    
106     C-- Old and new gam, bet are the same
107     DO k=1,Nr
108 heimbach 1.14 DO j=jMin,jMax
109     DO i=iMin,iMax
110 heimbach 1.12 bet(i,j,k) = 0. _d 0
111     gam(i,j,k) = 0. _d 0
112     ENDDO
113     ENDDO
114     ENDDO
115    
116 heimbach 1.10 C-- Only need do anything if Nr>1
117     IF (Nr.GT.1) THEN
118    
119 heimbach 1.12 k = 1
120 cnh 1.5 C-- Beginning of forward sweep (top level)
121 adcroft 1.1 DO j=jMin,jMax
122     DO i=iMin,iMax
123 heimbach 1.12 IF (b(i,j,1).NE.0.) bet(i,j,1) = 1. _d 0 / b(i,j,1)
124 adcroft 1.1 ENDDO
125     ENDDO
126 heimbach 1.10
127 adcroft 1.1 ENDIF
128 heimbach 1.9
129 cnh 1.5 C-- Middle of forward sweep
130 cnh 1.6 IF (Nr.GT.2) THEN
131 heimbach 1.10
132 heimbach 1.12 CADJ loop = sequential
133     DO k=2,Nr
134 heimbach 1.9
135 adcroft 1.1 DO j=jMin,jMax
136     DO i=iMin,iMax
137 heimbach 1.12 gam(i,j,k) = c(i,j,k-1)*bet(i,j,k-1)
138     IF ( ( b(i,j,k) - a(i,j,k)*gam(i,j,k) ) .NE. 0.)
139     & bet(i,j,k) = 1. _d 0 / ( b(i,j,k) - a(i,j,k)*gam(i,j,k) )
140 adcroft 1.1 ENDDO
141     ENDDO
142 heimbach 1.9
143 adcroft 1.1 ENDDO
144 heimbach 1.10
145 adcroft 1.1 ENDIF
146 heimbach 1.10
147 heimbach 1.11
148 heimbach 1.12 DO j=jMin,jMax
149     DO i=iMin,iMax
150     gYNm1(i,j,1,bi,bj) = gXNm1(i,j,1,bi,bj)*bet(i,j,1)
151 heimbach 1.10 ENDDO
152 heimbach 1.12 ENDDO
153     DO k=2,Nr
154 heimbach 1.10 DO j=jMin,jMax
155     DO i=iMin,iMax
156 heimbach 1.12 gYnm1(i,j,k,bi,bj) = bet(i,j,k)*
157     & (gXnm1(i,j,k,bi,bj) - a(i,j,k)*gYnm1(i,j,k-1,bi,bj))
158 heimbach 1.9 ENDDO
159     ENDDO
160 heimbach 1.12 ENDDO
161 heimbach 1.9
162    
163 heimbach 1.12 C-- Backward sweep
164     CADJ loop = sequential
165     DO k=Nr-1,1,-1
166     DO j=jMin,jMax
167     DO i=iMin,iMax
168     gYnm1(i,j,k,bi,bj)=gYnm1(i,j,k,bi,bj)
169     & -gam(i,j,k+1)*gYnm1(i,j,k+1,bi,bj)
170     ENDDO
171 adcroft 1.1 ENDDO
172     ENDDO
173 heimbach 1.9
174 heimbach 1.12 DO k=1,Nr
175 adcroft 1.1 DO j=jMin,jMax
176     DO i=iMin,iMax
177 heimbach 1.12 gXnm1(i,j,k,bi,bj)=gYnm1(i,j,k,bi,bj)
178 adcroft 1.1 ENDDO
179     ENDDO
180     ENDDO
181    
182     RETURN
183     END
  ViewVC Help
Powered by ViewVC 1.1.22