flag_gr_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 flag_gr_snow(KFLAG,OMASK,TPSNOW)  
!     ##########################################################
!
!!****  *FLAG_GR_SNOW* - routine to flag snow surface fields
!!
!!    PURPOSE
!!    -------
!       Initialize snow surface fields.
!
!!**  METHOD
!!    ------
!!    
!!    
!!
!!    EXTERNAL
!!    --------
!!      
!!       
!!    IMPLICIT ARGUMENTS
!!    ------------------ 
!!
!!    REFERENCE
!!    ---------
!!      
!!      
!!
!!    AUTHOR
!!    ------
!!      V. Masson       * Meteo France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original       10/2011
!!      P. Samuelsson  07/2014 Added snow albedos
!-----------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!
USE modd_type_snow
!
!
USE modd_surf_par, ONLY : xundef
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*       0.1   declarations of arguments
!
INTEGER, INTENT(IN) :: kflag ! 1 : to put physical values to run ISBA afterwards
!                            ! 2 : to flag with XUNDEF value for points wihtout
LOGICAL, DIMENSION(:), INTENT(IN) :: omask ! T: points where snow values 
!                                          !    must be flagged
TYPE(surf_snow), INTENT(INOUT) :: tpsnow   ! snow characteristics
!
!*       0.2   declarations of local variables
!
REAL            :: zval
INTEGER         :: jlayer, jpatch
REAL(KIND=JPRB) :: zhook_handle
!-------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('FLAG_GR_SNOW',0,zhook_handle)
!
IF (kflag==1) THEN
  zval = 0.
ELSEIF (kflag==2) THEN 
  zval = xundef
ENDIF
!
DO jpatch = 1,SIZE(tpsnow%WSNOW,3)
  !
  DO jlayer = 1,tpsnow%NLAYER
    !
    WHERE(omask(:)) tpsnow%WSNOW(:,jlayer,jpatch) = zval
    !
    IF (kflag==1) THEN 
      !
      WHERE(omask(:)) tpsnow%RHO  (:,jlayer,jpatch) = xundef
      !
      IF (SIZE(tpsnow%TEMP ) >0) THEN
        WHERE(omask(:)) 
          tpsnow%TEMP (:,jlayer,jpatch) = xundef
          tpsnow%HEAT (:,jlayer,jpatch) = xundef
        END WHERE
      ENDIF
      !
      IF (SIZE(tpsnow%T    ) >0) WHERE(omask(:)) tpsnow%T(:,jlayer,jpatch) = xundef
      !
      IF (SIZE(tpsnow%GRAN1) >0) THEN
        WHERE(omask(:)) 
          tpsnow%GRAN1(:,jlayer,jpatch) = xundef
          tpsnow%GRAN2(:,jlayer,jpatch) = xundef
          tpsnow%HIST (:,jlayer,jpatch) = xundef
          tpsnow%AGE  (:,jlayer,jpatch) = xundef
        END WHERE
      END IF
      !
    ENDIF
    !
  ENDDO
  !
  IF (kflag==1) THEN
    !
    WHERE(omask(:)) tpsnow%ALB    (:,jpatch) = xundef
    WHERE(omask(:)) tpsnow%ALBVIS (:,jpatch) = xundef
    WHERE(omask(:)) tpsnow%ALBNIR (:,jpatch) = xundef
    WHERE(omask(:)) tpsnow%ALBFIR (:,jpatch) = xundef
    !
    IF (SIZE(tpsnow%EMIS ) >0) THEN
      WHERE(omask(:))
        tpsnow%EMIS (:,jpatch) = xundef
        tpsnow%TS   (:,jpatch) = xundef
      END WHERE
    END IF
    !
  ENDIF
  !
END DO
!
IF (lhook) CALL dr_hook('FLAG_GR_SNOW',1,zhook_handle)
!
!-------------------------------------------------------------------------------
!
END SUBROUTINE flag_gr_snow