OpenAD - Adjoint Code for Toy Problem

Similar to the tangent-linear model, the transformation for the toy problem
        subroutine head(x,y) 
double precision,intent(in) :: x
double precision,intent(out) :: y
y=sin(x*x)
end subroutine
leads to a slightly more complex code with additional temporary variables due to possible aliasing. We show colored sections for
Note that the generated code contains sections for argument and result checkpointing. The split reversal, however, does not use  any checkpointing.
       subroutine head(X,Y)
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

use w2f__types
use active_module
IMPLICIT NONE
C
C **** Global Variables ****
C
REAL(w2f__8) OpenAD_Symbol_0
REAL(w2f__8) OpenAD_Symbol_1
REAL(w2f__8) OpenAD_Symbol_2
REAL(w2f__8) OpenAD_Symbol_3
REAL(w2f__8) OpenAD_Symbol_4
REAL(w2f__8) OpenAD_Symbol_5
type(active) :: OpenAD_Symbol_6
C
C **** Parameters and Result ****
C
type(active) :: X
type(active) :: Y
C
C **** Local Variables and functions ****
C
REAL(w2f__8) OpenAD_Symbol_7
C
C **** statements ****
C


! checkpointing stacks and offsets
integer, parameter :: theMaxStackSize=200

integer :: cp_loop_variable_1,cp_loop_variable_2,
+cp_loop_variable_3,cp_loop_variable_4
! floats 'F'
double precision, dimension(theMaxStackSize), save ::
+theArgFStack
integer, save :: theArgFStackoffset=0
double precision, dimension(theMaxStackSize), save ::
+theResFStack
integer, save :: theResFStackoffset=0
! integers 'I'
integer, dimension(theMaxStackSize), save ::
+theArgIStack
integer, save :: theArgIStackoffset=0
integer, dimension(theMaxStackSize), save ::
+theResIStack
integer, save :: theResIStackoffset=0
! booleans 'B'
logical, dimension(theMaxStackSize), save ::
+theArgBStack
integer, save :: theArgBStackoffset=0
logical, dimension(theMaxStackSize), save ::
+theResBStack
integer, save :: theResBStackoffset=0
! strings 'S'
character*(80), dimension(theMaxStackSize), save ::
+theArgSStack
integer, save :: theArgSStackoffset=0
character*(80), dimension(theMaxStackSize), save ::
+theResSStack
integer, save :: theResSStackoffset=0

! call external C function used in inlined code
integer iaddr
external iaddr
call tape_init

if (our_rev_mode%arg_store) then
! store arguments
theArgFStackoffset = theArgFStackoffset+1
theArgFStack(theArgFStackoffset) = X%v
end if
if (our_rev_mode%arg_restore) then
! restore arguments
X%v = theArgFStack(theArgFStackoffset)
theArgFStackoffset = theArgFStackoffset-1
end if
if (our_rev_mode%plain) then
! original function
Y%v = SIN(X%v*X%v)

end if
if (our_rev_mode%tape) then
! taping
OpenAD_Symbol_0 = (X%v*X%v)
OpenAD_Symbol_4 = SIN(OpenAD_Symbol_0)
OpenAD_Symbol_2 = X%v
OpenAD_Symbol_3 = X%v
OpenAD_Symbol_1 = COS(OpenAD_Symbol_0)
Y%v = OpenAD_Symbol_4
OpenAD_Symbol_5 = ((OpenAD_Symbol_3 + OpenAD_Symbol_2) * OpenAD_S
+ymbol_1)
double_tape(double_tape_pointer) = OpenAD_Symbol_5
double_tape_pointer = double_tape_pointer+1

end if
if (our_rev_mode%res_store) then
! store results
theResFStackoffset = theResFStackoffset+1
theResFStack(theResFStackoffset) = Y%v
end if
if (our_rev_mode%res_restore) then
! restore results
Y%v = theResFStack(theResFStackoffset)
theResFStackoffset = theResFStackoffset-1
end if
if (our_rev_mode%adjoint) then
! adjoint
double_tape_pointer = double_tape_pointer-1
OpenAD_Symbol_7 = double_tape(double_tape_pointer)
OpenAD_Symbol_6%d = OpenAD_Symbol_6%d+Y%d*OpenAD_Symbol_7
Y%d = 0.0d0
X%d = X%d+OpenAD_Symbol_6%d
OpenAD_Symbol_6%d = 0.0d0
end if
end subroutine head