fct_q2.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$
!/===========================================================================/

!==============================================================================|
!  FLUX CONTROL FOR SALINITY                                                        |
!==============================================================================|

   SUBROUTINE fct_q2
!#  if defined (1)

!==============================================================================|
   USE all_vars
   USE mod_utils
   USE bcs
   USE mod_obcs
   IMPLICIT NONE
   REAL(SP):: Q2MAX,Q2MIN
   INTEGER :: I,J,K
!==============================================================================|

   IF(heating_type == 'body') return
   
   IF(dbg_set(dbg_sbr)) write(ipt,*) "Start: fct_q2"


nodes:DO i=1,m

     IF(iobcn > 0)THEN
       DO j=1,iobcn
         IF(i == i_obc_n(j)) cycle nodes
       END DO
     END IF     
 
     IF(numqbc > 0)THEN
       DO j=1,numqbc
         IF(river_inflow_location == 'node')THEN
       IF(i == inodeq(j)) cycle nodes
     END IF  
         IF(river_inflow_location == 'edge')THEN
       IF(i == n_icellq(j,1) .OR. i == n_icellq(j,2)) cycle nodes
     END IF  
       END DO
     END IF
     DO k=2,kbm1
       q2max = maxval(q2(nbsn(i,1:ntsn(i)),k))
       q2min = minval(q2(nbsn(i,1:ntsn(i)),k))

       IF(k == 2)THEN
         q2max = max(q2max,(q2(i,k)*dzz(i,k)+q2(i,k+1)*dzz(i,k-1))/  &
                 (dzz(i,k)+dzz(i,k-1)))
         q2min = min(q2min,(q2(i,k)*dzz(i,k)+q2(i,k+1)*dzz(i,k-1))/  &
                 (dzz(i,k)+dzz(i,k-1)))
       ELSE IF(k == kbm1)THEN
         q2max = max(q2max,(q2(i,k)*dzz(i,k-2)+q2(i,k-1)*dzz(i,k-1))/  &
                 (dzz(i,k-1)+dzz(i,k-2)))
         q2min = min(q2min,(q2(i,k)*dzz(i,k-2)+q2(i,k-1)*dzz(i,k-1))/  &
                 (dzz(i,k-1)+dzz(i,k-2)))
       ELSE
         q2max = max(q2max,(q2(i,k)*dzz(i,k-2)+q2(i,k-1)*dzz(i,k-1))/  &
                 (dzz(i,k-1)+dzz(i,k-2)),                              &
                 (q2(i,k)*dzz(i,k)+q2(i,k+1)*dzz(i,k-1))/              &
                 (dzz(i,k)+dzz(i,k-1)))  
         q2min = min(q2min,(q2(i,k)*dzz(i,k-2)+q2(i,k-1)*dzz(i,k-1))/  &
                 (dzz(i,k-1)+dzz(i,k-2)),                              &
                 (q2(i,k)*dzz(i,k)+q2(i,k+1)*dzz(i,k-1))/              &
                 (dzz(i,k)+dzz(i,k-1)))
       END IF

       IF(q2min-q2f(i,k) > 0.0_sp)q2f(i,k) = q2min
       IF(q2f(i,k)-q2max > 0.0_sp)q2f(i,k) = q2max

     END DO

   END DO nodes

   IF(dbg_set(dbg_sbr)) write(ipt,*) "End: fct_q2"

   END SUBROUTINE fct_q2
!==============================================================================|