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