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

Contents 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 - (show 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
2 #include "AUTODIFF_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 #include "ctrl.h"
60
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 readBinaryPrec = ctrlprec
99 prec = ctrlprec
100
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 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 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 #include "ctrl.h"
280
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 readBinaryPrec = ctrlprec
306 prec = ctrlprec
307
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 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 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 #include "ctrl.h"
446
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 readBinaryPrec = ctrlprec
485 prec = ctrlprec
486
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 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 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 #include "ctrl.h"
666
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 readBinaryPrec = ctrlprec
692 prec = ctrlprec
693
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
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
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