psmile_mg_coars_level.F90

Go to the documentation of this file.

!-----------------------------------------------------------------------
! Copyright 2006-2010, NEC Europe Ltd., London, UK.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: PSMILe_MG_coars_level
!
! !INTERFACE:

      subroutine psmile_mg_coars_level (grid_id, mg_info_fine,   &
                                                 mg_info_coarse, &
                                        icoarse, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_MG_coars_level

      implicit none
!
! !INPUT PARAMETERS:
!
      integer, Intent (In)                :: grid_id

!     Specifies the handle to the grid information.
!
      Type (Enddef_mg), Intent (In)       :: mg_info_fine

!     Structure containing the data on the finer multigrid level.

      Integer, Intent (In)                :: icoarse  (ndim_3d)

!     Specifies the coarsening in each direction.
!
! !INPUT/OUTPUT PARAMETERS:
!
      Type (Enddef_mg), Intent (InOut)    :: mg_info_coarse

!     Structure returning the data on the coarser multigrid level
!     which is created by this routine.
!
!
! !OUTPUT PARAMETERS:
!
      integer, Intent (Out)               :: ierror

!     Returns the error code of PSMILe_MG_coars_level;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
      Type (Corner_Block), Pointer        :: corner_pointer
!
!     ... for error parameters
!
      integer, parameter                  :: nerrp = 1
      integer                             :: ierrp (nerrp)
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_MG_coars_level" creates the next (coarser)
! multigrid level from an existing finer one.
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03.07.07    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_mg_coars_level.F90 2325 2010-04-21 15:00:07Z valcke $
!  $Autor$
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_mg_coars_level.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------

#ifdef VERBOSE
      print 9990, trim(ch_id), grid_id, icoarse

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Initialization
!
      corner_pointer => Grids(grid_id)%corner_pointer
!
      if (corner_pointer%corner_datatype == MPI_REAL) then

!        ... Real datatype

         call psmile_mg_coars_level_real (grid_id, mg_info_fine,   &
                                                   mg_info_coarse, &
                                          icoarse, ierror)

      else if (corner_pointer%corner_datatype == MPI_DOUBLE_PRECISION) then

!        ... Double datatype

         call psmile_mg_coars_level_dble (grid_id, mg_info_fine,   &
                                                   mg_info_coarse, &
                                          icoarse, ierror)

#if defined ( PRISM_QUAD_TYPE )
      else if (corner_pointer%corner_datatype == MPI_REAL16) then

!        ... Quadruple  datatype

         call psmile_mg_coars_level_quad (grid_id, mg_info_fine,   &
                                                   mg_info_coarse, &
                                          icoarse, ierror)

#endif

      else
!
!        Unknown data type
!
         ierrp (1) = corner_pointer%corner_datatype
         ierror = PRISM_Error_Internal
         call psmile_error ( ierror, 'unsupported data type', &
                             ierrp, 1, __FILE__, __LINE__ )
      endif
!
!===> All done
!
#ifdef VERBOSE
      print 9980, trim(ch_id), grid_id, ierror

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Formats:
!
9990 format (1x, a, ': PSMILe_MG_coars_level: grid_id =', i3, &
                    '; icoarse =', 3i4)
9980 format (1x, a, ': PSMILe_MG_coars_level: end grid_id =', i3, &
                    '; ierror =', i4)

      end subroutine PSMILe_MG_coars_level