Changeset 2513


Ignore:
Timestamp:
May 12, 2016, 6:21:10 PM (9 years ago)
Author:
jyg
Message:

Creation of two new subroutines containing all
the Ale and Alp stuff previously present in
physiq_mod.F90: files alpale.F90 and
alpale_th.F90.

Location:
LMDZ5/trunk/libf/phylmd
Files:
2 added
1 edited

Legend:

Unmodified
Added
Removed

  • LMDZ5/trunk/libf/phylmd/physiq_mod.F90

    r2501 r2513  
    368368    real, save :: ale_bl_prescr=0.
    369369
    370     real, save :: ale_max=1000.
    371     real, save :: alp_max=2.
    372 
    373370    real, save :: wake_s_min_lsp=0.1
    374371
    375372    !$OMP THREADPRIVATE(alp_bl_prescr,ale_bl_prescr)
    376     !$OMP THREADPRIVATE(ale_max,alp_max)
    377373    !$OMP THREADPRIVATE(wake_s_min_lsp)
    378374
    … …  
    438434    LOGICAL,SAVE :: ok_adjwk=.FALSE.
    439435    !$OMP THREADPRIVATE(ok_adjwk)
    440     REAL, dimension(klon) :: www
    441436    REAL, SAVE :: alp_offset
    442437    !$OMP THREADPRIVATE(alp_offset)
    … …  
    22882283       !>jyg
    22892284       !
    2290 
    2291        ! Calcul de l'energie disponible ALE (J/kg) et de la puissance
    2292        ! disponible ALP (W/m2) pour le soulevement des particules dans
    2293        ! le modele convectif
    2294        !
    2295        do i = 1,klon
    2296           ALE(i) = 0.
    2297           ALP(i) = 0.
    2298        enddo
    2299        !
    2300        !calcul de ale_wake et alp_wake
    2301        if (iflag_wake>=1) then
    2302           if (itap .le. it_wape_prescr) then
    2303              do i = 1,klon
    2304                 ale_wake(i) = wape_prescr
    2305                 alp_wake(i) = fip_prescr
    2306              enddo
    2307           else
    2308              do i = 1,klon
    2309                 !jyg  ALE=WAPE au lieu de ALE = 1/2 Cstar**2
    2310                 !cc           ale_wake(i) = 0.5*wake_cstar(i)**2
    2311                 ale_wake(i) = wake_pe(i)
    2312                 alp_wake(i) = wake_fip(i)
    2313              enddo
    2314           endif
    2315        else
    2316           do i = 1,klon
    2317              ale_wake(i) = 0.
    2318              alp_wake(i) = 0.
    2319           enddo
    2320        endif
    2321        !combinaison avec ale et alp de couche limite: constantes si pas
    2322        !de couplage, valeurs calculees dans le thermique sinon
    2323        if (iflag_coupl.eq.0) then
    2324           if (debut.and.prt_level.gt.9) &
    2325                WRITE(lunout,*)'ALE et ALP imposes'
    2326           do i = 1,klon
    2327              !on ne couple que ale
    2328              !           ALE(i) = max(ale_wake(i),Ale_bl(i))
    2329              ALE(i) = max(ale_wake(i),ale_bl_prescr)
    2330              !on ne couple que alp
    2331              !           ALP(i) = alp_wake(i) + Alp_bl(i)
    2332              ALP(i) = alp_wake(i) + alp_bl_prescr
    2333           enddo
    2334        else
    2335           IF(prt_level>9)WRITE(lunout,*)'ALE et ALP couples au thermique'
    2336           !         do i = 1,klon
    2337           !             ALE(i) = max(ale_wake(i),Ale_bl(i))
    2338           ! avant        ALP(i) = alp_wake(i) + Alp_bl(i)
    2339           !             ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
    2340           !         write(20,*)'ALE',ALE(i),Ale_bl(i),ale_wake(i)
    2341           !         write(21,*)'ALP',ALP(i),Alp_bl(i),alp_wake(i)
    2342           !         enddo
    2343 
    2344           ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2345           ! Modif FH 2010/04/27. Sans doute temporaire.
    2346           ! Deux options pour le alp_offset : constant si >?? 0 ou
    2347           ! proportionnel ??a w si <0
    2348           ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2349           ! Estimation d'une vitesse verticale effective pour ALP
    2350           if (1==0) THEN
    2351              www(1:klon)=0.
    2352              do k=2,klev-1
    2353                 do i=1,klon
    2354                    www(i)=max(www(i),-omega(i,k)*RD*t_seri(i,k) &
    2355                         /(RG*paprs(i,k)) *zw2(i,k)*zw2(i,k))
    2356                    ! if (paprs(i,k)>pbase(i)) then
    2357                    ! calcul approche de la vitesse verticale en m/s
    2358                    !  www(i)=max(www(i),-omega(i,k)*RD*temp(i,k)/(RG*paprs(i,k))
    2359                    !             endif
    2360                    !   Le 0.1 est en gros H / ps = 1e5 / 1e4
    2361                 enddo
    2362              enddo
    2363              do i=1,klon
    2364                 if (www(i)>0. .and. ale_bl(i)>0. ) www(i)=www(i)/ale_bl(i)
    2365              enddo
    2366           ENDIF
    2367 
    2368 
    2369           do i = 1,klon
    2370              ALE(i) = max(ale_wake(i),Ale_bl(i))
    2371              !cc nrlmd le 10/04/2012----------Stochastic triggering------------
    2372              if (iflag_trig_bl.ge.1) then
    2373                 ALE(i) = max(ale_wake(i),Ale_bl_trig(i))
    2374              endif
    2375              !cc fin nrlmd le 10/04/2012
    2376              if (alp_offset>=0.) then
    2377                 ALP(i) = alp_wake(i) + Alp_bl(i) + alp_offset ! modif sb
    2378              else
    2379                 abort_message ='Ne pas passer la car www non calcule'
    2380                 CALL abort_physic (modname,abort_message,1)
    2381 
    2382                 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2383                 !                                _                  _
    2384                 ! Ajout d'une composante 3 * A * w w'2 a w'3 avec
    2385                 ! w=www : w max sous pbase ou A est la fraction
    2386                 ! couverte par les ascendances w' on utilise le fait
    2387                 ! que A * w'3 = ALP et donc A * w'2 ~ ALP / sqrt(ALE)
    2388                 ! (on ajoute 0.1 pour les singularites)
    2389                 ALP(i)=alp_wake(i)*(1.+3.*www(i)/( sqrt(ale_wake(i))+0.1) ) &
    2390                      +alp_bl(i)  *(1.+3.*www(i)/( sqrt(ale_bl(i))  +0.1) )
    2391                 !    ALP(i)=alp_wake(i)+Alp_bl(i)+alp_offset*min(omega(i,6),0.)
    2392                 !             if (alp(i)<0.) then
    2393                 !                print*,'ALP ',alp(i),alp_wake(i) &
    2394                 !                     ,Alp_bl(i),alp_offset*min(omega(i,6),0.)
    2395                 !             endif
    2396              endif
    2397           enddo
    2398           ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
    2399 
    2400        endif
    2401        do i=1,klon
    2402           if (alp(i)>alp_max) then
    2403              IF(prt_level>9)WRITE(lunout,*)                             &
    2404                   'WARNING SUPER ALP (seuil=',alp_max, &
    2405                   '): i, alp, alp_wake,ale',i,alp(i),alp_wake(i),ale(i)
    2406              alp(i)=alp_max
    2407           endif
    2408           if (ale(i)>ale_max) then
    2409              IF(prt_level>9)WRITE(lunout,*)                             &
    2410                   'WARNING SUPER ALE (seuil=',ale_max, &
    2411                   '): i, alp, alp_wake,ale',i,ale(i),ale_wake(i),alp(i)
    2412              ale(i)=ale_max
    2413           endif
    2414        enddo
    2415 
    2416        !fin calcul ale et alp
    2417        !=======================================================================
    2418 
    2419 
     2285!jyg<
     2286       CALL alpale( debut, itap, dtime, paprs, omega, t_seri,   &
     2287                    alp_offset, it_wape_prescr,  wape_prescr, fip_prescr, &
     2288                    ale_bl_prescr, alp_bl_prescr, &
     2289                    wake_pe, wake_fip,  &
     2290                    Ale_bl, Ale_bl_trig, Alp_bl, &
     2291                    Ale, Alp )
     2292!>jyg
     2293!
    24202294       ! sb, oct02:
    24212295       ! Schema de convection modularise et vectorise:
    … …  
    28952769          ENDIF
    28962770          !>jyg
    2897 
    2898           !cc nrlmd le 10/04/2012
    2899           !-----------Stochastic triggering-----------
    2900           if (iflag_trig_bl.ge.1) then
    2901              !
    2902              IF (prt_level .GE. 10) THEN
    2903                 print *,'cin, ale_bl_stat, alp_bl_stat ', &
    2904                      cin, ale_bl_stat, alp_bl_stat
    2905              ENDIF
    2906 
    2907 
    2908              !----Initialisations
    2909              do i=1,klon
    2910                 proba_notrig(i)=1.
    2911                 random_notrig(i)=1e6*ale_bl_stat(i)-int(1e6*ale_bl_stat(i))
    2912                 if ( random_notrig(i) > random_notrig_max ) random_notrig(i)=0.
    2913                 if ( ale_bl_trig(i) .lt. abs(cin(i))+1.e-10 ) then
    2914                    tau_trig(i)=tau_trig_shallow
    2915                 else
    2916                    tau_trig(i)=tau_trig_deep
    2917                 endif
    2918              enddo
    2919              !
    2920              IF (prt_level .GE. 10) THEN
    2921                 print *,'random_notrig, tau_trig ', &
    2922                      random_notrig, tau_trig
    2923                 print *,'s_trig,s2,n2 ', &
    2924                      s_trig,s2,n2
    2925              ENDIF
    2926 
    2927              !Option pour re-activer l'ancien calcul de Ale_bl (iflag_trig_bl=2)
    2928              IF (iflag_trig_bl.eq.1) then
    2929 
    2930                 !----Tirage al\'eatoire et calcul de ale_bl_trig
    2931                 do i=1,klon
    2932                    if ( (ale_bl_stat(i) .gt. abs(cin(i))+1.e-10) )  then
    2933                       proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
    2934                            (n2(i)*dtime/tau_trig(i))
    2935                       !        print *, 'proba_notrig(i) ',proba_notrig(i)
    2936                       if (random_notrig(i) .ge. proba_notrig(i)) then
    2937                          ale_bl_trig(i)=ale_bl_stat(i)
    2938                       else
    2939                          ale_bl_trig(i)=0.
    2940                       endif
    2941                    else
    2942                       proba_notrig(i)=1.
    2943                       random_notrig(i)=0.
    2944                       ale_bl_trig(i)=0.
    2945                    endif
    2946                 enddo
    2947 
    2948              ELSE IF (iflag_trig_bl.ge.2) then
    2949 
    2950                 do i=1,klon
    2951                    if ( (Ale_bl(i) .gt. abs(cin(i))+1.e-10) )  then
    2952                       proba_notrig(i)=(1.-exp(-s_trig/s2(i)))** &
    2953                            (n2(i)*dtime/tau_trig(i))
    2954                       !        print *, 'proba_notrig(i) ',proba_notrig(i)
    2955                       if (random_notrig(i) .ge. proba_notrig(i)) then
    2956                          ale_bl_trig(i)=Ale_bl(i)
    2957                       else
    2958                          ale_bl_trig(i)=0.
    2959                       endif
    2960                    else
    2961                       proba_notrig(i)=1.
    2962                       random_notrig(i)=0.
    2963                       ale_bl_trig(i)=0.
    2964                    endif
    2965                 enddo
    2966 
    2967              ENDIF
    2968 
    2969              !
    2970              IF (prt_level .GE. 10) THEN
    2971                 print *,'proba_notrig, ale_bl_trig ', &
    2972                      proba_notrig, ale_bl_trig
    2973              ENDIF
    2974 
    2975           endif !(iflag_trig_bl)
    2976 
    2977           !-----------Statistical closure-----------
    2978           if (iflag_clos_bl.eq.1) then
    2979 
    2980              do i=1,klon
    2981                 !CR: alp probabiliste
    2982                 if (ale_bl_trig(i).gt.0.) then
    2983                    alp_bl(i)=alp_bl(i)/(1.-min(proba_notrig(i),0.999))
    2984                 endif
    2985              enddo
    2986 
    2987           else if (iflag_clos_bl.eq.2) then
    2988 
    2989              !CR: alp calculee dans thermcell_main
    2990              do i=1,klon
    2991                 alp_bl(i)=alp_bl_stat(i)
    2992              enddo
    2993 
    2994           else
    2995 
    2996              alp_bl_stat(:)=0.
    2997 
    2998           endif !(iflag_clos_bl)
    2999 
    3000           IF (prt_level .GE. 10) THEN
    3001              print *,'ale_bl_trig, alp_bl_stat ',ale_bl_trig, alp_bl_stat
    3002           ENDIF
    3003 
    3004           !cc fin nrlmd le 10/04/2012
    3005 
    3006           ! ------------------------------------------------------------------
    3007           ! Transport de la TKE par les panaches thermiques.
    3008           ! FH : 2010/02/01
    3009           !     if (iflag_pbl.eq.10) then
    3010           !     call thermcell_dtke(klon,klev,nbsrf,pdtphys,fm_therm,entr_therm,
    3011           !    s           rg,paprs,pbl_tke)
    3012           !     endif
    3013           ! -------------------------------------------------------------------
    3014           !IM/FH: 2011/02/23
    3015           ! Couplage Thermiques/Emanuel seulement si T<0
    3016           if (iflag_coupl==2) then
    3017              IF (prt_level .GE. 10) THEN
    3018                 print*,'Couplage Thermiques/Emanuel seulement si T<0'
    3019              ENDIF
    3020              do i=1,klon
    3021                 if (t_seri(i,lmax_th(i))>273.) then
    3022                    Ale_bl(i)=0.
    3023                 endif
    3024              enddo
    3025           endif
     2771!jyg<
     2772!
     2773          CALL alpale_th( dtime, lmax_th, t_seri, &
     2774                          cin, s2, n2,  &
     2775                          ale_bl_trig, ale_bl_stat, ale_bl,  &
     2776                          alp_bl, alp_bl_stat )
    30262777
    30272778          do i=1,klon
Note: See TracChangeset for help on using the changeset viewer.