/[MITgcm]/MITgcm_contrib/gael/pkg/smooth2/smooth_diff3D.F
ViewVC logotype

Annotation of /MITgcm_contrib/gael/pkg/smooth2/smooth_diff3D.F

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


Revision 1.2 - (hide annotations) (download)
Fri Nov 13 19:52:32 2009 UTC (15 years, 8 months ago) by jmc
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +13 -13 lines
remove/replace tab

1 jmc 1.2 C $Header: /u/gcmpack/MITgcm_contrib/gael/pkg/smooth2/smooth_diff3D.F,v 1.1 2009/10/25 21:24:03 gforget Exp $
2 gforget 1.1 C $Name: $
3    
4     #include "CPP_OPTIONS.h"
5    
6     subroutine smooth_diff3D (fld_in,nbt_in,mythid)
7    
8     C *==========================================================*
9     C | SUBROUTINE smooth_diff3D
10     C | o Routine that smoothes a 3D field, using diffusion
11     C *==========================================================*
12    
13     IMPLICIT NONE
14     #include "EEPARAMS.h"
15     #include "SIZE.h"
16     #include "PARAMS.h"
17     #include "GRID.h"
18     #include "DYNVARS.h"
19     #include "FFIELDS.h"
20     c#include "ctrl.h"
21     c#include "ctrl_dummy.h"
22     c#include "optim.h"
23     #ifdef ALLOW_AUTODIFF_TAMC
24     #include "tamc.h"
25     #include "tamc_keys.h"
26     #endif /* ALLOW_AUTODIFF_TAMC */
27     #include "smooth.h"
28    
29 jmc 1.2 integer i,j,k, bi,bj, iMin,iMax,jMin,jMax
30 gforget 1.1 integer itlo,ithi, jtlo,jthi
31     integer myThid, myIter(nSx,nSy)
32     integer mykkey, smoothkey
33     _RL fld_in(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
34     _RL fld_tmp(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
35     _RL gT_in(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
36     _RL gTm1_in(1-Olx:sNx+Olx,1-Oly:sNy+Oly,Nr,nSx,nSy)
37     integer nbt_in
38     integer ii, jj, kk
39     integer iloop, ilev_1, ilev_2, ilev_3
40     integer max_lev2, max_lev3, key_in
41     _RL dTtracerLev_bak(nr)
42    
43     c for now: useless, because level 3 is recomputed anyway
44     c but : if level3 was computed during the fwd loop by callung
45 jmc 1.2 c mdsmooth_diff3D (assumes that it would be called
46     c directly by the_main_loop) then I would need to pass key_in
47     c as a parameter, with different values for T, S, ...
48     c in order not to overwrite the same tape
49 gforget 1.1 key_in=0
50    
51     jtlo = mybylo(mythid)
52     jthi = mybyhi(mythid)
53     itlo = mybxlo(mythid)
54     ithi = mybxhi(mythid)
55    
56     DO bj=jtlo,jthi
57     DO bi=itlo,ithi
58     DO k=1,Nr
59     DO j=1,sNy
60     DO i=1,sNx
61     gT_in(i,j,k,bi,bj) = 0. _d 0
62     gTm1_in(i,j,k,bi,bj) = 0. _d 0
63     ENDDO
64     ENDDO
65     ENDDO
66     ENDDO
67     ENDDO
68    
69     _EXCH_XYZ_RL ( fld_in , myThid )
70     _EXCH_XYZ_RL ( gt_in , myThid )
71     _EXCH_XYZ_RL ( gtm1_in , myThid )
72    
73     #ifdef ALLOW_TAMC_CHECKPOINTING
74    
75     c checkpointing:
76     max_lev3=nbt_in/(nchklev_1*nchklev_2)+1
77     max_lev2=nbt_in/nchklev_1+1
78     #ifdef ALLOW_AUTODIFF_TAMC
79     CADJ INIT tape_smooth_lev3 = USER
80     #endif /* ALLOW_AUTODIFF_TAMC */
81     do ilev_3 = 1,nchklev_3
82     if(ilev_3.le.max_lev3) then
83     #ifdef ALLOW_AUTODIFF_TAMC
84     CADJ STORE fld_in = tape_smooth_lev3 ,
85     CADJ & key = key_in*max_lev3 + ilev_3
86     CADJ STORE gTm1_in = tape_smooth_lev3 ,
87     CADJ & key = key_in*max_lev3 + ilev_3
88     #endif /* ALLOW_AUTODIFF_TAMC */
89     #ifdef ALLOW_AUTODIFF_TAMC
90     CADJ INIT tape_smooth_lev2 = USER
91     #endif /* ALLOW_AUTODIFF_TAMC */
92     do ilev_2 = 1,nchklev_2
93     if(ilev_2.le.max_lev2) then
94     #ifdef ALLOW_AUTODIFF_TAMC
95 jmc 1.2 CADJ STORE fld_in = tape_smooth_lev2 ,
96 gforget 1.1 CADJ & key = key_in*nchklev_2 + ilev_2
97 jmc 1.2 CADJ STORE gTm1_in = tape_smooth_lev2 ,
98 gforget 1.1 CADJ & key = key_in*nchklev_2 + ilev_2
99     #endif /* ALLOW_AUTODIFF_TAMC */
100     #ifdef ALLOW_AUTODIFF_TAMC
101     CADJ INIT tape_smooth_lev1 = COMMON,
102     CADJ & nchklev_1*nsx*nsy*nthreads_chkpt
103     #endif /* ALLOW_AUTODIFF_TAMC */
104     do ilev_1 = 1,nchklev_1
105     iloop = (ilev_2 - 1)*nchklev_1 + ilev_1
106     & + (ilev_3 - 1)*nchklev_2*nchklev_1
107     if ( iloop .le. nbt_in ) then
108    
109     #ifdef ALLOW_AUTODIFF_TAMC
110 jmc 1.2 CADJ STORE gTm1_in(:,:,:,bi,bj) = tape_smooth_lev1 ,
111 gforget 1.1 CADJ & key = key_in*nchklev_1 + ilev_1
112     #endif /* ALLOW_AUTODIFF_TAMC */
113    
114    
115     #else /* ALLOW_TAMC_CHECKPOINTING */
116     do iloop=1,nbt_in
117     #endif
118    
119     DO bj=jtlo,jthi
120     DO bi=itlo,ithi
121     DO k=1,Nr
122     DO j=1,sNy
123     DO i=1,sNx
124     gT_in(i,j,k,bi,bj) = 0. _d 0
125     ENDDO
126     ENDDO
127     ENDDO
128     ENDDO
129     ENDDO
130    
131     _EXCH_XYZ_RL ( gt_in , myThid )
132    
133     c compute gT_in:
134     CALL smooth_rhs( fld_in, gT_in, myThid )
135    
136     DO bj=jtlo,jthi
137     DO bi=itlo,ithi
138     c adams bashfort on gT_in:
139     myIter(bi,bj)=iloop-1
140     DO k=1,Nr
141     CALL ADAMS_BASHFORTH2(
142     & bi, bj, k,
143     & gT_in, gTm1_in,
144     & myIter(bi,bj) , myThid )
145     ENDDO
146 jmc 1.2 c time stepping:
147 gforget 1.1 DO k=1,Nr
148     DO j=1-OLy,sNy+OLy
149     DO i=1-OLx,sNx+OLx
150     fld_in(i,j,k,bi,bj)=fld_in(i,j,k,bi,bj)
151     & +smooth3DdelTime*gT_in(i,j,k,bi,bj)
152     gT_in(i,j,k,bi,bj)=0
153     ENDDO
154     ENDDO
155     ENDDO
156    
157     #ifdef ALLOW_AUTODIFF_TAMC
158     CADJ STORE fld_in(:,:,:,bi,bj) = tape_smooth_lev1,
159     CADJ & key = key_in*nchklev_1 + ilev_1
160     #endif /* ALLOW_AUTODIFF_TAMC */
161    
162     if ( smooth3DdoImpldiff ) then
163     CALL SMOOTH_IMPLDIFF(
164     I bi, bj, 1, sNx, 1, sNy ,
165     I smooth3DdelTime, smooth3D_kappaR(1-OLx,1-OLy,1,bi,bj),
166     I recip_hFacC,
167     U fld_in,
168     I myThid )
169     endif
170    
171     ENDDO
172     ENDDO
173    
174     _EXCH_XYZ_RL ( fld_in , myThid )
175     _EXCH_XYZ_RL ( gt_in , myThid )
176     _EXCH_XYZ_RL ( gtm1_in , myThid )
177    
178     #ifdef ALLOW_TAMC_CHECKPOINTING
179     endif
180     enddo
181     endif
182     enddo
183     endif
184     enddo
185     #else /* ALLOW_TAMC_CHECKPOINTING */
186 jmc 1.2 enddo
187     #endif
188 gforget 1.1
189 jmc 1.2 END

  ViewVC Help
Powered by ViewVC 1.1.22