mkflag_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 mkflag_snow(TPSNOW)
!          ###################
!
!!****  *MKFLAG_SNOW* - puts undefined value on some snow quantities
!!                      where snow is not present
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!     A. Bogatchev 09/2005 EBA snow option
!!     B. Decharme  01/2009 Limit snow mass if Density=undef
!!     P. Samuelsson 10/2014 Additional snow albedos
!!------------------------------------------------------------------
!
USE modd_type_snow
USE modd_surf_par,   ONLY : xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
TYPE(surf_snow)  :: tpsnow ! snow state vector
!
INTEGER :: jlayer
INTEGER :: jpatch
REAL(KIND=JPRB) :: zhook_handle
!
!--------------------------------------------------
!
IF (lhook) CALL dr_hook('MKFLAG_SNOW',0,zhook_handle)
IF (tpsnow%SCHEME=='NON' .AND. lhook) CALL dr_hook('MKFLAG_SNOW',1,zhook_handle)
IF (tpsnow%SCHEME=='NON') RETURN
!
DO jpatch =1,SIZE(tpsnow%WSNOW,3)
!
 IF (tpsnow%SCHEME=='D95' .OR. tpsnow%SCHEME=='EBA' .OR. tpsnow%SCHEME=='1-L' .OR. tpsnow%SCHEME=='3-L' &
          .OR. tpsnow%SCHEME=='CRO') THEN  
  DO jlayer=1,tpsnow%NLAYER
    WHERE ( tpsnow%RHO(:,1,jpatch)== xundef .AND. tpsnow%WSNOW(:,jlayer,jpatch) > 0.0 .AND. tpsnow%WSNOW(:,1,jpatch)/= xundef )
      tpsnow%WSNOW(:,jlayer,jpatch) = 0.0
    END WHERE
  END DO
 END IF
! 
 IF (tpsnow%SCHEME=='1-L') THEN
  DO jlayer=1,tpsnow%NLAYER
    WHERE ( tpsnow%WSNOW(:,1,jpatch)==0. .OR. tpsnow%WSNOW(:,1,jpatch)== xundef )
      tpsnow%T(:,jlayer,jpatch) = xundef
    END WHERE
   END DO
 END IF
!
 IF (tpsnow%SCHEME=='D95' .OR. tpsnow%SCHEME=='EBA' .OR. tpsnow%SCHEME=='1-L' .OR. tpsnow%SCHEME=='3-L' &
           .OR. tpsnow%SCHEME=='CRO') THEN  
  DO jlayer=1,tpsnow%NLAYER
    WHERE ( tpsnow%WSNOW(:,1,jpatch)==0. .OR. tpsnow%WSNOW(:,1,jpatch)== xundef )
      tpsnow%RHO(:,jlayer,jpatch) = xundef
    END WHERE
  END DO
 END IF
!
 IF (tpsnow%SCHEME=='3-L' .OR. tpsnow%SCHEME=='CRO') THEN
  DO jlayer=1,tpsnow%NLAYER
    WHERE ( tpsnow%WSNOW(:,1,jpatch)==0. .OR. tpsnow%WSNOW(:,1,jpatch)== xundef )
      tpsnow%HEAT(:,jlayer,jpatch) = xundef
      tpsnow%AGE (:,jlayer,jpatch) = xundef
     END WHERE
   END DO
 END IF
!
IF (tpsnow%SCHEME=='CRO') THEN
  DO jlayer=1,tpsnow%NLAYER
    WHERE ( tpsnow%WSNOW(:,1,jpatch)==0. .OR. tpsnow%WSNOW(:,1,jpatch)== xundef )
      tpsnow%GRAN1(:,jlayer,jpatch) = xundef
      tpsnow%GRAN2(:,jlayer,jpatch) = xundef
      tpsnow%HIST(:,jlayer,jpatch) = xundef
     END WHERE
   END DO
 END IF
!
 IF (tpsnow%SCHEME=='D95' .OR. tpsnow%SCHEME=='EBA' .OR. tpsnow%SCHEME=='1-L' .OR. tpsnow%SCHEME=='3-L' &
          .OR. tpsnow%SCHEME=='CRO') THEN  
   WHERE ( tpsnow%WSNOW(:,1,jpatch)==0. .OR. tpsnow%WSNOW(:,1,jpatch)== xundef )
    tpsnow%ALB(:,jpatch) = xundef
    tpsnow%ALBVIS(:,jpatch) = xundef
    tpsnow%ALBNIR(:,jpatch) = xundef
    tpsnow%ALBFIR(:,jpatch) = xundef
   END WHERE
 END IF
!
 IF (tpsnow%SCHEME=='1-L') THEN
   WHERE ( tpsnow%WSNOW(:,1,jpatch)==0. .OR. tpsnow%WSNOW(:,1,jpatch)== xundef )
    tpsnow%EMIS(:,jpatch) = xundef
   END WHERE
 END IF
!
 IF (tpsnow%SCHEME=='1-L') THEN
   WHERE ( tpsnow%WSNOW(:,1,jpatch)==0. .OR. tpsnow%WSNOW(:,1,jpatch)== xundef )
    tpsnow%TS(:,jpatch) = xundef
   END WHERE
 END IF

END DO
IF (lhook) CALL dr_hook('MKFLAG_SNOW',1,zhook_handle)
!
!--------------------------------------------------
!
END SUBROUTINE mkflag_snow