C ========== begin copyright notice ============== C This file is part of C --------------- C xaifBooster C --------------- C Distributed under the BSD license as follows: C Copyright (c) 2005, The University of Chicago C All rights reserved. C C Redistribution and use in source and binary forms, C with or without modification, are permitted provided that the following conditions are met: C C - Redistributions of source code must retain the above copyright notice, C this list of conditions and the following disclaimer. C - Redistributions in binary form must reproduce the above copyright notice, C this list of conditions and the following disclaimer in the documentation C and/or other materials provided with the distribution. C - Neither the name of The University of Chicago nor the names of its contributors C may be used to endorse or promote products derived from this software without C specific prior written permission. C C THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY C EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES C OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT C SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, C INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, C PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS C INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT C LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE C OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. C C General Information: C xaifBooster is intended for the transformation of C numerical programs represented as xml files according C to the XAIF schema. It is part of the OpenAD framework. C The main application is automatic C differentiation, i.e. the generation of code for C the computation of derivatives. C The following people are the principal authors of the C current version: C Uwe Naumann C Jean Utke C Additional contributors are: C Andrew Lyons C Peter Fine C C For more details about xaifBooster and its use in OpenAD please visit: C http://www.mcs.anl.gov/openad C C This work is partially supported by: C NSF-ITR grant OCE-0205590 C ========== end copyright notice ============== subroutine template() use OpenAD_dct use OpenAD_tape use OpenAD_rev use OpenAD_checkpoints ! original arguments get inserted before version ! and declared here together with all local variables ! generated by xaifBooster !$TEMPLATE_PRAGMA_DECLARATIONS ! checkpointing stacks and offsets integer :: cp_loop_variable_1,cp_loop_variable_2, +cp_loop_variable_3,cp_loop_variable_4 ! floats 'F' double precision, dimension(:), allocatable, save :: +theArgFStack integer, save :: theArgFStackoffset=0, theArgFStackSize=0 double precision, dimension(:), allocatable, save :: +theResFStack integer, save :: theResFStackoffset=0, theResFStackSize=0 ! integers 'I' integer, dimension(:), allocatable, save :: +theArgIStack integer, save :: theArgIStackoffset=0, theArgIStackSize=0 integer, dimension(:), allocatable, save :: +theResIStack integer, save :: theResIStackoffset=0, theResIStackSize=0 ! booleans 'B' logical, dimension(:), allocatable, save :: +theArgBStack integer, save :: theArgBStackoffset=0, theArgBStackSize=0 logical, dimension(:), allocatable, save :: +theResBStack integer, save :: theResBStackoffset=0, theResBStackSize=0 ! strings 'S' character*(80), dimension(:), allocatable, save :: +theArgSStack integer, save :: theArgSStackoffset=0, theArgSStackSize=0 character*(80), dimension(:), allocatable, save :: +theResSStack integer, save :: theResSStackoffset=0, theResSStackSize=0 type(modeType) :: our_orig_mode ! call external C function used in inlined code integer iaddr external iaddr C write(*,'(A,I6,A,I6,A,I6,A,I6,A,I5,A,I5)') C +"b:AF:", theArgFStackoffset, C +" AI:",theArgIStackoffset, C +" RF:",theResFStackoffset, C +" RI:",theResIStackoffset, C +" DT:",double_tape_pointer, C +" IT:",integer_tape_pointer if (our_rev_mode%arg_store) then C print*, " arg_store ", our_rev_mode C store arguments !$PLACEHOLDER_PRAGMA$ id=4 end if if (our_rev_mode%arg_restore) then C print*, " arg_restore", our_rev_mode C restore arguments !$PLACEHOLDER_PRAGMA$ id=6 end if if (our_rev_mode%plain) then C print*, " plain ", our_rev_mode our_orig_mode=our_rev_mode our_rev_mode%arg_store=.FALSE. C original function !$PLACEHOLDER_PRAGMA$ id=1 our_rev_mode=our_orig_mode end if if (our_rev_mode%tape) then C print*, " tape ", our_rev_mode our_rev_mode%arg_store=.TRUE. our_rev_mode%arg_restore=.FALSE. our_rev_mode%res_store=.FALSE. our_rev_mode%res_restore=.FALSE. our_rev_mode%plain=.TRUE. our_rev_mode%tape=.FALSE. our_rev_mode%adjoint=.FALSE. C taping !$PLACEHOLDER_PRAGMA$ id=2 our_rev_mode%arg_store=.FALSE. our_rev_mode%arg_restore=.FALSE. our_rev_mode%res_store=.FALSE. our_rev_mode%res_restore=.FALSE. our_rev_mode%plain=.FALSE. our_rev_mode%tape=.FALSE. our_rev_mode%adjoint=.TRUE. end if if (our_rev_mode%res_restore) then C restore results !$PLACEHOLDER_PRAGMA$ id=7 end if if (our_rev_mode%adjoint) then C print*, " adjoint ", our_rev_mode our_rev_mode%arg_store=.FALSE. our_rev_mode%arg_restore=.TRUE. our_rev_mode%res_store=.FALSE. our_rev_mode%res_restore=.FALSE. our_rev_mode%plain=.FALSE. our_rev_mode%tape=.TRUE. our_rev_mode%adjoint=.FALSE. C adjoint !$PLACEHOLDER_PRAGMA$ id=3 our_rev_mode%arg_store=.FALSE. our_rev_mode%arg_restore=.TRUE. our_rev_mode%res_store=.FALSE. our_rev_mode%res_restore=.FALSE. our_rev_mode%plain=.FALSE. our_rev_mode%tape=.TRUE. our_rev_mode%adjoint=.FALSE. end if if (our_rev_mode%res_store) then C store results C print*, " res_store ", our_rev_mode !$PLACEHOLDER_PRAGMA$ id=5 end if C write(*,'(A,I6,A,I6,A,I6,A,I6,A,I5,A,I5)') C +"a:AF:", theArgFStackoffset, C +" AI:",theArgIStackoffset, C +" RF:",theResFStackoffset, C +" RI:",theResIStackoffset, C +" DT:",double_tape_pointer, C +" IT:",integer_tape_pointer end subroutine template