depth_check.f90

Go to the documentation of this file.

!/===========================================================================/
! Copyright (c) 2007, The University of Massachusetts Dartmouth 
! Produced at the School of Marine Science & Technology 
! Marine Ecosystem Dynamics Modeling group
! All rights reserved.
!
! FVCOM has been developed by the joint UMASSD-WHOI research team. For 
! details of authorship and attribution of credit please see the FVCOM
! technical manual or contact the MEDM group.
!
! 
! This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu 
! The full copyright notice is contained in the file COPYRIGHT located in the 
! root directory of the FVCOM code. This original header must be maintained
! in all distributed versions.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
! AND ANY EXPRESS OR  IMPLIED WARRANTIES, INCLUDING,  BUT NOT  LIMITED TO,
! THE IMPLIED WARRANTIES OF MERCHANTABILITY AND  FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED.  
!
!/---------------------------------------------------------------------------/
! CVS VERSION INFORMATION
! $Id$
! $Name$
! $Revision$
!/===========================================================================/

!==============================================================================|
!     ENSURE DEPTH IS GREATER THAN MIN_DEPTH                                   |
!     IF THIS CONDITION IS VIOLATED, HALT THE PROGRAM AND WRITE A WARNING      |
!     MESSAGE TO THE SCREEN                                                    |
!==============================================================================|

SUBROUTINE depth_check

  !==============================================================================|
  USE all_vars
  USE mod_utils
  USE mod_par  
  IMPLICIT NONE
  INTEGER, DIMENSION(NPROCS) :: SBUF,RBUF
  INTEGER  :: I,II,MLOC,IERR, RECV
  REAL(SP) :: DMIN
  !==============================================================================|

   IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "Start: depth_check"
!--Calculate Minimum Depth and Set Global Node Number if Min Depth < MIN_DEPTH
   sbuf = 0
   mloc = 0
   ierr = 0
   dmin = minval(d(1:m))
   ! NGID NOW EXISTS FOR BOTH SERIAL AND PARALLEL
   IF(dmin < min_depth) mloc = ngid(minloc(d(1:m),dim=1))

!--Reduce in Master Processor Array and Dump To Screen
   sbuf(myid) = mloc
   rbuf = sbuf


!--If Depth Condition is Violated Write Warning and Halt User
   IF(msr)THEN
     IF(sum(rbuf) /= 0) THEN
        DO i=1,nprocs
           ii = rbuf(i)
           IF(ii /= 0)THEN
              !         WRITE(*,*)'DEPTH IN NODE: ',II,' AT ',XG(II)+VXMIN,YG(II)+VYMIN, &
              !                        ' IS LESS THAN MIN_DEPTH'
              
              WRITE(*,*)'DEPTH IN NODE: ',ii,'; IS LESS THAN MIN_DEPTH'
              WRITE(*,*)'ADJUST BATHYMETRY AT THIS (THESE) LOCATION(S) OR'
              WRITE(*,*)'RECOMPILE FVCOM WITH FLOODING/DRYING FORMULATION'                 
              WRITE(*,*)'STOPPING....'
              CALL pstop
           END IF
        END DO
     END IF
  END IF

   IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "End: depth_check"

   END SUBROUTINE depth_check
!==============================================================================|