SUBROUTINE reevap (klon,klev,iflag_ice_thermo,t_seri,q_seri,ql_seri,qs_seri, & & d_t_eva,d_q_eva,d_ql_eva,d_qs_eva & #ifdef ISO ,xt_seri,xtl_seri,xts_seri,d_xt_eva,d_xtl_eva,d_xts_eva & #endif & ) ! flag to include modifications to ensure energy conservation (if flag >0) USE add_phys_tend_mod, only : fl_cor_ebil #ifdef ISO USE infotrac_phy, ONLY: ntraciso #ifdef ISOVERIF USE isotopes_verif_mod !, ONLY: errmax,errmaxrel, iso_verif_o18_aberrant_nostop,deltaD,deltaO USE isotopes_mod, ONLY: iso_eau,iso_hdo,iso_o18,ridicule #ifdef ISOTRAC USE isotrac_routines_mod, ONLY: iso_verif_traceur_pbidouille #endif #endif #endif IMPLICIT none !>====================================================================== INTEGER klon,klev,iflag_ice_thermo REAL, DIMENSION(klon,klev), INTENT(in) :: t_seri,q_seri,ql_seri,qs_seri REAL, DIMENSION(klon,klev), INTENT(out) :: d_t_eva,d_q_eva,d_ql_eva,d_qs_eva REAL za,zb,zdelta,zlvdcp,zlsdcp INTEGER i,k #ifdef ISO REAL, DIMENSION(ntraciso,klon,klev), INTENT(in) :: xt_seri,xtl_seri,xts_seri REAL, DIMENSION(ntraciso,klon,klev), INTENT(out) :: d_xt_eva,d_xtl_eva,d_xts_eva integer ixt #endif !--------Stochastic Boundary Layer Triggering: ALE_BL-------- !---Propri\'et\'es du thermiques au LCL include "YOMCST.h" include "YOETHF.h" include "FCTTRE.h" !IM 100106 BEG : pouvoir sortir les ctes de la physique ! ! Re-evaporer l'eau liquide nuageuse ! !print *,'rrevap ; fl_cor_ebil:',fl_cor_ebil,' iflag_ice_thermo:',iflag_ice_thermo,' RVTMP2',RVTMP2 DO k = 1, klev ! re-evaporation de l'eau liquide nuageuse DO i = 1, klon if (fl_cor_ebil .GT. 0) then zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k))) zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*(q_seri(i,k)+ql_seri(i,k)+qs_seri(i,k))) else zlvdcp=RLVTT/RCPD/(1.0+RVTMP2*q_seri(i,k)) !jyg< ! Attention : Arnaud a propose des formules completement differentes ! A verifier !!! zlsdcp=RLSTT/RCPD/(1.0+RVTMP2*q_seri(i,k)) end if IF (iflag_ice_thermo .EQ. 0) THEN zlsdcp=zlvdcp ENDIF !>jyg IF (iflag_ice_thermo.eq.0) THEN !pas necessaire a priori zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k))) zdelta = 0. zb = MAX(0.0,ql_seri(i,k)) za = - MAX(0.0,ql_seri(i,k)) & * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta) d_t_eva(i,k) = za d_q_eva(i,k) = zb d_ql_eva(i,k) = -ql_seri(i,k) d_qs_eva(i,k) = 0. #ifdef ISO do ixt=1,ntraciso zb = MAX(0.0,xtl_seri(ixt,i,k)) d_xt_eva(ixt,i,k) = zb d_xtl_eva(ixt,i,k) = -xtl_seri(ixt,i,k) d_xts_eva(ixt,i,k) = 0. enddo ! do ixt=1,ntraciso #ifdef ISOVERIF do ixt=1,ntraciso call iso_verif_noNaN(xt_seri(ixt,i,k), & & 'physiq 2417: apres evap tot') enddo if (iso_eau.gt.0) then call iso_verif_egalite_choix( & & xt_seri(iso_eau,i,k),q_seri(i,k), & & 'physiq 1891+, après reevap totale',errmax,errmaxrel) call iso_verif_egalite_choix( & & xtl_seri(iso_eau,i,k),ql_seri(i,k), & & 'physiq 2209+, après reevap totale',errmax,errmaxrel) endif !if (iso_eau.gt.0) then if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then if (q_seri(i,k).gt.ridicule) then if (iso_verif_o18_aberrant_nostop( & & xt_seri(iso_HDO,i,k)/q_seri(i,k), & & xt_seri(iso_O18,i,k)/q_seri(i,k), & & 'physiq 2315: apres reevap totale').eq.1) then write(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k) write(*,*) 'd_q_eva(i,k)=',d_q_eva(i,k) write(*,*) 'deltaD(d_q_eva(i,k))=',deltaD(d_xt_eva(iso_HDO,i,k)/d_q_eva(i,k)) write(*,*) 'deltaO18(d_q_eva(i,k))=',deltaO(d_xt_eva(iso_O18,i,k)/d_q_eva(i,k)) stop endif ! if (iso_verif_o18_aberrant_nostop endif !if (q_seri(i,k).gt.errmax) then endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then #ifdef ISOTRAC call iso_verif_traceur(xt_seri(1,i,k), & & 'physiq 2165') call iso_verif_traceur_pbidouille(xt_seri(1,i,k), & & 'physiq 2165b') #endif #endif #endif ELSE !CR: on r\'e-\'evapore eau liquide et glace ! zdelta = MAX(0.,SIGN(1.,RTT-t_seri(i,k))) ! zb = MAX(0.0,ql_seri(i,k)) ! za = - MAX(0.0,ql_seri(i,k)) & ! * (zlvdcp*(1.-zdelta)+zlsdcp*zdelta) zb = MAX(0.0,ql_seri(i,k)+qs_seri(i,k)) za = - MAX(0.0,ql_seri(i,k))*zlvdcp & - MAX(0.0,qs_seri(i,k))*zlsdcp d_t_eva(i,k) = za d_q_eva(i,k) = zb d_ql_eva(i,k) = -ql_seri(i,k) d_qs_eva(i,k) = -qs_seri(i,k) #ifdef ISO do ixt=1,ntraciso zb = MAX(0.0,xtl_seri(ixt,i,k)+xts_seri(ixt,i,k)) d_xt_eva(ixt,i,k) = zb d_xtl_eva(ixt,i,k) = -xtl_seri(ixt,i,k) d_xts_eva(ixt,i,k) = -xts_seri(ixt,i,k) enddo ! do ixt=1,ntraciso #ifdef ISOVERIF do ixt=1,ntraciso call iso_verif_noNaN(xt_seri(ixt,i,k), & & 'physiq 2417: apres evap tot') enddo if (iso_eau.gt.0) then call iso_verif_egalite_choix( & & xt_seri(iso_eau,i,k),q_seri(i,k), & & 'physiq 1891, après réévap totale',errmax,errmaxrel) call iso_verif_egalite_choix( & & xtl_seri(iso_eau,i,k),ql_seri(i,k), & & 'physiq 2209, après réévap totale',errmax,errmaxrel) call iso_verif_egalite_choix( & & xts_seri(iso_eau,i,k),qs_seri(i,k), & & 'physiq 2209b, après réévap totale',errmax,errmaxrel) endif !if (iso_eau.gt.0) then if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then if (q_seri(i,k).gt.ridicule) then if (iso_verif_o18_aberrant_nostop( & & xt_seri(iso_HDO,i,k)/q_seri(i,k), & & xt_seri(iso_O18,i,k)/q_seri(i,k), & & 'physiq 2408: apres reevap totale').eq.1) then write(*,*) 'i,k,q_seri(i,k)=',i,k,q_seri(i,k) stop endif ! if (iso_verif_o18_aberrant_nostop endif !if (q_seri(i,k).gt.errmax) then endif !if ((iso_HDO.gt.0).and.(iso_O18.gt.0)) then #ifdef ISOTRAC call iso_verif_traceur(xt_seri(1,i,k), & & 'physiq 2165') call iso_verif_traceur_pbidouille(xt_seri(1,i,k), & & 'physiq 2165b') #endif #endif #endif ENDIF ENDDO ENDDO RETURN END SUBROUTINE reevap