Scrambler  1
elliptic_control.f90
Go to the documentation of this file.
00001 !#########################################################################
00002 !               
00003 !    Copyright (C) 2003-2012 Department of Physics and Astronomy,
00004 !                            University of Rochester,
00005 !                            Rochester, NY
00006 !
00007 !    elliptic_control.f90 is part of AstroBEAR.
00008 !
00009 !    AstroBEAR is free software: you can redistribute it and/or modify    
00010 !    it under the terms of the GNU General Public License as published by 
00011 !    the Free Software Foundation, either version 3 of the License, or    
00012 !    (at your option) any later version.
00013 !
00014 !    AstroBEAR is distributed in the hope that it will be useful, 
00015 !    but WITHOUT ANY WARRANTY; without even the implied warranty of
00016 !    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00017 !    GNU General Public License for more details.
00018 !
00019 !    You should have received a copy of the GNU General Public License
00020 !    along with AstroBEAR.  If not, see <http://www.gnu.org/licenses/>.
00021 !
00022 !#########################################################################
00025 
00028 
00031 
00035 
00038 MODULE EllipticControl
00039   USE Timing
00040   USE GlobalDeclarations
00041   USE CommunicationDeclarations
00042   USE TreeDeclarations
00043   USE DataDeclarations
00044   USE Poisson
00045   USE PhysicsDeclarations
00046   USE EllipticComms
00047   IMPLICIT NONE
00048   PUBLIC EllipticInit, EllipticSetup, EllipticSolve, EllipticDestroy, ApplyEllipticBC
00049   INTEGER :: isolve=0
00050 CONTAINS
00051 
00052 
00055 
00057   SUBROUTINE EllipticInit
00058      INTEGER :: i
00059      INTEGER :: iErr
00060      lEllipticPeriodic=.false.
00061      NrEllipticObjects=0
00062      ALLOCATE(elliptic_maxspeed(0:MaxLevel))     
00063      elliptic_maxspeed = 0.d0
00064      lPoissonSolve=(lSelfGravity)
00065      IF (lPoissonSolve) THEN
00066         NrEllipticObjects=NrEllipticObjects+1
00067         iPoissonSolve=NrEllipticObjects
00068      END IF     
00069      IF (NrEllipticObjects > 0) THEN
00070         ALLOCATE(EllipticObjects(NrEllipticObjects))
00071      END IF
00072      IF (iPoissonSolve .ne. 0) CALL Poisson_Init(EllipticObjects(iPoissonSolve))
00073      DO i=1,NrEllipticObjects
00074         ALLOCATE(EllipticObjects(i)%LevelObjects(0:MaxLevel))
00075      END DO
00076      lAnyPeriodic=lAnyPeriodic .OR. lEllipticPeriodic
00077   END SUBROUTINE EllipticInit
00079 
00082 
00085    SUBROUTINE InitialElliptic(n)
00086       INTEGER :: n
00087       TYPE(NodeDef), POINTER :: node
00088       TYPE(NodeDefList), POINTER :: nodelist
00089       INTEGER :: matrixID, ierr
00090       REAL(KIND=qPREC) :: temp
00091       CALL StartTimer(iElliptic, n)
00092       temp=levels(n)%dt
00093       levels(n)%dt=0d0
00094       IF (lElliptic) THEN
00095          CALL EllipticSetup(n)
00096          CALL EllipticSolve(n)
00097          CALL EllipticDestroy(n)
00098          CALL PostElliptic(n)
00099 !         IF (nEllipticTransferFields > 0) THEN
00100 !            CALL EllipticTransfer(n, EllipticTransferFields, levels(n)%egmbc(1))
00101 !         END IF
00102       END IF
00103       levels(n)%dt=temp
00104       CALL StopTimer(iElliptic, n)
00105    END SUBROUTINE InitialElliptic
00106 
00109    SUBROUTINE Elliptic(n)
00110      INTEGER :: n, iErr
00111       CALL StartTimer(iElliptic, n)
00112       IF (lElliptic) THEN
00113          CALL MPI_ALLREDUCE(lRequestRestart, RestartStep, 1, MPI_LOGICAL, MPI_LOR, MPI_COMM_WORLD, iErr)
00114          IF (RestartStep) THEN
00115 !            IF (levels(n)%step > 1) THEN !We already setup the grid etc...
00116 !               CALL EllipticDestroy(n)
00117 !            END IF
00118 !           IF (MPI_ID == 0) write(*,*) 'Skipping elliptic solve since restart was requested'
00119             RETURN
00120          END IF
00121 !         IF (levels(n)%step == 1) THEN
00122             CALL EllipticSetup(n)
00123 !         END IF
00124          CALL EllipticSolve(n)
00125 !         IF (levels(n)%step == levels(n)%steps) THEN
00126             CALL EllipticDestroy(n)
00127 !         END IF
00128          CALL PostElliptic(n)
00129       END IF
00130       CALL StopTimer(iElliptic, n)                  
00131    END SUBROUTINE Elliptic
00132 
00134 
00135 
00138 
00141   SUBROUTINE EllipticSetup(n)
00142      INTEGER :: n
00143      TYPE(NodeDefList), POINTER :: nodelist
00144      INTEGER :: iErr
00145      INTEGER :: i, nnodes, totalnodes, mb(3,2), minmb(3), maxmb(3), minmbo(3), maxmbo(3), minsize, maxsize, minsizeo, maxsizeo
00146      REAL(8) :: datasize, totaldatasize
00147      CHARACTER(LEN=21) :: s_filename
00148      !First create the grid for this level to be used by all elliptic equations
00149      CALL C_StructGridCreate(levels(n)%MPI_COMM, nDim, levels(n)%Grid, iErr); CALL CheckErr('C_StructGridCreate',iErr)
00150      nodelist=>nodes(n)%p
00151      datasize=0
00152      nnodes=0
00153      minmb=2**10
00154      maxmb=-2**10
00155      minsize=2**10
00156      maxsize=-2**10
00157      DO WHILE (associated(nodelist))
00158         CALL C_StructGridSetExtents(levels(n)%Grid, nodelist%self%box%mGlobal(1:nDim,1), nodelist%self%box%mGlobal(1:nDim,2), iErr)
00159         CALL CheckErr('C_StructGridSetExtents',iErr)
00160 !        mB=nodelist%self%box%mGlobal(1:nDim,:)
00161 !        datasize=datasize+product(mB(:,2)-mB(:,1) + 1)
00162 !        minmb=min(minmb, mB(:,1))
00163 !        maxmb=max(maxmb, mB(:,2))
00164 !        minsize=min(minsize, product(mB(:,2)-mB(:,1)+1))
00165 !        maxsize=max(maxsize, product(mB(:,2)-mB(:,1)+1))
00166 !        nnodes=nnodes+1
00167         nodelist=>nodelist%next
00168      END DO
00169 
00170 !!     CALL MPI_REDUCE(nnodes, totalnodes, 1, MPI_INTEGER, MPI_SUM, 0, MPI_COMM_WORLD, iErr)
00171 !     CALL MPI_REDUCE(datasize, totaldatasize, 1, MPI_DOUBLE_PRECISION, MPI_SUM, 0, MPI_COMM_WORLD, iErr)
00172 !     CALL MPI_REDUCE(minmb, minmbo, 3, MPI_INTEGER, MPI_MIN, 0, MPI_COMM_WORLD, iErr)
00173 !     CALL MPI_REDUCE(maxmb, maxmbo, 3, MPI_INTEGER, MPI_MAX, 0, MPI_COMM_WORLD, iErr)
00174 !     CALL MPI_REDUCE(minsize, minsizeo, 1, MPI_INTEGER, MPI_MIN, 0, MPI_COMM_WORLD, iErr)
00175 !     CALL MPI_REDUCE(maxsize, maxsizeo, 1, MPI_INTEGER, MPI_MAX, 0, MPI_COMM_WORLD, iErr)
00176      
00177 !     IF (MPI_ID == 0) write(*,*) n, totalnodes, totaldatasize, minmbo, maxmbo, minsizeo, maxsizeo
00178 
00179 !     CALL MPI_BARRIER(MPI_COMM_WORLD, iErr)
00180      IF (ANY(lEllipticPeriodic(1:nDim))) CALL C_StructGridSetPeriodic(levels(n)%Grid,levels(n)%mX(1:nDim), iErr) 
00181      !If Self Gravity and Thermal Diffusion are not both periodic this will break
00182      CALL CheckErr('StructGridSetPeriodic',iErr)
00183      CALL C_StructGridAssemble(levels(n)%Grid, iErr); CALL CheckErr('C_StructGridAssemble',iErr)
00184      !Next setup matrices for different elliptic objects
00185      DO i=1,NrEllipticObjects
00186         CALL C_StructMatrixCreate(levels(n)%MPI_COMM, levels(n)%Grid, EllipticObjects(i)%Stencil, EllipticObjects(i)%LevelObjects(n)%Matrix, iErr) ;CALL CheckErr('C_StructMatrixCreate',iErr)     
00187         CALL C_StructMatrixInitialize(EllipticObjects(i)%LevelObjects(n)%Matrix, iErr); CALL CheckErr('C_StructMatrixInitialize',iErr)
00188         IF (i == iPoissonSolve) THEN
00189            CALL Poisson_Setup(n,EllipticObjects(i)%LevelObjects(n))
00190         END IF
00191         CALL C_StructMatrixAssemble(EllipticObjects(i)%LevelObjects(n)%Matrix, iErr);CALL CheckErr('C_StructMatrixAssemble',iErr)
00192         IF (EllipticObjects(i)%hVerbosity > 0) THEN
00193            write(s_filename,'(A7,I2.2,A1,I2.2,A1,I4.4,A4)') "matrix_",n,"_",i,"_",isolve,".dat"
00194            CALL C_StructMatrixPrint(s_filename, EllipticObjects(i)%LevelObjects(n)%Matrix, 0, ierr)
00195            CALL CheckErr('C_SStructMatrixPrint', iErr)
00196         END IF   
00197      END DO
00198   END SUBROUTINE EllipticSetup
00199 
00202   SUBROUTINE EllipticSolve(n)
00203      INTEGER :: n
00204      INTEGER :: i
00205      INTEGER :: ierr, iters
00206      CHARACTER(LEN=25) :: s_filename
00207      LOGICAL :: done_solving
00208      isolve=isolve+1
00209      elliptic_maxspeed(n)=0
00210      DO i=1,NrEllipticObjects
00211         done_solving=.false.
00212         CALL PreSolveComm(i,n,done_solving)
00213         DO WHILE (.not. done_solving)
00214            CALL C_StructVectorCreate(levels(n)%MPI_COMM, levels(n)%Grid, EllipticObjects(i)%LevelObjects(n)%VariableVector, iErr) ;CALL CheckErr('C_StructVectorCreate',iErr)
00215            CALL C_StructVectorCreate(levels(n)%MPI_COMM, levels(n)%Grid, EllipticObjects(i)%LevelObjects(n)%SolutionVector, iErr) ;CALL CheckErr('C_StructVectorCreate',iErr)
00216            CALL C_StructVectorInitialize(EllipticObjects(i)%LevelObjects(n)%VariableVector, iErr); CALL CheckErr('C_StructVectorInitialize',iErr)
00217            CALL C_StructVectorInitialize(EllipticObjects(i)%LevelObjects(n)%SolutionVector, iErr); CALL CheckErr('C_StructVectorInitialize', iErr)
00218            IF (i == iPoissonSolve) THEN
00219               CALL Poisson_LoadVectors(n,EllipticObjects(iPoissonSolve)%LevelObjects(n))     
00220            END IF
00221            CALL C_StructVectorAssemble(EllipticObjects(i)%LevelObjects(n)%VariableVector, iErr) ;CALL CheckErr('C_StructVectorAssemble',iErr)
00222            CALL C_StructVectorAssemble(EllipticObjects(i)%LevelObjects(n)%SolutionVector, iErr) ;CALL CheckErr('C_StructVectorAssemble',iErr)
00223            IF (EllipticObjects(i)%hVerbosity > 0) THEN
00224               write(s_filename,'(A11,I2.2,A1,I2.2,A1,I4.4,A4)') "rhs_vector_",n,"_",i,"_",isolve,".dat"
00225               CALL C_StructVectorPrint(s_filename, EllipticObjects(i)%LevelObjects(n)%VariableVector, 0, ierr)
00226               CALL CheckErr('C_StructMatrixPrint', iErr)
00227               write(s_filename,'(A11,I2.2,A1,I2.2,A1,I4.4,A4)') "lhs_vector_",n,"_",i,"_",isolve,".dat"
00228               CALL C_StructVectorPrint(s_filename, EllipticObjects(i)%LevelObjects(n)%SolutionVector, 0, ierr)
00229               CALL CheckErr('C_StructVectorPrint', iErr)
00230            END IF
00231 
00232            SELECT CASE(EllipticObjects(i)%solver) !Choose correct solver
00233            CASE(StructPCG)
00234               CALL C_StructPCGCreate(levels(n)%MPI_COMM, EllipticObjects(i)%LevelObjects(n)%Solver, iErr); CALL CheckErr('C_SStructPCGCreate',iErr)
00235               
00236               ! set solver parameters
00237               CALL C_StructPCGSetTol(EllipticObjects(i)%LevelObjects(n)%Solver, EllipticObjects(i)%tolerance, iErr)
00238               CALL CheckErr('C_StructPCGSetTol',iErr)
00239 
00240               ! set solver parameters
00241               CALL C_StructPCGSetMaxIter(EllipticObjects(i)%LevelObjects(n)%Solver, EllipticObjects(i)%MaxIters, iErr)
00242               CALL CheckErr('C_StructPCGSetMaxIter',iErr)
00243               
00244               CALL C_StructPCGSetPrintLevel(EllipticObjects(i)%LevelObjects(n)%Solver, EllipticObjects(i)%printlevel, iErr)
00245               CALL CheckErr('C_StructPCGSetPrintLevel',iErr)
00246               
00247               ! setup and solve
00248               CALL C_StructPCGSetup(EllipticObjects(i)%LevelObjects(n)%Solver, EllipticObjects(i)%LevelObjects(n)%Matrix, EllipticObjects(i)%LevelObjects(n)%VariableVector, EllipticObjects(i)%LevelObjects(n)%SolutionVector, iErr)
00249               CALL CheckErr('C_StructPCGSetup',iErr)
00250               CALL C_StructPCGSolve(EllipticObjects(i)%LevelObjects(n)%Solver, EllipticObjects(i)%LevelObjects(n)%Matrix, EllipticObjects(i)%LevelObjects(n)%VariableVector, EllipticObjects(i)%LevelObjects(n)%SolutionVector, iErr)
00251               CALL CheckErr('C_StructPCGSolve',iErr)
00252               CALL C_StructPCGGetNumIterations(EllipticObjects(i)%LevelObjects(n)%Solver, Iters, iErr)
00253               CALL CheckErr('C_StructPCGSolve',iErr)
00254               CALL CheckIters(Iters, EllipticObjects(i)%MaxIters)
00255               CALL C_StructPCGDestroy(EllipticObjects(i)%LevelObjects(n)%Solver,iErr)
00256               CALL CheckErr('C_StructPCGDestroy',iErr)
00257            CASE(StructGMRES)
00258               
00259               CALL C_StructGMRESCreate(levels(n)%MPI_COMM, EllipticObjects(i)%LevelObjects(n)%Solver, iErr); CALL CheckErr('C_SStructGMRESCreate',iErr)       
00260               
00261               ! set solver parameters
00262               CALL C_StructGMRESSetTol(EllipticObjects(i)%LevelObjects(n)%Solver, EllipticObjects(i)%tolerance, iErr)
00263               CALL CheckErr('C_StructGMRESSetTol',iErr)
00264 
00265               CALL C_StructGMRESSetMaxIter(EllipticObjects(i)%LevelObjects(n)%Solver, EllipticObjects(i)%maxIters, iErr)
00266               CALL CheckErr('C_StructGMRESSetMaxIter',iErr)
00267               
00268               CALL C_StructGMRESSetPrintLevel(EllipticObjects(i)%LevelObjects(n)%Solver, EllipticObjects(i)%printlevel, iErr)
00269               CALL CheckErr('C_StructGMRESSetPrintLevel',iErr)
00270               
00271               ! setup and solve
00272               CALL C_StructGMRESSetup(EllipticObjects(i)%LevelObjects(n)%Solver, EllipticObjects(i)%LevelObjects(n)%Matrix, EllipticObjects(i)%LevelObjects(n)%VariableVector, EllipticObjects(i)%LevelObjects(n)%SolutionVector, iErr)
00273               CALL CheckErr('C_StructGMRESSetup',iErr)
00274               CALL C_StructGMRESSolve(EllipticObjects(i)%LevelObjects(n)%Solver, EllipticObjects(i)%LevelObjects(n)%Matrix, EllipticObjects(i)%LevelObjects(n)%VariableVector, EllipticObjects(i)%LevelObjects(n)%SolutionVector, iErr)
00275               CALL CheckErr('C_StructGMRESSolve',iErr)
00276               CALL C_StructGMRESGetNumIterations(EllipticObjects(i)%LevelObjects(n)%Solver, Iters, iErr)
00277               CALL CheckErr('C_StructPCGSolve',iErr)
00278               CALL CheckIters(Iters, EllipticObjects(i)%MaxIters)
00279               CALL C_StructGMRESDestroy(EllipticObjects(i)%LevelObjects(n)%Solver,iErr)
00280               CALL CheckErr('C_StructGMRESDesetroy',iErr)
00281               
00282            END SELECT
00283            
00284            !Choose correct routine to unload vector objects
00285            IF (i == iPoissonSolve) THEN
00286               CALL Poisson_UnLoadVectors(n,EllipticObjects(iPoissonSolve)%LevelObjects(n))     
00287            END IF
00288            CALL C_StructVectorDestroy(EllipticObjects(i)%LevelObjects(n)%VariableVector, iErr) ;CALL CheckErr('C_StructVectorDestroy',iErr)
00289            CALL C_StructVectorDestroy(EllipticObjects(i)%LevelObjects(n)%SolutionVector, iErr) ;CALL CheckErr('C_StructVectorDestroy',iErr)        
00290            CALL BetweenSolveComm(i,n,done_solving)
00291         END DO
00292         CALL PostSolveComm(i,n)
00293      END DO
00294   END SUBROUTINE EllipticSolve
00295 
00298   SUBROUTINE EllipticDestroy(n)
00299      INTEGER :: n
00300      TYPE(NodeDefList), POINTER :: nodelist
00301      INTEGER :: ierr
00302      INTEGER :: i
00303      !First create the grid for this level to be used by all elliptic equations
00304      DO i=1,NrEllipticObjects
00305         CALL C_StructMatrixDestroy(EllipticObjects(i)%LevelObjects(n)%Matrix, iErr) ;CALL CheckErr('C_StructMatrixDestroy',iErr)     
00306      END DO
00307      CALL C_StructGridDestroy(levels(n)%Grid, iErr); CALL CheckErr('C_StructGridDesetroy',iErr)
00308   END SUBROUTINE EllipticDestroy
00309 
00312   SUBROUTINE PostElliptic(n)
00313      INTEGER :: i
00314      INTEGER :: n
00315      DO i=1,NrEllipticObjects
00316         IF (i == iPoissonSolve) THEN
00317            CALL PoissonPostElliptic(n)
00318         END IF
00319      END DO
00320   END SUBROUTINE PostElliptic
00322 
00323 
00326 
00331   SUBROUTINE PreSolveComm(i,n,done_solving)
00332      INTEGER :: i
00333      INTEGER :: n
00334      LOGICAL :: done_solving
00335      IF (i == iPoissonSolve) THEN
00336         CALL PoissonPreSolveComm(n,done_solving)
00337      END IF
00338   END SUBROUTINE PreSolveComm
00339 
00344   SUBROUTINE BetweenSolveComm(i,n,done_solving)
00345      INTEGER :: i
00346      INTEGER :: n
00347      LOGICAL :: done_solving
00348      IF (i == iPoissonSolve) THEN
00349         CALL PoissonBetweenSolveComm(n,done_solving)
00350      END IF
00351    END SUBROUTINE BetweenSolveComm
00352 
00356   SUBROUTINE PostSolveComm(i,n)
00357      INTEGER :: i
00358      INTEGER :: n
00359      LOGICAL :: done_solving
00360      IF (i == iPoissonSolve) THEN
00361         CALL PoissonPostSolveComm(n)
00362      END IF
00363   END SUBROUTINE PostSolveComm
00364 
00365 
00366 
00367   SUBROUTINE ApplyEllipticBC(n)
00368      INTEGER :: n
00369      CALL StartTimer(iApplyEllipticBCs, n)
00370      IF (lPoissonSolve) CALL PoissonSetBC(n)
00371      CALL StopTimer(iApplyEllipticBCs, n)
00372   END SUBROUTINE ApplyEllipticBC
00373 
00374 
00375 
00377 
00378 
00379 
00380   
00381 END MODULE EllipticControl
00382 
 All Classes Files Functions Variables