OpenAD/code_shallow_openad/active_module.f90


        module active_module
        use w2f__types
        implicit none
        private
        public :: active, saxpy, sax, setderiv, zero_deriv, &
convert_p2a_scalar, convert_a2p_scalar, &
convert_p2a_vector, convert_a2p_vector, &
convert_p2a_matrix, convert_a2p_matrix, &
convert_p2a_three_tensor, convert_a2p_three_tensor, &
convert_p2a_four_tensor, convert_a2p_four_tensor, &
convert_p2a_five_tensor, convert_a2p_five_tensor 

        
        !
        ! active needs to be a sequence type
        !  with no initialization
        !
        type active
          sequence
          double precision :: v 
          ! initialization does not work for active variables
          ! inside of common block, such as in boxmodel
          ! initialization is required for correct adjoint
          double precision :: d=0.0
          ! double precision :: d
        end type active

        interface saxpy
          module procedure saxpy_a_a
        end interface
        
        interface setderiv
          module procedure setderiv_a_a
        end interface

        interface zero_deriv
          module procedure zero_deriv_a
        end interface
        
        interface sax
          module procedure sax_d_a_a, sax_i_a_a
        end interface

        interface convert_p2a_scalar
          module procedure convert_p2a_scalar_impl
        end interface
        interface convert_a2p_scalar
          module procedure convert_a2p_scalar_impl
        end interface

        interface convert_p2a_vector
          module procedure convert_p2a_vector_impl
        end interface
        interface convert_a2p_vector
          module procedure convert_a2p_vector_impl
        end interface

        interface convert_p2a_matrix
          module procedure convert_p2a_matrix_impl
        end interface
        interface convert_a2p_matrix
          module procedure convert_a2p_matrix_impl
        end interface

        interface convert_p2a_three_tensor
          module procedure convert_p2a_three_tensor_impl
        end interface
        interface convert_a2p_three_tensor
          module procedure convert_a2p_three_tensor_impl
        end interface

        interface convert_p2a_four_tensor
          module procedure convert_p2a_four_tensor_impl
        end interface
        interface convert_a2p_four_tensor
          module procedure convert_a2p_four_tensor_impl
        end interface

        interface convert_p2a_five_tensor
          module procedure convert_p2a_five_tensor_impl
        end interface
        interface convert_a2p_five_tensor
          module procedure convert_a2p_five_tensor_impl
        end interface

        contains
        
        !
        ! chain rule saxpy to be used in forward and reverse modes
        !
        
        subroutine saxpy_a_a(a,x,y)
          double precision, intent(in) :: a
          type(active), intent(in) :: x
          type(active), intent(inout) :: y
        
          y%d=y%d+x%d*a
        end subroutine saxpy_a_a
        
        !
        ! chain rule saxpy to be used in forward and reverse modes
        ! derivative component of y is equal to zero initially
        ! note: y needs to be inout as otherwise value component gets
        ! zeroed out
        !
        
        subroutine sax_d_a_a(a,x,y)
          double precision, intent(in) :: a
          type(active), intent(in) :: x
          type(active), intent(inout) :: y
        
          y%d=x%d*a
        end subroutine sax_d_a_a

        subroutine sax_i_a_a(a,x,y)
          integer(kind=w2f__i8), intent(in) :: a
          type(active), intent(in) :: x
          type(active), intent(inout) :: y
        
          y%d=x%d*a
        end subroutine sax_i_a_a
        
        !
        ! set derivative of y to be equal to derivative of x
        ! note: making y inout allows for already existing active
        ! variables to become the target of a derivative assignment
        !
        
        subroutine setderiv_a_a(y,x)
          type(active), intent(inout) :: y
          type(active), intent(in) :: x
        
          y%d=x%d
        end subroutine setderiv_a_a

        !
        ! set derivative components to 0.0
        !
        subroutine zero_deriv_a(x)
          type(active), intent(out) :: x

          x%d=0.0d0
        end subroutine zero_deriv_a

        subroutine convert_a2p_scalar_impl(convertTo, convertFrom)
          real(kind=w2f__8), intent(out) :: convertTo
          type(active), intent(in) :: convertFrom
          convertTo=convertFrom%v
        end subroutine

        subroutine convert_p2a_scalar_impl(convertTo, convertFrom)
          real(kind=w2f__8), intent(in) :: convertFrom
          type(active), intent(inout) :: convertTo
          convertTo%v=convertFrom
        end subroutine 

        subroutine convert_a2p_vector_impl(convertTo, convertFrom)
          type(active), dimension(:), intent(in) :: convertFrom
          real(kind=w2f__8), dimension(:), intent(out) :: convertTo
          convertTo=convertFrom%v
        end subroutine

        subroutine convert_p2a_vector_impl(convertTo, convertFrom)
          real(kind=w2f__8), dimension(:), intent(in) :: convertFrom
          type(active), dimension(:), intent(inout) :: convertTo
          convertTo%v=convertFrom
        end subroutine

        subroutine convert_a2p_matrix_impl(convertTo, convertFrom)
          type(active), dimension(:,:), intent(in) :: convertFrom
          real(kind=w2f__8), dimension(:,:), intent(out) :: convertTo
          convertTo=convertFrom%v
        end subroutine

        subroutine convert_p2a_matrix_impl(convertTo, convertFrom)
          real(kind=w2f__8), dimension(:,:), intent(in) :: convertFrom
          type(active), dimension(:,:), intent(inout) :: convertTo
          convertTo%v=convertFrom
        end subroutine

        subroutine convert_a2p_three_tensor_impl(convertTo, convertFrom)
          type(active), dimension(:,:,:), intent(in) :: convertFrom
          real(kind=w2f__8), dimension(:,:,:), intent(out) :: convertTo
          convertTo=convertFrom%v
        end subroutine

        subroutine convert_p2a_three_tensor_impl(convertTo, convertFrom)
          real(kind=w2f__8), dimension(:,:,:), intent(in) :: convertFrom
          type(active), dimension(:,:,:), intent(inout) :: convertTo
          convertTo%v=convertFrom
        end subroutine
        
        subroutine convert_a2p_four_tensor_impl(convertTo, convertFrom)
          type(active), dimension(:,:,:,:), intent(in) :: convertFrom
          real(kind=w2f__8), dimension(:,:,:,:), intent(out) :: convertTo
          convertTo=convertFrom%v
        end subroutine

        subroutine convert_p2a_four_tensor_impl(convertTo, convertFrom)
          real(kind=w2f__8), dimension(:,:,:,:), intent(in) :: convertFrom
          type(active), dimension(:,:,:,:), intent(inout) :: convertTo
          convertTo%v=convertFrom
        end subroutine

        subroutine convert_a2p_five_tensor_impl(convertTo, convertFrom)
          type(active), dimension(:,:,:,:,:), intent(in) :: convertFrom
          real(kind=w2f__8), dimension(:,:,:,:,:), intent(out) :: convertTo
          convertTo=convertFrom%v
        end subroutine

        subroutine convert_p2a_five_tensor_impl(convertTo, convertFrom)
          real(kind=w2f__8), dimension(:,:,:,:,:), intent(in) :: convertFrom
          type(active), dimension(:,:,:,:,:), intent(inout) :: convertTo
          convertTo%v=convertFrom
        end subroutine
        
        end module


