1!/*****************************************************************************/ 2! * 3! * Elmer, A Finite Element Software for Multiphysical Problems 4! * 5! * Copyright 1st April 1995 - , CSC - IT Center for Science Ltd., Finland 6! * 7! * This library is free software; you can redistribute it and/or 8! * modify it under the terms of the GNU Lesser General Public 9! * License as published by the Free Software Foundation; either 10! * version 2.1 of the License, or (at your option) any later version. 11! * 12! * This library is distributed in the hope that it will be useful, 13! * but WITHOUT ANY WARRANTY; without even the implied warranty of 14! * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 15! * Lesser General Public License for more details. 16! * 17! * You should have received a copy of the GNU Lesser General Public 18! * License along with this library (in file ../LGPL-2.1); if not, write 19! * to the Free Software Foundation, Inc., 51 Franklin Street, 20! * Fifth Floor, Boston, MA 02110-1301 USA 21! * 22! *****************************************************************************/ 23 24#include "huti_fdefs.h" 25 26!> \ingroup ElmerLib 27!------------------------------------------------------------------------------ 28 SUBROUTINE MultigridPrec( u,v,ipar ) 29!------------------------------------------------------------------------------ 30 USE Multigrid 31 32 INTEGER, DIMENSION(*) :: ipar !< structure holding info from (HUTIter-iterative solver package) 33 REAL(KIND=dp), TARGET :: u(*) 34 REAL(KIND=dp), TARGET :: v(*) 35 36 INTEGER :: i,j,k,me,n, DOFs 37 TYPE(Solver_t), POINTER :: PSolver 38 39 TYPE(Matrix_t), POINTER :: A 40 REAL(KIND=dp), POINTER CONTIG :: x(:),b(:) 41 42 CALL Info('MultigridPrec','Starting Multigrid preconditioning cycle',Level=12) 43 44 PSolver => CurrentModel % Solver 45 46 n = HUTI_NDIM 47 IF ( PSolver % Matrix % COMPLEX ) n=2*n 48 49 x => u(1:n) 50 b => v(1:n) 51 A => GlobalMatrix 52 53 IF ( ParEnv % PEs > 1 ) THEN 54 A => GlobalMatrix % EMatrix 55 n = A % NumberOfRows 56 ALLOCATE( x(n), b(n) ) 57 x=0; b=0; 58 59 j = 0 60 me = ParEnv % MyPe 61 DO i=1,n 62 IF ( A % ParallelInfo % NeighbourList(i) % Neighbours(1) == me ) THEN 63 j = j + 1 64 b(i) = v(j) 65 END IF 66 END DO 67 END IF 68 69 DOFs = PSolver % Variable % DOFs 70 x = b 71 CALL MultiGridSolve( A, x, b, & 72 DOFs, PSolver, PSolver % MultiGridLevel, FirstCall(stack_pos)) 73 74 IF ( ParEnv % PEs > 1 ) THEN 75 j = 0 76 DO i=1,n 77 IF ( A % ParallelInfo % NeighbourList(i) % Neighbours(1) == me ) THEN 78 j = j + 1 79 u(j) = x(i) 80 END IF 81 END DO 82 DEALLOCATE( x,b ) 83 END IF 84 85 FirstCall(stack_pos) = .FALSE. 86 87 CALL Info('MultigridPrec','Done multigrid preconditioning cycle',Level=12) 88 89 END SUBROUTINE MultigridPrec 90!------------------------------------------------------------------------------ 91