/[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.4 - (show 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
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 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 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 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 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 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 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
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
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