1 |
gforget |
1.12 |
C $Header: /u/gcmpack/MITgcm/pkg/ctrl/ctrl_map_ini_gentim2d.F,v 1.11 2015/09/02 06:01:10 mmazloff Exp $ |
2 |
gforget |
1.1 |
C $Name: $ |
3 |
|
|
|
4 |
|
|
#include "CTRL_OPTIONS.h" |
5 |
gforget |
1.3 |
#ifdef ALLOW_AUTODIFF |
6 |
|
|
# include "AUTODIFF_OPTIONS.h" |
7 |
|
|
#endif |
8 |
gforget |
1.1 |
|
9 |
|
|
CBOP |
10 |
|
|
C !ROUTINE: CTRL_MAP_INI_GENTIM2D |
11 |
|
|
C !INTERFACE: |
12 |
|
|
SUBROUTINE CTRL_MAP_INI_GENTIM2D( myThid ) |
13 |
|
|
|
14 |
|
|
C !DESCRIPTION: \bv |
15 |
|
|
C *================================================================= |
16 |
|
|
C | SUBROUTINE CTRL_MAP_INI_GENTIM2D |
17 |
|
|
C | Dimensionalize and preprocess time variable controls. |
18 |
|
|
C *================================================================= |
19 |
|
|
C \ev |
20 |
|
|
|
21 |
|
|
C !USES: |
22 |
|
|
IMPLICIT NONE |
23 |
|
|
|
24 |
|
|
C == global variables == |
25 |
|
|
#include "SIZE.h" |
26 |
|
|
#include "EEPARAMS.h" |
27 |
|
|
#include "PARAMS.h" |
28 |
|
|
#include "GRID.h" |
29 |
|
|
#include "DYNVARS.h" |
30 |
|
|
#include "FFIELDS.h" |
31 |
|
|
#include "CTRL_SIZE.h" |
32 |
|
|
#include "ctrl.h" |
33 |
|
|
#include "optim.h" |
34 |
|
|
#include "ctrl_dummy.h" |
35 |
|
|
#include "CTRL_GENARR.h" |
36 |
|
|
#ifdef ALLOW_PTRACERS |
37 |
|
|
# include "PTRACERS_SIZE.h" |
38 |
|
|
# include "PTRACERS_FIELDS.h" |
39 |
|
|
#endif |
40 |
gforget |
1.3 |
#ifdef ALLOW_AUTODIFF |
41 |
|
|
#include "tamc.h" |
42 |
|
|
#endif |
43 |
gforget |
1.1 |
|
44 |
|
|
C !INPUT/OUTPUT PARAMETERS: |
45 |
|
|
C == routine arguments == |
46 |
|
|
INTEGER myThid |
47 |
|
|
|
48 |
|
|
#ifdef ALLOW_GENTIM2D_CONTROL |
49 |
|
|
C !LOCAL VARIABLES: |
50 |
|
|
C == local variables == |
51 |
|
|
integer iarr |
52 |
gforget |
1.10 |
integer numsmo |
53 |
gforget |
1.1 |
character*(80) fnamegenIn |
54 |
|
|
character*(80) fnamegenOut |
55 |
gforget |
1.8 |
character*(80) fnamegenTmp |
56 |
heimbach |
1.5 |
character*(80) fnamebase |
57 |
gforget |
1.1 |
integer startrec |
58 |
|
|
integer endrec |
59 |
|
|
integer diffrec |
60 |
|
|
integer irec, jrec, krec |
61 |
|
|
integer replicated_nrec |
62 |
|
|
integer replicated_ntimes |
63 |
|
|
logical doglobalread |
64 |
|
|
logical ladinit |
65 |
gforget |
1.10 |
logical dowc01 |
66 |
|
|
logical dosmooth |
67 |
gforget |
1.1 |
_RL xx_gen(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
68 |
gforget |
1.8 |
#ifdef ALLOW_ECCO |
69 |
|
|
_RL xx_gen_tmp(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy) |
70 |
|
|
integer nyearsINT |
71 |
|
|
_RL nyearsRL |
72 |
|
|
#endif |
73 |
gforget |
1.1 |
integer bi,bj |
74 |
|
|
integer i,j,k2 |
75 |
|
|
INTEGER ILNBLNK |
76 |
|
|
EXTERNAL ILNBLNK |
77 |
|
|
integer ilgen |
78 |
|
|
CEOP |
79 |
|
|
|
80 |
|
|
c-- Now, read the control vector. |
81 |
|
|
doglobalread = .false. |
82 |
|
|
ladinit = .false. |
83 |
|
|
|
84 |
|
|
C-- generic 2D control variables |
85 |
|
|
DO iarr = 1, maxCtrlTim2D |
86 |
|
|
|
87 |
gforget |
1.3 |
diffrec=0 |
88 |
|
|
startrec=0 |
89 |
|
|
endrec=0 |
90 |
|
|
|
91 |
heimbach |
1.5 |
#ifndef ALLOW_OPENAD |
92 |
gforget |
1.1 |
if (xx_gentim2d_weight(iarr).NE.' ') then |
93 |
heimbach |
1.5 |
#endif |
94 |
gforget |
1.1 |
|
95 |
heimbach |
1.5 |
fnamebase = xx_gentim2d_file(iarr) |
96 |
|
|
call ctrl_init_rec ( fnamebase, |
97 |
gforget |
1.1 |
I xx_gentim2d_startdate1(iarr), |
98 |
|
|
I xx_gentim2d_startdate2(iarr), |
99 |
|
|
I xx_gentim2d_period(iarr), |
100 |
|
|
I 1, |
101 |
|
|
O xx_gentim2d_startdate(1,iarr), |
102 |
|
|
O diffrec, startrec, endrec, |
103 |
|
|
I myThid ) |
104 |
|
|
|
105 |
gforget |
1.10 |
dosmooth=.false. |
106 |
|
|
dowc01 = .false. |
107 |
|
|
if (ctrlSmoothCorrel2D) dowc01=.TRUE. |
108 |
|
|
|
109 |
|
|
numsmo=1 |
110 |
gforget |
1.1 |
do k2 = 1, maxCtrlProc |
111 |
gforget |
1.10 |
if (xx_gentim2d_preproc(k2,iarr).EQ.'WC01') then |
112 |
|
|
dowc01=.TRUE. |
113 |
|
|
if (xx_gentim2d_preproc_i(k2,iarr).NE.0) |
114 |
|
|
& numsmo=xx_gentim2d_preproc_i(k2,iarr) |
115 |
|
|
endif |
116 |
|
|
if ((.NOT.dowc01).AND. |
117 |
|
|
& (xx_gentim2d_preproc(k2,iarr).EQ.'smooth')) then |
118 |
|
|
dosmooth=.TRUE. |
119 |
|
|
if (xx_gentim2d_preproc_i(k2,iarr).NE.0) |
120 |
|
|
& numsmo=xx_gentim2d_preproc_i(k2,iarr) |
121 |
gforget |
1.1 |
endif |
122 |
|
|
enddo |
123 |
|
|
|
124 |
gforget |
1.8 |
fnamebase = xx_gentim2d_file(iarr) |
125 |
|
|
ilgen=ilnblnk( fnamebase ) |
126 |
|
|
write(fnamegenIn(1:80),'(2a,i10.10)') |
127 |
|
|
& fnamebase(1:ilgen),'.',optimcycle |
128 |
|
|
write(fnamegenOut(1:80),'(2a,i10.10)') |
129 |
|
|
& fnamebase(1:ilgen),'.effective.',optimcycle |
130 |
|
|
write(fnamegenTmp(1:80),'(2a,i10.10)') |
131 |
|
|
& fnamebase(1:ilgen),'.tmp.',optimcycle |
132 |
|
|
|
133 |
gforget |
1.9 |
c-- docycle |
134 |
gforget |
1.8 |
|
135 |
gforget |
1.1 |
replicated_nrec=endrec |
136 |
|
|
replicated_ntimes=0 |
137 |
|
|
do k2 = 1, maxCtrlProc |
138 |
gforget |
1.9 |
if (xx_gentim2d_preproc(k2,iarr).EQ.'docycle') then |
139 |
gforget |
1.1 |
if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then |
140 |
|
|
replicated_nrec=min(endrec,xx_gentim2d_preproc_i(k2,iarr)) |
141 |
|
|
replicated_ntimes= |
142 |
|
|
& int(float(endrec)/float(replicated_nrec)) |
143 |
|
|
if (replicated_ntimes*replicated_nrec.LT.endrec) |
144 |
|
|
& replicated_ntimes=replicated_ntimes+1 |
145 |
|
|
if (replicated_ntimes*replicated_nrec.GT.endrec) |
146 |
|
|
& replicated_ntimes=replicated_ntimes-1 |
147 |
|
|
endif |
148 |
|
|
endif |
149 |
|
|
enddo |
150 |
|
|
|
151 |
gforget |
1.7 |
DO jrec = 1, replicated_ntimes+1 |
152 |
gforget |
1.1 |
DO irec = 1, replicated_nrec |
153 |
gforget |
1.3 |
#ifdef ALLOW_AUTODIFF |
154 |
|
|
CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte |
155 |
|
|
#endif |
156 |
gforget |
1.7 |
krec=replicated_nrec*(jrec-1)+irec |
157 |
|
|
IF (krec.LE.endrec) THEN |
158 |
|
|
#ifdef ALLOW_AUTODIFF |
159 |
|
|
call active_read_xy( fnamegenIn, xx_gen, irec, |
160 |
|
|
& doglobalread, ladinit, optimcycle, |
161 |
|
|
& mythid, xx_gentim2d_dummy(iarr) ) |
162 |
|
|
#else |
163 |
|
|
CALL READ_REC_XY_RL( fnamegenIn, xx_gen, iRec, 1, myThid ) |
164 |
|
|
#endif |
165 |
|
|
#ifdef ALLOW_AUTODIFF |
166 |
|
|
call active_write_xy( fnamegenOut, xx_gen, krec, optimcycle, |
167 |
|
|
& mythid, xx_gentim2d_dummy(iarr) ) |
168 |
|
|
#else |
169 |
|
|
CALL WRITE_REC_XY_RL( fnamegenOut, xx_gen, iRec, 1, myThid ) |
170 |
|
|
#endif |
171 |
|
|
ENDIF |
172 |
|
|
ENDDO |
173 |
|
|
ENDDO |
174 |
|
|
|
175 |
gforget |
1.8 |
c-- rmcycle |
176 |
|
|
#ifdef ALLOW_ECCO |
177 |
|
|
replicated_nrec=endrec |
178 |
|
|
replicated_ntimes=0 |
179 |
|
|
do k2 = 1, maxCtrlProc |
180 |
|
|
if (xx_gentim2d_preproc(k2,iarr).EQ.'rmcycle') then |
181 |
|
|
if (xx_gentim2d_preproc_i(k2,iarr).NE.0) then |
182 |
|
|
replicated_nrec=min(endrec,xx_gentim2d_preproc_i(k2,iarr)) |
183 |
|
|
replicated_ntimes= |
184 |
|
|
& int(float(endrec)/float(replicated_nrec)) |
185 |
|
|
if (replicated_ntimes*replicated_nrec.LT.endrec) |
186 |
|
|
& replicated_ntimes=replicated_ntimes+1 |
187 |
|
|
if (replicated_ntimes*replicated_nrec.GT.endrec) |
188 |
|
|
& replicated_ntimes=replicated_ntimes-1 |
189 |
|
|
endif |
190 |
|
|
endif |
191 |
|
|
enddo |
192 |
|
|
|
193 |
gforget |
1.12 |
c print*,'endrec',endrec,replicated_ntimes,replicated_nrec |
194 |
gforget |
1.8 |
|
195 |
|
|
IF (replicated_ntimes.GT.0) THEN |
196 |
|
|
|
197 |
|
|
c create cyclic average |
198 |
|
|
|
199 |
|
|
nyearsINT=1+int((endrec-replicated_nrec)/replicated_nrec) |
200 |
|
|
nyearsRL=float(nyearsINT) |
201 |
|
|
|
202 |
gforget |
1.12 |
c print*,'nyearsINT',nyearsINT,nyearsRL |
203 |
gforget |
1.8 |
|
204 |
|
|
DO irec = 1, replicated_nrec |
205 |
|
|
|
206 |
|
|
call ecco_zero(xx_gen,1,zeroRL,myThid) |
207 |
|
|
|
208 |
|
|
do jrec=1,nyearsINT |
209 |
|
|
#ifdef ALLOW_AUTODIFF |
210 |
|
|
CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte |
211 |
|
|
#endif |
212 |
|
|
krec=irec+(jrec-1)*replicated_nrec |
213 |
|
|
#ifdef ALLOW_AUTODIFF |
214 |
|
|
call active_read_xy( fnamegenOut, xx_gen_tmp, krec, |
215 |
|
|
& doglobalread, ladinit, optimcycle, |
216 |
|
|
& mythid, xx_gentim2d_dummy(iarr) ) |
217 |
|
|
#else |
218 |
mmazloff |
1.11 |
CALL READ_REC_XY_RL( fnamegenOut, xx_gen_tmp, krec, |
219 |
|
|
& 1, myThid ) |
220 |
gforget |
1.8 |
#endif |
221 |
|
|
call ecco_add(xx_gen_tmp,1,xx_gen,1,myThid) |
222 |
|
|
enddo |
223 |
|
|
|
224 |
|
|
call ecco_div(xx_gen,1,nyearsRL,myThid) |
225 |
|
|
|
226 |
|
|
#ifdef ALLOW_AUTODIFF |
227 |
|
|
CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte |
228 |
|
|
#endif |
229 |
|
|
|
230 |
|
|
#ifdef ALLOW_AUTODIFF |
231 |
|
|
call active_write_xy( fnamegenTmp, xx_gen, iRec, optimcycle, |
232 |
|
|
& mythid, xx_gentim2d_dummy(iarr) ) |
233 |
|
|
#else |
234 |
|
|
CALL WRITE_REC_XY_RL( fnamegenTmp, xx_gen, iRec, 1, myThid ) |
235 |
|
|
#endif |
236 |
|
|
|
237 |
|
|
ENDDO |
238 |
|
|
|
239 |
|
|
c subtract cyclic average |
240 |
|
|
DO jrec = 1, replicated_ntimes+1 |
241 |
|
|
DO irec = 1, replicated_nrec |
242 |
|
|
#ifdef ALLOW_AUTODIFF |
243 |
|
|
CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte |
244 |
|
|
#endif |
245 |
|
|
krec=replicated_nrec*(jrec-1)+irec |
246 |
|
|
IF (krec.LE.endrec) THEN |
247 |
|
|
#ifdef ALLOW_AUTODIFF |
248 |
|
|
CALL active_read_xy( fnamegenOut, xx_gen, kRec, |
249 |
|
|
& doglobalread, ladinit, optimcycle, |
250 |
|
|
& mythid, xx_gentim2d_dummy(iarr) ) |
251 |
|
|
#else |
252 |
|
|
CALL READ_REC_XY_RL( fnamegenOut, xx_gen, kRec, 1, myThid ) |
253 |
|
|
#endif |
254 |
|
|
#ifdef ALLOW_AUTODIFF |
255 |
|
|
CALL active_read_xy( fnamegenTmp, xx_gen_tmp, iRec, |
256 |
|
|
& doglobalread, ladinit, optimcycle, |
257 |
|
|
& mythid, xx_gentim2d_dummy(iarr) ) |
258 |
|
|
#else |
259 |
|
|
CALL READ_REC_XY_RL( fnamegenTmp, xx_gen_tmp, iRec, 1, myThid ) |
260 |
|
|
#endif |
261 |
|
|
CALL ecco_subtract(xx_gen_tmp,1,xx_gen,1,myThid) |
262 |
|
|
#ifdef ALLOW_AUTODIFF |
263 |
|
|
CALL active_write_xy( fnamegenOut, xx_gen, kRec, optimcycle, |
264 |
|
|
& mythid, xx_gentim2d_dummy(iarr) ) |
265 |
|
|
#else |
266 |
|
|
CALL WRITE_REC_XY_RL( fnamegenOut, xx_gen, kRec, 1, myThid ) |
267 |
|
|
#endif |
268 |
|
|
ENDIF |
269 |
|
|
ENDDO |
270 |
|
|
ENDDO |
271 |
|
|
|
272 |
|
|
ENDIF |
273 |
|
|
#endif /* ifdef ALLOW_ECCO */ |
274 |
|
|
|
275 |
|
|
c-- scaling and smoothing |
276 |
gforget |
1.7 |
|
277 |
|
|
DO irec = 1, endrec |
278 |
|
|
#ifdef ALLOW_AUTODIFF |
279 |
|
|
CADJ STORE xx_gentim2d_dummy = ctrltape, key = 1 , kind = isbyte |
280 |
|
|
#endif |
281 |
gforget |
1.1 |
|
282 |
gforget |
1.6 |
#ifdef ALLOW_AUTODIFF |
283 |
gforget |
1.8 |
call active_read_xy( fnamegenOut, xx_gen, irec, |
284 |
gforget |
1.1 |
& doglobalread, ladinit, optimcycle, |
285 |
|
|
& mythid, xx_gentim2d_dummy(iarr) ) |
286 |
gforget |
1.6 |
#else |
287 |
gforget |
1.10 |
CALL READ_REC_XY_RL( fnamegenOut, xx_gen, iRec, 1, myThid ) |
288 |
gforget |
1.6 |
#endif |
289 |
gforget |
1.1 |
|
290 |
heimbach |
1.5 |
#ifndef ALLOW_OPENAD |
291 |
gforget |
1.10 |
jrec=1 |
292 |
|
|
do k2 = 1, maxCtrlProc |
293 |
|
|
if (xx_gentim2d_preproc(k2,iarr).EQ.'variaweight') jrec=irec |
294 |
|
|
enddo |
295 |
|
|
call mdsreadfield( xx_gentim2d_weight(iarr), ctrlprec, 'RL', |
296 |
gforget |
1.7 |
& 1, wgentim2d(1-Olx,1-Oly,1,1,iarr), jrec, myThid ) |
297 |
gforget |
1.1 |
|
298 |
|
|
#ifdef ALLOW_SMOOTH |
299 |
gforget |
1.10 |
IF (useSMOOTH) THEN |
300 |
|
|
IF (dowc01) call smooth_correl2D(xx_gen,maskC,numsmo,mythid) |
301 |
|
|
IF (dosmooth) call smooth2d(xx_gen,maskC,numsmo,mythid) |
302 |
|
|
ENDIF |
303 |
|
|
#endif /* ALLOW_SMOOTH */ |
304 |
|
|
|
305 |
|
|
DO bj=myByLo(myThid), myByHi(myThid) |
306 |
|
|
DO bi=myBxLo(myThid), myBxHi(myThid) |
307 |
|
|
DO j = 1,sNy |
308 |
|
|
DO i = 1,sNx |
309 |
|
|
if ((maskC(i,j,1,bi,bj).NE.0.).AND. |
310 |
gforget |
1.1 |
& (wgentim2d(i,j,bi,bj,iarr).GT.0.)) then |
311 |
|
|
xx_gen(i,j,bi,bj)=xx_gen(i,j,bi,bj) |
312 |
|
|
& /sqrt(wgentim2d(i,j,bi,bj,iarr)) |
313 |
gforget |
1.10 |
else |
314 |
gforget |
1.1 |
xx_gen(i,j,bi,bj)=0. _d 0 |
315 |
gforget |
1.10 |
endif |
316 |
gforget |
1.1 |
ENDDO |
317 |
|
|
ENDDO |
318 |
gforget |
1.10 |
ENDDO |
319 |
|
|
ENDDO |
320 |
|
|
#endif /* ALLOW_OPENAD */ |
321 |
gforget |
1.1 |
|
322 |
gforget |
1.10 |
CALL CTRL_BOUND_2D(xx_gen,maskC, |
323 |
|
|
& xx_gentim2d_bounds(1,iarr),myThid) |
324 |
gforget |
1.1 |
|
325 |
gforget |
1.10 |
CALL EXCH_XY_RL ( xx_gen , myThid ) |
326 |
gforget |
1.6 |
|
327 |
|
|
#ifdef ALLOW_AUTODIFF |
328 |
gforget |
1.1 |
call active_write_xy( fnamegenOut, xx_gen, irec, optimcycle, |
329 |
|
|
& mythid, xx_gentim2d_dummy(iarr) ) |
330 |
gforget |
1.6 |
#else |
331 |
|
|
CALL WRITE_REC_XY_RL( fnamegenOut, xx_gen, iRec, 1, myThid ) |
332 |
|
|
#endif |
333 |
gforget |
1.1 |
|
334 |
|
|
c-- end irec loop |
335 |
|
|
ENDDO |
336 |
|
|
|
337 |
heimbach |
1.5 |
#ifndef ALLOW_OPENAD |
338 |
gforget |
1.1 |
endif |
339 |
heimbach |
1.5 |
#endif |
340 |
gforget |
1.1 |
|
341 |
|
|
c-- end iarr loop |
342 |
|
|
ENDDO |
343 |
|
|
|
344 |
|
|
#endif /* ALLOW_GENTIM2D_CONTROL */ |
345 |
|
|
|
346 |
|
|
RETURN |
347 |
|
|
END |
348 |
|
|
|