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

SUBROUTINE icing(NOW)
  USE mod_utils
  USE mod_force
  USE all_vars
  USE mod_time
  IMPLICIT NONE
  TYPE(time), INTENT(IN) :: now
  REAL(sp), PARAMETER :: Tfreeze = -1.75_sp 
  REAL(SP), DIMENSION(0:MT) :: ICING_WNDSPD

  IF(dbg_set(dbg_log)) write(ipt,*) "Start Icing Update"

  ! GET THE FORCING DATA
  CALL update_icing(now,icing_satmp,icing_wndx,icing_wndy)
  
  icing_wndspd = sqrt(icing_wndy**2 + icing_wndx**2)
  icing_wndspd(0) = 0.0_sp
  

  IF(dbg_set(dbg_io))THEN
     WRITE(ipt,*) "min/max(SAT)",minval(icing_satmp(1:mt)),maxval(icing_satmp(1:mt))
     WRITE(ipt,*) "min/max(WNDSPD)",minval(icing_wndspd(1:mt)),maxval(icing_wndspd(1:mt))
     WRITE(ipt,*) "min/max(T1(:,1))",minval(t1(1:mt,1)),maxval(t1(1:mt,1))
  END IF
  
  icing_0kts = (tfreeze - icing_satmp) /&
       (1.0_sp + 0.4_sp *(t1(:,1) -tfreeze))
  
  WHERE (icing_0kts < 0.0_sp) icing_0kts = 0.0_sp

  icing_10kts = (icing_wndspd + 5.0_sp) * icing_0kts

  icing_0kts = icing_0kts * icing_wndspd
  

END SUBROUTINE icing