diag_misc_flaken.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 diag_misc_flake_n (DMF, F)
!     ###############################################################################
!
!!****  *DIAG_MISC-FLAKE_n * - additional diagnostics for FLake
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     P. Le Moigne 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/2005
!!------------------------------------------------------------------
!
!
USE modd_flake_n, ONLY : flake_t
USE modd_diag_misc_flake_n, ONLY : diag_misc_flake_t
!
USE modd_surf_par,           ONLY : xundef
!
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
!
TYPE(flake_t), INTENT(INOUT) :: F
TYPE(diag_misc_flake_t), INTENT(INOUT) :: DMF
!
!*      0.2    declarations of local variables
!
REAL, DIMENSION(SIZE(DMF%XZW_PROFILE),SIZE(F%XT_WML)) :: ZCSI      ! Vertical normalized coordinate
REAL, DIMENSION(SIZE(DMF%XZW_PROFILE),SIZE(F%XT_WML)) :: ZSHAPE    ! Shape function
!
INTEGER         :: IZW
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('DIAG_MISC_FLAKE_N',0,zhook_handle)
!
!* Flake temperature profile
!
dmf%XTW_PROFILE(:,:) = xundef
!
IF (dmf%LWATER_PROFILE) THEN
!
   DO izw=1,SIZE(dmf%XZW_PROFILE)
      WHERE (f%XWATER_DEPTH(:)==f%XH_ML(:))
         zcsi(izw,:) = 0.
      ELSEWHERE
         zcsi(izw,:) = (dmf%XZW_PROFILE(izw) - f%XH_ML(:))/(f%XWATER_DEPTH(:) - f%XH_ML(:))
      END WHERE
      zshape(izw,:) = (40./3.*f%XCT-20./3.)*zcsi(izw,:)   +     (18.-30.*f%XCT)*zcsi(izw,:)**2 &
                       + (20.*f%XCT-12.)   *zcsi(izw,:)**3+(5./3.-10./3.*f%XCT)*zcsi(izw,:)**4  
   END DO
!
   DO izw=1,SIZE(dmf%XZW_PROFILE)
      WHERE (f%XH_ML(:) >= dmf%XZW_PROFILE(izw))
         dmf%XTW_PROFILE(izw,:) =  f%XT_WML(:) 
      ELSEWHERE (f%XWATER_DEPTH(:) >= dmf%XZW_PROFILE(izw)) 
         dmf%XTW_PROFILE(izw,:) = f%XT_WML(:) - (f%XT_WML(:) - f%XT_BOT(:)) * zshape(izw,:)
      END WHERE
   END DO
!
END IF
!
IF (lhook) CALL dr_hook('DIAG_MISC_FLAKE_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE diag_misc_flake_n