psmile_reshape_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_Reshape_2d_real
!
! !INTERFACE:
!
      subroutine psmile_reshape_2d_real (source, source_shape, sub_range, &
                                         dest,   dest_shape, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe!, dummy_interface => PSMILe_Reshape_2d_real

      Implicit none
!
! !INPUT PARAMETERS:
!
      Integer,          Intent (In)       :: source_shape (2, ndim_2d)

!     Dimension of source array "source"

      Integer,          Intent (In)       :: sub_range (2, ndim_2d)

!     Range of source to be copied

      Real, Intent (In)                   ::          
         source (source_shape(1,1):source_shape(2,1), 
                 source_shape(1,2):source_shape(2,2))

!     Array containg the sub-array to be copied

      Integer,          Intent (In)       :: dest_shape (2, ndim_2d)
!
! !OUTPUT PARAMETERS:
!

      Real, Intent (InOut)                ::    
         dest (dest_shape(1,1):dest_shape(2,1), 
               dest_shape(1,2):dest_shape(2,2))

!     Array returning the sub-array which was copied

      Integer,          Intent (Out)      :: ierror

!     Returns the error code of PSMILe_Reshape_2d_real;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
      Integer             :: i, j
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Reshape_2d_real" copies the subarray
!    "source(sub_range(1,1):sub_range(2,1),
!            sub_range(1,2):sub_range(2,2))"
! into the destination array "dest(:, :)"
!
! Note: The routine is used to copy to/from an array which is stored
!       as 1-dimensional vector.
!
!
! !REVISION HISTORY:
!   Date      Programmer   Description
! ----------  ----------   -----------
! 02.05.09    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_reshape_2d_real.F90,v 1.1.2.1 2009/07/07 15:18:05 ritzdorf Exp $
! $Author: ritzdorf $

   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_reshape_2d_real.F90,v 1.1.2.1 2009/07/07 15:18:05 ritzdorf Exp $'
!
!----------------------------------------------------------------------
!
!  Initialization
!
      ierror = 0
!
      dest   (sub_range(1,1):sub_range(2,1),   &
              sub_range(1,2):sub_range(2,2)) = &
      source (sub_range(1,1):sub_range(2,1),   &
              sub_range(1,2):sub_range(2,2))
!
      end subroutine PSMILe_Reshape_2d_real