psmile_reducedgrid_map.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_reducedgrid_map
!
! !INTERFACE:

      subroutine psmile_reducedgrid_map ( grid_id, nbr_latitudes, &
                 nbr_points_per_lat, ierror )
!
! !USES:
!
      use PRISM
!
      use PSMILe, dummy => psmile_reducedgrid_map
!
      use psmile_grid_reduced_gauss, only : psmile_init_gauss_data

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

!     Specifies the handle to the grid information for which this call is.

      integer, Intent (In)                :: nbr_latitudes

!     Number of latitudes of the Gaussian reduced grid.

      integer, Intent (In)                :: nbr_points_per_lat(nbr_latitudes)

!     Number of longitude points per latitude circle
!
      integer, Intent (Out)               :: ierror
!
!     Returns the error code of psmile_reducedgrid_map;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
!
! !LOCAL VARIABLES
!
      integer, parameter :: nerrp = 2
      integer            :: ierrp (nerrp)
!
! !DESCRIPTION:
!
!  Subroutine "psmile_reducedgrid_map" receive mapping information for the
!  1 d coordinate arrays.
!
!
!
! !REVISION HISTORY:
!   Date      Programmer   Description
! ----------  ----------   -----------
! 05.06.27    R. Redler    created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_reducedgrid_map.F90 2917 2011-01-27 09:24:20Z hanke $
! $Author: hanke $
!
  Character(len=len_cvs_string), save :: mycvs = 
      '$Id: psmile_reducedgrid_map.F90 2917 2011-01-27 09:24:20Z hanke $'
!
!----------------------------------------------------------------------

#ifdef VERBOSE
      print *, trim(ch_id), ': psmile_reducedgrid_map: grid_id =', grid_id

      call psmile_flushstd
#endif /* VERBOSE */

!------------------------------------------------------------------------
!  1st Initialization
!------------------------------------------------------------------------

      ierror = 0

      call psmile_init_gauss_data (grid_id, nbr_points_per_lat)

!------------------------------------------------------------------------
!  2nd Control Grid id
!------------------------------------------------------------------------

      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_free) 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

!------------------------------------------------------------------------
!  3rd Allocate memory
!------------------------------------------------------------------------

      Allocate(Grids(grid_id)%nbr_points_per_lat(nbr_latitudes), STAT=ierror)

      if (ierror > 0) then
         ierrp (1) = ierror
         ierrp (2) = nbr_latitudes
         ierror = PRISM_Error_Alloc

         call psmile_error ( ierror, 'nbr_points_per_lat', &
                             ierrp, 2, __FILE__, __LINE__ )
         return
      endif

!------------------------------------------------------------------------
!  4th Store Data
!------------------------------------------------------------------------

      Grids(grid_id)%nbr_latitudes = nbr_latitudes
      Grids(grid_id)%nbr_points_per_lat(:) = nbr_points_per_lat(:)

!------------------------------------------------------------------------
!  5th Epilogue
!------------------------------------------------------------------------

#ifdef VERBOSE
      print *, trim(ch_id), ': psmile_reducedgrid_map: eof ierror =', &
               ierror, '; grid_id', grid_id

      call psmile_flushstd
#endif /* VERBOSE */
!
      end subroutine psmile_reducedgrid_map