| Directory: | ./ |
|---|---|
| File: | phys/thermcell_closure.f90 |
| Date: | 2022-01-11 19:19:34 |
| Exec | Total | Coverage | |
|---|---|---|---|
| Lines: | 18 | 18 | 100.0% |
| Branches: | 18 | 18 | 100.0% |
| Line | Branch | Exec | Source |
|---|---|---|---|
| 1 | ! | ||
| 2 | ! $Header$ | ||
| 3 | ! | ||
| 4 | 480 | SUBROUTINE thermcell_closure(ngrid,nlay,r_aspect,ptimestep,rho, & | |
| 5 | 480 | & zlev,lalim,alim_star,f_star,zmax,wmax,f,lev_out) | |
| 6 | |||
| 7 | !------------------------------------------------------------------------- | ||
| 8 | !thermcell_closure: fermeture, determination de f | ||
| 9 | ! | ||
| 10 | ! Modification 7 septembre 2009 | ||
| 11 | ! 1. On enleve alim_star_tot des arguments pour le recalculer et etre ainis | ||
| 12 | ! coherent avec l'integrale au numerateur. | ||
| 13 | ! 2. On ne garde qu'une version des couples wmax,zmax et wmax_sec,zmax_sec | ||
| 14 | ! l'idee etant que le choix se fasse a l'appel de thermcell_closure | ||
| 15 | ! 3. Vectorisation en mettant les boucles en l l'exterieur avec des if | ||
| 16 | !------------------------------------------------------------------------- | ||
| 17 | IMPLICIT NONE | ||
| 18 | |||
| 19 | integer :: iflag_thermals,nsplit_thermals | ||
| 20 | |||
| 21 | !!! nrlmd le 10/04/2012 | ||
| 22 | integer :: iflag_trig_bl,iflag_clos_bl | ||
| 23 | integer :: tau_trig_shallow,tau_trig_deep | ||
| 24 | real :: s_trig | ||
| 25 | !!! fin nrlmd le 10/04/2012 | ||
| 26 | |||
| 27 | real,parameter :: r_aspect_thermals=2.,l_mix_thermals=30. | ||
| 28 | real :: alp_bl_k | ||
| 29 | real :: tau_thermals,fact_thermals_ed_dz | ||
| 30 | integer,parameter :: w2di_thermals=0 | ||
| 31 | integer :: isplit | ||
| 32 | |||
| 33 | integer :: iflag_coupl,iflag_clos,iflag_wake | ||
| 34 | integer :: iflag_thermals_ed,iflag_thermals_optflux,iflag_thermals_closure | ||
| 35 | |||
| 36 | common/ctherm1/iflag_thermals,nsplit_thermals,iflag_thermals_closure | ||
| 37 | common/ctherm2/tau_thermals,alp_bl_k,fact_thermals_ed_dz | ||
| 38 | common/ctherm4/iflag_coupl,iflag_clos,iflag_wake | ||
| 39 | common/ctherm5/iflag_thermals_ed,iflag_thermals_optflux | ||
| 40 | |||
| 41 | !!! nrlmd le 10/04/2012 | ||
| 42 | common/ctherm6/iflag_trig_bl,iflag_clos_bl | ||
| 43 | common/ctherm7/tau_trig_shallow,tau_trig_deep | ||
| 44 | common/ctherm8/s_trig | ||
| 45 | !!! fin nrlmd le 10/04/2012 | ||
| 46 | |||
| 47 | !$OMP THREADPRIVATE(/ctherm1/,/ctherm2/,/ctherm4/,/ctherm5/) | ||
| 48 | !$OMP THREADPRIVATE(/ctherm6/,/ctherm7/,/ctherm8/) | ||
| 49 | INTEGER ngrid,nlay | ||
| 50 | INTEGER ig,k | ||
| 51 | REAL r_aspect,ptimestep | ||
| 52 | integer lev_out ! niveau pour les print | ||
| 53 | |||
| 54 | INTEGER lalim(ngrid) | ||
| 55 | REAL alim_star(ngrid,nlay) | ||
| 56 | REAL f_star(ngrid,nlay+1) | ||
| 57 | REAL rho(ngrid,nlay) | ||
| 58 | REAL zlev(ngrid,nlay) | ||
| 59 | REAL zmax(ngrid) | ||
| 60 | REAL wmax(ngrid) | ||
| 61 | REAL zdenom(ngrid) | ||
| 62 | 960 | REAL alim_star2(ngrid) | |
| 63 | REAL f(ngrid) | ||
| 64 | |||
| 65 | 480 | REAL alim_star_tot(ngrid) | |
| 66 | INTEGER llmax | ||
| 67 | |||
| 68 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | ||
| 69 | !print*,'THERMCELL CLOSURE 26E' | ||
| 70 | |||
| 71 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | alim_star2(:)=0. |
| 72 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | alim_star_tot(:)=0. |
| 73 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | f(:)=0. |
| 74 | |||
| 75 | ! Indice vertical max (max de lalim) atteint par les thermiques sur le domaine | ||
| 76 | llmax=1 | ||
| 77 |
2/2✓ Branch 0 taken 480 times.
✓ Branch 1 taken 477120 times.
|
477600 | do ig=1,ngrid |
| 78 | 477600 | if (lalim(ig)>llmax) llmax=lalim(ig) | |
| 79 | enddo | ||
| 80 | |||
| 81 | |||
| 82 | ! Calcul des integrales sur la verticale de alim_star et de | ||
| 83 | ! alim_star^2/(rho dz) | ||
| 84 |
2/2✓ Branch 0 taken 3331 times.
✓ Branch 1 taken 480 times.
|
3811 | do k=1,llmax-1 |
| 85 |
2/2✓ Branch 0 taken 3311014 times.
✓ Branch 1 taken 3331 times.
|
3314825 | do ig=1,ngrid |
| 86 |
2/2✓ Branch 0 taken 609661 times.
✓ Branch 1 taken 2701353 times.
|
3314345 | if (k<lalim(ig)) then |
| 87 | alim_star2(ig)=alim_star2(ig)+alim_star(ig,k)**2 & | ||
| 88 | 609661 | & /(rho(ig,k)*(zlev(ig,k+1)-zlev(ig,k))) | |
| 89 | 609661 | alim_star_tot(ig)=alim_star_tot(ig)+alim_star(ig,k) | |
| 90 | endif | ||
| 91 | enddo | ||
| 92 | enddo | ||
| 93 | |||
| 94 | |||
| 95 |
2/2✓ Branch 0 taken 477120 times.
✓ Branch 1 taken 480 times.
|
477600 | do ig=1,ngrid |
| 96 |
2/2✓ Branch 0 taken 248430 times.
✓ Branch 1 taken 228690 times.
|
477600 | if (alim_star2(ig)>1.e-10) then |
| 97 | f(ig)=wmax(ig)*alim_star_tot(ig)/ & | ||
| 98 | 248430 | & (max(500.,zmax(ig))*r_aspect*alim_star2(ig)) | |
| 99 | endif | ||
| 100 | enddo | ||
| 101 | |||
| 102 | |||
| 103 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | ||
| 104 | ! TESTS POUR UNE NOUVELLE FERMETURE DANS LAQUELLE ALIM_STAR NE SERAIT | ||
| 105 | ! PAS NORMALISE | ||
| 106 | ! f(ig)=f(ig)*f_star(ig,2)/(f_star(ig,lalim(ig))) | ||
| 107 | !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! | ||
| 108 | |||
| 109 | 480 | return | |
| 110 | end | ||
| 111 |