Actual source code: samgtools1.F
1: subroutine samgpetsc_apply_shift(ia, nnu, ia_shift, ja, nna, &
2: & ja_shift)
3: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
4: ! This routine applies a ia_shift to all elements in the ia array,!
5: ! and a ja_shift to all elements in the ja array. !
6: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
8: implicit none
9: integer ia(*), nnu, ia_shift, ja(*), nna, ja_shift
10: integer i
12: do i=1,nnu+1
13: ia(i) = ia(i) - ia_shift
14: enddo
16: do i=1,nna
17: ja(i) = ja(i) - ja_shift
18: enddo
20: end subroutine samgpetsc_apply_shift
22: subroutine samgpetsc_get_levels(levelscp)
23: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
24: ! Routine to get the numbers of levels created by SAMG !
25: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
26:
27: implicit none
28:
29: integer levelscp, levels
31: common /samg_mlev/ levels
33: levelscp = levels
35: return
36: end subroutine samgpetsc_get_levels
38: subroutine samgpetsc_get_dim_operator(k, nnu, nna)
39: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
40: ! Routine do get number of unknowns and nonzeros of coarse grid !
41: ! matrix on level k !
42: ! input: k: coarse grid level !
43: ! output: nnu, nna: number of unknowns and nonzeros !
44: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
46: ! The number of unknowns is determined from the imin and imax arrays.
47: ! These arrays are stored in common blocks
48: ! The number of nonzeros is determined from the ia array.
49: ! This array is stored in the u_wkspace work array.
50: ! For information on this latter array, see module samg_wkspace_status
51: ! in amg_mod.f
52:
53: use u_wkspace
55: implicit none
56: integer imin(25),imax(25),ipmin(25),ipmax(25)
57: integer levels
58: common /samg_minx/ imin(25),imax(25),ipmin(25),ipmax(25)
59: common /samg_mlev/ levels
60: integer k, ilo, ihi, n1, n2, nnu, nna
62: ! check level input parameter
63: if (k.lt.2.or.k.gt.levels) then
64: write(*,*) 'ERROR in samggetdimmat: k out of range'
65: write(*,*) 'Specified value for k on input = ',k
66: write(*,*) 'The current number of levels = ',levels
67: stop 'k should satisfy: 2 <= k <= levels!'
68: endif
70: ! determine number of unknowns
71: ilo = imin(k)
72: ihi = imax(k)
73: nnu = ihi-ilo+1
74: ! determine number of nonzeros
75: n1 = ia(ilo)
76: n2 = ia(ihi+1)-1
77: nna = n2-n1+1
79: write(*,*) 'The current level k = ', k
80: write(*,*) 'The number of levels = ', levels
81: write(*,*) 'De dimensie van de matrix = ', nnu
82: write(*,*) 'Het aantal nullen van de matrix = ', nna
83:
84: return
85: end subroutine samgpetsc_get_dim_operator
87: subroutine samgpetsc_get_operator(k, aout, iaout, jaout)
88: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
89: ! Routine do get coarse grid matrix on level k !
90: ! input: k: coarse grid level !
91: ! input/output: aut, ia, jaout: coarse grid matrix in skyline !
92: ! format !
93: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
95: ! WARNING: This routine assumes memory allocation for aout, iaout,
96: ! and jaout OUTSIDE routine
98: ! The coarse grid matrices are stored in (a, ia, ja). The array ia is
99: ! stored in the u_wkspace work array, while the arrays a and ja are stored
100: ! in the a_wkspace work array. See module samg_wkspace_status
101: ! in amg_mod.f for details.
103: use u_wkspace
104: use a_wkspace
106: implicit none
107: integer imin(25),imax(25),ipmin(25),ipmax(25)
108: integer levels
109: common /samg_minx/ imin(25),imax(25),ipmin(25),ipmax(25)
110: common /samg_mlev/ levels
111: double precision aout(*)
112: integer iaout(*), jaout(*)
113: integer k, ilo, ihi, n1, n2, nnu, nna
115: ! check level input parameter
116: if (k.lt.2.or.k.gt.levels) then
117: write(*,*) 'ERROR in samggetmat: k out of range'
118: write(*,*) 'Specified value for k on input = ',k
119: write(*,*) 'The current number of levels = ',levels
120: stop 'k should satisfy: 2 <= k <= levels!'
121: endif
123: ! determine number of unknowns
124: ilo = imin(k)
125: ihi = imax(k)
126: nnu = ihi-ilo+1
127: ! determine number of nonzeros
128: n1 = ia(ilo)
129: n2 = ia(ihi+1)-1
130: nna = n2-n1+1
132: ! get matrix values
133: iaout(1:nnu+1) = ia(ilo:ihi+1)
134: aout(1:nna) = a(n1:n2)
135: jaout(1:nna) = ja(n1:n2)
137: return
138: end subroutine samgpetsc_get_operator
140: subroutine samgpetsc_get_dim_interpol(k, nnu, nna)
141: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
142: ! Routine to get size and number of nonzeros of interpolation operator !
143: ! from grid k+1 (coarse grid) to k (finer grid). !
144: ! input: k: fine grid level !
145: ! output: nnu and nna: size and number of nonzeros of interpolation !
146: ! operator !
147: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
149: ! The the size is determined from the imin and imax arrays.
150: ! These arrays are stored in common blocks
151: ! The number of nonzeros is determined from the iw array.
152: ! This array is stored in the u_wkspace work array.
153: ! For information on this latter array, see module samg_wkspace_status
154: ! in amg_mod.f
156: use u_wkspace
158: implicit none
159: integer imin(25),imax(25),ipmin(25),ipmax(25)
160: integer levels
161: common /samg_minx/ imin(25),imax(25),ipmin(25),ipmax(25)
162: common /samg_mlev/ levels
163: integer k, nnu, nna, ilo, ihi, n1, n2
165: ! check level input parameter
166: if (k.lt.1.or.k.gt.levels-1) then
167: write(*,*) 'ERROR in samggetdimint: k out of range'
168: write(*,*) 'Specified value for k on input = ',k
169: write(*,*) 'The current number of levels = ',levels
170: stop 'k should satisfy: 1 <= k <= levels-1!'
171: endif
173: ! determine size
174: ilo = imin(k)
175: ihi = imax(k)
176: nnu = ihi-ilo+1
177: ! determine number of nonzeros
178: n1 = iw(ilo)
179: n2 = iw(ihi+1)-1
180: nna = n2-n1+1
182: write(*,*) 'The current level k = ', k
183: write(*,*) 'The number of levels = ', levels
184: write(*,*) 'De dimensie van de interp. op. k -> k+1= ', nnu
185: write(*,*) 'Het aantal nullen van de interp. op = ', nna
186:
187: return
188: end subroutine samgpetsc_get_dim_interpol
190: subroutine samgpetsc_get_interpol(k, wout, iwout, jwout)
191: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
192: ! Routine do get interpolation operator from grid k+1 (coarse grid) !
193: ! to k (finer grid). !
194: ! input: k: fine grid level !
195: ! output: wout, iwout, jwout: interpolation in skyline format !
196: !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
198: ! WARNING: This routine assumes memory allocation for wout, iwout,
199: ! and jwout OUTSIDE routine
201: ! The interpolation opreators are stored in (w, iw, jw). The array iw is
202: ! stored in the u_wkspace work array, while the arrays w and jw are stored
203: ! in the w_wkspace work array. See module samg_wkspace_status
204: ! in amg_mod.f for details.
206: use u_wkspace
207: use w_wkspace
209: implicit none
210: integer imin(25),imax(25),ipmin(25),ipmax(25)
211: integer levels
212: common /samg_minx/ imin(25),imax(25),ipmin(25),ipmax(25)
213: common /samg_mlev/ levels
214: double precision wout(*)
215: integer iwout(*), jwout(*)
216: integer k, ilo, ihi, n1, n2, nnu, nna
218: ! determine number of unknowns
219: ilo = imin(k)
220: ihi = imax(k)
221: nnu = ihi-ilo+1
222: ! determine number of nonzeros
223: n1 = iw(ilo)
224: n2 = iw(ihi+1)-1
225: nna = n2-n1+1
227: ! get interpolation values
228: iwout(1:nnu+1) = iw(ilo:ihi+1)
229: wout(1:nna) = w(n1:n2)
230: jwout(1:nna) = jw(n1:n2)
232: end subroutine samgpetsc_get_interpol