/[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.10 - (show annotations) (download)
Mon Mar 22 02:15:02 2010 UTC (14 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint62v, checkpoint62u, checkpoint62t, checkpoint62s, checkpoint62r, checkpoint62q, checkpoint62p, checkpoint62g, checkpoint62f, checkpoint62e, checkpoint62d, checkpoint62k, checkpoint62j, checkpoint62i, checkpoint62h, checkpoint62o, checkpoint62n, checkpoint62m, checkpoint62l, checkpoint62w, checkpoint62z, checkpoint62y, checkpoint62x, checkpoint63g, checkpoint63, checkpoint63p, checkpoint63q, checkpoint63l, checkpoint63m, checkpoint63n, checkpoint63o, checkpoint63h, checkpoint63i, checkpoint63j, checkpoint63k, checkpoint63d, checkpoint63e, checkpoint63f, checkpoint63a, checkpoint63b, checkpoint63c
Changes since 1.9: +3 -3 lines
finish removing unbalanced quote (single or double) in commented line

1 C $Header: /u/gcmpack/MITgcm/pkg/autodiff/active_file_control_slice.F,v 1.9 2007/10/08 23:50:53 jmc Exp $
2 C $Name: $
3
4 #include "AUTODIFF_OPTIONS.h"
5
6 c ==================================================================
7 c
8 c active_file_control.F: Routines to handle the i/o of active vari-
9 c ables for the adjoint calculations. All
10 c files are direct access files.
11 c
12 c Routines:
13 c
14 c o active_read_xz_rl - Basic routine to handle active read
15 c operations.
16 c o active_write_xz_rl - Basic routine to handle active write
17 c operations.
18 c o active_read_yz_rl - Basic routine to handle active read
19 c operations.
20 c o active_write_yz_rl - Basic routine to handle active write
21 c operations.
22 c
23 c ==================================================================
24
25
26 subroutine active_read_xz_rl(
27 I active_var_file,
28 O active_var,
29 I globalfile,
30 I lAdInit,
31 I irec,
32 I mynr,
33 I theSimulationMode,
34 I myOptimIter,
35 I mythid
36 & )
37
38 c ==================================================================
39 c SUBROUTINE active_read_xz_rl
40 c ==================================================================
41 c
42 c o Read an active variable from file.
43 c
44 c The variable *globalfile* can be used as a switch, which allows
45 c to read from a global file. The adjoint files are, however, always
46 c treated as tiled files.
47 c
48 c started: heimbach@mit.edu 05-Mar-2001
49 c
50 c ==================================================================
51 c SUBROUTINE active_read_xz_rl
52 c ==================================================================
53
54 implicit none
55
56 c == global variables ==
57
58 #include "EEPARAMS.h"
59 #include "SIZE.h"
60 #include "PARAMS.h"
61 #include "ctrl.h"
62
63 c == routine arguments ==
64
65 character*(*) active_var_file
66
67 logical globalfile
68 logical lAdInit
69 integer irec
70 integer mynr
71 integer theSimulationMode
72 integer myOptimIter
73 integer mythid
74 _RL active_var(1-olx:snx+olx,mynr,nsx,nsy)
75
76 c == local variables ==
77
78 character*(2) adpref
79 character*(80) adfname
80
81 integer bi,bj
82 integer i,j,k
83 integer oldprec
84 integer prec
85 integer il
86 integer ilnblnk
87
88 logical writeglobalfile
89
90 _RL active_data_t(1-olx:snx+olx,mynr,nsx,nsy)
91
92 c == functions ==
93
94 external ilnblnk
95
96 c == end of interface ==
97
98 c force 64-bit io
99 oldPrec = readBinaryPrec
100 readBinaryPrec = ctrlprec
101 prec = ctrlprec
102
103 write(adfname(1:80),'(80a)') ' '
104 adpref = 'ad'
105 il = ilnblnk( active_var_file )
106
107 write(adfname(1:2),'(a)') adpref
108 write(adfname(3:il+2),'(a)') active_var_file(1:il)
109
110 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
111 c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
112 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
113
114 if (theSimulationMode .eq. FORWARD_SIMULATION) then
115
116 _BEGIN_MASTER( mythid )
117
118 c Read the active variable from file.
119
120 call mdsreadfieldxz(
121 & active_var_file,
122 & prec,
123 & 'RL',
124 & mynr,
125 & active_var,
126 & irec,
127 & mythid )
128
129 if (lAdInit) then
130 c Initialise the corresponding adjoint variable on the
131 c adjoint variable file. These files are tiled.
132
133 writeglobalfile = .false.
134 do bj = 1,nsy
135 do bi = 1,nsx
136 do k = 1,mynr
137 do i = 1,snx
138 active_data_t(i,k,bi,bj)= 0. _d 0
139 enddo
140 enddo
141 enddo
142 enddo
143
144 call mdswritefieldxz(
145 & adfname,
146 & prec,
147 & globalfile,
148 & 'RL',
149 & mynr,
150 & active_data_t,
151 & irec,
152 & myOptimIter,
153 & mythid )
154 endif
155
156 _END_MASTER( mythid )
157
158 endif
159
160 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
161 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
162 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
163
164 if (theSimulationMode .eq. REVERSE_SIMULATION) then
165
166 _BEGIN_MASTER( mythid )
167
168 writeglobalfile = .false.
169 call mdsreadfieldxz(
170 & active_var_file,
171 & prec,
172 & 'RL',
173 & mynr,
174 & active_data_t,
175 & irec,
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 k = 1,mynr
182 do i = 1,snx
183 active_data_t(i,k,bi,bj) =
184 & active_data_t(i,k,bi,bj) +
185 & active_var(i,k,bi,bj)
186 enddo
187 enddo
188 enddo
189 enddo
190
191 c Store the result on disk.
192 call mdswritefieldxz(
193 & active_var_file,
194 & prec,
195 & writeglobalfile,
196 & 'RL',
197 & mynr,
198 & active_data_t,
199 & irec,
200 & myOptimIter,
201 & mythid )
202
203 c Set active_var to zero.
204 do bj = 1,nsy
205 do bi = 1,nsx
206 do k=1,mynr
207 do i = 1,snx
208 active_var(i,k,bi,bj) = 0. _d 0
209 enddo
210 enddo
211 enddo
212 enddo
213
214 _END_MASTER( mythid )
215 endif
216
217 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
218 c >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
219 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
220
221 if (theSimulationMode .eq. TANGENT_SIMULATION) then
222
223 _BEGIN_MASTER( mythid )
224
225 c Read the active variable from file.
226
227 call mdsreadfieldxz(
228 & active_var_file,
229 & prec,
230 & 'RL',
231 & mynr,
232 & active_var,
233 & irec,
234 & mythid )
235
236 _END_MASTER( mythid )
237
238 endif
239
240 c Reset default io precision.
241 readBinaryPrec = oldPrec
242
243 _BARRIER
244
245 return
246 end
247
248 c ==================================================================
249
250 subroutine active_write_xz_rl(
251 I active_var_file,
252 I active_var,
253 I globalfile,
254 I irec,
255 I mynr,
256 I theSimulationMode,
257 I myOptimIter,
258 I mythid
259 & )
260
261 c ==================================================================
262 c SUBROUTINE active_write_xz_rl
263 c ==================================================================
264 c
265 c o Write an active variable to a file.
266 c
267 c started: heimbach@mit.edu 05-Mar-2001
268 c
269 c ==================================================================
270 c SUBROUTINE active_write_xz_rl
271 c ==================================================================
272
273 implicit none
274
275 c == global variables ==
276
277 #include "EEPARAMS.h"
278 #include "SIZE.h"
279 #include "PARAMS.h"
280 #include "ctrl.h"
281
282 c == routine arguments ==
283
284 character*(*) active_var_file
285
286 integer mynr
287 logical globalfile
288 integer irec
289 integer theSimulationMode
290 integer myOptimIter
291 integer mythid
292 _RL active_var(1-olx:snx+olx,mynr,nsx,nsy)
293
294 c == local variables ==
295
296 integer i,j,k
297 integer bi,bj
298 _RL active_data_t(1-olx:snx+olx,mynr,nsx,nsy)
299 integer oldprec
300 integer prec
301
302 c == end of interface ==
303
304 c force 64-bit io
305 oldPrec = readBinaryPrec
306 readBinaryPrec = ctrlprec
307 prec = ctrlprec
308
309 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
310 c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
311 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
312
313 if (theSimulationMode .eq. FORWARD_SIMULATION) then
314
315 _BEGIN_MASTER( mythid )
316
317 call mdswritefieldxz(
318 & active_var_file,
319 & prec,
320 & globalfile,
321 & 'RL',
322 & mynr,
323 & active_var,
324 & irec,
325 & myOptimIter,
326 & mythid )
327
328 _END_MASTER( mythid )
329
330 endif
331
332 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
333 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
334 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
335
336 if (theSimulationMode .eq. REVERSE_SIMULATION) then
337
338 _BEGIN_MASTER( mythid )
339
340 call mdsreadfieldxz(
341 & active_var_file,
342 & prec,
343 & 'RL',
344 & mynr,
345 & active_data_t,
346 & irec,
347 & mythid )
348
349 c Add active_var from appropriate location to data.
350 do bj = 1,nsy
351 do bi = 1,nsx
352 do k = 1,nr
353 do i = 1,snx
354 active_var(i,k,bi,bj) =
355 & active_var(i,k,bi,bj) +
356 & active_data_t(i,k,bi,bj)
357 active_data_t(i,k,bi,bj) = 0. _d 0
358 enddo
359 enddo
360 enddo
361 enddo
362 call mdswritefieldxz(
363 & active_var_file,
364 & prec,
365 & globalfile,
366 & 'RL',
367 & mynr,
368 & active_data_t,
369 & irec,
370 & myOptimIter,
371 & mythid )
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,mynr,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 file. These files are tiled.
516
517 writeglobalfile = .false.
518 do bj = 1,nsy
519 do bi = 1,nsx
520 do k = 1, mynr
521 do j = 1,sny
522 active_data_t(j,k,bi,bj)= 0. _d 0
523 enddo
524 enddo
525 enddo
526 enddo
527
528 call mdswritefieldyz(
529 & adfname,
530 & prec,
531 & globalfile,
532 & 'RL',
533 & mynr,
534 & active_data_t,
535 & irec,
536 & myOptimIter,
537 & mythid )
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 call mdsreadfieldyz(
554 & active_var_file,
555 & prec,
556 & 'RL',
557 & mynr,
558 & active_data_t,
559 & irec,
560 & mythid )
561
562 c Add active_var from appropriate location to data.
563 do bj = 1,nsy
564 do bi = 1,nsx
565 do k = 1,mynr
566 do j = 1,sny
567 active_data_t(j,k,bi,bj) =
568 & active_data_t(j,k,bi,bj) +
569 & active_var(j,k,bi,bj)
570 enddo
571 enddo
572 enddo
573 enddo
574
575 c Store the result on disk.
576 call mdswritefieldyz(
577 & active_var_file,
578 & prec,
579 & writeglobalfile,
580 & 'RL',
581 & mynr,
582 & active_data_t,
583 & irec,
584 & myOptimIter,
585 & mythid )
586
587 c Set active_var to zero.
588 do bj = 1,nsy
589 do bi = 1,nsx
590 do k=1,mynr
591 do j = 1,sny
592 active_var(j,k,bi,bj) = 0. _d 0
593 enddo
594 enddo
595 enddo
596 enddo
597
598 _END_MASTER( mythid )
599 endif
600
601 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
602 c >>>>>>>>>>>>>>>>>>> TANGENT RUN <<<<<<<<<<<<<<<<<<<
603 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
604
605 if (theSimulationMode .eq. TANGENT_SIMULATION) then
606
607 _BEGIN_MASTER( mythid )
608
609 c Read the active variable from file.
610
611 call mdsreadfieldyz(
612 & active_var_file,
613 & prec,
614 & 'RL',
615 & mynr,
616 & active_var,
617 & irec,
618 & mythid )
619
620 _END_MASTER( mythid )
621
622 endif
623
624 c Reset default io precision.
625 readBinaryPrec = oldPrec
626
627 _BARRIER
628
629 return
630 end
631
632 c ==================================================================
633
634 subroutine active_write_yz_rl(
635 I active_var_file,
636 I active_var,
637 I globalfile,
638 I irec,
639 I mynr,
640 I theSimulationMode,
641 I myOptimIter,
642 I mythid
643 & )
644
645 c ==================================================================
646 c SUBROUTINE active_write_yz_rl
647 c ==================================================================
648 c
649 c o Write an active variable to a file.
650 c
651 c started: heimbach@mit.edu 05-Mar-2001
652 c
653 c ==================================================================
654 c SUBROUTINE active_write_yz_rl
655 c ==================================================================
656
657 implicit none
658
659 c == global variables ==
660
661 #include "EEPARAMS.h"
662 #include "SIZE.h"
663 #include "PARAMS.h"
664 #include "ctrl.h"
665
666 c == routine arguments ==
667
668 character*(*) active_var_file
669
670 integer mynr
671 logical globalfile
672 integer irec
673 integer theSimulationMode
674 integer myOptimIter
675 integer mythid
676 _RL active_var(1-oly:sny+oly,mynr,nsx,nsy)
677
678 c == local variables ==
679
680 integer i,j,k
681 integer bi,bj
682 _RL active_data_t(1-oly:sny+oly,mynr,nsx,nsy)
683 integer oldprec
684 integer prec
685
686 c == end of interface ==
687
688 c force 64-bit io
689 oldPrec = readBinaryPrec
690 readBinaryPrec = ctrlprec
691 prec = ctrlprec
692
693 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
694 c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
695 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
696
697 if (theSimulationMode .eq. FORWARD_SIMULATION) then
698
699 _BEGIN_MASTER( mythid )
700
701 call mdswritefieldyz(
702 & active_var_file,
703 & prec,
704 & globalfile,
705 & 'RL',
706 & mynr,
707 & active_var,
708 & irec,
709 & myOptimIter,
710 & mythid )
711
712 _END_MASTER( mythid )
713
714 endif
715
716 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
717 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
718 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
719
720 if (theSimulationMode .eq. REVERSE_SIMULATION) then
721
722 _BEGIN_MASTER( mythid )
723
724 call mdsreadfieldyz(
725 & active_var_file,
726 & prec,
727 & 'RL',
728 & mynr,
729 & active_data_t,
730 & irec,
731 & mythid )
732
733 c Add active_var from appropriate location to data.
734 do bj = 1,nsy
735 do bi = 1,nsx
736 do k = 1, mynr
737 do j = 1,sny
738 active_var(j,k,bi,bj) =
739 & active_var(j,k,bi,bj) +
740 & active_data_t(j,k,bi,bj)
741 active_data_t(j,k,bi,bj) = 0. _d 0
742 enddo
743 enddo
744 enddo
745 enddo
746 call mdswritefieldyz(
747 & active_var_file,
748 & prec,
749 & globalfile,
750 & 'RL',
751 & mynr,
752 & active_data_t,
753 & irec,
754 & myOptimIter,
755 & mythid )
756
757 _END_MASTER( mythid )
758
759 endif
760
761 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
762 c >>>>>>>>>>>>>>>>>>> TANGENTY RUN <<<<<<<<<<<<<<<<<<<
763 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
764
765 if (theSimulationMode .eq. TANGENT_SIMULATION) then
766
767 _BEGIN_MASTER( mythid )
768
769 call mdswritefieldyz(
770 & active_var_file,
771 & prec,
772 & globalfile,
773 & 'RL',
774 & mynr,
775 & active_var,
776 & irec,
777 & myOptimIter,
778 & mythid )
779
780 _END_MASTER( mythid )
781
782 endif
783
784 c Reset default io precision.
785 readBinaryPrec = oldPrec
786
787 _BARRIER
788
789 return
790 end
791

  ViewVC Help
Powered by ViewVC 1.1.22