SICOPOLIS V5-dev  Revision 1368
oad_template_sor_sprs.f90
Go to the documentation of this file.
1  subroutine template()
2 
3  use oad_tape
4  use oad_rev
5  use sico_maths_m, only : sor_sprs_local
7 !$TEMPLATE_PRAGMA_DECLARATIONS
8 
9 
10  type(modetype) :: our_orig_mode
11 INTEGER :: iter
12 
13 INTEGER(4) :: nr, k, i, nmax_local, nnz_local, n_sprs_local
14 real(8) :: omega_local, eps_sor_local
15 logical :: flag_convergence
16 !
17 ! **** Statements ****
18 !
19 
20 
21  integer iaddr
22  external iaddr
23 
24  if (our_rev_mode%plain) then
25 ! original function
26  call sor_sprs_local(lgs_a_value%v, lgs_a_index, &
27  lgs_a_diag_index, lgs_a_ptr, &
28  lgs_b_value%v, nnz, nmax, n_sprs, omega, &
29  eps_sor, lgs_x_value%v, ierr)
30  end if
31  if (our_rev_mode%tape) then
32 ! taping
33 ! set up for plain execution
34  our_orig_mode=our_rev_mode
35  our_rev_mode%arg_store=.false.
36  our_rev_mode%arg_restore=.false.
37  our_rev_mode%plain=.true.
38  our_rev_mode%tape=.false.
39  our_rev_mode%adjoint=.false.
40  print *, "Before sorsTP integer_tape_pointer ", oad_it_ptr
41  print *, "Before sorsTP double_tape_pointer ", oad_dt_ptr
42  do i=1,nmax
43  !double_tape(double_tape_pointer)=lgs_x_value(i)%v
44  !double_tape_pointer=double_tape_pointer+1
45  if (oad_dt_sz.lt.oad_dt_ptr) call oad_dt_grow()
46  oad_dt(oad_dt_ptr) = lgs_x_value(i)%v
47  oad_dt_ptr = oad_dt_ptr+1
48  end do
49  do i=1,nnz
50  !double_tape(double_tape_pointer)=lgs_a_value(i)%v
51  !double_tape_pointer=double_tape_pointer+1
52  if (oad_dt_sz.lt.oad_dt_ptr) call oad_dt_grow()
53  oad_dt(oad_dt_ptr) = lgs_a_value(i)%v
54  oad_dt_ptr = oad_dt_ptr+1
55  end do
56  do i=1,nmax+1
57  !integer_tape(integer_tape_pointer)=lgs_a_ptr(i)
58  !integer_tape_pointer=integer_tape_pointer+1
59  if (oad_it_sz.lt.oad_it_ptr) call oad_it_grow()
60  oad_it(oad_it_ptr) = lgs_a_ptr(i)
61  oad_it_ptr = oad_it_ptr+1
62  end do
63  do i=1,nnz
64  !integer_tape(integer_tape_pointer)=lgs_a_index(i)
65  !integer_tape_pointer=integer_tape_pointer+1
66  if (oad_it_sz.lt.oad_it_ptr) call oad_it_grow()
67  oad_it(oad_it_ptr) = lgs_a_index(i)
68  oad_it_ptr = oad_it_ptr+1
69  end do
70  do i=1,nmax
71  !integer_tape(integer_tape_pointer)=lgs_a_diag_index(i)
72  !integer_tape_pointer=integer_tape_pointer+1
73  if (oad_it_sz.lt.oad_it_ptr) call oad_it_grow()
74  oad_it(oad_it_ptr) = lgs_a_diag_index(i)
75  oad_it_ptr = oad_it_ptr+1
76  end do
77  do i=1,nmax
78  !double_tape(double_tape_pointer)=lgs_b_value(i)%v
79  !double_tape_pointer=double_tape_pointer+1
80  if (oad_dt_sz.lt.oad_dt_ptr) call oad_dt_grow()
81  oad_dt(oad_dt_ptr) = lgs_b_value(i)%v
82  oad_dt_ptr = oad_dt_ptr+1
83  end do
84  call sor_sprs_local(lgs_a_value%v, lgs_a_index, &
85  lgs_a_diag_index, lgs_a_ptr, &
86  lgs_b_value%v, nnz, nmax, n_sprs, omega, &
87  eps_sor, lgs_x_value%v, ierr)
88  do i=1,nmax
89  !double_tape(double_tape_pointer)=lgs_x_value(i)%v
90  !double_tape_pointer=double_tape_pointer+1
91  if (oad_dt_sz.lt.oad_dt_ptr) call oad_dt_grow()
92  oad_dt(oad_dt_ptr) = lgs_x_value(i)%v
93  oad_dt_ptr = oad_dt_ptr+1
94  end do
95  !double_tape(double_tape_pointer)=omega
96  !double_tape_pointer=double_tape_pointer+1
97  if (oad_dt_sz.lt.oad_dt_ptr) call oad_dt_grow()
98  oad_dt(oad_dt_ptr) = omega
99  oad_dt_ptr = oad_dt_ptr+1
100  !double_tape(double_tape_pointer)=eps_sor
101  !double_tape_pointer=double_tape_pointer+1
102  if (oad_dt_sz.lt.oad_dt_ptr) call oad_dt_grow()
103  oad_dt(oad_dt_ptr) = eps_sor
104  oad_dt_ptr = oad_dt_ptr+1
105  !integer_tape(integer_tape_pointer)=n_sprs
106  !integer_tape_pointer=integer_tape_pointer+1
107  if (oad_it_sz.lt.oad_it_ptr) call oad_it_grow()
108  oad_it(oad_it_ptr) = n_sprs
109  oad_it_ptr = oad_it_ptr+1
110  !integer_tape(integer_tape_pointer)=nnz
111  !integer_tape_pointer=integer_tape_pointer+1
112  if (oad_it_sz.lt.oad_it_ptr) call oad_it_grow()
113  oad_it(oad_it_ptr) = nnz
114  oad_it_ptr = oad_it_ptr+1
115  !integer_tape(integer_tape_pointer)=nmax
116  !integer_tape_pointer=integer_tape_pointer+1
117  if (oad_it_sz.lt.oad_it_ptr) call oad_it_grow()
118  oad_it(oad_it_ptr) = nmax
119  oad_it_ptr = oad_it_ptr+1
120  our_rev_mode=our_orig_mode
121  end if
122  if (our_rev_mode%adjoint) then
123 ! adjoint
124  our_orig_mode=our_rev_mode
125  our_rev_mode%arg_store=.false.
126  our_rev_mode%arg_restore=.false.
127  our_rev_mode%plain=.true.
128  our_rev_mode%tape=.false.
129  our_rev_mode%adjoint=.false.
130  !integer_tape_pointer=integer_tape_pointer-1
131  !nmax_local=integer_tape(integer_tape_pointer)
132  oad_it_ptr = oad_it_ptr-1
133  nmax_local = oad_it(oad_it_ptr)
134  !integer_tape_pointer=integer_tape_pointer-1
135  !nnz_local=integer_tape(integer_tape_pointer)
136  oad_it_ptr = oad_it_ptr-1
137  nnz_local = oad_it(oad_it_ptr)
138  !integer_tape_pointer=integer_tape_pointer-1
139  !n_sprs_local=integer_tape(integer_tape_pointer)
140  oad_it_ptr = oad_it_ptr-1
141  n_sprs_local = oad_it(oad_it_ptr)
142  !double_tape_pointer=double_tape_pointer-1
143  !eps_sor_local=double_tape(double_tape_pointer)
144  oad_dt_ptr = oad_dt_ptr-1
145  eps_sor_local = oad_dt(oad_dt_ptr)
146  !double_tape_pointer=double_tape_pointer-1
147  !omega_local=double_tape(double_tape_pointer)
148  oad_dt_ptr = oad_dt_ptr-1
149  omega_local = oad_dt(oad_dt_ptr)
150  do i=nmax_local, 1, -1
151  !double_tape_pointer=double_tape_pointer-1
152  !lgs_x_value(i)%v=double_tape(double_tape_pointer)
153  oad_dt_ptr = oad_dt_ptr-1
154  lgs_x_value(i)%v = oad_dt(oad_dt_ptr)
155  end do
156  do i=nmax_local, 1, -1
157  !double_tape_pointer=double_tape_pointer-1
158  !lgs_b_value(i)%v=double_tape(double_tape_pointer)
159  oad_dt_ptr = oad_dt_ptr-1
160  lgs_b_value(i)%v = oad_dt(oad_dt_ptr)
161  end do
162  do i=nmax_local, 1, -1
163  !integer_tape_pointer=integer_tape_pointer-1
164  !lgs_a_diag_index(i)=integer_tape(integer_tape_pointer)
165  oad_it_ptr = oad_it_ptr-1
166  lgs_a_diag_index(i) = oad_it(oad_it_ptr)
167  end do
168  do i=nnz_local, 1, -1
169  !integer_tape_pointer=integer_tape_pointer-1
170  !lgs_a_index(i)=integer_tape(integer_tape_pointer)
171  oad_it_ptr = oad_it_ptr-1
172  lgs_a_index(i) = oad_it(oad_it_ptr)
173  end do
174  do i=nmax_local+1, 1, -1
175  !integer_tape_pointer=integer_tape_pointer-1
176  !lgs_a_ptr(i)=integer_tape(integer_tape_pointer)
177  oad_it_ptr = oad_it_ptr-1
178  lgs_a_ptr(i) = oad_it(oad_it_ptr)
179  end do
180  do i=nnz_local, 1, -1
181  !double_tape_pointer=double_tape_pointer-1
182  !lgs_a_value(i)%v=double_tape(double_tape_pointer)
183  oad_dt_ptr = oad_dt_ptr-1
184  lgs_a_value(i)%v = oad_dt(oad_dt_ptr)
185  end do
186  call sor_sprs_grad(lgs_a_value%v, lgs_a_value%d,&
187  lgs_a_index, lgs_a_diag_index, lgs_a_ptr, &
188  lgs_b_value%v, lgs_b_value%d, &
189  nnz_local, nmax_local, n_sprs_local,&
190  omega_local, eps_sor_local, &
191  lgs_x_value%v, lgs_x_value%d, ierr)
192  do i=nmax_local, 1, -1
193  !double_tape_pointer=double_tape_pointer-1
194  !lgs_x_value(i)%v=double_tape(double_tape_pointer)
195  oad_dt_ptr = oad_dt_ptr-1
196  lgs_x_value(i)%v = oad_dt(oad_dt_ptr)
197  end do
198  print *, "After sorsAD integer_tape_pointer ", oad_it_ptr
199  print *, "After sorsAD double_tape_pointer ", oad_dt_ptr
200  our_rev_mode=our_orig_mode
201  end if
202  end subroutine template
Solvers for systems of linear equations used by SICOPOLIS.
Several mathematical tools used by SICOPOLIS.
subroutine template()