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

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

  IF(heating_type == 'body') RETURN

  IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"Start: fct_s"

  nodes: DO i=1,m

     ! SKIP OPEN BOUNDARY NODES
     IF(iobcn > 0)THEN
        DO j=1,iobcn
           IF(i == i_obc_n(j)) cycle nodes
        END DO
     END IF

     ! SKIP RIVER INFLOW POINTS
     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

     ! SKIP GROUND WATER INFLOW POINTS
     IF(bfwdis(i) .GT. 0.0_sp .and. groundwater_salt_on) cycle nodes

     k1 = 1
     IF(precipitation_on) k1 = 2
!     DO K=1,KBM1
     DO k=k1,kbm1
        smax = maxval(s1(nbsn(i,1:ntsn(i)),k))
        smin = minval(s1(nbsn(i,1:ntsn(i)),k))

        IF(k == 1)THEN
           smax = max(smax,(s1(i,k)*dz(i,k+1)+s1(i,k+1)*dz(i,k))/  &
                (dz(i,k)+dz(i,k+1)))
           smin = min(smin,(s1(i,k)*dz(i,k+1)+s1(i,k+1)*dz(i,k))/  &
                (dz(i,k)+dz(i,k+1)))
        ELSE IF(k == kbm1)THEN
           smax = max(smax,(s1(i,k)*dz(i,k-1)+s1(i,k-1)*dz(i,k))/  &
                (dz(i,k)+dz(i,k-1)))
           smin = min(smin,(s1(i,k)*dz(i,k-1)+s1(i,k-1)*dz(i,k))/  &
                (dz(i,k)+dz(i,k-1)))
        ELSE
           smax = max(smax,(s1(i,k)*dz(i,k-1)+s1(i,k-1)*dz(i,k))/  &
                (dz(i,k)+dz(i,k-1)),                             &
                (s1(i,k)*dz(i,k+1)+s1(i,k+1)*dz(i,k))/           &
                (dz(i,k)+dz(i,k+1)))
           smin = min(smin,(s1(i,k)*dz(i,k-1)+s1(i,k-1)*dz(i,k))/  &
                (dz(i,k)+dz(i,k-1)),                             &
                (s1(i,k)*dz(i,k+1)+s1(i,k+1)*dz(i,k))/           &
                (dz(i,k)+dz(i,k+1)))
        END IF

        IF(smin-sf1(i,k) > 0.0_sp)sf1(i,k) = smin
        IF(sf1(i,k)-smax > 0.0_sp)sf1(i,k) = smax

     END DO
  END DO nodes

  WHERE(sf1 < 0.0_sp)sf1=0.0_sp
  
  IF(dbg_set(dbg_sbr)) WRITE(ipt,*)"End: fct_s"
  !#  endif
END SUBROUTINE fct_s
!==============================================================================|