! ! $Header$ ! subroutine calltherm(dtime & & ,pplay,paprs,pphi,weak_inversion & & ,u_seri,v_seri,t_seri,q_seri,zqsat,debut & & ,d_u_ajs,d_v_ajs,d_t_ajs,d_q_ajs & & ,fm_therm,entr_therm,zqasc,clwcon0,lmax,ratqscth, & & ratqsdiff,zqsatth,Ale_bl,Alp_bl,lalim_conv,wght_th, & & zmax0,f0) USE dimphy implicit none #include "dimensions.h" !#include "dimphy.h" #include "thermcell.h" #include "iniprint.h" ! A inclure eventuellement dans les fichiers de configuration data r_aspect_thermals,l_mix_thermals,tho_thermals/2.,30.,0./ data w2di_thermals/0/ REAL dtime LOGICAL debut REAL u_seri(klon,klev),v_seri(klon,klev) REAL t_seri(klon,klev),q_seri(klon,klev),qmemoire(klon,klev) REAL weak_inversion(klon) REAL paprs(klon,klev+1) REAL pplay(klon,klev) REAL pphi(klon,klev) real zlev(klon,klev+1) !test: on sort lentr et a* pour alimenter KE REAL wght_th(klon,klev) INTEGER lalim_conv(klon) !FH Update Thermiques REAL d_t_ajs(klon,klev), d_q_ajs(klon,klev) REAL d_u_ajs(klon,klev),d_v_ajs(klon,klev) real fm_therm(klon,klev+1),entr_therm(klon,klev) !******************************************************** ! declarations ! real fmc_therm(klon,klev+1),zqasc(klon,klev) real zqasc(klon,klev) real zqla(klon,klev) real wmax_sec(klon) real zmax_sec(klon) real f_sec(klon) ! real detrc_therm(klon,klev) ! save fmc_therm, detrc_therm REAL, SAVE, ALLOCATABLE :: fmc_therm(:,:), detrc_therm(:,:) !$OMP THREADPRIVATE(fmc_therm, detrc_therm) real clwcon0(klon,klev) real zqsat(klon,klev) real zw_sec(klon,klev+1) integer lmix_sec(klon) integer lmax(klon) real ratqscth(klon,klev) real ratqsdiff(klon,klev) real zqsatth(klon,klev) !nouvelles variables pour la convection real Ale_bl(klon) real Alp_bl(klon) real Ale(klon) real Alp(klon) !RC !on garde le zmax du pas de temps precedent real zmax0(klon), f0(klon) !******************************************************** ! variables locales REAL d_t_the(klon,klev), d_q_the(klon,klev) REAL d_u_the(klon,klev),d_v_the(klon,klev) ! ! real zfm_therm(klon,klev+1),zentr_therm(klon,klev),zdt real zdt ! save zentr_therm,zfm_therm REAL, SAVE, ALLOCATABLE :: zfm_therm(:,:),zentr_therm(:,:) !$OMP THREADPRIVATE(zfm_therm, zentr_therm) integer i,k LOGICAL, SAVE :: first=.true. !******************************************************** ! Modele du thermique ! =================== ! print*,'thermiques: WARNING on passe t au lieu de t_seri' if (first) then ALLOCATE(fmc_therm(klon,klev+1)) ALLOCATE(detrc_therm(klon,klev)) ALLOCATE(zfm_therm(klon,klev+1)) ALLOCATE(zentr_therm(klon,klev)) first=.false. endif fm_therm(:,:)=0. entr_therm(:,:)=0. Ale_bl(:)=0. Alp_bl(:)=0. if (prt_level.ge.10) then print*,'thermV4 nsplit: ',nsplit_thermals,' weak_inversion' endif ! tests sur les valeurs negatives de l'eau do k=1,klev do i=1,klon if (.not.q_seri(i,k).ge.0.) then if (prt_level.ge.10) then print*,'WARN eau<0 avant therm i=',i,' k=',k & & ,' dq,q',d_q_the(i,k),q_seri(i,k) endif q_seri(i,k)=1.e-15 endif enddo enddo zdt=dtime/float(nsplit_thermals) do isplit=1,nsplit_thermals if (iflag_thermals.eq.1) then CALL thermcell_2002(klon,klev,zdt & & ,pplay,paprs,pphi & & ,u_seri,v_seri,t_seri,q_seri & & ,d_u_the,d_v_the,d_t_the,d_q_the & & ,zfm_therm,zentr_therm & & ,r_aspect_thermals,30.,w2di_thermals & & ,tho_thermals,3) else if (iflag_thermals.eq.2) then CALL thermcell_sec(klon,klev,zdt & & ,pplay,paprs,pphi,zlev & & ,u_seri,v_seri,t_seri,q_seri & & ,d_u_the,d_v_the,d_t_the,d_q_the & & ,zfm_therm,zentr_therm & & ,r_aspect_thermals,30.,w2di_thermals & & ,tho_thermals,3) else if (iflag_thermals.eq.3) then CALL thermcell(klon,klev,zdt & & ,pplay,paprs,pphi & & ,u_seri,v_seri,t_seri,q_seri & & ,d_u_the,d_v_the,d_t_the,d_q_the & & ,zfm_therm,zentr_therm & & ,r_aspect_thermals,l_mix_thermals,w2di_thermals & & ,tho_thermals,3) else if (iflag_thermals.eq.10) then CALL thermcell_eau(klon,klev,zdt & & ,pplay,paprs,pphi & & ,u_seri,v_seri,t_seri,q_seri & & ,d_u_the,d_v_the,d_t_the,d_q_the & & ,zfm_therm,zentr_therm & & ,r_aspect_thermals,l_mix_thermals,w2di_thermals & & ,tho_thermals,3) else if (iflag_thermals.eq.11) then stop'cas non prevu dans calltherm' ! CALL thermcell_pluie(klon,klev,zdt & ! & ,pplay,paprs,pphi,zlev & ! & ,u_seri,v_seri,t_seri,q_seri & ! & ,d_u_the,d_v_the,d_t_the,d_q_the & ! & ,zfm_therm,zentr_therm,zqla & ! & ,r_aspect_thermals,l_mix_thermals,w2di_thermals & ! & ,tho_thermals,3) else if (iflag_thermals.eq.12) then CALL calcul_sec(klon,klev,zdt & & ,pplay,paprs,pphi,zlev & & ,u_seri,v_seri,t_seri,q_seri & & ,zmax_sec,wmax_sec,zw_sec,lmix_sec & & ,r_aspect_thermals,l_mix_thermals,w2di_thermals & & ,tho_thermals) ! CALL calcul_sec_entr(klon,klev,zdt ! s ,pplay,paprs,pphi,zlev,debut ! s ,u_seri,v_seri,t_seri,q_seri ! s ,zmax_sec,wmax_sec,zw_sec,lmix_sec ! s ,r_aspect_thermals,l_mix_thermals,w2di_thermals ! s ,tho_thermals,3) ! CALL thermcell_pluie_detr(klon,klev,zdt & ! & ,pplay,paprs,pphi,zlev,debut & ! & ,u_seri,v_seri,t_seri,q_seri & ! & ,d_u_the,d_v_the,d_t_the,d_q_the & ! & ,zfm_therm,zentr_therm,zqla,lmax & ! & ,zmax_sec,wmax_sec,zw_sec,lmix_sec & ! & ,ratqscth,ratqsdiff,zqsatth & ! & ,r_aspect_thermals,l_mix_thermals,w2di_thermals & ! & ,tho_thermals) else if (iflag_thermals.ge.13) then CALL thermcell_main(klon,klev,zdt & & ,pplay,paprs,pphi,debut & & ,u_seri,v_seri,t_seri,q_seri & & ,d_u_the,d_v_the,d_t_the,d_q_the & & ,zfm_therm,zentr_therm,zqla,lmax & & ,ratqscth,ratqsdiff,zqsatth & & ,r_aspect_thermals,l_mix_thermals,w2di_thermals & & ,tho_thermals,Ale,Alp,lalim_conv,wght_th & & ,zmax0,f0) endif DO i=1,klon DO k=1,klev IF(iflag_thermals.lt.14.or.weak_inversion(i).gt.0.5) THEN ! transformation de la derivee en tendance d_t_the(i,k)=d_t_the(i,k)*dtime/float(nsplit_thermals) d_u_the(i,k)=d_u_the(i,k)*dtime/float(nsplit_thermals) d_v_the(i,k)=d_v_the(i,k)*dtime/float(nsplit_thermals) d_q_the(i,k)=d_q_the(i,k)*dtime/float(nsplit_thermals) fm_therm(i,k)=fm_therm(i,k) & & +zfm_therm(i,k)/float(nsplit_thermals) entr_therm(i,k)=entr_therm(i,k) & & +zentr_therm(i,k)/float(nsplit_thermals) fm_therm(:,klev+1)=0. ! accumulation de la tendance d_t_ajs(i,k)=d_t_ajs(i,k)+d_t_the(i,k) d_u_ajs(i,k)=d_u_ajs(i,k)+d_u_the(i,k) d_v_ajs(i,k)=d_v_ajs(i,k)+d_v_the(i,k) d_q_ajs(i,k)=d_q_ajs(i,k)+d_q_the(i,k) ! incrementation des variables meteo t_seri(i,k) = t_seri(i,k) + d_t_the(i,k) u_seri(i,k) = u_seri(i,k) + d_u_the(i,k) v_seri(i,k) = v_seri(i,k) + d_v_the(i,k) qmemoire(i,k)=q_seri(i,k) q_seri(i,k) = q_seri(i,k) + d_q_the(i,k) ENDIF ENDDO ENDDO DO i=1,klon fm_therm(i,klev+1)=0. Ale_bl(i)=Ale_bl(i)+Ale(i)/float(nsplit_thermals) ! write(22,*)'ALE CALLTHERM',Ale_bl(i),Ale(i) Alp_bl(i)=Alp_bl(i)+Alp(i)/float(nsplit_thermals) ! write(23,*)'ALP CALLTHERM',Alp_bl(i),Alp(i) ENDDO ! tests sur les valeurs negatives de l'eau DO k = 1, klev DO i = 1, klon if (.not.q_seri(i,k).ge.0.) then if (prt_level.ge.10) then print*,'WARN eau<0 apres therm i=',i,' k=',k & & ,' dq,q',d_q_the(i,k),q_seri(i,k), & & 'fm=',zfm_therm(i,k),'entr=',entr_therm(i,k) endif q_seri(i,k)=1.e-15 ! stop endif ENDDO ENDDO ! tests sur les valeurs de la temperature DO k = 1, klev DO i = 1, klon if ((t_seri(i,k).lt.50.) .or. & & (t_seri(i,k).gt.370.)) then print*,'WARN temp apres therm i=',i,' k=',k & & ,' t_seri',t_seri(i,k) ! CALL abort endif ENDDO ENDDO enddo ! isplit ! !*************************************************************** ! calcul du flux ascencant conservatif ! print*,'<<<