psmile_print_irreg2_coord_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_Print_irreg2_coord_real
!
! !INTERFACE:

      subroutine psmile_print_irreg2_coord_real (x, y, z, shape,     &
                                                 ind, nloc, message)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Print_irreg2_coord_real
!
      implicit none
!
! !INPUT PARAMETERS:
!
      Integer, Intent (In)          :: shape (2, ndim_3d)
!
!     Shape of coordinates
!
      Real, Intent (In)             :: x (shape(1,1):shape(2,1), 
                                          shape(1,2):shape(2,2))
      Real, Intent (In)             :: y (shape(1,1):shape(2,1), 
                                          shape(1,2):shape(2,2))
      Real, Intent (In)             :: z (shape(1,3):shape(2,3))
!     Coords to be printed out
!
      Integer, Intent(In)           :: nloc
!
!     Number of indices to be printed out

      Integer, Intent(In)           :: ind (ndim_3d, nloc)
!
!     Indices of coords to be printed out
!
      Character(len=*), Intent(In)  :: message

!     Additional string to be printed out
!
! !LOCAL VARIABLES
!
      Integer                       :: i
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Print_irreg2_coord_real" prints the coordinate values
! of indices "ind" for a grid of type "PRISM_IRRLONLAT_Regvert".
!
!
! !REVISION HISTORY:
!
!   Date      Programmer    Description
! ----------  -----------   -----------
! 01.12.03    H. Ritzdorf   created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_print_irreg2_coord_real.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_print_irreg2_coord_real.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------
!
      write (*, 9000) trim(ch_id), message
!     print *, 'shape', shape
!     print *, 'nloc', nloc
!     print *, 'ind', ind
      call psmile_flushstd ()
!
!  Check
!
         do i = 1, nloc
         if (shape(1,1) <= ind(1,i) .and. ind(1,i) <= shape(2,1) .and. &
             shape(1,2) <= ind(2,i) .and. ind(2,i) <= shape(2,2) .and. &
             shape(1,3) <= ind(3,i) .and. ind(3,i) <= shape(2,3)) then
            print 9010, ind (:, i), x (ind(1,i), ind(2,i)), &
                                    y (ind(1,i), ind(2,i)), &
                                    z (ind(3,i))
         else
            print 9020, ind (:, i), shape
         end if
         end do ! i
!
!  FLush output
!
      call psmile_flushstd ()
!
!-----------------------------------------------------------------------
!  Formats
!-----------------------------------------------------------------------
!
9000  format (/1x, a, ': ', a)
9010  format (1x, 'ind =', 3i6, '; coord =', 1p, 3d16.9)
9020  format (1x, 'ind =', 3i6, ' out of shape', 6i6)
!
      end subroutine PSMILe_Print_irreg2_coord_real