tools/OAD_support/ad_template.exch1_rs.F

8702af1f36 Patr*0001 #include "CPP_EEOPTIONS.h"
                0002       subroutine template()
                0003       use OAD_tape
                0004       use OAD_rev
                0005
                0006 !$TEMPLATE_PRAGMA_DECLARATIONS
                0007
                0008       type(modeType) :: our_orig_mode
                0009
                0010 c lovcal vars:
                0011       INTEGER , PARAMETER :: nArgsHelper=9
                0012       INTEGER argsHelper(nArgsHelper)
                0013       _RS     array_p( 1-myOLw:sNx+myOLe,
                0014      &               1-myOLs:sNy+myOLn,
                0015      &               myNz, nSx, nSy )
                0016
                0017 #ifdef OAD_DEBUG_SPLIT1
                0018       character*(80):: indentation='
                0019      +                                         '
                0020       our_indent=our_indent+1
                0021
                0022       write(standardmessageunit, '(A,A,A)', ADVANCE='NO')
                0023      +'OAD:',indentation(1:our_indent), 'enter __SRNAME__:'
                0024       call oad_dump_revmod(); call oad_dump_tapestats()
                0025       write(standardmessageunit,*)
                0026 #endif
                0027
                0028       if (our_rev_mode%plain) then
                0029 #ifdef OAD_DEBUG_SPLIT1
                0030          write(standardmessageunit,'(A,A,A)')
                0031      +'OAD:',indentation(1:our_indent),
                0032      +' __SRNAME__: entering plain'
                0033 #endif
                0034 c copy the values
                0035          array_p = array%v
                0036 c keep the mode
                0037          our_orig_mode=our_rev_mode
                0038 c set up for plain execution
                0039          call OAD_revPlain()
                0040 c do it
                0041          call EXCH1_RS(
                0042      U                 array_p,
                0043      I                 myOLw, myOLe, myOLs, myOLn, myNz,
                0044      I                 exchWidthX, exchWidthY,
                0045      I                 cornerMode, myThid )
                0046 c reset the mode
                0047          our_rev_mode=our_orig_mode
                0048 c copy back
                0049          array%v = array_p
                0050       end if
                0051       if (our_rev_mode%tape) then
                0052 #ifdef OAD_DEBUG_SPLIT1
                0053          write(standardmessageunit,'(A,A,A)')
                0054      +'OAD:',indentation(1:our_indent),
                0055      +' __SRNAME__: entering tape'
                0056 #endif
                0057 c copy the values
                0058          array_p = array%v
                0059 c copy the args in case they are overwritte
                0060          argsHelper=(/myOLw, myOLe, myOLs, myOLn, myNz,exchWidthX,
                0061      +exchWidthY,cornerMode, myThid/)
                0062 c keep the mode
                0063          our_orig_mode=our_rev_mode
                0064 c set up for plain execution
                0065          call OAD_revPlain()
                0066 c do it
                0067          call EXCH1_RS(
                0068      U                 array_p,
                0069      I                 myOLw, myOLe, myOLs, myOLn, myNz,
                0070      I                 exchWidthX, exchWidthY,
                0071      I                 cornerMode, myThid )
                0072 c reset the mode
                0073          our_rev_mode=our_orig_mode
                0074 c copy back
                0075          array%v = array_p
                0076 c store the args:
                0077          if(oad_it_sz.lt. oad_it_ptr+nArgsHelper) call oad_it_grow()
                0078          oad_it(oad_it_ptr:oad_it_ptr+nArgsHelper-1)=argsHelper
                0079          oad_it_ptr=oad_it_ptr+nArgsHelper
                0080       end if
                0081       if (our_rev_mode%adjoint) then
                0082 c restore the args:
                0083       oad_it_ptr=oad_it_ptr-nArgsHelper
                0084       argsHelper=oad_it(oad_it_ptr:oad_it_ptr+nArgsHelper-1)
                0085 #ifdef OAD_DEBUG_SPLIT1
                0086          write(standardmessageunit,'(A,A,A)')
                0087      +'OAD:',indentation(1:our_indent),
                0088      +' __SRNAME__: entering adjoint'
                0089 #endif
                0090 c copy the adjoints
                0091          array_p = array%d
                0092 c keep the mode
                0093          our_orig_mode=our_rev_mode
                0094 c set up for plain execution
                0095          call OAD_revPlain()
                0096 c call the manual adjoint
                0097          call EXCH1_RS_AD(
                0098      U                 array_p,
                0099      I                 argsHelper(1),argsHelper(2),argsHelper(3),
                0100      I                 argsHelper(4),argsHelper(5),argsHelper(6),
                0101      I                 argsHelper(7),argsHelper(8),argsHelper(9) )
                0102 c reset the mode
                0103          our_rev_mode=our_orig_mode
                0104 c copy back
                0105          array%d = array_p
                0106       end if
                0107
                0108 #ifdef OAD_DEBUG_SPLIT1
                0109       write(standardmessageunit,'(A,A,A)', ADVANCE='NO')
                0110      +'OAD:',indentation(1:our_indent), 'leave __SRNAME__:'
                0111       call oad_dump_revmod(); call oad_dump_tapestats()
                0112       write(standardmessageunit,*)
                0113
                0114       our_indent=our_indent-1
                0115 #endif
                0116
                0117       end subroutine template