psmile_get_true_mask_entries.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_get_true_mask_entries
!
! !INTERFACE:

      subroutine psmile_get_true_mask_entries (mask_array, mask_shape, &
                                               inter, n_true, ierror)
!
! !USES:
!
      use PRISM_constants
!
      use PSMILe, dummy_interface => PSMILe_get_true_mask_entries

      implicit none
!
! !INPUT PARAMETERS:
!
      Integer, Intent (In)               :: mask_shape (2, ndim_3d)
!
!     Dimensions of mask array "mask_array"
!
      Logical, Intent (In)               :: mask_array (                     
                                            mask_shape(1,1):mask_shape(2,1), 
                                            mask_shape(1,2):mask_shape(2,2), 
                                            mask_shape(1,3):mask_shape(2,3))
!
!     Mask array to be controlled
!
      Integer, Intent (In)               :: inter (2, ndim_3d)

!     Sub-region to be controlled
!
! !OUTPUT PARAMETERS:
!
      Integer, Intent (Out)             :: n_true

!     Returns the number of mask entries which are true
!
      Integer, Intent (Out)             :: ierror

!     Returns the error code of PSMILe_get_true_mask_entries;
!             ierror = 0 : No error
!             ierror > 0 : Severe error
!
! !LOCAL VARIABLES
!
! !DESCRIPTION:
!
! Subroutine "PSMILe_get_true_mask_entries" returns the number of
! mask entries in "mask_array (inter (1,*):inter(2,*))" which have the
! logical value "true".
!
! !REVISION HISTORY:
!
!   Date      Programmer   Description
! ----------  ----------   -----------
! 08.02.05    H. Ritzdorf  created
!
!EOP
!----------------------------------------------------------------------
!
! $Id: psmile_get_true_mask_entries.F90 2325 2010-04-21 15:00:07Z valcke $
! $Author: valcke $
!
   Character(len=len_cvs_string), save :: mycvs = 
       '$Id: psmile_get_true_mask_entries.F90 2325 2010-04-21 15:00:07Z valcke $'
!
!----------------------------------------------------------------------
!
#ifdef VERBOSE
      print 9990, trim(ch_id)

      call psmile_flushstd
#endif /* VERBOSE */
!
!  Initialization
!
      ierror = 0
!
      n_true = count (mask_array(inter(1,1):inter(2,1), &
                                 inter(1,2):inter(2,2), &
                                 inter(2,3):inter(2,3)) )
!
#ifdef VERBOSE
      print 9980, trim(ch_id), ierror, n_true
      call psmile_flushstd
#endif /* VERBOSE */

!
!  Formats:
!

#ifdef VERBOSE

9990 format (1x, a, ': psmile_get_true_mask_entries:')
9980 format (1x, a, ': psmile_get_true_mask_entries: eof ierror =', i3, &
                    '; n_true =', i7)

#endif /* VERBOSE */ 

      end subroutine PSMILe_get_true_mask_entries