utcic_stress.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 utcic_stress(PTSTEP, PUTCI, PUTCIC )
!   ##########################################################################
!
!!****  *UTCIC_STRESS*  
!!
!!    PURPOSE
!!    -------
!
! Integrates the UTCI index according to several heat stress ranges
!         
!     
!!**  METHOD
!     ------
!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!   www.utci.org
!!      
!!    AUTHOR
!!    ------
!!
!!      V. Masson           * Meteo-France *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original  10/2013
!-------------------------------------------------------------------------------
!
!*       0.     DECLARATIONS
!               ------------
!
USE modd_utci
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
REAL,                 INTENT(IN)     :: PTSTEP ! time-step (s)
REAL, DIMENSION(:),   INTENT(IN)     :: PUTCI  ! UTCI  (C)
REAL, DIMENSION(:,:), INTENT(INOUT)  :: PUTCIC ! Time cumulated in each sheat-stress range (s)
!
!*      0.2    declarations of local variables
!
INTEGER :: JSTRESS ! Loop counter on stress ranges
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('UTCIC_STRESS',0,zhook_handle)
!
DO jstress=1,nutci_stress
!* loop on each stress range
  !* integrates time when in the heat/cold stress range
  WHERE (putci(:)>xutci_stress_limits(jstress-1) .AND. putci(:)<=xutci_stress_limits(jstress))
    putcic(:,jstress) = putcic(:,jstress) + ptstep
  END WHERE
END DO
!
IF (lhook) CALL dr_hook('UTCIC_STRESS',1,zhook_handle)
!-------------------------------------------------------------------------------------
!
END SUBROUTINE utcic_stress