SICOPOLIS V5-dev  Revision 1264
oad_template_my_erfc.f90
Go to the documentation of this file.
1  subroutine template()
2 
3  use oad_tape
4  use oad_rev
5  use oad_sico_variables_m, only : pi
6 !$TEMPLATE_PRAGMA_DECLARATIONS
7 
8 
9  type(modetype) :: our_orig_mode
10  real(8) :: tempval
11 !
12 ! **** Statements ****
13 !
14 
15 
16  integer iaddr
17  external iaddr
18 
19  if (our_rev_mode%plain) then
20 ! original function
21  retval%v = erfc(x%v)
22  end if
23  if (our_rev_mode%tape) then
24 ! taping
25 ! set up for plain execution
26  our_orig_mode=our_rev_mode
27  our_rev_mode%arg_store=.false.
28  our_rev_mode%arg_restore=.false.
29  our_rev_mode%plain=.true.
30  our_rev_mode%tape=.false.
31  our_rev_mode%adjoint=.false.
32  print *, "Before sorsTP integer_tape_pointer ", oad_it_ptr
33  print *, "Before sorsTP double_tape_pointer ", oad_dt_ptr
34  if (oad_dt_sz.lt.oad_dt_ptr) call oad_dt_grow()
35  oad_dt(oad_dt_ptr) = -1*2*exp(-1*(x%v*x%v))/sqrt(pi)
36  oad_dt_ptr = oad_dt_ptr+1
37  retval%v = erfc(x%v)
38  our_rev_mode=our_orig_mode
39  end if
40  if (our_rev_mode%adjoint) then
41 ! adjoint
42  our_orig_mode=our_rev_mode
43  our_rev_mode%arg_store=.false.
44  our_rev_mode%arg_restore=.false.
45  our_rev_mode%plain=.true.
46  our_rev_mode%tape=.false.
47  our_rev_mode%adjoint=.false.
48  oad_dt_ptr = oad_dt_ptr-1
49  tempval = oad_dt(oad_dt_ptr)
50  x%d = x%d+tempval*retval%d
51  retval%d = 0.0
52  print *, "After sorsAD integer_tape_pointer ", oad_it_ptr
53  print *, "After sorsAD double_tape_pointer ", oad_dt_ptr
54  our_rev_mode=our_orig_mode
55  end if
56  end subroutine template
subroutine template()