assim_isba_update_snow.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
SUBROUTINE assim_isba_update_snow (I, &
                                   hprogram, ki, pswe, pswe_orig, oinitsnow, oinc, htest )

! ------------------------------------------------------------------------------------------
!  *****************************************************************************************
!
!  Routine to update snow field for ISBA
!  Trygve Aspelien, Separating IO  06/2013
!
!
! ******************************************************************************************
! ------------------------------------------------------------------------------------------
!
USE modd_isba_n, ONLY : isba_t
!
USE modd_csts,        ONLY : xtt
USE modd_surf_par,    ONLY : xundef
USE modd_snow_par,    ONLY : xansmin, xansmax, xrhosmin, xrhosmax
!
!
USE modi_abor1_sfx
!
USE yomhook,          ONLY : lhook,dr_hook
USE parkind1,         ONLY : jprb
!
IMPLICIT NONE
!
TYPE(isba_t), INTENT(INOUT) :: i
!
 CHARACTER(LEN=6),    INTENT(IN)    :: hprogram  ! program calling surf. schemes
INTEGER,             INTENT(IN)    :: ki
REAL, DIMENSION(KI), INTENT(IN)    :: pswe
REAL, DIMENSION(KI), INTENT(INOUT) :: pswe_orig
LOGICAL,             INTENT(IN)    :: oinitsnow
LOGICAL,             INTENT(IN)    :: oinc
 CHARACTER(LEN=2),    INTENT(IN)    :: htest     ! must be equal to 'OK'
!
!    Declarations of local variables
!
REAL, DIMENSION(KI) :: zswe     ! Snow before update
REAL, DIMENSION(KI) :: zsweinc
REAL, DIMENSION(KI) :: zts
!    Addtional snow fields with D95 snow scheme 
REAL, DIMENSION(KI) :: zsnr     ! Snow density 
REAL, DIMENSION(KI) :: zsna     ! Snow albedo 
INTEGER  :: jl,jp
REAL(KIND=JPRB) :: zhook_handle
!
! ----------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('ASSIM_ISBA_UPDATE_SNOW',0,zhook_handle)
!
IF (htest/='OK') THEN
  CALL abor1_sfx('ASSIM_ISBA_n: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
IF ( i%TSNOW%SCHEME=='D95' ) THEN
  jl = 1
  jp = 1
  IF ( i%NPATCH > 1 ) CALL abor1_sfx("Update of snow is only implemented for D95 and one patch")
ELSE
  CALL abor1_sfx("Update of snow is only implemented for D95")
ENDIF
!
IF ( oinitsnow ) THEN
  !
  pswe_orig(:) = i%TSNOW%WSNOW(:,jl,jp)
  !
  zts(:) = i%XTG(:,1,jp)
  !
  zswe(:) = pswe(:)
  ! Set snow=0 where 1. guess = 0 and Ts>0, to avoid that the snow analysis introduce snow where it is no snow.
  WHERE ( pswe(:)/=xundef .AND. pswe(:)<1.0e-10 .AND. zts(:)>xtt )
    zswe(:)   = 0.0
  END WHERE
  !
  i%TSNOW%WSNOW(:,jl,jp) = zswe(:)
  !
ENDIF


! Update snow
IF ( oinc ) THEN

  zswe(:) = i%TSNOW%WSNOW(:,jl,jp)  
  zsna(:) = i%TSNOW%ALB  (:,jp)
  zsnr(:) = i%TSNOW%RHO  (:,jl,jp)

  ! If we only do second step, we must set working SWE as input SWE
  IF ( .NOT. oinitsnow ) zswe(:) = pswe(:)
 
  ! Calculate increments
  zsweinc(:) = zswe(:) - pswe_orig(:)
  WRITE(*,'("  SURFRESERV.NEIGE - min, mean, max: ",3E13.4)') minval(zswe),maxval(zswe),sum(zswe)/ki
  WRITE(*,*) 'Mean SN increments over NATURE ',sum(zsweinc)/ki

  ! Snow albedo and density are given initial values in points  
  ! which get initial snow in the snow analysis 
  WHERE ( pswe_orig(:) < 1.0e-10 .AND. zswe(:)>= 1.0e-10 ) 
    zsna(:)    = 0.5 * ( xansmin + xansmax ) 
    zsnr(:)    = 0.5 * ( xrhosmin + xrhosmax )
  END WHERE 
  !
  i%TSNOW%WSNOW(:,jl,jp) = zswe(:)
  i%TSNOW%ALB  (:,jp)    = zsna(:)
  i%TSNOW%RHO  (:,jl,jp) = zsnr(:)
  !
ENDIF
!
! -------------------------------------------------------------------------------------
 IF (lhook) CALL dr_hook('ASSIM_ISBA_UPDATE_SNOW',1,zhook_handle)
 END SUBROUTINE assim_isba_update_snow