tools/OAD_support/ad_template.active_write_xy.F

4a33dbfb87 Patr*0001 #include "OPENAD_OPTIONS.h"
                0002
1a5e3fa960 Patr*0003       subroutine template()
4a33dbfb87 Patr*0004 C     !FUNCTIONS
1a5e3fa960 Patr*0005       use OAD_tape
                0006       use OAD_rev
                0007       use OAD_cp
                0008
                0009
                0010 ! original arguments get inserted before version
                0011 !         ! and declared here together with all local variables
                0012 !         ! generated by xaifBooster
                0013
                0014 !use mode_variables
                0015
                0016 !$TEMPLATE_PRAGMA_DECLARATIONS
                0017       type(modeType) :: our_orig_mode
                0018
                0019       integer iaddr
                0020       external iaddr
                0021
                0022 !LOCAL VARIABLES:
                0023       CHARACTER*(2) adpref
                0024       CHARACTER*(80) fname
                0025       INTEGER il
                0026       INTEGER myNr
4a33dbfb87 Patr*0027       LOGICAL globalFile
1a5e3fa960 Patr*0028       LOGICAL useCurrentDir
                0029       Real*8  active_var_p(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
4a33dbfb87 Patr*0030       INTEGER  ILNBLNK
                0031       EXTERNAL ILNBLNK
                0032
                0033 #ifdef ALLOW_OPENAD_ACTIVE_WRITE
1a5e3fa960 Patr*0034
                0035       myNr = 1
d6c4472d2f Patr*0036       globalFile = .FALSE.
1a5e3fa960 Patr*0037       useCurrentDir = .FALSE.
                0038
                0039       if (our_rev_mode%plain) then
4a33dbfb87 Patr*0040          our_orig_mode = our_rev_mode
1a5e3fa960 Patr*0041 ! original function
                0042          active_var_p = active_var%v
                0043 ! set up for plain execution
                0044          our_rev_mode%arg_store=.FALSE.
                0045          our_rev_mode%arg_restore=.FALSE.
                0046          our_rev_mode%plain=.TRUE.
                0047          our_rev_mode%tape=.FALSE.
                0048          our_rev_mode%adjoint=.FALSE.
4a33dbfb87 Patr*0049          call ACTIVE_WRITE_3D_RL(
                0050      &        active_var_file, active_var_p, globalFile,
                0051      &        useCurrentDir, iRec, myNr,
1a5e3fa960 Patr*0052      &        FORWARD_SIMULATION, myOptimIter, myThid )
                0053 ! reset the mode
                0054          our_rev_mode=our_orig_mode
                0055 ! copy back
                0056          active_var%v = active_var_p
                0057       end if
                0058
                0059       if (our_rev_mode%tape) then
                0060 ! taping
4a33dbfb87 Patr*0061          our_orig_mode=our_rev_mode
e3c770b7ff Dani*0062 ! original function
                0063          active_var_p = active_var%v
4a33dbfb87 Patr*0064          our_rev_mode%arg_store=.FALSE.
                0065          our_rev_mode%arg_restore=.FALSE.
                0066          our_rev_mode%plain=.TRUE.
                0067          our_rev_mode%tape=.FALSE.
                0068          our_rev_mode%adjoint=.FALSE.
                0069          if (oad_st_sz.lt.oad_st_ptr) call oad_st_grow()
                0070          oad_st(oad_st_ptr) = active_var_file
                0071          oad_st_ptr = oad_st_ptr+1
                0072          if (oad_it_sz.lt.oad_it_ptr) call oad_it_grow()
                0073          oad_it(oad_it_ptr) = iRec
                0074          oad_it_ptr = oad_it_ptr+1
                0075          call ACTIVE_WRITE_3D_RL(
e3c770b7ff Dani*0076      &        active_var_file, active_var_p, globalFile,
4a33dbfb87 Patr*0077      &        useCurrentDir, iRec, myNr,
1a5e3fa960 Patr*0078      &        FORWARD_SIMULATION, myOptimIter, myThid )
4a33dbfb87 Patr*0079          our_rev_mode=our_orig_mode
e3c770b7ff Dani*0080 ! copy back
                0081          active_var%v = active_var_p
1a5e3fa960 Patr*0082       end if
                0083
                0084       if (our_rev_mode%adjoint) then
                0085 ! adjoint
4a33dbfb87 Patr*0086          oad_st_ptr = oad_st_ptr-1
                0087          active_var_file = oad_st(oad_st_ptr)
                0088          oad_it_ptr = oad_it_ptr-1
                0089          iRec = oad_it(oad_it_ptr)
1a5e3fa960 Patr*0090          adpref = 'ad'
                0091          il   = ILNBLNK( active_var_file )
                0092          WRITE(fname(1:80),'(A)') ' '
4a33dbfb87 Patr*0093          WRITE(fname(1:2+il),'(2A)') adpref, active_var_file(1:il)
                0094 !         WRITE(fname(1:2+il),'(2A)') adpref, active_var_file
1a5e3fa960 Patr*0095          active_var_p = active_var%d
                0096 ! set up for plain execution
                0097          our_orig_mode=our_rev_mode
                0098          our_rev_mode%arg_store=.FALSE.
                0099          our_rev_mode%arg_restore=.FALSE.
                0100          our_rev_mode%plain=.TRUE.
                0101          our_rev_mode%tape=.FALSE.
                0102          our_rev_mode%adjoint=.FALSE.
4a33dbfb87 Patr*0103          call ACTIVE_WRITE_3D_RL(
                0104      &        fname, active_var_p, globalFile,
                0105      &        useCurrentDir, iRec, myNr,
1a5e3fa960 Patr*0106      &        REVERSE_SIMULATION, myOptimIter, myThid )
                0107 ! reset the mode
                0108          our_rev_mode=our_orig_mode
                0109 ! copy back
                0110          active_var%d = active_var_p
                0111       end if
                0112
4a33dbfb87 Patr*0113 #endif /* ALLOW_OPENAD_ACTIVE_WRITE */
                0114
1a5e3fa960 Patr*0115       end