/[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.2 - (hide annotations) (download)
Fri Sep 28 04:19:27 2001 UTC (22 years, 7 months ago) by heimbach
Branch: MAIN
CVS Tags: release1_b1, checkpoint43, ecco-branch-mod1, release1_beta1
Branch point for: release1, ecco-branch, release1_coupled
Changes since 1.1: +84 -48 lines
Started to add comments...

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

  ViewVC Help
Powered by ViewVC 1.1.22