/[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.1 - (show annotations) (download)
Sun Mar 25 22:33:53 2001 UTC (23 years, 2 months ago) by heimbach
Branch: MAIN
CVS Tags: checkpoint40pre3, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint40pre9, checkpoint40pre8, checkpoint38, checkpoint40pre2, checkpoint40pre4, c37_adj, checkpoint39, checkpoint40pre5, checkpoint42, checkpoint40, checkpoint41
Modifications and additions to enable automatic differentiation.
Detailed info's in doc/notes_c37_adj.txt

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 Reset default io precision.
216 readBinaryPrec = oldPrec
217
218 _BARRIER
219
220 return
221 end
222
223 c ==================================================================
224
225 subroutine active_write_xz_rl(
226 I active_var_file,
227 I active_var,
228 I globalfile,
229 I irec,
230 I mynr,
231 I theSimulationMode,
232 I myOptimIter,
233 I mythid
234 & )
235
236 c ==================================================================
237 c SUBROUTINE active_write_xz_rl
238 c ==================================================================
239 c
240 c o Write an active variable to a file.
241 c
242 c started: heimbach@mit.edu 05-Mar-2001
243 c
244 c ==================================================================
245 c SUBROUTINE active_write_xz_rl
246 c ==================================================================
247
248 implicit none
249
250 c == global variables ==
251
252 #include "EEPARAMS.h"
253 #include "SIZE.h"
254 #include "PARAMS.h"
255
256 c == routine arguments ==
257
258 character*(*) active_var_file
259
260 integer mynr
261 logical globalfile
262 integer irec
263 integer theSimulationMode
264 integer myOptimIter
265 integer mythid
266 _RL active_var(1-olx:snx+olx,mynr,nsx,nsy)
267
268 c == local variables ==
269
270 integer i,j,k
271 integer bi,bj
272 _RL active_data_t(1-olx:snx+olx,nsx,nsy)
273 integer oldprec
274 integer prec
275
276 c == end of interface ==
277
278 c force 64-bit io
279 oldPrec = readBinaryPrec
280 readBinaryPrec = precFloat64
281 prec = precFloat64
282
283 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
284 c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
285 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
286
287 if (theSimulationMode .eq. FORWARD_SIMULATION) then
288
289 _BEGIN_MASTER( mythid )
290
291 call mdswritefieldxz(
292 & active_var_file,
293 & prec,
294 & globalfile,
295 & 'RL',
296 & mynr,
297 & active_var,
298 & irec,
299 & myOptimIter,
300 & mythid )
301
302 _END_MASTER( mythid )
303
304 endif
305
306 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
307 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
308 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
309
310 if (theSimulationMode .eq. REVERSE_SIMULATION) then
311
312 _BEGIN_MASTER( mythid )
313
314 do k=1,mynr
315 c Read data from file layer by layer.
316 call mdsreadfieldxz(
317 & active_var_file,
318 & prec,
319 & 'RL',
320 & 1,
321 & active_data_t,
322 & (irec-1)*mynr+k,
323 & mythid )
324
325 c Add active_var from appropriate location to data.
326 do bj = 1,nsy
327 do bi = 1,nsx
328 do i = 1,snx
329 active_var(i,k,bi,bj) =
330 & active_var(i,k,bi,bj) +
331 & active_data_t(i,bi,bj)
332 active_data_t(i,bi,bj) = 0. _d 0
333 enddo
334 enddo
335 enddo
336 call mdswritefieldxz(
337 & active_var_file,
338 & prec,
339 & globalfile,
340 & 'RL',
341 & 1,
342 & active_data_t,
343 & (irec-1)*mynr+k,
344 & myOptimIter,
345 & mythid )
346 enddo
347
348 _END_MASTER( mythid )
349
350 endif
351
352 c Reset default io precision.
353 readBinaryPrec = oldPrec
354
355 _BARRIER
356
357 return
358 end
359
360 c ==================================================================
361
362 subroutine active_read_yz_rl(
363 I active_var_file,
364 O active_var,
365 I globalfile,
366 I lAdInit,
367 I irec,
368 I mynr,
369 I theSimulationMode,
370 I myOptimIter,
371 I mythid
372 & )
373
374 c ==================================================================
375 c SUBROUTINE active_read_yz_rl
376 c ==================================================================
377 c
378 c o Read an active variable from file.
379 c
380 c The variable *globalfile* can be used as a switch, which allows
381 c to read from a global file. The adjoint files are, however, always
382 c treated as tiled files.
383 c
384 c started: heimbach@mit.edu 05-Mar-2001
385 c
386 c ==================================================================
387 c SUBROUTINE active_read_yz_rl
388 c ==================================================================
389
390 implicit none
391
392 c == global variables ==
393
394 #include "EEPARAMS.h"
395 #include "SIZE.h"
396 #include "PARAMS.h"
397
398 c == routine arguments ==
399
400 character*(*) active_var_file
401
402 logical globalfile
403 logical lAdInit
404 integer irec
405 integer mynr
406 integer theSimulationMode
407 integer myOptimIter
408 integer mythid
409 _RL active_var(1-oly:sny+oly,mynr,nsx,nsy)
410
411 c == local variables ==
412
413 character*(2) adpref
414 character*(80) adfname
415
416 integer bi,bj
417 integer i,j,k
418 integer oldprec
419 integer prec
420 integer il
421 integer ilnblnk
422
423 logical writeglobalfile
424
425 _RL active_data_t(1-oly:sny+oly,nsx,nsy)
426
427 c == functions ==
428
429 external ilnblnk
430
431 c == end of interface ==
432
433 c force 64-bit io
434 oldPrec = readBinaryPrec
435 readBinaryPrec = precFloat64
436 prec = precFloat64
437
438 write(adfname(1:80),'(80a)') ' '
439 adpref = 'ad'
440 il = ilnblnk( active_var_file )
441
442 write(adfname(1:2),'(a)') adpref
443 write(adfname(3:il+2),'(a)') active_var_file(1:il)
444
445 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
446 c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
447 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
448
449 if (theSimulationMode .eq. FORWARD_SIMULATION) then
450
451 _BEGIN_MASTER( mythid )
452
453 c Read the active variable from file.
454
455 call mdsreadfieldyz(
456 & active_var_file,
457 & prec,
458 & 'RL',
459 & mynr,
460 & active_var,
461 & irec,
462 & mythid )
463
464 if (lAdInit) then
465 c Initialise the corresponding adjoint variable on the
466 c adjoint variable's file. These files are tiled.
467
468 writeglobalfile = .false.
469 do bj = 1,nsy
470 do bi = 1,nsx
471 do j = 1,sny
472 active_data_t(j,bi,bj)= 0. _d 0
473 enddo
474 enddo
475 enddo
476
477 do k = 1,mynr
478 call mdswritefieldyz(
479 & adfname,
480 & prec,
481 & globalfile,
482 & 'RL',
483 & 1,
484 & active_data_t,
485 & (irec-1)*mynr+k,
486 & myOptimIter,
487 & mythid )
488 enddo
489 endif
490
491 _END_MASTER( mythid )
492
493 endif
494
495 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
496 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
497 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
498
499 if (theSimulationMode .eq. REVERSE_SIMULATION) then
500
501 _BEGIN_MASTER( mythid )
502
503 writeglobalfile = .false.
504 do k=1,mynr
505 c Read data from file layer by layer.
506 call mdsreadfieldyz(
507 & active_var_file,
508 & prec,
509 & 'RL',
510 & 1,
511 & active_data_t,
512 & (irec-1)*mynr+k,
513 & mythid )
514
515 c Add active_var from appropriate location to data.
516 do bj = 1,nsy
517 do bi = 1,nsx
518 do j = 1,sny
519 active_data_t(j,bi,bj) = active_data_t(j,bi,bj) +
520 & active_var(j,k,bi,bj)
521 enddo
522 enddo
523 enddo
524
525 c Store the result on disk.
526 call mdswritefieldyz(
527 & active_var_file,
528 & prec,
529 & writeglobalfile,
530 & 'RL',
531 & 1,
532 & active_data_t,
533 & (irec-1)*mynr+k,
534 & myOptimIter,
535 & mythid )
536 enddo
537
538
539 c Set active_var to zero.
540 do k=1,mynr
541 do bj = 1,nsy
542 do bi = 1,nsx
543 do j = 1,sny
544 active_var(j,k,bi,bj) = 0. _d 0
545 enddo
546 enddo
547 enddo
548 enddo
549
550 _END_MASTER( mythid )
551 endif
552
553 c Reset default io precision.
554 readBinaryPrec = oldPrec
555
556 _BARRIER
557
558 return
559 end
560
561 c ==================================================================
562
563 subroutine active_write_yz_rl(
564 I active_var_file,
565 I active_var,
566 I globalfile,
567 I irec,
568 I mynr,
569 I theSimulationMode,
570 I myOptimIter,
571 I mythid
572 & )
573
574 c ==================================================================
575 c SUBROUTINE active_write_yz_rl
576 c ==================================================================
577 c
578 c o Write an active variable to a file.
579 c
580 c started: heimbach@mit.edu 05-Mar-2001
581 c
582 c ==================================================================
583 c SUBROUTINE active_write_yz_rl
584 c ==================================================================
585
586 implicit none
587
588 c == global variables ==
589
590 #include "EEPARAMS.h"
591 #include "SIZE.h"
592 #include "PARAMS.h"
593
594 c == routine arguments ==
595
596 character*(*) active_var_file
597
598 integer mynr
599 logical globalfile
600 integer irec
601 integer theSimulationMode
602 integer myOptimIter
603 integer mythid
604 _RL active_var(1-oly:sny+oly,mynr,nsx,nsy)
605
606 c == local variables ==
607
608 integer i,j,k
609 integer bi,bj
610 _RL active_data_t(1-oly:sny+oly,nsx,nsy)
611 integer oldprec
612 integer prec
613
614 c == end of interface ==
615
616 c force 64-bit io
617 oldPrec = readBinaryPrec
618 readBinaryPrec = precFloat64
619 prec = precFloat64
620
621 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
622 c >>>>>>>>>>>>>>>>>>> FORWARD RUN <<<<<<<<<<<<<<<<<<<
623 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
624
625 if (theSimulationMode .eq. FORWARD_SIMULATION) then
626
627 _BEGIN_MASTER( mythid )
628
629 call mdswritefieldyz(
630 & active_var_file,
631 & prec,
632 & globalfile,
633 & 'RL',
634 & mynr,
635 & active_var,
636 & irec,
637 & myOptimIter,
638 & mythid )
639
640 _END_MASTER( mythid )
641
642 endif
643
644 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
645 c >>>>>>>>>>>>>>>>>>> ADJOINT RUN <<<<<<<<<<<<<<<<<<<
646 c >>>>>>>>>>>>>>>>>>> <<<<<<<<<<<<<<<<<<<
647
648 if (theSimulationMode .eq. REVERSE_SIMULATION) then
649
650 _BEGIN_MASTER( mythid )
651
652 do k=1,mynr
653 c Read data from file layer by layer.
654 call mdsreadfieldyz(
655 & active_var_file,
656 & prec,
657 & 'RL',
658 & 1,
659 & active_data_t,
660 & (irec-1)*mynr+k,
661 & mythid )
662
663 c Add active_var from appropriate location to data.
664 do bj = 1,nsy
665 do bi = 1,nsx
666 do j = 1,sny
667 active_var(j,k,bi,bj) =
668 & active_var(j,k,bi,bj) +
669 & active_data_t(j,bi,bj)
670 active_data_t(j,bi,bj) = 0. _d 0
671 enddo
672 enddo
673 enddo
674 call mdswritefieldyz(
675 & active_var_file,
676 & prec,
677 & globalfile,
678 & 'RL',
679 & 1,
680 & active_data_t,
681 & (irec-1)*mynr+k,
682 & myOptimIter,
683 & mythid )
684 enddo
685
686 _END_MASTER( mythid )
687
688 endif
689
690 c Reset default io precision.
691 readBinaryPrec = oldPrec
692
693 _BARRIER
694
695 return
696 end
697

  ViewVC Help
Powered by ViewVC 1.1.22