source: LMDZ6/trunk/libf/phylmd/alpale_wk.f90 @ 5833

Last change on this file since 5833 was 5833, checked in by rkazeroni, 2 months ago

For GPU porting of alpale_th and alpale_wk routines:

  • Put routine into module (speeds up source-to-source transformation)
  • Add "horizontal" comment to specify possible names of horizontal variables
  • Move declaration of variables with SAVE attributes from the compute routine to the module
  • Move one-time instructions (allocate, getin, print) to a dedicated routine_first
File size: 3.7 KB
Line 
1!$gpum horizontal klon
2MODULE alpale_wk_mod
3  PRIVATE
4
5  LOGICAL, SAVE                                              :: first = .TRUE.
6  !$OMP THREADPRIVATE(first)
7  REAL, ALLOCATABLE, SAVE, DIMENSION(:)                      :: cellrad
8  !$OMP THREADPRIVATE(cellrad)
9
10  PUBLIC alpale_wk, alpale_wk_first
11
12  CONTAINS
13
14SUBROUTINE alpale_wk_first(cell_area)
15
16  USE dimphy, ONLY: klon
17  USE yomcst_mod_h, ONLY: rpi
18
19  IMPLICIT NONE
20  REAL, DIMENSION(klon), INTENT(IN)     :: cell_area
21
22  IF (first) THEN
23    ALLOCATE (cellrad(klon))
24  !  Compute pseudo grid-cell radius cellrad, such that pi*cellrad^2=cell_area
25    print *,'alpale_wk: cell_area(1) ',cell_area(1)
26    cellrad(:)=sqrt(cell_area(:)/rpi)
27    first = .FALSE.
28  ENDIF
29
30END SUBROUTINE alpale_wk_first
31
32SUBROUTINE alpale_wk ( dtime, cell_area, zoccur, sigmaw, wdens, fip ,  &
33                       fip_cond)
34
35! **************************************************************
36!                                                              *
37! ALPALE_WK                                                    *
38!                                                              *
39!                                                              *
40! written by   : Jean-Yves Grandpeix, 07/08/2017               *
41! modified by :                                                *
42! **************************************************************
43
44  USE dimphy, ONLY: klon
45  USE ioipsl_getin_p_mod, ONLY : getin_p
46  USE print_control_mod, ONLY: mydebug=>debug , lunout, prt_level
47  USE yomcst_mod_h, ONLY: rpi
48
49  IMPLICIT NONE
50
51!================================================================
52! Auteur(s)   : Jean-Yves Grandpeix, 07/08/2017
53! Objet : Contribution of the wake scheme to Ale and Alp
54!================================================================
55
56! Input arguments
57!----------------
58  REAL, INTENT(IN)                                           :: dtime
59  REAL, DIMENSION(klon),    INTENT(IN)                       :: cell_area
60  INTEGER, DIMENSION(klon), INTENT (IN)                      :: zoccur
61  REAL, DIMENSION(klon),    INTENT(IN)                       :: sigmaw
62  REAL, DIMENSION(klon),    INTENT(IN)                       :: wdens
63  REAL, DIMENSION(klon),    INTENT(IN)                       :: fip
64! Output arguments
65!-----------------
66  REAL, DIMENSION(klon), INTENT(OUT)                         :: fip_cond
67
68
69! Local variables
70!----------------
71  INTEGER                                                    :: i
72  REAL, DIMENSION(klon)                                      :: wkrad
73  REAL, DIMENSION(klon)                                      :: proba_gf
74
75!  Compute wake radius
76!!  print *,'alpale_wk: sigmaw(1), wdens(1) ', sigmaw(1), wdens(1)
77  DO i = 1,klon
78    IF (zoccur(i) .GE. 1) THEN
79      wkrad(i) = sqrt(sigmaw(i)/(rpi*wdens(i)))
80    ELSE
81      wkrad(i) = 0.
82    ENDIF ! (zoccur(i) .GE. 1)
83  ENDDO
84
85!  Compute probability that the grid-cell is intersected by a gust front
86!!  print *,'alpale_wk: wkrad(1), cellrad(1) ', wkrad(1), cellrad(1)
87!!  proba_gf(:) = exp(-wdens(:)*rpi*max(wkrad(:)-cellrad(:),0.)**2) - &   ! Formules
88!!                exp(-wdens(:)*rpi*(wkrad(:)+cellrad(:))**2)             ! fausses !
89  proba_gf(:) = 1. - exp(-wdens(:)*rpi*((wkrad(:)+cellrad(:))**2 - &
90                                        max(wkrad(:)-cellrad(:),0.)**2) )
91!
92  proba_gf(:) = max(proba_gf(:),1.e-3)
93!  Compute Fip conditionned on the presence of some gust front within the
94!  grid-cell
95!!  print *,'alpale_wk: proba_gf(1), fip(1), ', proba_gf(1), fip(1)
96  fip_cond(:) = fip(:)/proba_gf(:)
97!!    print *,'alpale_wk: wkrad(1), cellrad(1), proba_gf(1), fip(1), fip_cond(1) ', &
98!!                        wkrad(1), cellrad(1), proba_gf(1), fip(1), fip_cond(1)
99
100   RETURN
101   END SUBROUTINE alpale_wk
102
103END MODULE alpale_wk_mod
Note: See TracBrowser for help on using the repository browser.