psmile_generate_1d_3d_dble.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_Generate_1d_3d_dble
!
! !INTERFACE:

      subroutine psmile_generate_1d_3d_dble (                 &
                           vector1, vector2, vector3, shape,  &
                           dest_array, dest_shape,            &
                           grid_valid_shape,                  &
                           ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Generate_1d_3d_dble

      implicit none
!
! !INPUT PARAMETERS:

      Integer, Intent (In)            :: shape (2, ndim_3d)

!     Dimension of source vectors "vector1", "vector2", "vector3"
!     which contain the values to be copied.
!
      Double Precision, Intent (In)               :: vector1 (shape(1,1): 
                                                              shape(2,1))
      Double Precision, Intent (In)               :: vector2 (shape(1,2): 
                                                              shape(2,2))
      Double Precision, Intent (In)               :: vector3 (shape(1,3): 
                                                              shape(2,3))
!     Data to be copied

      Integer, Intent (In)            :: dest_shape (2, ndim_3d)

!     Dimension of 3-dimensional destination array "dest_array"

      Integer, Intent (In)            :: grid_valid_shape (2, ndim_3d)
      
!     Specifies the subarray to be generated / copied.

! !OUTPUT PARAMETERS:

      Double Precision, Intent (Out)              :: dest_array ( 
                                             dest_shape(1,1):dest_shape(2,1), 
                                             dest_shape(1,2):dest_shape(2,2), 
                                             dest_shape(1,3):dest_shape(2,3))

!     Destination array to be generated

      integer, Intent (Out)           :: ierror

!     Returns the error code of PSMILe_info_trs_loc_3d_reg_dble;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
!     ... loop variables
!
      Integer                         :: j, k
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Generate_1d_3d_dble" generates a 3-dimensional array
! out of 3 1-dimensional vectors.
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 03.07.21    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_generate_1d_3d_dble.F90 2325 2010-04-21 15:00:07Z valcke $
!  $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_generate_1d_3d_dble.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------
!
!  Initialization
!
#ifdef VERBOSE
      print 9990, trim(ch_id)

      call psmile_flushstd
#endif /* VERBOSE */
!
      ierror = 0
!
!===> Generate 1st direction
!
         do k = grid_valid_shape (1, 3), grid_valid_shape (2, 3)
            do j = grid_valid_shape (1, 2), grid_valid_shape (2, 2)

            dest_array (grid_valid_shape(1,1):grid_valid_shape(2,1), j, k) = &
               vector1 (grid_valid_shape(1,1):grid_valid_shape(2,1))

            end do ! j
         end do ! k
!
!===> Generate 2nd direction
!
         do k = grid_valid_shape (1, 3), grid_valid_shape (2, 3)
            do j = grid_valid_shape (1, 2), grid_valid_shape (2, 2)

            dest_array (grid_valid_shape(1,1):grid_valid_shape(2,1), j, k) = &
               vector2 (j)

            end do ! j
         end do ! k
!
!===> Generate 3rd direction
!
         do k = grid_valid_shape (1, 3), grid_valid_shape (2, 3)
            do j = grid_valid_shape (1, 2), grid_valid_shape (2, 2)

            dest_array (grid_valid_shape(1,1):grid_valid_shape(2,1), &
                        grid_valid_shape(1,2):grid_valid_shape(2,2), k) = &
               vector3 (k)

            end do ! j
         end do ! k
                
!===> All done
!
#ifdef VERBOSE
      print 9980, trim(ch_id), ierror

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Formats:
!

#ifdef VERBOSE

9990 format (1x, a, ': psmile_generate_1d_3d_dble')
9980 format (1x, a, ': psmile_generate_1d_3d_dble: eof ierror =', i3)

#endif /* VERBOSE */

      end subroutine PSMILe_Generate_1d_3d_dble