/[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.8 - (show annotations) (download)
Tue Jul 26 13:10:46 2005 UTC (18 years, 10 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint57m_post, checkpoint57s_post, checkpoint58b_post, checkpoint57y_post, checkpoint57r_post, checkpoint59, checkpoint58, checkpoint58f_post, checkpoint57n_post, checkpoint58d_post, checkpoint58a_post, checkpoint57z_post, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint57t_post, checkpoint57v_post, checkpoint58w_post, checkpoint57y_pre, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, checkpoint58e_post, checkpoint58r_post, checkpoint58n_post, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59h, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint58g_post, checkpoint58x_post, checkpoint58h_post, checkpoint58j_post, checkpoint57o_post, checkpoint57w_post, checkpoint58i_post, checkpoint57x_post, checkpoint58c_post, checkpoint58u_post, checkpoint58s_post
Changes since 1.7: +82 -86 lines
Re-structured unnecessary k-loop bracketing mdsio routines.

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,mynr,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 k = 1,mynr
135 do i = 1,snx
136 active_data_t(i,k,bi,bj)= 0. _d 0
137 enddo
138 enddo
139 enddo
140 enddo
141
142 call mdswritefieldxz(
143 & adfname,
144 & prec,
145 & globalfile,
146 & 'RL',
147 & mynr,
148 & active_data_t,
149 & irec,
150 & myOptimIter,
151 & mythid )
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 call mdsreadfieldxz(
168 & active_var_file,
169 & prec,
170 & 'RL',
171 & mynr,
172 & active_data_t,
173 & irec,
174 & mythid )
175
176 c Add active_var from appropriate location to data.
177 do bj = 1,nsy
178 do bi = 1,nsx
179 do k = 1,mynr
180 do i = 1,snx
181 active_data_t(i,k,bi,bj) =
182 & active_data_t(i,k,bi,bj) +
183 & active_var(i,k,bi,bj)
184 enddo
185 enddo
186 enddo
187 enddo
188
189 c Store the result on disk.
190 call mdswritefieldxz(
191 & active_var_file,
192 & prec,
193 & writeglobalfile,
194 & 'RL',
195 & mynr,
196 & active_data_t,
197 & irec,
198 & myOptimIter,
199 & mythid )
200
201 c Set active_var to zero.
202 do bj = 1,nsy
203 do bi = 1,nsx
204 do k=1,mynr
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 #include "ctrl.h"
279
280 c == routine arguments ==
281
282 character*(*) active_var_file
283
284 integer mynr
285 logical globalfile
286 integer irec
287 integer theSimulationMode
288 integer myOptimIter
289 integer mythid
290 _RL active_var(1-olx:snx+olx,mynr,nsx,nsy)
291
292 c == local variables ==
293
294 integer i,j,k
295 integer bi,bj
296 _RL active_data_t(1-olx:snx+olx,mynr,nsx,nsy)
297 integer oldprec
298 integer prec
299
300 c == end of interface ==
301
302 c force 64-bit io
303 oldPrec = readBinaryPrec
304 readBinaryPrec = ctrlprec
305 prec = ctrlprec
306
307 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
308 c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
309 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
310
311 if (theSimulationMode .eq. FORWARD_SIMULATION) then
312
313 _BEGIN_MASTER( mythid )
314
315 call mdswritefieldxz(
316 & active_var_file,
317 & prec,
318 & globalfile,
319 & 'RL',
320 & mynr,
321 & active_var,
322 & irec,
323 & myOptimIter,
324 & mythid )
325
326 _END_MASTER( mythid )
327
328 endif
329
330 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
331 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
332 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
333
334 if (theSimulationMode .eq. REVERSE_SIMULATION) then
335
336 _BEGIN_MASTER( mythid )
337
338 call mdsreadfieldxz(
339 & active_var_file,
340 & prec,
341 & 'RL',
342 & mynr,
343 & active_data_t,
344 & irec,
345 & mythid )
346
347 c Add active_var from appropriate location to data.
348 do bj = 1,nsy
349 do bi = 1,nsx
350 do k = 1,nr
351 do i = 1,snx
352 active_var(i,k,bi,bj) =
353 & active_var(i,k,bi,bj) +
354 & active_data_t(i,k,bi,bj)
355 active_data_t(i,k,bi,bj) = 0. _d 0
356 enddo
357 enddo
358 enddo
359 enddo
360 call mdswritefieldxz(
361 & active_var_file,
362 & prec,
363 & globalfile,
364 & 'RL',
365 & mynr,
366 & active_data_t,
367 & irec,
368 & myOptimIter,
369 & mythid )
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 #include "ctrl.h"
444
445 c == routine arguments ==
446
447 character*(*) active_var_file
448
449 logical globalfile
450 logical lAdInit
451 integer irec
452 integer mynr
453 integer theSimulationMode
454 integer myOptimIter
455 integer mythid
456 _RL active_var(1-oly:sny+oly,mynr,nsx,nsy)
457
458 c == local variables ==
459
460 character*(2) adpref
461 character*(80) adfname
462
463 integer bi,bj
464 integer i,j,k
465 integer oldprec
466 integer prec
467 integer il
468 integer ilnblnk
469
470 logical writeglobalfile
471
472 _RL active_data_t(1-oly:sny+oly,mynr,nsx,nsy)
473
474 c == functions ==
475
476 external ilnblnk
477
478 c == end of interface ==
479
480 c force 64-bit io
481 oldPrec = readBinaryPrec
482 readBinaryPrec = ctrlprec
483 prec = ctrlprec
484
485 write(adfname(1:80),'(80a)') ' '
486 adpref = 'ad'
487 il = ilnblnk( active_var_file )
488
489 write(adfname(1:2),'(a)') adpref
490 write(adfname(3:il+2),'(a)') active_var_file(1:il)
491
492 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
493 c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
494 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
495
496 if (theSimulationMode .eq. FORWARD_SIMULATION) then
497
498 _BEGIN_MASTER( mythid )
499
500 c Read the active variable from file.
501
502 call mdsreadfieldyz(
503 & active_var_file,
504 & prec,
505 & 'RL',
506 & mynr,
507 & active_var,
508 & irec,
509 & mythid )
510
511 if (lAdInit) then
512 c Initialise the corresponding adjoint variable on the
513 c adjoint variable's file. These files are tiled.
514
515 writeglobalfile = .false.
516 do bj = 1,nsy
517 do bi = 1,nsx
518 do k = 1, mynr
519 do j = 1,sny
520 active_data_t(j,k,bi,bj)= 0. _d 0
521 enddo
522 enddo
523 enddo
524 enddo
525
526 call mdswritefieldyz(
527 & adfname,
528 & prec,
529 & globalfile,
530 & 'RL',
531 & mynr,
532 & active_data_t,
533 & irec,
534 & myOptimIter,
535 & mythid )
536 endif
537
538 _END_MASTER( mythid )
539
540 endif
541
542 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
543 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
544 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
545
546 if (theSimulationMode .eq. REVERSE_SIMULATION) then
547
548 _BEGIN_MASTER( mythid )
549
550 writeglobalfile = .false.
551 call mdsreadfieldyz(
552 & active_var_file,
553 & prec,
554 & 'RL',
555 & mynr,
556 & active_data_t,
557 & irec,
558 & mythid )
559
560 c Add active_var from appropriate location to data.
561 do bj = 1,nsy
562 do bi = 1,nsx
563 do k = 1,mynr
564 do j = 1,sny
565 active_data_t(j,k,bi,bj) =
566 & active_data_t(j,k,bi,bj) +
567 & active_var(j,k,bi,bj)
568 enddo
569 enddo
570 enddo
571 enddo
572
573 c Store the result on disk.
574 call mdswritefieldyz(
575 & active_var_file,
576 & prec,
577 & writeglobalfile,
578 & 'RL',
579 & mynr,
580 & active_data_t,
581 & irec,
582 & myOptimIter,
583 & mythid )
584
585 c Set active_var to zero.
586 do bj = 1,nsy
587 do bi = 1,nsx
588 do k=1,mynr
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 #include "ctrl.h"
663
664 c == routine arguments ==
665
666 character*(*) active_var_file
667
668 integer mynr
669 logical globalfile
670 integer irec
671 integer theSimulationMode
672 integer myOptimIter
673 integer mythid
674 _RL active_var(1-oly:sny+oly,mynr,nsx,nsy)
675
676 c == local variables ==
677
678 integer i,j,k
679 integer bi,bj
680 _RL active_data_t(1-oly:sny+oly,mynr,nsx,nsy)
681 integer oldprec
682 integer prec
683
684 c == end of interface ==
685
686 c force 64-bit io
687 oldPrec = readBinaryPrec
688 readBinaryPrec = ctrlprec
689 prec = ctrlprec
690
691 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
692 c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
693 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
694
695 if (theSimulationMode .eq. FORWARD_SIMULATION) then
696
697 _BEGIN_MASTER( mythid )
698
699 call mdswritefieldyz(
700 & active_var_file,
701 & prec,
702 & globalfile,
703 & 'RL',
704 & mynr,
705 & active_var,
706 & irec,
707 & myOptimIter,
708 & mythid )
709
710 _END_MASTER( mythid )
711
712 endif
713
714 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
715 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
716 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
717
718 if (theSimulationMode .eq. REVERSE_SIMULATION) then
719
720 _BEGIN_MASTER( mythid )
721
722 call mdsreadfieldyz(
723 & active_var_file,
724 & prec,
725 & 'RL',
726 & mynr,
727 & active_data_t,
728 & irec,
729 & mythid )
730
731 c Add active_var from appropriate location to data.
732 do bj = 1,nsy
733 do bi = 1,nsx
734 do k = 1, mynr
735 do j = 1,sny
736 active_var(j,k,bi,bj) =
737 & active_var(j,k,bi,bj) +
738 & active_data_t(j,k,bi,bj)
739 active_data_t(j,k,bi,bj) = 0. _d 0
740 enddo
741 enddo
742 enddo
743 enddo
744 call mdswritefieldyz(
745 & active_var_file,
746 & prec,
747 & globalfile,
748 & 'RL',
749 & mynr,
750 & active_data_t,
751 & irec,
752 & myOptimIter,
753 & mythid )
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