psmile_print_3d_coord_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_Print_3d_coord_dble
!
! !INTERFACE:

      subroutine psmile_print_3d_coord_dble (x, y, z, shape,     &
                                             ind, nloc, message)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_Print_3d_coord_dble
!
      implicit none
!
! !INPUT PARAMETERS:
!
      Integer, Intent (In)          :: shape (2, ndim_3d)
!
!     Shape of coordinates
!
      Double Precision, Intent (In) :: x (shape(1,1):shape(2,1), 
                                          shape(1,2):shape(2,2), 
                                          shape(1,3):shape(2,3))
      Double Precision, Intent (In) :: y (shape(1,1):shape(2,1), 
                                          shape(1,2):shape(2,2), 
                                          shape(1,3):shape(2,3))
      Double Precision, Intent (In) :: z (shape(1,1):shape(2,1), 
                                          shape(1,2):shape(2,2), 
                                          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_3d_coord_dble" prints the coordinate values
! of indices (i,j,k).
!
!
! !REVISION HISTORY:
!
!   Date      Programmer    Description
! ----------  -----------   -----------
! 01.12.03    H. Ritzdorf   created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_print_3d_coord_dble.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_print_3d_coord_dble.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------
!
      write (*, 9000) trim(ch_id), message
!
!  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), ind(3,i)), &
                                    y (ind(1,i), ind(2,i), ind(3,i)), &
                                    z (ind(1,i), ind(2,i), 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_3d_coord_dble