/[MITgcm]/MITgcm/pkg/autodiff/active_file_loc_control.F
ViewVC logotype

Annotation of /MITgcm/pkg/autodiff/active_file_loc_control.F

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


Revision 1.5 - (hide annotations) (download)
Mon Feb 23 19:13:02 2004 UTC (20 years, 7 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint53f_post, checkpoint54a_pre, checkpoint55c_post, checkpoint57b_post, checkpoint53b_pre, checkpoint55e_post, checkpoint52l_pre, checkpoint52n_post, checkpoint53d_post, checkpoint57f_post, checkpoint57j_post, checkpoint53c_post, checkpoint57k_post, checkpoint55d_pre, checkpoint57d_post, checkpoint57g_post, checkpoint57c_pre, checkpoint55j_post, checkpoint56b_post, checkpoint57i_post, checkpoint54a_post, checkpoint52l_post, checkpoint55h_post, checkpoint52k_post, checkpoint57g_pre, checkpoint54b_post, checkpoint57e_post, checkpoint54d_post, checkpoint56c_post, checkpoint54e_post, checkpoint55b_post, checkpoint57h_post, checkpoint52m_post, checkpoint55, checkpoint53a_post, checkpoint57f_pre, checkpoint57a_post, checkpoint54, checkpoint54f_post, checkpoint53b_post, checkpoint55g_post, checkpoint55f_post, checkpoint57a_pre, checkpoint55i_post, checkpoint57, checkpoint56, checkpoint53, eckpoint57e_pre, checkpoint57h_done, checkpoint53g_post, hrcube5, checkpoint57c_post, checkpoint55a_post, checkpoint53d_pre, checkpoint54c_post, checkpoint57h_pre, checkpoint57l_post, checkpoint56a_post, checkpoint55d_post
Changes since 1.4: +6 -4 lines
o accuracy ctrlprec = 32 insuffient for gradient checks using
  averaged fields (I/O via cost_averages)
  -> use ctrl.h in active_file*.F to control I/O precision.

1 heimbach 1.2
2 edhill 1.3 #include "AUTODIFF_OPTIONS.h"
3 heimbach 1.2
4     c ==================================================================
5     c
6     c active_file_control_loc.F: Routines to handle the i/o of active vari-
7     c ables for the adjoint calculations. All
8     c files are direct access files.
9     c
10     c Routines:
11     c
12     c o active_read_rl_loc - Basic routine to handle active read
13     c operations.
14     c o active_write_rl_loc - Basic routine to handle active write
15     c operations.
16     c
17     c
18     c ==================================================================
19    
20     CBOP
21     C !ROUTINE: active_read_rl_loc
22     C !INTERFACE:
23     subroutine active_read_rl_loc(
24     I active_var_file,
25     O active_var,
26     I globalfile,
27     I lAdInit,
28     I irec,
29     I mynr,
30     I theSimulationMode,
31     I myOptimIter,
32     I mythid
33     & )
34    
35     C !DESCRIPTION: \bv
36     c ==================================================================
37     c o Read an active _RL variable from file.
38     c The variable *globalfile* can be used as a switch, which allows
39     c to read from a global file. The adjoint files are, however, always
40     c treated as tiled files.
41     c started: Christian Eckert eckert@mit.edu Jan-1999
42     c ==================================================================
43     C \ev
44    
45     C !USES:
46     implicit none
47    
48     c == global variables ==
49     #include "EEPARAMS.h"
50     #include "SIZE.h"
51     #include "PARAMS.h"
52 heimbach 1.5 #include "ctrl.h"
53 heimbach 1.2
54     C !INPUT/OUTPUT PARAMETERS:
55     c == routine arguments ==
56     c active_var_file: filename
57     c active_var: array
58     c irec: record number
59     c myOptimIter: number of optimization iteration (default: 0)
60     c mythid: thread number for this instance
61     c doglobalread: flag for global or local read/write
62     c (default: .false.)
63     c lAdInit: initialisation of corresponding adjoint
64     c variable and write to active file
65     c mynr: vertical array dimension
66     c theSimulationMode: forward mode or reverse mode simulation
67     character*(*) active_var_file
68     logical globalfile
69     logical lAdInit
70     integer irec
71     integer mynr
72     integer theSimulationMode
73     integer myOptimIter
74     integer mythid
75     _RL active_var(1-olx:snx+olx,1-oly:sny+oly,mynr,nsx,nsy)
76    
77     C !LOCAL VARIABLES:
78     c == local variables ==
79     character*(2) adpref
80     character*(80) adfname
81     integer bi,bj
82     integer i,j,k
83     integer oldprec
84     integer prec
85     integer il
86     integer ilnblnk
87     logical writeglobalfile
88     _RL active_data_t(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
89    
90     c == functions ==
91     external ilnblnk
92    
93     c == end of interface ==
94     CEOP
95    
96     c force 64-bit io
97     oldPrec = readBinaryPrec
98 heimbach 1.5 readBinaryPrec = ctrlprec
99     prec = ctrlprec
100 heimbach 1.2
101     write(adfname(1:80),'(80a)') ' '
102     adpref = 'ad'
103     il = ilnblnk( active_var_file )
104    
105     write(adfname(1:2),'(a)') adpref
106     write(adfname(3:il+2),'(a)') active_var_file(1:il)
107    
108     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
109     c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
110     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
111    
112     if (theSimulationMode .eq. FORWARD_SIMULATION) then
113    
114     _BEGIN_MASTER( mythid )
115    
116     c Read the active variable from file.
117    
118     call mdsreadfield_loc(
119     & active_var_file,
120     & prec,
121     & 'RL',
122     & mynr,
123     & active_var,
124     & irec,
125     & mythid )
126    
127     if (lAdInit) then
128     c Initialise the corresponding adjoint variable on the
129     c adjoint variable's file. These files are tiled.
130    
131     writeglobalfile = .false.
132     do bj = 1,nsy
133     do bi = 1,nsx
134     do j=1,sny
135     do i=1,snx
136     active_data_t(i,j,bi,bj)= 0. _d 0
137     enddo
138     enddo
139     enddo
140     enddo
141    
142     do k = 1,mynr
143     call mdswritefield_loc(
144     & adfname,
145     & prec,
146     & globalfile,
147     & 'RL',
148     & 1,
149     & active_data_t,
150     & (irec-1)*mynr+k,
151     & myOptimIter,
152     & mythid )
153     enddo
154     endif
155    
156     _END_MASTER( mythid )
157    
158     endif
159    
160     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
161     c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
162     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
163    
164     if (theSimulationMode .eq. REVERSE_SIMULATION) then
165    
166     _BEGIN_MASTER( mythid )
167    
168     writeglobalfile = .false.
169     do k=1,mynr
170     c Read data from file layer by layer.
171     call mdsreadfield_loc(
172     & active_var_file,
173     & prec,
174     & 'RL',
175     & 1,
176     & active_data_t,
177     & (irec-1)*mynr+k,
178     & mythid )
179    
180     c Add active_var from appropriate location to data.
181     do bj = 1,nsy
182     do bi = 1,nsx
183     do j=1,sny
184     do i=1,snx
185     active_data_t(i,j,bi,bj) = active_data_t(i,j,bi,bj) +
186     & active_var(i,j,k,bi,bj)
187     enddo
188     enddo
189     enddo
190     enddo
191    
192     c Store the result on disk.
193     call mdswritefield_loc(
194     & active_var_file,
195     & prec,
196     & writeglobalfile,
197     & 'RL',
198     & 1,
199     & active_data_t,
200     & (irec-1)*mynr+k,
201     & myOptimIter,
202     & mythid )
203     enddo
204    
205    
206     c Set active_var to zero.
207     do k=1,mynr
208     do bj = 1,nsy
209     do bi = 1,nsx
210     do j=1,sny
211     do i=1,snx
212     active_var(i,j,k,bi,bj) = 0. _d 0
213     enddo
214     enddo
215     enddo
216     enddo
217     enddo
218    
219     _END_MASTER( mythid )
220     endif
221    
222     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
223     c >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
224     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
225    
226     if (theSimulationMode .eq. TANGENT_SIMULATION) then
227    
228     _BEGIN_MASTER( mythid )
229    
230     c Read the active variable from file.
231    
232     call mdsreadfield_loc(
233     & active_var_file,
234     & prec,
235     & 'RL',
236     & mynr,
237     & active_var,
238     & irec,
239     & mythid )
240    
241     _END_MASTER( mythid )
242     endif
243    
244     c Reset default io precision.
245     readBinaryPrec = oldPrec
246    
247     _BARRIER
248    
249     return
250     end
251    
252    
253     CBOP
254     C !ROUTINE: active_write_rl_loc
255     C !INTERFACE:
256     subroutine active_write_rl_loc(
257     I active_var_file,
258     I active_var,
259     I globalfile,
260     I irec,
261     I mynr,
262     I theSimulationMode,
263     I myOptimIter,
264     I mythid
265     & )
266    
267     C !DESCRIPTION: \bv
268     c ==================================================================
269     c o Write an active _RL variable to a file.
270     c started: Christian Eckert eckert@mit.edu Jan-1999
271     c ==================================================================
272     C \ev
273    
274     C !USES:
275     implicit none
276    
277     c == global variables ==
278     #include "EEPARAMS.h"
279     #include "SIZE.h"
280     #include "PARAMS.h"
281 heimbach 1.5 #include "ctrl.h"
282 heimbach 1.2
283     C !INPUT/OUTPUT PARAMETERS:
284     c == routine arguments ==
285     c active_var_file: filename
286     c active_var: array
287     c irec: record number
288     c myOptimIter: number of optimization iteration (default: 0)
289     c mythid: thread number for this instance
290     c doglobalread: flag for global or local read/write
291     c (default: .false.)
292     c lAdInit: initialisation of corresponding adjoint
293     c variable and write to active file
294     c mynr: vertical array dimension
295     c theSimulationMode: forward mode or reverse mode simulation
296     character*(*) active_var_file
297     integer mynr
298     logical globalfile
299     integer irec
300     integer theSimulationMode
301     integer myOptimIter
302     integer mythid
303     _RL active_var(1-olx:snx+olx,1-oly:sny+oly,mynr,nsx,nsy)
304    
305     C !LOCAL VARIABLES:
306     c == local variables ==
307     integer i,j,k
308     integer bi,bj
309     _RL active_data_t(1-olx:snx+olx,1-oly:sny+oly,nsx,nsy)
310     integer oldprec
311     integer prec
312    
313     c == end of interface ==
314     CEOP
315    
316     c force 64-bit io
317     oldPrec = readBinaryPrec
318 heimbach 1.5 readBinaryPrec = ctrlprec
319     prec = ctrlprec
320 heimbach 1.2
321     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
322     c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
323     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
324    
325     if (theSimulationMode .eq. FORWARD_SIMULATION) then
326    
327     _BEGIN_MASTER( mythid )
328    
329     call mdswritefield_loc(
330     & active_var_file,
331     & prec,
332     & globalfile,
333     & 'RL',
334     & mynr,
335     & active_var,
336     & irec,
337     & myOptimIter,
338     & mythid )
339    
340     _END_MASTER( mythid )
341    
342     endif
343    
344     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
345     c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
346     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
347    
348     if (theSimulationMode .eq. REVERSE_SIMULATION) then
349    
350     _BEGIN_MASTER( mythid )
351    
352     do k=1,mynr
353     c Read data from file layer by layer.
354     call mdsreadfield_loc(
355     & active_var_file,
356     & prec,
357     & 'RL',
358     & 1,
359     & active_data_t,
360     & (irec-1)*mynr+k,
361     & mythid )
362    
363     c Add active_var from appropriate location to data.
364     do bj = 1,nsy
365     do bi = 1,nsx
366     do j=1,sny
367     do i=1,snx
368     active_var(i,j,k,bi,bj) =
369     & active_var(i,j,k,bi,bj) +
370     & active_data_t(i,j,bi,bj)
371     active_data_t(i,j,bi,bj) = 0. _d 0
372     enddo
373     enddo
374     enddo
375     enddo
376     call mdswritefield_loc(
377     & active_var_file,
378     & prec,
379     & globalfile,
380     & 'RL',
381     & 1,
382     & active_data_t,
383     & (irec-1)*mynr+k,
384     & myOptimIter,
385     & mythid )
386     enddo
387    
388     _END_MASTER( mythid )
389    
390     endif
391    
392     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
393     c >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
394     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
395    
396     if (theSimulationMode .eq. TANGENT_SIMULATION) then
397    
398     _BEGIN_MASTER( mythid )
399    
400     call mdswritefield_loc(
401     & active_var_file,
402     & prec,
403     & globalfile,
404     & 'RL',
405     & mynr,
406     & active_var,
407     & irec,
408     & myOptimIter,
409     & mythid )
410    
411     _END_MASTER( mythid )
412    
413     endif
414    
415     c Reset default io precision.
416     readBinaryPrec = oldPrec
417    
418     _BARRIER
419    
420     return
421     end
422    

  ViewVC Help
Powered by ViewVC 1.1.22