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

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

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


Revision 1.2 - (hide annotations) (download)
Fri Oct 16 03:36:34 2009 UTC (15 years, 9 months ago) by gforget
Branch: MAIN
CVS Tags: HEAD
Changes since 1.1: +7 -7 lines
bring pkg/smooth up to date

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

  ViewVC Help
Powered by ViewVC 1.1.22