1	heimbach	1.1
2			module active_module
3			use w2f__types
4			implicit none
5			private
6			public :: active, saxpy, sax, setderiv, zero_deriv, &
7	utke	1.4	convert_p2a_scalar, convert_a2p_scalar, &
8			convert_p2a_vector, convert_a2p_vector, &
9			convert_p2a_matrix, convert_a2p_matrix, &
10			convert_p2a_three_tensor, convert_a2p_three_tensor, &
11			convert_p2a_four_tensor, convert_a2p_four_tensor, &
12			convert_p2a_five_tensor, convert_a2p_five_tensor
13	heimbach	1.1
14
15			!
16			! active needs to be a sequence type
17			! with no initialization
18			!
19			type active
20			sequence
21			double precision :: v
22			! initialization does not work for active variables
23			! inside of common block, such as in boxmodel
24			! initialization is required for correct adjoint
25			double precision :: d=0.0
26			! double precision :: d
27			end type active
28
29			interface saxpy
30			module procedure saxpy_a_a
31			end interface
32
33			interface setderiv
34			module procedure setderiv_a_a
35			end interface
36
37			interface zero_deriv
38			module procedure zero_deriv_a
39			end interface
40
41			interface sax
42			module procedure sax_d_a_a, sax_i_a_a
43			end interface
44
45			interface convert_p2a_scalar
46			module procedure convert_p2a_scalar_impl
47			end interface
48			interface convert_a2p_scalar
49			module procedure convert_a2p_scalar_impl
50			end interface
51	utke	1.2
52	heimbach	1.1	interface convert_p2a_vector
53	utke	1.4	module procedure convert_p2a_vector_impl
54	heimbach	1.1	end interface
55			interface convert_a2p_vector
56	utke	1.4	module procedure convert_a2p_vector_impl
57	heimbach	1.1	end interface
58	utke	1.2
59	heimbach	1.1	interface convert_p2a_matrix
60	utke	1.4	module procedure convert_p2a_matrix_impl
61	heimbach	1.1	end interface
62			interface convert_a2p_matrix
63	utke	1.4	module procedure convert_a2p_matrix_impl
64	heimbach	1.1	end interface
65
66	utke	1.2	interface convert_p2a_three_tensor
67	utke	1.4	module procedure convert_p2a_three_tensor_impl
68	utke	1.2	end interface
69			interface convert_a2p_three_tensor
70	utke	1.4	module procedure convert_a2p_three_tensor_impl
71	utke	1.2	end interface
72
73			interface convert_p2a_four_tensor
74	utke	1.4	module procedure convert_p2a_four_tensor_impl
75	utke	1.2	end interface
76			interface convert_a2p_four_tensor
77	utke	1.4	module procedure convert_a2p_four_tensor_impl
78	utke	1.2	end interface
79
80			interface convert_p2a_five_tensor
81	utke	1.4	module procedure convert_p2a_five_tensor_impl
82	utke	1.2	end interface
83			interface convert_a2p_five_tensor
84	utke	1.4	module procedure convert_a2p_five_tensor_impl
85	utke	1.2	end interface
86
87	heimbach	1.1	contains
88
89			!
90			! chain rule saxpy to be used in forward and reverse modes
91			!
92
93			subroutine saxpy_a_a(a,x,y)
94			double precision, intent(in) :: a
95			type(active), intent(in) :: x
96			type(active), intent(inout) :: y
97
98			y%d=y%d+x%d*a
99			end subroutine saxpy_a_a
100
101			!
102			! chain rule saxpy to be used in forward and reverse modes
103			! derivative component of y is equal to zero initially
104			! note: y needs to be inout as otherwise value component gets
105			! zeroed out
106			!
107
108			subroutine sax_d_a_a(a,x,y)
109			double precision, intent(in) :: a
110			type(active), intent(in) :: x
111			type(active), intent(inout) :: y
112
113			y%d=x%d*a
114			end subroutine sax_d_a_a
115
116			subroutine sax_i_a_a(a,x,y)
117			integer(kind=w2f__i8), intent(in) :: a
118			type(active), intent(in) :: x
119			type(active), intent(inout) :: y
120
121			y%d=x%d*a
122			end subroutine sax_i_a_a
123
124			!
125			! set derivative of y to be equal to derivative of x
126			! note: making y inout allows for already existing active
127			! variables to become the target of a derivative assignment
128			!
129
130			subroutine setderiv_a_a(y,x)
131			type(active), intent(inout) :: y
132			type(active), intent(in) :: x
133
134			y%d=x%d
135			end subroutine setderiv_a_a
136
137			!
138			! set derivative components to 0.0
139			!
140			subroutine zero_deriv_a(x)
141			type(active), intent(out) :: x
142
143			x%d=0.0d0
144			end subroutine zero_deriv_a
145
146			subroutine convert_a2p_scalar_impl(convertTo, convertFrom)
147	utke	1.4	real(kind=w2f__8), intent(out) :: convertTo
148	heimbach	1.1	type(active), intent(in) :: convertFrom
149			convertTo=convertFrom%v
150			end subroutine
151
152			subroutine convert_p2a_scalar_impl(convertTo, convertFrom)
153	utke	1.4	real(kind=w2f__8), intent(in) :: convertFrom
154	utke	1.3	type(active), intent(inout) :: convertTo
155	heimbach	1.1	convertTo%v=convertFrom
156			end subroutine
157
158	utke	1.4	subroutine convert_a2p_vector_impl(convertTo, convertFrom)
159	heimbach	1.1	type(active), dimension(:), intent(in) :: convertFrom
160	utke	1.4	real(kind=w2f__8), dimension(:), intent(out) :: convertTo
161			convertTo=convertFrom%v
162	heimbach	1.1	end subroutine
163
164	utke	1.4	subroutine convert_p2a_vector_impl(convertTo, convertFrom)
165			real(kind=w2f__8), dimension(:), intent(in) :: convertFrom
166	utke	1.3	type(active), dimension(:), intent(inout) :: convertTo
167	utke	1.4	convertTo%v=convertFrom
168	heimbach	1.1	end subroutine
169
170	utke	1.4	subroutine convert_a2p_matrix_impl(convertTo, convertFrom)
171	heimbach	1.1	type(active), dimension(:,:), intent(in) :: convertFrom
172	utke	1.4	real(kind=w2f__8), dimension(:,:), intent(out) :: convertTo
173			convertTo=convertFrom%v
174	heimbach	1.1	end subroutine
175
176	utke	1.4	subroutine convert_p2a_matrix_impl(convertTo, convertFrom)
177			real(kind=w2f__8), dimension(:,:), intent(in) :: convertFrom
178	utke	1.3	type(active), dimension(:,:), intent(inout) :: convertTo
179	utke	1.4	convertTo%v=convertFrom
180	heimbach	1.1	end subroutine
181	utke	1.2
182	utke	1.4	subroutine convert_a2p_three_tensor_impl(convertTo, convertFrom)
183	utke	1.2	type(active), dimension(:,:,:), intent(in) :: convertFrom
184	utke	1.4	real(kind=w2f__8), dimension(:,:,:), intent(out) :: convertTo
185			convertTo=convertFrom%v
186	utke	1.2	end subroutine
187
188	utke	1.4	subroutine convert_p2a_three_tensor_impl(convertTo, convertFrom)
189			real(kind=w2f__8), dimension(:,:,:), intent(in) :: convertFrom
190	utke	1.3	type(active), dimension(:,:,:), intent(inout) :: convertTo
191	utke	1.4	convertTo%v=convertFrom
192	utke	1.2	end subroutine
193
194	utke	1.4	subroutine convert_a2p_four_tensor_impl(convertTo, convertFrom)
195	utke	1.2	type(active), dimension(:,:,:,:), intent(in) :: convertFrom
196	utke	1.4	real(kind=w2f__8), dimension(:,:,:,:), intent(out) :: convertTo
197			convertTo=convertFrom%v
198	utke	1.2	end subroutine
199
200	utke	1.4	subroutine convert_p2a_four_tensor_impl(convertTo, convertFrom)
201			real(kind=w2f__8), dimension(:,:,:,:), intent(in) :: convertFrom
202	utke	1.3	type(active), dimension(:,:,:,:), intent(inout) :: convertTo
203	utke	1.4	convertTo%v=convertFrom
204	utke	1.2	end subroutine
205
206	utke	1.4	subroutine convert_a2p_five_tensor_impl(convertTo, convertFrom)
207	utke	1.2	type(active), dimension(:,:,:,:,:), intent(in) :: convertFrom
208	utke	1.4	real(kind=w2f__8), dimension(:,:,:,:,:), intent(out) :: convertTo
209			convertTo=convertFrom%v
210	utke	1.2	end subroutine
211
212	utke	1.4	subroutine convert_p2a_five_tensor_impl(convertTo, convertFrom)
213			real(kind=w2f__8), dimension(:,:,:,:,:), intent(in) :: convertFrom
214	utke	1.3	type(active), dimension(:,:,:,:,:), intent(inout) :: convertTo
215	utke	1.4	convertTo%v=convertFrom
216	utke	1.2	end subroutine
217	heimbach	1.1
218			end module
219
220