/[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.4 - (hide annotations) (download)
Mon Sep 16 18:11:58 2002 UTC (21 years, 8 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint46n_post, checkpoint47e_post, checkpoint46l_post, checkpoint46g_pre, checkpoint47c_post, checkpoint50c_post, checkpoint46f_post, checkpoint48e_post, checkpoint50c_pre, checkpoint48i_post, checkpoint46l_pre, checkpoint51, checkpoint50, checkpoint50d_post, checkpoint50b_pre, checkpoint51f_post, checkpoint48b_post, checkpoint51d_post, checkpoint48c_pre, checkpoint47d_pre, c49_autodiff, checkpoint47a_post, checkpoint48d_pre, checkpoint51j_post, checkpoint47i_post, checkpoint47d_post, checkpoint48d_post, checkpoint48f_post, checkpoint46j_pre, checkpoint48h_post, checkpoint51b_pre, checkpoint47g_post, checkpoint46j_post, checkpoint51h_pre, checkpoint46k_post, checkpoint48a_post, checkpoint50f_post, checkpoint50a_post, checkpoint50f_pre, checkpoint47j_post, branch-exfmods-tag, branchpoint-genmake2, checkpoint48c_post, checkpoint51b_post, checkpoint51c_post, checkpoint47b_post, checkpoint46h_pre, checkpoint46m_post, checkpoint50g_post, checkpoint46g_post, checkpoint50h_post, checkpoint50e_pre, checkpoint50i_post, checkpoint51i_pre, checkpoint47f_post, checkpoint50e_post, checkpoint46i_post, checkpoint50d_pre, checkpoint51e_post, checkpoint47, checkpoint48, checkpoint49, checkpoint46h_post, checkpoint51f_pre, checkpoint48g_post, checkpoint47h_post, checkpoint51g_post, checkpoint50b_post, checkpoint51a_post
Branch point for: branch-exfmods-curt, branch-genmake2
Changes since 1.3: +92 -0 lines
Enable tangent linear (forward mode) gradient checks:
o extended active file handling to g_... files
o added TANGENT_SIMULATION to theSimulationMode
o extended grdchk package accordingly

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

  ViewVC Help
Powered by ViewVC 1.1.22