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

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

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


Revision 1.7 - (hide annotations) (download)
Mon Feb 23 19:13:02 2004 UTC (20 years, 3 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint52l_pre, hrcube5, checkpoint57g_pre, checkpoint57b_post, checkpoint57g_post, checkpoint56b_post, checkpoint54d_post, checkpoint54e_post, checkpoint57d_post, checkpoint57i_post, checkpoint52l_post, checkpoint52k_post, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint53, checkpoint54f_post, checkpoint55i_post, checkpoint57l_post, checkpoint55c_post, checkpoint57f_post, checkpoint53d_post, checkpoint57a_post, checkpoint57h_pre, checkpoint54b_post, checkpoint57h_post, checkpoint52m_post, checkpoint55g_post, checkpoint57c_post, checkpoint55d_post, checkpoint54a_pre, checkpoint53c_post, checkpoint55d_pre, checkpoint57c_pre, checkpoint55j_post, checkpoint54a_post, checkpoint55h_post, checkpoint57e_post, checkpoint55b_post, checkpoint53a_post, checkpoint55f_post, checkpoint53g_post, eckpoint57e_pre, checkpoint56a_post, checkpoint53f_post, checkpoint57h_done, checkpoint57j_post, checkpoint57f_pre, checkpoint52n_post, checkpoint53b_pre, checkpoint56c_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57k_post, checkpoint53b_post, checkpoint53d_pre, checkpoint55e_post, checkpoint54c_post
Changes since 1.6: +12 -8 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.3
2 edhill 1.5 #include "AUTODIFF_OPTIONS.h"
3 heimbach 1.3
4     c ==================================================================
5     c
6     c active_file_control.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_xz_rl - Basic routine to handle active read
13     c operations.
14     c o active_write_xz_rl - Basic routine to handle active write
15     c operations.
16     c o active_read_yz_rl - Basic routine to handle active read
17     c operations.
18     c o active_write_yz_rl - Basic routine to handle active write
19     c operations.
20     c
21     c ==================================================================
22    
23    
24     subroutine active_read_xz_rl(
25     I active_var_file,
26     O active_var,
27     I globalfile,
28     I lAdInit,
29     I irec,
30     I mynr,
31     I theSimulationMode,
32     I myOptimIter,
33     I mythid
34     & )
35    
36     c ==================================================================
37     c SUBROUTINE active_read_xz_rl
38     c ==================================================================
39     c
40     c o Read an active variable from file.
41     c
42     c The variable *globalfile* can be used as a switch, which allows
43     c to read from a global file. The adjoint files are, however, always
44     c treated as tiled files.
45     c
46     c started: heimbach@mit.edu 05-Mar-2001
47     c
48     c ==================================================================
49     c SUBROUTINE active_read_xz_rl
50     c ==================================================================
51    
52     implicit none
53    
54     c == global variables ==
55    
56     #include "EEPARAMS.h"
57     #include "SIZE.h"
58     #include "PARAMS.h"
59 heimbach 1.7 #include "ctrl.h"
60 heimbach 1.3
61     c == routine arguments ==
62    
63     character*(*) active_var_file
64    
65     logical globalfile
66     logical lAdInit
67     integer irec
68     integer mynr
69     integer theSimulationMode
70     integer myOptimIter
71     integer mythid
72     _RL active_var(1-olx:snx+olx,mynr,nsx,nsy)
73    
74     c == local variables ==
75    
76     character*(2) adpref
77     character*(80) adfname
78    
79     integer bi,bj
80     integer i,j,k
81     integer oldprec
82     integer prec
83     integer il
84     integer ilnblnk
85    
86     logical writeglobalfile
87    
88     _RL active_data_t(1-olx:snx+olx,nsx,nsy)
89    
90     c == functions ==
91    
92     external ilnblnk
93    
94     c == end of interface ==
95    
96     c force 64-bit io
97     oldPrec = readBinaryPrec
98 heimbach 1.7 readBinaryPrec = ctrlprec
99     prec = ctrlprec
100 heimbach 1.3
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 mdsreadfieldxz(
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 i = 1,snx
135     active_data_t(i,bi,bj)= 0. _d 0
136     enddo
137     enddo
138     enddo
139    
140     do k = 1,mynr
141     call mdswritefieldxz(
142     & adfname,
143     & prec,
144     & globalfile,
145     & 'RL',
146     & 1,
147     & active_data_t,
148     & (irec-1)*mynr+k,
149     & myOptimIter,
150     & mythid )
151     enddo
152     endif
153    
154     _END_MASTER( mythid )
155    
156     endif
157    
158     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
159     c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
160     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
161    
162     if (theSimulationMode .eq. REVERSE_SIMULATION) then
163    
164     _BEGIN_MASTER( mythid )
165    
166     writeglobalfile = .false.
167     do k=1,mynr
168     c Read data from file layer by layer.
169     call mdsreadfieldxz(
170     & active_var_file,
171     & prec,
172     & 'RL',
173     & 1,
174     & active_data_t,
175     & (irec-1)*mynr+k,
176     & mythid )
177    
178     c Add active_var from appropriate location to data.
179     do bj = 1,nsy
180     do bi = 1,nsx
181     do i = 1,snx
182     active_data_t(i,bi,bj) = active_data_t(i,bi,bj) +
183     & active_var(i,k,bi,bj)
184     enddo
185     enddo
186     enddo
187    
188     c Store the result on disk.
189     call mdswritefieldxz(
190     & active_var_file,
191     & prec,
192     & writeglobalfile,
193     & 'RL',
194     & 1,
195     & active_data_t,
196     & (irec-1)*mynr+k,
197     & myOptimIter,
198     & mythid )
199     enddo
200    
201    
202     c Set active_var to zero.
203     do k=1,mynr
204     do bj = 1,nsy
205     do bi = 1,nsx
206     do i = 1,snx
207     active_var(i,k,bi,bj) = 0. _d 0
208     enddo
209     enddo
210     enddo
211     enddo
212    
213     _END_MASTER( mythid )
214     endif
215    
216 heimbach 1.4 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
217     c >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
218     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
219    
220     if (theSimulationMode .eq. TANGENT_SIMULATION) then
221    
222     _BEGIN_MASTER( mythid )
223    
224     c Read the active variable from file.
225    
226     call mdsreadfieldxz(
227     & active_var_file,
228     & prec,
229     & 'RL',
230     & mynr,
231     & active_var,
232     & irec,
233     & mythid )
234    
235     _END_MASTER( mythid )
236    
237     endif
238    
239 heimbach 1.3 c Reset default io precision.
240     readBinaryPrec = oldPrec
241    
242     _BARRIER
243    
244     return
245     end
246    
247     c ==================================================================
248    
249     subroutine active_write_xz_rl(
250     I active_var_file,
251     I active_var,
252     I globalfile,
253     I irec,
254     I mynr,
255     I theSimulationMode,
256     I myOptimIter,
257     I mythid
258     & )
259    
260     c ==================================================================
261     c SUBROUTINE active_write_xz_rl
262     c ==================================================================
263     c
264     c o Write an active variable to a file.
265     c
266     c started: heimbach@mit.edu 05-Mar-2001
267     c
268     c ==================================================================
269     c SUBROUTINE active_write_xz_rl
270     c ==================================================================
271    
272     implicit none
273    
274     c == global variables ==
275    
276     #include "EEPARAMS.h"
277     #include "SIZE.h"
278     #include "PARAMS.h"
279 heimbach 1.7 #include "ctrl.h"
280 heimbach 1.3
281     c == routine arguments ==
282    
283     character*(*) active_var_file
284    
285     integer mynr
286     logical globalfile
287     integer irec
288     integer theSimulationMode
289     integer myOptimIter
290     integer mythid
291     _RL active_var(1-olx:snx+olx,mynr,nsx,nsy)
292    
293     c == local variables ==
294    
295     integer i,j,k
296     integer bi,bj
297     _RL active_data_t(1-olx:snx+olx,nsx,nsy)
298     integer oldprec
299     integer prec
300    
301     c == end of interface ==
302    
303     c force 64-bit io
304     oldPrec = readBinaryPrec
305 heimbach 1.7 readBinaryPrec = ctrlprec
306     prec = ctrlprec
307 heimbach 1.3
308     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
309     c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
310     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
311    
312     if (theSimulationMode .eq. FORWARD_SIMULATION) then
313    
314     _BEGIN_MASTER( mythid )
315    
316     call mdswritefieldxz(
317     & active_var_file,
318     & prec,
319     & globalfile,
320     & 'RL',
321     & mynr,
322     & active_var,
323     & irec,
324     & myOptimIter,
325     & mythid )
326    
327     _END_MASTER( mythid )
328    
329     endif
330    
331     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
332     c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
333     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
334    
335     if (theSimulationMode .eq. REVERSE_SIMULATION) then
336    
337     _BEGIN_MASTER( mythid )
338    
339     do k=1,mynr
340     c Read data from file layer by layer.
341     call mdsreadfieldxz(
342     & active_var_file,
343     & prec,
344     & 'RL',
345     & 1,
346     & active_data_t,
347     & (irec-1)*mynr+k,
348     & mythid )
349    
350     c Add active_var from appropriate location to data.
351     do bj = 1,nsy
352     do bi = 1,nsx
353     do i = 1,snx
354     active_var(i,k,bi,bj) =
355     & active_var(i,k,bi,bj) +
356     & active_data_t(i,bi,bj)
357     active_data_t(i,bi,bj) = 0. _d 0
358     enddo
359     enddo
360     enddo
361     call mdswritefieldxz(
362     & active_var_file,
363     & prec,
364     & globalfile,
365     & 'RL',
366     & 1,
367     & active_data_t,
368     & (irec-1)*mynr+k,
369     & myOptimIter,
370     & mythid )
371     enddo
372    
373     _END_MASTER( mythid )
374    
375     endif
376    
377 heimbach 1.4 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
378     c >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
379     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
380    
381     if (theSimulationMode .eq. TANGENT_SIMULATION) then
382    
383     _BEGIN_MASTER( mythid )
384    
385     call mdswritefieldxz(
386     & active_var_file,
387     & prec,
388     & globalfile,
389     & 'RL',
390     & mynr,
391     & active_var,
392     & irec,
393     & myOptimIter,
394     & mythid )
395    
396     _END_MASTER( mythid )
397    
398     endif
399    
400 heimbach 1.3 c Reset default io precision.
401     readBinaryPrec = oldPrec
402    
403     _BARRIER
404    
405     return
406     end
407    
408     c ==================================================================
409    
410     subroutine active_read_yz_rl(
411     I active_var_file,
412     O active_var,
413     I globalfile,
414     I lAdInit,
415     I irec,
416     I mynr,
417     I theSimulationMode,
418     I myOptimIter,
419     I mythid
420     & )
421    
422     c ==================================================================
423     c SUBROUTINE active_read_yz_rl
424     c ==================================================================
425     c
426     c o Read an active variable from file.
427     c
428     c The variable *globalfile* can be used as a switch, which allows
429     c to read from a global file. The adjoint files are, however, always
430     c treated as tiled files.
431     c
432     c started: heimbach@mit.edu 05-Mar-2001
433     c
434     c ==================================================================
435     c SUBROUTINE active_read_yz_rl
436     c ==================================================================
437    
438     implicit none
439    
440     c == global variables ==
441    
442     #include "EEPARAMS.h"
443     #include "SIZE.h"
444     #include "PARAMS.h"
445 heimbach 1.7 #include "ctrl.h"
446 heimbach 1.3
447     c == routine arguments ==
448    
449     character*(*) active_var_file
450    
451     logical globalfile
452     logical lAdInit
453     integer irec
454     integer mynr
455     integer theSimulationMode
456     integer myOptimIter
457     integer mythid
458     _RL active_var(1-oly:sny+oly,mynr,nsx,nsy)
459    
460     c == local variables ==
461    
462     character*(2) adpref
463     character*(80) adfname
464    
465     integer bi,bj
466     integer i,j,k
467     integer oldprec
468     integer prec
469     integer il
470     integer ilnblnk
471    
472     logical writeglobalfile
473    
474     _RL active_data_t(1-oly:sny+oly,nsx,nsy)
475    
476     c == functions ==
477    
478     external ilnblnk
479    
480     c == end of interface ==
481    
482     c force 64-bit io
483     oldPrec = readBinaryPrec
484 heimbach 1.7 readBinaryPrec = ctrlprec
485     prec = ctrlprec
486 heimbach 1.3
487     write(adfname(1:80),'(80a)') ' '
488     adpref = 'ad'
489     il = ilnblnk( active_var_file )
490    
491     write(adfname(1:2),'(a)') adpref
492     write(adfname(3:il+2),'(a)') active_var_file(1:il)
493    
494     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
495     c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
496     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
497    
498     if (theSimulationMode .eq. FORWARD_SIMULATION) then
499    
500     _BEGIN_MASTER( mythid )
501    
502     c Read the active variable from file.
503    
504     call mdsreadfieldyz(
505     & active_var_file,
506     & prec,
507     & 'RL',
508     & mynr,
509     & active_var,
510     & irec,
511     & mythid )
512    
513     if (lAdInit) then
514     c Initialise the corresponding adjoint variable on the
515     c adjoint variable's file. These files are tiled.
516    
517     writeglobalfile = .false.
518     do bj = 1,nsy
519     do bi = 1,nsx
520     do j = 1,sny
521     active_data_t(j,bi,bj)= 0. _d 0
522     enddo
523     enddo
524     enddo
525    
526     do k = 1,mynr
527     call mdswritefieldyz(
528     & adfname,
529     & prec,
530     & globalfile,
531     & 'RL',
532     & 1,
533     & active_data_t,
534     & (irec-1)*mynr+k,
535     & myOptimIter,
536     & mythid )
537     enddo
538     endif
539    
540     _END_MASTER( mythid )
541    
542     endif
543    
544     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
545     c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
546     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
547    
548     if (theSimulationMode .eq. REVERSE_SIMULATION) then
549    
550     _BEGIN_MASTER( mythid )
551    
552     writeglobalfile = .false.
553     do k=1,mynr
554     c Read data from file layer by layer.
555     call mdsreadfieldyz(
556     & active_var_file,
557     & prec,
558     & 'RL',
559     & 1,
560     & active_data_t,
561     & (irec-1)*mynr+k,
562     & mythid )
563    
564     c Add active_var from appropriate location to data.
565     do bj = 1,nsy
566     do bi = 1,nsx
567     do j = 1,sny
568     active_data_t(j,bi,bj) = active_data_t(j,bi,bj) +
569     & active_var(j,k,bi,bj)
570     enddo
571     enddo
572     enddo
573    
574     c Store the result on disk.
575     call mdswritefieldyz(
576     & active_var_file,
577     & prec,
578     & writeglobalfile,
579     & 'RL',
580     & 1,
581     & active_data_t,
582     & (irec-1)*mynr+k,
583     & myOptimIter,
584     & mythid )
585     enddo
586    
587    
588     c Set active_var to zero.
589     do k=1,mynr
590     do bj = 1,nsy
591     do bi = 1,nsx
592     do j = 1,sny
593     active_var(j,k,bi,bj) = 0. _d 0
594     enddo
595     enddo
596     enddo
597     enddo
598    
599     _END_MASTER( mythid )
600     endif
601    
602 heimbach 1.4 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
603     c >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
604     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
605    
606     if (theSimulationMode .eq. TANGENT_SIMULATION) then
607    
608     _BEGIN_MASTER( mythid )
609    
610     c Read the active variable from file.
611    
612     call mdsreadfieldyz(
613     & active_var_file,
614     & prec,
615     & 'RL',
616     & mynr,
617     & active_var,
618     & irec,
619     & mythid )
620    
621     _END_MASTER( mythid )
622    
623     endif
624    
625 heimbach 1.3 c Reset default io precision.
626     readBinaryPrec = oldPrec
627    
628     _BARRIER
629    
630     return
631     end
632    
633     c ==================================================================
634    
635     subroutine active_write_yz_rl(
636     I active_var_file,
637     I active_var,
638     I globalfile,
639     I irec,
640     I mynr,
641     I theSimulationMode,
642     I myOptimIter,
643     I mythid
644     & )
645    
646     c ==================================================================
647     c SUBROUTINE active_write_yz_rl
648     c ==================================================================
649     c
650     c o Write an active variable to a file.
651     c
652     c started: heimbach@mit.edu 05-Mar-2001
653     c
654     c ==================================================================
655     c SUBROUTINE active_write_yz_rl
656     c ==================================================================
657    
658     implicit none
659    
660     c == global variables ==
661    
662     #include "EEPARAMS.h"
663     #include "SIZE.h"
664     #include "PARAMS.h"
665 heimbach 1.7 #include "ctrl.h"
666 heimbach 1.3
667     c == routine arguments ==
668    
669     character*(*) active_var_file
670    
671     integer mynr
672     logical globalfile
673     integer irec
674     integer theSimulationMode
675     integer myOptimIter
676     integer mythid
677     _RL active_var(1-oly:sny+oly,mynr,nsx,nsy)
678    
679     c == local variables ==
680    
681     integer i,j,k
682     integer bi,bj
683     _RL active_data_t(1-oly:sny+oly,nsx,nsy)
684     integer oldprec
685     integer prec
686    
687     c == end of interface ==
688    
689     c force 64-bit io
690     oldPrec = readBinaryPrec
691 heimbach 1.7 readBinaryPrec = ctrlprec
692     prec = ctrlprec
693 heimbach 1.3
694     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
695     c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
696     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
697    
698     if (theSimulationMode .eq. FORWARD_SIMULATION) then
699    
700     _BEGIN_MASTER( mythid )
701    
702     call mdswritefieldyz(
703     & active_var_file,
704     & prec,
705     & globalfile,
706     & 'RL',
707     & mynr,
708     & active_var,
709     & irec,
710     & myOptimIter,
711     & mythid )
712    
713     _END_MASTER( mythid )
714    
715     endif
716    
717     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
718     c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
719     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
720    
721     if (theSimulationMode .eq. REVERSE_SIMULATION) then
722    
723     _BEGIN_MASTER( mythid )
724    
725     do k=1,mynr
726     c Read data from file layer by layer.
727     call mdsreadfieldyz(
728     & active_var_file,
729     & prec,
730     & 'RL',
731     & 1,
732     & active_data_t,
733     & (irec-1)*mynr+k,
734     & mythid )
735    
736     c Add active_var from appropriate location to data.
737     do bj = 1,nsy
738     do bi = 1,nsx
739     do j = 1,sny
740     active_var(j,k,bi,bj) =
741     & active_var(j,k,bi,bj) +
742     & active_data_t(j,bi,bj)
743     active_data_t(j,bi,bj) = 0. _d 0
744     enddo
745     enddo
746     enddo
747     call mdswritefieldyz(
748     & active_var_file,
749     & prec,
750     & globalfile,
751     & 'RL',
752     & 1,
753     & active_data_t,
754     & (irec-1)*mynr+k,
755     & myOptimIter,
756     & mythid )
757     enddo
758 heimbach 1.4
759     _END_MASTER( mythid )
760    
761     endif
762    
763     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
764     c >>>>>>>>>>>>>>>>>>> TANGENTY RUN <<<<<<<<<<<<<<<<<<<
765     c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
766    
767     if (theSimulationMode .eq. TANGENT_SIMULATION) then
768    
769     _BEGIN_MASTER( mythid )
770    
771     call mdswritefieldyz(
772     & active_var_file,
773     & prec,
774     & globalfile,
775     & 'RL',
776     & mynr,
777     & active_var,
778     & irec,
779     & myOptimIter,
780     & mythid )
781 heimbach 1.3
782     _END_MASTER( mythid )
783    
784     endif
785    
786     c Reset default io precision.
787     readBinaryPrec = oldPrec
788    
789     _BARRIER
790    
791     return
792     end
793    

  ViewVC Help
Powered by ViewVC 1.1.22