/[MITgcm]/MITgcm_contrib/dgoldberg/streamice/streamice_cg_solve_petsc.F
ViewVC logotype

Annotation of /MITgcm_contrib/dgoldberg/streamice/streamice_cg_solve_petsc.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.1 - (hide annotations) (download)
Wed Aug 27 19:29:13 2014 UTC (10 years, 10 months ago) by dgoldberg
Branch: MAIN
CVS Tags: HEAD
updating contrib streamice repo with latest files, and separated out convergence checks; and parameterised maximum iteration counts and interface w shelfice for coupling

1 dgoldberg 1.1 C $Header: /u/gcmpack/MITgcm/pkg/streamice/streamice_cg_solve_petsc.F,v 1.1 2013/08/24 20:32:03 dgoldberg Exp $
2     C $Name: $
3    
4     #include "STREAMICE_OPTIONS.h"
5    
6     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8     CBOP
9     SUBROUTINE STREAMICE_CG_SOLVE_PETSC(
10     U cg_Uin, ! x-velocities
11     U cg_Vin, ! y-velocities
12     I cg_Bu, ! force in x dir
13     I cg_Bv, ! force in y dir
14     I A_uu, ! section of matrix that multiplies u and projects on u
15     I A_uv, ! section of matrix that multiplies v and projects on u
16     I A_vu, ! section of matrix that multiplies u and projects on v
17     I A_vv, ! section of matrix that multiplies v and projects on v
18     I tolerance,
19     O iters,
20     I maxIter,
21     I myThid )
22     C /============================================================\
23     C | SUBROUTINE |
24     C | o |
25     C |============================================================|
26     C | |
27     C \============================================================/
28     IMPLICIT NONE
29    
30     #include "SIZE.h"
31     #include "EEPARAMS.h"
32     #include "PARAMS.h"
33     #include "STREAMICE.h"
34     #include "STREAMICE_CG.h"
35    
36    
37    
38     #ifdef ALLOW_PETSC
39     #include "finclude/petsc.h"
40     ! UNCOMMENT IF V3.0
41     !#include "finclude/petscvec.h"
42     !#include "finclude/petscmat.h"
43     !#include "finclude/petscksp.h"
44     !#include "finclude/petscpc.h"
45     #endif
46     C === Global variables ===
47    
48    
49     C !INPUT/OUTPUT ARGUMENTS
50     C cg_Uin, cg_Vin - input and output velocities
51     C cg_Bu, cg_Bv - driving stress
52     INTEGER myThid
53     INTEGER iters, maxiter
54     _RL tolerance
55     _RL cg_Uin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
56     _RL cg_Vin (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
57     _RL cg_Bu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
58     _RL cg_Bv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
59     _RL
60     & A_uu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
61     & A_vu (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
62     & A_uv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1),
63     & A_vv (1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy,-1:1,-1:1)
64    
65     C LOCAL VARIABLES
66     INTEGER i, j, bi, bj, cg_halo, conv_flag
67     INTEGER iter, is, js, ie, je, colx, coly, k
68     _RL dot_p1, dot_p2, alpha_k, beta_k, resid, resid_0
69     _RL dot_p1_tile (nSx,nSy)
70     _RL dot_p2_tile (nSx,nSy)
71     CHARACTER*(MAX_LEN_MBUF) msgBuf
72    
73    
74     #ifdef ALLOW_PETSC
75     INTEGER indices(2*(snx*nsx*sny*nsy))
76     INTEGER n_dofs_cum_sum (0:nPx*nPy-1), idx(1)
77     _RL rhs_values(2*(snx*nsx*sny*nsy))
78     _RL solution_values(2*(snx*nsx*sny*nsy))
79     ! _RL mat_values (2*Nx*Ny,2*(snx*nsx*sny*nsy))
80     _RL mat_values (18,1), mat_val_return(1)
81     INTEGER indices_col(18)
82     INTEGER local_dofs, global_dofs, dof_index, dof_index_col
83     INTEGER local_offset
84     Mat matrix
85     KSP ksp
86     PC pc
87     Vec rhs
88     Vec solution
89     PetscErrorCode ierr
90     #ifdef ALLOW_USE_MPI
91     integer mpiRC, mpiMyWid
92     #endif
93     #endif
94    
95    
96     #ifdef ALLOW_STREAMICE
97    
98    
99    
100    
101     #ifdef ALLOW_PETSC
102    
103     #ifdef ALLOW_USE_MPI
104    
105    
106     CALL MPI_COMM_RANK( MPI_COMM_WORLD, mpiMyWId, mpiRC )
107     local_dofs = n_dofs_process (mpiMyWid)
108     global_dofs = 0
109    
110     n_dofs_cum_sum(0) = 0
111     DO i=0,nPx*nPy-1
112     global_dofs = global_dofs + n_dofs_process (i)
113     if (i.ge.1) THEN
114     n_dofs_cum_sum(i) = n_dofs_cum_sum(i-1)+
115     & n_dofs_process(i-1)
116     endif
117     ENDDO
118     local_offset = n_dofs_cum_sum(mpimywid)
119    
120     #else
121    
122     local_dofs = n_dofs_process (0)
123     global_dofs = local_dofs
124     local_offset = 0
125    
126     #endif
127    
128     ! call petscInitialize(PETSC_NULL_CHARACTER,ierr)
129    
130     !----------------------
131    
132     call VecCreate(PETSC_COMM_WORLD, rhs, ierr)
133     call VecSetSizes(rhs, local_dofs, global_dofs, ierr)
134     call VecSetType(rhs, VECMPI, ierr)
135    
136     call VecCreate(PETSC_COMM_WORLD, solution, ierr)
137     call VecSetSizes(solution, local_dofs, global_dofs, ierr)
138     call VecSetType(solution, VECMPI, ierr)
139    
140     do i=1,local_dofs
141     indices(i) = i-1 + local_offset
142     end do
143     do i=1,2*nSx*nSy*sNx*sNy
144     rhs_values (i) = 0. _d 0
145     solution_values (i) = 0. _d 0
146     enddo
147    
148     ! gather rhs and initial guess values to populate petsc vectors
149    
150     DO bj = myByLo(myThid), myByHi(myThid)
151     DO bi = myBxLo(myThid), myBxHi(myThid)
152     DO j=1,sNy
153     DO i=1,sNx
154    
155     dof_index = INT(streamice_petsc_dofs_u(i,j,bi,bj))
156     & - local_offset
157    
158     if (dof_index.ge.0) THEN
159    
160     rhs_values(dof_index+1) = cg_Bu(i,j,bi,bj)
161     solution_values(dof_index+1) = cg_Uin(i,j,bi,bj)
162    
163     endif
164    
165     !---------------
166    
167     dof_index = INT(streamice_petsc_dofs_v(i,j,bi,bj))
168     & - local_offset
169    
170     if (dof_index.ge.0) THEN
171    
172     rhs_values(dof_index+1) = cg_Bv(i,j,bi,bj)
173     solution_values(dof_index+1) = cg_Vin(i,j,bi,bj)
174    
175     endif
176    
177     ENDDO
178     ENDDO
179     ENDDO
180     ENDDO
181    
182    
183     call VecSetValues(rhs, local_dofs, indices, rhs_values,
184     & INSERT_VALUES, ierr)
185     call VecAssemblyBegin(rhs, ierr)
186     call VecAssemblyEnd(rhs, ierr)
187    
188    
189     call VecSetValues(solution, local_dofs, indices,
190     & solution_values, INSERT_VALUES, ierr)
191     call VecAssemblyBegin(solution, ierr)
192     call VecAssemblyEnd(solution, ierr)
193    
194     ! IF USING v3.0 THEN
195     ! call MatCreateMPIAIJ (PETSC_COMM_WORLD,
196     call MatCreateAIJ (PETSC_COMM_WORLD,
197     & local_dofs, local_dofs,
198     & global_dofs, global_dofs,
199     & 18, PETSC_NULL_INTEGER,
200     & 18, PETSC_NULL_INTEGER,
201     & matrix, ierr)
202    
203    
204     ! populate petsc matrix
205    
206     DO bj = myByLo(myThid), myByHi(myThid)
207     DO bi = myBxLo(myThid), myBxHi(myThid)
208     DO j=1,sNy
209     DO i=1,sNx
210    
211     dof_index = INT(streamice_petsc_dofs_u(i,j,bi,bj))
212     ! & - local_offset
213    
214     IF (dof_index .ge. 0) THEN
215    
216     DO k=1,18
217     indices_col(k) = 0
218     mat_values(k,1) = 0. _d 0
219     ENDDO
220     k=0
221    
222     DO coly=-1,1
223     DO colx=-1,1
224    
225     dof_index_col = streamice_petsc_dofs_u(i+colx,j+coly,bi,bj)
226    
227     if (dof_index_col.ge.0) THEN
228     ! pscal = A_uu(i,j,bi,bj,colx,coly)
229     ! CALL MatSetValue (matrix,dof_index, dof_index_col,
230     ! & pscal,INSERT_VALUES,ierr)
231     k=k+1
232     mat_values (k,1) = A_uu(i,j,bi,bj,colx,coly)
233     indices_col (k) = dof_index_col
234     endif
235    
236     dof_index_col = streamice_petsc_dofs_v(i+colx,j+coly,bi,bj)
237    
238     if (dof_index_col.ge.0) THEN
239     ! CALL MatSetValue (matrix,dof_index, dof_index_col,
240     ! & A_uv(i,j,bi,bj,colx,coly),INSERT_VALUES,ierr)
241     k=k+1
242     mat_values (k,1) = A_uv(i,j,bi,bj,colx,coly)
243     indices_col (k) = dof_index_col
244     endif
245    
246     ENDDO
247     ENDDO
248    
249     call matSetValues (matrix, 1, dof_index, k, indices_col,
250     & mat_values,INSERT_VALUES,ierr)
251    
252    
253     ENDIF
254    
255     ! ----------------------------------------------
256    
257     dof_index = INT(streamice_petsc_dofs_v(i,j,bi,bj))
258     ! & - local_offset
259    
260     IF (dof_index .ge. 0) THEN
261    
262     DO k=1,18
263     indices_col(k) = 0
264     mat_values(k,1) = 0. _d 0
265     ENDDO
266     k=0
267    
268     DO coly=-1,1
269     DO colx=-1,1
270    
271     dof_index_col = streamice_petsc_dofs_u(i+colx,j+coly,bi,bj)
272    
273     if (dof_index_col.ge.0) THEN
274     ! CALL MatSetValue (matrix,dof_index, dof_index_col,
275     ! & A_vu(i,j,bi,bj,colx,coly),INSERT_VALUES,ierr)
276     k=k+1
277     mat_values (k,1) = A_vu(i,j,bi,bj,colx,coly)
278     indices_col (k) = dof_index_col
279     endif
280    
281     dof_index_col = streamice_petsc_dofs_v(i+colx,j+coly,bi,bj)
282    
283     if (dof_index_col.ge.0) THEN
284     ! CALL MatSetValue (matrix,dof_index, dof_index_col,
285     ! & A_vv(i,j,bi,bj,colx,coly),INSERT_VALUES,ierr)
286     k=k+1
287     mat_values (k,1) = A_vv(i,j,bi,bj,colx,coly)
288     indices_col (k) = dof_index_col
289     endif
290    
291     ENDDO
292     ENDDO
293    
294     call matSetValues (matrix, 1, dof_index, k, indices_col,
295     & mat_values,INSERT_VALUES,ierr)
296     ENDIF
297    
298     ENDDO
299     ENDDO
300     ENDDO
301     ENDDO
302    
303     call MatAssemblyBegin(matrix,MAT_FINAL_ASSEMBLY,ierr)
304     call MatAssemblyEnd(matrix,MAT_FINAL_ASSEMBLY,ierr)
305    
306    
307     call KSPCreate(PETSC_COMM_WORLD, ksp, ierr)
308     call KSPSetOperators(ksp, matrix, matrix,
309     & DIFFERENT_NONZERO_PATTERN, ierr)
310    
311     SELECT CASE (PETSC_SOLVER_TYPE)
312     CASE ('CG')
313     PRINT *, "PETSC SOLVER: SELECTED CG"
314     call KSPSetType(ksp, KSPCG, ierr)
315     CASE ('GMRES')
316     PRINT *, "PETSC SOLVER: SELECTED GMRES"
317     call KSPSetType(ksp, KSPGMRES, ierr)
318     CASE ('BICG')
319     PRINT *, "PETSC SOLVER: SELECTED BICG"
320     call KSPSetType(ksp, KSPBICG, ierr)
321     CASE DEFAULT
322     PRINT *, "PETSC SOLVER: SELECTED DEFAULT"
323     call KSPSetType(ksp, KSPCG, ierr)
324     END SELECT
325    
326     call KSPGetPC(ksp, pc, ierr)
327     call KSPSetTolerances(ksp,tolerance,
328     & PETSC_DEFAULT_DOUBLE_PRECISION,
329     & PETSC_DEFAULT_DOUBLE_PRECISION,
330     & maxiter,ierr)
331    
332     SELECT CASE (PETSC_PRECOND_TYPE)
333     CASE ('BLOCKJACOBI')
334     PRINT *, "PETSC PRECOND: SELECTED BJACOBI"
335     call PCSetType(pc, PCBJACOBI, ierr)
336     CASE ('JACOBI')
337     PRINT *, "PETSC PRECOND: SELECTED JACOBI"
338     call PCSetType(pc, PCJACOBI, ierr)
339     CASE ('ILU')
340     PRINT *, "PETSC PRECOND: SELECTED ILU"
341     call PCSetType(pc, PCILU, ierr)
342     CASE DEFAULT
343     PRINT *, "PETSC PRECOND: SELECTED DEFAULT"
344     call PCSetType(pc, PCBJACOBI, ierr)
345     END SELECT
346    
347    
348     call KSPSolve(ksp, rhs, solution, ierr)
349     call KSPGetIterationNumber(ksp,iters,ierr)
350    
351     call VecGetValues(solution,local_dofs,indices,
352     & solution_values,ierr)
353    
354     DO bj = myByLo(myThid), myByHi(myThid)
355     DO bi = myBxLo(myThid), myBxHi(myThid)
356     DO j=1,sNy
357     DO i=1,sNx
358    
359     dof_index = INT(streamice_petsc_dofs_u(i,j,bi,bj))
360     & - local_offset
361     if (dof_index.ge.0) THEN
362     cg_Uin(i,j,bi,bj) = solution_values(dof_index+1)
363     endif
364    
365     dof_index = INT(streamice_petsc_dofs_v(i,j,bi,bj))
366     & - local_offset
367     if (dof_index.ge.0) THEN
368     cg_Vin(i,j,bi,bj) = solution_values(dof_index+1)
369     endif
370    
371     ENDDO
372     ENDDO
373     ENDDO
374     ENDDO
375    
376     call KSPDestroy (ksp, ierr)
377     call VecDestroy (rhs, ierr)
378     call VecDestroy (solution, ierr)
379     call MatDestroy (matrix, ierr)
380    
381    
382     ! call PetscFinalize(ierr)
383    
384    
385     #endif
386    
387    
388    
389     #endif
390     RETURN
391     END

  ViewVC Help
Powered by ViewVC 1.1.22