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

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

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


Revision 1.3 - (show annotations) (download)
Sun Apr 5 07:06:45 2015 UTC (9 years 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.2: +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_write_xy.F,v 1.2 2015/02/14 23:56:59 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 globalFile
31 LOGICAL useCurrentDir
32 Real*8 active_var_p(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
33 INTEGER ILNBLNK
34 EXTERNAL ILNBLNK
35
36 #ifdef ALLOW_OPENAD_ACTIVE_WRITE
37
38 myNr = 1
39 globalFile = .FALSE.
40 useCurrentDir = .FALSE.
41
42 if (our_rev_mode%plain) then
43 our_orig_mode = our_rev_mode
44 ! original function
45 active_var_p = active_var%v
46 ! set up for plain execution
47 our_rev_mode%arg_store=.FALSE.
48 our_rev_mode%arg_restore=.FALSE.
49 our_rev_mode%plain=.TRUE.
50 our_rev_mode%tape=.FALSE.
51 our_rev_mode%adjoint=.FALSE.
52 call ACTIVE_WRITE_3D_RL(
53 & active_var_file, active_var_p, globalFile,
54 & useCurrentDir, iRec, myNr,
55 & FORWARD_SIMULATION, myOptimIter, myThid )
56 ! reset the mode
57 our_rev_mode=our_orig_mode
58 ! copy back
59 active_var%v = active_var_p
60 end if
61
62 if (our_rev_mode%tape) then
63 ! taping
64 our_orig_mode=our_rev_mode
65 ! original function
66 active_var_p = active_var%v
67 our_rev_mode%arg_store=.FALSE.
68 our_rev_mode%arg_restore=.FALSE.
69 our_rev_mode%plain=.TRUE.
70 our_rev_mode%tape=.FALSE.
71 our_rev_mode%adjoint=.FALSE.
72 if (oad_st_sz.lt.oad_st_ptr) call oad_st_grow()
73 oad_st(oad_st_ptr) = active_var_file
74 oad_st_ptr = oad_st_ptr+1
75 if (oad_it_sz.lt.oad_it_ptr) call oad_it_grow()
76 oad_it(oad_it_ptr) = iRec
77 oad_it_ptr = oad_it_ptr+1
78 call ACTIVE_WRITE_3D_RL(
79 & active_var_file, active_var_p, globalFile,
80 & useCurrentDir, iRec, myNr,
81 & FORWARD_SIMULATION, myOptimIter, myThid )
82 our_rev_mode=our_orig_mode
83 ! copy back
84 active_var%v = active_var_p
85 end if
86
87 if (our_rev_mode%adjoint) then
88 ! adjoint
89 oad_st_ptr = oad_st_ptr-1
90 active_var_file = oad_st(oad_st_ptr)
91 oad_it_ptr = oad_it_ptr-1
92 iRec = oad_it(oad_it_ptr)
93 adpref = 'ad'
94 il = ILNBLNK( active_var_file )
95 WRITE(fname(1:80),'(A)') ' '
96 WRITE(fname(1:2+il),'(2A)') adpref, active_var_file(1:il)
97 ! WRITE(fname(1:2+il),'(2A)') adpref, active_var_file
98 active_var_p = active_var%d
99 ! set up for plain execution
100 our_orig_mode=our_rev_mode
101 our_rev_mode%arg_store=.FALSE.
102 our_rev_mode%arg_restore=.FALSE.
103 our_rev_mode%plain=.TRUE.
104 our_rev_mode%tape=.FALSE.
105 our_rev_mode%adjoint=.FALSE.
106 call ACTIVE_WRITE_3D_RL(
107 & fname, active_var_p, globalFile,
108 & useCurrentDir, iRec, myNr,
109 & REVERSE_SIMULATION, myOptimIter, myThid )
110 ! reset the mode
111 our_rev_mode=our_orig_mode
112 ! copy back
113 active_var%d = active_var_p
114 end if
115
116 #endif /* ALLOW_OPENAD_ACTIVE_WRITE */
117
118 end

  ViewVC Help
Powered by ViewVC 1.1.22