/[MITgcm]/MITgcm/tools/OAD_support/ad_template.active_read_xy.F
ViewVC logotype

Contents of /MITgcm/tools/OAD_support/ad_template.active_read_xy.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.5 - (show annotations) (download)
Sun Apr 5 07:06:45 2015 UTC (4 years, 3 months ago) by dgoldberg
Branch: MAIN
CVS Tags: checkpoint66g, checkpoint66f, checkpoint66e, checkpoint66d, checkpoint66c, checkpoint66b, checkpoint66a, checkpoint66o, checkpoint66n, checkpoint66m, checkpoint66l, checkpoint66k, checkpoint66j, checkpoint66i, checkpoint66h, checkpoint65z, checkpoint65x, checkpoint65y, checkpoint65r, checkpoint65s, checkpoint65p, checkpoint65q, checkpoint65v, checkpoint65w, checkpoint65t, checkpoint65u, checkpoint65n, checkpoint65o, checkpoint65l, checkpoint65m, HEAD
Changes since 1.4: +6 -2 lines
previous version was passing active array to subroutine expecting _RL array arg

1 ! $Header: /u/gcmpack/MITgcm/tools/OAD_support/ad_template.active_read_xy.F,v 1.4 2015/02/18 12:39:27 heimbach Exp $
2 ! $Name: $
3
4 #include "OPENAD_OPTIONS.h"
5
6 subroutine template()
7 C !FUNCTIONS
8 use OAD_tape
9 use OAD_rev
10 use OAD_cp
11
12
13 ! original arguments get inserted before version
14 ! ! and declared here together with all local variables
15 ! ! generated by xaifBooster
16
17 !use mode_variables
18
19 !$TEMPLATE_PRAGMA_DECLARATIONS
20 type(modeType) :: our_orig_mode
21
22 integer iaddr
23 external iaddr
24
25 !LOCAL VARIABLES:
26 CHARACTER*(2) adpref
27 CHARACTER*(80) fname
28 INTEGER il
29 INTEGER myNr
30 LOGICAL useCurrentDir
31 Real*8 active_var_p(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
32 INTEGER ILNBLNK
33 EXTERNAL ILNBLNK
34
35 #ifdef ALLOW_OPENAD_ACTIVE_READ_XY
36
37 myNr = 1
38 useCurrentDir = .FALSE.
39
40 if (our_rev_mode%plain) then
41 our_orig_mode = our_rev_mode
42 ! original function
43 active_var_p = active_var%v
44 ! set up for plain execution
45 our_rev_mode%arg_store=.FALSE.
46 our_rev_mode%arg_restore=.FALSE.
47 our_rev_mode%plain=.TRUE.
48 our_rev_mode%tape=.FALSE.
49 our_rev_mode%adjoint=.FALSE.
50 call ACTIVE_READ_3D_RL(
51 & active_var_file, active_var_p, doglobalread,
52 & useCurrentDir, lAdInit, iRec, myNr,
53 & FORWARD_SIMULATION, myOptimIter, myThid )
54 ! reset the mode
55 our_rev_mode=our_orig_mode
56 ! copy back
57 active_var%v = active_var_p
58 end if
59
60 if (our_rev_mode%tape) then
61 ! taping
62 our_orig_mode=our_rev_mode
63 ! original function
64 active_var_p = active_var%v
65 our_rev_mode%arg_store=.FALSE.
66 our_rev_mode%arg_restore=.FALSE.
67 our_rev_mode%plain=.TRUE.
68 our_rev_mode%tape=.FALSE.
69 our_rev_mode%adjoint=.FALSE.
70 if (oad_st_sz.lt.oad_st_ptr) call oad_st_grow()
71 oad_st(oad_st_ptr) = active_var_file
72 oad_st_ptr = oad_st_ptr+1
73 if (oad_it_sz.lt.oad_it_ptr) call oad_it_grow()
74 oad_it(oad_it_ptr) = iRec
75 oad_it_ptr = oad_it_ptr+1
76 call ACTIVE_READ_3D_RL(
77 & active_var_file, active_var_p, doglobalread,
78 & useCurrentDir, lAdInit, iRec, myNr,
79 & FORWARD_SIMULATION, myOptimIter, myThid )
80 our_rev_mode=our_orig_mode
81 ! copy back
82 active_var%v = active_var_p
83 end if
84
85 if (our_rev_mode%adjoint) then
86 ! adjoint
87 oad_st_ptr = oad_st_ptr-1
88 active_var_file = oad_st(oad_st_ptr)
89 oad_it_ptr = oad_it_ptr-1
90 iRec = oad_it(oad_it_ptr)
91 adpref = 'ad'
92 il = ILNBLNK( active_var_file )
93 WRITE(fname(1:80),'(A)') ' '
94 WRITE(fname(1:2+il),'(2A)') adpref, active_var_file(1:il)
95 ! WRITE(fname(1:2+il),'(2A)') adpref, active_var_file
96 active_var_p = active_var%d
97 ! set up for plain execution
98 our_orig_mode=our_rev_mode
99 our_rev_mode%arg_store=.FALSE.
100 our_rev_mode%arg_restore=.FALSE.
101 our_rev_mode%plain=.TRUE.
102 our_rev_mode%tape=.FALSE.
103 our_rev_mode%adjoint=.FALSE.
104 call ACTIVE_READ_3D_RL(
105 & fname, active_var_p, doglobalread,
106 & useCurrentDir, lAdInit, iRec, myNr,
107 & REVERSE_SIMULATION, myOptimIter, myThid )
108 ! reset the mode
109 our_rev_mode=our_orig_mode
110 ! copy back
111 active_var%d = active_var_p
112 end if
113
114 #endif /* ALLOW_OPENAD_ACTIVE_READ_XY */
115
116 end

  ViewVC Help
Powered by ViewVC 1.1.22