psmile_print_found_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_found_dble
!
! !INTERFACE:

      subroutine psmile_print_found_dble (comp_info, lev,           &
                        found, loc, range,                          &
                        coords1, coords2, coords3,                  &
                        shape1,  shape2,  shape3,                   &
                        control, n_coords, message, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe !, dummy_interface => PSMILe_print_found_dble

      implicit none
!
! !INPUT PARAMETERS:
!
      Type (Enddef_comp), Intent (In) :: comp_info

!     Info on the component

      Integer, Intent (In)            :: lev

!     Level number

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

!     Dimension of loc and found

!     Index range in "coords" to be searched
!
      Integer, Intent (In)            :: found (range(1,1):range(2,1), 
                                                range(1,2):range(2,2), 
                                                range(1,3):range(2,3))

!     Finest level number on which a grid cell was found for point i,j,k.
!     Level number < -1: Point was not found and
!                        and last level number was (-found(i,j,k))
!     Level number = -(nlev+1): Never found
!     found(i,j,k) = +1: Point (i,j,k) is located on a point
!                        of the method grid.
!     found(i,j,k) = -1: Point (i,j,k) is located in a cell
!                        of the method grid.
!
      Integer, Intent (In)           :: loc   (ndim_2d,               
                                                range(1,1):range(2,1), 
                                                range(1,2):range(2,2), 
                                                range(1,3):range(2,3))

      Integer, Intent (In)            :: shape1 (2, ndim_3d)
      Integer, Intent (In)            :: shape2 (2, ndim_3d)
      Integer, Intent (In)            :: shape3 (2, ndim_3d)

!     Dimension of coordinate arrays "coord1" and "coord2"
!     which contain the coordinates to be searched.

!     Indices of the grid cell in which the point was found.
!     The indices are relative to "shape".

      Double Precision, Intent (In)   :: coords1 (shape1(1,1):shape1(2,1), 
                                                  shape1(1,2):shape1(2,2), 
                                                  shape1(1,3):shape1(2,3))
      Double Precision, Intent (In)   :: coords2 (shape2(1,1):shape2(2,1), 
                                                  shape2(1,2):shape2(2,2), 
                                                  shape2(1,3):shape2(2,3))
      Double Precision, Intent (In)   :: coords3 (shape3(1,1):shape3(2,1), 
                                                  shape3(1,2):shape3(2,2), 
                                                  shape3(1,3):shape3(2,3))

!     Coordinates to be searched

      Integer, Intent (In)            :: control (2, ndim_3d)
!
      Integer, Intent (In)           :: n_coords
!
!     Number of coordinate arrays
!
      Character (len=*), Intent(In)  :: message
!
!     Message to be printed in the beginning
!
! !OUTPUT PARAMETERS:
!
      Integer, Intent (Out)           :: ierror

!     Returns the error code of PSMILE_mg_method_2d_dble;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !DEFINED PARAMETERS:
!
!  val_direct  = Code for locations which should to be directly transferred
!                to the destination process.
!  val_coupler = Code for locations which should to be transferred
!                to the coupler process.
!
      Integer, Parameter              :: val_direct  =  1
      Integer, Parameter              :: val_coupler = -1
!
! !LOCAL VARIABLES
!
      Integer                         :: i, j, k
!
      Double precision                :: xyz (n_coords)
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_print_found_dble" write data out on the locations
! currently found.
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 13.05.08    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_print_found_dble.F90,v 1.1.2.1 2008/06/20 10:43:50 ritzdorf Exp $
!  $Author: ritzdorf $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_print_found_dble.F90,v 1.1.2.1 2008/06/20 10:43:50 ritzdorf Exp $'
!
!  Initialization
!
      ierror = 0

#ifdef PRISM_ASSERTION
      if (lev < 1) then
         call psmile_assert (__FILE__, __LINE__, &
                             "lev < 1")
      endif
!
      if (n_coords > ndim_3d) then
         call psmile_assert (__FILE__, __LINE__, &
                             "n_coords > ndim_3d")
      endif
#endif
!
      print 9990, trim(ch_id), message, lev
!
         do k = range(1,3), range(2,3)
            do j = range(1,2), range (2,2)
               do i = range (1,1), range (2,1)

               print 9980, i,j,k, abs(found (i,j,k)) == lev, &
                           found (i,j,k), loc (:, i,j,k)

               if (abs(found (i,j,k)) /= lev) then
             
                  xyz (1) = coords1 (i,j,k)
                  if (n_coords >= 2) xyz (2) = coords2 (i,j,k)
                  if (n_coords >= 3) xyz (3) = coords3 (i,j,k)

                  print 9970, i,j,k, xyz (1:n_coords)
               endif

               end do
            end do
         end do

      call psmile_flushstd
!
!  Formats:
!
9990  format (1x, a, ': ', a, ': lev =', i3)
9980  format (1x, 'i,j,k', 3i5, ': found ', l1, ' (', i3, '), loc', 3i6)
9970  format (1x, 'i,j,k', 3i5, ': coords', 3f20.12)

      end subroutine psmile_print_found_dble