psmile_trans_loc2glob_3d.F90

Go to the documentation of this file.

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

      subroutine psmile_trans_loc2glob_3d (grid_id, &
                      ibuf, len_item, nloc, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_trans_loc2glob_3d

      Implicit none
!
! !INPUT PARAMETERS:
!
      Integer,         Intent (In)    :: grid_id

!     Grid Id of the source grid (grid on which the points are searched)
!
      Integer, Intent (In)            :: nloc
!
!     Number of locations to be transferred
!
      Integer, Intent (In)            :: len_item
!
!     First dimension of array "ibuf"
!
! !INPUT/OUTPUT PARAMETERS:
!
      Integer, Intent (InOut)         :: ibuf (len_item, nloc)
!
!     Indices of locations to be transformed with
!     ibuf (1:ndim_3d, :) = Index in 3d grid
!     Input:  Indices as local  indices
!     Output: Indices as global indices
!
! !OUTPUT PARAMETERS:
!
      Integer, Intent (Out)           :: ierror

!     Returns the error code of PSMILe_trans_loc2glob_3d;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
!     ... for grid
!
      Integer                         :: nbr_blocks
!
      Type(Grid), Pointer             :: grid_info
!
!     ... for transformation
!
      Integer                         :: shift (ndim_3d)
!
!     ... loop variables
!
      Integer                         :: i
!
!     ... for error handling
!
!     Integer, Parameter              :: nerrp = 2
!     Integer                         :: ierrp (nerrp)
!
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_trans_global_3d" transforms the local
! 3d-indices into global 3d-indices for a grid of
! type "PRISM_Irrlonlatvrt", "PRISM_Irrlonlat_regvrt" or
! "PRISM_Reglonlatvrt".
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 13.02.07    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_trans_loc2glob_3d.F90,v 1.1.2.1 2007/04/30 15:00:27 ritzdorf Exp $
!  $Author: ritzdorf $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_trans_loc2glob_3d.F90,v 1.1.2.1 2007/04/30 15:00:27 ritzdorf Exp $'
!
!----------------------------------------------------------------------
!----------------------------------------------------------------------
!
!  Initialization
!
#ifdef VERBOSE
      print 9990, trim(ch_id)

      call psmile_flushstd
#endif /* VERBOSE */
!
      ierror = 0
!
      grid_info => Grids(grid_id)
      nbr_blocks = size (grid_info%extent(:,1))
!
#ifdef PRISM_ASSERTION
#endif
!
      if ( nbr_blocks > 1) then
         print *, '### Warning: Only a single partition is currently supported in global search'
      endif
!
      shift (1:ndim_3d) = grid_info%partition (1, 1:ndim_3d) - &
                          grid_info%grid_shape(1, 1:ndim_3d) + 1
!
!cdir vector
         do i = 1, nloc
         ibuf (1,i) = ibuf (1,i) + shift (1)
         ibuf (2,i) = ibuf (2,i) + shift (2)
         ibuf (3,i) = ibuf (3,i) + shift (3)
         end do
!
!===> All done
!
#ifdef VERBOSE
      print 9980, trim(ch_id)

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Formats:
!
9990 format (1x, a, ': psmile_trans_loc2glob_3d')
9980 format (1x, a, ': psmile_trans_loc2glob_3d: eof')

      end subroutine psmile_trans_loc2glob_3d