psmile_print_grid_info.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_grid_info
!
! !INTERFACE:

      subroutine psmile_print_grid_info ( grid_id )
!
! !USES:
!
      use PRISM_constants
      use PSMILe, dummy_interface => PSMILe_Print_grid_info

      implicit none
!
! !INPUT PARAMETERS:
!
      integer,Intent(In)  :: grid_id

!     Handle to the grid information to be printed.
!
! !LOCAL VARIABLES
!
     Type (Corner_Block), Pointer  :: corner_pointer

     character(len=22), save :: name_status (PSMILe_Status_free: 
                                             PSMILe_Status_commited)
     character(len=17), save :: name_grid   (PSMILe_Grid_Block: 
                                             PSMILe_Grid_Block)

     data name_status /'PSMILe_Status_free', 'PSMILe_status_defined', &
                       'PSMILe_Status_commited'/
     data name_grid   /'PSMILe_Grid_Block'/
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_Print_grid_info" prints the info of a grid handle.
!
!
! !REVISION HISTORY:
!
!   Date      Programmer    Description
! ----------  -----------   -----------
! 01.12.03    H. Ritzdorf   created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_print_grid_info.F90 2687 2010-10-28 15:15:52Z coquart $
! $Author: coquart $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_print_grid_info.F90 2687 2010-10-28 15:15:52Z coquart $'
!
!----------------------------------------------------------------------
!
      write (*, 9000) trim(ch_id), grid_id
!
!  Check
!
      if (grid_id > Number_of_Grids_allocated .or. &
          grid_id < 1) then

         write (*, 9010) 'Is an invalid grid id'

         call psmile_flushstd ()
         return
      endif
!
      if (Grids(grid_id)%status == PSMILe_status_free) then
         write (*, 9010) 'Is currently free'

         call psmile_flushstd ()
         return
      endif
!
      if (Grids(grid_id)%status >= PSMILe_Status_free .and. &
          Grids(grid_id)%status <= PSMILe_status_commited) then
          write (*, 9020) 'status',          Grids(grid_id)%status, &
                          name_status (Grids(grid_id)%status)
      else
          write (*, 9020) 'status',          Grids(grid_id)%status
      endif
!
!  Print general info
!
      write (*, 9020) 'comp_id',         Grids(grid_id)%comp_id

      if (Grids(grid_id)%grid_type >= PSMILe_Grid_Block .and. &
          Grids(grid_id)%grid_type <= PSMILe_Grid_Block) then
         write (*, 9020) 'grid_type',       Grids(grid_id)%grid_type, &
                          name_grid (Grids(grid_id)%grid_type)
      else
         write (*, 9020) 'grid_type',       Grids(grid_id)%grid_type
      endif

      write (*, 9020) 'grid_structure', Grids(grid_id)%grid_structure
      write (*, 9020) 'n_dim '        , Grids(grid_id)%n_dim
      write (*, 9020) 'size'          , Grids(grid_id)%size
      write (*, 9030) 'grid name is ' , trim(Grids(grid_id)%grid_name)

      Nullify ( corner_pointer )
      corner_pointer  => Grids(grid_id)%corner_pointer
      write (*, 9050) 'size of corner', &
                       corner_pointer%corner_shape(1:2,1:Grids(grid_id)%n_dim)

      if (Associated(Grids(grid_id)%partition)) then
         write (*, 9030) 'partition pointer', 'is associated'
         write (*, 9060) 'partition is     ', Grids(grid_id)%partition
      else
         write (*, 9030) 'partition pointer', 'is not associated'
      endif

      if (Associated(corner_pointer%corners_real(1)%vector)) then
         write (*, 9030) 'corners_real(1)%vector pointer', 'is associated'
      else
         write (*, 9030) 'corners_real(1)%vector pointer', 'is not associated'
      endif
      if (Associated(corner_pointer%corners_dble(1)%vector)) then
         write (*, 9030) 'corners_dble(1)%vector pointer', 'is associated'
      else
         write (*, 9030) 'corners_dble(1)%vector pointer', 'is not associated'
      endif

      if (Associated(corner_pointer%corners_real(2)%vector)) then
         write (*, 9030) 'corners_real(2)%vector pointer', 'is associated'
      else
         write (*, 9030) 'corners_real(2)%vector pointer', 'is not associated'
      endif
      if (Associated(corner_pointer%corners_dble(2)%vector)) then
         write (*, 9030) 'corners_dble(2)%vector pointer', 'is associated'
      else
         write (*, 9030) 'corners_dble(2)%vector pointer', 'is not associated'
      endif

      if (Associated(corner_pointer%corners_real(3)%vector)) then
         write (*, 9030) 'corners_real(3)%vector pointer', 'is associated'
      else
         write (*, 9030) 'corners_real(3)%vector pointer', 'is not associated'
      endif
      if (Associated(corner_pointer%corners_dble(3)%vector)) then
         write (*, 9030) 'corners_dble(3)%vector pointer', 'is associated'
      else
         write (*, 9030) 'corners_dble(3)%vector pointer', 'is not associated'
      endif
!
!  FLush output
!

      write (*, 9010)

      call psmile_flushstd ()
!
!-----------------------------------------------------------------------
!  Formats
!-----------------------------------------------------------------------
!
9000  format (/1x, a, ': Info on grid handle', i3, ':', &
              /1x, 40('-'))
9010  format (1x, a)
9020  format (1x, a30, ' = ', i7, : 1x, a)
9030  format (1x, a30, 3x,    a)
9050  format (1x, a30, ' = ', 3(i4, ':', i4, :, ','))
9060  format (1x, a30, ' = ', 2(i8, ';'),i8)
!
      end subroutine PSMILe_Print_grid_info