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 |