psmile_set_points_gridless.F90

Go to the documentation of this file.

!
!-----------------------------------------------------------------------
! Copyright 2006-2010, CERFACS, Toulouse, France.
! Copyright 2006-2010, SGI Germany, Munich, Germany.
! Copyright 2006-2010, NEC Europe Ltd., London, UK.
! All rights reserved. Use is subject to OASIS4 license terms.
!-----------------------------------------------------------------------
!BOP
!
! !ROUTINE: psmile_set_points_gridless
!
! !INTERFACE:

      subroutine psmile_set_points_gridless ( method_id, point_name, &
                                             grid_id, new_points, ierror)
!
! !USES:
!
      use PRISM
!
      use PSMILe, dummy => psmile_set_points_gridless
!
      implicit none
!
! !INPUT PARAMETERS:
!
      Character(len=*), Intent (In)       :: point_name

!     Specifies the name of the set of points specified, unique on each
!     process within each component.

      Integer,          Intent (In)       :: grid_id

!     Specifies handle to the grid information created by routine
!     PRISM_def_grid.

      Logical,          Intent (In)       :: new_points
!
!     Logical to indicate whether a new method id should be generated or not.
!
! !INPUT/OUTPUT PARAMETERS:
!
      Integer,          Intent (InOut)    :: method_id

!     handle to the defined method.
!
! !OUTPUT PARAMETERS:
!
      Integer,          Intent (Out)      :: ierror

!     Returns the error code of psmile_set_points_gridless;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
      Type (Coords_Block), pointer :: coords_pointer
      Integer                      :: i, n_dim
!
      Integer, parameter           :: nerrp = 3
      Integer                      :: ierrp (nerrp)
!
!
! !DESCRIPTION:
!
! Subroutine "psmile_set_points_gridless" defines/returns the method id
! "method_id" for a gridless grid with id "grid_id".
! The points of grid type "PRIDM_Gridless" are always defined on the
! vertices of the grid. Therefore, it is not necessary to pass coordinate
! arrays for the location of the points.
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 01.12.03    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_set_points_gridless.F90 2773 2010-11-25 14:48:32Z hanke $
! $Author: hanke $
!
  Character(len=len_cvs_string), save :: mycvs = 
      '$Id: psmile_set_points_gridless.F90 2773 2010-11-25 14:48:32Z hanke $'
!
!----------------------------------------------------------------------

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

      call psmile_flushstd
#endif /* VERBOSE */

!-----------------------------------------------------------------------
!  Initialization
!-----------------------------------------------------------------------

      ierror = 0

!-----------------------------------------------------------------------
!  Control input arguments
!-----------------------------------------------------------------------

      if (grid_id < 1 .or. &
          grid_id > Number_of_Grids_allocated ) then
         ierrp (1) = grid_id
         ierrp (2) = Number_of_Grids_allocated

         ierror = PRISM_Error_Arg

         call psmile_error ( ierror, 'grid_id', &
                             ierrp, 2, __FILE__, __LINE__ )
         return
      endif
!
      if (Grids(grid_id)%status /= PSMILe_status_defined) then
         ierrp (1) = grid_id

         ierror = PRISM_Error_Arg

         call psmile_error ( PRISM_Error_Arg, 'grid_id (not active)', &
                             ierrp, 1, __FILE__, __LINE__ )
         return
      endif
!
      if ( Grids(grid_id)%grid_type /= PRISM_Gridless ) then
         ierrp (1) = grid_id
         ierror = PRISM_Error_Arg

         call psmile_error ( PRISM_Error_Arg, &
             'Coordinate points must be specified for all grids except for grids of type PRISM_Gridless', &
                             ierrp, 1, __FILE__, __LINE__ )
         return
      endif

!-----------------------------------------------------------------------
!  Store data on vertices
!-----------------------------------------------------------------------

      if ( new_points ) then

!-----------------------------------------------------------------------
!  get a new method Id
!-----------------------------------------------------------------------

         call psmile_get_method_handle (grid_id, method_id, ierror)

         if (ierror > 0) then
            ierrp (1) = method_id
            ierror = PRISM_Error_Arg
            call psmile_error ( PRISM_Error_Arg, 'Failed to get a new method id', &
                                ierrp, 1, __FILE__, __LINE__ )
            return
         endif

         Allocate(Methods(method_id)%coords_pointer, STAT = ierror)

         if (ierror > 0) then
            ierrp (1) = ierror
            ierror = PRISM_Error_Alloc
            call psmile_error ( ierror, 'coords_pointer', &
                                ierrp, 1, __FILE__, __LINE__ )
            return
         endif

         coords_pointer => Methods(method_id)%coords_pointer

            do i = 1, ndim_3d
            Nullify ( coords_pointer%coords_real(i)%vector )
            Nullify ( coords_pointer%coords_dble(i)%vector )
#if defined ( PRISM_QUAD_TYPE )
            Nullify ( coords_pointer%coords_quad(i)%vector )
#endif
            end do

         coords_pointer%coords_datatype = MPI_DATATYPE_NULL

         Methods(method_id)%used_for_coupling = .false.

      else

         if ( Methods(method_id)%method_type /= PSMILe_PointMethod ) then

            ierror = PRISM_Error_Parameter
            ierrp (1) = ierror
            ierrp (2) = method_id
            call psmile_error ( ierror, 'not a method_id for points', &
                                ierrp, 2, __FILE__, __LINE__ )
            return
         endif

         coords_pointer => Methods(method_id)%coords_pointer
      endif

!-----------------------------------------------------------------------
! Get n_dim which was defined in PRISM_def_grid
!-----------------------------------------------------------------------

      n_dim = Grids(grid_id)%n_dim
      if ( n_dim > ndim_3d ) then
         ierrp (1) = n_dim

         ierror = PRISM_Error_Internal
         call psmile_error ( ierror, 'unsupported dimension Grids(grid_id)%n_dim', &
                             ierrp, 1, __FILE__, __LINE__ )
         return
       endif

      Methods(method_id)%size = 0

!-----------------------------------------------------------------------
!  Store shapes
!-----------------------------------------------------------------------

      coords_pointer%coords_shape = 1
      coords_pointer%coords_shape(1:2,1:n_dim) = &
              Grids(grid_id)%grid_shape(1:2,1:n_dim)
!
!-----------------------------------------------------------------------
!     Update status and other info's
!-----------------------------------------------------------------------
!
!     Mark status as changed
!     ? Special status for ``unimportant data'' required?
!
      Methods(method_id)%status          = PSMILe_status_defined
!
      Methods(method_id)%grid_id         = grid_id
!
      Methods(method_id)%method_type     = PSMILe_PointMethod
!
      Methods(method_id)%point_name      = point_name

#ifdef VERBOSE
      print 9980, trim(ch_id), ierror, method_id

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Formats:
!
#ifdef VERBOSE

9990 format (1x, a, ': psmile_set_points_gridless: grid_id ', i3, &
                    '; new handle ', l1)
9980 format (1x, a, ': psmile_set_points_gridless: eof ierror =', i3, &
                    '; method_id', i5)

#endif /* VERBOSE */

      end subroutine psmile_set_points_gridless