! Contains the alpale subroutine, as well as the old content from alpale.h !$gpum horizontal klon MODULE alpale_mod IMPLICIT NONE; PRIVATE PUBLIC alpale !===================================================================== ! Specifique de Ale/Alp : !===================================================================== PUBLIC iflag_trig_bl, iflag_clos_bl, tau_trig_shallow, tau_trig_deep, iflag_strig, & alp_bl_k, s_trig, h_trig, iflag_coupl, iflag_clos, iflag_wake ! dans alealp_th, thermcell_alp, physiq_mod, conf_phys INTEGER :: iflag_trig_bl, iflag_clos_bl, iflag_strig INTEGER :: tau_trig_shallow, tau_trig_deep REAL :: s_trig, h_trig ! thermcell_alp et convection ... INTEGER :: iflag_coupl, iflag_clos, iflag_wake ! thermcell_alp REAL :: alp_bl_k !$OMP THREADPRIVATE(iflag_trig_bl, iflag_clos_bl, tau_trig_shallow, tau_trig_deep, iflag_strig) !$OMP THREADPRIVATE(alp_bl_k, s_trig, h_trig, iflag_coupl, iflag_clos, iflag_wake) CONTAINS SUBROUTINE alpale(debut, itap, dtime, paprs, omega, t_seri, & alp_offset, it_wape_prescr, wape_prescr, fip_prescr, & ale_bl_prescr, alp_bl_prescr, & wake_pe, wake_fip, & Ale_bl, Ale_bl_trig, Alp_bl, & Ale, Alp, Ale_wake, Alp_wake) ! ************************************************************** ! * ! ALPALE * ! * ! * ! written by : Jean-Yves Grandpeix, 12/05/2016 * ! modified by : * ! ************************************************************** USE dimphy USE ioipsl_getin_p_mod, ONLY: getin_p USE print_control_mod, ONLY: mydebug => debug, lunout, prt_level USE phys_local_var_mod, ONLY: zw2 ! Variables internes non sauvegardees de la physique USE yoethf_mod_h USE yomcst_mod_h IMPLICIT NONE !================================================================ ! Auteur(s) : Jean-Yves Grandpeix, 12/05/2016 ! Objet : Sums up all contributions to Ale and Alp !================================================================ ! Input arguments !---------------- LOGICAL, INTENT(IN) :: debut INTEGER, INTENT(IN) :: itap REAL, INTENT(IN) :: dtime INTEGER, INTENT(IN) :: it_wape_prescr REAL, INTENT(IN) :: wape_prescr, fip_prescr REAL, INTENT(IN) :: Ale_bl_prescr, Alp_bl_prescr REAL, INTENT(IN) :: alp_offset REAL, DIMENSION(klon, klev + 1), INTENT(IN) :: paprs REAL, DIMENSION(klon, klev), INTENT(IN) :: t_seri REAL, DIMENSION(klon, klev), INTENT(IN) :: omega REAL, DIMENSION(klon), INTENT(IN) :: wake_pe, wake_fip REAL, DIMENSION(klon), INTENT(IN) :: Ale_bl, Ale_bl_trig, Alp_bl ! Output arguments !---------------- REAL, DIMENSION(klon), INTENT(OUT) :: Ale, Alp REAL, DIMENSION(klon), INTENT(OUT) :: Ale_wake, Alp_wake ! Local variables !---------------- INTEGER :: i, k REAL, DIMENSION(klon) :: www REAL, PARAMETER :: ale_max = 1000. REAL, PARAMETER :: alp_max = 2. CHARACTER (LEN=20), PARAMETER :: modname = 'alpale' CHARACTER (LEN=80) :: abort_message ! Calcul de l'energie disponible ALE (J/kg) et de la puissance ! disponible ALP (W/m2) pour le soulevement des particules dans ! le modele convectif DO i = 1, klon ALE(i) = 0. ALP(i) = 0. enddo !calcul de ale_wake et alp_wake IF (iflag_wake>=1) THEN IF (itap <= it_wape_prescr) THEN DO i = 1, klon ale_wake(i) = wape_prescr alp_wake(i) = fip_prescr enddo else DO i = 1, klon !jyg ALE=WAPE au lieu de ALE = 1/2 Cstar**2 !cc ale_wake(i) = 0.5*wake_cstar(i)**2 ale_wake(i) = wake_pe(i) alp_wake(i) = wake_fip(i) enddo endif else DO i = 1, klon ale_wake(i) = 0. alp_wake(i) = 0. enddo endif !combinaison avec ale et alp de couche limite: constantes si pas !de couplage, valeurs calculees dans le thermique sinon IF (iflag_coupl==0) THEN IF (debut.AND.prt_level>9) & WRITE(lunout, *)'ALE et ALP imposes' DO i = 1, klon !on ne couple que ale ! ALE(i) = max(ale_wake(i),Ale_bl(i)) ALE(i) = max(ale_wake(i), ale_bl_prescr) !on ne couple que alp ! ALP(i) = alp_wake(i) + Alp_bl(i) ALP(i) = alp_wake(i) + alp_bl_prescr enddo else IF(prt_level>9)WRITE(lunout, *)'ALE et ALP couples au thermique' ! do i = 1,klon ! ALE(i) = max(ale_wake(i),Ale_bl(i)) ! avant ALP(i) = alp_wake(i) + Alp_bl(i) ! ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb ! WRITE(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i) ! WRITE(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i) ! enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Modif FH 2010/04/27. Sans doute temporaire. ! Deux options pour le alp_offset : constant si >?? 0 ou ! proportionnel ??a w si <0 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Estimation d'une vitesse verticale effective pour ALP IF (1==0) THEN www(1:klon) = 0. DO k = 2, klev - 1 DO i = 1, klon www(i) = max(www(i), -omega(i, k) * RD * t_seri(i, k) & / (RG * paprs(i, k)) * zw2(i, k) * zw2(i, k)) ! if (paprs(i,k)>pbase(i)) THEN ! calcul approche de la vitesse verticale en m/s ! www(i)=max(www(i),-omega(i,k)*RD*temp(i,k)/(RG*paprs(i,k)) ! endif ! Le 0.1 est en gros H / ps = 1e4 / 1e5 enddo enddo DO i = 1, klon IF (www(i)>0. .AND. ale_bl(i)>0.) www(i) = www(i) / ale_bl(i) enddo ENDIF DO i = 1, klon ALE(i) = max(ale_wake(i), Ale_bl(i)) !cc nrlmd le 10/04/2012----------Stochastic triggering------------ IF (iflag_trig_bl>=1) THEN ALE(i) = max(ale_wake(i), Ale_bl_trig(i)) endif !cc fin nrlmd le 10/04/2012 IF (alp_offset>=0.) THEN ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb else abort_message = 'Ne pas passer la car www non calcule' CALL abort_physic (modname, abort_message, 1) ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! _ _ ! Ajout d'une composante 3 * A * w w'2 a w'3 avec ! w=www : w max sous pbase ou A est la fraction ! couverte par les ascendances w' on utilise le fait ! que A * w'3 = ALP et donc A * w'2 ~ ALP / sqrt(ALE) ! (on ajoute 0.1 pour les singularites) ALP(i) = alp_wake(i) * (1. + 3. * www(i) / (sqrt(ale_wake(i)) + 0.1)) & + alp_bl(i) * (1. + 3. * www(i) / (sqrt(ale_bl(i)) + 0.1)) ! ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.) ! if (alp(i)<0.) THEN ! PRINT*,'ALP ',alp(i),alp_wake(i) & ! ,Alp_bl(i),alp_offset*min(omega(i,6),0.) ! endif endif enddo ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! endif DO i = 1, klon IF (alp(i)>alp_max) THEN IF(prt_level>9)WRITE(lunout, *) & 'WARNING SUPER ALP (seuil=', alp_max, & '): i, alp, alp_wake,ale', i, alp(i), alp_wake(i), ale(i) alp(i) = alp_max endif IF (ale(i)>ale_max) THEN IF(prt_level>9)WRITE(lunout, *) & 'WARNING SUPER ALE (seuil=', ale_max, & '): i, alp, alp_wake,ale', i, ale(i), ale_wake(i), alp(i) ale(i) = ale_max endif enddo !fin calcul ale et alp !======================================================================= RETURN END SUBROUTINE alpale END MODULE alpale_mod