psmile_copy_subarray_2d_double.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_Copy_subarray_2d_double
!
! !INTERFACE:
!
      subroutine psmile_copy_subarray_2d_double (dest_vector, size, &
                        darray, idlow, idhigh, jdlow, jdhigh, &
                                ibeg,  iend,   jbeg,  jend,   ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Copy_subarray_2d_double

      implicit none
!
! !INPUT PARAMETERS:
!
      integer(kind=int64), Intent (In)    :: size

!     Size (length) of destination vector "dest"

      integer, Intent (In)                :: idlow

!     Lowest  first  dimension of array "darray"

      integer, Intent (In)                :: idhigh

!     Highest first  dimension of array "darray"

      integer, Intent (In)                :: jdlow

!     Lowest  second dimension of array "darray"

      integer, Intent (In)                :: jdhigh

!     Highest second dimension of array "darray"

      double precision, Intent (In)       :: darray (idlow:idhigh, 
                                                     jdlow:jdhigh)

!     Array containg the sub-array to be copied

      integer, Intent (In)                :: ibeg

!     Lowest  first  index of sub-array to be copied

      integer, Intent (In)                :: iend

!     Highest first index of sub-array to be copied

      integer, Intent (In)                :: jbeg

!     Lowest  second index of sub-array to be copied

      integer, Intent (In)                :: jend

!     Highest second index of sub-array to be copied
!
! !OUTPUT PARAMETERS:
!
      double precision, Intent (Out)      :: dest_vector (size)

!     Destintation vector

      integer, Intent (Out)               :: ierror

!     Returns the error code of PSMILe_Copy_subarray_2d_double;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
      integer             :: i, j, leni
      integer(kind=int64) :: ip
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Copy_subarray_2d_double" copies the subarray
! darray (ibeg:iend, jbeg:jend) into the 1-dimensional destination
! vector "dest_vector".
!
!
! !REVISION HISTORY:
!   Date      Programmer   Description
! ----------  ----------   -----------
! 01.12.03    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_copy_subarray_2d_double.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $

   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_copy_subarray_2d_double.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------
!
!  Initialization
!
! ??? waere es moeglich dest_array als
!  dest_array (sub(1,1):sub(2,1), sub(1,2):sub(2,2), sub (1,3):sub(2,3))
! zu deklariren und dann
!
!  dest_array = darray (sub(1,1):sub(2,1), sub(1,2):sub(2,2), sub (1,3):sub(2,3)
!  asuzufuehren ?
!
!
      ierror = 0
!
      ip = 1
!
      leni = iend - ibeg + 1
!
         do j = jbeg, jend
!cdir vector
            do i = ibeg, iend
            dest_vector (ip+(i-ibeg)) = darray (i, j)
            enddo

            ip = ip + leni
         enddo
!
      end subroutine PSMILe_Copy_subarray_2d_double