psmile_extract_indices_2d_real.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_Extract_indices_2d_real
!
! !INTERFACE:

      subroutine psmile_extract_indices_2d_real (array, shape, &
               dstijk, ncpl, dest_vector, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Extract_indices_2d_real

      implicit none
!
! !INPUT PARAMETERS:
!
      Integer, Intent (In)            :: shape (2, ndim_2d)
!
!     Shape of the array "array"
!
      Real, Intent (In)               :: array (shape(1,1):shape(2,1), 
                                                shape(1,2):shape(2,2))
!
      Integer, Intent (In)            :: ncpl
!
!     Dimension of output vector "dest_vector" and input vector "dstijk"
!
      Integer, Intent (In)            :: dstijk (ndim_3d, ncpl)
!
! !OUTPUT PARAMETERS:
!
      Real, Intent (Out)              :: dest_vector (ncpl)
!
!     Output vector containing extracted values of indices "dstijk"
!
      Integer, Intent (Out)           :: ierror

!     Returns the error code of PSMILE_Extract_indices_2d_real;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
!     ... for extracting the compact list
!
      Integer                         :: n
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Extract_indices_2d_real" extracts the values of array
! "array" for indices specified in "dstijk" and stores the values in
! destination vector "dest_vector"
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03.07.21    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_extract_indices_2d_real.F90 2325 2010-04-21 15:00:07Z valcke $
!  $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_extract_indices_2d_real.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------
!----------------------------------------------------------------------
!
!  Initialization
!
#ifdef VERBOSE
      print 9990, trim(ch_id)

      call psmile_flushstd
#endif /* VERBOSE */
!
#ifdef PRISM_ASSERTION
#endif
!
      ierror = 0
!
!cdir vector
         do n = 1, ncpl
         dest_vector (n) = array (dstijk(1, n), dstijk(2, n))
         end do
!
!===> All done
!
#ifdef VERBOSE
      print 9980, trim(ch_id)

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

      end subroutine PSMILe_Extract_indices_2d_real