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 (DGMF, &
                                     pt_wml,pt_bot,ph_ml,pct,pwater_depth)
!     ###############################################################################
!
!!****  *DIAG_MISC-FLAKE_n * - additional diagnostics for FLake
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     P. Le Moigne 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    10/2005
!!------------------------------------------------------------------
!
!
!
!
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(diag_misc_flake_t), INTENT(INOUT) :: dgmf
!
       REAL, DIMENSION(:), INTENT(IN) :: pt_wml       ! Mixed-layer temperature [K]
       REAL, DIMENSION(:), INTENT(IN) :: pt_bot       ! Temperature at the water-bottom sediment 
       REAL, DIMENSION(:), INTENT(IN) :: ph_ml        ! Thickness of the mixed-layer [m]
       REAL, DIMENSION(:), INTENT(IN) :: pct          ! Shape factor (thermocline)
       REAL, DIMENSION(:), INTENT(IN) :: pwater_depth ! Lake depth 
!
!*      0.2    declarations of local variables
!
       REAL, DIMENSION(SIZE(DGMF%XZW_PROFILE),SIZE(PT_WML)) :: zcsi      ! Vertical normalized coordinate
       REAL, DIMENSION(SIZE(DGMF%XZW_PROFILE),SIZE(PT_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
!
dgmf%XTW_PROFILE(:,:) = xundef
!
IF (dgmf%LWATER_PROFILE) THEN
!
   DO izw=1,SIZE(dgmf%XZW_PROFILE)
      WHERE (pwater_depth(:)==ph_ml(:))
         zcsi(izw,:) = 0.
      ELSEWHERE
         zcsi(izw,:) = (dgmf%XZW_PROFILE(izw) - ph_ml(:))/(pwater_depth(:) - ph_ml(:))
      END WHERE
      zshape(izw,:) = (40./3.*pct-20./3.)*zcsi(izw,:)+(18.-30.*pct)*zcsi(izw,:)**2 &
                    + (20.*pct-12.)*zcsi(izw,:)**3+(5./3.-10./3.*pct)*zcsi(izw,:)**4  
   END DO
!
   DO izw=1,SIZE(dgmf%XZW_PROFILE)
      WHERE (ph_ml(:) >= dgmf%XZW_PROFILE(izw))
         dgmf%XTW_PROFILE(izw,:) =  pt_wml(:) 
      ELSEWHERE (pwater_depth(:) >= dgmf%XZW_PROFILE(izw)) 
         dgmf%XTW_PROFILE(izw,:) = pt_wml(:) - (pt_wml(:) - pt_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