GCC Code Coverage Report
Directory: ./ Exec Total Coverage
File: phylmd/alpale_wk.F90 Lines: 16 16 100.0 %
Date: 2023-06-30 12:56:34 Branches: 17 20 85.0 %

Line Branch Exec Source
1
44738
SUBROUTINE alpale_wk ( dtime, cell_area, zoccur, sigmaw, wdens, fip ,  &
2
                       fip_cond)
3
4
! **************************************************************
5
!                                                              *
6
! ALPALE_WK                                                    *
7
!                                                              *
8
!                                                              *
9
! written by   : Jean-Yves Grandpeix, 07/08/2017               *
10
! modified by :                                                *
11
! **************************************************************
12
13
  USE dimphy, ONLY: klon
14
  USE ioipsl_getin_p_mod, ONLY : getin_p
15
  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
16
!
17
  IMPLICIT NONE
18
19
!================================================================
20
! Auteur(s)   : Jean-Yves Grandpeix, 07/08/2017
21
! Objet : Contribution of the wake scheme to Ale and Alp
22
!================================================================
23
24
! Input arguments
25
!----------------
26
  REAL, INTENT(IN)                                           :: dtime
27
  REAL, DIMENSION(klon),    INTENT(IN)                       :: cell_area
28
  INTEGER, DIMENSION(klon), INTENT (IN)                      :: zoccur
29
  REAL, DIMENSION(klon),    INTENT(IN)                       :: sigmaw
30
  REAL, DIMENSION(klon),    INTENT(IN)                       :: wdens
31
  REAL, DIMENSION(klon),    INTENT(IN)                       :: fip
32
! Output arguments
33
!-----------------
34
  REAL, DIMENSION(klon), INTENT(OUT)                         :: fip_cond
35
36
37
! Local variables
38
!----------------
39
  INTEGER                                                    :: i
40
  LOGICAL, SAVE                                              :: first = .TRUE.
41
  !$OMP THREADPRIVATE(first)
42
  REAL, ALLOCATABLE, SAVE, DIMENSION(:)                      :: cellrad
43
  !$OMP THREADPRIVATE(cellrad)
44
576
  REAL, DIMENSION(klon)                                      :: wkrad
45
576
  REAL, DIMENSION(klon)                                      :: proba_gf
46
47
  INCLUDE "YOMCST.h"   ! rpi
48
49
288
IF (first) THEN
50

1
  ALLOCATE (cellrad(klon))
51
!  Compute pseudo grid-cell radius cellrad, such that pi*cellrad^2=cell_area
52
1
  print *,'alpale_wk: cell_area(1) ',cell_area(1)
53
995
  cellrad(:)=sqrt(cell_area(:)/rpi)
54
1
  first = .FALSE.
55
ENDIF
56
57
!  Compute wake radius
58
!!  print *,'alpale_wk: sigmaw(1), wdens(1) ', sigmaw(1), wdens(1)
59
286560
  DO i = 1,klon
60
286560
    IF (zoccur(i) .GE. 1) THEN
61
44450
      wkrad(i) = sqrt(sigmaw(i)/(rpi*wdens(i)))
62
    ELSE
63
241822
      wkrad(i) = 0.
64
    ENDIF ! (zoccur(i) .GE. 1)
65
  ENDDO
66
67
!  Compute probability that the grid-cell is intersected by a gust front
68
!!  print *,'alpale_wk: wkrad(1), cellrad(1) ', wkrad(1), cellrad(1)
69
!!  proba_gf(:) = exp(-wdens(:)*rpi*max(wkrad(:)-cellrad(:),0.)**2) - &   ! Formules
70
!!                exp(-wdens(:)*rpi*(wkrad(:)+cellrad(:))**2)             ! fausses !
71
  proba_gf(:) = 1. - exp(-wdens(:)*rpi*((wkrad(:)+cellrad(:))**2 - &
72
286560
                                        max(wkrad(:)-cellrad(:),0.)**2) )
73
!
74
286560
  proba_gf(:) = max(proba_gf(:),1.e-3)
75
!  Compute Fip conditionned on the presence of some gust front within the
76
!  grid-cell
77
!!  print *,'alpale_wk: proba_gf(1), fip(1), ', proba_gf(1), fip(1)
78
286560
  fip_cond(:) = fip(:)/proba_gf(:)
79
!!    print *,'alpale_wk: wkrad(1), cellrad(1), proba_gf(1), fip(1), fip_cond(1) ', &
80
!!                        wkrad(1), cellrad(1), proba_gf(1), fip(1), fip_cond(1)
81
82
288
   RETURN
83
   END SUBROUTINE alpale_wk
84