fct_q2l.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_q2l
!#  if defined (1)

!==============================================================================|
   USE all_vars
   USE bcs
   USE mod_utils
   USE mod_obcs
   IMPLICIT NONE
   REAL(SP):: Q2LMAX,Q2LMIN
   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
       q2lmax = maxval(q2l(nbsn(i,1:ntsn(i)),k))
       q2lmin = minval(q2l(nbsn(i,1:ntsn(i)),k))

       IF(k == 2)THEN
         q2lmax = max(q2lmax,(q2l(i,k)*dzz(i,k)+q2l(i,k+1)*dzz(i,k-1))/  &
                  (dzz(i,k)+dzz(i,k-1)))
         q2lmin = min(q2lmin,(q2l(i,k)*dzz(i,k)+q2l(i,k+1)*dzz(i,k-1))/  &
                  (dzz(i,k)+dzz(i,k-1)))
       ELSE IF(k == kbm1)THEN
         q2lmax = max(q2lmax,(q2l(i,k)*dzz(i,k-2)+q2l(i,k-1)*dzz(i,k-1))/  &
                  (dzz(i,k-1)+dzz(i,k-2)))
         q2lmin = min(q2lmin,(q2l(i,k)*dzz(i,k-2)+q2l(i,k-1)*dzz(i,k-1))/  &
                  (dzz(i,k-1)+dzz(i,k-2)))
       ELSE
         q2lmax = max(q2lmax,(q2l(i,k)*dzz(i,k-2)+q2l(i,k-1)*dzz(i,k-1))/  &         
                  (dzz(i,k-1)+dzz(i,k-2)),                                 &
                  (q2l(i,k)*dzz(i,k)+q2l(i,k+1)*dzz(i,k-1))/               &
                  (dzz(i,k)+dzz(i,k-1)))
         q2lmin = min(q2lmin,(q2l(i,k)*dzz(i,k-2)+q2l(i,k-1)*dzz(i,k-1))/  &
                  (dzz(i,k-1)+dzz(i,k-2)),                                 &
                  (q2l(i,k)*dzz(i,k)+q2l(i,k+1)*dzz(i,k-1))/               &
                  (dzz(i,k)+dzz(i,k-1)))
       END IF

       IF(q2lmin-q2lf(i,k) > 0.0_sp)q2lf(i,k) = q2lmin
       IF(q2lf(i,k)-q2lmax > 0.0_sp)q2lf(i,k) = q2lmax

     END DO

   END DO nodes

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

   END SUBROUTINE fct_q2l
!==============================================================================|