psmile_enddef_comp_grid.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_Enddef_comp_grid
!
! !INTERFACE:

      subroutine psmile_enddef_comp_grid (comp_id, n_grids, ierror)

!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_enddef_comp_grid

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

!     Specifies the handle to the component information.
!
! !OUTPUT PARAMETERS:
!
      integer, Intent (Out)               :: n_grids

!     Returns the number of grids used in the coupling process.

      integer, Intent (Out)               :: ierror

!     Returns the error code of PSMILe_enddef_comp_grid;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
      Integer                      :: n, grid_id
      Integer                      :: color, key
      Integer                      :: il_size

      Integer, parameter           :: nerrp = 1
      Integer                      :: ierrp (nerrp)
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_enddef_comp" computes the number of grids of
! component "comp_id" which are used in the coupling process, and
! for stand_alone application, the number of grids used in the IO
! process
!
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 01.12.03    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
!  $Id: psmile_enddef_comp_grid.F90 2847 2011-01-04 17:07:21Z coquart $
!  $Autor$
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_enddef_comp_grid.F90 2847 2011-01-04 17:07:21Z coquart $'
!
!----------------------------------------------------------------------

#ifdef VERBOSE
      print *, trim(ch_id), ': PSMILe_enddef_comp_grid: comp_id', comp_id

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Initialization
!
      ierror = 0
!
!  Is the grid really used ?
!  TODO
!  ??? Wird das wirklich in der endgueltigen Version gebraucht ?
!  ??? Wenn ja, dann Argument und bis zu psmile_enddef_comp passen
!
!
!   Get the number of grids used for coupling
!
      n = 0
      do grid_id = 1, Number_of_Grids_allocated

#ifdef DEBUGX
        PRINT*, 'In psmile_enddef_comp_grid for grid_id:', grid_id
        PRINT*, 'Grids(grid_id)%status :',Grids(grid_id)%status
        PRINT*, 'Grids(grid_id)%comp_id , comp_id:',Grids(grid_id)%comp_id , comp_id
        PRINT*, 'Grids(grid_id)%used_for_coupling :',Grids(grid_id)%used_for_coupling
        PRINT*, 'Grids(grid_id)%used_for_io :',Grids(grid_id)%used_for_io
        call psmile_flushstd
#endif

         if (Grids(grid_id)%status /= PSMILe_status_free .and. &
             Grids(grid_id)%comp_id == comp_id           .and. &
             Grids(grid_id)%used_for_coupling) then

            n = n + 1

         endif

         IF (Appl%stand_alone .AND. &
             Grids(grid_id)%status /= PSMILe_status_free .AND. &
             Grids(grid_id)%comp_id == comp_id           .and. &
             Grids(grid_id)%used_for_io ) then

            n = n + 1

        ENDIF

      enddo

      n_grids = n

      key     = 0
      color   = 0
      
      if ( n_grids > 0 )  color = 1
!
! To support stand alone applications that only use OASIS4 PSMILE for IO
!

      call MPI_Comm_Split ( Comps(comp_id)%comm, color, key, Comps(comp_id)%act_comm, ierror )
#ifdef DEBUG
      call MPI_Comm_Size ( Comps(comp_id)%act_comm, il_size, ierror)
      WRITE (*,*) 'n_grids = ', n_grids, 'size of Comp(comp_id) =',il_size
#endif
      if ( ierror /= MPI_SUCCESS ) then
         ierrp (1) = ierror
         ierror = PRISM_Error_MPI

         call psmile_error ( ierror, 'MPI_Comm_Split', &
              ierrp, 1, __FILE__, __LINE__ )
         return
      endif
!
#ifdef PRISM_ASSERTION
      if (n > Comps(comp_id)%n_grids) then
         write (*, 9990) n, Comps(comp_id)%n_grids
         call psmile_assert ( __FILE__, __LINE__, &
                              'n > Number_of_Grids')
      endif
#endif /* PRISM_ASSERTION */
!
!===> All done
!
#ifdef VERBOSE
      print *, trim(ch_id), ': PSMILe_enddef_comp_grid: eof ierror =', ierror

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Fromats
!
#ifdef PRISM_ASSERTION
9990 format (/1x, 'PSMILe_enddef_comp_grid: inconsistent number of grids: ',&
                  'n =', i7, '; Number_of_Grids =', i7)
#endif /* PRISM_ASSERTION */

      end subroutine PSMILe_enddef_comp_grid