/[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.2 - (show 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
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 CBOP
25 C !ROUTINE: active_read_xz_rl
26 C !INTERFACE:
27 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 C !DESCRIPTION: \bv
40 c ==================================================================
41 c SUBROUTINE active_read_xz_rl
42 c ==================================================================
43 c o Read an active sliced xz _RL variable from file.
44 c started: heimbach@mit.edu 05-Mar-2001
45 c ==================================================================
46 c SUBROUTINE active_read_xz_rl
47 c ==================================================================
48 C \ev
49
50 C !USES:
51 implicit none
52
53 c == global variables ==
54 #include "EEPARAMS.h"
55 #include "SIZE.h"
56 #include "PARAMS.h"
57
58 C !INPUT/OUTPUT PARAMETERS:
59 c == routine arguments ==
60 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 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 C !LOCAL VARIABLES:
82 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 CEOP
99
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 CBOP
231 C !ROUTINE: active_write_xz_rl
232 C !INTERFACE:
233 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 C !DESCRIPTION: \bv
245 c ==================================================================
246 c SUBROUTINE active_write_xz_rl
247 c ==================================================================
248 c o Write an active xz _RL variable to a file.
249 c started: heimbach@mit.edu 05-Mar-2001
250 c ==================================================================
251 c SUBROUTINE active_write_xz_rl
252 c ==================================================================
253 C \ev
254
255 C !USES:
256 implicit none
257
258 c == global variables ==
259 #include "EEPARAMS.h"
260 #include "SIZE.h"
261 #include "PARAMS.h"
262
263 C !INPUT/OUTPUT PARAMETERS:
264 c == routine arguments ==
265 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 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 C !LOCAL VARIABLES:
286 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 CEOP
295
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 CBOP
381 C !ROUTINE: active_read_yz_rl
382 C !INTERFACE:
383 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 C !DESCRIPTION: \bv
396 c ==================================================================
397 c SUBROUTINE active_read_yz_rl
398 c ==================================================================
399 c o Read an active sliced yz _RL variable from file.
400 c started: heimbach@mit.edu 05-Mar-2001
401 c ==================================================================
402 c SUBROUTINE active_read_yz_rl
403 c ==================================================================
404 C \ev
405
406 C !USES:
407 implicit none
408
409 c == global variables ==
410 #include "EEPARAMS.h"
411 #include "SIZE.h"
412 #include "PARAMS.h"
413
414 C !INPUT/OUTPUT PARAMETERS:
415 c == routine arguments ==
416 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 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 C !LOCAL VARIABLES:
438 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 CEOP
455
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 CBOP
587 C !ROUTINE: active_write_yz_rl
588 C !INTERFACE:
589 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 C !DESCRIPTION: \bv
601 c ==================================================================
602 c SUBROUTINE active_write_yz_rl
603 c ==================================================================
604 c o Write an active yz _RL variable to a file.
605 c started: heimbach@mit.edu 05-Mar-2001
606 c ==================================================================
607 c SUBROUTINE active_write_yz_rl
608 c ==================================================================
609 C \ev
610
611 C !USES:
612 implicit none
613
614 c == global variables ==
615 #include "EEPARAMS.h"
616 #include "SIZE.h"
617 #include "PARAMS.h"
618
619 C !INPUT/OUTPUT PARAMETERS:
620 c == routine arguments ==
621 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 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 C !LOCAL VARIABLES:
642 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 CEOP
651
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