/[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.9 - (hide annotations) (download)
Fri Jun 9 02:45:04 2000 UTC (24 years ago) by heimbach
Branch: MAIN
Changes since 1.8: +64 -2 lines 
Modifications to include TAMC directives, tape key computations
and initialisations to make code TAMC compatible.
Routines the_model_main.F and initialise_fixed.F
are left unchanged for the moment. (P.H.)
1 heimbach 1.9 C $Header: /u/gcmpack/models/MITgcmUV/model/src/impldiff.F,v 1.8 1999/05/18 18:01:13 adcroft Exp $
2 adcroft 1.1
3 cnh 1.7 #include "CPP_OPTIONS.h"
4 adcroft 1.1
5     C /==========================================================\
6     C | S/R IMPLDIFF |
7 cnh 1.5 C | o Solve implicit diffusion equation for vertical |
8     C | diffusivity. |
9 adcroft 1.1 C \==========================================================/
10     SUBROUTINE IMPLDIFF( bi, bj, iMin, iMax, jMin, jMax,
11 adcroft 1.8 I deltaTX,KappaRX,recip_hFac,
12     U gXNm1,
13 adcroft 1.1 I myThid )
14 cnh 1.5 IMPLICIT NONE
15     C == Global data ==
16 adcroft 1.1 #include "SIZE.h"
17     #include "DYNVARS.h"
18 cnh 1.2 #include "EEPARAMS.h"
19 adcroft 1.1 #include "PARAMS.h"
20     #include "GRID.h"
21 cnh 1.5
22 heimbach 1.9 #ifdef ALLOW_AUTODIFF_TAMC
23     #include "tamc_keys.h"
24     #endif
25    
26 adcroft 1.1 C == Routine Arguments ==
27     INTEGER bi,bj,iMin,iMax,jMin,jMax
28 adcroft 1.8 _RL deltaTX
29     _RL KappaRX(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
30     _RS recip_hFac(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
31     _RL gXnm1(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
32 adcroft 1.1 INTEGER myThid
33 cnh 1.5
34 adcroft 1.1 C == Local variables ==
35     INTEGER i,j,k
36     _RL a(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
37     _RL b(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
38     _RL c(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
39     _RL ckm1(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
40     _RL bet(1-Olx:sNx+Olx,1-Oly:sNy+Oly)
41 cnh 1.6 _RL gam(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr)
42 adcroft 1.1
43 heimbach 1.9 #ifdef ALLOW_AUTODIFF_TAMC
44     INTEGER kkey
45     #endif
46    
47 cnh 1.6 IF (Nr.GT.1) THEN ! Only need do anything if Nr>1
48 cnh 1.5 C-- Beginning of forward sweep (top level)
49 adcroft 1.1 DO j=jMin,jMax
50     DO i=iMin,iMax
51 adcroft 1.8 c(i,j)=-deltaTX*recip_hFac(i,j,1,bi,bj)*recip_drF(1)
52     & *KappaRX(i,j,2)*recip_drC(2)
53 adcroft 1.1 b(i,j)=1.-c(i,j)
54     bet(i,j)=0.
55     IF (b(i,j).NE.0.) bet(i,j)=1. / b(i,j)
56     ENDDO
57     ENDDO
58     ENDIF
59 heimbach 1.9
60     #ifdef ALLOW_AUTODIFF_TAMC
61     CADJ store bet = comlev1_impl3d, key = idkey
62     CADJ store gXNm1 = comlev1_impl2d, key = idkey
63     #endif
64    
65     DO j=jMin,jMax
66     DO i=iMin,iMax
67     gXNm1(i,j,1,bi,bj) = gXNm1(i,j,1,bi,bj)*bet(i,j)
68     ENDDO
69     ENDDO
70    
71 cnh 1.5 C-- Middle of forward sweep
72 cnh 1.6 IF (Nr.GT.2) THEN
73     DO k=2,Nr-1
74 heimbach 1.9
75     #ifdef ALLOW_AUTODIFF_TAMC
76     kkey = (idkey-1)*(Nr-2) + k-1
77     #endif
78    
79 adcroft 1.1 DO j=jMin,jMax
80     DO i=iMin,iMax
81     ckm1(i,j)=c(i,j)
82 adcroft 1.8 a(i,j)=-deltaTX*recip_hFac(i,j,k,bi,bj)*recip_drF(k)
83     & *KappaRX(i,j, k )*recip_drC( k )
84     c(i,j)=-deltaTX*recip_hFac(i,j,k,bi,bj)*recip_drF(k)
85     & *KappaRX(i,j,k+1)*recip_drC(k+1)
86 adcroft 1.1 b(i,j)=1.-c(i,j)-a(i,j)
87     ENDDO
88     ENDDO
89 heimbach 1.9
90     #ifdef ALLOW_AUTODIFF_TAMC
91     CADJ store ckm1 = comlev1_impl3d, key = kkey
92     CADJ store bet = comlev1_impl3d, key = kkey
93     #endif
94    
95 adcroft 1.1 DO j=jMin,jMax
96     DO i=iMin,iMax
97     gam(i,j,k)=ckm1(i,j)*bet(i,j)
98     bet(i,j)=b(i,j)-a(i,j)*gam(i,j,k)
99     IF (bet(i,j).NE.0.) bet(i,j)=1. / bet(i,j)
100 heimbach 1.9 ENDDO
101     ENDDO
102    
103     #ifdef ALLOW_AUTODIFF_TAMC
104     CADJ store bet = comlev1_impl3d, key = kkey
105     CADJ store gXNm1(:,:,k-1:k,bi,bj) = comlev1_impl3d, key = kkey
106     #endif
107    
108     DO j=jMin,jMax
109     DO i=iMin,iMax
110 adcroft 1.8 gXnm1(i,j,k,bi,bj)=(gXnm1(i,j,k,bi,bj)
111     & -a(i,j)*gXnm1(i,j,k-1,bi,bj))*bet(i,j)
112 adcroft 1.1 ENDDO
113     ENDDO
114 heimbach 1.9
115 adcroft 1.1 ENDDO
116     ENDIF
117 cnh 1.6 IF (Nr.GT.1) THEN
118 cnh 1.5 C-- End of forward sweep (bottom level)
119 adcroft 1.1 DO j=jMin,jMax
120     DO i=iMin,iMax
121     ckm1(i,j)=c(i,j)
122 adcroft 1.8 a(i,j)=-deltaTX*recip_hFac(i,j,Nr,bi,bj)*recip_drF(Nr)
123     & *KappaRX(i,j, Nr )*recip_drC( Nr )
124 adcroft 1.1 b(i,j)=1.-a(i,j)
125     ENDDO
126     ENDDO
127 heimbach 1.9
128     #ifdef ALLOW_AUTODIFF_TAMC
129     CADJ store ckm1 = comlev1_impl2d, key = idkey
130     CADJ store a,b = comlev1_impl2d, key = idkey
131     CADJ store bet = comlev1_impl2d, key = idkey
132     #endif
133    
134 adcroft 1.1 DO j=jMin,jMax
135     DO i=iMin,iMax
136 cnh 1.6 gam(i,j,Nr)=ckm1(i,j)*bet(i,j)
137     bet(i,j)=b(i,j)-a(i,j)*gam(i,j,Nr)
138 adcroft 1.1 IF (bet(i,j).NE.0.) bet(i,j)=1. / bet(i,j)
139 heimbach 1.9 ENDDO
140     ENDDO
141    
142     #ifdef ALLOW_AUTODIFF_TAMC
143     CADJ store gXnm1 = comlev1_impl2d, key = idkey
144     #endif
145    
146     DO j=jMin,jMax
147     DO i=iMin,iMax
148 adcroft 1.8 gXnm1(i,j,Nr,bi,bj)=(gXnm1(i,j,Nr,bi,bj)
149     & -a(i,j)*gXnm1(i,j,Nr-1,bi,bj))*bet(i,j)
150 adcroft 1.1 ENDDO
151     ENDDO
152 heimbach 1.9
153     #ifdef ALLOW_AUTODIFF_TAMC
154     CADJ store gam = comlev1_impl2d, key = idkey
155     #endif
156    
157 cnh 1.5 C-- Backward sweep
158 cnh 1.6 DO k=Nr-1,1,-1
159 adcroft 1.1 DO j=jMin,jMax
160     DO i=iMin,iMax
161 adcroft 1.8 gXnm1(i,j,k,bi,bj)=gXnm1(i,j,k,bi,bj)
162     & -gam(i,j,k+1)*gXnm1(i,j,k+1,bi,bj)
163 adcroft 1.1 ENDDO
164     ENDDO
165     ENDDO
166     ENDIF
167    
168     RETURN
169     END
  ViewVC Help
Powered by ViewVC 1.1.22