Changeset 5144 for LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_wk.F90
- Timestamp:
- Jul 29, 2024, 11:01:04 PM (3 months ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
LMDZ6/branches/Amaury_dev/libf/phylmd/alpale_wk.F90
r5112 r5144 1 SUBROUTINE alpale_wk( dtime, cell_area, zoccur, sigmaw, wdens, fip ,&2 1 SUBROUTINE alpale_wk(dtime, cell_area, zoccur, sigmaw, wdens, fip, & 2 fip_cond) 3 3 4 ! **************************************************************5 ! *6 ! ALPALE_WK *7 ! *8 ! *9 ! written by : Jean-Yves Grandpeix, 07/08/2017 *10 ! modified by : *11 ! **************************************************************4 ! ************************************************************** 5 ! * 6 ! ALPALE_WK * 7 ! * 8 ! * 9 ! written by : Jean-Yves Grandpeix, 07/08/2017 * 10 ! modified by : * 11 ! ************************************************************** 12 12 13 13 USE dimphy, ONLY: klon 14 14 USE lmdz_ioipsl_getin_p, ONLY: getin_p 15 USE lmdz_print_control, ONLY: mydebug=>debug , lunout, prt_level 15 USE lmdz_print_control, ONLY: mydebug => debug, lunout, prt_level 16 USE lmdz_yomcst, ONLY: rpi 16 17 17 18 IMPLICIT NONE 18 19 19 !================================================================20 ! Auteur(s) : Jean-Yves Grandpeix, 07/08/201721 ! Objet : Contribution of the wake scheme to Ale and Alp22 !================================================================20 !================================================================ 21 ! Auteur(s) : Jean-Yves Grandpeix, 07/08/2017 22 ! Objet : Contribution of the wake scheme to Ale and Alp 23 !================================================================ 23 24 24 ! Input arguments25 !----------------26 REAL, INTENT(IN) 27 REAL, DIMENSION(klon), INTENT(IN):: cell_area28 INTEGER, DIMENSION(klon), INTENT (IN) 29 REAL, DIMENSION(klon), INTENT(IN):: sigmaw30 REAL, DIMENSION(klon), INTENT(IN):: wdens31 REAL, DIMENSION(klon), INTENT(IN):: fip32 ! Output arguments33 !-----------------34 REAL, DIMENSION(klon), INTENT(OUT) 25 ! Input arguments 26 !---------------- 27 REAL, INTENT(IN) :: dtime 28 REAL, DIMENSION(klon), INTENT(IN) :: cell_area 29 INTEGER, DIMENSION(klon), INTENT (IN) :: zoccur 30 REAL, DIMENSION(klon), INTENT(IN) :: sigmaw 31 REAL, DIMENSION(klon), INTENT(IN) :: wdens 32 REAL, DIMENSION(klon), INTENT(IN) :: fip 33 ! Output arguments 34 !----------------- 35 REAL, DIMENSION(klon), INTENT(OUT) :: fip_cond 35 36 36 37 37 ! Local variables38 !----------------39 INTEGER 40 LOGICAL, SAVE 38 ! Local variables 39 !---------------- 40 INTEGER :: i 41 LOGICAL, SAVE :: first = .TRUE. 41 42 !$OMP THREADPRIVATE(first) 42 REAL, ALLOCATABLE, SAVE, DIMENSION(:) 43 REAL, ALLOCATABLE, SAVE, DIMENSION(:) :: cellrad 43 44 !$OMP THREADPRIVATE(cellrad) 44 REAL, DIMENSION(klon) 45 REAL, DIMENSION(klon) 45 REAL, DIMENSION(klon) :: wkrad 46 REAL, DIMENSION(klon) :: proba_gf 46 47 47 INCLUDE "YOMCST.h" ! rpi 48 IF (first) THEN 49 ALLOCATE (cellrad(klon)) 50 ! Compute pseudo grid-cell radius cellrad, such that pi*cellrad^2=cell_area 51 print *, 'alpale_wk: cell_area(1) ', cell_area(1) 52 cellrad(:) = sqrt(cell_area(:) / rpi) 53 first = .FALSE. 54 ENDIF 48 55 49 IF (first) THEN 50 ALLOCATE (cellrad(klon)) 51 ! Compute pseudo grid-cell radius cellrad, such that pi*cellrad^2=cell_area 52 print *,'alpale_wk: cell_area(1) ',cell_area(1) 53 cellrad(:)=sqrt(cell_area(:)/rpi) 54 first = .FALSE. 55 ENDIF 56 57 ! Compute wake radius 58 !! print *,'alpale_wk: sigmaw(1), wdens(1) ', sigmaw(1), wdens(1) 59 DO i = 1,klon 56 ! Compute wake radius 57 !! print *,'alpale_wk: sigmaw(1), wdens(1) ', sigmaw(1), wdens(1) 58 DO i = 1, klon 60 59 IF (zoccur(i) >= 1) THEN 61 wkrad(i) = sqrt(sigmaw(i) /(rpi*wdens(i)))60 wkrad(i) = sqrt(sigmaw(i) / (rpi * wdens(i))) 62 61 ELSE 63 62 wkrad(i) = 0. … … 65 64 ENDDO 66 65 67 ! Compute probability that the grid-cell is intersected by a gust front68 !! print *,'alpale_wk: wkrad(1), cellrad(1) ', wkrad(1), cellrad(1)69 !! proba_gf(:) = exp(-wdens(:)*rpi*max(wkrad(:)-cellrad(:),0.)**2) - & ! Formules70 !! exp(-wdens(:)*rpi*(wkrad(:)+cellrad(:))**2) ! fausses !71 proba_gf(:) = 1. - exp(-wdens(:) *rpi*((wkrad(:)+cellrad(:))**2 - &72 max(wkrad(:)-cellrad(:),0.)**2))66 ! Compute probability that the grid-cell is intersected by a gust front 67 !! print *,'alpale_wk: wkrad(1), cellrad(1) ', wkrad(1), cellrad(1) 68 !! proba_gf(:) = exp(-wdens(:)*rpi*max(wkrad(:)-cellrad(:),0.)**2) - & ! Formules 69 !! exp(-wdens(:)*rpi*(wkrad(:)+cellrad(:))**2) ! fausses ! 70 proba_gf(:) = 1. - exp(-wdens(:) * rpi * ((wkrad(:) + cellrad(:))**2 - & 71 max(wkrad(:) - cellrad(:), 0.)**2)) 73 72 74 proba_gf(:) = max(proba_gf(:), 1.e-3)75 ! Compute Fip conditionned on the presence of some gust front within the 76 ! grid-cell77 !! print *,'alpale_wk: proba_gf(1), fip(1), ', proba_gf(1), fip(1)78 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)73 proba_gf(:) = max(proba_gf(:), 1.e-3) 74 ! Compute Fip conditionned on the presence of some gust front within the 75 ! grid-cell 76 !! print *,'alpale_wk: proba_gf(1), fip(1), ', proba_gf(1), fip(1) 77 fip_cond(:) = fip(:) / proba_gf(:) 78 !! print *,'alpale_wk: wkrad(1), cellrad(1), proba_gf(1), fip(1), fip_cond(1) ', & 79 !! wkrad(1), cellrad(1), proba_gf(1), fip(1), fip_cond(1) 81 80 81 END SUBROUTINE alpale_wk 82 82 83 END SUBROUTINE alpale_wk84
Note: See TracChangeset
for help on using the changeset viewer.
