Index: /LMDZ5/trunk/libf/phylmd/Dust/aeropt_spl.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/aeropt_spl.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/aeropt_spl.F (revision 2630) @@ -0,0 +1,251 @@ + SUBROUTINE aeropt_spl(zdz, tr_seri, RHcl, + . id_prec, id_fine, id_coss, id_codu, id_scdu, + . ok_chimeredust, + . ztaue550,ztaue670,ztaue865, + . taue550_tr2,taue670_tr2,taue865_tr2, + . taue550_ss,taue670_ss,taue865_ss, + . taue550_dust,taue670_dust,taue865_dust, + . taue550_dustsco,taue670_dustsco,taue865_dustsco) +c + USE dimphy + USE infotrac + IMPLICIT none +c +#include "chem.h" +#include "dimensions.h" +c #include "dimphy.h" +#include "YOMCST.h" +c +c Arguments: +c +c======================== INPUT ================================== + REAL zdz(klon,klev) + REAL tr_seri(klon,klev,nbtr) ! masse of tracer + REAL RHcl(klon,klev) ! humidite relativen ciel clair + INTEGER id_prec, id_fine, id_coss, id_codu, id_scdu + LOGICAL ok_chimeredust +c============================== OUTPUT ================================= + REAL ztaue550(klon) ! epaisseur optique aerosol 550 nm + REAL ztaue670(klon) ! epaisseur optique aerosol 670 nm + REAL ztaue865(klon) ! epaisseur optique aerosol 865 nm + REAL taue550_tr2(klon) ! epaisseur optique aerosol 550 nm, diagnostic + REAL taue670_tr2(klon) ! epaisseur optique aerosol 670 nm, diagnostic + REAL taue865_tr2(klon) ! epaisseur optique aerosol 865 nm, diagnostic + REAL taue550_ss(klon) ! epaisseur optique aerosol 550 nm, diagnostic + REAL taue670_ss(klon) ! epaisseur optique aerosol 670 nm, diagnostic + REAL taue865_ss(klon) ! epaisseur optique aerosol 865 nm, diagnostic + REAL taue550_dust(klon) ! epaisseur optique aerosol 550 nm, diagnostic + REAL taue670_dust(klon) ! epaisseur optique aerosol 670 nm, diagnostic + REAL taue865_dust(klon) ! epaisseur optique aerosol 865 nm, diagnostic + REAL taue550_dustsco(klon) ! epaisseur optique aerosol 550 nm, diagnostic + REAL taue670_dustsco(klon) ! epaisseur optique aerosol 670 nm, diagnostic + REAL taue865_dustsco(klon) ! epaisseur optique aerosol 865 nm, diagnostic +c===================== LOCAL VARIABLES =========================== + INTEGER nb_lambda,nbre_RH + PARAMETER (nb_lambda=3,nbre_RH=12) + INTEGER i, k, RH_num + REAL rh, RH_MAX, DELTA, RH_tab(nbre_RH) + PARAMETER (RH_MAX=95.) + INTEGER rh_int + PARAMETER (rh_int=12) + REAL auxreal +c REAL ss_a(nb_lambda,int,nbtr-1) +c DATA ss_a/72*1./ + REAL ss_dust(nb_lambda), ss_acc550(rh_int), alpha_acc + REAL ss_dustsco(nb_lambda) + REAL ss_acc670(rh_int), ss_acc865(rh_int) + REAL ss_ssalt550(rh_int) + REAL ss_ssalt670(rh_int), ss_ssalt865(rh_int) + REAL burden_ss(klon) + DATA ss_acc550 /3.135,3.135,3.135, 3.135, 4.260, 4.807, + . 5.546,6.651,8.641,10.335,13.534,22.979/ + DATA ss_acc670 /2.220,2.220,2.220, 2.220, 3.048, 3.460, + . 4.023,4.873,6.426, 7.761,10.322,18.079/ + DATA ss_acc865 /1.329,1.329,1.329, 1.329, 1.855, 2.124, + . 2.494,3.060,4.114, 5.033, 6.831,12.457/ +!old4tracers DATA ss_dust/0.564, 0.614, 0.700/ !for bin 0.5-10um +! DATA ss_dust/0.553117, 0.610185, 0.7053460 / !for bin 0.5-3um radius +! DATA ss_dustsco/0.1014, 0.102156, 0.1035538 / !for bin 3-15um radius +!20140902 DATA ss_dust/0.5345737, 0.5878828, 0.6772957/ !for bin 0.5-3um radius +!20140902 DATA ss_dustsco/0.1009634, 0.1018700, 0.1031178/ !for bin 3-15um radius +!3days DATA ss_dust/0.4564216, 0.4906738, 0.5476248/ !for bin 0.5-3um radius +!3days DATA ss_dustsco/0.1015022, 0.1024051, 0.1036622/ !for bin 3-15um radius +!JE20140911 DATA ss_dust/0.5167768,0.5684330,0.6531643/ !for bin 0.5-3um radius +!JE20140911 DATA ss_dustsco/0.1003391,0.1012288,0.1024651/ !for bin 3-15um radius +!JE20140915 DATA ss_dust/0.3188754,0.3430106,0.3829019/ !for bin 0.5-5um radius +!JE20140915 DATA ss_dustsco/8.0582686E-02,8.1255026E-02,8.1861295E-02/ !for bin 5-15um radius + +! DATA ss_dust/0.5167768,0.5684330,0.6531643/ !for bin 0.5-3um radius +! DATA ss_dustsco/0.1003391,0.1012288,0.1024651/ !for bin 3-15um radius + + + DATA ss_ssalt550/0.182,0.182,0.182,0.182,0.366,0.430, + . 0.484,0.551,0.648,0.724,0.847,1.218/ !for bin 0.5-20 um, fit_v2 + DATA ss_ssalt670/0.193,0.193,0.193,0.193,0.377,0.431, + . 0.496,0.587,0.693,0.784,0.925,1.257/ !for bin 0.5-20 um + DATA ss_ssalt865/0.188,0.188,0.188,0.188,0.384,0.443, + . 0.502,0.580,0.699,0.799,0.979,1.404/ !for bin 0.5-20 um + + DATA RH_tab/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./ +c + IF (ok_chimeredust) THEN +!JE20150212<< : changes in ustar in dustmod changes emission distribution +! ss_dust=(/0.5167768,0.5684330,0.6531643/) +! ss_dustsco=(/0.1003391,0.1012288,0.1024651/) +! JE20150618: Change in dustmodule, div3 is now =6: change distributions +! div3=3 ss_dust =(/0.4670522 , 0.5077308 , 0.5745184/) +! div3=3 ss_dustsco=(/0.099858 , 0.1007395 , 0.1019673/) + ss_dust =(/0.4851232 , 0.5292494 , 0.5935509/) + ss_dustsco=(/0.1001981 , 0.1011043 , 0.1023113/) + +!JE20150212>> + + ELSE + ss_dust=(/0.564, 0.614, 0.700/) + ss_dustsco=(/0.,0.,0./) + ENDIF + + DO i=1, klon + ztaue550(i)=0.0 + ztaue670(i)=0.0 + ztaue865(i)=0.0 + taue550_tr2(i)=0.0 + taue670_tr2(i)=0.0 + taue865_tr2(i)=0.0 + taue550_ss(i)=0.0 + taue670_ss(i)=0.0 + taue865_ss(i)=0.0 + taue550_dust(i)=0.0 + taue670_dust(i)=0.0 + taue865_dust(i)=0.0 + taue550_dustsco(i)=0.0 + taue670_dustsco(i)=0.0 + taue865_dustsco(i)=0.0 + burden_ss(i)=0.0 + ENDDO + + DO k=1, klev + DO i=1, klon +c + rh=MIN(RHcl(i,k)*100.,RH_MAX) + RH_num = INT( rh/10. + 1.) + IF (rh.gt.85.) RH_num=10 + IF (rh.gt.90.) RH_num=11 +c IF (rh.gt.40.) THEN +c RH_num=5 ! Added by NHL temporarily +c print *,'TEMPORARY CASE' +c ENDIF + DELTA=(rh-RH_tab(RH_num))/(RH_tab(RH_num+1)-RH_tab(RH_num)) + + +c******************************************************************* +c AOD at 550 NM +c******************************************************************* + alpha_acc=ss_acc550(RH_num) + DELTA*(ss_acc550(RH_num+1)- + . ss_acc550(RH_num)) !--m2/g +cnhl_test TOTAL AOD + auxreal=0. + IF(id_fine>0) auxreal=auxreal+alpha_acc*tr_seri(i,k,id_fine) + IF(id_coss>0) auxreal=auxreal+ss_ssalt550(RH_num)* + . tr_seri(i,k,id_coss) + IF(id_codu>0) auxreal=auxreal+ss_dust(1)*tr_seri(i,k,id_codu) + IF(id_scdu>0) auxreal=auxreal+ss_dustsco(1)*tr_seri(i,k,id_scdu) + ztaue550(i)=ztaue550(i)+auxreal*zdz(i,k)*1.e6 + +!JE20150128 ztaue550(i)=ztaue550(i)+(alpha_acc*tr_seri(i,k,id_fine)+ +! . ss_ssalt550(RH_num)*tr_seri(i,k,id_coss)+ +! . ss_dust(1)*tr_seri(i,k,id_codu)+ +! . ss_dustsco(1)*tr_seri(i,k,id_scdu) )*zdz(i,k)*1.e6 + +cnhl_test TOTAL AOD IS NOW AOD COARSE MODE ONLY +cnhl_test ztaue550(i)=ztaue550(i)+( +cnhl_test . ss_ssalt550(RH_num)*tr_seri(i,k,3)+ +cnhl_test . ss_dust(1)*tr_seri(i,k,4))*zdz(i,k)*1.e6 + + IF(id_fine>0) taue550_tr2(i)=taue550_tr2(i) + . + alpha_acc*tr_seri(i,k,id_fine)*zdz(i,k)*1.e6 + IF(id_coss>0) taue550_ss(i)=taue550_ss(i)+ + . ss_ssalt550(RH_num)*tr_seri(i,k,id_coss)* + . zdz(i,k)*1.e6 + IF(id_codu>0) taue550_dust(i)=taue550_dust(i)+ + . ss_dust(1)*tr_seri(i,k,id_codu)* + . zdz(i,k)*1.e6 + IF(id_scdu>0) taue550_dustsco(i)=taue550_dustsco(i)+ + . ss_dustsco(1)*tr_seri(i,k,id_scdu)* + . zdz(i,k)*1.e6 +! print *,'taue550_ss = ',SUM(taue550_ss),MINVAL(taue550_ss), +! . MAXVAL(taue550_ss) + +c******************************************************************* +c AOD at 670 NM +c******************************************************************* + alpha_acc=ss_acc670(RH_num) + DELTA*(ss_acc670(RH_num+1)- + . ss_acc670(RH_num)) !--m2/g + auxreal=0. + IF(id_fine>0) auxreal=auxreal+alpha_acc*tr_seri(i,k,id_fine) + IF(id_coss>0) auxreal=auxreal+ss_ssalt670(RH_num) + . *tr_seri(i,k,id_coss) + IF(id_codu>0) auxreal=auxreal+ss_dust(2)*tr_seri(i,k,id_codu) + IF(id_scdu>0) auxreal=auxreal+ss_dustsco(2)*tr_seri(i,k,id_scdu) + ztaue670(i)=ztaue670(i)+auxreal*zdz(i,k)*1.e6 + +!JE20150128 ztaue670(i)=ztaue670(i)+(alpha_acc*tr_seri(i,k,id_fine)+ +! . ss_ssalt670(RH_num)*tr_seri(i,k,id_coss)+ +! . ss_dust(2)*tr_seri(i,k,id_codu)+ +! . ss_dustsco(2)*tr_seri(i,k,id_scdu))*zdz(i,k)*1.e6 + + IF(id_fine>0) taue670_tr2(i)=taue670_tr2(i)+ + . alpha_acc*tr_seri(i,k,id_fine)* + . zdz(i,k)*1.e6 + IF(id_coss>0) taue670_ss(i)=taue670_ss(i)+ + . ss_ssalt670(RH_num)*tr_seri(i,k,id_coss)* + . zdz(i,k)*1.e6 + IF(id_codu>0) taue670_dust(i)=taue670_dust(i) + . +ss_dust(2)*tr_seri(i,k,id_codu)* + . zdz(i,k)*1.e6 + IF(id_scdu>0) taue670_dustsco(i)=taue670_dustsco(i)+ + . ss_dustsco(2)*tr_seri(i,k,id_scdu)* + . zdz(i,k)*1.e6 + +c******************************************************************* +c AOD at 865 NM +c******************************************************************* + alpha_acc=ss_acc865(RH_num) + DELTA*(ss_acc865(RH_num+1)- + . ss_acc865(RH_num)) !--m2/g + auxreal=0. + IF(id_fine>0) auxreal=auxreal+alpha_acc*tr_seri(i,k,id_fine) + IF(id_coss>0) auxreal=auxreal + . +ss_ssalt865(RH_num)*tr_seri(i,k,id_coss) + IF(id_codu>0) auxreal=auxreal+ss_dust(3)*tr_seri(i,k,id_codu) + IF(id_scdu>0) auxreal=auxreal+ss_dustsco(3)*tr_seri(i,k,id_scdu) + ztaue865(i)=ztaue865(i)+auxreal*zdz(i,k)*1.e6 +!JE20150128 ztaue865(i)=ztaue865(i)+(alpha_acc*tr_seri(i,k,id_fine)+ +! . ss_ssalt865(RH_num)*tr_seri(i,k,id_coss)+ +! . ss_dust(3)*tr_seri(i,k,id_codu)+ +! . ss_dustsco(3)*tr_seri(i,k,id_scdu))*zdz(i,k)*1.e6 + IF(id_fine>0) taue865_tr2(i)=taue865_tr2(i) + . +alpha_acc*tr_seri(i,k,id_fine)* + . zdz(i,k)*1.e6 + IF(id_coss>0) taue865_ss(i)=taue865_ss(i)+ + . ss_ssalt865(RH_num)*tr_seri(i,k,id_coss)* + . zdz(i,k)*1.e6 + IF(id_codu>0) taue865_dust(i)=taue865_dust(i) + . +ss_dust(3)*tr_seri(i,k,id_codu)* + . zdz(i,k)*1.e6 + IF(id_scdu>0) taue865_dustsco(i)=taue865_dustsco(i)+ + . ss_dustsco(3)*tr_seri(i,k,id_scdu)* + . zdz(i,k)*1.e6 + + +c + IF(id_coss>0) burden_ss(i)=burden_ss(i) + . +tr_seri(i,k,id_coss)*1.e6*1.e3*zdz(i,k) + ENDDO !-loop on klev + ENDDO !-loop on klon +! print *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)), +! . MAXVAL(tr_seri(:,:,3)) +! print *,'taue550_ss = ',SUM(taue550_ss),MINVAL(taue550_ss), +! . MAXVAL(taue550_ss) +c + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/bcscav_spl.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/bcscav_spl.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/bcscav_spl.F (revision 2630) @@ -0,0 +1,55 @@ + SUBROUTINE bcscav_spl(pdtime,flxr,flxs,alpha_r,alpha_s,x,dx) + + USE dimphy + IMPLICIT NONE +c===================================================================== +c Objet : below-cloud scavenging of tracers +c Date : september 1999 +c Auteur: O. Boucher (LOA) +c===================================================================== +c +#include "dimensions.h" +#include "chem.h" +#include "YOMCST.h" +#include "YOECUMF.h" +c + REAL pdtime, alpha_r, alpha_s, R_r, R_s + PARAMETER (R_r=0.001) !--mean raindrop radius (m) + PARAMETER (R_s=0.001) !--mean snow crystal radius (m) + REAL flxr(klon,klev) ! liquid precipitation rate (kg/m2/s) + REAL flxs(klon,klev) ! solid precipitation rate (kg/m2/s) + REAL flxr_aux(klon,klev+1) + REAL flxs_aux(klon,klev+1) + REAL x(klon,klev) ! q de traceur + REAL dx(klon,klev) ! tendance de traceur +c +c--variables locales + INTEGER i, k + REAL pr, ps, ice, water +c +c------------------------------------------ +c +! NHL +! Auxiliary variables defined to deal with the fact that precipitation +! fluxes are defined on klev levels only. +! NHL +! + flxr_aux(:,klev+1)=0.0 + flxs_aux(:,klev+1)=0.0 + flxr_aux(:,1:klev)=flxr(:,:) + flxs_aux(:,1:klev)=flxs(:,:) +! + DO k=1, klev + DO i=1, klon + pr=0.5*(flxr_aux(i,k)+flxr_aux(i,k+1)) + ps=0.5*(flxs_aux(i,k)+flxs_aux(i,k+1)) + water=pr*alpha_r/R_r/rho_water + ice=ps*alpha_s/R_s/rho_ice + dx(i,k)=-3./4.*x(i,k)*pdtime*(water+ice) +ctmp dx(i,k)=-3./4.*x(i,k)*pdtime* +ctmp . (pr*alpha_r/R_r/rho_water+ps*alpha_s/R_s/rho_ice) + ENDDO + ENDDO +c + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/bl_for_dms.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/bl_for_dms.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/bl_for_dms.F (revision 2630) @@ -0,0 +1,105 @@ + SUBROUTINE bl_for_dms(u,v,paprs,pplay,cdragh,cdragm + . ,t,q,tsol,ustar,obklen) + USE dimphy + IMPLICIT NONE +c +c=================================================================== +c Auteur : E. Cosme +c Calcul de la vitesse de friction (ustar) et de la longueur de +c Monin-Obukhov (obklen), necessaires pour calculer les flux de DMS +c par la methode de Nightingale. +c Cette subroutine est plus que fortement inspiree de la subroutine +c 'nonlocal' dans clmain.F . +c reference : Holtslag, A.A.M., and B.A. Boville, 1993: +c Local versus nonlocal boundary-layer diffusion in a global climate +c model. J. of Climate, vol. 6, 1825-1842. (a confirmer) +c 31 08 01 +c=================================================================== +c +#include "dimensions.h" +#include "YOMCST.h" +#include "YOETHF.h" +#include "FCTTRE.h" +c +c Arguments : + REAL u(klon,klev) ! vent zonal + REAL v(klon,klev) ! vent meridien + REAL paprs(klon,klev+1) ! niveaux de pression aux intercouches (Pa) + REAL pplay(klon,klev) ! niveaux de pression aux milieux... (Pa) + REAL cdragh(klon) ! coefficient de trainee pour la chaleur + REAL cdragm(klon) ! coefficient de trainee pour le vent + REAL t(klon,klev) ! temperature + REAL q(klon,klev) ! humidite kg/kg + REAL tsol(klon) ! temperature du sol + REAL ustar(klon) ! vitesse de friction + REAL obklen(klon) ! longueur de Monin-Obukhov +c +c Locales : + REAL vk + PARAMETER (vk=0.35) + REAL beta ! coefficient d'evaporation reelle (/evapotranspiration) + ! entre 0 et 1, mais 1 au-dessus de la mer + PARAMETER (beta=1.) + INTEGER i,k + REAL zxt, zxu, zxv, zxq, zxqs, zxmod, taux, tauy + REAL zcor, zdelta, zcvm5 + REAL z(klon,klev) + REAL zx_alf1, zx_alf2 ! parametres pour extrapolation + REAL khfs(klon) ! surface kinematic heat flux [mK/s] + REAL kqfs(klon) ! sfc kinematic constituent flux [m/s] + REAL heatv(klon) ! surface virtual heat flux + + +c +c====================================================================== +c +c Calculer les hauteurs de chaque couche +c +! JE20150707 r2es=611.14 *18.0153/28.9644 + DO i = 1, klon + z(i,1) = RD * t(i,1) / (0.5*(paprs(i,1)+pplay(i,1))) + . * (paprs(i,1)-pplay(i,1)) / RG + ENDDO + DO k = 2, klev + DO i = 1, klon + z(i,k) = z(i,k-1) + . + RD * 0.5*(t(i,k-1)+t(i,k)) / paprs(i,k) + . * (pplay(i,k-1)-pplay(i,k)) / RG + ENDDO + ENDDO + + DO i = 1, klon +c + zdelta=MAX(0.,SIGN(1.,RTT-tsol(i))) + zcvm5 = R5LES*RLVTT*(1.-zdelta) + R5IES*RLSTT*zdelta + zcvm5 = zcvm5 / RCPD / (1.0+RVTMP2*q(i,1)) + zxqs= r2es * FOEEW(tsol(i),zdelta)/paprs(i,1) + zxqs=MIN(0.5,zxqs) + zcor=1./(1.-retv*zxqs) + zxqs=zxqs*zcor +c + zx_alf1 = 1.0 + zx_alf2 = 1.0 - zx_alf1 + zxt = (t(i,1)+z(i,1)*RG/RCPD/(1.+RVTMP2*q(i,1))) + . *(1.+RETV*q(i,1))*zx_alf1 + . + (t(i,2)+z(i,2)*RG/RCPD/(1.+RVTMP2*q(i,2))) + . *(1.+RETV*q(i,2))*zx_alf2 + zxu = u(i,1)*zx_alf1+u(i,2)*zx_alf2 + zxv = v(i,1)*zx_alf1+v(i,2)*zx_alf2 + zxq = q(i,1)*zx_alf1+q(i,2)*zx_alf2 + zxmod = 1.0+SQRT(zxu**2+zxv**2) + khfs(i) = (tsol(i)*(1.+RETV*q(i,1))-zxt) *zxmod*cdragh(i) + kqfs(i) = (zxqs-zxq) *zxmod*cdragh(i) * beta + heatv(i) = khfs(i) + 0.61*zxt*kqfs(i) + taux = zxu *zxmod*cdragm(i) + tauy = zxv *zxmod*cdragm(i) + ustar(i) = SQRT(taux**2+tauy**2) + ustar(i) = MAX(SQRT(ustar(i)),0.01) +c + ENDDO +c + DO i = 1, klon + obklen(i) = -t(i,1)*ustar(i)**3/(RG*vk*heatv(i)) + ENDDO +c + END SUBROUTINE Index: /LMDZ5/trunk/libf/phylmd/Dust/blcloud_scav.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/blcloud_scav.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/blcloud_scav.F (revision 2630) @@ -0,0 +1,125 @@ +c Subroutine that calculates the effect of precipitation in scavenging +c BELOW the cloud, for large scale as well as convective precipitation + SUBROUTINE blcloud_scav(lminmax,qmin,qmax,pdtphys,prfl,psfl, + . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse, + . his_dhbclsc,his_dhbccon,tr_seri) + + USE dimphy + USE indice_sol_mod + USE infotrac + IMPLICIT NONE + +#include "dimensions.h" +#include "chem.h" +#include "YOMCST.h" +#include "paramet.h" + +c============================= INPUT =================================== + REAL qmin,qmax + REAL pdtphys ! pas d'integration pour la physique (seconde) +! REAL prfl(klon,klev), psfl(klon,klev) !--large-scale +! REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection + REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie + REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige + REAL masse(nbtr) + LOGICAL lminmax + REAL zdz(klon,klev) + REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale ! Titane + REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection ! Titane +c============================= OUTPUT ================================== + REAL tr_seri(klon,klev,nbtr) ! traceur + REAL aux_var1(klon,klev) ! traceur + REAL aux_var2(klon,klev) ! traceur + REAL his_dhbclsc(klon,nbtr), his_dhbccon(klon,nbtr) +c========================= LOCAL VARIABLES ============================= + INTEGER it, k, i, j + REAL d_tr(klon,klev,nbtr) + + EXTERNAL minmaxqfi, bcscav_spl + + DO it=1, nbtr +c + DO j=1,klev + DO i=1,klon + aux_var1(i,j)=tr_seri(i,j,it) + aux_var2(i,j)=d_tr(i,j,it) + ENDDO + ENDDO +c +cnhl CALL bcscav_spl(pdtphys,prfl,psfl,alpha_r(it),alpha_s(it), +cnhl . tr_seri(1,1,it),d_tr(1,1,it)) + CALL bcscav_spl(pdtphys,prfl,psfl,alpha_r(it),alpha_s(it), + . aux_var1,aux_var2) +c + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=aux_var1(i,j) + d_tr(i,j,it)=aux_var2(i,j) + ENDDO + ENDDO + DO k = 1, klev + DO i = 1, klon + tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr(i,k,it) + his_dhbclsc(i,it)=his_dhbclsc(i,it)-d_tr(i,k,it)/RNAVO* + . masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys !--mgS/m2/s + + ENDDO + ENDDO +c + DO i=1,klon + DO j=1,klev + aux_var1(i,j)=tr_seri(i,j,it) + aux_var2(i,j)=d_tr(i,j,it) + ENDDO + ENDDO +c + IF (lminmax) THEN + CALL minmaxqfi(aux_var1,qmin,qmax,'depot humide bc lsc') +cnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide bc lsc') + ENDIF +c +c-scheme for convective scavenging +c +cnhl CALL bcscav_spl(pdtphys,pmflxr,pmflxs,alpha_r(it),alpha_s(it), +cnhl . tr_seri(1,1,it),d_tr(1,1,it)) + + + CALL bcscav_spl(pdtphys,pmflxr,pmflxs,alpha_r(it),alpha_s(it), + . aux_var1,aux_var2) + + +c + DO i=1,klon + DO j=1,klev + tr_seri(i,j,it)=aux_var1(i,j) + d_tr(i,j,it)=aux_var2(i,j) + ENDDO + ENDDO +c + DO k = 1, klev + DO i = 1, klon + tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr(i,k,it) + his_dhbccon(i,it)=his_dhbccon(i,it)-d_tr(i,k,it)/RNAVO* + . masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys !--mgS/m2/s + ENDDO + ENDDO +c + IF (lminmax) THEN + DO j=1,klev + DO i=1,klon + aux_var1(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL minmaxqfi(aux_var1,qmin,qmax,'depot humide bc con') +cnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide bc con') + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=aux_var1(i,j) + ENDDO + ENDDO + ENDIF +c +c + ENDDO !--boucle sur it +c + END Index: /LMDZ5/trunk/libf/phylmd/Dust/blcloud_scav_lsc.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/blcloud_scav_lsc.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/blcloud_scav_lsc.F (revision 2630) @@ -0,0 +1,125 @@ +c Subroutine that calculates the effect of precipitation in scavenging +c BELOW the cloud, for large scale as well as convective precipitation + SUBROUTINE blcloud_scav_lsc(lminmax,qmin,qmax,pdtphys,prfl,psfl, + . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse, + . his_dhbclsc,his_dhbccon,tr_seri) + + USE dimphy + USE indice_sol_mod + USE infotrac + IMPLICIT NONE + +#include "dimensions.h" +#include "chem.h" +#include "YOMCST.h" +#include "paramet.h" + +c============================= INPUT =================================== + REAL qmin,qmax + REAL pdtphys ! pas d'integration pour la physique (seconde) +! REAL prfl(klon,klev), psfl(klon,klev) !--large-scale +! REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection + REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie + REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige + REAL masse(nbtr) + LOGICAL lminmax + REAL zdz(klon,klev) + REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale ! Titane + REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection ! Titane +c============================= OUTPUT ================================== + REAL tr_seri(klon,klev,nbtr) ! traceur + REAL aux_var1(klon,klev) ! traceur + REAL aux_var2(klon,klev) ! traceur + REAL his_dhbclsc(klon,nbtr), his_dhbccon(klon,nbtr) +c========================= LOCAL VARIABLES ============================= + INTEGER it, k, i, j + REAL d_tr(klon,klev,nbtr) + + EXTERNAL minmaxqfi, bcscav_spl + + DO it=1, nbtr +c + DO j=1,klev + DO i=1,klon + aux_var1(i,j)=tr_seri(i,j,it) + aux_var2(i,j)=d_tr(i,j,it) + ENDDO + ENDDO +c +cnhl CALL bcscav_spl(pdtphys,prfl,psfl,alpha_r(it),alpha_s(it), +cnhl . tr_seri(1,1,it),d_tr(1,1,it)) + CALL bcscav_spl(pdtphys,prfl,psfl,alpha_r(it),alpha_s(it), + . aux_var1,aux_var2) +c + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=aux_var1(i,j) + d_tr(i,j,it)=aux_var2(i,j) + ENDDO + ENDDO + DO k = 1, klev + DO i = 1, klon + tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr(i,k,it) + his_dhbclsc(i,it)=his_dhbclsc(i,it)-d_tr(i,k,it)/RNAVO* + . masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys !--mgS/m2/s + + ENDDO + ENDDO +c + DO i=1,klon + DO j=1,klev + aux_var1(i,j)=tr_seri(i,j,it) + aux_var2(i,j)=d_tr(i,j,it) + ENDDO + ENDDO +c + IF (lminmax) THEN + CALL minmaxqfi(aux_var1,qmin,qmax,'depot humide bc lsc') +cnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide bc lsc') + ENDIF +c +c-scheme for convective scavenging +c +cnhl CALL bcscav_spl(pdtphys,pmflxr,pmflxs,alpha_r(it),alpha_s(it), +cnhl . tr_seri(1,1,it),d_tr(1,1,it)) + + +cJE CALL bcscav_spl(pdtphys,pmflxr,pmflxs,alpha_r(it),alpha_s(it), +cJE . aux_var1,aux_var2) + + +c + DO i=1,klon + DO j=1,klev + tr_seri(i,j,it)=aux_var1(i,j) + d_tr(i,j,it)=aux_var2(i,j) + ENDDO + ENDDO +c + DO k = 1, klev + DO i = 1, klon + tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr(i,k,it) + his_dhbccon(i,it)=his_dhbccon(i,it)-d_tr(i,k,it)/RNAVO* + . masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys !--mgS/m2/s + ENDDO + ENDDO +c + IF (lminmax) THEN + DO j=1,klev + DO i=1,klon + aux_var1(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL minmaxqfi(aux_var1,qmin,qmax,'depot humide bc con') +cnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide bc con') + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=aux_var1(i,j) + ENDDO + ENDDO + ENDIF +c +c + ENDDO !--boucle sur it +c + END Index: /LMDZ5/trunk/libf/phylmd/Dust/checkmass.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/checkmass.F90 (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/checkmass.F90 (revision 2630) @@ -0,0 +1,59 @@ +SUBROUTINE checkmass(zq,RNAVOG,mass,zdz,pplay,t_seri,iscm3,comment) + USE dimphy +USE geometry_mod , ONLY:cell_area + IMPLICIT NONE + +#include "YOMCST.h" + +! Entrees + REAL,DIMENSION(klon,klev), INTENT(IN) :: zq + REAL,DIMENSION(klon,klev), INTENT(IN) :: zdz + REAL,INTENT(IN) :: mass + REAL,INTENT(IN) :: RNAVOG + CHARACTER(LEN=*),INTENT(IN) :: comment +REAL,DIMENSION(klon,klev) ,INTENT(IN) :: pplay +REAL,DIMENSION(klon,klev) ,INTENT(IN) :: t_seri +LOGICAL :: iscm3 + + +! Local +! INTEGER,DIMENSION(klon) :: jadrs + INTEGER :: i, k + REAL :: totmass + REAL,DIMENSION(klon) :: burden + REAL,DIMENSION(klon,klev) :: zqv + + +DO i=1, klon +burden(i)=0.0 + DO k=1, klev +zqv(i,k)=zq(i,k) + +ENDDO + +ENDDO + +totmass=0.0 + + +IF (iscm3) THEN + +ELSE + +CALL kg_to_cm3(pplay,t_seri,zqv) + +ENDIF + + DO k=1, klev + DO i=1, klon + burden(i)=burden(i)+(zqv(i,k)*1.e6*zdz(i,k)* & + mass*1.e3/RNAVOG) !--mg S/m2 + ENDDO + ENDDO + DO i=1, klon + totmass=totmass+burden(i)*cell_area(i) +ENDDO +WRITE(*,9999) comment," totmass= ",totmass +9999 format(a20,a10,e15.8) + +END SUBROUTINE checkmass Index: /LMDZ5/trunk/libf/phylmd/Dust/checknanqfi.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/checknanqfi.F90 (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/checknanqfi.F90 (revision 2630) @@ -0,0 +1,32 @@ +SUBROUTINE checknanqfi(zq,qmin,qmax,comment) + USE dimphy + IMPLICIT NONE + +! Entrees + REAL,DIMENSION(klon,klev), INTENT(IN) :: zq + REAL,INTENT(IN) :: qmin,qmax + CHARACTER(LEN=*),INTENT(IN) :: comment + +! Local + INTEGER,DIMENSION(klon) :: jadrs + INTEGER :: i, jbad, k + + DO k = 1, klev + jbad = 0 + DO i = 1, klon +! IF (zq(i,k).GT.qmax .OR. zq(i,k).LT.qmin) THEN + IF (isnan(zq(i,k))) THEN + jbad = jbad + 1 + jadrs(jbad) = i + ENDIF + ENDDO + IF (jbad.GT.0) THEN + WRITE(*,*)comment + DO i = 1, jbad + WRITE(*,*) "i,k,q=", jadrs(i),k,zq(jadrs(i),k) + CALL abort_gcm(comment, 'NaN founded',1) + ENDDO + ENDIF + ENDDO + +END SUBROUTINE checknanqfi Index: /LMDZ5/trunk/libf/phylmd/Dust/chem_spla.h =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/chem_spla.h (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/chem_spla.h (revision 2630) @@ -0,0 +1,14 @@ +! +! $Header$ +! + + INTEGER ss_bins + PARAMETER (ss_bins=2) + +! INTEGER nbreg_dust,nbreg_ind, nbreg_bb +! PARAMETER (nbreg_dust=11,nbreg_ind=13,nbreg_bb=15) + + REAL masse_ammsulfate + PARAMETER (masse_ammsulfate=132.0) !--g mol-1 + + Index: /LMDZ5/trunk/libf/phylmd/Dust/cltrac_spl.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/cltrac_spl.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/cltrac_spl.F (revision 2630) @@ -0,0 +1,137 @@ + SUBROUTINE cltrac_spl(dtime,coef,yu1,yv1,t,tr, + . flux,paprs,pplay,d_tr) + + USE dimphy + IMPLICIT none +c====================================================================== +c Auteur(s): O. Boucher (LOA/LMD) date: 19961127 +c inspire de clvent +c Objet: diffusion verticale de traceurs avec flux fixe a la surface +c ou/et flux du type c-drag +c====================================================================== +c Arguments: +c dtime----input-R- intervalle du temps (en second) +c coef-----input-R- le coefficient d'echange (m**2/s) l>1 +c yu1------input-R- le vent dans le 1iere couche +c yv1------input-R- le vent dans le 1iere couche +c t--------input-R- temperature (K) +c tr-------input-R- la q. de traceurs +c flux-----input-R- le flux de traceurs a la surface +c paprs----input-R- pression a inter-couche (Pa) +c pplay----input-R- pression au milieu de couche (Pa) +c delp-----input-R- epaisseur de couche (Pa) +c cdrag----input-R- cdrag pour le flux de surface (non active) +c tr0------input-R- traceurs a la surface ou dans l'ocean (non active) +c d_tr-----output-R- le changement de tr +c flux_tr--output-R- flux de tr +c====================================================================== +#include "dimensions.h" + REAL dtime + REAL coef(klon,klev) + REAL yu1(klon), yv1(klon) + REAL t(klon,klev), tr(klon,klev) + REAL paprs(klon,klev+1), pplay(klon,klev), delp(klon,klev) + REAL d_tr(klon,klev) + REAL flux(klon), cdrag(klon), tr0(klon) +c REAL flux_tr(klon,klev) +c====================================================================== +#include "YOMCST.h" +c====================================================================== + INTEGER i, k + REAL zx_ctr(klon,2:klev) + REAL zx_dtr(klon,2:klev) + REAL zx_buf(klon) + REAL zx_coef(klon,klev) + REAL local_tr(klon,klev) + REAL zx_alf1(klon), zx_alf2(klon), zx_flux(klon) +c====================================================================== +c CHECKING VALUES +! print *,'CHECKING VALUES IN CLTRAC (INI)' +! print *,'d_tr = ',sum(d_tr),MINVAL(d_tr),MAXVAL(d_tr) +! print *,'flux = ',sum(flux),MINVAL(flux),MAXVAL(flux) +! print *,'tr = ',sum(tr),MINVAL(tr),MAXVAL(tr) +c====================================================================== + DO k = 1, klev + DO i = 1, klon + local_tr(i,k) = tr(i,k) + delp(i,k) = paprs(i,k)-paprs(i,k+1) + ENDDO + ENDDO +c====================================================================== + DO i = 1, klon + zx_alf1(i) = (paprs(i,1)-pplay(i,2))/(pplay(i,1)-pplay(i,2)) + zx_alf2(i) = 1.0 - zx_alf1(i) + zx_flux(i) = -flux(i)*dtime*RG +c--pour le moment le flux est prescrit + cdrag(i) = 0.0 +c cdrag(i) = coef(i,1) * (1.0+SQRT(yu1(i)**2+yv1(i)**2)) +c . * pplay(i,1)/(RD*t(i,1)) + tr0(i) = 0.0 + zx_coef(i,1) = cdrag(i)*dtime*RG + ENDDO +c====================================================================== + DO k = 2, klev + DO i = 1, klon + zx_coef(i,k) = coef(i,k)*RG/(pplay(i,k-1)-pplay(i,k)) + . *(paprs(i,k)*2/(t(i,k)+t(i,k-1))/RD)**2 + zx_coef(i,k) = zx_coef(i,k)*dtime*RG + ENDDO + ENDDO +c====================================================================== + DO i = 1, klon + zx_buf(i) = delp(i,1) + zx_coef(i,1)*zx_alf1(i) + zx_coef(i,2) + zx_ctr(i,2) = (local_tr(i,1)*delp(i,1)+ + . zx_coef(i,1)*tr0(i)-zx_flux(i))/zx_buf(i) + zx_dtr(i,2) = (zx_coef(i,2)-zx_alf2(i)*zx_coef(i,1)) / + . zx_buf(i) + ENDDO +c + DO k = 3, klev + DO i = 1, klon + zx_buf(i) = delp(i,k-1) + zx_coef(i,k) + . + zx_coef(i,k-1)*(1.-zx_dtr(i,k-1)) + zx_ctr(i,k) = (local_tr(i,k-1)*delp(i,k-1) + . +zx_coef(i,k-1)*zx_ctr(i,k-1) )/zx_buf(i) + zx_dtr(i,k) = zx_coef(i,k)/zx_buf(i) + ENDDO + ENDDO + DO i = 1, klon + local_tr(i,klev) = ( local_tr(i,klev)*delp(i,klev) + . +zx_coef(i,klev)*zx_ctr(i,klev) ) + . / ( delp(i,klev) + zx_coef(i,klev) + . -zx_coef(i,klev)*zx_dtr(i,klev) ) + ENDDO + DO k = klev-1, 1, -1 + DO i = 1, klon + local_tr(i,k) = zx_ctr(i,k+1) + zx_dtr(i,k+1)*local_tr(i,k+1) + ENDDO + ENDDO +c====================================================================== +! print *,'CHECKING VALUES IN CLTRAC (FIN)' +! print *,'local_tr = ',sum(local_tr),MINVAL(local_tr), +! . MAXVAL(local_tr) +! print *,'zx_ctr = ',sum(zx_ctr),MINVAL(zx_ctr),MAXVAL(zx_ctr) +! print *,'zx_dtr = ',sum(zx_dtr),MINVAL(zx_dtr),MAXVAL(zx_dtr) +! print *,'tr = ',sum(tr),MINVAL(tr),MAXVAL(tr) +c====================================================================== +c== flux_tr est le flux de traceur (positif vers bas) +c DO i = 1, klon +c flux_tr(i,1) = zx_coef(i,1)/(RG*dtime) +c ENDDO +c DO k = 2, klev +c DO i = 1, klon +c flux_tr(i,k) = zx_coef(i,k)/(RG*dtime) +c . * (local_tr(i,k)-local_tr(i,k-1)) +c ENDDO +c ENDDO +c====================================================================== + DO k = 1, klev + DO i = 1, klon + d_tr(i,k) = local_tr(i,k) - tr(i,k) + ENDDO + ENDDO +! print *,'CHECKING VALUES IN CLTRAC (END)' +! print *,'d_tr = ',sum(d_tr),MINVAL(d_tr),MAXVAL(d_tr) +c + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/cm3_to_kg.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/cm3_to_kg.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/cm3_to_kg.F (revision 2630) @@ -0,0 +1,25 @@ + SUBROUTINE cm3_to_kg(pplay,t_seri,tr_seri) + + USE dimphy + USE infotrac + USE indice_sol_mod + + IMPLICIT NONE +c +#include "dimensions.h" +#include "YOMCST.h" +c + REAL t_seri(klon,klev), pplay(klon,klev) + REAL tr_seri(klon,klev) + REAL zrho + INTEGER i, k +c +!JE20150707 RD = 1000.0 * 1.380658E-23 * 6.0221367E+23 / 28.9644 + DO k = 1, klev + DO i = 1, klon + zrho=pplay(i,k)/t_seri(i,k)/RD + tr_seri(i,k)=tr_seri(i,k)*1.e6/zrho + ENDDO + ENDDO +c + END Index: /LMDZ5/trunk/libf/phylmd/Dust/coarsemission.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/coarsemission.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/coarsemission.F (revision 2630) @@ -0,0 +1,313 @@ +c This subroutine calculates the emissions of SEA SALT and DUST, part of +C which goes to tracer 2 and other part to tracer 3. + SUBROUTINE coarsemission(pctsrf,pdtphys, + . t_seri,pmflxr,pmflxs,prfl,psfl, + . xlat,xlon,debutphy, + . zu10m,zv10m,wstar,ale_bl,ale_wake, + . scale_param_ssacc,scale_param_sscoa, + . scale_param_dustacc,scale_param_dustcoa, + . scale_param_dustsco, + . nbreg_dust, + . iregion_dust,dust_ec, + . param_wstarBLperregion,param_wstarWAKEperregion, + . nbreg_wstardust, + . iregion_wstardust, + . lmt_sea_salt,qmin,qmax, + . flux_sparam_ddfine,flux_sparam_ddcoa, + . flux_sparam_ddsco, + . flux_sparam_ssfine,flux_sparam_sscoa, + . id_prec,id_fine,id_coss,id_codu,id_scdu, + . ok_chimeredust, + . source_tr,flux_tr) +! . wth,cly,zprecipinsoil,lmt_sea_salt, + +! CALL dustemission( debutphy, xlat, xlon, pctsrf, +! . zu10m zv10m,wstar,ale_bl,ale_wake) +! + + USE dimphy + USE indice_sol_mod + USE infotrac + USE dustemission_mod, ONLY : dustemission +! USE phytracr_spl_mod, ONLY : nbreg_dust, nbreg_ind, nbreg_bb + IMPLICIT NONE + +#include "dimensions.h" +#include "chem.h" +#include "chem_spla.h" +#include "YOMCST.h" +#include "paramet.h" + +c============================== INPUT ================================== + INTEGER nbjour + LOGICAL ok_chimeredust + REAL pdtphys ! pas d'integration pour la physique (seconde) + REAL t_seri(klon,klev) ! temperature + REAL pctsrf(klon,nbsrf) + REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection +! REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection + REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale +! REAL prfl(klon,klev), psfl(klon,klev) !--large-scale + LOGICAL debutphy, lafinphy + REAL, intent(in) :: xlat(klon) ! latitudes pour chaque point + REAL, intent(in) :: xlon(klon) ! longitudes pour chaque point + REAL,DIMENSION(klon),INTENT(IN) :: zu10m + REAL,DIMENSION(klon),INTENT(IN) :: zv10m + REAL,DIMENSION(klon),INTENT(IN) :: wstar,Ale_bl,ale_wake + +c +c------------------------- Scaling Parameters -------------------------- +c + INTEGER iregion_dust(klon) !Defines dust regions + REAL scale_param_ssacc !Scaling parameter for Fine Sea Salt + REAL scale_param_sscoa !Scaling parameter for Coarse Sea Salt + REAL scale_param_dustacc(nbreg_dust) !Scaling parameter for Fine Dust + REAL scale_param_dustcoa(nbreg_dust) !Scaling parameter for Coarse Dust + REAL scale_param_dustsco(nbreg_dust) !Scaling parameter for SCoarse Dust +!JE20141124<< + INTEGER iregion_wstardust(klon) !Defines dust regions in terms of wstar + REAL param_wstarBLperregion(nbreg_wstardust) ! + REAL param_wstarWAKEperregion(nbreg_wstardust) ! + REAL param_wstarBL(klon) !parameter for surface wind correction.. + REAL param_wstarWAKE(klon) !parameter for surface wind correction.. + INTEGER nbreg_wstardust +!JE20141124>> + INTEGER nbreg_dust + INTEGER, INTENT(IN) :: id_prec,id_fine,id_coss,id_codu,id_scdu +c============================== OUTPUT ================================= + REAL source_tr(klon,nbtr) + REAL flux_tr(klon,nbtr) + REAL flux_sparam_ddfine(klon), flux_sparam_ddcoa(klon) + REAL flux_sparam_ddsco(klon) + REAL flux_sparam_ssfine(klon), flux_sparam_sscoa(klon) +c=========================== LOCAL VARIABLES =========================== + INTEGER i, j + REAL pct_ocean(klon) +! REAL zprecipinsoil(klon) +! REAL cly(klon), wth(klon) + REAL clyfac, avgdryrate, drying + +c---------------------------- SEA SALT emissions ------------------------ + REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um +c +c--------vent 10 m CEPMMT +c + REAL dust_ec(klon) + + real tmp_var2(klon,nbtr) ! auxiliary variable to replace source + REAL qmin, qmax +!----------------------DUST Sahara --------------- + REAL, DIMENSION(klon) :: dustsourceacc,dustsourcecoa,dustsourcesco + INTEGER, DIMENSION(klon) :: maskd +C*********************** DUST EMMISSIONS ******************************* +c + +! avgdryrate=300./365.*pdtphys/86400. +c +! DO i=1, klon +c +! IF (cly(i).LT.9990..AND.wth(i).LT.9990.) THEN +! zprecipinsoil(i)=zprecipinsoil(i) + +! . (pmflxr(i,1)+pmflxs(i,1)+prfl(i,1)+psfl(i,1))*pdtphys +c +! clyfac=MIN(16., cly(i)*0.4+8.) ![mm] max amount of water hold in top soil +! drying=avgdryrate*exp(0.03905491* +! . exp(0.17446*(t_seri(i,1)-273.15))) ! [mm] +! zprecipinsoil(i)=min(max(0.,zprecipinsoil(i)-drying),clyfac) ! [mm] +c +! ENDIF +c +! ENDDO +c +c ==================== CALCULATING DUST EMISSIONS ====================== +c +! IF (lminmax) THEN + DO j=1,nbtr + DO i=1,klon + tmp_var2(i,j)=source_tr(i,j) + ENDDO + ENDDO + CALL minmaxsource(tmp_var2,qmin,qmax,'src: before DD emiss') +! print *,'Source = ',SUM(source_tr),MINVAL(source_tr), +! . MAXVAL(source_tr) +! ENDIF + +c + IF (.NOT. ok_chimeredust) THEN + DO i=1, klon +!! IF (cly(i).GE.9990..OR.wth(i).GE.9990..OR. +!! . t_seri(i,1).LE.273.15.OR.zprecipinsoil(i).GT.1.e-8) THEN +!! dust_ec(i)=0.0 +!! ENDIF +!c Corresponds to dust_emission.EQ.3 +!!!!!!!****************AQUIIIIIIIIIIIIIIIIIIIIIIIIIIII +!! Original line (4 tracers) +!JE<< old 4 tracer(nhl scheme) source_tr(i,id_fine)=scale_param_dustacc(iregion_dust(i))* +! . dust_ec(i)*1.e3*0.093 ! g/m2/s +! source_tr(i,id_codu)=scale_param_dustcoa(iregion_dust(i))* +! . dust_ec(i)*1.e3*0.905 ! g/m2/s bin 0.5-10um +!! Original line (4 tracers) +! flux_tr(i,id_fine)=scale_param_dustacc(iregion_dust(i))* +! . dust_ec(i)*1.e3*0.093*1.e3 !mg/m2/s +! flux_tr(i,id_codu)=scale_param_dustcoa(iregion_dust(i))* +! . dust_ec(i)*1.e3*0.905*1.e3 !mg/m2/s bin 0.5-10um +! flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) * +! . dust_ec(i)*1.e3*0.093*1.e3 +! flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) * +! . dust_ec(i)*1.e3*0.905*1.e3 + IF(id_fine>0) source_tr(i,id_fine)= + . scale_param_dustacc(iregion_dust(i))* + . dust_ec(i)*1.e3*0.093 ! g/m2/s + IF(id_codu>0) source_tr(i,id_codu)= + . scale_param_dustcoa(iregion_dust(i))* + . dust_ec(i)*1.e3*0.905 ! g/m2/s bin 0.5-10um + IF(id_scdu>0) source_tr(i,id_scdu)=0. ! no supercoarse +! Original line (4 tracers) + IF(id_fine>0) flux_tr(i,id_fine)= + . scale_param_dustacc(iregion_dust(i))* + . dust_ec(i)*1.e3*0.093*1.e3 !mg/m2/s + IF(id_codu>0) flux_tr(i,id_codu)= + . scale_param_dustcoa(iregion_dust(i))* + . dust_ec(i)*1.e3*0.905*1.e3 !mg/m2/s bin 0.5-10um + IF(id_scdu>0) flux_tr(i,id_scdu)=0. + + flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) * + . dust_ec(i)*1.e3*0.093*1.e3 + flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) * + . dust_ec(i)*1.e3*0.905*1.e3 + flux_sparam_ddsco(i)=0. + ENDDO + ENDIF +!*****************NEW CHIMERE DUST EMISSION Sahara***** +! je 20140522 + IF(ok_chimeredust) THEN + print *,'MIX- NEW SAHARA DUST SOURCE SCHEME...' + + DO i=1,klon + param_wstarBL(i) =param_wstarBLperregion(iregion_wstardust(i)) + param_wstarWAKE(i)=param_wstarWAKEperregion(iregion_wstardust(i)) + ENDDO + + + CALL dustemission( debutphy, xlat, xlon, pctsrf, + . zu10m,zv10m,wstar,ale_bl,ale_wake, + . param_wstarBL, param_wstarWAKE, + . dustsourceacc,dustsourcecoa, + . dustsourcesco,maskd) + + DO i=1,klon + if (maskd(i).gt.0) then + IF(id_fine>0) source_tr(i,id_fine)= + . scale_param_dustacc(iregion_dust(i))* + . dustsourceacc(i)*1.e3 ! g/m2/s bin 0.03-0.5 + IF(id_codu>0) source_tr(i,id_codu)= + . scale_param_dustcoa(iregion_dust(i))* + . dustsourcecoa(i)*1.e3 ! g/m2/s bin 0.5-3um + IF(id_scdu>0) source_tr(i,id_scdu)= + . scale_param_dustsco(iregion_dust(i))* + . dustsourcesco(i)*1.e3 ! g/m2/s bin 3-15um +! Original line (4 tracers) + IF(id_fine>0) flux_tr(i,id_fine)= + . scale_param_dustacc(iregion_dust(i))* + . dustsourceacc(i)*1.e3*1.e3 !mg/m2/s + IF(id_codu>0) flux_tr(i,id_codu)= + . scale_param_dustcoa(iregion_dust(i))* + . dustsourcecoa(i)*1.e3*1.e3 !mg/m2/s bin 0.5-3um + IF(id_scdu>0) flux_tr(i,id_scdu)= + . scale_param_dustsco(iregion_dust(i))* + . dustsourcesco(i)*1.e3*1.e3 !mg/m2/s bin 3-15um + flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) * + . dustsourceacc(i)*1.e3*1.e3 + flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) * + . dustsourcecoa(i)*1.e3*1.e3 + flux_sparam_ddsco(i)=scale_param_dustsco(iregion_dust(i)) * + . dustsourcesco(i)*1.e3*1.e3 + else + IF(id_fine>0) source_tr(i,id_fine)= + . scale_param_dustacc(iregion_dust(i))* + . dust_ec(i)*1.e3*0.114 ! g/m2/s + IF(id_codu>0) source_tr(i,id_codu)= + . scale_param_dustcoa(iregion_dust(i))* + . dust_ec(i)*1.e3*0.108 ! g/m2/s bin 0.5-3um + IF(id_scdu>0) source_tr(i,id_scdu)= + . scale_param_dustsco(iregion_dust(i))* + . dust_ec(i)*1.e3*0.778 ! g/m2/s bin 3-15um +! Original line (4 tracers) + IF(id_fine>0) flux_tr(i,id_fine)= + . scale_param_dustacc(iregion_dust(i))* + . dust_ec(i)*1.e3*0.114*1.e3 !mg/m2/s + IF(id_codu>0) flux_tr(i,id_codu)= + . scale_param_dustcoa(iregion_dust(i))* + . dust_ec(i)*1.e3*0.108*1.e3 !mg/m2/s bin 0.5-3um + IF(id_scdu>0) flux_tr(i,id_scdu)= + . scale_param_dustsco(iregion_dust(i))* + . dust_ec(i)*1.e3*0.778*1.e3 !mg/m2/s bin 0.5-3um + + flux_sparam_ddfine(i)=scale_param_dustacc(iregion_dust(i)) * + . dust_ec(i)*1.e3*0.114*1.e3 + flux_sparam_ddcoa(i)=scale_param_dustcoa(iregion_dust(i)) * + . dust_ec(i)*1.e3*0.108*1.e3 + flux_sparam_ddsco(i)=scale_param_dustsco(iregion_dust(i)) * + . dust_ec(i)*1.e3*0.778*1.e3 + + endif + ENDDO + + + + + + ENDIF +!***************************************************** +C******************* SEA SALT EMMISSIONS ******************************* + DO i=1,klon + pct_ocean(i)=pctsrf(i,is_oce) + ENDDO +c +! IF (lminmax) THEN + DO j=1,nbtr + DO i=1,klon + tmp_var2(i,j)=source_tr(i,j) + ENDDO + ENDDO + CALL minmaxsource(tmp_var2,qmin,qmax,'src: before SS emiss') + IF(id_coss>0) then + print *,'Source = ',SUM(source_tr(:,id_coss)), + . MINVAL(source_tr(:,id_coss)), MAXVAL(source_tr(:,id_coss)) + ENDIF +! + DO i=1,klon +! Original line (4 tracers) + IF(id_fine>0) source_tr(i,id_fine)= + . source_tr(i,id_fine)+scale_param_ssacc* + . lmt_sea_salt(i,1)*1.e4 !g/m2/s + +! Original line (4 tracers) + IF(id_fine>0) flux_tr(i,id_fine)= + . flux_tr(i,id_fine)+scale_param_ssacc + . *lmt_sea_salt(i,1)*1.e4*1.e3 !mg/m2/s +! + IF(id_coss>0) source_tr(i,id_coss)= + . scale_param_sscoa*lmt_sea_salt(i,2)*1.e4 !g/m2/s + IF(id_coss>0) flux_tr(i,id_coss)= + . scale_param_sscoa*lmt_sea_salt(i,2)*1.e4*1.e3 !mg/m2/s +c + flux_sparam_ssfine(i)=scale_param_ssacc * + . lmt_sea_salt(i,1)*1.e4*1.e3 + flux_sparam_sscoa(i)=scale_param_sscoa * + . lmt_sea_salt(i,2)*1.e4*1.e3 + ENDDO +! IF (lminmax) THEN + DO j=1,nbtr + DO i=1,klon + tmp_var2(i,j)=source_tr(i,j) + ENDDO + ENDDO + CALL minmaxsource(tmp_var2,qmin,qmax,'src: after SS emiss') + IF(id_coss>0) then + print *,'Source = ',SUM(source_tr(:,id_coss)), + . MINVAL(source_tr(:,id_coss)), MAXVAL(source_tr(:,id_coss)) + ENDIF +c + + END Index: /LMDZ5/trunk/libf/phylmd/Dust/condsurfc.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/condsurfc.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/condsurfc.F (revision 2630) @@ -0,0 +1,149 @@ + SUBROUTINE condsurfc(jour,lmt_bcff,lmt_bcbb, + . lmt_bcbbl,lmt_bcbbh,lmt_bc_penner, + . lmt_omff,lmt_ombb,lmt_ombbl,lmt_ombbh, + . lmt_omnat) + USE dimphy + IMPLICIT none +! +! Lire les conditions aux limites du modele pour la chimie. +! -------------------------------------------------------- +! +#include "dimensions.h" +#include "netcdf.inc" + REAL lmt_bcff(klon), lmt_bcbb(klon),lmt_bc_penner(klon) + REAL lmt_omff(klon), lmt_ombb(klon) + REAL lmt_bcbbl(klon), lmt_bcbbh(klon) + REAL lmt_ombbl(klon), lmt_ombbh(klon) + REAL lmt_omnat(klon) + REAL lmt_terp(klon) +! + INTEGER jour, i + INTEGER ierr + INTEGER nid1,nvarid + INTEGER debut(2),epais(2) +! + IF (jour.LT.0 .OR. jour.GT.(360-1)) THEN + IF (jour.GT.(360-1).AND.jour.LE.367) THEN + jour=360-1 + print *,'JE: jour changed to jour= ',jour + ELSE + PRINT*,'Le jour demande n est pas correcte:', jour + CALL ABORT + ENDIF + ENDIF +! + ierr = NF_OPEN ("limitcarbon.nc", NF_NOWRITE, nid1) + if (ierr.ne.NF_NOERR) then + write(6,*)' Pb d''ouverture du fichier limitbc.nc' + write(6,*)' ierr = ', ierr + call exit(1) + endif +! +! Tranche a lire: + debut(1) = 1 + debut(2) = jour+1 + epais(1) = klon + epais(2) = 1 +! +! + ierr = NF_INQ_VARID (nid1, "BCFF", nvarid) +!nhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcff) +! print *,'IERR = ',ierr +! print *,'NF_NOERR = ',NF_NOERR +! print *,'debut = ',debut +! print *,'epais = ',epais +!nhl #else +!nhl ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcff) +!nhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources BC' + CALL exit(1) + ENDIF +! +! + ierr = NF_INQ_VARID (nid1, "BCBB", nvarid) +!nhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcbb) +!nhl #else +!nhl ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcbb) +!nhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources BC-biomass' + CALL exit(1) + ENDIF +! +! + ierr = NF_INQ_VARID (nid1, "BCBL", nvarid) +!nhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcbbl) +!nhl #else +!nhl ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcbbl) +!nhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources BC low' + CALL exit(1) + ENDIF +! +! + ierr = NF_INQ_VARID (nid1, "BCBH", nvarid) +!nhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_bcbbh) +!nhl #else +!nhl ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_bcbbh) +!nhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources BC high' + CALL exit(1) + ENDIF +! + ierr = NF_INQ_VARID (nid1, "TERP", nvarid) +!nhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_terp) +!nhl #else +!nhl ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_terp) +!nhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources Terpene' + CALL exit(1) + ENDIF +! +! + ierr = NF_INQ_VARID (nid1, "BC_penner", nvarid) +!nhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, + . epais, lmt_bc_penner) +!nhl #else +!nhl ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, +!nhl . lmt_bc_penner) +!nhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources BC Penner' + CALL exit(1) + ENDIF +! +! + ierr = NF_INQ_VARID (nid1, "OMFF", nvarid) +!nhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, lmt_omff) +!nhl #else +!nhl ierr = NF_GET_VARA_REAL (nid1, nvarid, debut, epais, lmt_omff) +!nhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources om-ifossil' + CALL exit(1) + ENDIF +! + DO i=1,klon + lmt_ombb(i) = lmt_bcbb(i)*7.0*1.6 !OC/BC=7.0;OM/OC=1.6 + lmt_ombbl(i) = lmt_bcbbl(i)*7.0*1.6 + lmt_ombbh(i) = lmt_bcbbh(i)*7.0*1.6 + lmt_omff(i) = lmt_omff(i)*1.4 !--OM/OC=1.4 + lmt_omnat(i) = lmt_terp(i)*0.11*1.4 !-- 11% Terpene is OC + ENDDO +! + ierr = NF_CLOSE(nid1) + PRINT*, 'Carbon sources lues pour jour: ', jour +! + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/condsurfc_new.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/condsurfc_new.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/condsurfc_new.F (revision 2630) @@ -0,0 +1,225 @@ + SUBROUTINE condsurfc_new(jour,lmt_bcff, lmt_bcnff, + . lmt_bcbbl,lmt_bcbbh, lmt_bcba, + . lmt_omff,lmt_omnff,lmt_ombbl,lmt_ombbh, + . lmt_omnat, lmt_omba) + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + USE dimphy + IMPLICIT none +c +c Lire les conditions aux limites du modele pour la chimie. +c -------------------------------------------------------- +c +#include "dimensions.h" +#include "netcdf.inc" + REAL lmt_bcff(klon), lmt_bcnff(klon), lmt_bcba(klon) + REAL lmt_omff(klon), lmt_omnff(klon), lmt_ombb(klon) + REAL lmt_bcbbl(klon), lmt_bcbbh(klon) + REAL lmt_ombbl(klon), lmt_ombbh(klon) + REAL lmt_omnat(klon), lmt_omba(klon) + REAL lmt_terp(klon) +c + REAL lmt_bcff_glo(klon_glo), lmt_bcnff_glo(klon_glo) + REAL lmt_bcba_glo(klon_glo) + REAL lmt_omff_glo(klon_glo), lmt_omnff_glo(klon_glo) + REAL lmt_ombb_glo(klon_glo) + REAL lmt_bcbbl_glo(klon_glo), lmt_bcbbh_glo(klon_glo) + REAL lmt_ombbl_glo(klon_glo), lmt_ombbh_glo(klon_glo) + REAL lmt_omnat_glo(klon_glo), lmt_omba_glo(klon_glo) + REAL lmt_terp_glo(klon_glo) +! + INTEGER jour, i + INTEGER ierr + INTEGER nid1,nvarid + INTEGER debut(2),epais(2) +c +! IF (jour.LT.0 .OR. jour.GT.(366-1)) THEN + IF (jour.LT.0 .OR. jour.GT.366) THEN + PRINT*,'Le jour demande n est pas correcte:', jour + print *,'JE: FORCED TO CONTINUE (emissions have + . to be longer than 1 year!!!! )' +!JE CALL ABORT + ENDIF + +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN +! +! Tranche a lire: + debut(1) = 1 + debut(2) = jour + epais(1) = klon_glo +! epais(1) = klon + epais(2) = 1 +! +!======================================================================= +! BC EMISSIONS +!======================================================================= +! + ierr = NF_OPEN ("carbon_emissions.nc", NF_NOWRITE, nid1) + if (ierr.ne.NF_NOERR) then + write(6,*)' Pb d''ouverture du fichier limitbc.nc' + write(6,*)' ierr = ', ierr + call exit(1) + endif +! +! BC emissions from fossil fuel combustion +! + ierr = NF_INQ_VARID (nid1, "BCFF", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_bcff_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources BC' + CALL exit(1) + ENDIF + !print *,'lmt_bcff = ',lmt_bcff + !stop +! +! BC emissions from non fossil fuel combustion +! + ierr = NF_INQ_VARID (nid1, "BCNFF", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_bcnff_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources BC' + CALL exit(1) + ENDIF +! +! Low BC emissions from biomass burning +! + ierr = NF_INQ_VARID (nid1, "BCBBL", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_bcbbl_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources BC low' + CALL exit(1) + ENDIF +! +! High BC emissions from biomass burning +! + ierr = NF_INQ_VARID (nid1, "BCBBH", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_bcbbh_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources BC high' + CALL exit(1) + ENDIF +! +! BC emissions from ship transport +! + ierr = NF_INQ_VARID (nid1, "BCBA", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_bcba_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources BC' + CALL exit(1) + ENDIF +! +!======================================================================= +! OM EMISSIONS +!======================================================================= +! + +! +! OM emissions from fossil fuel combustion +! + ierr = NF_INQ_VARID (nid1, "OMFF", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_omff_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources OM' + CALL exit(1) + ENDIF +! +! OM emissions from non fossil fuel combustion +! + ierr = NF_INQ_VARID (nid1, "OMNFF", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_omnff_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources OM' + CALL exit(1) + ENDIF +! +! Low OM emissions from biomass burning - low +! + ierr = NF_INQ_VARID (nid1, "OMBBL", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_ombbl_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources OM low' + CALL exit(1) + ENDIF +! +! High OM emissions from biomass burning - high +! + ierr = NF_INQ_VARID (nid1, "OMBBH", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_ombbh_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources OM high' + CALL exit(1) + ENDIF +! +! High OM emissions from ship +! + ierr = NF_INQ_VARID (nid1, "OMBA", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_omba_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources OM ship' + CALL exit(1) + ENDIF +! +! Natural Terpene emissions => Natural OM emissions +! + ierr = NF_INQ_VARID (nid1, "TERP", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid1, nvarid, debut, epais, + . lmt_terp_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources Terpene' + CALL exit(1) + ENDIF +! + DO i=1,klon_glo + lmt_omnat_glo(i) = lmt_terp_glo(i)*0.11*1.4 !-- 11% Terpene is OC + ENDDO + + ierr = NF_CLOSE(nid1) +! + PRINT*, 'Carbon sources lues pour jour: ', jour +! lmt_bcff(klon)=0.0 +! lmt_bcnff(klon)=0.0 +! lmt_omff(klon)=0.0 +! lmt_omnff(klon)=0.0 +! lmt_ombb(klon)=0.0 +! lmt_bcbbl(klon)=0.0 +! lmt_bcbbh(klon)=0.0 +! lmt_ombbl(klon)=0.0 +! lmt_ombbh(klon)=0.0 +! lmt_omnat(klon)=0.0 +! lmt_omba(klon)=0.0 +! lmt_terp(klon)=0.0 + + + ENDIF +!$OMP END MASTER +!$OMP BARRIER + call scatter( lmt_bcff_glo , lmt_bcff ) + call scatter( lmt_bcnff_glo , lmt_bcnff ) + call scatter( lmt_bcbbl_glo , lmt_bcbbl ) + call scatter( lmt_bcbbh_glo , lmt_bcbbh ) + call scatter( lmt_bcba_glo , lmt_bcba ) + call scatter( lmt_omff_glo , lmt_omff ) + call scatter( lmt_omnff_glo , lmt_omnff ) + call scatter( lmt_ombbl_glo , lmt_ombbl ) + call scatter( lmt_ombbh_glo , lmt_ombbh ) + call scatter( lmt_omba_glo , lmt_omba ) + call scatter( lmt_terp_glo , lmt_terp ) + call scatter( lmt_omnat_glo , lmt_omnat ) + + + + + + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/condsurfs.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/condsurfs.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/condsurfs.F (revision 2630) @@ -0,0 +1,317 @@ + SUBROUTINE condsurfs(jour, edgar, flag_dms, + . lmt_so2h, lmt_so2b, lmt_so2bb, lmt_so2ba, + . lmt_so2volc, lmt_altvolc, + . lmt_dmsbio, lmt_h2sbio, lmt_dms, lmt_dmsconc) + USE dimphy + IMPLICIT none +c +c Lire les conditions aux limites du modele pour la chimie. +c -------------------------------------------------------- +c +#include "dimensions.h" +#include "netcdf.inc" +c + REAL lmt_so2h(klon), lmt_so2b(klon), lmt_so2bb(klon) + REAL lmt_dmsbio(klon), lmt_h2sbio(klon), lmt_so2ba(klon) + REAL lmt_so2volc(klon), lmt_altvolc(klon) + REAL lmt_dms(klon), lmt_dmsconc(klon) + LOGICAL edgar + INTEGER flag_dms +c + INTEGER jour, i + INTEGER ierr + INTEGER nid,nvarid + INTEGER debut(2),epais(2) +c + IF (jour.LT.0 .OR. jour.GT.(360-1)) THEN + IF ((jour.GT.(360-1)) .AND. (jour.LE.367)) THEN + jour=360-1 + print *,'JE: jour changed to jour= ',jour + ELSE + PRINT*,'Le jour demande n est pas correcte:', jour + CALL ABORT + ENDIF + ENDIF +c + ierr = NF_OPEN ("limitsoufre.nc", NF_NOWRITE, nid) + if (ierr.ne.NF_NOERR) then + write(6,*)' Pb d''ouverture du fichier limitsoufre.nc' + write(6,*)' ierr = ', ierr + call exit(1) + endif +c +c Tranche a lire: + debut(1) = 1 + debut(2) = jour+1 + epais(1) = klon + epais(2) = 1 +c + ierr = NF_INQ_VARID (nid, "VOLC", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2volc) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2volc) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 volcan' + CALL exit(1) + ENDIF +c + ierr = NF_INQ_VARID (nid, "ALTI", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_altvolc) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_altvolc) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les altitudes volcan' + CALL exit(1) + ENDIF +c + IF (edgar) THEN !--EDGAR w/o ship and biomass burning +c + ierr = NF_INQ_VARID (nid, "SO2ED95L", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2b) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2b) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 edgar low' + CALL exit(1) + ENDIF +c + ierr = NF_INQ_VARID (nid, "SO2ED95H", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2h) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2h) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 edgar high' + CALL exit(1) + ENDIF +c + ELSE !--GEIA +c + ierr = NF_INQ_VARID (nid, "SO2H", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2h) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2h) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 haut' + CALL exit(1) + ENDIF +c + ierr = NF_INQ_VARID (nid, "SO2B", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2b) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2b) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 bas' + CALL exit(1) + ENDIF +c + ENDIF !--edgar +c + ierr = NF_INQ_VARID (nid, "SO2BB", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2bb) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2bb) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 bb' + CALL exit(1) + ENDIF +c + ierr = NF_INQ_VARID (nid, "SO2BA", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_so2ba) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_so2ba) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 bateau' + CALL exit(1) + ENDIF +c + ierr = NF_INQ_VARID (nid, "DMSB", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_dmsbio) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsbio) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms bio' + CALL exit(1) + ENDIF +c + ierr = NF_INQ_VARID (nid, "H2SB", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_h2sbio) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_h2sbio) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources h2s bio' + CALL exit(1) + ENDIF +c + IF (flag_dms.EQ.1) THEN +c + ierr = NF_INQ_VARID (nid, "DMSL", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_dms) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dms) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms liss' + CALL exit(1) + ENDIF +c + ELSEIF (flag_dms.EQ.2) THEN +c + ierr = NF_INQ_VARID (nid, "DMSW", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, lmt_dms) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dms) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms wann' + CALL exit(1) + ENDIF +c + ELSEIF (flag_dms.EQ.3) THEN +c + ierr = NF_INQ_VARID (nid, "DMSC1", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dmsconc old' + CALL exit(1) + ENDIF +c + ELSEIF (flag_dms.EQ.4) THEN +c + ierr = NF_INQ_VARID (nid, "DMSC2", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms conc 2' + CALL exit(1) + ENDIF +c + ELSEIF (flag_dms.EQ.5) THEN +c + ierr = NF_INQ_VARID (nid, "DMSC3", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms conc 3' + CALL exit(1) + ENDIF +c + ELSEIF (flag_dms.EQ.6) THEN +c + ierr = NF_INQ_VARID (nid, "DMSC4", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms conc 4' + CALL exit(1) + ENDIF +c + ELSEIF (flag_dms.EQ.7) THEN +c + ierr = NF_INQ_VARID (nid, "DMSC5", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms conc 5' + CALL exit(1) + ENDIF +c + ELSEIF (flag_dms.EQ.8) THEN +c + ierr = NF_INQ_VARID (nid, "DMSC6", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms conc 6' + CALL exit(1) + ENDIF +c + ELSEIF (flag_dms.EQ.9) THEN +c + ierr = NF_INQ_VARID (nid, "DMSC7", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms conc 7' + CALL exit(1) + ENDIF +c + ELSEIF (flag_dms.EQ.10) THEN +c + ierr = NF_INQ_VARID (nid, "DMSC8", nvarid) +cnhl #ifdef NC_DOUBLE + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_dmsconc) +cnhl #else +cnhl ierr = NF_GET_VARA_REAL (nid, nvarid, debut, epais, lmt_dmsconc) +cnhl #endif + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms conc 8' + CALL exit(1) + ENDIF +c + ELSE +c + PRINT *,'choix non possible pour flag_dms' + STOP +c + ENDIF +c + ierr = NF_CLOSE(nid) +c + IF (flag_dms.LE.2) THEN + DO i=1, klon + lmt_dmsconc(i)=0.0 + ENDDO + ELSE + DO i=1, klon + lmt_dms(i)=0.0 + ENDDO + ENDIF +c + PRINT*, 'Sources SOUFRE lues pour jour: ', jour +c + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/condsurfs_new.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/condsurfs_new.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/condsurfs_new.F (revision 2630) @@ -0,0 +1,273 @@ + SUBROUTINE condsurfs_new(jour, edgar, flag_dms, + . lmt_so2b, lmt_so2h, lmt_so2nff, + . lmt_so2bb_l, lmt_so2bb_h, lmt_so2ba, + . lmt_so2volc_cont, lmt_altvolc_cont, + . lmt_so2volc_expl, lmt_altvolc_expl, + . lmt_dmsbio, lmt_h2sbio, lmt_dms, + . lmt_dmsconc) + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + USE dimphy + IMPLICIT none +c +c Lire les conditions aux limites du modele pour la chimie. +c -------------------------------------------------------- +c +#include "dimensions.h" +#include "netcdf.inc" +c + REAL lmt_so2b(klon), lmt_so2h(klon), lmt_so2nff(klon) + REAL lmt_so2bb_l(klon), lmt_so2bb_h(klon) + REAL lmt_dmsbio(klon), lmt_h2sbio(klon), lmt_so2ba(klon) + REAL lmt_so2volc_cont(klon), lmt_altvolc_cont(klon) + REAL lmt_so2volc_expl(klon), lmt_altvolc_expl(klon) + REAL lmt_dms(klon), lmt_dmsconc(klon) + + REAL lmt_so2b_glo(klon_glo), lmt_so2h_glo(klon_glo) + REAL lmt_so2nff_glo(klon_glo) + REAL lmt_so2bb_l_glo(klon_glo), lmt_so2bb_h_glo(klon_glo) + REAL lmt_dmsbio_glo(klon_glo), lmt_h2sbio_glo(klon_glo) + REAL lmt_so2ba_glo(klon_glo) + REAL lmt_so2volc_cont_glo(klon_glo),lmt_altvolc_cont_glo(klon_glo) + REAL lmt_so2volc_expl_glo(klon_glo),lmt_altvolc_expl_glo(klon_glo) + REAL lmt_dms_glo(klon_glo), lmt_dmsconc_glo(klon_glo) + LOGICAL edgar + INTEGER flag_dms +c + INTEGER jour, i + INTEGER ierr + INTEGER nid,nvarid + INTEGER debut(2),epais(2) +c + IF (jour.LT.0 .OR. jour.GT.(366-1)) THEN + PRINT*,'Le jour demande n est pas correcte:', jour + print *,'JE: FORCED TO CONTINUE (emissions have + . to be longer than 1 year!!!! )' +! CALL ABORT + ENDIF +! + +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + +c Tranche a lire: + debut(1) = 1 + debut(2) = jour +! epais(1) = klon + epais(1) = klon_glo + epais(2) = 1 +!======================================================================= +! READING NEW EMISSIONS FROM RCP +!======================================================================= +! + ierr = NF_OPEN ("sulphur_emissions_antro.nc", NF_NOWRITE, nid) + if (ierr.ne.NF_NOERR) then + write(6,*)' Pb d''ouverture du fichier sulphur_emissions_antro' + write(6,*)' ierr = ', ierr + call exit(1) + endif + +! +! SO2 Low level emissions +! + ierr = NF_INQ_VARID (nid, "SO2FF_LOW", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,lmt_so2b_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 low' + print *,'JE klon, jour, debut ,epais ',klon_glo,jour,debut,epais + CALL HANDLE_ERR(ierr) + print *,'error ierr= ',ierr + CALL exit(1) + ENDIF +! +! SO2 High level emissions +! + ierr = NF_INQ_VARID (nid, "SO2FF_HIGH", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais,lmt_so2h_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 high' + CALL exit(1) + ENDIF +! +! SO2 Biomass burning High level emissions +! + ierr = NF_INQ_VARID (nid, "SO2BBH", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, + . epais, lmt_so2bb_h_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 BB high' + CALL exit(1) + ENDIF +! +! SO2 biomass burning low level emissions +! + ierr = NF_INQ_VARID (nid, "SO2BBL", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, + . epais, lmt_so2bb_l_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 BB low' + CALL exit(1) + ENDIF +! +! SO2 ship emissions +! + ierr = NF_INQ_VARID (nid, "SO2BA", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut,epais,lmt_so2ba_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 ship' + CALL exit(1) + ENDIF +! +! SO2 Non Fossil Fuel Emissions +! + ierr = NF_INQ_VARID (nid, "SO2NFF", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, + . lmt_so2nff_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 non FF' + CALL exit(1) + ENDIF +! + ierr = NF_CLOSE(nid) +! +!======================================================================= +! READING NATURAL EMISSIONS +!======================================================================= + ierr = NF_OPEN ("sulphur_emissions_nat.nc", NF_NOWRITE, nid) + if (ierr.ne.NF_NOERR) then + write(6,*)' Pb d''ouverture du fichier sulphur_emissions_nat' + write(6,*)' ierr = ', ierr + call exit(1) + endif +c +c Biologenic source of DMS +c + ierr = NF_INQ_VARID (nid, "DMSB", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid,debut,epais,lmt_dmsbio_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms bio' + CALL exit(1) + ENDIF +c +c Biologenic source of H2S +c + ierr = NF_INQ_VARID (nid, "H2SB", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid,debut,epais,lmt_h2sbio_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources h2s bio' + CALL exit(1) + ENDIF +c +c Ocean surface concentration of dms (emissions are computed later) +c + IF (flag_dms.EQ.4) THEN +c + ierr = NF_INQ_VARID (nid, "DMSC2", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid,nvarid,debut,epais,lmt_dmsconc_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources dms conc 2' + CALL exit(1) + ENDIF +c + DO i=1, klon +! lmt_dms(i)=0.0 + lmt_dms_glo(i)=0.0 + ENDDO +c + ELSE +c + PRINT *,'choix non possible pour flag_dms' + STOP + + ENDIF +c + ierr = NF_CLOSE(nid) +c +!======================================================================= +! READING VOLCANIC EMISSIONS +!======================================================================= + print *,' *** READING VOLCANIC EMISSIONS *** ' + print *,' Jour = ',jour + ierr = NF_OPEN ("sulphur_emissions_volc.nc", NF_NOWRITE, nid) + if (ierr.ne.NF_NOERR) then + write(6,*)' Pb d''ouverture du fichier sulphur_emissions_volc' + write(6,*)' ierr = ', ierr + call exit(1) + endif +c +c Continuous Volcanic emissions +c +! ierr = NF_INQ_VARID (nid, "VOLC", nvarid) + ierr = NF_INQ_VARID (nid, "flx_volc_cont", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, + . lmt_so2volc_cont_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 volcan (cont)' + CALL exit(1) + ENDIF + print *,'SO2 volc cont (in read) = ',SUM(lmt_so2volc_cont_glo), + + MINVAL(lmt_so2volc_cont_glo),MAXVAL(lmt_so2volc_cont_glo) +! lmt_so2volc(:)=0.0 +c +c Altitud of continuous volcanic emissions +c +! ierr = NF_INQ_VARID (nid, "ALTI", nvarid) + ierr = NF_INQ_VARID (nid, "flx_volc_altcont", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, + . lmt_altvolc_cont_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les altitudes volcan (cont)' + CALL exit(1) + ENDIF +c +c Explosive Volcanic emissions +c + ierr = NF_INQ_VARID (nid, "flx_volc_expl", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, + . lmt_so2volc_expl_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les sources so2 volcan (expl)' + CALL exit(1) + ENDIF +! lmt_so2volc_expl(:)=0.0 + print *,'SO2 volc expl (in read) = ',SUM(lmt_so2volc_expl_glo), + + MINVAL(lmt_so2volc_expl_glo),MAXVAL(lmt_so2volc_expl_glo) +c +c Altitud of explosive volcanic emissions +c + ierr = NF_INQ_VARID (nid, "flx_volc_altexpl", nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debut, epais, + . lmt_altvolc_expl_glo) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour les altitudes volcan' + CALL exit(1) + ENDIF +! lmt_altvolc_expl(:)=0.0 + + ierr = NF_CLOSE(nid) +c + PRINT*, 'Sources SOUFRE lues pour jour: ', jour +c + + + ENDIF +!$OMP END MASTER +!$OMP BARRIER + call scatter( lmt_so2b_glo , lmt_so2b ) + call scatter(lmt_so2h_glo , lmt_so2h ) + call scatter(lmt_so2bb_h_glo , lmt_so2bb_h ) + call scatter(lmt_so2bb_l_glo , lmt_so2bb_l) + call scatter(lmt_so2ba_glo , lmt_so2ba) + call scatter(lmt_so2nff_glo , lmt_so2nff) + call scatter(lmt_dmsbio_glo , lmt_dmsbio) + call scatter(lmt_h2sbio_glo , lmt_h2sbio) + call scatter(lmt_dmsconc_glo , lmt_dmsconc) + call scatter(lmt_dms_glo , lmt_dms) + call scatter(lmt_so2volc_cont_glo , lmt_so2volc_cont) + call scatter(lmt_altvolc_cont_glo , lmt_altvolc_cont) + call scatter(lmt_so2volc_expl_glo , lmt_so2volc_expl) + call scatter(lmt_altvolc_expl_glo , lmt_altvolc_expl) + + + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/deposition.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/deposition.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/deposition.F (revision 2630) @@ -0,0 +1,56 @@ +c Subroutine that estimates the Deposition velocities and the depostion +C for the different tracers + subroutine deposition(vdep_oce,vdep_sic,vdep_ter,vdep_lic,pctsrf, + . zrho,zdz,pdtphys,RHcl,masse,t_seri,pplay, + . paprs,lminmax,qmin,qmax, + . his_ds,source_tr,tr_seri) + + USE dimphy + USE infotrac + USE indice_sol_mod + + IMPLICIT NONE + +#include "dimensions.h" +#include "chem.h" +#include "YOMCST.h" +#include "paramet.h" + +c----------------------------- INPUT ----------------------------------- + LOGICAL lminmax + REAL qmin, qmax + REAL vdep_oce(nbtr), vdep_sic(nbtr) + REAL vdep_ter(nbtr), vdep_lic(nbtr) + REAL pctsrf(klon,nbsrf) + REAL zrho(klon,klev) !Density of air at mid points of Z (kg/m3) + REAL zdz(klon,klev) + REAL pdtphys ! pas d'integration pour la physique (seconde) + REAL RHcl(klon,klev) ! humidite relativen ciel clair + REAL t_seri(klon,klev) ! temperature + REAL pplay(klon,klev) ! pression pour le mileu de chaque couche (en Pa) + REAL paprs(klon, klev+1) !pressure at interface of layers Z (Pa) + REAL masse(nbtr) + +c----------------------------- OUTPUT ---------------------------------- + REAL his_ds(klon,nbtr) + REAL source_tr(klon,nbtr) + REAL tr_seri(klon, klev,nbtr) !conc of tracers +c--------------------- INTERNAL VARIABLES ------------------------------ + INTEGER i, it + REAL vdep !sed. velocity + + DO it=1, nbtr + DO i=1, klon + vdep=vdep_oce(it)*pctsrf(i,is_oce)+ + . vdep_sic(it)*pctsrf(i,is_sic)+ + . vdep_ter(it)*pctsrf(i,is_ter)+ + . vdep_lic(it)*pctsrf(i,is_lic) +c--Unit: molec/m2/s for it=1 to nbtr-3, mg/m2/s for it=nbtr-2 to nbtr + source_tr(i,it)=source_tr(i,it) + . -vdep*tr_seri(i,1,it)*zrho(i,1)/1.e2 + his_ds(i,it)=vdep*tr_seri(i,1,it)*zrho(i,1)/1.e2 + . /RNAVO*masse(it)*1.e3 ! mg/m2/s + ENDDO + ENDDO +c + END Index: /LMDZ5/trunk/libf/phylmd/Dust/dustemission_mod.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/dustemission_mod.F90 (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/dustemission_mod.F90 (revision 2630) @@ -0,0 +1,1548 @@ +MODULE dustemission_mod + + IMPLICIT NONE + !Parameters +! INTEGER, PARAMETER :: nbins=12 ! number of aerosol bins: original +! INTEGER, PARAMETER :: nbins=800 ! number of aerosol bins: for spla +! INTEGER, PARAMETER :: nbins=8000 ! number of aerosol bins: for spla + + INTEGER, PARAMETER :: flag_feff=1 ! 0: deactivate feff (drag partition scheme) + INTEGER, PARAMETER :: nbins=800 ! number of aerosol bins: for spla + INTEGER, PARAMETER :: nmode=3 ! number of soil-dust modes + INTEGER, PARAMETER :: ntyp=5 ! number of soil types + INTEGER, PARAMETER :: nwb=12 ! number of points for the 10m wind +! speed weibull distribution (>=2) + real ,parameter :: z10m=1000. !10m in cm + REAL,PARAMETER :: kref=3. !weibull parameter + INTEGER, PARAMETER :: nats=14 !number of mineral types (14 here for sand, + ! silt, clay etc.) + integer, parameter :: nclass=200000 + + + real , parameter :: dmin=0.0001 + real , parameter :: dmax=0.2 + integer, parameter :: nspe=nmode*3+1 + real ,parameter :: vkarm=0.41 +!JE20150202 : updating scheme to chimere13b <<< +! original values +! integer, parameter :: div1=3. +! integer, parameter :: div2=3. +! integer, parameter :: div3=3. +! real , parameter :: e1=3.61/div1 +! real , parameter :: e2=3.52/div2 +! real , parameter :: e3=3.46/div3 +! real , parameter :: rop=2.65 ! particle density g/m3 +! real , parameter :: roa=0.001227 ! air density g/m3 +! real , parameter :: pi=3.14159 !! +! real , parameter :: gravity=981. !! cm!! +! real , parameter :: cd=1.*roa/gravity +! new values +! logical, parameter :: ok_splatuning=.true. +! Div=3 from S. Alfaro (Sow et al ACPD 2011) +!JE 20150206 +! integer, parameter :: div1=3. +! integer, parameter :: div2=3. +! integer, parameter :: div3=3. + integer, parameter :: div1=6. + integer, parameter :: div2=6. + integer, parameter :: div3=6. + real , parameter :: e1=3.61/div1 + real , parameter :: e2=3.52/div2 + real , parameter :: e3=3.46/div3 + real , parameter :: rop=2.65 ! particle density g/m3 + real , parameter :: roa=0.001227 ! air density g/m3 + real , parameter :: pi=3.14159 !! + real , parameter :: gravity=981. !! cm!! +! C=2.61 from Marticorena and Bergametti 1995 instead of Gillete and Chen 2001 +! (recommended C=1.1 in supply-limited dust source area.. ) + real , parameter :: cd=2.61*roa/gravity +! real , parameter :: cd=1.0*roa/gravity +!JE20150202>>>> + real,parameter :: beta=16300. + real, parameter, dimension(3) :: diam=(/1.5,6.7,14.2/) + INTEGER, PARAMETER :: ndistb=3 + real, parameter, dimension(3) :: sig=(/1.7,1.6,1.5/) + +! INTEGER, PARAMETER :: nbinsHR=3000 !original + INTEGER, PARAMETER :: nbinsHR=30000 +!min and max dust size in um + REAL, PARAMETER :: sizedustmin=0.0599 ! for spla + REAL, PARAMETER :: sizedustmax=63. +! REAL, PARAMETER :: sizedustmin=0.09 ! original +! REAL, PARAMETER :: sizedustmax=63. + + + ! Calc variables + REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: massfrac + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: binsHR + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: binsHRcm + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: itv + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: sizedust !size dust bin (in um) + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: szdcm !the same but (in cm) + + !soil inputs from file donnees_lisa.nc . Should be in the same grid as the + !model (regridded with nearest neighborhood from surfnew.nc) + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: sol + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: P + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: zos + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: z01 + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: z02 + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: D + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: A + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: solspe + INTEGER,DIMENSION(:,:),ALLOCATABLE,SAVE :: masklisa +!!! INTEGER,DIMENSION(:),ALLOCATABLE,SAVE :: maskdust + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: feff + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: feffdbg + + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: sizeclass + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: sizeclass2 + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: uth + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: uth2 + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: srel + REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: srel2 + + INTEGER :: nat ! SOL data inside the loop (use as soil type index?) + REAL :: ustarsalt + REAL :: var3a,var3b + INTEGER :: ns,nd,nsi,npi,ni ! counters + INTEGER :: ncl + +! outputs + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: m1dflux !fluxes for each soil mode + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: m2dflux + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: m3dflux + + + +!$OMP THREADPRIVATE(m1dflux) +!$OMP THREADPRIVATE(m2dflux) +!$OMP THREADPRIVATE(m3dflux) +!$OMP THREADPRIVATE(massfrac) +!$OMP THREADPRIVATE(binsHR) +!$OMP THREADPRIVATE(binsHRcm) +!$OMP THREADPRIVATE(itv) +!$OMP THREADPRIVATE(sizedust) +!$OMP THREADPRIVATE(szdcm) +!$OMP THREADPRIVATE(sol) +!$OMP THREADPRIVATE(P) +!$OMP THREADPRIVATE(zos) +!$OMP THREADPRIVATE(z01) +!$OMP THREADPRIVATE(z02) +!$OMP THREADPRIVATE(D) +!$OMP THREADPRIVATE(A) +!$OMP THREADPRIVATE(solspe) +!$OMP THREADPRIVATE(masklisa) +!!!!$OMP THREADPRIVATE(maskdust) +!$OMP THREADPRIVATE(feff) +!$OMP THREADPRIVATE(feffdbg) +!$OMP THREADPRIVATE(sizeclass) +!$OMP THREADPRIVATE(sizeclass2) +!$OMP THREADPRIVATE(uth) +!$OMP THREADPRIVATE(uth2) +!$OMP THREADPRIVATE(srel) +!$OMP THREADPRIVATE(srel2) + + + + CONTAINS + +!-------------------------------------------------------------------------------------- +!====================================================================================== +!************************************************************************************** +!====================================================================================== +!-------------------------------------------------------------------------------------- + + SUBROUTINE dustemission( debutphy, xlat, xlon, & !Input + pctsrf,zu10m,zv10m,wstar, & !Input + ale_bl,ale_wake, & !Input + param_wstarBL, param_wstarWAKE, & !Input + emdustacc,emdustcoa,emdustsco,maskdust) !Output + USE dimphy + USE infotrac + USE write_field_phy + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + USE indice_sol_mod + + IMPLICIT NONE + ! input : + ! output: flux_sparam_ddfine,flux_sparam_ddcoa, + ! first: + ! Model grid parameters + REAL,DIMENSION(klon), INTENT(IN) :: xlat + REAL,DIMENSION(klon), INTENT(IN) :: xlon + REAL,DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf + REAL,DIMENSION(klon),INTENT(IN) :: zu10m ! 10m zonal wind + REAL,DIMENSION(klon),INTENT(IN) :: zv10m ! meridional 10m wind + REAL,DIMENSION(klon),INTENT(IN) :: wstar + REAL,DIMENSION(klon),INTENT(IN) :: ale_bl + REAL,DIMENSION(klon),INTENT(IN) :: ale_wake + REAL,DIMENSION(klon), INTENT(IN) :: param_wstarWAKE + REAL,DIMENSION(klon), INTENT(IN) :: param_wstarBL + + + LOGICAL :: debutphy ! First physiqs run or not + ! Intermediate variable: 12 bins emissions + REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: emisbinloc ! vertical emission fluxes + + !OUT variables + REAL,DIMENSION(klon) :: emdustacc,emdustcoa,emdustsco ! emission in spla dust bins: +! old radio : acc=0.03-0.5 micrometers, ccoa:0.5-10 micrometers +! new acc=0.03-0.5 micrometers, coa:0.5-3 micrometers ,sco:3-15 um + INTEGER,DIMENSION(klon) :: maskdust ! where the emissions were calculated +! INTEGER,DIMENSION(klon_glo) :: maskdust_glo ! auxiliar +! REAL,DIMENSION(klon_glo) :: raux_klon_glo ! auxiliar + +!$OMP THREADPRIVATE(emisbinloc) +!!!!!!$OMP THREADPRIVATE(maskdust) + IF (debutphy) THEN + ALLOCATE( emisbinloc(klon,nbins) ) + ENDIF + + IF( debutphy ) THEN + CALL initdust(xlat,xlon,pctsrf) + ENDIF + +!JE20141124 CALL calcdustemission(debutphy,zu10m,zv10m,wstar,ale_bl,ale_wake,emisbinloc) + CALL calcdustemission(debutphy,zu10m,zv10m,wstar,ale_bl,ale_wake,param_wstarBL,param_wstarWAKE, & !I + emisbinloc) !O + + CALL makemask(maskdust) + + IF( debutphy ) THEN +! call gather(maskdust,maskdust_glo) +! !$OMP MASTER +! IF (is_mpi_root .AND. is_omp_root) THEN +! CALL writefield_phy("maskdust",float(maskdust_glo),1) + CALL writefield_phy("maskdust",float(maskdust),1) +! ENDIF +! !$OMP END MASTER +! !$OMP BARRIER + ENDIF + + !CALL adaptdustemission(debutphy,emisbinloc,emdustacc,emdustcoa,emdustsco) + CALL adaptdustemission(debutphy,emisbinloc,emdustacc,emdustcoa,emdustsco,maskdust,pctsrf) + ! output in kg/m2/s + + + END SUBROUTINE dustemission + +!-------------------------------------------------------------------------------------- +!====================================================================================== +!************************************************************************************** +!====================================================================================== +!-------------------------------------------------------------------------------------- + + SUBROUTINE makemask(maskdustloc) + USE dimphy + USE infotrac + IMPLICIT NONE + !Input + INTEGER,DIMENSION(klon) :: maskdustloc + INTEGER :: i,j,k + integer :: iaux + + + do k=1,klon + maskdustloc(k)=0 + do i=1,ntyp + if (masklisa(k,i)>0) then + maskdustloc(k)=1 + endif + enddo + enddo + + END SUBROUTINE makemask + +!-------------------------------------------------------------------------------------- +!====================================================================================== +!************************************************************************************** +!====================================================================================== +!-------------------------------------------------------------------------------------- + + SUBROUTINE adaptdustemission(debutphy,emisbinlocal, & + emdustacc,emdustcoa,emdustsco,maskdust,pctsrf) +! emdustacc,emdustcoa,emdustsco) + + USE dimphy + USE infotrac + USE write_field_phy + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + USE indice_sol_mod + + IMPLICIT NONE + !Input + REAL,DIMENSION(klon) :: emdustacc,emdustcoa,emdustsco + REAL, DIMENSION(klon,nbins) :: emisbinlocal + ! Local + INTEGER :: i,j,k +!!! INTEGER,DIMENSION(2) :: iminacclow,iminacchigh,imincoalow,imincoahigh ! in +!case of small nbins.... not ready + INTEGER,SAVE ::iminacclow,iminacchigh,imincoalow + INTEGER,SAVE ::imincoahigh,iminscohigh,iminscolow + INTEGER,DIMENSION(klon) :: maskdust ! where the emissions were calculated + REAL,DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf +! real,parameter :: sizeacclow=0.03 +! real,parameter :: sizeacchigh=0.5 +! real,parameter :: sizecoalow=0.5 +! real,parameter :: sizecoahigh=10. ! in micrometers + real,parameter :: sizeacclow=0.06 + real,parameter :: sizeacchigh=1.0 + real,parameter :: sizecoalow=1.0 + real,parameter :: sizecoahigh=6. !20 ! diameter in micrometers + real,parameter :: sizescolow=6. + real,parameter :: sizescohigh=30. ! in micrometers +!-------------------------------- +! real,parameter :: tuningfactorfine=0.9 ! factor for fine bins!!! important!! + real,parameter :: tuningfactorfine=0.8 ! factor for fine bins!!! important!! +! real,parameter :: tuningfactorfine=4.5 ! factor for fine bins!!! important!! +! real,parameter :: tuningfactorcoa=3.6 ! factor for coarse bins!!! important!! + real,parameter :: tuningfactorcoa=3.25 ! factor for coarse bins!!! important!! +! real,parameter :: tuningfactorcoa=4.5 ! factor for coarse bins!!! important!! +! real,parameter :: tuningfactorsco=3.6 ! factor for supercoarse bins!!! important!! + real,parameter :: tuningfactorsco=3.25 ! factor for supercoarse bins!!! important!! +! real,parameter :: tuningfactorsco=4.5 ! factor for supercoarse bins!!! important!! + real,parameter :: basesumemission= 0.0 !1.e-6 ! emissions to SUM to each land pixel FOR ASSIMILATION ONLY important!! in mg/m2/s, per bin + !basesumemission = 1.e-6 increase the AOD in about 12% (0.03 of AOD) , + !while 1e-8 increase in about 0.12% (0.003 of AOD) + + real,dimension(klon) :: basesumacc,basesumcoa,basesumsco +!-------------------------------- +!JE20140915 real,parameter :: sizeacclow=0.06 +!JE20140915 real,parameter :: sizeacchigh=1.0 +!JE20140915 real,parameter :: sizecoalow=1.0 +!JE20140915 real,parameter :: sizecoahigh=10. !20 ! diameter in micrometers +!JE20140915 real,parameter :: sizescolow=10. +!JE20140915 real,parameter :: sizescohigh=30. ! in micrometers + + + + logical :: debutphy + real :: diff, auxr1,auxr2,auxr3,auxr4 + real,dimension(klon,nbins) :: itvmean + real,dimension(klon,nbins+1) :: itv2 +! real,dimension(klon_glo,nbins) :: itvmean_glo +! real,dimension(:,:) , allocatable :: itvmean_glo +! real,dimension(:,:), allocatable :: itv2_glo + + integer, save :: counter,counter1 !dbg + REAL, DIMENSION(:,:),ALLOCATABLE,SAVE :: emisbinlocalmean,emisbinlocalmean2 !dbg + REAL, DIMENSION(:,:),ALLOCATABLE :: emisbinlocalmean2_glo + logical :: writeaerosoldistrib +!$OMP THREADPRIVATE(iminacclow,iminacchigh,imincoalow,imincoahigh) + +writeaerosoldistrib=.false. +if (debutphy) then + + if (sizedustmin>sizeacclow .or. sizedustmax> + +!CALL abort_gcm('calcdustemission', 'OK1',1) + +END SUBROUTINE adaptdustemission + + +!-------------------------------------------------------------------------------------- +!====================================================================================== +!************************************************************************************** +!====================================================================================== +!-------------------------------------------------------------------------------------- + + +!-------------------------------------------------------- + SUBROUTINE initdust(xlat,xlon,pctsrf) + USE dimphy + USE infotrac + USE write_field_phy + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + USE indice_sol_mod + + IMPLICIT NONE + !Inputs + REAL,DIMENSION(klon), INTENT(IN) :: xlat + REAL,DIMENSION(klon), INTENT(IN) :: xlon + ! JE20150605<< better to read + ! REAL,DIMENSION(klon), INTENT(IN) :: pctsrf + REAL,DIMENSION(klon,nbsrf), INTENT(IN) :: pctsrf + ! JE20150605>> + + !Local + REAL,DIMENSION(klon,ntyp) :: solini + REAL,DIMENSION(klon,ntyp) :: Pini + REAL,DIMENSION(klon,ntyp) :: zosini + REAL,DIMENSION(klon,ntyp) :: z01ini + REAL,DIMENSION(klon,ntyp) :: z02ini + REAL,DIMENSION(klon,ntyp) :: Dini + REAL,DIMENSION(klon,ntyp) :: Aini + + REAL,DIMENSION(nclass) :: newstep + + !TEMPORAL/ MAKE MASK!!! + REAL, PARAMETER :: longmin=-20. + REAL, PARAMETER :: longmax=77. !35. + REAL, PARAMETER :: latmin=10. + REAL, PARAMETER :: latmax=40. + !TEMPORAL/ MAKE MASK!!! + !Local + REAL, PARAMETER :: eps=1.e-5 + REAL, PARAMETER :: aeff=0.35 + REAL, PARAMETER :: xeff=10. + REAL, PARAMETER :: trctunt=0.310723 + + INTEGER :: i,j,k,nts + REAL :: dp,dstep +! Parametres pour le calcul de la repartition de l energie feff(klon,ntyp) + REAL :: aa,bb,cc,dd,ee,ff + REAL,DIMENSION(klon,ntyp) :: tmp1 + REAL :: p3t,var1,var2,et + +! Parametres pour le calcul de la surface couverte par les particule de diametre +! dp srel(nats,nclass) + REAL :: stotale,su,su_loc,xk,xl,xm,xn + REAL,DIMENSION(nclass) :: subsoildist + +! isolog and massfrac calcs + INTEGER :: nbinsout,nb,miniso,nbins1,nbins2,istart,no + REAL :: b1,b2,stepbin,minisograd,exden,d2min,d2max,numin,numax + REAL :: delta1,delta2,ldmd +! REAL, PARAMETER :: sizedustmin=0.09 + REAL,DIMENSION(nbinsHR):: binsISOGRAD + REAL,DIMENSION(nbinsHR):: vdISOGRAD + REAL,DIMENSION(nbinsHR):: logvdISOGRAD + REAL :: curvd + REAL :: avdhr + REAL :: bvdhr + REAL,DIMENSION(nbins) :: dmn1 + REAL,DIMENSION(nbins) :: dmn2 + REAL,DIMENSION(nbins) :: dmn3 + REAL,DIMENSION(nbinsHR) :: vdHR + REAL,DIMENSION(nbinsHR) :: vdout + + + +! Parametres pour le calcul de la vitesse de friction seuil uth(nclass) +! calcul de la vitesse seuil selon la parametrisation de Shao and Lu +! 2000(icuth=1). +! INTEGER :: ich1 + REAL :: an + REAL :: gam + REAL :: sigshao + REAL :: x1 + REAL :: x2 +! Cas de Iversen and White 1982 (icuth=0) si necessaire. + REAL, PARAMETER :: adust=1331.647 + REAL, PARAMETER :: bdust=0.38194 + REAL, PARAMETER :: xdust=1.561228 + REAL, PARAMETER :: ddust=0.006/(rop*gravity) + + CHARACTER(LEN=10) :: varname + CHARACTER(LEN=80) :: fnsolspe + CHARACTER(LEN=200) :: line + + +! nats: number of mineral types (14 here for sand, silt, clay etc.) + ALLOCATE( binsHR(nbinsHR) ) + ALLOCATE( binsHRcm(nbinsHR) ) + ALLOCATE( itv(nbins+1) ) + ALLOCATE( sizedust(nbins) ) + ALLOCATE( szdcm(nbins) ) + ALLOCATE( massfrac(ndistb,nbins) ) + ALLOCATE( sol(klon,ntyp) ) + ALLOCATE( P(klon,ntyp) ) + ALLOCATE( zos(klon,ntyp) ) + ALLOCATE( z01(klon,ntyp) ) + ALLOCATE( z02(klon,ntyp) ) + ALLOCATE( D(klon,ntyp) ) + ALLOCATE( A(klon,ntyp) ) + ALLOCATE( masklisa(klon,ntyp) ) + ALLOCATE( solspe(nats,nspe) ) + ALLOCATE( feff(klon,ntyp) ) + ALLOCATE( feffdbg(klon,ntyp) ) + ALLOCATE( sizeclass(nclass) ) + ALLOCATE( sizeclass2(nclass) ) + ALLOCATE( uth(nclass) ) + ALLOCATE( uth2(nclass) ) + ALLOCATE( srel(nats,nclass) ) + ALLOCATE( srel2(nats,nclass) ) + ALLOCATE( m1dflux(klon) ) + ALLOCATE( m2dflux(klon) ) + ALLOCATE( m3dflux(klon) ) + + + + ! read input data from donnees_lisa.nc + varname='SOL' + CALL read_surface(varname,solini) + varname='P' + CALL read_surface(varname,Pini) + varname='ZOS_' + CALL read_surface(varname,zosini) + varname='ZO1_' + CALL read_surface(varname,z01ini) + varname='ZO2_' + CALL read_surface(varname,z02ini) + varname='D' + CALL read_surface(varname,Dini) + varname='A' + CALL read_surface(varname,Aini) +print *,'beforewritephy',mpi_rank,omp_rank + CALL writefield_phy("SOLinit",solini,5) + CALL writefield_phy("Pinit",Pini,5) + CALL writefield_phy("ZOSinit",zosini,5) + CALL writefield_phy("ZO1init",z01ini,5) + CALL writefield_phy("ZO2init",z02ini,5) + CALL writefield_phy("Dinit",Dini,5) + CALL writefield_phy("Ainit",Aini,5) +print *,'afterwritephy',mpi_rank,omp_rank + + DO i=1,klon + DO nts=1,ntyp + masklisa(i,nts)=0 + IF(Pini(i,nts)>=0.) THEN + masklisa(i,nts)=1 + ENDIF + ENDDO + ENDDO +!print *,'JEOK1',mpi_rank,omp_rank + DO i=1,klon + !print *,Pini(i,1),Pini(i,2),Pini(i,3),Pini(i,4),Pini(i,5) + DO nts=1,ntyp + !IF(xlon(i).ge.longmin.and.xlon(i).le.longmax.and. & + !& xlat(i).ge.latmin.and.xlat(i).le.latmax & + !& .and.pctsrf(i)>0.5.and.Pini(i,nts)>0.)THEN + ! JE20150605<< easier to read + ! IF(pctsrf(i)>0.5.and.Pini(i,nts)>0.)THEN + IF(pctsrf(i,is_ter)>0.5.and.Pini(i,nts)>0.)THEN + ! JE20150605>> + sol(i,nts) = solini(i,nts) + P(i,nts) = Pini(i,nts) + zos(i,nts) = zosini(i,nts) + z01(i,nts) = z01ini(i,nts) + z02(i,nts) = z02ini(i,nts) + D(i,nts) = Dini(i,nts) + A(i,nts) = Aini(i,nts) +! masklisa(i,nts)=1 + ELSE + sol(i,nts) =0.0 + P(i,nts) =0.0 + zos(i,nts) =0.0 + z01(i,nts) =0.0 + z02(i,nts) =0.0 + D(i,nts) =0.0 + A(i,nts) =0.0 +! masklisa(i,nts)=0 + ENDIF + ENDDO + ENDDO + +! print *,'JEOK2',mpi_rank,omp_rank +if ( 1==1 ) then + +! print *,'JEOK4',mpi_rank,omp_rank + CALL writefield_phy("SOL",sol,5) + CALL writefield_phy("P" ,P ,5) + CALL writefield_phy("ZOS",zos,5) + CALL writefield_phy("ZO1",z01,5) + CALL writefield_phy("ZO2",z02,5) + CALL writefield_phy("D" ,D ,5) + CALL writefield_phy("A" ,A ,5) + CALL writefield_phy("masklisa",float(masklisa),5) + CALL writefield_phy("pctsrf",pctsrf,1) + CALL writefield_phy("xlon",xlon,1) + CALL writefield_phy("xlat",xlat,1) +!print *,'JEOK5',mpi_rank,omp_rank +!print *,'JEOK6',mpi_rank,omp_rank + +endif + + !CALL abort_gcm('initdustemission', 'OK1',1) + +! Lecture des donnees du LISA indiquant le type de sol utilise. + ! in lines: landuse +! nats: number of mineral types (14 here for sand, silt, clay etc.) +! data format in columns +! mmd1 sigma1 p1 mmd2 sigma2 p2 mmd3 ... alpha +!print *,'JEOK7',mpi_rank,omp_rank +!$OMP MASTER +IF (is_mpi_root .AND. is_omp_root) THEN +!print *,'JEOK9',mpi_rank,omp_rank + fnsolspe='SOILSPEC.data' + PRINT*,' o Reading ',fnsolspe(1:40) + OPEN(10,file=fnsolspe) + READ(10,*)line + DO i=1,nats + READ(10,*)line + READ(10,*)(solspe(i,j),j=1,nspe) +!JE alfa(i)=solspe(i,10) +! PRINT*,'i,alfa(i)',i,alfa(i) +! WRITE(18,*)i,alfa(i) + END DO +! print*,'solspe(14,10)= ',solspe(14,10) + CLOSE(10) +ENDIF +!$OMP END MASTER +!$OMP BARRIER +!print *,'JEOK10',mpi_rank,omp_rank + call bcast(solspe) +! Calcul de la distribution en taille des particules de Dust +! Elle depend du nombre de classe des particules nclass. +!c making full resolution soil diameter table + dstep=0.0005 + dp=dmin + do i=1,nclass + dp=dp*exp(dstep) + sizeclass(i)=dp + if(dp.ge.dmax+eps)goto 30 + newstep(i)=dstep + ! WRITE(18,*)i,sizeclass(i) + enddo +30 continue + print*,'IK5' + ncl=i-1 + print*,' soil size classes used ',ncl,' / ',nclass + print*,' soil size min: ',sizeclass(1),' soil size max: ',sizeclass(ncl) + if(ncl.gt.nclass)stop + +! Threshold velocity: +if (.false.) then +!if (.true.) then +!c 0: Iversen and White 1982 + print *,'Using Iversen and White 1982 Uth' + do i=1,ncl + bb=adust*(sizeclass(i)**xdust)+bdust + cc=sqrt(1+ddust*(sizeclass(i)**(-2.5))) + xk=sqrt(abs(rop*gravity*sizeclass(i)/roa)) + if (bb.lt.10.) then + dd=sqrt(1.928*(bb**0.092)-1.) + uth(i)=0.129*xk*cc/dd + else + ee=-0.0617*(bb-10.) + ff=1.-0.0858*exp(ee) + uth(i)=0.12*xk*cc*ff + endif + enddo +endif +if(.true.) then +! 1: Shao and Lu 2000 + print *,'Using Shao and Lu 2000 Uth' + an=0.0123 + gam=0.3 + do i=1,ncl + sigshao=rop/roa + x1=sigshao*gravity*sizeclass(i) + x2=gam/(roa*sizeclass(i)) + uth(i)=sqrt(an*(x1+x2)) + enddo +endif + + + +!Calcul de la surface couverte par les particules de diametre dp +!srel(nats,nclass) + +! OPEN(18,file='srel.dat',form='formatted',access='sequential') + DO ns=1,nats + stotale=0. + DO i=1,ncl + su=0. + DO j=1,nmode + nd=((j-1)*3)+1 + nsi=((j-1)*3)+2 + npi=((j-1)*3)+3 + IF (solspe(ns,nd).EQ.0.)THEN + su_loc=0. + ELSE + xk=solspe(ns,npi)/(sqrt(2.*pi)*log(solspe(ns,nsi))) + xl=((log(sizeclass(i))-log(solspe(ns,nd)))**2) & + & /(2.*(log(solspe(ns,nsi)))**2) + xm=xk*exp(-xl) + xn=rop*(2./3.)*(sizeclass(i)/2.) + su_loc=xm*newstep(i)/xn + END IF + su=su+su_loc + END DO + subsoildist(i)=su + stotale=stotale+su + END DO + DO i=1,ncl + IF (subsoildist(i).gt.0..and.stotale.gt.0.)THEN + srel(ns,i)=subsoildist(i)/stotale + + ELSE + srel(ns,i)=0. + END IF +! WRITE(18,*)i,srel(1,i) + END DO +! PRINT*,'ns , srel(10000) ',ns,srel(ns,10000) + END DO + + +! Calcul de la repartition de l energie feff(klon,ntyp) + + !efficient fraction for the friction velocities as a function + !of z0s, Zo1 et Zo2 to retrieve the apparent threshold + !wind friction velocity. + ! feff(:,:)=0. + do i=1,klon + do k=1,ntyp + ! print*,'IKKK ',i,klon,k,ntyp + if (zos(i,k).eq.0..or.z01(i,k).eq.0.) then + ! if (zos(i,k)<=0..or.z01(i,k)<=0.) then +! if (zos(i,k)<0..or.z01(i,k)<0.) then + ! print*,'INI DUST WARNING zos ou z01<0',zos(i,k),z01(i,k) +! endif + feff(i,k)=0. + feffdbg(i,k)=0. + ! print*,'IKKK A ',i,klon,k,ntyp + else +! drag partition betzeen the erodable surface and zo1 + ! print*,'IKKK B0 ',i,klon,k,ntyp,z01(i,k),zos(i,k),xeff,aeff + aa=log(z01(i,k)/zos(i,k)) + tmp1(i,k)=aa + bb=log(aeff*(xeff/zos(i,k))**0.8) + cc=1.-aa/bb + feffdbg(i,k)=cc + ! print*,'IKKK B1 ',i,klon,k,ntyp +! drag partition between zo1 and zo2 +! feff: total efficient fraction + if(D(i,k).eq.0.)then + feff(i,k)=cc + ! print*,'IKKK C ',i,klon,k,ntyp + else + dd=log(z02(i,k)/z01(i,k)) + ee=log(aeff*(D(i,k)/z01(i,k))**0.8) + feff(i,k)=(1.-dd/ee)*cc + ! print*,'IKKK D ',i,klon,k,ntyp + endif + if (feff(i,k).lt.0.)feff(i,k)=0. + if (feffdbg(i,k).lt.0.)feffdbg(i,k)=0. + if (feff(i,k).gt.1.)feff(i,k)=1. + if (feffdbg(i,k).gt.1.)feffdbg(i,k)=1. + ! print*,'IKKK E ',i,klon,k,ntyp + endif + enddo + enddo +! JE20150120<< + if (flag_feff .eq. 0) then + print *,'JE_dbg FORCED deactivated feff' + do i=1,klon + do k=1,ntyp + feff(i,k)=1. + enddo + enddo + endif +! JE20150120>> + + +if (1==1) then +! ! CALL writefield_phy("AA",tmp1(1:klon,1:5),5) +! + CALL writefield_phy("REPART5",feff(1:klon,1:5),5) + CALL writefield_phy("REPART5dbg",feffdbg(1:klon,1:5),5) +endif + + +!c---------------FOR def_prepag01modif(var3a,var3b)----------------------- + p3t=0.0001 + var1=e3**(1./3.) + var2=(rop*pi)**(1./3.) + var3a=trctunt*var1/var2 + et=e1+(sqrt(p3t*(e3*e3+e1*e2-e2*e3-e1*e3))/p3t) + var1=et**(1./3.) + var2=(rop*pi)**(1./3.) + var3b=trctunt*var1/var2 + +! JE20140902: comment all isograd distributions and make own massfrac: + + +! if (.false.) then +!!**************L718 +! +!!c------------------------------------------------------------------------ +!! isolog distrib and massfrac calculations. +! +! nbinsout=nbins+1 +! b1=log(sizedustmin) +! b2=log(sizedustmax) +!! restricted ISOLOG bins distributions +! +!! step=(b2-b1)/(nbinsout-1) +!! DO ni=1,nbinsout +!! itv(ni)=exp(b1+(ni-1)*step) +!! ENDDO +!!OPEN(18,file='vdepothrsizbin.dat',form='formatted',access='sequential') +!! Restricted ISOGRADIENT bins distributions +!!!!!!!Making HIGH RESOLUTION dust size distribution (in um)!!!!!! +! stepbin=(b2-b1)/(nbinsHR-1) +! DO nb=1,nbinsHR +! binsHR(nb)=exp(b1+(nb-1)*stepbin) +! END DO +! +! DO nb=1,nbinsHR +! binsHRcm(nb)=binsHR(nb)*1.e-4 +! END DO +!! Making HIGH RESOLUTION dry deposition velocity +! CALL calcvd(vdout) +! +! +! DO nb=1,nbinsHR +! vdHR(nb)=vdout(nb) +!! WRITE(18,*),binsHR(nb),vdHR(nb) +! END DO +! +! !searching for minimum value of dry deposition velocity +! minisograd=1.e20 +! DO nb=1,nbinsHR +! IF(vdHR(nb).le.minisograd)THEN +! minisograd=vdHR(nb) +! miniso=nb +! END IF +! END DO +! +!! searching for optimal number of bins in positive slope Vd part +! +! nbins1=1 +! nbins2=nbinsout-1 +! DO k=1,1000 +! delta1=abs(log(vdHR(1))-log(vdHR(miniso)) )/nbins1 +! delta2=abs(log(vdHR(nbinsHR))-log(vdHR(miniso)))/(nbins2-1) +! IF(delta2.GE.delta1)THEN +! GOTO 50 +! +! ELSE +! nbins2=nbins2-1 +! nbins1=nbins1+1 +! END IF +! IF(nbins2.EQ.1)THEN +! PRINT*,'!! warning: lower limit was found: STOP' +! STOP +! END IF +! END DO +! 50 CONTINUE +!print*,'IK10' +!! building the optimized distribution +! logvdISOGRAD(1)=log(vdHR(1)) +! binsISOGRAD(1)=binsHR(1) +! DO k=2,nbins1 +! logvdISOGRAD(k)=logvdISOGRAD(1)-(k-1)*delta1 +! END DO +! +! logvdISOGRAD(nbins1+1)=log(minisograd) +! +! DO k=1,nbins2 +! logvdISOGRAD(nbins1+1+k)=logvdISOGRAD(nbins1+1)+k*delta2 +! END DO +! +! DO k=1,nbinsout +! vdISOGRAD(k)=exp(logvdISOGRAD(k)) +! END DO +!! sequential search of the correspondig particle diameter +! istart=1 +! DO k=2,nbinsout-1 +! curvd=vdISOGRAD(k) +! DO nb=istart,nbinsHR +! avdhr=vdHR(nb) +! bvdhr=vdHR(nb+1) +! IF(nb.LT.(miniso-1).AND.curvd.LT.avdhr.AND. & +! curvd.GT.bvdhr)THEN +! binsISOGRAD(k)=binsHR(nb) +! istart=nb +! GOTO 60 +! END IF +! IF(nb.eq.miniso)THEN +! binsISOGRAD(k)=binsHR(nb) +! istart=nb+1 +! GOTO 60 +! END IF +! IF(nb.GT.miniso.AND.curvd.GT.avdhr.AND. & +! curvd.LT.bvdhr)THEN +! binsISOGRAD(k)=binsHR(nb) +! istart=nb +! GOTO 60 +! END IF +! END DO +! 60 CONTINUE +! END DO +!print*,'IK11' +! binsISOGRAD(nbinsout)=binsHR(nbinsHR) +! vdISOGRAD(nbinsout)=vdHR(nbinsHR) +! DO nb=1,nbinsout +! itv(nb)=binsISOGRAD(nb) +! END DO +! end ! JE20140902 if false + +! Making dust size distribution (in um) +! + nbinsout=nbins+1 + b1=log(sizedustmin) + b2=log(sizedustmax) + stepbin=(b2-b1)/(nbinsout-1) + DO ni=1,nbinsout + itv(ni)=exp(b1+(ni-1)*stepbin) + ENDDO + +! stepbin=(b2-b1)/(nbinsHR-1) +! DO nb=1,nbinsHR +! binsHR(nb)=exp(b1+(nb-1)*stepbin) +! END DO +! +! DO nb=1,nbinsHR +! binsHRcm(nb)=binsHR(nb)*1.e-4 +! END DO + + + + DO nb=1,nbins + ldmd=(log(itv(nb+1))-log(itv(nb)))/2. + sizedust(nb)=exp(log(itv(nb))+ldmd) + PRINT*,nb, itv(nb),' < ',sizedust(nb),' < ',itv(nb+1) + ENDDO +! Making dust size distribution (in cm) ??? + DO nb=1,nbins + szdcm(nb)=sizedust(nb)*1.e-4 + ENDDO +!c preparation of emissions reaffectation. + DO k=1,ndistb + exden=sqrt(2.)*log(sig(k)) + DO nb=1,nbins + d2min=itv(nb) + d2max=itv(nb+1) + numin=log(d2min/diam(k)) + numax=log(d2max/diam(k)) + massfrac(k,nb)=0.5*(erf(numax/exden)-erf(numin/exden)) + !print *,k,nb,massfrac(k,nb) + ENDDO + ENDDO + +!$OMP MASTER +IF (is_mpi_root .AND. is_omp_root) THEN + OPEN (unit=15001, file='massfrac') + DO k=1,ndistb + DO nb=1,nbins + write(15001,*),k,nb,massfrac(k,nb) + ENDDO + ENDDO +ENDIF +!$OMP END MASTER +!$OMP BARRIER + + !CALL abort_gcm('calcdustemission', 'OK1',1) + + !------------ + + + END SUBROUTINE initdust + +!-------------------------------------------------------------------------------------- +!====================================================================================== +!************************************************************************************** +!====================================================================================== +!-------------------------------------------------------------------------------------- + + SUBROUTINE calcdustemission(debutphy,zu10m,zv10m,wstar, & + ale_bl,ale_wake,param_wstarBL,param_wstarWAKE, & + emisbin) + ! emisions over 12 dust bin + USE dimphy + USE infotrac + + IMPLICIT NONE + ! Input + LOGICAL, INTENT(IN) :: debutphy ! First physiqs run or not + REAL,DIMENSION(klon),INTENT(IN) :: zu10m ! 10m zonal wind + REAL,DIMENSION(klon),INTENT(IN) :: zv10m ! meridional 10m wind + REAL,DIMENSION(klon),INTENT(IN) :: wstar + REAL,DIMENSION(klon),INTENT(IN) :: ale_bl + REAL,DIMENSION(klon),INTENT(IN) :: ale_wake + + ! Local variables +! INTEGER, PARAMETER :: flag_wstar=150 +! INTEGER, PARAMETER :: flag_wstar=120 +! INTEGER, PARAMETER :: flag_wstar=125 + REAL,DIMENSION(klon), INTENT(IN) :: param_wstarWAKE + REAL,DIMENSION(klon), INTENT(IN) :: param_wstarBL + REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: fluxdust ! horizonal emission fluxes in UNITS for the nmod soil aerosol modes + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: wind10ms ! 10m wind distribution in m/s + REAL,DIMENSION(:), ALLOCATABLE,SAVE :: wind10cm ! 10m wind distribution in cm/s + REAL,DIMENSION(klon) :: zwstar + REAL,DIMENSION(nwb) :: probu +! REAL, DIMENSION(nmode) :: fluxN,ftN,adN,fdpN,pN,eN ! in the original code N=1,2,3 + REAL :: flux1,flux2,flux3,ft1,ft2,ft3 + + + REAL, PARAMETER :: umin=21. + REAL, PARAMETER :: woff=0.5 ! min value of 10m wind speed accepted for emissions + REAL :: pdfcum,U10mMOD,pdfu,weilambda + REAL :: z0salt,ceff,cerod,cpcent + REAL :: cdnms,ustarns,modwm,utmin +!JE20150202 REAL :: cdnms,ustarns,modwm + REAL :: fdp1,fdp2,ad1,ad2,ad3,flux_diam + REAL :: dfec1,dfec2,dfec3,t1,t2,t3,p1,p2,p3,dec,ec + ! auxiliar counters + INTEGER :: kwb + INTEGER :: i,j,k,l,n + INTEGER :: kfin,ideb,ifin,kfin2,istep + REAL :: auxreal + + ! Output + !REAL,DIMENSION(:,:), ALLOCATABLE,SAVE :: emisbin ! vertical emission fluxes in UNITS for the 12 bins + REAL,DIMENSION(klon,nbins) :: emisbin ! vertical emission fluxes in UNITS for the 12 bins +!$OMP THREADPRIVATE(fluxdust) +!$OMP THREADPRIVATE(wind10ms) +!$OMP THREADPRIVATE(wind10cm) + + !---------------------------------------------------- + ! initialization + !---------------------------------------------------- + IF (debutphy) THEN +! ALLOCATE( emisbin(klon,nbins) ) + ALLOCATE( fluxdust(klon,nmode) ) + ALLOCATE( wind10ms(nwb) ) + ALLOCATE( wind10cm(nwb) ) + ENDIF !debutphy + + + DO i=1,klon + DO j=1,nbins + emisbin(i,j) = 0.0 + ENDDO !j,nbind + DO j=1,nmode + fluxdust(i,j) = 0.0 + ENDDO !j,nmode + zwstar(i) = 0.0 + ENDDO !i,klon + !---------------------------------------------------- + ! calculations + !---------------------------------------------------- + + ! including BL processes.. +!JE201041120 zwstar=sqrt(2.*(ale_bl+0.01*(flag_wstar-100)*ale_wake)) +!JE20141124 zwstar=sqrt(2.*(flag_wstarBL*ale_bl+0.01*(flag_wstar-100)*ale_wake)) +! print +!*,'zwstar=sqrt(2.*(',flag_wstarBL,'ale_bl+0.01*(',flag_wstar,'-100)*ale_wake))' + ! + DO i=1,klon ! main loop + zwstar(i)=sqrt(2.*(param_wstarBL(i)*ale_bl(i)+param_wstarWAKE(i)*ale_wake(i))) + U10mMOD=MAX(woff,sqrt(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i))) + pdfcum=0. + ! Wind weibull distribution: + + DO kwb=1,nwb + flux1=0. + flux2=0. + flux3=0. +!JE20141205<< differences in weibull distribution: expectance of the distribution is +!0.89*U10mMODD instead of U10mMOD +! now: lambda parameter of weibull ditribution is estimated as +! lambda=U10mMOD/gamma(1+1/kref) +! gamma function estimated with stirling formula + auxreal=1.+1./kref + weilambda = U10mMOD/exp(auxreal*log(auxreal)-auxreal & + - 0.5*log(auxreal/(2.*pi))+1./(12.*auxreal) & + -1./(360.*(auxreal**3.))+1./(1260.*(auxreal**5.))) + IF(nwb.gt.1)THEN + wind10ms(kwb)=kwb*2.*U10mMOD/nwb +!original +! pdfu=(kref/U10mMOD)*(wind10ms(kwb)/U10mMOD)**(kref-1) & +! *exp(-(wind10ms(kwb)/U10mMOD)**kref) + pdfu=(kref/weilambda)*(wind10ms(kwb)/weilambda)**(kref-1) & + *exp(-(wind10ms(kwb)/weilambda)**kref) +! !print *,'JEdbg U10mMOD weilambda ',U10mMOD,weilambda +!JE20141205>> + + probu(kwb)=pdfu*2.*U10mMOD/nwb + pdfcum=pdfcum+probu(kwb) + IF(probu(kwb).le.1.e-2)GOTO 70 + ELSE + wind10ms(kwb)=U10mMOD + probu(kwb)=1. + ENDIF + wind10cm(kwb)=wind10ms(kwb)*100. + DO n=1,ntyp + ft1=0. + ft2=0. + ft3=0. +!JE20150129<<<< + + IF(.FALSE.) THEN +! nat=int(sol(i,n)) +! print *,i,n + IF(sol(i,n).gt.1..and.sol(i,n).lt.15.) nat=int(sol(i,n)) +!JE20140526<< +! print *,'JE: WARNING: nat=0 forced to nat=99!! and doing nothing' + IF(sol(i,n).lt.0.5) THEN + nat=99 + GOTO 80 + ENDIF +!JE20140526>> + + + !IF(n.eq.1.and.nat.eq.99)GOTO 80 + ! if(n.eq.1) print*,'nat1=',nat,'sol1=',sol(i,n) + IF(n.eq.1.and.nat.eq.99)GOTO 80 + + ENDIF + IF(.TRUE.) THEN + nat=int(sol(i,n)) + if(n == 1 .and. nat >= 14 .or. nat < 1 .or. nat > 19) GOTO 80 + ENDIF +!JE20150129>>>> + + z0salt=z02(i,n) + ceff=feff(i,n) + cerod=A(i,n) + cpcent=P(i,n) + ustarsalt=0. + IF(ceff.le.0..or.z0salt.eq.0.)GOTO 80 + IF(cerod.eq.0.or.cpcent.eq.0.)GOTO 80 +! in cm: utmin, umin, z10m, z0salt, ustarns +! in meters: modwm +! no dimension for: cdnms +! Cas ou wsta=0. + cdnms=vkarm/(log(z10m/z0salt)) + modwm=sqrt((wind10ms(kwb)**2)+(1.2*zwstar(i))**2) + ustarns=cdnms*modwm*100. +!JE20150202 << +! Do not have too much sense.. and is not anymore in the chimere14b version. +! +! utmin=umin/(cdnms*ceff) +! IF(wind10cm(kwb).ge.utmin)THEN +! ustarsalt=ustarns+ & +! (0.3*(wind10cm(kwb)/100.-utmin/100.)**2.) +! ELSE +! ustarsalt=ustarns +! ENDIF +! ustarsalt should be : + ustarsalt=ustarns +!JE20150202 >> + + + IF(ustarsalt.lt.umin/ceff)GOTO 80 +! print*,'ustarsalt = ',ustarsalt +!---------------------------------------- + CALL def_copyncl(kfin) + +! CALL def_ag01(kfin,ft1,ft2,ft3) + do ni=1,kfin + fdp1=1.-(uth2(ni)/(ceff*ustarsalt)) + if (fdp1.le.0..or.srel2(nat,ni).eq.0.) then + ad1=0. + ad2=0. + ad3=0. + else + + fdp2=(1.+(uth2(ni)/(ceff*ustarsalt)))**2. + flux_diam=cd*srel2(nat,ni)*fdp1*fdp2*(ustarsalt**3) + dec=flux_diam*beta + ec=(pi/3.)*1.e+2*rop* (sizeclass2(ni)**3) *(ustarsalt**2) + dfec1=(ec-e1) + dfec2=(ec-e2) + dfec3=(ec-e3) + t1=0. + t2=0. + t3=0. + if(ec.ge.e1)t1=1. + if(ec.ge.e2)t2=1. + if(ec.ge.e3)t3=1. + if(dfec3.ne.0.)then + p1=t1*dfec1/dfec3 + p2=t2*(1.-p1)*dfec2/dfec3 + else + p1=0. + p2=0. + endif + p3=t3*(1.-p1-p2) + ad1=(pi/6.)*dec*rop*p1*((diam(1)*1.e-4)**3.)/e1 + ad2=(pi/6.)*dec*rop*p2*((diam(2)*1.e-4)**3.)/e2 + ad3=(pi/6.)*dec*rop*p3*((diam(3)*1.e-4)**3.)/e3 + + endif + ft1=ft1+ad1 + ft2=ft2+ad2 + ft3=ft3+ad3 + enddo ! of loop over nc + +!.... + + flux1=flux1+ft1*cpcent*cerod + flux2=flux2+ft2*cpcent*cerod + flux3=flux3+ft3*cpcent*cerod +! print *,'JEflux :',kwb,n,flux1,flux2,flux3 +80 CONTINUE + ENDDO !n=1,ntyp +70 CONTINUE + fluxdust(i,1)=fluxdust(i,1)+flux1*probu(kwb) + fluxdust(i,2)=fluxdust(i,2)+flux2*probu(kwb) + fluxdust(i,3)=fluxdust(i,3)+flux3*probu(kwb) + ENDDO !kwb=1,nwb + m1dflux(i)=10.*fluxdust(i,1) + m2dflux(i)=10.*fluxdust(i,2) ! tous en Kg/m2/s + m3dflux(i)=10.*fluxdust(i,3) + + + + ENDDO ! i, klon + + + + + !from horizontal to vertical fluxes for each bin + DO k=1,klon + DO i=1,ndistb + DO j=1,nbins +!JE20150202 << + emisbin(k,j) = emisbin(k,j)+10*fluxdust(k,i)*massfrac(i,j) +!JE20150202 >> + ENDDO !j, nbind + ENDDO !i, nmode + ENDDO !k,klon + + +!print *,' JE fluxdust in calcdust' +! DO k=1,klon +! DO i=1,ndistb +!!print *,k,i,fluxdust(k,i) +!enddo +!enddo +!print *,' JE emisbin in calcdust' +!do k=1,klon +!do j=1,nbins +!!print *,k,j,emisbin(k,j) +!enddo +!enddo +! CALL abort_gcm('calcdustemission', 'OK1',1) + + END SUBROUTINE calcdustemission +!-------------------------------------------------------------------------------------- +!====================================================================================== +!************************************************************************************** +!====================================================================================== +!-------------------------------------------------------------------------------------- + + + +SUBROUTINE def_copyncl(kfin) + implicit none + + integer i,n,kfin,ideb,ifin,istep,kfin2 + real dsmin,dsmax + +! estimation of the reduced soil size distribution + dsmin=var3a*(ustarsalt**(-2./3.)) + dsmax=var3b*(ustarsalt**(-2./3.)) +! print*,'ustarsalt = ',ustarsalt,'dsmin=',dsmin,'dsmax=',dsmax +! dichotomy + call def_dichotomy(sizeclass,nclass,1,ncl,dsmin,ideb) + ! print*,'ideb = ',ideb + call def_dichotomy(sizeclass,nclass,ideb,ncl,dsmax,ifin) + ! print*,'ifin = ',ifin +! readaptation of large sizes particles + kfin=0 + do i=ideb,ifin + kfin=kfin+1 + sizeclass2(kfin)=sizeclass(i) + uth2(kfin)=uth(i) + srel2(nat,kfin)=srel(nat,i) + enddo + ! print*,'je suis la' + kfin2=kfin + istep=50 + do i=ifin,ncl,istep + kfin=kfin+1 + sizeclass2(kfin)=sizeclass(i) + uth2(kfin)=uth(i) + srel2(nat,kfin)=srel(nat,i)*istep + enddo + if(kfin.ge.nclass)then + print*,'$$$$ Tables dimension problem:',kfin,'>',nclass + endif +!--------------- + + return +END SUBROUTINE def_copyncl + +!-------------------------------------------------------------------------------------- +!====================================================================================== +!************************************************************************************** +!====================================================================================== +!-------------------------------------------------------------------------------------- + +subroutine def_dichotomy(siz,nclass,i1,i2,ds,iout) +!c--------------------------------------------------------------- +!c 'size' is the table to scan +!c of dimension 'nclass', and reduced size of interest [i1:i2] +!c 'ds' is the value to find in 'size' +!c 'iout' is the number in the table 'size' correspondig to 'ds' +!c--------------------------------------------------------------- + + implicit none + integer i1,i2,nclass,iout,ismin,ismax,k2,ihalf,idiff + real siz(nclass),ds +!c----------------------------- + iout=0 + ismin=i1 + ismax=i2 + ihalf=int((ismax+ismin)/2.) + do k2=1,1000000 + if(ds.gt.siz(ihalf))then + ismin=ihalf + else + ismax=ihalf + endif + ihalf=int((ismax+ismin)/2.) + idiff=ismax-ismin + if(idiff.le.1)then + iout=ismin + goto 52 + endif + enddo + 52 continue + if(iout.eq.0)then + print*,'$$$$ Tables dimension problem: ',iout + endif + + end subroutine def_dichotomy + +!-------------------------------------------------------------------------------------- +!====================================================================================== +!************************************************************************************** +!====================================================================================== +!-------------------------------------------------------------------------------------- + + + SUBROUTINE calcvd(vdout) + IMPLICIT NONE + INTEGER :: nb +!JE already def in module INTEGER,PARAMETER :: nbinsHR=3000 + INTEGER,PARAMETER :: idiffusi=1 + INTEGER,PARAMETER :: idrydep=2 + REAL :: dmn1,dmn2,dmn3,ra,rb + REAL :: rhod,muair,nuair,R,airmolw + REAL :: bolz,rhoair,gravity,karman,zed,z0m + REAL :: ustarbin,temp,pres,rac,lambda,ccexp + REAL :: Cc,rexp,pi,St + REAL,DIMENSION(nbinsHR) :: setvel + REAL,DIMENSION(nbinsHR) :: diffmol1 + REAL,DIMENSION(nbinsHR) :: diffmol2 + REAL,DIMENSION(nbinsHR) :: schmidtnumb + REAL,DIMENSION(nbinsHR) :: diffmole + + REAL,DIMENSION(nbinsHR), INTENT(OUT) :: vdout +! users physical parameters + temp=273.15+25. ! in Kelvin degrees + pres=1013. ! in hPa +! calculation of Ra + zed=10. + z0m=0.05 + karman=0.41 + ustarbin=30. ! cm/s + ra=log(zed/z0m)/(karman*ustarbin) +!c physical constants (all must in units g / cm / s) + rhod=2.65 ! g.cm-3 + muair=1.72e-4 ! g.cm-1.s-1 + nuair=0.1461 ! air kinematic viscosity [cm2.s-1] + R=8.314 ! molar gas constant J.mol-1.K-1 + airmolw=28.8 ! molar weight of air + bolz=1.38e-16 ! g.cm2.s-2 + rhoair=1.225e-3 ! g.cm-3 + gravity=981. ! gravity [cm.s-2] + pi=3.14159 + rac=sqrt(8.0*airmolw/(pi*R*temp)) + lambda=(2.*muair)/(pres*rac) +! c Cc and Vs +! binsHRcm=binsize*1.e-4 + DO nb=1,nbinsHR + ccexp=exp((-0.55*binsHRcm(nb))/lambda) + Cc=1.+(2.*lambda)/binsHRcm(nb)*(1.257+0.4*ccexp) + setvel(nb)=(1./18.)*((binsHRcm(nb))**2*rhod*gravity*Cc)/muair +!c Molecular diffusivity (s/cm2) and Schmidt number +!c Note that the molecular diffusivity uses diameter in micro-m +!c to give a result directly in s/cm2 + dmn1=2.38e-7/binsHR(nb) + dmn2=0.163/binsHR(nb) + dmn3=0.0548*exp(-6.66*binsHR(nb))/binsHR(nb) + diffmol1(nb)=dmn1*(1.+dmn2+dmn3) + diffmol2(nb)=bolz*temp*Cc/(3.*pi*muair*binsHRcm(nb)) + IF(idiffusi.EQ.1)diffmole(nb)=diffmol1(nb) + IF(idiffusi.EQ.2)diffmole(nb)=diffmol2(nb) + schmidtnumb(nb)=nuair/diffmole(nb) + St=setvel(nb)*ustarbin*ustarbin/(gravity*nuair) + rb=1./(ustarbin*((schmidtnumb(nb))**(-2./3.)+10.**(-3./St))) +!c wesely (primarily designed for gases) + IF(idrydep.EQ.1)THEN + vdout(nb)=1./(ra+rb+ra*rb*setvel(nb))+setvel(nb) + END IF +!c venkatram and pleim (more adaptated to particles but numerically unstable) + IF(idrydep.EQ.2)THEN + rexp=exp(-(ra+rb)*setvel(nb)) + vdout(nb)=setvel(nb)/(1.-rexp) + END IF + END DO +!c----------------- + RETURN + END SUBROUTINE calcvd + + + +END MODULE dustemission_mod + Index: /LMDZ5/trunk/libf/phylmd/Dust/finemission.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/finemission.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/finemission.F (revision 2630) @@ -0,0 +1,144 @@ +C This subroutine calculates the emissions of BLACK CARBON and ORGANIC +C MATTER + SUBROUTINE finemission(zdz,pdtphys,zalt,kminbc,kmaxbc, + . scale_param_bb,scale_param_ff, + . iregion_ind,iregion_bb, + . nbreg_ind,nbreg_bb, + . lmt_bcff,lmt_bcnff,lmt_bcbb_l,lmt_bcbb_h, + . lmt_bcba,lmt_omff,lmt_omnff,lmt_ombb_l, + . lmt_ombb_h,lmt_omnat,lmt_omba,id_fine, + . flux_sparam_bb,flux_sparam_ff, + . source_tr,flux_tr,tr_seri) + + USE dimphy + USE indice_sol_mod + USE infotrac +! USE phytracr_spl_mod, ONLY : nbreg_dust, nbreg_ind, nbreg_bb + IMPLICIT NONE + +#include "dimensions.h" +#include "chem.h" +#include "YOMCST.h" +#include "paramet.h" + + INTEGER i, k, kminbc, kmaxbc +c============================= INPUT =================================== + REAL pdtphys ! pas d'integration pour la physique (seconde) + REAL zalt(klon,klev) + REAL zdz(klon,klev) +c +c------------------------- Scaling Parameters -------------------------- +c + INTEGER nbreg_ind,nbreg_bb + INTEGER iregion_ind(klon) !Defines regions for SO2, BC & OM + INTEGER iregion_bb(klon) !Defines regions for SO2, BC & OM + REAL scale_param_bb(nbreg_bb) !Scaling parameter for biomas burning + REAL scale_param_ff(nbreg_ind) !Scaling parameter for industrial emissions (fossil fuel) + INTEGER id_fine +c============================= OUTPUT ================================== + REAL source_tr(klon,nbtr) + REAL flux_tr(klon,nbtr) + REAL tr_seri(klon,klev,nbtr) ! traceur + REAL flux_sparam_bb(klon), flux_sparam_ff(klon) +c========================= LOCAL VARIABLES ============================= + REAL zzdz +c------------------------- BLACK CARBON emissions ---------------------- + REAL lmt_bcff(klon) ! emissions de BC fossil fuels + REAL lmt_bcnff(klon) ! emissions de BC non-fossil fuels + REAL lmt_bcbb_l(klon) ! emissions de BC biomass basses + REAL lmt_bcbb_h(klon) ! emissions de BC biomass hautes + REAL lmt_bcba(klon) ! emissions de BC bateau +c------------------------ ORGANIC MATTER emissions --------------------- + REAL lmt_omff(klon) ! emissions de OM fossil fuels + REAL lmt_omnff(klon) ! emissions de OM non-fossil fuels + REAL lmt_ombb_l(klon) ! emissions de OM biomass basses + REAL lmt_ombb_h(klon) ! emissions de OM biomass hautes + REAL lmt_omnat(klon) ! emissions de OM Natural + REAL lmt_omba(klon) ! emissions de OM bateau + + EXTERNAL condsurfc +c======================================================================== +c LOW LEVEL EMISSIONS +c======================================================================== + +c corresponds to bc_source.EQ.3 + + DO i=1,klon + IF (iregion_ind(i).GT.0) THEN + IF(id_fine>0) source_tr(i,id_fine)=source_tr(i,id_fine)+ + . (scale_param_ff(iregion_ind(i))*lmt_bcff(i)+ !g/m2/s + . scale_param_ff(iregion_ind(i))*lmt_omff(i) + . ) * 1.e4 !g/m2/s +c + IF(id_fine>0) flux_tr(i,id_fine)=flux_tr(i,id_fine)+ + . (scale_param_ff(iregion_ind(i))*lmt_bcff(i)+ !mg/m2/s + . scale_param_ff(iregion_ind(i))*lmt_omff(i) + . ) * 1.e4 *1.e3 !mg/m2/s +c + flux_sparam_ff(i)= flux_sparam_ff(i) + + . scale_param_ff(iregion_ind(i))* + . ( lmt_bcff(i)+lmt_omff(i)) + . *1.e4*1.e3 + ENDIF + IF (iregion_bb(i).GT.0) THEN + IF(id_fine>0) source_tr(i,id_fine)=source_tr(i,id_fine)+ + . (scale_param_bb(iregion_bb(i))*lmt_bcbb_l(i)+ !g/m2/s + . scale_param_bb(iregion_bb(i))*lmt_ombb_l(i) !g/m2/s + . ) * 1.e4 !g/m2/s +c + IF(id_fine>0) flux_tr(i,id_fine)=flux_tr(i,id_fine)+ + . (scale_param_bb(iregion_bb(i))*lmt_bcbb_l(i)+ !mg/m2/s + . scale_param_bb(iregion_bb(i))*lmt_ombb_l(i)+ !mg/m2/s + . scale_param_bb(iregion_bb(i))*lmt_bcbb_h(i)+ !mg/m2/s + . scale_param_bb(iregion_bb(i))*lmt_ombb_h(i) !mg/m2/s + . ) * 1.e4 *1.e3 !mg/m2/s +c + flux_sparam_bb(i)=flux_sparam_bb(i) + + . scale_param_bb(iregion_bb(i))*(lmt_bcbb_l(i) + + . lmt_bcbb_h(i) + lmt_ombb_l(i) + lmt_ombb_h(i)) + . *1.e4*1.e3 + ENDIF + IF(id_fine>0) source_tr(i,id_fine)=source_tr(i,id_fine)+ + . (lmt_bcnff(i)+lmt_bcba(i)+lmt_omnff(i)+ + . lmt_omnat(i)+lmt_omba(i)) * 1.e4 !g/m2/s +c + IF(id_fine>0) flux_tr(i,id_fine)=flux_tr(i,id_fine)+ + . (lmt_bcnff(i)+lmt_omnff(i)+lmt_omnat(i)+ + . lmt_omba(i)+lmt_bcba(i)) * 1.e4 *1.e3 !mg/m2/s +c + flux_sparam_ff(i)= flux_sparam_ff(i) + + . (lmt_omba(i)+lmt_bcba(i))*1.e4*1.e3 + ENDDO + +c======================================================================== +c HIGH LEVEL EMISSIONS +c======================================================================== + +c Sources hautes de BC/OM + +c +c HIGH LEVEL EMISSIONS OF SO2 ARE IN PRECUREMISSION.F +c + k=2 !introducing emissions in level 2 +cnhl DO i = 1, klon +c +cnhl tr_seri(i,k,id_fine)=tr_seri(i,k,id_fine)+scale_param_ff(iregion_ind(i))* +cnhl . (lmt_bcff_h(i)+lmt_omff_h(i))/zdz(i,k)/100.*pdtphys +c +cnhl ENDDO + + DO k=kminbc, kmaxbc + DO i = 1, klon + zzdz=zalt(i,kmaxbc+1)-zalt(i,kminbc) +c + IF (iregion_bb(i) .GT.0) THEN + IF(id_fine>0) tr_seri(i,k,id_fine)=tr_seri(i,k,id_fine)+ + . (scale_param_bb(iregion_bb(i))*lmt_bcbb_h(i)+ + . scale_param_bb(iregion_bb(i))*lmt_ombb_h(i)) + . /zzdz/100.*pdtphys + ENDIF +c + ENDDO + ENDDO +c + END Index: /LMDZ5/trunk/libf/phylmd/Dust/gastoparticle.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/gastoparticle.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/gastoparticle.F (revision 2630) @@ -0,0 +1,92 @@ + SUBROUTINE gastoparticle(pdtphys,zdz,zrho,xlat,pplay,t_seri, + . id_prec,id_fine, + . tr_seri,his_g2pgas ,his_g2paer ) +cnhl . fluxso4chem, flux_sparam_sulf, + + USE dimphy + USE infotrac +c USE indice_sol_mod + + IMPLICIT NONE +c +#include "dimensions.h" +#include "chem.h" +#include "chem_spla.h" +#include "YOMCST.h" +#include "YOECUMF.h" +c + REAL pdtphys + REAL zrho(klon,klev) + REAL zdz(klon,klev) + REAL tr_seri(klon,klev,nbtr) ! traceurs + REAL tend ! tendance par espece + REAL xlat(klon) ! latitudes pour chaque point + REAL pi +c JE: 20140120 + REAL his_g2pgas(klon) + REAL his_g2paer(klon) + REAL tendincm3(klon,klev) + REAL tempvar(klon,klev) + REAL pplay(klon,klev) + REAL t_seri(klon,klev) + REAL tend2d(klon,klev) + INTEGER id_prec,id_fine +c +c------------------------- Scaling Parameter -------------------------- +c +c REAL scale_param_so4(klon) !Scaling parameter for sulfate + + INTEGER i, k + REAL tau_chem !---chemical lifetime in s +c +c------------------------- Variables to save -------------------------- +c +cnhl REAL fluxso4chem(klon,klev) +cnhl REAL flux_sparam_sulf(klon,klev) + +c====================================================================== + pi=atan(1.)*4. +c + IF (id_prec>0 .AND. id_fine>0) THEN + DO k = 1, klev + DO i = 1, klon +c +c tau_chem=scale_param_so4(i)*86400.*(8.-5.*cos(xlat(i)*pi/180.)) !tchemfctn2 +cnhl tau_chem=86400.*(8.-5.*cos(xlat(i)*pi/180.)) !tchemfctn2 + tau_chem=86400.*(5.-4.*cos(xlat(i)*pi/180.)) ! + tend=tr_seri(i,k,id_prec)*(1.-exp(-pdtphys/tau_chem)) ! Sulfate production +cnhl tend=(1.-exp(-pdtphys/tau_chem)) +cnhl tend=scale_param_so4(i) !as this it works +c + tr_seri(i,k,id_prec) =tr_seri(i,k,id_prec) - tend + tr_seri(i,k,id_fine) =tr_seri(i,k,id_fine) + + . tend/RNAVO*masse_ammsulfate !--gAER/KgAir + tend2d(i,k)=tend +c +cnhl fluxso4chem(i,k) = tend/RNAVO*masse_ammsulfate +cnhl flux_sparam_sulf(i,k) = tend/RNAVO*masse_ammsulfate + ENDDO + ENDDO + + + + tempvar=tend2d + CALL kg_to_cm3(pplay,t_seri,tempvar) + tendincm3=tempvar + + DO k = 1, klev + DO i = 1, klon + +c his_g2pgas(i) = his_g2pgas(i) + tendincm3(i,k)*1e6*zdz(i,k)/pdtphys + his_g2paer(i) = his_g2paer(i) + + . tendincm3(i,k)/RNAVO*masse_ammsulfate*1.e3* + . 1.e6*zdz(i,k)/pdtphys ! mg/m2/s + his_g2pgas(i) = his_g2paer(i)*masse_s/masse_ammsulfate ! mg-S/m2/s + + ENDDO + ENDDO + ENDIF + +c + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/incloud_scav.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/incloud_scav.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/incloud_scav.F (revision 2630) @@ -0,0 +1,100 @@ +c Subroutine that calculates the effect of precipitation in scavenging +c WITHIN the cloud, for large scale as well as convective precipitation + SUBROUTINE incloud_scav(lminmax,qmin,qmax,masse,henry,kk,prfl, + . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys, + . his_dhlsc,his_dhcon1,tr_seri) + + USE dimphy + USE infotrac + USE indice_sol_mod + + IMPLICIT NONE + +#include "dimensions.h" +#include "chem.h" +#include "YOMCST.h" +#include "paramet.h" + +c============================= INPUT =================================== + REAL qmin, qmax + REAL masse(nbtr) + REAL henry(nbtr) !--cste de Henry mol/l/atm + REAL kk(nbtr) !--coefficient de var avec T (K) + REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale +! REAL prfl(klon,klev), psfl(klon,klev) !--large-scale + REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection +! REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection + REAL zrho(klon,klev), zdz(klon,klev) + REAL t_seri(klon,klev) + LOGICAL lminmax + REAL pdtphys +! REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale ! Titane +! REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection ! Titane +c============================= OUTPUT ================================== + REAL tr_seri(klon,klev,nbtr) ! traceur + REAL aux_var1(klon,klev) ! traceur + REAL aux_var2(klon) ! traceur + REAL aux_var3(klon) ! traceur + REAL his_dhlsc(klon,nbtr) ! in-cloud scavenging lsc + REAL his_dhcon1(klon,nbtr) ! in-cloud scavenging con +c========================= LOCAL VARIABLES ============================= + INTEGER it, i, j + + EXTERNAL minmaxqfi, inscav_spl + + DO it=1, nbtr +c + DO i=1,klon + aux_var2(i)=his_dhlsc(i,it) + aux_var3(i)=his_dhcon1(i,it) + ENDDO + DO j=1,klev + DO i=1,klon + aux_var1(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO +c + IF (lminmax) THEN + CALL minmaxqfi(aux_var1,qmin,qmax,'avt inscav') +cnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'avt inscav') + ENDIF +c +cnhl CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),0.5e-3, +cnhl . prfl,psfl,zrho,zdz,t_seri,tr_seri(1,1,it), +cnhl . his_dhlsc(1,it)) + CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),0.5e-3, + . prfl,psfl,zrho,zdz,t_seri,aux_var1,aux_var2) +c + IF (lminmax) THEN + CALL minmaxqfi(aux_var1,qmin,qmax,'depot humide lsc') +cnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide lsc') + ENDIF +c +c +c-scheme for convective in-cloud scavenging +c +cnhl CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),1.e-3, +cnhl . pmflxr,pmflxs,zrho,zdz,t_seri,tr_seri(1,1,it), +cnhl . his_dhcon1(1,it)) + CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),1.e-3, + . pmflxr,pmflxs,zrho,zdz,t_seri,aux_var1,aux_var3) +c + IF (lminmax) THEN + CALL minmaxqfi(aux_var1,qmin,qmax,'depot humide con') +cnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide con') + ENDIF +c + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=aux_var1(i,j) + ENDDO + ENDDO + DO i=1,klon + his_dhlsc(i,it)=aux_var2(i) + his_dhcon1(i,it)=aux_var3(i) + ENDDO + +c + ENDDO !--boucle sur it + + END Index: /LMDZ5/trunk/libf/phylmd/Dust/incloud_scav_lsc.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/incloud_scav_lsc.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/incloud_scav_lsc.F (revision 2630) @@ -0,0 +1,112 @@ +c Subroutine that calculates the effect of precipitation in scavenging +c WITHIN the cloud, for large scale as well as convective precipitation + SUBROUTINE incloud_scav_lsc(lminmax,qmin,qmax,masse,henry,kk,prfl, + . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys, + . his_dhlsc,his_dhcon1,tr_seri) + + USE dimphy + USE infotrac + USE indice_sol_mod + + IMPLICIT NONE + +#include "dimensions.h" +#include "chem.h" +#include "YOMCST.h" +#include "paramet.h" + +c============================= INPUT =================================== + REAL qmin, qmax + REAL masse(nbtr) + REAL henry(nbtr) !--cste de Henry mol/l/atm + REAL kk(nbtr) !--coefficient de var avec T (K) + REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale +! REAL prfl(klon,klev), psfl(klon,klev) !--large-scale + REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection +! REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection + REAL zrho(klon,klev), zdz(klon,klev) + REAL t_seri(klon,klev) + LOGICAL lminmax + REAL pdtphys +! REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale ! Titane +! REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection ! Titane +c============================= OUTPUT ================================== + REAL tr_seri(klon,klev,nbtr) ! traceur + REAL aux_var1(klon,klev) ! traceur + REAL aux_var2(klon) ! traceur + REAL aux_var3(klon) ! traceur + REAL his_dhlsc(klon,nbtr) ! in-cloud scavenging lsc + REAL his_dhcon1(klon,nbtr) ! in-cloud scavenging con +c========================= LOCAL VARIABLES ============================= + INTEGER it, i, j + + EXTERNAL minmaxqfi, inscav_spl + DO it=1, nbtr +c + DO i=1,klon + aux_var2(i)=his_dhlsc(i,it) + aux_var3(i)=his_dhcon1(i,it) + ENDDO + DO j=1,klev + DO i=1,klon + aux_var1(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO +c + IF (lminmax) THEN + CALL minmaxqfi(aux_var1,qmin,qmax,'avt inscav') +cnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'avt inscav') + ENDIF +c +cnhl CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),0.5e-3, +cnhl . prfl,psfl,zrho,zdz,t_seri,tr_seri(1,1,it), +cnhl . his_dhlsc(1,it)) + CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),0.5e-3, + . prfl,psfl,zrho,zdz,t_seri,aux_var1,aux_var2) +c + IF (lminmax) THEN + CALL minmaxqfi(aux_var1,qmin,qmax,'depot humide lsc') +cnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide lsc') + ENDIF +c +c +c-scheme for convective in-cloud scavenging +c +cnhl CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),1.e-3, +cnhl . pmflxr,pmflxs,zrho,zdz,t_seri,tr_seri(1,1,it), +cnhl . his_dhcon1(1,it)) + +c print *,'JE inscav0' +c IF (iflag_con.LT.3) THEN +c +c print *,'JE inscav1' +c print *,'iflag_con',iflag_con +c CALL inscav_spl(pdtphys,it,masse(it),henry(it),kk(it),1.e-3, +c . pmflxr,pmflxs,zrho,zdz,t_seri,aux_var1,aux_var3) +c +cc +c IF (lminmax) THEN +c CALL minmaxqfi(aux_var1,qmin,qmax,'depot humide con') +ccnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'depot humide con') +c +c ENDIF +c +c ENDIF ! iflag_con + +c +c print *,'JE inscav2' + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=aux_var1(i,j) + ENDDO + ENDDO + DO i=1,klon + his_dhlsc(i,it)=aux_var2(i) + his_dhcon1(i,it)=aux_var3(i) + ENDDO + +c + ENDDO !--boucle sur it + +c print *,'JE inscav3' + END Index: /LMDZ5/trunk/libf/phylmd/Dust/inscav_spl.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/inscav_spl.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/inscav_spl.F (revision 2630) @@ -0,0 +1,140 @@ + SUBROUTINE inscav_spl(pdtime,it,masse,henry,kk,qliq, + . flxr,flxs,zrho,zdz,t,x, + . his_dh) + USE dimphy + IMPLICIT NONE +c===================================================================== +c Objet : depot humide de traceurs +c Date : mars 1998 +c Auteur: O. Boucher (LOA) +c===================================================================== +c +#include "dimensions.h" +#include "chem.h" +#include "YOMCST.h" +#include "YOECUMF.h" +c + INTEGER it + REAL pdtime ! pas de temps (s) + REAL masse ! molar mass (except for BC/OM/IF/DUST=Nav) + REAL henry ! constante de Henry en mol/l/atm + REAL kk ! coefficient de dependence en T (K) + REAL qliq ! contenu en eau liquide dans le nuage (kg/kg) +! REAL flxr(klon,klev+1) ! flux precipitant de pluie +! REAL flxs(klon,klev+1) ! flux precipitant de neige + REAL flxr(klon,klev) ! flux precipitant de pluie ! Titane + REAL flxs(klon,klev) ! flux precipitant de neige ! Titane + REAL flxr_aux(klon,klev+1) + REAL flxs_aux(klon,klev+1) + REAL zrho(klon,klev) + REAL zdz(klon,klev) + REAL t(klon,klev) + REAL x(klon,klev) ! q de traceur + REAL his_dh(klon) ! tendance de traceur integre verticalement +c +c--variables locales + INTEGER i, k +c + REAL dx ! tendance de traceur + REAL f_a !--rapport de la phase aqueuse a la phase gazeuse + REAL beta !--taux de conversion de l'eau en pluie + REAL henry_t !--constante de Henry a T t (mol/l/atm) + REAL scav(klon,klev) !--fraction aqueuse du constituant + REAL K1, K2, ph, frac + REAL frac_gas, frac_aer !-cste pour la reevaporation + PARAMETER (ph=5., frac_gas=1.0, frac_aer=0.5) +c---cste de dissolution pour le depot humide + REAL frac_fine_scav,frac_coar_scav +c---added by nhl + REAL aux_cte + + PARAMETER (frac_fine_scav=0.7) + PARAMETER (frac_coar_scav=0.7) + +c--101.325 m3/l x Pa/atm +c--R Pa.m3/mol/K +c +c------------------------------------------ +c +cnhl IF (it.EQ.2.OR.it.EQ.3) THEN !--aerosol ! AS IT WAS FIRST + IF (it.EQ.2.OR.it.EQ.3.OR.it.EQ.4) THEN !--aerosol + frac=frac_aer + ELSE !--gas + frac=frac_gas + ENDIF +c + IF (it.EQ.1) THEN + DO k=1, klev + DO i=1, klon + henry_t=henry*exp(-kk*(1./298.-1./t(i,k))) !--mol/l/atm + K1=1.2e-2*exp(-2010*(1/298.-1/t(i,k))) + K2=6.6e-8*exp(-1510*(1/298.-1/t(i,k))) + henry_t=henry_t*(1 + K1/10.**(-ph) + K1*K2/(10.**(-ph))**2) + f_a=henry_t/101.325*R*t(i,k)*qliq*zrho(i,k)/rho_water + scav(i,k)=f_a/(1.+f_a) + ENDDO + ENDDO + ELSEIF (it.EQ.2) THEN + DO k=1, klev + DO i=1, klon + scav(i,k)=frac_fine_scav + ENDDO + ENDDO + ELSEIF (it.EQ.3) THEN + DO k=1, klev + DO i=1, klon + scav(i,k)=frac_coar_scav + ENDDO + ENDDO + ELSEIF (it.EQ.4) THEN + DO k=1, klev + DO i=1, klon + scav(i,k)=frac_coar_scav + ENDDO + ENDDO + ELSE + PRINT *,'it non pris en compte' + STOP + ENDIF +c +! NHL +! Auxiliary variables defined to deal with the fact that precipitation +! fluxes are defined on klev levels only. +! NHL +! + flxr_aux(:,klev+1)=0.0 + flxs_aux(:,klev+1)=0.0 + flxr_aux(:,1:klev)=flxr(:,:) + flxs_aux(:,1:klev)=flxs(:,:) + DO k=klev, 1, -1 + DO i=1, klon +c--scavenging + beta=flxr_aux(i,k)-flxr_aux(i,k+1)+flxs_aux(i,k)-flxs_aux(i,k+1) + beta=beta/zdz(i,k)/qliq/zrho(i,k) + beta=MAX(0.0,beta) + dx=x(i,k)*(exp(-scav(i,k)*beta*pdtime)-1.) + x(i,k)=x(i,k)+dx + his_dh(i)=his_dh(i)-dx/RNAVO* + . masse*1.e3*1.e6*zdz(i,k)/pdtime !--mgS/m2/s +c--reevaporation + beta=flxr_aux(i,k)-flxr_aux(i,k+1)+flxs_aux(i,k)-flxs_aux(i,k+1) + IF (beta.LT.0.) beta=beta/(flxr_aux(i,k+1)+flxs_aux(i,k+1)) + IF (flxr_aux(i,k)+flxs_aux(i,k).EQ.0) THEN !--reevaporation totale + beta=MIN(MAX(0.0,-beta),1.0) + ELSE !--reevaporation non totale pour aerosols + !print *,'FRAC USED IN INSCAV_SPL' + beta=MIN(MAX(0.0,-beta)*frac,1.0) + ENDIF + dx=beta*his_dh(i)*RNAVO/masse/1.e3/1.e6/zdz(i,k)*pdtime !ORIG LINE +! funny line for TL/AD +! AD test works without (x) and for xd = dxd*1.e5 : 2.79051851638 times the 0. +! AD test does not work with the line : 754592404.083 times the 0. +! problem seems to be linked to the largest dx wrt x +! x(i, k) = x(i, k) + dx +! x(i, k) = x(i, k) + dx ! THIS LINE WAS COMMENTED OUT ORIGINALY !nhl + his_dh(i)=(1.-beta)*his_dh(i) + ENDDO + ENDDO +c + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/kg_to_cm3.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/kg_to_cm3.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/kg_to_cm3.F (revision 2630) @@ -0,0 +1,22 @@ + SUBROUTINE kg_to_cm3(pplay,t_seri,tr_seri) +c + USE dimphy + USE infotrac + IMPLICIT NONE +c +#include "dimensions.h" +#include "YOMCST.h" +c + REAL t_seri(klon,klev), pplay(klon,klev) + REAL tr_seri(klon,klev) + REAL zrho + INTEGER i, k +c + DO k = 1, klev + DO i = 1, klon + zrho=pplay(i,k)/t_seri(i,k)/RD + tr_seri(i,k)=tr_seri(i,k)/1.e6*zrho + ENDDO + ENDDO +c + END Index: /LMDZ5/trunk/libf/phylmd/Dust/lsc_scav_orig.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/lsc_scav_orig.F90 (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/lsc_scav_orig.F90 (revision 2630) @@ -0,0 +1,291 @@ +!$Id $ + +SUBROUTINE lsc_scav_orig(pdtime,it,iflag_lscav,oliq,flxr,flxs,rneb,beta_fisrt, & + beta_v1,pplay,paprs,t,tr_seri,d_tr_insc, & + d_tr_bcscav,d_tr_evap,qPrls) + USE ioipsl + USE dimphy + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + USE traclmdz_mod + USE infotrac,ONLY : nbtr +!!! USE geometry_mod + USE iophy + + IMPLICIT NONE +!===================================================================== +! Objet : depot humide (lessivage et evaporation) de traceurs +! Inspired by routines of Olivier Boucher (mars 1998) +! author R. Pilon 10 octobre 2012 +! last modification 16/01/2013 (reformulation partie evaporation) +!===================================================================== + + include "dimensions.h" + include "chem.h" + include "YOMCST.h" + include "YOECUMF.h" + + REAL,INTENT(IN) :: pdtime ! time step (s) + INTEGER,INTENT(IN) :: it ! tracer number + INTEGER,INTENT(IN) :: iflag_lscav ! LS scavenging param: +! 3=Reddy_Boucher2004, 4=3+RPilon. + REAL,DIMENSION(klon,klev+1),INTENT(IN) :: flxr ! flux precipitant de pluie + REAL,DIMENSION(klon,klev+1),INTENT(IN) :: flxs ! flux precipitant de neige + REAL,INTENT(IN) :: oliq ! contenu en eau liquide dans le nuage (kg/kg) + REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb + REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression + REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression + REAL,DIMENSION(klon,klev),INTENT(IN) :: t ! temperature +! tracers + REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr_seri ! q de traceur + REAL,DIMENSION(klon,klev),INTENT(IN) :: beta_fisrt ! taux de conversion de l'eau cond + REAL,DIMENSION(klon,klev),INTENT(OUT) :: beta_v1 ! -- (originale version) + REAL,DIMENSION(klon) :: his_dh ! tendance de traceur integre verticalement + REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: d_tr_insc ! tendance du traceur + REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: d_tr_bcscav ! tendance de traceur + REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: d_tr_evap + REAL,DIMENSION(klon,nbtr),INTENT(OUT) :: qPrls !jyg: concentration tra dans pluie LS a la surf. + REAL :: dxin,dxev ! tendance temporaire de traceur incloud + REAL,DIMENSION(klon,klev) :: dxbc ! tendance temporaire de traceur bc + + +! variables locales + LOGICAL,SAVE :: debut=.true. +!$OMP THREADPRIVATE(debut) +! + REAL,PARAMETER :: henry=1.4 ! constante de Henry en mol/l/atm ~1.4 for gases + REAL :: henry_t ! constante de Henry a T t (mol/l/atm) + REAL,PARAMETER :: kk=2900. ! coefficient de dependence en T (K) + REAL :: f_a ! rapport de la phase aqueuse a la phase gazeuse + REAL :: beta ! taux de conversion de l'eau en pluie + + INTEGER :: i, k + REAL,DIMENSION(klon,klev) :: scav ! water liquid content / fraction aqueuse du constituant + REAL,DIMENSION(klon,klev) :: zrho + REAL,DIMENSION(klon,klev) :: zdz + REAL,DIMENSION(klon,klev) :: zmass ! layer mass + + REAL :: frac_ev ! cste pour la reevaporation : dropplet shrinking +! frac_ev = frac_gas ou frac_aer + REAL,PARAMETER :: frac_gas=1.0 ! cste pour la reevaporation pour les gaz + REAL :: frac_aer ! cste pour la reevaporation pour les particules + REAL,DIMENSION(klon,klev) :: deltaP ! P(i+1)-P(i) + REAL,DIMENSION(klon,klev) :: beta_ev ! dP/P(i+1) + +! 101.325 m3/l x Pa/atm +! R Pa.m3/mol/K +! cste de dissolution pour le depot humide + REAL,SAVE :: frac_fine_scav + REAL,SAVE :: frac_coar_scav +!$OMP THREADPRIVATE(frac_fine_scav, frac_coar_scav) + +! below-cloud scav variables +! aerosol : alpha_r=0.001, gas 0.001 (Pruppacher & Klett 1967) + REAL,SAVE :: alpha_r ! coefficient d'impaction pour la pluie + REAL,SAVE :: alpha_s ! coefficient d'impaction pour la neige + REAL,SAVE :: R_r ! mean raindrop radius (m) + REAL,SAVE :: R_s ! mean snow crystal radius (m) +!$OMP THREADPRIVATE(alpha_r, alpha_s, R_r, R_s) + REAL :: pr, ps, ice, water + real :: conserv +! +!!!!!!!!!!!!!!!!!!!! choix lessivage !!!!!!!!!!!!!!!!!!!!!!!! +!! logical,save :: inscav_fisrt +!!! $OMP THREADPRIVATE(inscav_first) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!! + IF (debut) THEN +! +! inscav_fisrt=.true. +! call getin('inscav_fisrt',inscav_fisrt) +! if(inscav_fisrt) then +! print*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt +! else +! print*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt +! endif +! + alpha_r=0.001 ! coefficient d'impaction pour la pluie + alpha_s=0.01 ! coefficient d'impaction pour la neige + R_r=0.001 ! mean raindrop radius (m) + R_s=0.001 ! mean snow crystal radius (m) + frac_fine_scav=0.7 + frac_coar_scav=0.7 +! frac_aer=0.5 ~ droplet size shrinks by evap + frac_aer=0.5 +! + +!JE to speed up, commented 20140219 +! +! OPEN(99,file='lsc_scav_param.data',status='old', & +! form='formatted',err=9999) +! READ(99,*,end=9998) alpha_r +! READ(99,*,end=9998) alpha_s +! READ(99,*,end=9998) R_r +! READ(99,*,end=9998) R_s +! READ(99,*,end=9998) frac_fine_scav +! READ(99,*,end=9998) frac_coar_scav +! READ(99,*,end=9998) frac_aer +!9998 Continue +! CLOSE(99) +!9999 Continue +! +! print*,'alpha_r',alpha_r +! print*,'alpha_s',alpha_s +! print*,'R_r',R_r +! print*,'R_s',R_s +! print*,'frac_fine_scav',frac_fine_scav +! print*,'frac_coar_scav',frac_coar_scav +! print*,'frac_aer ev',frac_aer +! +! JE endcomment +! + ENDIF !(debut) +!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +! initialization + dxin=0. + dxev=0. + beta_ev=0. + + DO i=1,klon + his_dh(i)=0. + ENDDO + + DO k=1,klev + DO i=1, klon + dxbc(i,k)=0. + beta_v1(i,k)=0. + deltaP(i,k)=0. + ENDDO + ENDDO + + DO k=1,klev + DO i=1, klon + d_tr_insc(i,k,it)=0. + d_tr_bcscav(i,k,it)=0. + d_tr_evap(i,k,it)=0. + ENDDO + ENDDO + +! pressure and size of the layer + DO k=klev-1, 1, -1 + DO i=1, klon + zrho(i,k)=pplay(i,k)/t(i,k)/RD + zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG + zmass(i,k)=(paprs(i,k)-paprs(i,k+1))/RG + ENDDO + ENDDO + + IF (it.gt.1) THEN ! aerosol + frac_ev=frac_aer + ELSE ! gas + frac_ev=frac_gas + ENDIF + + IF(it.gt.1) then ! aerosol + DO k=1, klev + DO i=1, klon + scav(i,k)=frac_fine_scav + ENDDO + ENDDO + ELSE ! gas + DO k=1, klev + DO i=1, klon + henry_t=henry*exp(-kk*(1./298.-1./t(i,k))) ! mol/l/atm + f_a=henry_t/101.325*R*t(i,k)*oliq*zrho(i,k)/rho_water + scav(i,k)=f_a/(1.+f_a) + ENDDO + ENDDO + ENDIF + + DO k=klev-1, 1, -1 + DO i=1, klon +! incloud scavenging +! if(inscav_fisrt) then + if (iflag_lscav .eq. 4) then + beta=beta_fisrt(i,k)*rneb(i,k) + else + beta=flxr(i,k)-flxr(i,k+1)+flxs(i,k)-flxs(i,k+1) +! beta=beta/zdz(i,k)/oliq/zrho(i,k) + beta=beta/zmass(i,k)/oliq + beta=MAX(0.,beta) + endif ! (iflag_lscav .eq. 4) + beta_v1(i,k)=beta !! for output +! + dxin=tr_seri(i,k,it)*(exp(-scav(i,k)*beta*pdtime)-1.) +! his_dh(i)=his_dh(i)-dxin*zrho(i,k)*zdz(i,k)/pdtime ! kg/m2/s + his_dh(i)=his_dh(i)-dxin*zmass(i,k)/pdtime ! kg/m2/s + d_tr_insc(i,k,it)=dxin + +! below-cloud impaction + IF(it.eq.1) then + d_tr_bcscav(i,k,it)=0. + ELSE + pr=0.5*(flxr(i,k)+flxr(i,k+1)) + ps=0.5*(flxs(i,k)+flxs(i,k+1)) + water=pr*alpha_r/R_r/rho_water + ice=ps*alpha_s/R_s/rho_ice + dxbc(i,k)=-3./4.*tr_seri(i,k,it)*pdtime*(water+ice) +! add tracers from below cloud scav in his_dh + his_dh(i)=his_dh(i)-dxbc(i,k)*zmass(i,k)/pdtime ! kg/m2/s + d_tr_bcscav(i,k,it)=dxbc(i,k) + ENDIF + +! reevaporation + deltaP(i,k)=flxr(i,k+1)+flxs(i,k+1)-flxr(i,k)-flxs(i,k) + deltaP(i,k)=max(deltaP(i,k),0.) + + if(flxr(i,k+1)+flxs(i,k+1).gt.1.e-16) then + beta_ev(i,k)=deltaP(i,k)/(flxr(i,k+1)+flxs(i,k+1)) + else + beta_ev(i,k)=0. + endif + + beta_ev(i,k)=max(min(1.,beta_ev(i,k)),0.) + +!jyg + + if(abs(1-(1-frac_ev)*beta_ev(i,k)).gt.1.e-16) then +! remove tracers from precipitation owing to release by evaporation in his_dh +! dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) & + dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zmass(i,k)) & + /(1 -(1-frac_ev)*beta_ev(i,k)) + his_dh(i)=his_dh(i)*(1 - frac_ev*beta_ev(i,k) / (1 -(1-frac_ev)*beta_ev(i,k))) + else +! dxev=his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) + dxev=his_dh(i) *pdtime/(zmass(i,k)) + his_dh(i)=0. + endif +! print*, k, 'beta_ev',beta_ev +! remove tracers from precipitation owing to release by evaporation in his_dh +!! dxev=frac_ev*deltaP(i,k)*pdtime * his_dh(i) /(zrho(i,k)*zdz(i,k)) +!rplmd +!! dxev=frac_ev*deltaP(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) & +!! /max(flxr(i,k)+flxs(i,k),1.e-16) + + + d_tr_evap(i,k,it)=dxev +!! tendency is further added in phytrac x = x + dx + ENDDO !! do i + ENDDO !! do k + +!jyg (20130114) + DO i = 1,klon + qPrls(i,it) = his_dh(i)/max(flxr(i,1)+flxs(i,1),1.e-16) + ENDDO +!jyg end + + +! test de conservation + conserv=0. +! DO k= klev,1,-1 +! DO i=1, klon +! conserv=conserv+d_tr_insc(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG & +! +d_tr_bcscav(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG & +! +d_tr_evap(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG +! if(it.eq.3) write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),& +! k,'lsc conserv ',conserv,'insc',d_tr_insc(i,k,it),'bc',d_tr_bcscav(i,k,it),'ev',d_tr_evap(i,k,it) +! ENDDO +! ENDDO + +END SUBROUTINE lsc_scav_orig Index: /LMDZ5/trunk/libf/phylmd/Dust/lsc_scav_spl.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/lsc_scav_spl.F90 (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/lsc_scav_spl.F90 (revision 2630) @@ -0,0 +1,302 @@ +!$Id $ + +SUBROUTINE lsc_scav_spl(pdtime,it,iflag_lscav,oliq,flxr,flxs,rneb,beta_fisrt, & + beta_v1,pplay,paprs,t,tr_seri,d_tr_insc, & + alpha_r,alpha_s,kk, henry, & + id_prec,id_fine,id_coss, id_codu, id_scdu, & + d_tr_bcscav,d_tr_evap,qPrls) + USE ioipsl + USE dimphy + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + USE traclmdz_mod + USE infotrac,ONLY : nbtr +! USE comgeomphy + USE iophy + IMPLICIT NONE +!===================================================================== +! Objet : depot humide (lessivage et evaporation) de traceurs +! Inspired by routines of Olivier Boucher (mars 1998) +! author R. Pilon 10 octobre 2012 +! last modification 16/01/2013 (reformulation partie evaporation) +!===================================================================== +! SPLA version taken from trunk revision 2041 + + include "dimensions.h" + include "chem.h" + include "YOMCST.h" + include "YOECUMF.h" + + REAL,INTENT(IN) :: pdtime ! time step (s) + INTEGER,INTENT(IN) :: it ! tracer number + INTEGER,INTENT(IN) :: iflag_lscav ! LS scavenging param: +! 3=Reddy_Boucher2004, 4=3+RPilon. + REAL,DIMENSION(klon,klev+1),INTENT(IN) :: flxr ! flux precipitant de pluie + REAL,DIMENSION(klon,klev+1),INTENT(IN) :: flxs ! flux precipitant de neige + REAL,INTENT(IN) :: oliq ! contenu en eau liquide dans le nuage (kg/kg) + REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb + REAL,DIMENSION(klon,klev),INTENT(IN) :: pplay ! pression + REAL,DIMENSION(klon,klev+1),INTENT(IN) :: paprs ! pression + REAL,DIMENSION(klon,klev),INTENT(IN) :: t ! temperature +! tracers + REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: tr_seri ! q de traceur + REAL,DIMENSION(klon,klev),INTENT(IN) :: beta_fisrt ! taux de conversion de l'eau cond + REAL,DIMENSION(klon,klev),INTENT(OUT) :: beta_v1 ! -- (originale version) + REAL,DIMENSION(klon) :: his_dh ! tendance de traceur integre verticalement + REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: d_tr_insc ! tendance du traceur + REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: d_tr_bcscav ! tendance de traceur + REAL,DIMENSION(klon,klev,nbtr),INTENT(OUT) :: d_tr_evap + REAL,DIMENSION(klon,nbtr),INTENT(OUT) :: qPrls !jyg: concentration tra dans pluie LS a la surf. + REAL :: dxin,dxev ! tendance temporaire de traceur incloud + REAL,DIMENSION(klon,klev) :: dxbc ! tendance temporaire de traceur bc + + INTEGER :: id_prec,id_fine,id_coss, id_codu, id_scdu + +! variables locales + LOGICAL,SAVE :: debut=.true. +!$OMP THREADPRIVATE(debut) +! +!JE REAL,PARAMETER :: henry=1.4 ! constante de Henry en mol/l/atm ~1.4 for gases + REAL,DIMENSION(nbtr) :: henry ! constante de Henry en mol/l/atm ~1.4 for gases + REAL :: henry_t ! constante de Henry a T t (mol/l/atm) +!JE REAL,PARAMETER :: kk=2900. ! coefficient de dependence en T (K) + REAL,DIMENSION(nbtr) :: kk ! coefficient de dependence en T (K) + REAL :: f_a ! rapport de la phase aqueuse a la phase gazeuse + REAL :: beta ! taux de conversion de l'eau en pluie + + INTEGER :: i, k + REAL,DIMENSION(klon,klev) :: scav ! water liquid content / fraction aqueuse du constituant + REAL,DIMENSION(klon,klev) :: zrho + REAL,DIMENSION(klon,klev) :: zdz + REAL,DIMENSION(klon,klev) :: zmass ! layer mass + + REAL :: frac_ev ! cste pour la reevaporation : dropplet shrinking +! frac_ev = frac_gas ou frac_aer + REAL,PARAMETER :: frac_gas=1.0 ! cste pour la reevaporation pour les gaz + REAL :: frac_aer ! cste pour la reevaporation pour les particules + REAL,DIMENSION(klon,klev) :: deltaP ! P(i+1)-P(i) + REAL,DIMENSION(klon,klev) :: beta_ev ! dP/P(i+1) + +! 101.325 m3/l x Pa/atm +! R Pa.m3/mol/K +! cste de dissolution pour le depot humide + REAL,SAVE :: frac_fine_scav + REAL,SAVE :: frac_coar_scav +!$OMP THREADPRIVATE(frac_fine_scav, frac_coar_scav) + +! below-cloud scav variables +! aerosol : alpha_r=0.001, gas 0.001 (Pruppacher & Klett 1967) +!JE<< +! REAL,SAVE :: alpha_r ! coefficient d'impaction pour la pluie +! REAL,SAVE :: alpha_s ! coefficient d'impaction pour la neige +!JE>> + REAL, DIMENSION(nbtr) :: alpha_r ! coefficient d'impaction pour la pluie + REAL, DIMENSION(nbtr) :: alpha_s ! coefficient d'impaction pour la neige + REAL,SAVE :: R_r ! mean raindrop radius (m) + REAL,SAVE :: R_s ! mean snow crystal radius (m) +!!! $OMP THREADPRIVATE(alpha_r, alpha_s, R_r, R_s) +!$OMP THREADPRIVATE(R_r, R_s) + REAL :: pr, ps, ice, water + real :: conserv +! +!!!!!!!!!!!!!!!!!!!! choix lessivage !!!!!!!!!!!!!!!!!!!!!!!! +!! logical,save :: inscav_fisrt +!!! $OMP THREADPRIVATE(inscav_first) +! +!!!!!!!!!!!!!!!!!!!!!!!!!!! + IF (debut) THEN +! +! inscav_fisrt=.true. +! call getin('inscav_fisrt',inscav_fisrt) +! if(inscav_fisrt) then +! print*,'beta from fisrtilp.F90, beta = (z_cond - z_oliq)/z_cond, inscav_fisrt=',inscav_fisrt +! else +! print*,'beta from Reddy and Bocuher 2004 (original version), inscav_fisrt=',inscav_fisrt +! endif +! +!JE alpha_r=0.001 ! coefficient d'impaction pour la pluie +!JE alpha_s=0.01 ! coefficient d'impaction pour la neige + R_r=0.001 ! mean raindrop radius (m) + R_s=0.001 ! mean snow crystal radius (m) + frac_fine_scav=0.7 + frac_coar_scav=0.7 +! frac_aer=0.5 ~ droplet size shrinks by evap + frac_aer=0.5 +! + +!JE to speed up, commented 20140219 +! +! OPEN(99,file='lsc_scav_param.data',status='old', & +! form='formatted',err=9999) +! READ(99,*,end=9998) alpha_r +! READ(99,*,end=9998) alpha_s +! READ(99,*,end=9998) R_r +! READ(99,*,end=9998) R_s +! READ(99,*,end=9998) frac_fine_scav +! READ(99,*,end=9998) frac_coar_scav +! READ(99,*,end=9998) frac_aer +!9998 Continue +! CLOSE(99) +!9999 Continue +! +! print*,'JE alpha_r',alpha_r +! print*,'JE alpha_s',alpha_s +! print*,'JE R_r',R_r +! print*,'JE R_s',R_s +! print*,'frac_fine_scav',frac_fine_scav +! print*,'frac_coar_scav',frac_coar_scav +! print*,'frac_aer ev',frac_aer +! +! JE endcomment +! + ENDIF !(debut) +!!!!!!!!!!!!!!!!!!!!!!!!!!! +! +! initialization + dxin=0. + dxev=0. + beta_ev=0. + + DO i=1,klon + his_dh(i)=0. + ENDDO + + DO k=1,klev + DO i=1, klon + dxbc(i,k)=0. + beta_v1(i,k)=0. + deltaP(i,k)=0. + ENDDO + ENDDO + + DO k=1,klev + DO i=1, klon + d_tr_insc(i,k,it)=0. + d_tr_bcscav(i,k,it)=0. + d_tr_evap(i,k,it)=0. + ENDDO + ENDDO + +! pressure and size of the layer + DO k=klev-1, 1, -1 + DO i=1, klon + zrho(i,k)=pplay(i,k)/t(i,k)/RD + zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG + zmass(i,k)=(paprs(i,k)-paprs(i,k+1))/RG + ENDDO + ENDDO + +!JE<< + IF (it.eq.id_prec) THEN ! gas + frac_ev=frac_gas + ELSE !aerosol + frac_ev=frac_aer + ENDIF + + IF (it.eq.id_prec) THEN ! gas + DO k=1, klev + DO i=1, klon + henry_t=henry(it)*exp(-kk(it)*(1./298.-1./t(i,k))) ! mol/l/atm + f_a=henry_t/101.325*R*t(i,k)*oliq*zrho(i,k)/rho_water + scav(i,k)=f_a/(1.+f_a) + ENDDO + ENDDO + ELSE !aerosol + DO k=1, klev + DO i=1, klon + scav(i,k)=frac_fine_scav + ENDDO + ENDDO + ENDIF +!JE>> + DO k=klev-1, 1, -1 + DO i=1, klon +! incloud scavenging +! if(inscav_fisrt) then + if (iflag_lscav .eq. 4) then + beta=beta_fisrt(i,k)*rneb(i,k) + else + beta=flxr(i,k)-flxr(i,k+1)+flxs(i,k)-flxs(i,k+1) +! beta=beta/zdz(i,k)/oliq/zrho(i,k) + beta=beta/zmass(i,k)/oliq + beta=MAX(0.,beta) + endif ! (iflag_lscav .eq. 4) + beta_v1(i,k)=beta !! for output +! + dxin=tr_seri(i,k,it)*(exp(-scav(i,k)*beta*pdtime)-1.) +! his_dh(i)=his_dh(i)-dxin*zrho(i,k)*zdz(i,k)/pdtime ! kg/m2/s + his_dh(i)=his_dh(i)-dxin*zmass(i,k)/pdtime ! kg/m2/s + d_tr_insc(i,k,it)=dxin + +! below-cloud impaction + IF(it.eq.id_prec) then + d_tr_bcscav(i,k,it)=0. + ELSE + pr=0.5*(flxr(i,k)+flxr(i,k+1)) + ps=0.5*(flxs(i,k)+flxs(i,k+1)) + water=pr*alpha_r(it)/R_r/rho_water + ice=ps*alpha_s(it)/R_s/rho_ice + dxbc(i,k)=-3./4.*tr_seri(i,k,it)*pdtime*(water+ice) +! add tracers from below cloud scav in his_dh + his_dh(i)=his_dh(i)-dxbc(i,k)*zmass(i,k)/pdtime ! kg/m2/s + d_tr_bcscav(i,k,it)=dxbc(i,k) + ENDIF + +! reevaporation + deltaP(i,k)=flxr(i,k+1)+flxs(i,k+1)-flxr(i,k)-flxs(i,k) + deltaP(i,k)=max(deltaP(i,k),0.) + + if(flxr(i,k+1)+flxs(i,k+1).gt.1.e-16) then + beta_ev(i,k)=deltaP(i,k)/(flxr(i,k+1)+flxs(i,k+1)) + else + beta_ev(i,k)=0. + endif + + beta_ev(i,k)=max(min(1.,beta_ev(i,k)),0.) + +!jyg + + if(abs(1-(1-frac_ev)*beta_ev(i,k)).gt.1.e-16) then +! remove tracers from precipitation owing to release by evaporation in his_dh +! dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) & + dxev=frac_ev*beta_ev(i,k)*his_dh(i) *pdtime/(zmass(i,k)) & + /(1 -(1-frac_ev)*beta_ev(i,k)) + his_dh(i)=his_dh(i)*(1 - frac_ev*beta_ev(i,k) / (1 -(1-frac_ev)*beta_ev(i,k))) + else +! dxev=his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) + dxev=his_dh(i) *pdtime/(zmass(i,k)) + his_dh(i)=0. + endif +! print*, k, 'beta_ev',beta_ev +! remove tracers from precipitation owing to release by evaporation in his_dh +!! dxev=frac_ev*deltaP(i,k)*pdtime * his_dh(i) /(zrho(i,k)*zdz(i,k)) +!rplmd +!! dxev=frac_ev*deltaP(i,k)*his_dh(i) *pdtime/(zrho(i,k)*zdz(i,k)) & +!! /max(flxr(i,k)+flxs(i,k),1.e-16) + + + d_tr_evap(i,k,it)=dxev +!! tendency is further added in phytrac x = x + dx + ENDDO !! do i + ENDDO !! do k + +!jyg (20130114) + DO i = 1,klon + qPrls(i,it) = his_dh(i)/max(flxr(i,1)+flxs(i,1),1.e-16) + ENDDO +!jyg end + + +! test de conservation + conserv=0. +! DO k= klev,1,-1 +! DO i=1, klon +! conserv=conserv+d_tr_insc(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG & +! +d_tr_bcscav(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG & +! +d_tr_evap(i,k,it)*(paprs(i,k)-paprs(i,k+1))/RG +! if(it.eq.3) write(*,'(I2,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12,2X,a,e20.12)'),& +! k,'lsc conserv ',conserv,'insc',d_tr_insc(i,k,it),'bc',d_tr_bcscav(i,k,it),'ev',d_tr_evap(i,k,it) +! ENDDO +! ENDDO + +END SUBROUTINE lsc_scav_spl Index: /LMDZ5/trunk/libf/phylmd/Dust/minmaxqfi2.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/minmaxqfi2.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/minmaxqfi2.F (revision 2630) @@ -0,0 +1,33 @@ + subroutine minmaxqfi2(zq,qmin,qmax,comment) +c + USE dimphy + USE infotrac +#include "dimensions.h" + +! character*20 comment + character*(*) comment + real qmin,qmax + real zq(klon,klev) + + integer ijmin, lmin, ijlmin + integer ijmax, lmax, ijlmax + + integer ismin,ismax + + ijlmin=ismin(klon*klev,zq,1) + lmin=(ijlmin-1)/klon+1 + ijmin=ijlmin-(lmin-1)*klon + zqmin=zq(ijmin,lmin) + + ijlmax=ismax(klon*klev,zq,1) + lmax=(ijlmax-1)/klon+1 + ijmax=ijlmax-(lmax-1)*klon + zqmax=zq(ijmax,lmax) + + if(zqmin.lt.qmin.or.zqmax.gt.qmax) + s write(*,9999) comment, + s ijmin,lmin,zqmin,ijmax,lmax,zqmax + + return +9999 format(a20,2(' q(',i4,',',i2,')=',e12.5)) + end Index: /LMDZ5/trunk/libf/phylmd/Dust/minmaxsource.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/minmaxsource.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/minmaxsource.F (revision 2630) @@ -0,0 +1,34 @@ + subroutine minmaxsource(zq,qmin,qmax,comment) + + USE dimphy + USE infotrac + +#include "dimensions.h" + +! character*20 comment + character*(*) comment + real qmin,qmax + real zq(klon,nbtr) + + integer ijmin, lmin, ijlmin + integer ijmax, lmax, ijlmax + + integer ismin,ismax + + ijlmin=ismin(klon*nbtr,zq,1) + lmin=(ijlmin-1)/klon+1 + ijmin=ijlmin-(lmin-1)*klon + zqmin=zq(ijmin,lmin) + + ijlmax=ismax(klon*nbtr,zq,1) + lmax=(ijlmax-1)/klon+1 + ijmax=ijlmax-(lmax-1)*klon + zqmax=zq(ijmax,lmax) + + if(zqmin.lt.qmin.or.zqmax.gt.qmax) + s write(*,9999) comment, + s ijmin,lmin,zqmin,ijmax,lmax,zqmax + + return +9999 format(a20,2(' q(',i4,',',i2,')=',e12.5)) + end Index: /LMDZ5/trunk/libf/phylmd/Dust/neutral.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/neutral.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/neutral.F (revision 2630) @@ -0,0 +1,72 @@ +c*********************************************************************** + subroutine neutral(u10_mps,ustar_mps,obklen_m, + + u10n_mps ) +c----------------------------------------------------------------------- +c subroutine to compute u10 neutral wind speed +c inputs +c u10_mps - wind speed at 10 m (m/s) +c ustar_mps - friction velocity (m/s) +c obklen_m - monin-obukhov length scale (m) +c outputs +c u10n_mps - wind speed at 10 m under neutral conditions (m/s) +c following code assumes reference height Z is 10m, consistent with use +c of u10 and u10_neutral. If not, code +c should be changed so that constants of 50. and 160. in equations +c below are changed to -5 * Z and -16 * Z respectively. +c Reference: G. L. Geernaert. 'Bulk parameterizations for the +c wind stress and heat fluxes,' in Surface Waves and Fluxes, Vol. I, +c Current Theory, Geernaert and W.J. Plant, editors, Kluwer Academic +c Publishers, Boston, MA, 1990. +c subroutine written Feb 2001 by eg chapman +c adapted to LMD-ZT by E. Cosme 310801 +c Following Will Shaw (PNL, Seattle) the theory applied for flux +c calculation with the scheme of Nightingale et al. (2000) does not +c hold anymore when -1> + +!JE20150620<< + + USE time_phylmdz_mod, only: day_step_phy, start_time, itau_phy + + USE phytracr_spl_mod, ONLY : ok_chimeredust, id_prec, id_fine, id_coss, & + id_codu, id_scdu , & + d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, & + d_tr_lessi_nucl, d_tr_insc, d_tr_bcscav, d_tr_evapls, d_tr_ls, & + d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav ,& + diff_aod550_tot,& + diag_aod670_tot, diag_aod865_tot, & + diff_aod550_tr2, diag_aod670_tr2, diag_aod865_tr2, & + diag_aod550_ss, diag_aod670_ss, diag_aod865_ss, & + diag_aod550_dust, diag_aod670_dust, diag_aod865_dust , & + diag_aod550_dustsco, diag_aod670_dustsco, diag_aod865_dustsco, & +! aod550_aqua, aod670_aqua, aod865_aqua, & +! aod550_terra, aod670_terra, aod865_terra, & + aod550_aqua,aod550_tr2_aqua,aod550_ss_aqua,aod550_dust_aqua,aod550_dustsco_aqua,& + aod670_aqua,aod670_tr2_aqua,aod670_ss_aqua,aod670_dust_aqua,aod670_dustsco_aqua,& + aod865_aqua,aod865_tr2_aqua,aod865_ss_aqua,aod865_dust_aqua,aod865_dustsco_aqua,& + aod550_terra,aod550_tr2_terra,aod550_ss_terra,aod550_dust_terra,aod550_dustsco_terra,& + aod670_terra,aod670_tr2_terra,aod670_ss_terra,aod670_dust_terra,aod670_dustsco_terra,& + aod865_terra,aod865_tr2_terra,aod865_ss_terra,aod865_dust_terra,aod865_dustsco_terra,& + trm01,trm02,trm03,trm04,trm05, & + sconc01,sconc02,sconc03,sconc04,sconc05, & + flux01,flux02,flux03,flux04,flux05,& + ds01,ds02,ds03,ds04,ds05, & + dh01,dh02,dh03,dh04,dh05, & + dtrconv01,dtrconv02,dtrconv03,dtrconv04,dtrconv05, & + dtherm01,dtherm02,dtherm03,dtherm04,dtherm05, & + dhkecv01,dhkecv02,dhkecv03,dhkecv04,dhkecv05, & + d_tr_ds01,d_tr_ds02,d_tr_ds03,d_tr_ds04,d_tr_ds05, & + dhkelsc01,dhkelsc02,dhkelsc03,dhkelsc04,dhkelsc05, & + d_tr_cv01,d_tr_cv02,d_tr_cv03,d_tr_cv04,d_tr_cv05, & + d_tr_trsp01,d_tr_trsp02,d_tr_trsp03,d_tr_trsp04,d_tr_trsp05, & + d_tr_sscav01,d_tr_sscav02,d_tr_sscav03,d_tr_sscav04,d_tr_sscav05, & + d_tr_sat01,d_tr_sat02,d_tr_sat03,d_tr_sat04,d_tr_sat05, & + d_tr_uscav01,d_tr_uscav02,d_tr_uscav03,d_tr_uscav04,d_tr_uscav05, & + d_tr_insc01,d_tr_insc02,d_tr_insc03,d_tr_insc04,d_tr_insc05, & + d_tr_bcscav01,d_tr_bcscav02,d_tr_bcscav03,d_tr_bcscav04,d_tr_bcscav05, & + d_tr_evapls01,d_tr_evapls02,d_tr_evapls03,d_tr_evapls04,d_tr_evapls05, & + d_tr_ls01,d_tr_ls02,d_tr_ls03,d_tr_ls04,d_tr_ls05, & + d_tr_dyn01,d_tr_dyn02,d_tr_dyn03,d_tr_dyn04,d_tr_dyn05, & + d_tr_cl01,d_tr_cl02,d_tr_cl03,d_tr_cl04,d_tr_cl05, & + d_tr_th01,d_tr_th02,d_tr_th03,d_tr_th04,d_tr_th05, & + sed_ss,sed_dust,sed_dustsco,his_g2pgas,his_g2paer, & + sed_ss3D,sed_dust3D,sed_dustsco3D, & + fluxbb, & + fluxff,fluxbcbb,fluxbcff,fluxbcnff, & + fluxbcba,fluxbc,fluxombb,fluxomff,fluxomnff, & + fluxomba,fluxomnat,fluxom,fluxh2sff,fluxh2snff, & + fluxso2ff,fluxso2nff,fluxso2bb,fluxso2vol,fluxso2ba, & + fluxso2,fluxso4ff,fluxso4nff,fluxso4ba,fluxso4bb, & + fluxso4,fluxdms,fluxh2sbio,fluxdustec,& + fluxddfine, & + fluxddcoa,fluxddsco,fluxdd, & + fluxssfine,fluxsscoa, & + fluxss,flux_sparam_ind,flux_sparam_bb,flux_sparam_ff, & + flux_sparam_ddfine,flux_sparam_ddcoa, & + flux_sparam_ddsco,flux_sparam_ssfine, & + flux_sparam_sscoa,u10m_ss,v10m_ss + + USE dustemission_mod, ONLY : m1dflux, m2dflux, m3dflux + +! USE phytrac_mod, ONLY : d_tr_cl, d_tr_th, d_tr_cv, d_tr_lessi_impa, & +! d_tr_lessi_nucl, d_tr_insc, d_tr_bcscav, d_tr_evapls, d_tr_ls, & +! d_tr_trsp, d_tr_sscav, d_tr_sat, d_tr_uscav + +!JE20150620>> + + ! Author: Abderrahmane IDELKADI (original include file) + ! Author: Laurent FAIRHEAD (transformation to module/subroutine) + ! Author: Ulysse GERARD (effective implementation) + +CONTAINS + + ! ug Routine pour définir (los du premier passageà) ET sortir les variables + SUBROUTINE phys_output_write_spl(itap, pdtphys, paprs, pphis, & + pplay, lmax_th, aerosol_couple, & + ok_ade, ok_aie, ivap, new_aod, ok_sync, & + ptconv, read_climoz, clevSTD, ptconvth, & + d_t, qx, d_qx, d_tr_dyn, zmasse, flag_aerosol, flag_aerosol_strat, ok_cdnc) + + ! This subroutine does the actual writing of diagnostics that were + ! defined and initialised in phys_output_mod.F90 + + USE dimphy, only: klon, klev, klevp1, nslay + USE control_mod, only: day_step, iphysiq + USE phys_output_ctrlout_mod, only: o_phis, o_aire, is_ter, is_lic, is_oce, & + is_ave, is_sic, o_contfracATM, o_contfracOR, & + o_aireTER, o_flat, o_slp, o_tsol, & + o_t2m, o_t2m_min, o_t2m_max, & + o_t2m_min_mon, o_t2m_max_mon, & + o_q2m, o_ustar, o_u10m, o_v10m, & + o_wind10m, o_wind10max, o_gusts, o_sicf, & + o_psol, o_mass, o_qsurf, o_qsol, & + o_precip, o_ndayrain, o_plul, o_pluc, & + o_snow, o_msnow, o_fsnow, o_evap, & + o_tops, o_tops0, o_topl, o_topl0, & + o_SWupTOA, o_SWupTOAclr, o_SWdnTOA, & + o_SWdnTOAclr, o_nettop, o_SWup200, & + o_SWup200clr, o_SWdn200, o_SWdn200clr, & + o_LWup200, o_LWup200clr, o_LWdn200, & + o_LWdn200clr, o_sols, o_sols0, & + o_soll, o_radsol, o_soll0, o_SWupSFC, & + o_SWupSFCclr, o_SWdnSFC, o_SWdnSFCclr, & + o_LWupSFC, o_LWdnSFC, o_LWupSFCclr, & + o_LWdnSFCclr, o_bils, o_bils_diss, & + o_bils_ec,o_bils_ech, o_bils_tke, o_bils_kinetic, & + o_bils_latent, o_bils_enthalp, o_sens, & + o_fder, o_ffonte, o_fqcalving, o_fqfonte, & + o_taux, o_tauy, o_snowsrf, o_qsnow, & + o_snowhgt, o_toice, o_sissnow, o_runoff, & + o_albslw3, o_pourc_srf, o_fract_srf, & + o_taux_srf, o_tauy_srf, o_tsol_srf, & + o_evappot_srf, o_ustar_srf, o_u10m_srf, & + o_v10m_srf, o_t2m_srf, o_evap_srf, & + o_sens_srf, o_lat_srf, o_flw_srf, & + o_fsw_srf, o_wbils_srf, o_wbilo_srf, & + o_tke_srf, o_tke_max_srf,o_dltpbltke_srf, o_wstar, & + o_cdrm, o_cdrh, o_cldl, o_cldm, o_cldh, & + o_cldt, o_JrNt, o_cldljn, o_cldmjn, & + o_cldhjn, o_cldtjn, o_cldq, o_lwp, o_iwp, & + o_ue, o_ve, o_uq, o_vq, o_cape, o_pbase, & + o_ptop, o_fbase, o_plcl, o_plfc, & + o_wbeff, o_cape_max, o_upwd, o_Ma, & + o_dnwd, o_dnwd0, o_ftime_con, o_mc, & + o_prw, o_s_pblh, o_s_pblt, o_s_lcl, & + o_s_therm, o_uSTDlevs, o_vSTDlevs, & + o_wSTDlevs, o_zSTDlevs, o_qSTDlevs, & + o_tSTDlevs, epsfra, o_t_oce_sic, & + o_ale_bl, o_alp_bl, o_ale_wk, o_alp_wk, & + o_ale, o_alp, o_cin, o_WAPE, o_wake_h, & + o_wake_s, o_wake_deltat, o_wake_deltaq, & + o_wake_omg, o_dtwak, o_dqwak, o_Vprecip, & + o_ftd, o_fqd, o_wdtrainA, o_wdtrainM, & + o_n2, o_s2, o_proba_notrig, & + o_random_notrig, o_ale_bl_stat, & + o_ale_bl_trig, o_alp_bl_det, & + o_alp_bl_fluct_m, o_alp_bl_fluct_tke, & + o_alp_bl_conv, o_alp_bl_stat, & + o_slab_qflux, o_tslab, o_slab_bils, & + o_slab_bilg, o_slab_sic, o_slab_tice, & + o_weakinv, o_dthmin, o_cldtau, & + o_cldemi, o_pr_con_l, o_pr_con_i, & + o_pr_lsc_l, o_pr_lsc_i, o_re, o_fl, & + o_rh2m, o_rh2m_min, o_rh2m_max, & + o_qsat2m, o_tpot, o_tpote, o_SWnetOR, & + o_SWdownOR, o_LWdownOR, o_snowl, & + o_solldown, o_dtsvdfo, o_dtsvdft, & + o_dtsvdfg, o_dtsvdfi, o_z0m, o_z0h, o_od550aer, & + o_od865aer, o_absvisaer, o_od550lt1aer, & + o_sconcso4, o_sconcno3, o_sconcoa, o_sconcbc, & + o_sconcss, o_sconcdust, o_concso4, o_concno3, & + o_concoa, o_concbc, o_concss, o_concdust, & + o_loadso4, o_loadoa, o_loadbc, o_loadss, & + o_loaddust, o_tausumaero, o_tausumaero_lw, & + o_topswad, o_topswad0, o_solswad, o_solswad0, & + o_toplwad, o_toplwad0, o_sollwad, o_sollwad0, & + o_swtoaas_nat, o_swsrfas_nat, & + o_swtoacs_nat, o_swtoaas_ant, & + o_swsrfas_ant, o_swtoacs_ant, & + o_swsrfcs_ant, o_swtoacf_nat, & + o_swsrfcf_nat, o_swtoacf_ant, & + o_swsrfcs_nat, o_swsrfcf_ant, & + o_swtoacf_zero, o_swsrfcf_zero, & + o_topswai, o_solswai, o_scdnc, & + o_cldncl, o_reffclws, o_reffclwc, & + o_cldnvi, o_lcc, o_lcc3d, o_lcc3dcon, & + o_lcc3dstra, o_reffclwtop, o_ec550aer, & + o_lwcon, o_iwcon, o_temp, o_theta, & + o_ovapinit, o_ovap, o_oliq, o_geop, & + o_vitu, o_vitv, o_vitw, o_pres, o_paprs, & + o_zfull, o_zhalf, o_rneb, o_rnebjn, o_rnebcon, & + o_rnebls, o_rhum, o_ozone, o_ozone_light, & + o_dtphy, o_dqphy, o_albe_srf, o_z0m_srf, o_z0h_srf, & + o_ages_srf, o_snow_srf, o_alb1, o_alb2, o_tke, & + o_tke_max, o_kz, o_kz_max, o_clwcon, & + o_dtdyn, o_dqdyn, o_dudyn, o_dvdyn, & + o_dtcon, o_tntc, o_ducon, o_dvcon, & + o_dqcon, o_tnhusc, o_tnhusc, o_dtlsc, & + o_dtlschr, o_dqlsc, o_beta_prec, & + o_dtlscth, o_dtlscst, o_dqlscth, & + o_dqlscst, o_plulth, o_plulst, & + o_ptconvth, o_lmaxth, o_dtvdf, & + o_dtdis, o_dqvdf, o_dteva, o_dqeva, & + o_ptconv, o_ratqs, o_dtthe, & + o_duthe, o_dvthe, o_ftime_th, & + o_f_th, o_e_th, o_w_th, o_q_th, & + o_a_th, o_d_th, o_f0_th, o_zmax_th, & + o_dqthe, o_dtajs, o_dqajs, o_dtswr, & + o_dtsw0, o_dtlwr, o_dtlw0, o_dtec, & + o_duvdf, o_dvvdf, o_duoro, o_dvoro, & + o_dtoro, o_dulif, o_dvlif, o_dtlif, & + ! o_duhin, o_dvhin, o_dthin, & + o_dqch4, o_rsu, & + o_rsd, o_rlu, o_rld, o_rsucs, o_rsdcs, & + o_rlucs, o_rldcs, o_tnt, o_tntr, & + o_tntscpbl, o_tnhus, o_tnhusscpbl, & + o_evu, o_h2o, o_mcd, o_dmc, o_ref_liq, & + o_ref_ice, o_rsut4co2, o_rlut4co2, & + o_rsutcs4co2, o_rlutcs4co2, o_rsu4co2, & + o_rlu4co2, o_rsucs4co2, o_rlucs4co2, & + o_rsd4co2, o_rld4co2, o_rsdcs4co2, & + o_rldcs4co2, o_tnondef, o_ta, o_zg, & + o_hus, o_hur, o_ua, o_va, o_wap, & + o_psbg, o_tro3, o_tro3_daylight, & + o_uxv, o_vxq, o_vxT, o_wxq, o_vxphi, & + o_wxT, o_uxu, o_vxv, o_TxT, o_trac, & + o_dtr_vdf, o_dtr_the, o_dtr_con, & + o_dtr_lessi_impa, o_dtr_lessi_nucl, & + o_dtr_insc, o_dtr_bcscav, o_dtr_evapls, & +! o_dtr_ls, o_dtr_dyn, o_dtr_cl, o_dtr_trsp, o_dtr_sscav, & + o_dtr_ls, o_dtr_trsp, o_dtr_sscav, & + o_dtr_sat, o_dtr_uscav, o_trac_cum, o_du_gwd_rando, o_dv_gwd_rando, & +!JE20150620<< +! o_vstr_gwd_rando + o_vstr_gwd_rando, & + o_m1dflux,o_m2dflux,o_m3dflux, & + o_taue550, & + o_taue670,o_taue865, & + o_taue550_tr2, o_taue670_tr2, o_taue865_tr2, & + o_taue550_ss,o_taue670_ss, o_taue865_ss, & + o_taue550_dust, o_taue670_dust, o_taue865_dust, & + o_taue550_dustsco, o_taue670_dustsco, o_taue865_dustsco, & + o_taue550_aqua, o_taue670_aqua, o_taue865_aqua, & + o_taue550_terra, o_taue670_terra, o_taue865_terra, & + o_taue550_fine_aqua , o_taue670_fine_aqua , & + o_taue865_fine_aqua , o_taue550_coss_aqua , & + o_taue670_coss_aqua , o_taue865_coss_aqua , & + o_taue550_codu_aqua , o_taue670_codu_aqua , & + o_taue865_codu_aqua , o_taue670_scdu_aqua , & + o_taue550_scdu_aqua , o_taue865_scdu_aqua , & + o_taue550_fine_terra , o_taue670_fine_terra ,& + o_taue865_fine_terra , o_taue550_coss_terra ,& + o_taue670_coss_terra , o_taue865_coss_terra ,& + o_taue550_codu_terra , o_taue670_codu_terra ,& + o_taue865_codu_terra , o_taue670_scdu_terra ,& + o_taue550_scdu_terra , o_taue865_scdu_terra ,& + o_trm01,o_trm02,o_trm03,o_trm04,o_trm05,& + o_sconc01,o_sconc02,o_sconc03,o_sconc04,o_sconc05, & + o_flux01,o_flux02,o_flux03,o_flux04,o_flux05, & + o_ds01,o_ds02,o_ds03,o_ds04,o_ds05, & + o_dh01,o_dh02,o_dh03,o_dh04,o_dh05, & + o_dtrconv01,o_dtrconv02,o_dtrconv03,o_dtrconv04,o_dtrconv05, & + o_dtherm01,o_dtherm02,o_dtherm03,o_dtherm04,o_dtherm05, & + o_dhkecv01,o_dhkecv02,o_dhkecv03,o_dhkecv04,o_dhkecv05, & + o_d_tr_ds01,o_d_tr_ds02,o_d_tr_ds03,o_d_tr_ds04,o_d_tr_ds05, & + o_dhkelsc01,o_dhkelsc02,o_dhkelsc03,o_dhkelsc04,o_dhkelsc05, & + o_d_tr_sat01,o_d_tr_cv01,o_d_tr_cv02,o_d_tr_cv03,o_d_tr_cv04,o_d_tr_cv05,& + o_d_tr_trsp01,o_d_tr_trsp02,o_d_tr_trsp03,o_d_tr_trsp04,o_d_tr_trsp05,& + o_d_tr_sscav01,o_d_tr_sscav02,o_d_tr_sscav03,o_d_tr_sscav04,o_d_tr_sscav05,& + o_d_tr_sat02,o_d_tr_sat03,o_d_tr_sat04,o_d_tr_sat05, & + o_d_tr_uscav01,o_d_tr_uscav02,o_d_tr_uscav03,o_d_tr_uscav04,o_d_tr_uscav05,& + o_d_tr_insc01,o_d_tr_insc02,o_d_tr_insc03,o_d_tr_insc04,o_d_tr_insc05,& + o_d_tr_bcscav01,o_d_tr_bcscav02,o_d_tr_bcscav03,o_d_tr_bcscav04,o_d_tr_bcscav05,& + o_d_tr_evapls01,o_d_tr_evapls02,o_d_tr_evapls03,o_d_tr_evapls04,o_d_tr_evapls05,& + o_d_tr_ls01,o_d_tr_ls02,o_d_tr_ls03,o_d_tr_ls04,o_d_tr_ls05,& + o_d_tr_dyn01,o_d_tr_dyn02,o_d_tr_dyn03,o_d_tr_dyn04,o_d_tr_dyn05,& + o_d_tr_cl01,o_d_tr_cl02,o_d_tr_cl03,o_d_tr_cl04,o_d_tr_cl05,& + o_d_tr_th01,o_d_tr_th02,o_d_tr_th03,o_d_tr_th04,o_d_tr_th05,& + o_sed_ss,o_sed_dust,o_sed_dustsco,o_g2p_gas,o_g2p_aer, & + o_sed_ss3D,o_sed_dust3D,o_sed_dustsco3D, & + o_fluxbb, & + o_fluxff ,o_fluxbcbb ,o_fluxbcff ,o_fluxbcnff , & + o_fluxbcba ,o_fluxbc ,o_fluxombb ,o_fluxomff , & + o_fluxomnff ,o_fluxomba ,o_fluxomnat ,o_fluxom , & + o_fluxh2sff ,o_fluxh2snff,o_fluxso2ff ,o_fluxso2nff, & + o_fluxso2bb ,o_fluxso2vol,o_fluxso2ba ,o_fluxso2 , & + o_fluxso4ff ,o_fluxso4nff,o_fluxso4bb ,o_fluxso4ba , & + o_fluxso4 ,o_fluxdms ,o_fluxh2sbio,o_fluxdustec, & + o_fluxddfine,o_fluxddcoa ,o_fluxddsco ,o_fluxdd ,& + o_fluxssfine,o_fluxsscoa, o_fluxss, & + o_flux_sparam_ind,o_flux_sparam_bb, & + o_flux_sparam_ff ,o_flux_sparam_ddfine ,o_flux_sparam_ddcoa, & + o_flux_sparam_ddsco,o_flux_sparam_ssfine,o_flux_sparam_sscoa, & + o_u10m_ss,o_v10m_ss + +!JE20150620>> + + USE phys_state_var_mod, only: pctsrf, paire_ter, rain_fall, snow_fall, & + qsol, z0m, z0h, fevap, agesno, & + nday_rain, rain_con, snow_con, & + topsw, toplw, toplw0, swup, swdn, & + topsw0, swup0, swdn0, SWup200, SWup200clr, & + SWdn200, SWdn200clr, LWup200, LWup200clr, & + LWdn200, LWdn200clr, solsw, solsw0, sollw, & + radsol, sollw0, sollwdown, sollw, gustiness, & + sollwdownclr, lwdn0, ftsol, ustar, u10m, & + v10m, pbl_tke, wake_delta_pbl_TKE, & + wstar, cape, ema_pcb, ema_pct, & + ema_cbmf, Ma, fm_therm, ale_bl, alp_bl, ale, & + alp, cin, wake_pe, wake_s, wake_deltat, & + wake_deltaq, ftd, fqd, ale_bl_trig, albsol1, & + rnebcon, wo, falb1, albsol2, coefh, clwcon0, & + ratqs, entr_therm, zqasc, detr_therm, f0, & + lwup, lwdn, lwup0, coefm, & + swupp, lwupp, swup0p, lwup0p, swdnp, lwdnp, & + swdn0p, lwdn0p, tnondef, O3sumSTD, uvsumSTD, & + vqsumSTD, vTsumSTD, O3daysumSTD, wqsumSTD, & + vphisumSTD, wTsumSTD, u2sumSTD, v2sumSTD, & + T2sumSTD, nlevSTD, & +! du_gwd_rando, dv_gwd_rando, & + ulevSTD, vlevSTD, wlevSTD, philevSTD, qlevSTD, tlevSTD, & + rhlevSTD, O3STD, O3daySTD, uvSTD, vqSTD, vTSTD, wqSTD, & + vphiSTD, wTSTD, u2STD, v2STD, T2STD, missing_val_nf90 + + USE phys_local_var_mod, only: zxfluxlat, slp, zxtsol, zt2m, & + t2m_min_mon, t2m_max_mon, evap, & + zu10m, zv10m, zq2m, zustar, zxqsurf, & + rain_lsc, snow_lsc, bils, sens, fder, & + zxffonte, zxfqcalving, zxfqfonte, fluxu, & + fluxv, zxsnow, qsnow, snowhgt, to_ice, & + sissnow, runoff, albsol3_lic, evap_pot, & + t2m, fluxt, fluxlat, fsollw, fsolsw, & + wfbils, wfbilo, cdragm, cdragh, cldl, cldm, & + cldh, cldt, JrNt, cldljn, cldmjn, cldhjn, & + cldtjn, cldq, flwp, fiwp, ue, ve, uq, vq, & + plcl, plfc, wbeff, upwd, dnwd, dnwd0, prw, & + s_pblh, s_pblt, s_lcl, s_therm, uwriteSTD, & + vwriteSTD, wwriteSTD, phiwriteSTD, qwriteSTD, & + twriteSTD, ale_wake, alp_wake, wake_h, & + wake_omg, d_t_wake, d_q_wake, Vprecip, & + wdtrainA, wdtrainM, n2, s2, proba_notrig, & + random_notrig, ale_bl_stat, & + alp_bl_det, alp_bl_fluct_m, alp_bl_conv, & + alp_bl_stat, alp_bl_fluct_tke, slab_wfbils, & + weak_inversion, dthmin, cldtau, cldemi, & + pmflxr, pmflxs, prfl, psfl, re, fl, rh2m, & + qsat2m, tpote, tpot, d_ts, od550aer, & + od865aer, absvisaer, od550lt1aer, sconcso4, sconcno3, & + sconcoa, sconcbc, sconcss, sconcdust, concso4, concno3, & + concoa, concbc, concss, concdust, loadso4, & + loadoa, loadbc, loadss, loaddust, tausum_aero, & + topswad_aero, topswad0_aero, solswad_aero, & + solswad0_aero, topsw_aero, solsw_aero, & + topsw0_aero, solsw0_aero, topswcf_aero, & + solswcf_aero, topswai_aero, solswai_aero, & + toplwad_aero, toplwad0_aero, sollwad_aero, & + sollwad0_aero, toplwai_aero, sollwai_aero, & + scdnc, cldncl, reffclws, reffclwc, cldnvi, & + lcc, lcc3d, lcc3dcon, lcc3dstra, reffclwtop, & + ec550aer, flwc, fiwc, t_seri, theta, q_seri, & +!jyg< +!! ql_seri, zphi, u_seri, v_seri, omega, cldfra, & + ql_seri, tr_seri, & + zphi, u_seri, v_seri, omega, cldfra, & +!>jyg + rneb, rnebjn, zx_rh, d_t_dyn, d_q_dyn, & + d_u_dyn, d_v_dyn, d_t_con, d_t_ajsb, d_t_ajs, & + d_u_ajs, d_v_ajs, & + d_u_con, d_v_con, d_q_con, d_q_ajs, d_t_lsc, & + d_t_lwr,d_t_lw0,d_t_swr,d_t_sw0, & + d_t_eva, d_q_lsc, beta_prec, d_t_lscth, & + d_t_lscst, d_q_lscth, d_q_lscst, plul_th, & + plul_st, d_t_vdf, d_t_diss, d_q_vdf, d_q_eva, & + zw2, fraca, zmax_th, d_q_ajsb, d_t_ec, d_u_vdf, & + d_v_vdf, d_u_oro, d_v_oro, d_t_oro, d_u_lif, & + d_v_lif, d_t_lif, & +! d_u_hin, d_v_hin, d_t_hin, & + d_q_ch4, pmfd, pmfu, ref_liq, ref_ice, rhwriteSTD + + USE phys_output_var_mod, only: vars_defined, snow_o, zfra_o, bils_diss, & + bils_ec,bils_ech, bils_tke, bils_kinetic, bils_latent, bils_enthalp, & + itau_con, nfiles, clef_files, nid_files, zvstr_gwd_rando + USE ocean_slab_mod, only: tslab, slab_bils, slab_bilg, tice, seaice + USE pbl_surface_mod, only: snow + USE indice_sol_mod, only: nbsrf + USE infotrac, only: nqtot, nqo, nbtr, type_trac + USE geometry_mod, only: cell_area + USE surface_data, only: type_ocean, version_ocean, ok_veget, ok_snow +! USE aero_mod, only: naero_spc + USE aero_mod, only: naero_tot, id_STRAT_phy + USE ioipsl, only: histend, histsync + USE iophy, only: set_itau_iophy, histwrite_phy + USE netcdf, only: nf90_fill_real + +#ifdef CPP_XIOS + ! ug Pour les sorties XIOS + USE xios, ONLY: xios_update_calendar + USE wxios, only: wxios_closedef, missing_val +#endif + USE phys_cal_mod, only : mth_len + + + IMPLICIT NONE + + +! INCLUDE "temps.h" + INCLUDE "clesphys.h" + INCLUDE "thermcell.h" + INCLUDE "compbl.h" + INCLUDE "YOMCST.h" + INCLUDE "dimensions.h" + include "iniprint.h" + + ! Input + INTEGER :: itap, ivap, read_climoz + INTEGER, DIMENSION(klon) :: lmax_th + LOGICAL :: aerosol_couple, ok_sync + LOGICAL :: ok_ade, ok_aie, new_aod + LOGICAL, DIMENSION(klon, klev) :: ptconv, ptconvth + REAL :: pdtphys + CHARACTER (LEN=4), DIMENSION(nlevSTD) :: clevSTD + REAL, DIMENSION(klon,nlevSTD) :: zx_tmp_fi3d_STD + REAL, DIMENSION(klon) :: pphis + REAL, DIMENSION(klon, klev) :: pplay, d_t + REAL, DIMENSION(klon, klev+1) :: paprs + REAL, DIMENSION(klon,klev,nqtot) :: qx, d_qx + REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: d_tr_dyn + REAL, DIMENSION(klon, llm) :: zmasse + INTEGER :: flag_aerosol_strat + INTEGER :: flag_aerosol + LOGICAL :: ok_cdnc + REAL, DIMENSION(3) :: freq_moyNMC + + ! Local + INTEGER, PARAMETER :: jjmp1=jjm+1-1/jjm + INTEGER :: itau_w + INTEGER :: i, iinit, iinitend=1, iff, iq, nsrf, k, ll, naero + REAL, DIMENSION (klon) :: zx_tmp_fi2d + REAL, DIMENSION (klon,klev) :: zx_tmp_fi3d, zpt_conv + REAL, DIMENSION (klon,klev+1) :: zx_tmp_fi3d1 + CHARACTER (LEN=4) :: bb2 + INTEGER, DIMENSION(iim*jjmp1) :: ndex2d + INTEGER, DIMENSION(iim*jjmp1*klev) :: ndex3d + REAL, PARAMETER :: dobson_u = 2.1415e-05 ! Dobson unit, in kg m-2 +! REAL, PARAMETER :: missing_val=nf90_fill_real +#ifndef CPP_XIOS + REAL :: missing_val +#endif + REAL, PARAMETER :: un_jour=86400. + + ! On calcul le nouveau tau: + itau_w = itau_phy + itap + ! On le donne à iophy pour que les histwrite y aient accès: + CALL set_itau_iophy(itau_w) + + IF(.NOT.vars_defined) THEN + iinitend = 2 + ELSE + iinitend = 1 + ENDIF + + ! ug la boucle qui suit ne sert qu'une fois, pour l'initialisation, sinon il n'y a toujours qu'un seul passage: + DO iinit=1, iinitend +#ifdef CPP_XIOS + !$OMP MASTER + IF (vars_defined) THEN + if (prt_level >= 10) then + write(lunout,*)"phys_output_write: call xios_update_calendar, itau_w=",itau_w + endif +! CALL xios_update_calendar(itau_w) + CALL xios_update_calendar(itap) + END IF + !$OMP END MASTER + !$OMP BARRIER +#endif + ! On procède à l'écriture ou à la définition des nombreuses variables: +!!! Champs 1D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + CALL histwrite_phy(o_phis, pphis) + CALL histwrite_phy(o_aire, cell_area) + + IF (vars_defined) THEN + DO i=1, klon + zx_tmp_fi2d(i)=pctsrf(i,is_ter)+pctsrf(i,is_lic) + ENDDO + ENDIF + + CALL histwrite_phy(o_contfracATM, zx_tmp_fi2d) + CALL histwrite_phy(o_contfracOR, pctsrf(:,is_ter)) + CALL histwrite_phy(o_aireTER, paire_ter) + +!!! Champs 2D !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! JE20141223 << +#include "spla_output_write.h" +! JE20141223 >> + + CALL histwrite_phy(o_flat, zxfluxlat) + CALL histwrite_phy(o_slp, slp) + CALL histwrite_phy(o_tsol, zxtsol) + CALL histwrite_phy(o_t2m, zt2m) + CALL histwrite_phy(o_t2m_min, zt2m) + CALL histwrite_phy(o_t2m_max, zt2m) + CALL histwrite_phy(o_t2m_max_mon, t2m_max_mon) + CALL histwrite_phy(o_t2m_min_mon, t2m_min_mon) + + IF (vars_defined) THEN + DO i=1, klon + zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) + ENDDO + ENDIF + CALL histwrite_phy(o_wind10m, zx_tmp_fi2d) + + IF (vars_defined) THEN + DO i=1, klon + zx_tmp_fi2d(i)=SQRT(zu10m(i)*zu10m(i)+zv10m(i)*zv10m(i)) + ENDDO + ENDIF + CALL histwrite_phy(o_wind10max, zx_tmp_fi2d) + + CALL histwrite_phy(o_gusts, gustiness) + + IF (vars_defined) THEN + DO i = 1, klon + zx_tmp_fi2d(i) = pctsrf(i,is_sic) + ENDDO + ENDIF + CALL histwrite_phy(o_sicf, zx_tmp_fi2d) + CALL histwrite_phy(o_q2m, zq2m) + CALL histwrite_phy(o_ustar, zustar) + CALL histwrite_phy(o_u10m, zu10m) + CALL histwrite_phy(o_v10m, zv10m) + + IF (vars_defined) THEN + DO i = 1, klon + zx_tmp_fi2d(i) = paprs(i,1) + ENDDO + ENDIF + CALL histwrite_phy(o_psol, zx_tmp_fi2d) + CALL histwrite_phy(o_mass, zmasse) + CALL histwrite_phy(o_qsurf, zxqsurf) + + IF (.NOT. ok_veget) THEN + CALL histwrite_phy(o_qsol, qsol) + ENDIF + + IF (vars_defined) THEN + DO i = 1, klon + zx_tmp_fi2d(i) = rain_fall(i) + snow_fall(i) + ENDDO + ENDIF + + CALL histwrite_phy(o_precip, zx_tmp_fi2d) + CALL histwrite_phy(o_ndayrain, nday_rain) + + IF (vars_defined) THEN + DO i = 1, klon + zx_tmp_fi2d(i) = rain_lsc(i) + snow_lsc(i) + ENDDO + ENDIF + CALL histwrite_phy(o_plul, zx_tmp_fi2d) + + IF (vars_defined) THEN + DO i = 1, klon + zx_tmp_fi2d(i) = rain_con(i) + snow_con(i) + ENDDO + ENDIF + CALL histwrite_phy(o_pluc, zx_tmp_fi2d) + CALL histwrite_phy(o_snow, snow_fall) + CALL histwrite_phy(o_msnow, zxsnow) + CALL histwrite_phy(o_fsnow, zfra_o) + CALL histwrite_phy(o_evap, evap) + CALL histwrite_phy(o_tops, topsw) + CALL histwrite_phy(o_tops0, topsw0) + CALL histwrite_phy(o_topl, toplw) + CALL histwrite_phy(o_topl0, toplw0) + + IF (vars_defined) THEN + zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, klevp1 ) + ENDIF + CALL histwrite_phy(o_SWupTOA, zx_tmp_fi2d) + + IF (vars_defined) THEN + zx_tmp_fi2d(1 : klon) = swup0 ( 1 : klon, klevp1 ) + ENDIF + CALL histwrite_phy(o_SWupTOAclr, zx_tmp_fi2d) + + IF (vars_defined) THEN + zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, klevp1 ) + ENDIF + CALL histwrite_phy(o_SWdnTOA, zx_tmp_fi2d) + + IF (vars_defined) THEN + zx_tmp_fi2d(1 : klon) = swdn0 ( 1 : klon, klevp1 ) + ENDIF + CALL histwrite_phy(o_SWdnTOAclr, zx_tmp_fi2d) + + IF (vars_defined) THEN + zx_tmp_fi2d(:) = topsw(:)-toplw(:) + ENDIF + CALL histwrite_phy(o_nettop, zx_tmp_fi2d) + CALL histwrite_phy(o_SWup200, SWup200) + CALL histwrite_phy(o_SWup200clr, SWup200clr) + CALL histwrite_phy(o_SWdn200, SWdn200) + CALL histwrite_phy(o_SWdn200clr, SWdn200clr) + CALL histwrite_phy(o_LWup200, LWup200) + CALL histwrite_phy(o_LWup200clr, LWup200clr) + CALL histwrite_phy(o_LWdn200, LWdn200) + CALL histwrite_phy(o_LWdn200clr, LWdn200clr) + CALL histwrite_phy(o_sols, solsw) + CALL histwrite_phy(o_sols0, solsw0) + CALL histwrite_phy(o_soll, sollw) + CALL histwrite_phy(o_radsol, radsol) + CALL histwrite_phy(o_soll0, sollw0) + + IF (vars_defined) THEN + zx_tmp_fi2d(1 : klon) = swup ( 1 : klon, 1 ) + ENDIF + CALL histwrite_phy(o_SWupSFC, zx_tmp_fi2d) + + IF (vars_defined) THEN + zx_tmp_fi2d(1 : klon) = swup0 ( 1 : klon, 1 ) + ENDIF + CALL histwrite_phy(o_SWupSFCclr, zx_tmp_fi2d) + + IF (vars_defined) THEN + zx_tmp_fi2d(1 : klon) = swdn ( 1 : klon, 1 ) + ENDIF + CALL histwrite_phy(o_SWdnSFC, zx_tmp_fi2d) + + IF (vars_defined) THEN + zx_tmp_fi2d(1 : klon) = swdn0 ( 1 : klon, 1 ) + ENDIF + CALL histwrite_phy(o_SWdnSFCclr, zx_tmp_fi2d) + + IF (vars_defined) THEN + zx_tmp_fi2d(1:klon)=sollwdown(1:klon)-sollw(1:klon) + ENDIF + CALL histwrite_phy(o_LWupSFC, zx_tmp_fi2d) + CALL histwrite_phy(o_LWdnSFC, sollwdown) + + IF (vars_defined) THEN + sollwdownclr(1:klon) = -1.*lwdn0(1:klon,1) + zx_tmp_fi2d(1:klon)=sollwdownclr(1:klon)-sollw0(1:klon) + ENDIF + CALL histwrite_phy(o_LWupSFCclr, zx_tmp_fi2d) + CALL histwrite_phy(o_LWdnSFCclr, sollwdownclr) + CALL histwrite_phy(o_bils, bils) + CALL histwrite_phy(o_bils_diss, bils_diss) + CALL histwrite_phy(o_bils_ec, bils_ec) + IF (iflag_ener_conserv>=1) THEN + CALL histwrite_phy(o_bils_ech, bils_ech) + ENDIF + CALL histwrite_phy(o_bils_tke, bils_tke) + CALL histwrite_phy(o_bils_kinetic, bils_kinetic) + CALL histwrite_phy(o_bils_latent, bils_latent) + CALL histwrite_phy(o_bils_enthalp, bils_enthalp) + + IF (vars_defined) THEN + zx_tmp_fi2d(1:klon)=-1*sens(1:klon) + ENDIF + CALL histwrite_phy(o_sens, zx_tmp_fi2d) + CALL histwrite_phy(o_fder, fder) + CALL histwrite_phy(o_ffonte, zxffonte) + CALL histwrite_phy(o_fqcalving, zxfqcalving) + CALL histwrite_phy(o_fqfonte, zxfqfonte) + IF (vars_defined) THEN + zx_tmp_fi2d=0. + DO nsrf=1,nbsrf + zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+pctsrf(:,nsrf)*fluxu(:,1,nsrf) + ENDDO + ENDIF + CALL histwrite_phy(o_taux, zx_tmp_fi2d) + + IF (vars_defined) THEN + zx_tmp_fi2d=0. + DO nsrf=1,nbsrf + zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+pctsrf(:,nsrf)*fluxv(:,1,nsrf) + ENDDO + ENDIF + CALL histwrite_phy(o_tauy, zx_tmp_fi2d) + + IF (ok_snow) THEN + CALL histwrite_phy(o_snowsrf, snow_o) + CALL histwrite_phy(o_qsnow, qsnow) + CALL histwrite_phy(o_snowhgt,snowhgt) + CALL histwrite_phy(o_toice,to_ice) + CALL histwrite_phy(o_sissnow,sissnow) + CALL histwrite_phy(o_runoff,runoff) + CALL histwrite_phy(o_albslw3,albsol3_lic) + ENDIF + + DO nsrf = 1, nbsrf + IF (vars_defined) zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf)*100. + CALL histwrite_phy(o_pourc_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = pctsrf( 1 : klon, nsrf) + CALL histwrite_phy(o_fract_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = fluxu( 1 : klon, 1, nsrf) + CALL histwrite_phy(o_taux_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = fluxv( 1 : klon, 1, nsrf) + CALL histwrite_phy(o_tauy_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = ftsol( 1 : klon, nsrf) + CALL histwrite_phy(o_tsol_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = evap_pot( 1 : klon, nsrf) + CALL histwrite_phy(o_evappot_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = ustar(1 : klon, nsrf) + CALL histwrite_phy(o_ustar_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = u10m(1 : klon, nsrf) + CALL histwrite_phy(o_u10m_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = v10m(1 : klon, nsrf) + CALL histwrite_phy(o_v10m_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = t2m(1 : klon, nsrf) + CALL histwrite_phy(o_t2m_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = fevap(1 : klon, nsrf) + CALL histwrite_phy(o_evap_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = fluxt( 1 : klon, 1, nsrf) + CALL histwrite_phy(o_sens_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = fluxlat( 1 : klon, nsrf) + CALL histwrite_phy(o_lat_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = fsollw( 1 : klon, nsrf) + CALL histwrite_phy(o_flw_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, nsrf) + CALL histwrite_phy(o_fsw_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = wfbils( 1 : klon, nsrf) + CALL histwrite_phy(o_wbils_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = wfbilo( 1 : klon, nsrf) + CALL histwrite_phy(o_wbilo_srf(nsrf), zx_tmp_fi2d) + + IF (iflag_pbl > 1) THEN + CALL histwrite_phy(o_tke_srf(nsrf), pbl_tke(:,1:klev,nsrf)) + CALL histwrite_phy(o_tke_max_srf(nsrf), pbl_tke(:,1:klev,nsrf)) + ENDIF +!jyg< + IF (iflag_pbl > 1 .AND. iflag_wake>=1 .AND. iflag_pbl_split >=1) THEN + CALL histwrite_phy(o_dltpbltke_srf(nsrf), wake_delta_pbl_TKE(:,1:klev,nsrf)) + ENDIF +!>jyg + + ENDDO + DO nsrf=1,nbsrf+1 + CALL histwrite_phy(o_wstar(nsrf), wstar(1 : klon, nsrf)) + ENDDO + + CALL histwrite_phy(o_cdrm, cdragm) + CALL histwrite_phy(o_cdrh, cdragh) + CALL histwrite_phy(o_cldl, cldl) + CALL histwrite_phy(o_cldm, cldm) + CALL histwrite_phy(o_cldh, cldh) + CALL histwrite_phy(o_cldt, cldt) + CALL histwrite_phy(o_JrNt, JrNt) + CALL histwrite_phy(o_cldljn, cldl*JrNt) + CALL histwrite_phy(o_cldmjn, cldm*JrNt) + CALL histwrite_phy(o_cldhjn, cldh*JrNt) + CALL histwrite_phy(o_cldtjn, cldt*JrNt) + CALL histwrite_phy(o_cldq, cldq) + IF (vars_defined) zx_tmp_fi2d(1:klon) = flwp(1:klon) + CALL histwrite_phy(o_lwp, zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1:klon) = fiwp(1:klon) + CALL histwrite_phy(o_iwp, zx_tmp_fi2d) + CALL histwrite_phy(o_ue, ue) + CALL histwrite_phy(o_ve, ve) + CALL histwrite_phy(o_uq, uq) + CALL histwrite_phy(o_vq, vq) + IF(iflag_con.GE.3) THEN ! sb + CALL histwrite_phy(o_cape, cape) + CALL histwrite_phy(o_pbase, ema_pcb) + CALL histwrite_phy(o_ptop, ema_pct) + CALL histwrite_phy(o_fbase, ema_cbmf) + if (iflag_con /= 30) then + CALL histwrite_phy(o_plcl, plcl) + CALL histwrite_phy(o_plfc, plfc) + CALL histwrite_phy(o_wbeff, wbeff) + end if + + CALL histwrite_phy(o_cape_max, cape) + + CALL histwrite_phy(o_upwd, upwd) + CALL histwrite_phy(o_Ma, Ma) + CALL histwrite_phy(o_dnwd, dnwd) + CALL histwrite_phy(o_dnwd0, dnwd0) + IF (vars_defined) zx_tmp_fi2d=float(itau_con)/float(itap) + CALL histwrite_phy(o_ftime_con, zx_tmp_fi2d) + IF (vars_defined) THEN + IF(iflag_thermals>=1)THEN + zx_tmp_fi3d=dnwd+dnwd0+upwd+fm_therm(:,1:klev) + ELSE + zx_tmp_fi3d=dnwd+dnwd0+upwd + ENDIF + ENDIF + CALL histwrite_phy(o_mc, zx_tmp_fi3d) + ENDIF !iflag_con .GE. 3 + CALL histwrite_phy(o_prw, prw) + CALL histwrite_phy(o_s_pblh, s_pblh) + CALL histwrite_phy(o_s_pblt, s_pblt) + CALL histwrite_phy(o_s_lcl, s_lcl) + CALL histwrite_phy(o_s_therm, s_therm) + !IM : Les champs suivants (s_capCL, s_oliqCL, s_cteiCL, s_trmb1, s_trmb2, s_trmb3) ne sont pas definis dans HBTM.F + ! IF (o_s_capCL%flag(iff)<=lev_files(iff)) THEN + ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), + ! $o_s_capCL%name,itau_w,s_capCL) + ! ENDIF + ! IF (o_s_oliqCL%flag(iff)<=lev_files(iff)) THEN + ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), + ! $o_s_oliqCL%name,itau_w,s_oliqCL) + ! ENDIF + ! IF (o_s_cteiCL%flag(iff)<=lev_files(iff)) THEN + ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), + ! $o_s_cteiCL%name,itau_w,s_cteiCL) + ! ENDIF + ! IF (o_s_trmb1%flag(iff)<=lev_files(iff)) THEN + ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), + ! $o_s_trmb1%name,itau_w,s_trmb1) + ! ENDIF + ! IF (o_s_trmb2%flag(iff)<=lev_files(iff)) THEN + ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), + ! $o_s_trmb2%name,itau_w,s_trmb2) + ! ENDIF + ! IF (o_s_trmb3%flag(iff)<=lev_files(iff)) THEN + ! CALL histwrite_phy(nid_files(iff),clef_stations(iff), + ! $o_s_trmb3%name,itau_w,s_trmb3) + ! ENDIF + +#ifdef CPP_IOIPSL +#ifndef CPP_XIOS + IF (.NOT.ok_all_xml) THEN + ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX: + ! Champs interpolles sur des niveaux de pression + missing_val=missing_val_nf90 + DO iff=1, nfiles + ll=0 + DO k=1, nlevSTD + bb2=clevSTD(k) + IF(bb2.EQ."850".OR.bb2.EQ."700".OR. & + bb2.EQ."500".OR.bb2.EQ."200".OR. & + bb2.EQ."100".OR. & + bb2.EQ."50".OR.bb2.EQ."10") THEN + + ! a refaire correctement !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ll=ll+1 + CALL histwrite_phy(o_uSTDlevs(ll),uwriteSTD(:,k,iff), iff) + CALL histwrite_phy(o_vSTDlevs(ll),vwriteSTD(:,k,iff), iff) + CALL histwrite_phy(o_wSTDlevs(ll),wwriteSTD(:,k,iff), iff) + CALL histwrite_phy(o_zSTDlevs(ll),phiwriteSTD(:,k,iff), iff) + CALL histwrite_phy(o_qSTDlevs(ll),qwriteSTD(:,k,iff), iff) + CALL histwrite_phy(o_tSTDlevs(ll),twriteSTD(:,k,iff), iff) + + ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR. + ENDDO + ENDDO + ENDIF +#endif +#endif +#ifdef CPP_XIOS + IF(ok_all_xml) THEN +!XIOS CALL xios_get_field_attr("u850",default_value=missing_val) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ll=0 + DO k=1, nlevSTD + bb2=clevSTD(k) + IF(bb2.EQ."850".OR.bb2.EQ."700".OR. & + bb2.EQ."500".OR.bb2.EQ."200".OR. & + bb2.EQ."100".OR. & + bb2.EQ."50".OR.bb2.EQ."10") THEN + ll=ll+1 + CALL histwrite_phy(o_uSTDlevs(ll),ulevSTD(:,k)) + CALL histwrite_phy(o_vSTDlevs(ll),vlevSTD(:,k)) + CALL histwrite_phy(o_wSTDlevs(ll),wlevSTD(:,k)) + CALL histwrite_phy(o_zSTDlevs(ll),philevSTD(:,k)) + CALL histwrite_phy(o_qSTDlevs(ll),qlevSTD(:,k)) + CALL histwrite_phy(o_tSTDlevs(ll),tlevSTD(:,k)) + ENDIF !(bb2.EQ."850".OR.bb2.EQ."700".OR. + ENDDO + ENDIF +#endif + IF (vars_defined) THEN + DO i=1, klon + IF (pctsrf(i,is_oce).GT.epsfra.OR. & + pctsrf(i,is_sic).GT.epsfra) THEN + zx_tmp_fi2d(i) = (ftsol(i, is_oce) * pctsrf(i,is_oce)+ & + ftsol(i, is_sic) * pctsrf(i,is_sic))/ & + (pctsrf(i,is_oce)+pctsrf(i,is_sic)) + ELSE + zx_tmp_fi2d(i) = 273.15 + ENDIF + ENDDO + ENDIF + CALL histwrite_phy(o_t_oce_sic, zx_tmp_fi2d) + + ! Couplage convection-couche limite + IF (iflag_con.GE.3) THEN + IF (iflag_coupl>=1) THEN + CALL histwrite_phy(o_ale_bl, ale_bl) + CALL histwrite_phy(o_alp_bl, alp_bl) + ENDIF !iflag_coupl>=1 + ENDIF !(iflag_con.GE.3) + ! Wakes + IF (iflag_con.EQ.3) THEN + IF (iflag_wake>=1) THEN + CALL histwrite_phy(o_ale_wk, ale_wake) + CALL histwrite_phy(o_alp_wk, alp_wake) + CALL histwrite_phy(o_ale, ale) + CALL histwrite_phy(o_alp, alp) + CALL histwrite_phy(o_cin, cin) + CALL histwrite_phy(o_WAPE, wake_pe) + CALL histwrite_phy(o_wake_h, wake_h) + CALL histwrite_phy(o_wake_s, wake_s) + CALL histwrite_phy(o_wake_deltat, wake_deltat) + CALL histwrite_phy(o_wake_deltaq, wake_deltaq) + CALL histwrite_phy(o_wake_omg, wake_omg) + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_wake(1:klon,1:klev) & + /pdtphys + CALL histwrite_phy(o_dtwak, zx_tmp_fi3d) + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_wake(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dqwak, zx_tmp_fi3d) + ENDIF ! iflag_wake>=1 + CALL histwrite_phy(o_ftd, ftd) + CALL histwrite_phy(o_fqd, fqd) + ENDIF !(iflag_con.EQ.3) + IF (iflag_con.EQ.3.OR.iflag_con.EQ.30) THEN + ! sortie RomP convection descente insaturee iflag_con=30 + ! etendue a iflag_con=3 (jyg) + CALL histwrite_phy(o_Vprecip, Vprecip) + CALL histwrite_phy(o_wdtrainA, wdtrainA) + CALL histwrite_phy(o_wdtrainM, wdtrainM) + ENDIF !(iflag_con.EQ.3.or.iflag_con.EQ.30) +!!! nrlmd le 10/04/2012 + IF (iflag_trig_bl>=1) THEN + CALL histwrite_phy(o_n2, n2) + CALL histwrite_phy(o_s2, s2) + CALL histwrite_phy(o_proba_notrig, proba_notrig) + CALL histwrite_phy(o_random_notrig, random_notrig) + CALL histwrite_phy(o_ale_bl_stat, ale_bl_stat) + CALL histwrite_phy(o_ale_bl_trig, ale_bl_trig) + ENDIF !(iflag_trig_bl>=1) + IF (iflag_clos_bl>=1) THEN + CALL histwrite_phy(o_alp_bl_det, alp_bl_det) + CALL histwrite_phy(o_alp_bl_fluct_m, alp_bl_fluct_m) + CALL histwrite_phy(o_alp_bl_fluct_tke, & + alp_bl_fluct_tke) + CALL histwrite_phy(o_alp_bl_conv, alp_bl_conv) + CALL histwrite_phy(o_alp_bl_stat, alp_bl_stat) + ENDIF !(iflag_clos_bl>=1) +!!! fin nrlmd le 10/04/2012 + ! Output of slab ocean variables + IF (type_ocean=='slab ') THEN + CALL histwrite_phy(o_slab_qflux, slab_wfbils) + CALL histwrite_phy(o_slab_bils, slab_bils) + IF (nslay.EQ.1) THEN + zx_tmp_fi2d(:)=tslab(:,1) + CALL histwrite_phy(o_tslab, zx_tmp_fi2d) + ELSE + CALL histwrite_phy(o_tslab, tslab) + END IF + IF (version_ocean=='sicINT') THEN + CALL histwrite_phy(o_slab_bilg, slab_bilg) + CALL histwrite_phy(o_slab_tice, tice) + CALL histwrite_phy(o_slab_sic, seaice) + END IF + ENDIF !type_ocean == force/slab + CALL histwrite_phy(o_weakinv, weak_inversion) + CALL histwrite_phy(o_dthmin, dthmin) + CALL histwrite_phy(o_cldtau, cldtau) + CALL histwrite_phy(o_cldemi, cldemi) + CALL histwrite_phy(o_pr_con_l, pmflxr(:,1:klev)) + CALL histwrite_phy(o_pr_con_i, pmflxs(:,1:klev)) + CALL histwrite_phy(o_pr_lsc_l, prfl(:,1:klev)) + CALL histwrite_phy(o_pr_lsc_i, psfl(:,1:klev)) + CALL histwrite_phy(o_re, re) + CALL histwrite_phy(o_fl, fl) + IF (vars_defined) THEN + DO i=1, klon + zx_tmp_fi2d(i)=MIN(100.,rh2m(i)*100.) + ENDDO + ENDIF + CALL histwrite_phy(o_rh2m, zx_tmp_fi2d) + + IF (vars_defined) THEN + DO i=1, klon + zx_tmp_fi2d(i)=MIN(100.,rh2m(i)*100.) + ENDDO + ENDIF + CALL histwrite_phy(o_rh2m_min, zx_tmp_fi2d) + + IF (vars_defined) THEN + DO i=1, klon + zx_tmp_fi2d(i)=MIN(100.,rh2m(i)*100.) + ENDDO + ENDIF + CALL histwrite_phy(o_rh2m_max, zx_tmp_fi2d) + + CALL histwrite_phy(o_qsat2m, qsat2m) + CALL histwrite_phy(o_tpot, tpot) + CALL histwrite_phy(o_tpote, tpote) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = fsolsw( 1 : klon, is_ter) + CALL histwrite_phy(o_SWnetOR, zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1:klon) = solsw(1:klon)/(1.-albsol1(1:klon)) + CALL histwrite_phy(o_SWdownOR, zx_tmp_fi2d) + CALL histwrite_phy(o_LWdownOR, sollwdown) + CALL histwrite_phy(o_snowl, snow_lsc) + CALL histwrite_phy(o_solldown, sollwdown) + CALL histwrite_phy(o_dtsvdfo, d_ts(:,is_oce)) + CALL histwrite_phy(o_dtsvdft, d_ts(:,is_ter)) + CALL histwrite_phy(o_dtsvdfg, d_ts(:,is_lic)) + CALL histwrite_phy(o_dtsvdfi, d_ts(:,is_sic)) + CALL histwrite_phy(o_z0m, z0m(:,nbsrf+1)) + CALL histwrite_phy(o_z0h, z0h(:,nbsrf+1)) + ! OD550 per species +!--OLIVIER +!This is warranted by treating INCA aerosols as offline aerosols +! IF (new_aod .and. (.not. aerosol_couple)) THEN + IF (new_aod) THEN + IF (flag_aerosol.GT.0) THEN + CALL histwrite_phy(o_od550aer, od550aer) + CALL histwrite_phy(o_od865aer, od865aer) + CALL histwrite_phy(o_absvisaer, absvisaer) + CALL histwrite_phy(o_od550lt1aer, od550lt1aer) + CALL histwrite_phy(o_sconcso4, sconcso4) + CALL histwrite_phy(o_sconcno3, sconcno3) + CALL histwrite_phy(o_sconcoa, sconcoa) + CALL histwrite_phy(o_sconcbc, sconcbc) + CALL histwrite_phy(o_sconcss, sconcss) + CALL histwrite_phy(o_sconcdust, sconcdust) + CALL histwrite_phy(o_concso4, concso4) + CALL histwrite_phy(o_concno3, concno3) + CALL histwrite_phy(o_concoa, concoa) + CALL histwrite_phy(o_concbc, concbc) + CALL histwrite_phy(o_concss, concss) + CALL histwrite_phy(o_concdust, concdust) + CALL histwrite_phy(o_loadso4, loadso4) + CALL histwrite_phy(o_loadoa, loadoa) + CALL histwrite_phy(o_loadbc, loadbc) + CALL histwrite_phy(o_loadss, loadss) + CALL histwrite_phy(o_loaddust, loaddust) + !--STRAT AER + ENDIF + IF (flag_aerosol.GT.0.OR.flag_aerosol_strat>=1) THEN +! DO naero = 1, naero_spc +!--correction mini bug OB + DO naero = 1, naero_tot + CALL histwrite_phy(o_tausumaero(naero), & + tausum_aero(:,2,naero) ) + END DO + ENDIF + IF (flag_aerosol_strat>=1) THEN + CALL histwrite_phy(o_tausumaero_lw, & + tausum_aero(:,6,id_STRAT_phy) ) + ENDIF + ENDIF + IF (ok_ade) THEN + CALL histwrite_phy(o_topswad, topswad_aero) + CALL histwrite_phy(o_topswad0, topswad0_aero) + CALL histwrite_phy(o_solswad, solswad_aero) + CALL histwrite_phy(o_solswad0, solswad0_aero) + CALL histwrite_phy(o_toplwad, toplwad_aero) + CALL histwrite_phy(o_toplwad0, toplwad0_aero) + CALL histwrite_phy(o_sollwad, sollwad_aero) + CALL histwrite_phy(o_sollwad0, sollwad0_aero) + !====MS forcing diagnostics + if (new_aod) then + CALL histwrite_phy(o_swtoaas_nat, topsw_aero(:,1)) + CALL histwrite_phy(o_swsrfas_nat, solsw_aero(:,1)) + CALL histwrite_phy(o_swtoacs_nat, topsw0_aero(:,1)) + CALL histwrite_phy(o_swsrfcs_nat, solsw0_aero(:,1)) + !ant + CALL histwrite_phy(o_swtoaas_ant, topsw_aero(:,2)) + CALL histwrite_phy(o_swsrfas_ant, solsw_aero(:,2)) + CALL histwrite_phy(o_swtoacs_ant, topsw0_aero(:,2)) + CALL histwrite_phy(o_swsrfcs_ant, solsw0_aero(:,2)) + !cf + if (.not. aerosol_couple) then + CALL histwrite_phy(o_swtoacf_nat, topswcf_aero(:,1)) + CALL histwrite_phy(o_swsrfcf_nat, solswcf_aero(:,1)) + CALL histwrite_phy(o_swtoacf_ant, topswcf_aero(:,2)) + CALL histwrite_phy(o_swsrfcf_ant, solswcf_aero(:,2)) + CALL histwrite_phy(o_swtoacf_zero,topswcf_aero(:,3)) + CALL histwrite_phy(o_swsrfcf_zero,solswcf_aero(:,3)) + endif + endif ! new_aod + !====MS forcing diagnostics + ENDIF + IF (ok_aie) THEN + CALL histwrite_phy(o_topswai, topswai_aero) + CALL histwrite_phy(o_solswai, solswai_aero) + ENDIF + IF (flag_aerosol.GT.0.AND.ok_cdnc) THEN + CALL histwrite_phy(o_scdnc, scdnc) + CALL histwrite_phy(o_cldncl, cldncl) + CALL histwrite_phy(o_reffclws, reffclws) + CALL histwrite_phy(o_reffclwc, reffclwc) + CALL histwrite_phy(o_cldnvi, cldnvi) + CALL histwrite_phy(o_lcc, lcc) + CALL histwrite_phy(o_lcc3d, lcc3d) + CALL histwrite_phy(o_lcc3dcon, lcc3dcon) + CALL histwrite_phy(o_lcc3dstra, lcc3dstra) + CALL histwrite_phy(o_reffclwtop, reffclwtop) + ENDIF + ! Champs 3D: + IF (ok_ade .OR. ok_aie) then + CALL histwrite_phy(o_ec550aer, ec550aer) + ENDIF + CALL histwrite_phy(o_lwcon, flwc) + CALL histwrite_phy(o_iwcon, fiwc) + CALL histwrite_phy(o_temp, t_seri) + CALL histwrite_phy(o_theta, theta) + CALL histwrite_phy(o_ovapinit, qx(:,:,ivap)) + CALL histwrite_phy(o_ovap, q_seri) + CALL histwrite_phy(o_oliq, ql_seri) + CALL histwrite_phy(o_geop, zphi) + CALL histwrite_phy(o_vitu, u_seri) + CALL histwrite_phy(o_vitv, v_seri) + CALL histwrite_phy(o_vitw, omega) + CALL histwrite_phy(o_pres, pplay) + CALL histwrite_phy(o_paprs, paprs(:,1:klev)) + IF (vars_defined) THEN + DO i=1, klon + zx_tmp_fi3d1(i,1)= pphis(i)/RG + !020611 zx_tmp_fi3d(i,1)= pphis(i)/RG + ENDDO + DO k=1, klev + !020611 DO k=1, klev-1 + DO i=1, klon + !020611 zx_tmp_fi3d(i,k+1)= zx_tmp_fi3d(i,k) - (t_seri(i,k) *RD * + zx_tmp_fi3d1(i,k+1)= zx_tmp_fi3d1(i,k) - (t_seri(i,k) *RD * & + (paprs(i,k+1) - paprs(i,k))) / ( pplay(i,k) * RG ) + ENDDO + ENDDO + ENDIF + CALL histwrite_phy(o_zfull,zx_tmp_fi3d1(:,2:klevp1)) + !020611 $o_zfull%name,itau_w,zx_tmp_fi3d) + + IF (vars_defined) THEN + DO i=1, klon + zx_tmp_fi3d(i,1)= pphis(i)/RG - ( & + (t_seri(i,1)+zxtsol(i))/2. *RD * & + (pplay(i,1) - paprs(i,1)))/( (paprs(i,1)+pplay(i,1))/2.* RG) + ENDDO + DO k=1, klev-1 + DO i=1, klon + zx_tmp_fi3d(i,k+1)= zx_tmp_fi3d(i,k) - ( & + (t_seri(i,k)+t_seri(i,k+1))/2. *RD * & + (pplay(i,k+1) - pplay(i,k))) / ( paprs(i,k) * RG ) + ENDDO + ENDDO + ENDIF + CALL histwrite_phy(o_zhalf, zx_tmp_fi3d) + CALL histwrite_phy(o_rneb, cldfra) + CALL histwrite_phy(o_rnebcon, rnebcon) + CALL histwrite_phy(o_rnebls, rneb) + IF (vars_defined) THEN + DO k=1, klev + DO i=1, klon + zx_tmp_fi3d(i,k)=cldfra(i,k)*JrNt(i) + ENDDO + ENDDO + ENDIF + CALL histwrite_phy(o_rnebjn, zx_tmp_fi3d) + CALL histwrite_phy(o_rhum, zx_rh) + CALL histwrite_phy(o_ozone, & + wo(:, :, 1) * dobson_u * 1e3 / zmasse / rmo3 * rmd) + + IF (read_climoz == 2) THEN + CALL histwrite_phy(o_ozone_light, & + wo(:, :, 2) * dobson_u * 1e3 / zmasse / rmo3 * rmd) + ENDIF + + CALL histwrite_phy(o_dtphy, d_t) + CALL histwrite_phy(o_dqphy, d_qx(:,:,ivap)) + DO nsrf=1, nbsrf + IF (vars_defined) zx_tmp_fi2d(1 : klon) = falb1( 1 : klon, nsrf) + CALL histwrite_phy(o_albe_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = z0m( 1 : klon, nsrf) + CALL histwrite_phy(o_z0m_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = z0h( 1 : klon, nsrf) + CALL histwrite_phy(o_z0h_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = agesno( 1 : klon, nsrf) + CALL histwrite_phy(o_ages_srf(nsrf), zx_tmp_fi2d) + IF (vars_defined) zx_tmp_fi2d(1 : klon) = snow( 1 : klon, nsrf) + CALL histwrite_phy(o_snow_srf(nsrf), zx_tmp_fi2d) + ENDDO !nsrf=1, nbsrf + CALL histwrite_phy(o_alb1, albsol1) + CALL histwrite_phy(o_alb2, albsol2) + !FH Sorties pour la couche limite + if (iflag_pbl>1) then + zx_tmp_fi3d=0. + IF (vars_defined) THEN + do nsrf=1,nbsrf + do k=1,klev + zx_tmp_fi3d(:,k)=zx_tmp_fi3d(:,k) & + +pctsrf(:,nsrf)*pbl_tke(:,k,nsrf) + enddo + enddo + ENDIF + CALL histwrite_phy(o_tke, zx_tmp_fi3d) + + CALL histwrite_phy(o_tke_max, zx_tmp_fi3d) + ENDIF + + CALL histwrite_phy(o_kz, coefh(:,:,is_ave)) + + CALL histwrite_phy(o_kz_max, coefh(:,:,is_ave)) + + CALL histwrite_phy(o_clwcon, clwcon0) + CALL histwrite_phy(o_dtdyn, d_t_dyn) + CALL histwrite_phy(o_dqdyn, d_q_dyn) + CALL histwrite_phy(o_dudyn, d_u_dyn) + CALL histwrite_phy(o_dvdyn, d_v_dyn) + + IF (vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys + ENDIF + CALL histwrite_phy(o_dtcon, zx_tmp_fi3d) + if(iflag_thermals.eq.0)then + IF (vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys + & + d_t_ajsb(1:klon,1:klev)/pdtphys + ENDIF + CALL histwrite_phy(o_tntc, zx_tmp_fi3d) + else if(iflag_thermals.ge.1.and.iflag_wake.EQ.1)then + IF (vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_t_con(1:klon,1:klev)/pdtphys + & + d_t_ajs(1:klon,1:klev)/pdtphys + & + d_t_wake(1:klon,1:klev)/pdtphys + ENDIF + CALL histwrite_phy(o_tntc, zx_tmp_fi3d) + endif + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_con(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_ducon, zx_tmp_fi3d) + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_con(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dvcon, zx_tmp_fi3d) + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dqcon, zx_tmp_fi3d) + + IF(iflag_thermals.EQ.0) THEN + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_tnhusc, zx_tmp_fi3d) + ELSE IF(iflag_thermals.GE.1.AND.iflag_wake.EQ.1) THEN + IF (vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_q_con(1:klon,1:klev)/pdtphys + & + d_q_ajs(1:klon,1:klev)/pdtphys + & + d_q_wake(1:klon,1:klev)/pdtphys + ENDIF + CALL histwrite_phy(o_tnhusc, zx_tmp_fi3d) + ENDIF + + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lsc(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtlsc, zx_tmp_fi3d) + IF (vars_defined) zx_tmp_fi3d(1:klon, 1:klev)=(d_t_lsc(1:klon,1:klev)+ & + d_t_eva(1:klon,1:klev))/pdtphys + CALL histwrite_phy(o_dtlschr, zx_tmp_fi3d) + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lsc(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dqlsc, zx_tmp_fi3d) + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=beta_prec(1:klon,1:klev) + CALL histwrite_phy(o_beta_prec, zx_tmp_fi3d) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ! Sorties specifiques a la separation thermiques/non thermiques + if (iflag_thermals>=1) then + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscth(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtlscth, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lscst(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtlscst, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscth(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dqlscth, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_lscst(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dqlscst, zx_tmp_fi3d) + CALL histwrite_phy(o_plulth, plul_th) + CALL histwrite_phy(o_plulst, plul_st) + IF (vars_defined) THEN + do k=1,klev + do i=1,klon + if (ptconvth(i,k)) then + zx_tmp_fi3d(i,k)=1. + else + zx_tmp_fi3d(i,k)=0. + endif + enddo + enddo + ENDIF + CALL histwrite_phy(o_ptconvth, zx_tmp_fi3d) + IF (vars_defined) THEN + do i=1,klon + zx_tmp_fi2d(1:klon)=lmax_th(:) + enddo + ENDIF + CALL histwrite_phy(o_lmaxth, zx_tmp_fi2d) + endif ! iflag_thermals>=1 +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_vdf(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtvdf, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_diss(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtdis, zx_tmp_fi3d) + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_vdf(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dqvdf, zx_tmp_fi3d) + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_eva(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dteva, zx_tmp_fi3d) + IF (vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_eva(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dqeva, zx_tmp_fi3d) + zpt_conv = 0. + WHERE (ptconv) zpt_conv = 1. + CALL histwrite_phy(o_ptconv, zpt_conv) + CALL histwrite_phy(o_ratqs, ratqs) + IF (vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_t_ajs(1:klon,1:klev)/pdtphys - & + d_t_ajsb(1:klon,1:klev)/pdtphys + ENDIF + CALL histwrite_phy(o_dtthe, zx_tmp_fi3d) + IF (vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_u_ajs(1:klon,1:klev)/pdtphys + ENDIF + CALL histwrite_phy(o_duthe, zx_tmp_fi3d) + IF (vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_v_ajs(1:klon,1:klev)/pdtphys + ENDIF + CALL histwrite_phy(o_dvthe, zx_tmp_fi3d) + + IF (iflag_thermals>=1) THEN + ! Pour l instant 0 a y reflichir pour les thermiques + zx_tmp_fi2d=0. + CALL histwrite_phy(o_ftime_th, zx_tmp_fi2d) + CALL histwrite_phy(o_f_th, fm_therm) + CALL histwrite_phy(o_e_th, entr_therm) + CALL histwrite_phy(o_w_th, zw2) + CALL histwrite_phy(o_q_th, zqasc) + CALL histwrite_phy(o_a_th, fraca) + CALL histwrite_phy(o_d_th, detr_therm) + CALL histwrite_phy(o_f0_th, f0) + CALL histwrite_phy(o_zmax_th, zmax_th) + IF (vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_q_ajs(1:klon,1:klev)/pdtphys - & + d_q_ajsb(1:klon,1:klev)/pdtphys + ENDIF + CALL histwrite_phy(o_dqthe, zx_tmp_fi3d) + ENDIF !iflag_thermals + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ajsb(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtajs, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_q_ajsb(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dqajs, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtswr, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_sw0(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtsw0, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lwr(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtlwr, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lw0(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtlw0, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_ec(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtec, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_vdf(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_duvdf, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_vdf(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dvvdf, zx_tmp_fi3d) + IF (ok_orodr) THEN + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_oro(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_duoro, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_oro(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dvoro, zx_tmp_fi3d) + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_oro(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtoro, zx_tmp_fi3d) + ENDIF + IF (ok_orolf) THEN + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_lif(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dulif, zx_tmp_fi3d) + + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_lif(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dvlif, zx_tmp_fi3d) + + IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_lif(1:klon,1:klev)/pdtphys + CALL histwrite_phy(o_dtlif, zx_tmp_fi3d) + ENDIF + +! IF (ok_hines) THEN +! IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_u_hin(1:klon,1:klev)/pdtphys +! CALL histwrite_phy(o_duhin, zx_tmp_fi3d) +! IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_v_hin(1:klon,1:klev)/pdtphys +! CALL histwrite_phy(o_dvhin, zx_tmp_fi3d) +! IF(vars_defined) zx_tmp_fi3d(1:klon,1:klev)=d_t_hin(1:klon,1:klev)/pdtphys +! CALL histwrite_phy(o_dthin, zx_tmp_fi3d) +! ENDIF + +! IF (ok_gwd_rando) then +! CALL histwrite_phy(o_du_gwd_rando, du_gwd_rando / pdtphys) +! CALL histwrite_phy(o_dv_gwd_rando, dv_gwd_rando / pdtphys) +! CALL histwrite_phy(o_vstr_gwd_rando, zvstr_gwd_rando) +! end IF + + IF (ok_qch4) then + CALL histwrite_phy(o_dqch4, d_q_ch4 / pdtphys) + ENDIF + + CALL histwrite_phy(o_rsu, swup) + CALL histwrite_phy(o_rsd, swdn) + CALL histwrite_phy(o_rlu, lwup) + CALL histwrite_phy(o_rld, lwdn) + CALL histwrite_phy(o_rsucs, swup0) + CALL histwrite_phy(o_rsdcs, swdn0) + CALL histwrite_phy(o_rlucs, lwup0) + CALL histwrite_phy(o_rldcs, lwdn0) + IF(vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_t(1:klon,1:klev)+ & + d_t_dyn(1:klon,1:klev) + ENDIF + CALL histwrite_phy(o_tnt, zx_tmp_fi3d) + IF(vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_t_swr(1:klon,1:klev)/pdtphys + & + d_t_lwr(1:klon,1:klev)/pdtphys + ENDIF + CALL histwrite_phy(o_tntr, zx_tmp_fi3d) + IF(vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)= (d_t_lsc(1:klon,1:klev)+ & + d_t_eva(1:klon,1:klev)+ & + d_t_vdf(1:klon,1:klev))/pdtphys + ENDIF + CALL histwrite_phy(o_tntscpbl, zx_tmp_fi3d) + IF(vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_qx(1:klon,1:klev,ivap)+ & + d_q_dyn(1:klon,1:klev) + ENDIF + CALL histwrite_phy(o_tnhus, zx_tmp_fi3d) + IF(vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=d_q_lsc(1:klon,1:klev)/pdtphys+ & + d_q_eva(1:klon,1:klev)/pdtphys + ENDIF + CALL histwrite_phy(o_tnhusscpbl, zx_tmp_fi3d) + CALL histwrite_phy(o_evu, coefm(:,:,is_ave)) + IF(vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=q_seri(1:klon,1:klev)+ & + ql_seri(1:klon,1:klev) + ENDIF + CALL histwrite_phy(o_h2o, zx_tmp_fi3d) + if (iflag_con >= 3) then + IF(vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=-1 * (dnwd(1:klon,1:klev)+ & + dnwd0(1:klon,1:klev)) + ENDIF + CALL histwrite_phy(o_mcd, zx_tmp_fi3d) + IF(vars_defined) THEN + zx_tmp_fi3d(1:klon,1:klev)=upwd(1:klon,1:klev) + & + dnwd(1:klon,1:klev)+ dnwd0(1:klon,1:klev) + ENDIF + CALL histwrite_phy(o_dmc, zx_tmp_fi3d) + else if (iflag_con == 2) then + CALL histwrite_phy(o_mcd, pmfd) + CALL histwrite_phy(o_dmc, pmfu + pmfd) + end if + CALL histwrite_phy(o_ref_liq, ref_liq) + CALL histwrite_phy(o_ref_ice, ref_ice) + if (RCO2_per.NE.RCO2_act.OR.RCH4_per.NE.RCH4_act.OR. & + RN2O_per.NE.RN2O_act.OR.RCFC11_per.NE.RCFC11_act.OR. & + RCFC12_per.NE.RCFC12_act) THEN + IF(vars_defined) zx_tmp_fi2d(1 : klon) = swupp ( 1 : klon, klevp1 ) + CALL histwrite_phy(o_rsut4co2, zx_tmp_fi2d) + IF(vars_defined) zx_tmp_fi2d(1 : klon) = lwupp ( 1 : klon, klevp1 ) + CALL histwrite_phy(o_rlut4co2, zx_tmp_fi2d) + IF(vars_defined) zx_tmp_fi2d(1 : klon) = swup0p ( 1 : klon, klevp1 ) + CALL histwrite_phy(o_rsutcs4co2, zx_tmp_fi2d) + IF(vars_defined) zx_tmp_fi2d(1 : klon) = lwup0p ( 1 : klon, klevp1 ) + CALL histwrite_phy(o_rlutcs4co2, zx_tmp_fi2d) + CALL histwrite_phy(o_rsu4co2, swupp) + CALL histwrite_phy(o_rlu4co2, lwupp) + CALL histwrite_phy(o_rsucs4co2, swup0p) + CALL histwrite_phy(o_rlucs4co2, lwup0p) + CALL histwrite_phy(o_rsd4co2, swdnp) + CALL histwrite_phy(o_rld4co2, lwdnp) + CALL histwrite_phy(o_rsdcs4co2, swdn0p) + CALL histwrite_phy(o_rldcs4co2, lwdn0p) + ENDIF +!!!!!!!!!!!! Sorties niveaux de pression NMC !!!!!!!!!!!!!!!!!!!! +#ifdef CPP_IOIPSL +#ifndef CPP_XIOS + IF (.NOT.ok_all_xml) THEN + ! ATTENTION, LES ANCIENS HISTWRITE ONT ETES CONSERVES EN ATTENDANT MIEUX: + ! Champs interpolles sur des niveaux de pression + missing_val=missing_val_nf90 + DO iff=7, nfiles + + CALL histwrite_phy(o_tnondef,tnondef(:,:,iff-6),iff) + CALL histwrite_phy(o_ta,twriteSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_zg,phiwriteSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_hus,qwriteSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_hur,rhwriteSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_ua,uwriteSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_va,vwriteSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_wap,wwriteSTD(:,:,iff-6),iff) + IF(vars_defined) THEN + DO k=1, nlevSTD + DO i=1, klon + IF(tnondef(i,k,iff-6).NE.missing_val) THEN + IF(freq_outNMC(iff-6).LT.0) THEN + freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6) + ELSE + freq_moyNMC(iff-6)=freq_outNMC(iff-6)/freq_calNMC(iff-6) + ENDIF + zx_tmp_fi3d_STD(i,k) = (100.*tnondef(i,k,iff-6))/freq_moyNMC(iff-6) + ELSE + zx_tmp_fi3d_STD(i,k) = missing_val + ENDIF + ENDDO + ENDDO + ENDIF + CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD,iff) + IF(vars_defined) THEN + DO k=1, nlevSTD + DO i=1, klon + IF(O3sumSTD(i,k,iff-6).NE.missing_val) THEN + zx_tmp_fi3d_STD(i,k) = O3sumSTD(i,k,iff-6) * 1.e+9 + ELSE + zx_tmp_fi3d_STD(i,k) = missing_val + ENDIF + ENDDO + ENDDO !k=1, nlevSTD + ENDIF + CALL histwrite_phy(o_tro3,zx_tmp_fi3d_STD,iff) + if (read_climoz == 2) THEN + IF(vars_defined) THEN + DO k=1, nlevSTD + DO i=1, klon + IF(O3daysumSTD(i,k,iff-6).NE.missing_val) THEN + zx_tmp_fi3d_STD(i,k) = O3daysumSTD(i,k,iff-6) * 1.e+9 + ELSE + zx_tmp_fi3d_STD(i,k) = missing_val + ENDIF + ENDDO + ENDDO !k=1, nlevSTD + ENDIF + CALL histwrite_phy(o_tro3_daylight,zx_tmp_fi3d_STD,iff) + endif + CALL histwrite_phy(o_uxv,uvsumSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_vxq,vqsumSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_vxT,vTsumSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_wxq,wqsumSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_vxphi,vphisumSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_wxT,wTsumSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_uxu,u2sumSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_vxv,v2sumSTD(:,:,iff-6),iff) + CALL histwrite_phy(o_TxT,T2sumSTD(:,:,iff-6),iff) + ENDDO !nfiles + ENDIF +#endif +#endif +#ifdef CPP_XIOS + IF(ok_all_xml) THEN +! DO iff=7, nfiles + +! CALL histwrite_phy(o_tnondef,tnondef(:,:,3)) + CALL histwrite_phy(o_ta,tlevSTD(:,:)) + CALL histwrite_phy(o_zg,philevSTD(:,:)) + CALL histwrite_phy(o_hus,qlevSTD(:,:)) + CALL histwrite_phy(o_hur,rhlevSTD(:,:)) + CALL histwrite_phy(o_ua,ulevSTD(:,:)) + CALL histwrite_phy(o_va,vlevSTD(:,:)) + CALL histwrite_phy(o_wap,wlevSTD(:,:)) +! IF(vars_defined) THEN +! DO k=1, nlevSTD +! DO i=1, klon +! IF(tnondef(i,k,3).NE.missing_val) THEN +! IF(freq_outNMC(iff-6).LT.0) THEN +! freq_moyNMC(iff-6)=(mth_len*un_jour)/freq_calNMC(iff-6) +! ELSE +! freq_moyNMC(iff-6)=freq_outNMC(iff-6)/freq_calNMC(iff-6) +! ENDIF +! zx_tmp_fi3d_STD(i,k) = (100.*tnondef(i,k,3))/freq_moyNMC(iff-6) +! ELSE +! zx_tmp_fi3d_STD(i,k) = missing_val +! ENDIF +! ENDDO +! ENDDO +! ENDIF +! CALL histwrite_phy(o_psbg,zx_tmp_fi3d_STD) + IF(vars_defined) THEN + DO k=1, nlevSTD + DO i=1, klon + IF(O3STD(i,k).NE.missing_val) THEN + zx_tmp_fi3d_STD(i,k) = O3STD(i,k) * 1.e+9 + ELSE + zx_tmp_fi3d_STD(i,k) = missing_val + ENDIF + ENDDO + ENDDO !k=1, nlevSTD + ENDIF + CALL histwrite_phy(o_tro3,zx_tmp_fi3d_STD) + if (read_climoz == 2) THEN + IF(vars_defined) THEN + DO k=1, nlevSTD + DO i=1, klon + IF(O3daySTD(i,k).NE.missing_val) THEN + zx_tmp_fi3d_STD(i,k) = O3daySTD(i,k) * 1.e+9 + ELSE + zx_tmp_fi3d_STD(i,k) = missing_val + ENDIF + ENDDO + ENDDO !k=1, nlevSTD + ENDIF + CALL histwrite_phy(o_tro3_daylight,zx_tmp_fi3d_STD) + endif + CALL histwrite_phy(o_uxv,uvSTD(:,:)) + CALL histwrite_phy(o_vxq,vqSTD(:,:)) + CALL histwrite_phy(o_vxT,vTSTD(:,:)) + CALL histwrite_phy(o_wxq,wqSTD(:,:)) + CALL histwrite_phy(o_vxphi,vphiSTD(:,:)) + CALL histwrite_phy(o_wxT,wTSTD(:,:)) + CALL histwrite_phy(o_uxu,u2STD(:,:)) + CALL histwrite_phy(o_vxv,v2STD(:,:)) + CALL histwrite_phy(o_TxT,T2STD(:,:)) +! ENDDO !nfiles + ENDIF +#endif +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + IF (nqtot.GE.nqo+1) THEN + DO iq=nqo+1,nqtot + IF (type_trac == 'lmdz' .OR. type_trac == 'repr') THEN + +!jyg< +!! CALL histwrite_phy(o_trac(iq-nqo), qx(:,:,iq)) + CALL histwrite_phy(o_trac(iq-nqo), tr_seri(:,:,iq-nqo)) +!>jyg + CALL histwrite_phy(o_dtr_vdf(iq-nqo),d_tr_cl(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_the(iq-nqo),d_tr_th(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_con(iq-nqo),d_tr_cv(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_lessi_impa(iq-nqo),d_tr_lessi_impa(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_lessi_nucl(iq-nqo),d_tr_lessi_nucl(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_insc(iq-nqo),d_tr_insc(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_bcscav(iq-nqo),d_tr_bcscav(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_evapls(iq-nqo),d_tr_evapls(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_ls(iq-nqo),d_tr_ls(:,:,iq-nqo)) +! CALL histwrite_phy(o_dtr_dyn(iq-nqo),d_tr_dyn(:,:,iq-nqo)) + !! CALL histwrite_phy(o_dtr_cl(iq-nqo),d_tr_cl(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_trsp(iq-nqo),d_tr_trsp(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_sscav(iq-nqo),d_tr_sscav(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_sat(iq-nqo),d_tr_sat(:,:,iq-nqo)) + CALL histwrite_phy(o_dtr_uscav(iq-nqo),d_tr_uscav(:,:,iq-nqo)) + zx_tmp_fi2d=0. + IF(vars_defined) THEN + DO k=1,klev +!jyg< +!! zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*qx(:,k,iq) + zx_tmp_fi2d(:)=zx_tmp_fi2d(:)+zmasse(:,k)*tr_seri(:,k,iq-nqo) +!>jyg + ENDDO + ENDIF + CALL histwrite_phy(o_trac_cum(iq-nqo), zx_tmp_fi2d) + endif + ENDDO + ENDIF + + IF(.NOT.vars_defined) THEN + !$OMP MASTER +#ifndef CPP_IOIPSL_NO_OUTPUT + DO iff=1,nfiles + IF (clef_files(iff)) THEN + CALL histend(nid_files(iff)) + ndex2d = 0 + ndex3d = 0 + + ENDIF ! clef_files + ENDDO ! iff +#endif +#ifdef CPP_XIOS + !On finalise l'initialisation: + CALL wxios_closedef() +#endif + + !$OMP END MASTER + !$OMP BARRIER + vars_defined = .TRUE. + + END IF + + END DO + + IF(vars_defined) THEN + ! On synchronise les fichiers pour IOIPSL +#ifndef CPP_IOIPSL_NO_OUTPUT + !$OMP MASTER + DO iff=1,nfiles + IF (ok_sync .AND. clef_files(iff)) THEN + CALL histsync(nid_files(iff)) + ENDIF + END DO + !$OMP END MASTER +#endif + ENDIF + + END SUBROUTINE phys_output_write_spl + +END MODULE phys_output_write_spl_mod Index: /LMDZ5/trunk/libf/phylmd/Dust/phytracr_spl_mod.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/phytracr_spl_mod.F90 (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/phytracr_spl_mod.F90 (revision 2630) @@ -0,0 +1,6040 @@ +! $Id: physiq.F90 2298 2015-06-14 19:13:32Z fairhead $ +!#define IO_DEBUG + +MODULE phytracr_spl_mod + + +! Recuperation des morceaux de la physique de Jeronimo specifiques +! du modele d'aerosols d'Olivier n'co. +! +INCLUDE "chem.h" +INCLUDE "chem_spla.h" + + REAL,SAVE :: scale_param_ssacc !Scaling parameter for Fine Sea Salt + REAL,SAVE :: scale_param_sscoa !Scaling parameter for Coarse Sea Salt + + + + REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_ind !Scaling parameter for industrial emissions of SO2 + REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_bb !Scaling parameter for biomas burning (SO2,BC & OM) + REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_ff !Scaling parameter for industrial emissions (fossil fuel) + REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_dustacc !Scaling parameter for Fine Dust + REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_dustcoa !Scaling parameter for Coarse Dust + REAL, DIMENSION(:),ALLOCATABLE,SAVE :: scale_param_dustsco !Scaling parameter for SCoarse Dust + REAL, DIMENSION(:),ALLOCATABLE,SAVE :: param_wstarBLperregion !parameter for .. + REAL, DIMENSION(:),ALLOCATABLE,SAVE :: param_wstarWAKEperregion !parameter for .. + !$OMP THREADPRIVATE(scale_param_ind,scale_param_bb,scale_param_ff) + !$OMP THREADPRIVATE(scale_param_dustacc,scale_param_dustcoa,scale_param_dustsco) + !$OMP THREADPRIVATE(scale_param_ssacc,scale_param_sscoa) + !$OMP THREADPRIVATE(param_wstarBLperregion,param_wstarWAKEperregion) + REAL, DIMENSION(:),ALLOCATABLE,SAVE ::dust_ec, u10m_ec, v10m_ec +!$OMP THREADPRIVATE(dust_ec, u10m_ec, v10m_ec) + + CHARACTER*800 fileregionsdimsind + CHARACTER*800 fileregionsdimsdust + CHARACTER*800 fileregionsdimsbb + CHARACTER*800 fileregionsdimswstar +! CHARACTER*800 filescaleparamsind +! CHARACTER*800 filescaleparamsdust +! CHARACTER*800 filescaleparamsbb + CHARACTER*100 paramname_ind + CHARACTER*100 paramname_bb + CHARACTER*100 paramname_ff + CHARACTER*100 paramname_dustacc + CHARACTER*100 paramname_dustcoa + CHARACTER*100 paramname_dustsco + CHARACTER*100 paramname_ssacc + CHARACTER*100 paramname_sscoa + CHARACTER*100 paramname_wstarBL + CHARACTER*100 paramname_wstarWAKE + + + CHARACTER*800 filescaleparams + CHARACTER*800 paramsname + + + !!------------------------ SULFUR emissions ---------------------------- + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2volc_cont ! emissions so2 volcan continuous + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_altvolc_cont ! altitude so2 volcan continuous + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2volc_expl ! emissions so2 volcan explosive +!$OMP THREADPRIVATE( lmt_so2volc_cont,lmt_altvolc_cont,lmt_so2volc_expl ) + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_altvolc_expl ! altitude so2 volcan explosive + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2ff_l ! emissions so2 fossil fuel (low) + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2ff_h ! emissions so2 fossil fuel (high) +!$OMP THREADPRIVATE( lmt_altvolc_expl,lmt_so2ff_l,lmt_so2ff_h ) + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2nff ! emissions so2 non-fossil fuel + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2ba ! emissions de so2 bateau + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2bb_l ! emissions de so2 biomass burning (low) +!$OMP THREADPRIVATE( lmt_so2nff,lmt_so2ba,lmt_so2bb_l ) + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_so2bb_h ! emissions de so2 biomass burning (high) + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_dmsconc ! concentration de dms oceanique + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_dmsbio ! emissions de dms bio + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_h2sbio ! emissions de h2s bio +!$OMP THREADPRIVATE(lmt_so2bb_h,lmt_dmsconc,lmt_dmsbio,lmt_h2sbio ) + !------------------------- BLACK CARBON emissions ---------------------- + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_bcff ! emissions de BC fossil fuels + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_bcnff ! emissions de BC non-fossil fuels + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_bcbb_l ! emissions de BC biomass basses +!$OMP THREADPRIVATE( lmt_bcff,lmt_bcnff,lmt_bcbb_l) + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_bcbb_h ! emissions de BC biomass hautes + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_bcba ! emissions de BC bateau +!$OMP THREADPRIVATE(lmt_bcbb_h,lmt_bcba) + !------------------------ ORGANIC MATTER emissions --------------------- + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_omff ! emissions de OM fossil fuels + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_omnff ! emissions de OM non-fossil fuels + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_ombb_l ! emissions de OM biomass basses +!$OMP THREADPRIVATE( lmt_omff,lmt_omnff,lmt_ombb_l) + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_ombb_h ! emissions de OM biomass hautes + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_omnat ! emissions de OM Natural + REAL , DIMENSION(:),ALLOCATABLE,SAVE :: lmt_omba ! emissions de OM bateau + REAL , DIMENSION(:,:),ALLOCATABLE,SAVE :: lmt_sea_salt ! emissions de OM Natural +!$OMP THREADPRIVATE(lmt_ombb_h,lmt_omnat,lmt_omba,lmt_sea_salt) + +!JE20141224 >> + ! others + REAL, DIMENSION(:),ALLOCATABLE,SAVE :: tsol +!$OMP THREADPRIVATE(tsol) + INTEGER :: ijulday + LOGICAL , parameter :: edgar = .true. + INTEGER , parameter :: flag_dms=4 + INTEGER*4 nbjour + + ! +! Tracer tendencies, for outputs +!------------------------------- + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cl ! Td couche +!. limite/traceur + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_dec +!RomP + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv ! Td +!onvection/traceur +! RomP >>> + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_insc + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_bcscav + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_evapls + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_ls + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPr,qDi ! concentration tra +!dans pluie,air descente insaturee + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qPa,qMel + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: qTrdi,dtrcvMA ! conc traceur +!descente air insaturee et td convective MA +!! RomP <<< + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_th ! Td thermique + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_lessi_impa ! Td du +!lessivage par impaction + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_lessi_nucl ! Td du +!lessivage par nucleation + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: qPrls !jyg: +!oncentration tra dans pluie LS a la surf. + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: d_tr_dry ! Td depot +!sec/traceur (1st layer),ALLOCATABLE,SAVE jyg + REAL,DIMENSION(:,:),ALLOCATABLE,SAVE :: flux_tr_dry ! depot +!sec/traceur (surface),ALLOCATABLE,SAVE jyg + +! Index of each traceur + INTEGER,SAVE :: id_prec, id_fine, id_coss, id_codu, id_scdu + +!$OMP THREADPRIVATE(d_tr_cl,d_tr_dec,d_tr_cv,d_tr_insc,d_tr_bcscav,d_tr_evapls) +!$OMP THREADPRIVATE(d_tr_ls,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav) +!$OMP THREADPRIVATE(qPr,qDi,qPa,qMel,qTrdi,dtrcvMA,d_tr_th,d_tr_lessi_impa) +!$OMP THREADPRIVATE(d_tr_lessi_nucl,qPrls,d_tr_dry,flux_tr_dry) +!$OMP THREADPRIVATE(id_prec,id_fine,id_coss,id_codu,id_scdu) + +! JE20141224 << + + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diff_aod550_tot ! epaisseur optique total aerosol 550 nm + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod670_tot ! epaisseur optique total aerosol 670 nm + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod865_tot ! epaisseur optique total aerosol 865 nm + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diff_aod550_tr2 ! epaisseur optique Traceur 2 aerosol 550 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod670_tr2 ! epaisseur optique Traceur 2 aerosol 670 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod865_tr2 ! epaisseur optique Traceur 2 aerosol 865 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod550_ss ! epaisseur optique Sels marins aerosol 550 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod670_ss ! epaisseur optique Sels marins aerosol 670 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod865_ss ! epaisseur optique Sels marins aerosol 865 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod550_dust ! epaisseur optique Dust aerosol 550 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod670_dust ! epaisseur optique Dust aerosol 670 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod865_dust ! epaisseur optique Dust aerosol 865 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod550_dustsco ! epaisseur optique Dust SCOarse aerosol 550 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod670_dustsco ! epaisseur optique Dust SCOarse aerosol 670 nm, diagnostic + REAL,DIMENSION(:),ALLOCATABLE,SAVE :: diag_aod865_dustsco ! epaisseur optique Dust SCOarse aerosol 865 nm, diagnostic + +!$OMP THREADPRIVATE(diff_aod550_tot,diag_aod670_tot,diag_aod865_tot) +!$OMP THREADPRIVATE(diff_aod550_tr2,diag_aod670_tr2,diag_aod865_tr2) +!$OMP THREADPRIVATE(diag_aod550_ss,diag_aod670_ss,diag_aod865_ss,diag_aod550_dust) +!$OMP THREADPRIVATE(diag_aod670_dust,diag_aod865_dust,diag_aod550_dustsco) +!$OMP THREADPRIVATE(diag_aod670_dustsco,diag_aod865_dustsco) + + + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_tr2_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_ss_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dust_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dustsco_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_tr2_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_ss_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dust_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dustsco_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_tr2_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_ss_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dust_terra ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dustsco_terra ! AOD at terra overpass time ( 10.30 local hour) + + + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_tr2_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_ss_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dust_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod550_dustsco_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_tr2_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_ss_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dust_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod670_dustsco_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_tr2_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_ss_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dust_aqua ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: aod865_dustsco_aqua ! AOD at aqua overpass time ( 13.30 local hour) + +!$OMP THREADPRIVATE(aod550_aqua,aod550_tr2_aqua,aod550_ss_aqua,aod550_dust_aqua,aod550_dustsco_aqua) +!$OMP THREADPRIVATE(aod670_aqua,aod670_tr2_aqua,aod670_ss_aqua,aod670_dust_aqua,aod670_dustsco_aqua) +!$OMP THREADPRIVATE(aod865_aqua,aod865_tr2_aqua,aod865_ss_aqua,aod865_dust_aqua,aod865_dustsco_aqua) +!$OMP THREADPRIVATE(aod550_terra,aod550_tr2_terra,aod550_ss_terra,aod550_dust_terra,aod550_dustsco_terra) +!$OMP THREADPRIVATE(aod670_terra,aod670_tr2_terra,aod670_ss_terra,aod670_dust_terra,aod670_dustsco_terra) +!$OMP THREADPRIVATE(aod865_terra,aod865_tr2_terra,aod865_ss_terra,aod865_dust_terra,aod865_dustsco_terra) + + + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc01 ! surface concentration + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm01 ! burden + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc02 ! surface concentration + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm02 ! burden + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc03 ! surface concentration + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm03 ! burden + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc04 ! surface concentration + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm04 ! burden + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sconc05 ! surface concentration + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: trm05 ! burden +!$OMP THREADPRIVATE(sconc01,sconc02,sconc03,sconc04,sconc05) +!$OMP THREADPRIVATE(trm01,trm02,trm03,trm04,trm05) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux01 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux02 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux03 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux04 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux05 +!$OMP THREADPRIVATE(flux01,flux02,flux03,flux04,flux05) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds01 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds02 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds03 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds04 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: ds05 +!$OMP THREADPRIVATE(ds01,ds02,ds03,ds04,ds05) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh01 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh02 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh03 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh04 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dh05 +!$OMP THREADPRIVATE(dh01,dh02,dh03,dh04,dh05) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv01 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv02 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv03 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv04 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtrconv05 +!$OMP THREADPRIVATE(dtrconv01,dtrconv02,dtrconv03,dtrconv04,dtrconv05) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm01 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm02 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm03 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm04 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dtherm05 +!$OMP THREADPRIVATE(dtherm01,dtherm02,dtherm03,dtherm04,dtherm05) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv01 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv02 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv03 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv04 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkecv05 +!$OMP THREADPRIVATE(dhkecv01,dhkecv02,dhkecv03,dhkecv04,dhkecv05) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds01 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds02 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds03 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds04 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: d_tr_ds05 +!$OMP THREADPRIVATE(d_tr_ds01,d_tr_ds02,d_tr_ds03,d_tr_ds04,d_tr_ds05) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc01 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc02 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc03 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc04 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: dhkelsc05 +!$OMP THREADPRIVATE(dhkelsc01,dhkelsc02,dhkelsc03,dhkelsc04,dhkelsc05) + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cv01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cv02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cv03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cv04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cv05 +!$OMP THREADPRIVATE(d_tr_cv01,d_tr_cv02,d_tr_cv03,d_tr_cv04,d_tr_cv05) + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_trsp01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_trsp02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_trsp03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_trsp04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_trsp05 +!$OMP THREADPRIVATE(d_tr_trsp01,d_tr_trsp02,d_tr_trsp03,d_tr_trsp04,d_tr_trsp05) + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sscav01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sscav02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sscav03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sscav04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sscav05 +!$OMP THREADPRIVATE(d_tr_sscav01,d_tr_sscav02,d_tr_sscav03,d_tr_sscav04,d_tr_sscav05) + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sat01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sat02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sat03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sat04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_sat05 +!$OMP THREADPRIVATE(d_tr_sat01,d_tr_sat02,d_tr_sat03,d_tr_sat04,d_tr_sat05) + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_uscav01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_uscav02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_uscav03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_uscav04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_uscav05 +!$OMP THREADPRIVATE(d_tr_uscav01,d_tr_uscav02,d_tr_uscav03,d_tr_uscav04,d_tr_uscav05) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_insc01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_insc02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_insc03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_insc04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_insc05 +!$OMP THREADPRIVATE(d_tr_insc01,d_tr_insc02,d_tr_insc03,d_tr_insc04,d_tr_insc05) + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_bcscav01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_bcscav02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_bcscav03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_bcscav04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_bcscav05 +!$OMP THREADPRIVATE(d_tr_bcscav01,d_tr_bcscav02,d_tr_bcscav03,d_tr_bcscav04,d_tr_bcscav05) + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_evapls01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_evapls02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_evapls03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_evapls04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_evapls05 +!$OMP THREADPRIVATE(d_tr_evapls01,d_tr_evapls02,d_tr_evapls03,d_tr_evapls04,d_tr_evapls05) + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_ls01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_ls02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_ls03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_ls04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_ls05 +!$OMP THREADPRIVATE(d_tr_ls01,d_tr_ls02,d_tr_ls03,d_tr_ls04,d_tr_ls05) + + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_dyn01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_dyn02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_dyn03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_dyn04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_dyn05 +!$OMP THREADPRIVATE(d_tr_dyn01,d_tr_dyn02,d_tr_dyn03,d_tr_dyn04,d_tr_dyn05) + + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cl01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cl02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cl03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cl04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_cl05 +!$OMP THREADPRIVATE(d_tr_cl01,d_tr_cl02,d_tr_cl03,d_tr_cl04,d_tr_cl05) + + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_th01 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_th02 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_th03 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_th04 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: d_tr_th05 +!$OMP THREADPRIVATE(d_tr_th01,d_tr_th02,d_tr_th03,d_tr_th04,d_tr_th05) + + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: sed_ss3D ! corresponds to tracer 3 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: sed_dust3D ! corresponds to tracer 4 + REAL, DIMENSION(:,:), ALLOCATABLE, SAVE :: sed_dustsco3D ! corresponds to tracer 4 +!$OMP THREADPRIVATE(sed_ss3D,sed_dust3D,sed_dustsco3D) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_ss ! corresponds to tracer 3 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_dust ! corresponds to tracer 4 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: sed_dustsco ! corresponds to tracer 4 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: his_g2pgas ! corresponds to tracer 4 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: his_g2paer ! corresponds to tracer 4 +!$OMP THREADPRIVATE(sed_ss,sed_dust,sed_dustsco,his_g2pgas,his_g2paer) + + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbb + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxff + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcbb + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcff + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcnff +!$OMP THREADPRIVATE(fluxbb,fluxff,fluxbcbb,fluxbcff,fluxbcnff) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbcba + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxbc + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxombb + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomff + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomnff +!$OMP THREADPRIVATE(fluxbcba,fluxbc,fluxombb,fluxomff,fluxomnff) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomba + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxomnat + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxom + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2sff + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2snff +!$OMP THREADPRIVATE(fluxomba,fluxomnat,fluxom,fluxh2sff,fluxh2snff) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2ff + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2nff + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2bb + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2vol + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2ba +!$OMP THREADPRIVATE(fluxso2ff,fluxso2nff,fluxso2bb,fluxso2vol,fluxso2ba) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso2 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4ff + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4nff + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4bb + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4ba +!$OMP THREADPRIVATE(fluxso2,fluxso4ff,fluxso4nff,fluxso4ba,fluxso4bb) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxso4 + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdms + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxh2sbio + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdustec + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddfine +!$OMP THREADPRIVATE(fluxso4,fluxdms,fluxh2sbio,fluxdustec,fluxddfine) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddcoa + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxddsco + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxdd + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxssfine + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxsscoa +!$OMP THREADPRIVATE(fluxddcoa,fluxddsco,fluxdd,fluxssfine,fluxsscoa) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: fluxss + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ind + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_bb + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ff +!$OMP THREADPRIVATE(fluxss,flux_sparam_ind,flux_sparam_bb,flux_sparam_ff) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddfine + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddcoa + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ddsco + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_ssfine +!$OMP THREADPRIVATE(flux_sparam_ddfine,flux_sparam_ddcoa) +!$OMP THREADPRIVATE(flux_sparam_ddsco,flux_sparam_ssfine) + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: flux_sparam_sscoa + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: u10m_ss + REAL, DIMENSION(:), ALLOCATABLE, SAVE :: v10m_ss +!$OMP THREADPRIVATE(flux_sparam_sscoa,u10m_ss,v10m_ss) + +! Select dust emission scheme ver the Sahara: +! LOGICAL,PARAMETER,SAVE :: ok_chimeredust=.FALSE. + LOGICAL,PARAMETER :: ok_chimeredust=.TRUE. +!!!!!! !$OMP THREADPRIVATE(ok_chimeredust) + +!OH REAL,SAVE :: scale_param_ssacc !Scaling parameter for Fine Sea Salt +!OH REAL,SAVE :: scale_param_sscoa !Scaling parameter for Coarse Sea Salt +!OH REAL,ALLOCATABLE,SAVE :: scale_param_ind(nbreg_ind) !Scaling parameter for industrial emissionsi of SO2 +!OH REAL,ALLOCATABLE,SAVE :: scale_param_bb(nbreg_bb) !Scaling parameter for biomas burning (SO2, BC & OM) +!OH REAL,ALLOCATABLE,SAVE :: scale_param_ff(nbreg_ind) !Scaling parameter for industrial emissions (fossil fuel) +!OH REAL,ALLOCATABLE,SAVE :: scale_param_dustacc(nbreg_dust) !Scaling parameter for Fine Dust +!OH REAL,ALLOCATABLE,SAVE :: scale_param_dustcoa(nbreg_dust) !Scaling parameter for Coarse Dust +!OH REAL,ALLOCATABLE,SAVE :: scale_param_dustsco(nbreg_dust) !Scaling parameter for SCoarse Dust +!OH REAL,ALLOCATABLE,SAVE :: param_wstarBLperregion(nbreg_wstardust) +!OH REAL,ALLOCATABLE,SAVE :: param_wstarWAKEperregion(nbreg_wstardust) +!!!! !$OMP THREADPRIVATE( scale_param_ssacc, scale_param_sscoa, scale_param_ind, scale_param_bb, scale_param_ff, scale_param_dustacc, scale_param_dustcoa, scale_param_dustsco, param_wstarBLperregion, param_wstarWAKEperregion) + + +CONTAINS +! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +SUBROUTINE phytracr_spl_ini(klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + IMPLICIT NONE + INTEGER klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust + + ALLOCATE( tsol(klon) ) + fileregionsdimsind='regions_ind_meta' + fileregionsdimsdust='regions_dustacc_meta' +! fileregionsdimsdust='regions_dust_meta' + fileregionsdimsbb='regions_bb_meta' + fileregionsdimswstar='regions_pwstarwake_meta' + call readregionsdims2_spl(nbreg_ind,fileregionsdimsind) + call readregionsdims2_spl(nbreg_dust,fileregionsdimsdust) + call readregionsdims2_spl(nbreg_bb,fileregionsdimsbb) + call readregionsdims2_spl(nbreg_wstardust,fileregionsdimswstar) + +!readregions_spl() + + ALLOCATE(scale_param_ind(nbreg_ind)) + ALLOCATE(scale_param_bb(nbreg_bb)) + ALLOCATE(scale_param_ff(nbreg_ind)) + ALLOCATE(scale_param_dustacc(nbreg_dust)) + ALLOCATE(scale_param_dustcoa(nbreg_dust)) + ALLOCATE(scale_param_dustsco(nbreg_dust)) + ALLOCATE(param_wstarBLperregion(nbreg_wstardust)) + ALLOCATE(param_wstarWAKEperregion(nbreg_wstardust)) + ALLOCATE( dust_ec(klon) ) + ALLOCATE( u10m_ec(klon) ) + ALLOCATE( v10m_ec(klon) ) + ALLOCATE( lmt_so2volc_cont(klon) ) + ALLOCATE( lmt_altvolc_cont(klon) ) + ALLOCATE( lmt_so2volc_expl(klon) ) + ALLOCATE( lmt_altvolc_expl(klon) ) + ALLOCATE( lmt_so2ff_l(klon) ) + ALLOCATE( lmt_so2ff_h(klon) ) + ALLOCATE( lmt_so2nff(klon) ) + ALLOCATE( lmt_so2ba(klon) ) + ALLOCATE( lmt_so2bb_l(klon) ) + ALLOCATE( lmt_so2bb_h(klon) ) + ALLOCATE( lmt_dmsconc(klon) ) + ALLOCATE( lmt_dmsbio(klon) ) + ALLOCATE( lmt_h2sbio(klon) ) + ALLOCATE( lmt_bcff(klon) ) + ALLOCATE( lmt_bcnff(klon) ) + ALLOCATE( lmt_bcbb_l(klon) ) + ALLOCATE( lmt_bcbb_h(klon) ) + ALLOCATE( lmt_bcba(klon) ) + ALLOCATE( lmt_omff(klon) ) + ALLOCATE( lmt_omnff(klon) ) + ALLOCATE( lmt_ombb_l(klon) ) + ALLOCATE( lmt_ombb_h(klon) ) + ALLOCATE( lmt_omnat(klon) ) + ALLOCATE( lmt_omba(klon) ) + ALLOCATE(lmt_sea_salt(klon,ss_bins)) + + + + + !temporal hardcoded null inicialization of assimilation emmision factors + scale_param_ssacc=1. + scale_param_sscoa=1. + scale_param_ind(:)=1. + scale_param_bb(:)=1. + scale_param_ff(:)=1. + scale_param_dustacc(:)=1. + scale_param_dustcoa(:)=1. + scale_param_dustsco(:)=1. + param_wstarBLperregion(:)=0. + param_wstarWAKEperregion(:)=0. + + + +RETURN +END SUBROUTINE phytracr_spl_ini + + + + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SUBROUTINE phytracr_spl ( debutphy,lafin,jD_cur,jH_cur,iflag_conv, & ! I + pdtphys,ftsol, & ! I + t_seri,q_seri,paprs,pplay,RHcl, & ! I + pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & ! I + coefh, cdragh, cdragm, yu1, yv1, & ! I + u_seri, v_seri, rlat,rlon, & ! I + pphis,pctsrf,pmflxr,pmflxs,prfl,psfl, & ! I + da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij, & ! I + epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con, & ! I + evapls,wdtrainA, wdtrainM,wght_cvfd, & ! I + fm_therm, entr_therm, rneb, & ! I + beta_fisrt,beta_v1, & ! I + zu10m,zv10m,wstar,ale_bl,ale_wake, & ! I + d_tr_dyn,tr_seri) ! O +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + USE IOIPSL + USE dimphy + USE infotrac + USE indice_sol_mod + USE write_field_phy + + + USE mod_phys_lmdz_transfert_para + + USE phys_cal_mod, only: jD_1jan,year_len, mth_len, days_elapsed, jh_1jan, year_cur, & + mth_cur, phys_cal_update + +! + IMPLICIT none +! + +!====================================================================== +! Auteur(s) FH +! Objet: Moniteur general des tendances traceurs +! +! Remarques en vrac: +! ------------------ +! 1/ le call phytrac se fait avec nqmax-2 donc nous avons bien +! les vrais traceurs (nbtr) dans phytrac (pas la vapeur ni eau liquide) +!====================================================================== +#include "dimensions.h" +#include "chem.h" +#include "chem_spla.h" +#include "YOMCST.h" +#include "YOETHF.h" +#include "paramet.h" +#include "thermcell.h" + +!====================================================================== + +! Arguments: +! +! EN ENTREE: +! ========== +! +! divers: +! ------- +! + real,intent(in) :: pdtphys ! pas d'integration pour la physique (seconde) + REAL, intent(in):: jD_cur, jH_cur + real, intent(in) :: ftsol(klon,nbsrf) ! temperature du sol par type + real, intent(in) :: t_seri(klon,klev) ! temperature + real, intent(in) :: u_seri(klon,klev) ! vent + real , intent(in) :: v_seri(klon,klev) ! vent + real , intent(in) :: q_seri(klon,klev) ! vapeur d eau kg/kg + +LOGICAL, INTENT(IN) :: lafin + + real tr_seri(klon,klev,nbtr) ! traceur + real tmp_var(klon,klev) ! auxiliary variable to replace traceur + real tmp_var2(klon,nbtr) ! auxiliary variable to replace source + real tmp_var3(klon,klev,nbtr) ! auxiliary variable 3D + real dummy1d ! JE auxiliary variable + real aux_var2(klon) ! auxiliary variable to replace traceur + real aux_var3(klon,klev) ! auxiliary variable to replace traceur + real d_tr(klon,klev,nbtr) ! traceur tendance + real sconc_seri(klon,nbtr) ! surface concentration of traceur +! + integer nbjour + save nbjour +!$OMP THREADPRIVATE(nbjour) +! + INTEGER masque_aqua_cur(klon) + INTEGER masque_terra_cur(klon) + INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_aqua !mask for 1 day + INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: masque_terra ! +!$OMP THREADPRIVATE(masque_aqua,masque_terra) +!!$OMP THREADPRIVATE(aod550_aqua,aod550_terra,aod670_aqua,aod670_terra) +!!$OMP THREADPRIVATE(aod865_aqua,aod865_terra) + + INTEGER, SAVE :: nbreg_dust, nbreg_ind, nbreg_bb, nbreg_ss,nbreg_wstardust + !$OMP THREADPRIVATE(nbreg_dust, nbreg_ind, nbreg_bb,nbreg_ss,nbreg_wstardust) + + + + REAL lmt_dms(klon) ! emissions de dms + +!JE20150518<< + REAL, DIMENSION(klon_glo) :: aod550_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod550_tr2_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod550_ss_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod550_dust_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod550_dustsco_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod670_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod670_tr2_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod670_ss_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod670_dust_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod670_dustsco_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod865_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod865_tr2_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod865_ss_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod865_dust_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + REAL, DIMENSION(klon_glo) :: aod865_dustsco_terra_glo ! AOD at terra overpass time ( 10.30 local hour) + + REAL, DIMENSION(klon_glo) :: aod550_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod550_tr2_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod550_ss_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod550_dust_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod550_dustsco_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod670_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod670_tr2_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod670_ss_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod670_dust_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod670_dustsco_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod865_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod865_tr2_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod865_ss_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod865_dust_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) + REAL, DIMENSION(klon_glo) :: aod865_dustsco_aqua_glo ! AOD at aqua overpass time ( 13.30 local hour) +!!!!!!!!!!!!! +!JE20150518>> + + + + + real , intent(in) :: paprs(klon,klev+1) ! pression pour chaque inter-couche (en Pa) + real , intent(in) :: pplay(klon,klev) ! pression pour le mileu de chaque couche (en Pa) + real , intent(in) :: RHcl(klon,klev) ! humidite relativen ciel clair + real znivsig(klev) ! indice des couches + real paire(klon) + real, intent(in) :: pphis(klon) + real, intent(in) :: pctsrf(klon,nbsrf) + logical , intent(in) :: debutphy ! le flag de l'initialisation de la physique +! +! Scaling Parameters: +! ---------------------- +! + CHARACTER*50 c_Directory + CHARACTER*80 c_FileName1 + CHARACTER*80 c_FileName2 + CHARACTER*130 c_FullName1 + CHARACTER*130 c_FullName2 + INTEGER :: xidx, yidx + INTEGER,DIMENSION(klon) :: mask_bbreg + INTEGER,DIMENSION(klon) :: mask_ffso2reg + INTEGER :: aux_mask1 + INTEGER :: aux_mask2 + INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_so4 !Defines regions for SO4 + INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_ind !Defines regions for SO2, BC & OM + INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_bb !Defines regions for SO2, BC & OM + INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_dust !Defines dust regions + INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: iregion_wstardust !Defines dust regions +!$OMP THREADPRIVATE(iregion_so4,iregion_ind,iregion_bb,iregion_dust,iregion_wstardust) + +! Emissions: + +! +!---------------------------- SEA SALT & DUST emissions ------------------------ + REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um + REAL u10m_ec1(klon),v10m_ec1(klon) + REAL u10m_ec2(klon),v10m_ec2(klon),dust_ec2(klon) + REAL dust_ec(klon) +! new dust emission chimere je20140522 + REAL,DIMENSION(klon),INTENT(IN) :: zu10m + REAL,DIMENSION(klon),INTENT(IN) :: zv10m + REAL,DIMENSION(klon),INTENT(IN) :: wstar,ale_bl,ale_wake + + +! +! Rem : nbtr : nombre de vrais traceurs est defini dans dimphy.h + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !Dynamique + !-------- + REAL,DIMENSION(klon,klev,nbtr),INTENT(IN) :: d_tr_dyn + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! convection: +! ----------- +! + REAL , intent(in) :: pmfu(klon,klev) ! flux de masse dans le panache montant + REAL , intent(in) :: pmfd(klon,klev) ! flux de masse dans le panache descendant + REAL, intent(in) :: pen_u(klon,klev) ! flux entraine dans le panache montant + REAL, intent(in) :: pde_u(klon,klev) ! flux detraine dans le panache montant + REAL, intent(in) :: pen_d(klon,klev) ! flux entraine dans le panache descendant + REAL, intent(in) :: pde_d(klon,klev) ! flux detraine dans le panache descendant +! +! Convection KE scheme: +! --------------------- +! +!! Variables pour le lessivage convectif + REAL,DIMENSION(klon,klev),INTENT(IN) :: da + REAL,DIMENSION(klon,klev,klev),INTENT(IN):: phi + REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: phi2 + REAL,DIMENSION(klon,klev),INTENT(IN) :: d1a,dam + REAL,DIMENSION(klon,klev),INTENT(IN) :: mp + REAL,DIMENSION(klon,klev),INTENT(IN) :: upwd ! saturated +! updraft mass flux + REAL,DIMENSION(klon,klev),INTENT(IN) :: dnwd ! saturated +! downdraft mass flux + INTEGER,DIMENSION(klon),INTENT(IN) :: itop_con + INTEGER,DIMENSION(klon),INTENT(IN) :: ibas_con + REAL,DIMENSION(klon,klev) :: evapls + REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainA + REAL,DIMENSION(klon,klev),INTENT(IN) :: wdtrainM + + + REAL,DIMENSION(klon,klev),INTENT(IN) :: ep + REAL,DIMENSION(klon),INTENT(IN) :: sigd + REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: sij + REAL,DIMENSION(klon,klev),INTENT(IN) :: clw + REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: elij + REAL,DIMENSION(klon,klev,klev),INTENT(IN) :: epmlmMm + REAL,DIMENSION(klon,klev),INTENT(IN) :: eplaMm + REAL,DIMENSION(klon,klev),INTENT(IN) :: wght_cvfd !RL + + +! KE: Tendances de traceurs (Td) et flux de traceurs: +! ------------------------ + REAL,DIMENSION(klon,klev) :: Mint + REAL,DIMENSION(klon,klev,nbtr) :: zmfd1a + REAL,DIMENSION(klon,klev,nbtr) :: zmfdam + REAL,DIMENSION(klon,klev,nbtr) :: zmfphi2 + +! !tra dans pluie LS a la surf. +! outputs for cvltr_spl + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cv_o + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_trsp_o + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sscav_o + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_sat_o + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_uscav_o + !!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!! + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_insc_o + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_bcscav_o + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_evapls_o + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_ls_o + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_dyn_o + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_cl_o + REAL,DIMENSION(:,:,:),ALLOCATABLE,SAVE :: d_tr_th_o + !!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!! + +!$OMP THREADPRIVATE(d_tr_cv_o,d_tr_trsp_o,d_tr_sscav_o,d_tr_sat_o,d_tr_uscav_o) +!$OMP THREADPRIVATE(d_tr_insc_o,d_tr_bcscav_o,d_tr_evapls_o,d_tr_ls_o) +!$OMP THREADPRIVATE(d_tr_dyn_o,d_tr_cl_o,d_tr_th_o) + + + INTEGER :: nsplit +! + + + +! +! Lessivage +! --------- +! + REAL, intent(in) :: pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection + REAL, intent(in) :: prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale +! JE REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection ! Titane +! JE REAL prfl(klon,klev), psfl(klon,klev) !--large-scale ! Titane + REAL :: ql_incl ! contenu en eau liquide nuageuse dans le nuage ! ql_incl=oliq/rneb + REAL :: ql_incloud_ref ! ref value of in-cloud condensed water content + + REAL,DIMENSION(klon,klev),INTENT(IN) :: rneb ! fraction nuageuse (grande echelle) +! + + REAL,DIMENSION(klon,klev) :: beta_fisrt ! taux de conversion +! ! de l'eau cond (de fisrtilp) + REAL,DIMENSION(klon,klev) :: beta_v1 ! -- (originale version) + INTEGER,SAVE :: iflag_lscav_omp,iflag_lscav +!$OMP THREADPRIVATE(iflag_lscav_omp,iflag_lscav) + + + + +!Thermiques: +!---------- + REAL,DIMENSION(klon,klev+1),INTENT(IN) :: fm_therm + REAL,DIMENSION(klon,klev),INTENT(IN) :: entr_therm + + +! +! Couche limite: +! -------------- +! + REAL , intent(in) :: coefh(klon,klev) ! coeff melange CL + REAL , intent(in) :: cdragh(klon), cdragm(klon) + REAL, intent(in) :: yu1(klon) ! vent dans la 1iere couche + REAL, intent(in) :: yv1(klon) ! vent dans la 1iere couche +! +! +!---------------------------------------------------------------------- + REAL his_ds(klon,nbtr) + REAL his_dh(klon,nbtr) + REAL his_dhlsc(klon,nbtr) ! in-cloud scavenging lsc + REAL his_dhcon(klon,nbtr) ! in-cloud scavenging con + REAL his_dhbclsc(klon,nbtr) ! below-cloud scavenging lsc + REAL his_dhbccon(klon,nbtr) ! below-cloud scavenging con + REAL trm(klon,nbtr) +! + REAL u10m_ec(klon), v10m_ec(klon) +! + REAL his_th(klon,nbtr) + REAL his_dhkecv(klon,nbtr) + REAL his_dhkelsc(klon,nbtr) + + +! +! Coordonnees +! ----------- +! + REAL, intent(in) :: rlat(klon) ! latitudes pour chaque point + REAL, intent(in) :: rlon(klon) ! longitudes pour chaque point +! + INTEGER i, k, it, j, ig +! +! DEFINITION OF DIAGNOSTIC VARIABLES +! + REAL diag_trm(nbtr), diag_drydep(nbtr) + REAL diag_wetdep(nbtr), diag_cvtdep(nbtr) + REAL diag_emissn(nbtr), diag_g2part + REAL diag_sedimt + REAL trm_aux(nbtr), src_aux(nbtr) +! +! Variables locales pour effectuer les appels en serie +!---------------------------------------------------- + REAL source_tr(klon,nbtr) + REAL flux_tr(klon,nbtr) + REAL m_conc(klon,klev) +! REAL sed_ss(klon) ! corresponds to tracer 3 +! REAL sed_dust(klon) ! corresponds to tracer 4 +! REAL sed_dustsco(klon) ! corresponds to tracer 4 + REAL henry(nbtr) !--cste de Henry mol/l/atm + REAL kk(nbtr) !--coefficient de var avec T (K) + REAL alpha_r(nbtr)!--coefficient d'impaction pour la pluie + REAL alpha_s(nbtr)!--coefficient d'impaction pour la neige + REAL vdep_oce(nbtr), vdep_sic(nbtr) + REAL vdep_ter(nbtr), vdep_lic(nbtr) + REAL ccntrAA_spla(nbtr) + REAL ccntrENV_spla(nbtr) + REAL coefcoli_spla(nbtr) + REAL dtrconv(klon,nbtr) + REAL zrho(klon,klev), zdz(klon,klev) + REAL zalt(klon,klev) + REAL,DIMENSION(klon,klev) :: zmasse ! densité atmosphérique +! . Kg/m2 + REAL,DIMENSION(klon,klev) :: ztra_th + REAL qmin, qmax, aux +! PARAMETER (qmin=0.0, qmax=1.e33) + PARAMETER (qmin=1.e33, qmax=-1.e33) + +! Variables to save data into file +!---------------------------------- + + CHARACTER*2 str2 + LOGICAL ok_histrac +!JE2014124 PARAMETER (ok_histrac=.true.) + PARAMETER (ok_histrac=.false.) +! PARAMETER (ok_chimeredust=.false.) +! PARAMETER (ok_chimeredust=.true.) + INTEGER ndex2d(iim*(jjm+1)), ndex3d(iim*(jjm+1)*klev) + INTEGER nhori1, nhori2, nhori3, nhori4, nhori5, nvert + INTEGER nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5 + SAVE nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5 +!$OMP THREADPRIVATE(nid_tra1, nid_tra2, nid_tra3, nid_tra4, nid_tra5) + INTEGER itra + SAVE itra ! compteur pour la physique +!$OMP THREADPRIVATE(itra) + INTEGER ecrit_tra, ecrit_tra_h, ecrit_tra_m + SAVE ecrit_tra, ecrit_tra_h, ecrit_tra_m +!$OMP THREADPRIVATE(ecrit_tra, ecrit_tra_h, ecrit_tra_m) + REAL presnivs(klev) ! pressions approximat. des milieux couches ( en PA) + REAL zx_tmp_2d(iim,jjm+1), zx_tmp_3d(iim,jjm+1,klev) + REAL zx_tmp_fi2d(klon), zx_tmp_fi3d(klon, klev) +! REAL zx_lon(iim,jjm+1), zx_lat(iim,jjm+1) + REAL zx_lon_glo(nbp_lon,nbp_lat), zx_lat_glo(nbp_lon,nbp_lat) + REAL zsto, zout, zout_h, zout_m, zjulian + +!------Molar Masses + REAL masse(nbtr) +! + REAL fracso2emis !--fraction so2 emis en so2 + PARAMETER (fracso2emis=0.95) + REAL frach2sofso2 !--fraction h2s from so2 + PARAMETER (frach2sofso2=0.0426) +! +! Controles +!------------- + LOGICAL convection,lessivage,lminmax,lcheckmass + DATA convection,lessivage,lminmax,lcheckmass & + /.true.,.true.,.true.,.false./ +! + REAL xconv(nbtr) +! + LOGICAL anthropo, bateau, edgar + DATA anthropo,bateau,edgar/.true.,.true.,.true./ +! +!c bc_source + INTEGER kminbc, kmaxbc +!JE20150715 PARAMETER (kminbc=3, kmaxbc=5) + PARAMETER (kminbc=4, kmaxbc=7) +! + REAL tr1_cont, tr2_cont, tr3_cont, tr4_cont +! +! JE for updating in cltrac + REAL,DIMENSION(klon,klev) :: delp ! epaisseur de couche (Pa) +!JE20140507 REAL,DIMENSION(klon,nbtr) :: d_tr_dry ! Td depot sec/traceur (1st layer),ALLOCATABLE,SAVE jyg +!JE20140507 REAL,DIMENSION(klon,nbtr) :: flux_tr_dry +! SAVE d_tr_dry +!! JE for include gas to particle conversion in output +! REAL his_g2pgas(klon) ! gastoparticle in gas units (check!) +! REAL his_g2paer(klon) ! gastoparticle in aerosol units (check!) +! + INTEGER ,intent(in) :: iflag_conv + LOGICAL iscm3 ! debug variable. for checkmass ! JE + +!------------------------------------------------------------------------ +! only to compute time consumption of each process +!---- + INTEGER clock_start,clock_end,clock_rate,clock_start_spla + INTEGER clock_end_outphytracr,clock_start_outphytracr + INTEGER ti_init,dife,ti_inittype,ti_inittwrite + INTEGER ti_spla,ti_emis,ti_depo,ti_cltr,ti_ther + INTEGER ti_sedi,ti_gasp,ti_wetap,ti_cvltr,ti_lscs,ti_brop,ti_outs + INTEGER ti_nophytracr,clock_per_max + REAL tia_init,tia_inittype,tia_inittwrite + REAL tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther + REAL tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs + REAL tia_brop,tia_outs + REAL tia_nophytracr + + SAVE tia_init,tia_inittype,tia_inittwrite + SAVE tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther + SAVE tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs + SAVE tia_brop,tia_outs + SAVE ti_nophytracr + SAVE tia_nophytracr + SAVE clock_end_outphytracr,clock_start_outphytracr + SAVE clock_per_max + LOGICAL logitime +!$OMP THREADPRIVATE(tia_init,tia_inittype,tia_inittwrite) +!$OMP THREADPRIVATE(tia_spla,tia_emis,tia_depo,tia_cltr,tia_ther) +!$OMP THREADPRIVATE(tia_sedi,tia_gasp,tia_wetap,tia_cvltr,tia_lscs) +!$OMP THREADPRIVATE(tia_brop,tia_outs) +!$OMP THREADPRIVATE(ti_nophytracr) +!$OMP THREADPRIVATE(tia_nophytracr) +!$OMP THREADPRIVATE(clock_end_outphytracr,clock_start_outphytracr) +!$OMP THREADPRIVATE(clock_per_max) + +! utils parallelization + REAL :: auxklon_glo(klon_glo) + INTEGER :: iauxklon_glo(klon_glo) + REAL, DIMENSION(klon_glo,nbp_lev) :: auxklonnbp_lev + REAL, DIMENSION(klon_glo,nbp_lev,nbtr) :: auxklonklevnbtr_glo + REAL,DIMENSION(nbp_lon,nbp_lat) :: zx_tmp_2d_glo + REAL,DIMENSION(nbp_lon,nbp_lat,nbp_lev) :: zx_tmp_3d_glo + REAL,DIMENSION(klon_glo) :: zx_tmp_fi2d_glo + REAL,DIMENSION(klon_glo , nbp_lev) :: zx_tmp_fi3d_glo + REAL,DIMENSION(klon_glo,nbtr) :: auxklonnbtr_glo + + + + source_tr=0. + + + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRA'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + + + if (debutphy) then + CALL iophys_ini + nbreg_ind=1 + nbreg_bb=1 + nbreg_dust=1 + nbreg_wstardust=1 + CALL phytracr_spl_ini(klon,nbreg_ind,nbreg_bb,nbreg_dust,nbreg_wstardust) + endif + + + + + + ijulday=jD_cur-jD_1jan+1 + nbjour = 1 + + paramname_ind='ind' + paramname_bb='bb' + paramname_ff='ind' + paramname_dustacc='dustacc' + paramname_dustcoa='dustcoasco' + paramname_dustsco='dustcoasco' +! paramname_dustacc='dust' +! paramname_dustcoa='dust' +! paramname_dustsco='dust' + paramname_wstarBL='pwstarbl' + paramname_wstarWAKE='pwstarwake' + paramname_ssacc='ssacc' + paramname_sscoa='sscoa' + + filescaleparams='modvalues.nc' + CALL readscaleparamsnc_spl(scale_param_ind, & + nbreg_ind, paramname_ind, & + scale_param_ff, nbreg_ind,paramname_ff, & + scale_param_bb, nbreg_bb,paramname_bb, & + scale_param_dustacc, nbreg_dust,paramname_dustacc, & + scale_param_dustcoa, nbreg_dust,paramname_dustcoa, & + scale_param_dustsco, nbreg_dust,paramname_dustsco, & + param_wstarBLperregion, nbreg_wstardust, paramname_wstarBL, & + param_wstarWAKEperregion, nbreg_wstardust, paramname_wstarWAKE, & + scale_param_ssacc , paramname_ssacc, & + scale_param_sscoa , paramname_sscoa, & + filescaleparams,ijulday,jH_cur, pdtphys,debutphy) +! add seasalt + + print *,'JE : check scale_params' + + print *, 'nbreg_ind', nbreg_ind + print *, 'nbreg_dust', nbreg_dust + print *, 'nbreg_bb', nbreg_bb + print *, 'ind', scale_param_ind + print *, 'dustacc', scale_param_dustacc + print *, 'dustcoa', scale_param_dustcoa + print *, 'dustsco', scale_param_dustsco + print *, 'wstardustBL', param_wstarBLperregion + print *, 'wstardustWAKE', param_wstarWAKEperregion + print *, 'ff', scale_param_ff + print *, 'bb', scale_param_bb + print *, 'ssacc', scale_param_ssacc + print *, 'sscoa', scale_param_sscoa + + print *,'JE: before read_newemissions ' + print *,'JE: jD_cur:',jD_cur,' ijulday:',ijulday,' jH_cur:',jH_cur,' pdtphys:',pdtphys + print *,'JE: now read_newemissions:' + print *,'lmt_so2ff_l AVANT' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l) + call read_newemissions(ijulday,jH_cur ,edgar, flag_dms,debutphy, & !I + pdtphys, lafin, nbjour, pctsrf, & !I + t_seri, rlat, rlon, & !I + pmflxr, pmflxs, prfl, psfl, & !I + u10m_ec, v10m_ec, dust_ec, & !O + lmt_sea_salt, lmt_so2ff_l, & !O + lmt_so2ff_h, lmt_so2nff, & !O + lmt_so2ba, lmt_so2bb_l, lmt_so2bb_h, & !O + lmt_so2volc_cont, lmt_altvolc_cont, & !O + lmt_so2volc_expl, lmt_altvolc_expl, & !O + lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, & !O + lmt_bcff, lmt_bcnff, lmt_bcbb_l, & !O + lmt_bcbb_h, lmt_bcba, lmt_omff, & !O + lmt_omnff, lmt_ombb_l, lmt_ombb_h, & !O + lmt_omnat, lmt_omba) !O + + + print *,'Check emissions' + print *,'lmt_so2ff_l' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l) + print *,'lmt_so2ff_h' , MINVAL(lmt_so2ff_h), MAXVAL(lmt_so2ff_h) + print *,'lmt_so2nff' , MINVAL(lmt_so2nff), MAXVAL(lmt_so2nff) + print *,'lmt_so2ba' , MINVAL(lmt_so2ba), MAXVAL(lmt_so2ba) + print *,'lmt_so2bb_l' , MINVAL(lmt_so2bb_l), MAXVAL(lmt_so2bb_l) + print *,'lmt_so2bb_h' , MINVAL(lmt_so2bb_h), MAXVAL(lmt_so2bb_h) + print *,'lmt_so2volc_cont' , MINVAL(lmt_so2volc_cont), MAXVAL(lmt_so2volc_cont) + print *,'lmt_altvolc_cont' , MINVAL(lmt_altvolc_cont), MAXVAL(lmt_altvolc_cont) + print *,'lmt_so2volc_expl' , MINVAL(lmt_so2volc_expl), MAXVAL(lmt_so2volc_expl) + print *,'lmt_altvolc_expl' , MINVAL(lmt_altvolc_expl), MAXVAL(lmt_altvolc_expl) + print *,'lmt_dmsbio' , MINVAL(lmt_dmsbio), MAXVAL(lmt_dmsbio) + print *,'lmt_h2sbio' , MINVAL(lmt_h2sbio), MAXVAL(lmt_h2sbio) + print *,'lmt_dmsconc' , MINVAL(lmt_dmsconc), MAXVAL(lmt_dmsconc) + print *,'lmt_bcff' , MINVAL(lmt_bcff), MAXVAL(lmt_bcff) + print *,'lmt_bcnff' , MINVAL(lmt_bcnff), MAXVAL(lmt_bcnff) + print *,'lmt_bcbb_l' , MINVAL(lmt_bcbb_l), MAXVAL(lmt_bcbb_l) + print *,'lmt_bcbb_h' , MINVAL(lmt_bcbb_h), MAXVAL(lmt_bcbb_h) + print *,'lmt_bcba' , MINVAL(lmt_bcba), MAXVAL(lmt_bcba) + print *,'lmt_omff' , MINVAL(lmt_omff), MAXVAL(lmt_omff) + print *,'lmt_omnff' , MINVAL(lmt_omnff), MAXVAL(lmt_omnff) + print *,'lmt_ombb_l' , MINVAL(lmt_ombb_l), MAXVAL(lmt_ombb_l) + print *,'lmt_ombb_h' , MINVAL(lmt_ombb_h), MAXVAL(lmt_ombb_h) + print *,'lmt_omnat' , MINVAL(lmt_omnat), MAXVAL(lmt_omnat) + print *,'lmt_omba' , MINVAL(lmt_omba), MAXVAL(lmt_omba) + print *,'JE iflag_con',iflag_conv + + +!JE_dbg + do i=1,klon + tsol(i)=0.0 + do j=1,nbsrf + tsol(i)=tsol(i)+ftsol(i,j)*pctsrf(i,j) + enddo + enddo + + +!====================================================================== +! INITIALISATIONS +!====================================================================== +! CALL checknanqfi(da(:,:),1.,-1.,' da_ before +! . phytracr_inphytracr') + +! +! computing time +! logitime=.true. + logitime=.false. + IF (logitime) THEN + clock_start=0 + clock_end=0 + clock_rate=0 + CALL SYSTEM_CLOCK(COUNT_RATE=clock_rate,COUNT_MAX=clock_per_max) + CALL SYSTEM_CLOCK(COUNT=clock_start_spla) + clock_start=clock_start_spla + clock_end_outphytracr=clock_start_spla + ENDIF + + +! Definition of tracers index. + print*,'OK ON PASSSE BIEN LA' + CALL minmaxsource(source_tr,qmin,qmax,'A1 maxsource init phytracr') + + + IF (debutphy) THEN + id_prec=-1 + id_fine=-1 + id_coss=-1 + id_codu=-1 + id_scdu=-1 + !print *,nbtr + do it=1,nbtr + print *, it, tname(it+2) + if (tname(it+2) == 'PREC' ) then + id_prec=it + endif + if (tname(it+2) == 'FINE' ) then + id_fine=it + endif + if (tname(it+2) == 'COSS' ) then + id_coss=it + endif + if (tname(it+2) == 'CODU' ) then + id_codu=it + endif + if (tname(it+2) == 'SCDU' ) then + id_scdu=it + endif + enddo + ! check consistency with dust emission scheme: + if (ok_chimeredust) then + if (.not.( id_scdu>0 .and. id_codu>0 .and. id_fine>0)) then + call abort_gcm('phytracr_mod', 'pb in ok_chimdust 0',1) + endif + else + if (id_scdu>0) then + call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1 SCDU',1) + endif + if ( (id_codu .le. 0) .or. ( id_fine.le.0) ) then + call abort_gcm('phytracr_mod', 'pb in ok_chimdust 1',1) + endif + endif + + + !print *,id_prec,id_fine,id_coss,id_codu,id_scdu + ENDIF + + + + + + +!---fraction of tracer that is convected (Tiedke) + xconv(:)=0. + if(id_prec>0) xconv(id_prec)=0.8 + if(id_fine>0) xconv(id_fine)=0.5 + if(id_coss>0) xconv(id_coss)=0.5 + if(id_codu>0) xconv(id_codu)=0.6 + if(id_scdu>0) xconv(id_scdu)=0.6 !!JE fix + + masse(:)=1. + if(id_prec>0) masse(id_prec)=32. + if(id_fine>0) masse(id_fine)=6.02e23 + if(id_coss>0) masse(id_coss)=6.02e23 + if(id_codu>0) masse(id_codu)=6.02e23 + if(id_scdu>0) masse(id_scdu)=6.02e23 + + henry(:)=0. + if(id_prec>0) henry(id_prec)=1.4 + if(id_fine>0) henry(id_fine)=0.0 + if(id_coss>0) henry(id_coss)=0.0 + if(id_codu>0) henry(id_codu)=0.0 + if(id_scdu>0) henry(id_scdu)=0.0 + !henry= (/1.4, 0.0, 0.0, 0.0/) + kk(:)=0. + if(id_prec>0) kk(id_prec)=2900. + if(id_fine>0) kk(id_fine)=0.0 + if(id_coss>0) kk(id_coss)=0.0 + if(id_codu>0) kk(id_codu)=0.0 + if(id_scdu>0) kk(id_scdu)=0.0 + !kk = (/2900., 0., 0., 0./) + alpha_r(:)=0. + if(id_prec>0) alpha_r(id_prec)=0.0 + if(id_fine>0) alpha_r(id_fine)=0.001 + if(id_coss>0) alpha_r(id_coss)=0.001 + if(id_codu>0) alpha_r(id_codu)=0.001 + if(id_scdu>0) alpha_r(id_scdu)=0.001 !JE fix + alpha_s(:)=0. + if(id_prec>0) alpha_s(id_prec)=0.0 + if(id_fine>0) alpha_s(id_fine)=0.01 + if(id_coss>0) alpha_s(id_coss)=0.01 + if(id_codu>0) alpha_s(id_codu)=0.01 + if(id_scdu>0) alpha_s(id_scdu)=0.01 !JE fix + +! alpha_r = (/0., 0.001, 0.001, 0.001/) +! alpha_s = (/0., 0.01, 0.01, 0.01/) + +! nhl DATA vdep_oce /0.7, 0.05, 1.2, 1.2/ +! nhl vdep_oce for tr1 is a weighted average of dms and so2 dep velocities + !vdep_oce = (/0.28, 0.28, 1.2, 1.2/) + vdep_oce(:)=0. + if(id_prec>0) vdep_oce(id_prec) = 0.28 + if(id_fine>0) vdep_oce(id_fine) = 0.28 + if(id_coss>0) vdep_oce(id_coss) = 1.2 + if(id_codu>0) vdep_oce(id_codu) = 1.2 + if(id_scdu>0) vdep_oce(id_scdu) = 1.2 + vdep_sic(:)=0. + if(id_prec>0) vdep_sic(id_prec) = 0.2 + if(id_fine>0) vdep_sic(id_fine) = 0.17 + if(id_coss>0) vdep_sic(id_coss) = 1.2 + if(id_codu>0) vdep_sic(id_codu) = 1.2 + if(id_scdu>0) vdep_sic(id_scdu) = 1.2 + + !vdep_sic = (/0.2, 0.17, 1.2, 1.2/) + !vdep_ter = (/0.3, 0.14, 1.2, 1.2/) + vdep_ter(:)=0. + if(id_prec>0) vdep_ter(id_prec) = 0.3 + if(id_fine>0) vdep_ter(id_fine) = 0.14 + if(id_coss>0) vdep_ter(id_coss) = 1.2 + if(id_codu>0) vdep_ter(id_codu) = 1.2 + if(id_scdu>0) vdep_ter(id_scdu) = 1.2 + + vdep_lic(:)=0. + if(id_prec>0) vdep_lic(id_prec) = 0.2 + if(id_fine>0) vdep_lic(id_fine) = 0.17 + if(id_coss>0) vdep_lic(id_coss) = 1.2 + if(id_codu>0) vdep_lic(id_codu) = 1.2 + if(id_scdu>0) vdep_lic(id_scdu) = 1.2 + + + ! convective KE lessivage aer params: + ccntrAA_spla(:)=0. + if(id_prec>0) ccntrAA_spla(id_prec)=-9999. + if(id_fine>0) ccntrAA_spla(id_fine)=0.7 + if(id_coss>0) ccntrAA_spla(id_coss)=1.0 + if(id_codu>0) ccntrAA_spla(id_codu)=0.7 + if(id_scdu>0) ccntrAA_spla(id_scdu)=0.7 + + ccntrENV_spla(:)=0. + if(id_prec>0) ccntrENV_spla(id_prec)=-9999. + if(id_fine>0) ccntrENV_spla(id_fine)=0.7 + if(id_coss>0) ccntrENV_spla(id_coss)=1.0 + if(id_codu>0) ccntrENV_spla(id_codu)=0.7 + if(id_scdu>0) ccntrENV_spla(id_scdu)=0.7 + + coefcoli_spla(:)=0. + if(id_prec>0) coefcoli_spla(id_prec)=-9999. + if(id_fine>0) coefcoli_spla(id_fine)=0.001 + if(id_coss>0) coefcoli_spla(id_coss)=0.001 + if(id_codu>0) coefcoli_spla(id_codu)=0.001 + if(id_scdu>0) coefcoli_spla(id_scdu)=0.001 + + !vdep_lic = (/0.2, 0.17, 1.2, 1.2/) +! + + iscm3=.false. + if (debutphy) then +!$OMP MASTER + CALL suphel + print *, 'let s check nbtr=', nbtr +! JE before put in zero + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan init phytracr') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'minmax init phytracr') + ENDDO + CALL minmaxsource(source_tr,qmin,qmax,'maxsource init phytracr') + ENDIF +! JE initializon to cero the tracers +! DO it=1, nbtr +! tr_seri(:,:,it)=0.0 +! ENDDO +! JE end +! Initializing to zero tr_seri for comparison purposes +! tr_seri(:,:,:)=0.0 +! +! DO it=1,nbtr +! trm_aux(it)=0.0 +! src_aux(it)=0.0 +! diag_trm(it)=0.0 +! diag_drydep(it)=0.0 +! diag_wetdep(it)=0.0 +! diag_cvtdep(it)=0.0 +! diag_emissn(it)=0.0 +! ENDDO +! diag_g2part=0.0 + print *,'PREPARE FILES TO SAVE VARIABLES' +! + nbjour=30 + ecrit_tra = NINT(86400./pdtphys) !--1-day average + ecrit_tra_h = NINT(86400./pdtphys*0.25) !--6-hour average + ecrit_tra_m = NINT(86400./pdtphys*FLOAT(nbjour)) !--1-mth average + print *,'ecrit_tra=', pdtphys, ecrit_tra + + IF (ok_histrac) THEN + IF (is_mpi_root .AND. is_omp_root) THEN + + itra=0 +! + CALL ymds2ju(1900, 1, 1, 0.0, zjulian) +! +! print *, 'klon,iim,jjm+1 = ',klon,iim,jjm+1 + print *, 'glo klon,iim,jjm+1 = ',klon_glo,nbp_lon,nbp_lat + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,rlon,zx_lon_glo) +! +! DO i = 1, iim + DO i = 1, nbp_lon + zx_lon_glo(i,1) = rlon(i+1) + zx_lon_glo(i,nbp_lat) = rlon(i+1) + ENDDO +! + CALL histbeg("histrac_spl", nbp_lon,zx_lon_glo, & + nbp_lat,zx_lat_glo, & + 1,nbp_lon,1,nbp_lat, 0, zjulian, pdtphys, & + nhori1, nid_tra1) +! + CALL histbeg("lessivage_spl", nbp_lon,zx_lon_glo, & + nbp_lat,zx_lat_glo, & + 1,nbp_lon,1,nbp_lat, 0, zjulian, pdtphys, & + nhori2, nid_tra2) +! + CALL histbeg("traceur_spl", nbp_lon,zx_lon_glo, & + nbp_lat,zx_lat_glo, & + 1,nbp_lon,1,nbp_lat, 0, zjulian, pdtphys, & + nhori3, nid_tra3) +! + CALL histvert(nid_tra1, "presnivs", "Vertical levels", "mb", & + nbp_lev, presnivs, nvert) +! + CALL histvert(nid_tra2, "presnivs", "Vertical levels", "mb", & + nbp_lev, presnivs, nvert) +! + CALL histvert(nid_tra3, "presnivs", "Vertical levels", "mb", & + nbp_lev, presnivs, nvert) +! + zsto = pdtphys + zout = pdtphys * FLOAT(ecrit_tra) + zout_h = pdtphys * FLOAT(ecrit_tra_h) + zout_m = pdtphys * FLOAT(ecrit_tra_m) + print *,'zsto zout=', zsto, zout + +! +!----------------- HISTORY FILES OF TRACER EMISSIONS ------------------- +! +! HISTRAC +! + CALL histdef(nid_tra1, "fluxbb", "Flux BB", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxff", "Flux FF", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxbcbb", "Flux BC-BB", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxbcff", "Flux BC-FF", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxbcnff", "Flux BC-NFF", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxbcba", "Flux BC-BA", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxbc", "Flux BC", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxombb", "Flux OM-BB", "mg/m2/s" , & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxomff", "Flux OM-FF", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxomnff", "Flux OM-NFF", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxomba", "Flux OM-BA", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxomnat", "Flux OM-NT", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxom", "Flux OM", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxh2sff","Flux H2S FF","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxh2snff","Flux H2S non-FF", & + "mgS/m2/s",nbp_lon,nbp_lat,nhori1, 1,1,1, & + -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxso2ff","Flux SO2 FF","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxso2nff","Flux SO2 non-FF", & + "mgS/m2/s",nbp_lon,nbp_lat,nhori1, 1,1,1, & + -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxso2bb", "Flux SO2 BB","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxso2vol","Flux SO2 Vol","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxso2ba", "Flux SO2 Ba","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxso2", "Flux SO2","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxso4ff","Flux SO4 FF","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxso4nff","Flux SO4 non-FF", & + "mgS/m2/s", nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxso4bb", "Flux SO4 BB","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxso4ba", "Flux SO4 Ba","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxso4", "Flux SO4","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxdms", "Flux DMS", "mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxh2sbio","Flux H2S Bio","mgS/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1, "fluxdustec", & + "Flux Dust EC", "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxddfine","DD Fine Mode","mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxddcoa","DD Coarse Mode","mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxddsco","DD SCoarse Mode","mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxdd","Flux DD","mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxssfine","SS Fine Mode","mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxsscoa","SS Coarse Mode","mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"fluxss","Flux SS","mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! +!nhl CALL histdef(nid_tra1,"fluxso4chem","SO4 chem prod", +!nhl . "gAer/kgAir", +!nhl . nbp_lon,nbp_lat,nhori1, nbp_lev,1,nbp_lev,nvert, 32, +!nhl . "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"flux_sparam_ind","Ind emiss", & + "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"flux_sparam_bb","BB emiss", & + "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"flux_sparam_ff","FF emiss", & + "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"flux_sparam_ddfine","DD fine emiss", & + "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"flux_sparam_ddcoa","DD coarse emiss", & + "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"flux_sparam_ddsco","DD Scoarse emiss", & + "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"flux_sparam_ssfine","SS fine emiss", & + "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"flux_sparam_sscoa","SS coarse emiss", & + "mg/m2/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"u10m","Zonal wind at 10 m", & + "m/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra1,"v10m","Meridional wind at 10 m", & + "m/s", & + nbp_lon,nbp_lat,nhori1, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! +!nhl CALL histdef(nid_tra1,"flux_sparam_sulf","SO4 chem prod", +!nhl . "gAer/kgAir", +!nhl . nbp_lon,nbp_lat,nhori1, nbp_lev,1,nbp_lev,nvert, 32, +!nhl . "ave(X)", zsto,zout) +! +! TRACEUR +! + CALL histdef(nid_tra3, "taue550", "Tau ext 550", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue670", "Tau ext 670", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue865", "Tau ext 865", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue550_tr2", "Tau ext 550tr2", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue670_tr2", "Tau ext 670tr2", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue865_tr2", "Tau ext 865tr2", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue550_ss", "Tau ext 550ss", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue670_ss", "Tau ext 670ss", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue865_ss", "Tau ext 865ss", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue550_dust", "Tau ext 550dust", " " & + ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue670_dust", "Tau ext 670dust", " " & + ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue865_dust", "Tau ext 865dust", " " & + ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) + + CALL histdef(nid_tra3, "taue550_dustsco", & + "Tau ext 550dustsco", " " & + ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue670_dustsco", & + "Tau ext 670dustsco", " " & + ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "taue865_dustsco", & + "Tau ext 865dustsco", " " & + ,nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) + + + CALL histdef(nid_tra3, "taue550_aqua", "Tau ext 550 aqua", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "inst(X)", zout,zout) + CALL histdef(nid_tra3, "taue550_terra", "Tau ext 550 terra", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "inst(X)", zout,zout) + CALL histdef(nid_tra3, "taue670_aqua", "Tau ext 670 aqua", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "inst(X)", zout,zout) + CALL histdef(nid_tra3, "taue670_terra", "Tau ext 670 terra", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "inst(X)", zout,zout) + CALL histdef(nid_tra3, "taue865_aqua", "Tau ext 865 aqua", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "inst(X)", zout,zout) + CALL histdef(nid_tra3, "taue865_terra", "Tau ext 865 terra", " ", & + nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "inst(X)", zout,zout) + + + DO it=1, nbtr +! + WRITE(str2,'(i2.2)') it +! + CALL histdef(nid_tra3, "trm"//str2, "Burden No."//str2, & + "mgS/m2", nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra3, "sconc"//str2, "Surf Conc. No."//str2, & + "mg/m3", nbp_lon,nbp_lat,nhori3, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! +! LESSIVAGE +! + CALL histdef(nid_tra2, "flux"//str2, "emission"//str2, & + "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra2, "ds"//str2, "Depot sec No."//str2, & + "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra2,"dh"//str2, & + "Depot hum No."//str2, & + "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra2,"dtrconv"//str2, & + "Tiedke convective"//str2, & + "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) + + CALL histdef(nid_tra2,"dtherm"//str2, & + "Thermals dtracer"//str2, & + "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) + + CALL histdef(nid_tra2,"dhkecv"//str2, & + "KE dep hum convective"//str2, & + "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) + CALL histdef(nid_tra2,"dhkelsc"//str2, & + "KE dep hum large scale"//str2, & + "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) + + + CALL histdef(nid_tra2,"d_tr_ds"//str2, & + " Tendance dep sec"//str2, & + "mgS/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, 32, & + "ave(X)", zsto,zout) + + + CALL histdef(nid_tra2,"d_tr_cv"//str2, & + "cvltr d_tr_cv"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) + CALL histdef(nid_tra2,"d_tr_trsp"//str2 & + ,"cvltr d_tr_trsp"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) + CALL histdef(nid_tra2,"d_tr_sscav"//str2 & + ,"cvltr d_tr_sscav"//str2,"mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) + CALL histdef(nid_tra2,"d_tr_sat"//str2 & + ,"cvltr d_tr_sat"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) + CALL histdef(nid_tra2,"d_tr_uscav"//str2, & + "cvltr d_tr_uscav"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) + CALL histdef(nid_tra2,"d_tr_insc"//str2, & !!! + "cvltr d_tr_insc"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) + CALL histdef(nid_tra2,"d_tr_bcscav"//str2, & + "cvltr d_tr_bcscav"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) + CALL histdef(nid_tra2,"d_tr_evapls"//str2, & + "cvltr d_tr_evapls"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) + CALL histdef(nid_tra2,"d_tr_ls"//str2, & + "cvltr d_tr_ls"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) !! + CALL histdef(nid_tra2,"d_tr_dyn"//str2, & + "large-scale d_tr_dyn"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) !! + CALL histdef(nid_tra2,"d_tr_cl"//str2, & + "cvltr d_tr_cl"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) !! + CALL histdef(nid_tra2,"d_tr_th"//str2, & + "cvltr d_tr_th"//str2, & + "mgS/m2/s", & + nbp_lon,nbp_lat,nhori2, nbp_lev,1,nbp_lev,nvert, 32, & + "ave(X)", zsto,zout) !! + + + +! + ENDDO +! + CALL histdef(nid_tra2, "sed_ss", "Sedmet. Tr3", & + "mg/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, -99, & + 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra2, "sed_dust", "Sedmet. Tr4", & + "mg/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, & + -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra2, "sed_dustsco", "Sedmet. Tr5", & + "mg/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1, & + -99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra2, "g2p_gas", "Gas2particle gas sink", & + "mg-S/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1,-99, 32, & + "ave(X)", zsto,zout) +! + CALL histdef(nid_tra2, "g2p_aer", "Gas2particle tr2 src", & + "mg/m2/s", nbp_lon,nbp_lat,nhori2, 1,1,1,-99,32, & + "ave(X)", zsto,zout) +! +!------------------------------------------------------------------- +! + CALL histend(nid_tra1) +! + CALL histend(nid_tra2) +! + CALL histend(nid_tra3) +! +!------------------------------------------------------------------- + +! nbjour=1 + ENDIF ! mpi root + ENDIF !--ok_histrac + +! +! IF (.NOT.edgar.AND.bateau) THEN +! PRINT *,'ATTENTION risque de compter double les bateaux' +! STOP +! ENDIF +! +! +! +!$OMP END MASTER +!$OMP BARRIER + endif ! debutphy +! +!====================================================================== +! Initialisations +!====================================================================== +! +! +! je KE init + IF (debutphy) THEN +!$OMP MASTER + + ALLOCATE(d_tr_cl(klon,klev,nbtr),d_tr_dry(klon,nbtr)) + ALLOCATE(flux_tr_dry(klon,nbtr),d_tr_dec(klon,klev,nbtr)) + ALLOCATE(d_tr_cv(klon,klev,nbtr)) + ALLOCATE(d_tr_insc(klon,klev,nbtr),d_tr_bcscav(klon,klev,nbtr)) + ALLOCATE(d_tr_evapls(klon,klev,nbtr),d_tr_ls(klon,klev,nbtr)) + ALLOCATE(qPrls(klon,nbtr),d_tr_trsp(klon,klev,nbtr)) + ALLOCATE(d_tr_sscav(klon,klev,nbtr),d_tr_sat(klon,klev,nbtr)) + ALLOCATE(d_tr_uscav(klon,klev,nbtr),qPr(klon,klev,nbtr)) + ALLOCATE(qDi(klon,klev,nbtr)) + ALLOCATE(qPa(klon,klev,nbtr),qMel(klon,klev,nbtr)) + ALLOCATE(qTrdi(klon,klev,nbtr),dtrcvMA(klon,klev,nbtr)) + ALLOCATE(d_tr_th(klon,klev,nbtr)) + ALLOCATE(d_tr_lessi_impa(klon,klev,nbtr)) + ALLOCATE(d_tr_lessi_nucl(klon,klev,nbtr)) + + ALLOCATE( diff_aod550_tot(klon) ) + ALLOCATE( diag_aod670_tot(klon) ) + ALLOCATE( diag_aod865_tot(klon) ) + ALLOCATE( diff_aod550_tr2(klon) ) + ALLOCATE( diag_aod670_tr2(klon) ) + ALLOCATE( diag_aod865_tr2(klon) ) + ALLOCATE( diag_aod550_ss(klon) ) + ALLOCATE( diag_aod670_ss(klon) ) + ALLOCATE( diag_aod865_ss(klon) ) + ALLOCATE( diag_aod550_dust(klon) ) + ALLOCATE( diag_aod670_dust(klon) ) + ALLOCATE( diag_aod865_dust(klon) ) + ALLOCATE( diag_aod550_dustsco(klon) ) + ALLOCATE( diag_aod670_dustsco(klon) ) + ALLOCATE( diag_aod865_dustsco(klon) ) + + + ALLOCATE( sconc01(klon) ) + ALLOCATE( trm01(klon) ) + ALLOCATE( sconc02(klon) ) + ALLOCATE( trm02(klon) ) + ALLOCATE( sconc03(klon) ) + ALLOCATE( trm03(klon) ) + ALLOCATE( sconc04(klon) ) + ALLOCATE( trm04(klon) ) + ALLOCATE( sconc05(klon) ) + ALLOCATE( trm05(klon) ) + + + ALLOCATE( flux01(klon) ) + ALLOCATE( flux02(klon) ) + ALLOCATE( flux03(klon) ) + ALLOCATE( flux04(klon) ) + ALLOCATE( flux05(klon) ) + ALLOCATE( ds01(klon) ) + ALLOCATE( ds02(klon) ) + ALLOCATE( ds03(klon) ) + ALLOCATE( ds04(klon) ) + ALLOCATE( ds05(klon) ) + ALLOCATE( dh01(klon) ) + ALLOCATE( dh02(klon) ) + ALLOCATE( dh03(klon) ) + ALLOCATE( dh04(klon) ) + ALLOCATE( dh05(klon) ) + ALLOCATE( dtrconv01(klon) ) + ALLOCATE( dtrconv02(klon) ) + ALLOCATE( dtrconv03(klon) ) + ALLOCATE( dtrconv04(klon) ) + ALLOCATE( dtrconv05(klon) ) + ALLOCATE( dtherm01(klon) ) + ALLOCATE( dtherm02(klon) ) + ALLOCATE( dtherm03(klon) ) + ALLOCATE( dtherm04(klon) ) + ALLOCATE( dtherm05(klon) ) + ALLOCATE( dhkecv01(klon) ) + ALLOCATE( dhkecv02(klon) ) + ALLOCATE( dhkecv03(klon) ) + ALLOCATE( dhkecv04(klon) ) + ALLOCATE( dhkecv05(klon) ) + ALLOCATE( d_tr_ds01(klon) ) + ALLOCATE( d_tr_ds02(klon) ) + ALLOCATE( d_tr_ds03(klon) ) + ALLOCATE( d_tr_ds04(klon) ) + ALLOCATE( d_tr_ds05(klon) ) + ALLOCATE( dhkelsc01(klon) ) + ALLOCATE( dhkelsc02(klon) ) + ALLOCATE( dhkelsc03(klon) ) + ALLOCATE( dhkelsc04(klon) ) + ALLOCATE( dhkelsc05(klon) ) + ALLOCATE( d_tr_cv01(klon,klev)) + ALLOCATE( d_tr_cv02(klon,klev)) + ALLOCATE( d_tr_cv03(klon,klev)) + ALLOCATE( d_tr_cv04(klon,klev)) + ALLOCATE( d_tr_cv05(klon,klev)) + ALLOCATE( d_tr_trsp01(klon,klev)) + ALLOCATE( d_tr_trsp02(klon,klev)) + ALLOCATE( d_tr_trsp03(klon,klev)) + ALLOCATE( d_tr_trsp04(klon,klev)) + ALLOCATE( d_tr_trsp05(klon,klev)) + ALLOCATE( d_tr_sscav01(klon,klev)) + ALLOCATE( d_tr_sscav02(klon,klev)) + ALLOCATE( d_tr_sscav03(klon,klev)) + ALLOCATE( d_tr_sscav04(klon,klev)) + ALLOCATE( d_tr_sscav05(klon,klev)) + ALLOCATE( d_tr_sat01(klon,klev)) + ALLOCATE( d_tr_sat02(klon,klev)) + ALLOCATE( d_tr_sat03(klon,klev)) + ALLOCATE( d_tr_sat04(klon,klev)) + ALLOCATE( d_tr_sat05(klon,klev)) + ALLOCATE( d_tr_uscav01(klon,klev)) + ALLOCATE( d_tr_uscav02(klon,klev)) + ALLOCATE( d_tr_uscav03(klon,klev)) + ALLOCATE( d_tr_uscav04(klon,klev)) + ALLOCATE( d_tr_uscav05(klon,klev)) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ALLOCATE( d_tr_insc01(klon,klev)) + ALLOCATE( d_tr_insc02(klon,klev)) + ALLOCATE( d_tr_insc03(klon,klev)) + ALLOCATE( d_tr_insc04(klon,klev)) + ALLOCATE( d_tr_insc05(klon,klev)) + ALLOCATE( d_tr_bcscav01(klon,klev)) + ALLOCATE( d_tr_bcscav02(klon,klev)) + ALLOCATE( d_tr_bcscav03(klon,klev)) + ALLOCATE( d_tr_bcscav04(klon,klev)) + ALLOCATE( d_tr_bcscav05(klon,klev)) + ALLOCATE( d_tr_evapls01(klon,klev)) + ALLOCATE( d_tr_evapls02(klon,klev)) + ALLOCATE( d_tr_evapls03(klon,klev)) + ALLOCATE( d_tr_evapls04(klon,klev)) + ALLOCATE( d_tr_evapls05(klon,klev)) + ALLOCATE( d_tr_ls01(klon,klev)) + ALLOCATE( d_tr_ls02(klon,klev)) + ALLOCATE( d_tr_ls03(klon,klev)) + ALLOCATE( d_tr_ls04(klon,klev)) + ALLOCATE( d_tr_ls05(klon,klev)) + ALLOCATE( d_tr_dyn01(klon,klev)) + ALLOCATE( d_tr_dyn02(klon,klev)) + ALLOCATE( d_tr_dyn03(klon,klev)) + ALLOCATE( d_tr_dyn04(klon,klev)) + ALLOCATE( d_tr_dyn05(klon,klev)) + ALLOCATE( d_tr_cl01(klon,klev)) + ALLOCATE( d_tr_cl02(klon,klev)) + ALLOCATE( d_tr_cl03(klon,klev)) + ALLOCATE( d_tr_cl04(klon,klev)) + ALLOCATE( d_tr_cl05(klon,klev)) + ALLOCATE( d_tr_th01(klon,klev)) + ALLOCATE( d_tr_th02(klon,klev)) + ALLOCATE( d_tr_th03(klon,klev)) + ALLOCATE( d_tr_th04(klon,klev)) + ALLOCATE( d_tr_th05(klon,klev)) + + ALLOCATE( sed_ss3D(klon,klev)) + ALLOCATE( sed_dust3D(klon,klev)) + ALLOCATE( sed_dustsco3D(klon,klev)) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + ALLOCATE( sed_ss(klon)) + ALLOCATE( sed_dust(klon)) + ALLOCATE( sed_dustsco(klon)) + ALLOCATE( his_g2pgas(klon)) + ALLOCATE( his_g2paer(klon)) + + ALLOCATE( fluxbb(klon)) + ALLOCATE( fluxff(klon)) + ALLOCATE( fluxbcbb(klon)) + ALLOCATE( fluxbcff(klon)) + ALLOCATE( fluxbcnff(klon)) + ALLOCATE( fluxbcba(klon)) + ALLOCATE( fluxbc(klon)) + ALLOCATE( fluxombb(klon)) + ALLOCATE( fluxomff(klon)) + ALLOCATE( fluxomnff(klon)) + ALLOCATE( fluxomba(klon)) + ALLOCATE( fluxomnat(klon)) + ALLOCATE( fluxom(klon)) + ALLOCATE( fluxh2sff(klon)) + ALLOCATE( fluxh2snff(klon)) + ALLOCATE( fluxso2ff(klon)) + ALLOCATE( fluxso2nff(klon)) + ALLOCATE( fluxso2bb(klon)) + ALLOCATE( fluxso2vol(klon)) + ALLOCATE( fluxso2ba(klon)) + ALLOCATE( fluxso2(klon)) + ALLOCATE( fluxso4ff(klon)) + ALLOCATE( fluxso4nff(klon)) + ALLOCATE( fluxso4bb(klon)) + ALLOCATE( fluxso4ba(klon)) + ALLOCATE( fluxso4(klon)) + ALLOCATE( fluxdms(klon)) + ALLOCATE( fluxh2sbio(klon)) + ALLOCATE( fluxdustec(klon)) + ALLOCATE( fluxddfine(klon)) + ALLOCATE( fluxddcoa(klon)) + ALLOCATE( fluxddsco(klon)) + ALLOCATE( fluxdd(klon)) + ALLOCATE( fluxssfine(klon)) + ALLOCATE( fluxsscoa(klon)) + ALLOCATE( fluxss(klon)) + ALLOCATE( flux_sparam_ind(klon)) + ALLOCATE( flux_sparam_bb(klon)) + ALLOCATE( flux_sparam_ff(klon)) + ALLOCATE( flux_sparam_ddfine(klon)) + ALLOCATE( flux_sparam_ddcoa(klon)) + ALLOCATE( flux_sparam_ddsco(klon)) + ALLOCATE( flux_sparam_ssfine(klon)) + ALLOCATE( flux_sparam_sscoa(klon)) + ALLOCATE( u10m_ss(klon)) + ALLOCATE( v10m_ss(klon)) + + + ALLOCATE(d_tr_cv_o(klon,klev,nbtr)) + ALLOCATE(d_tr_trsp_o(klon,klev,nbtr)) + ALLOCATE(d_tr_sscav_o(klon,klev,nbtr), & + d_tr_sat_o(klon,klev,nbtr)) + ALLOCATE(d_tr_uscav_o(klon,klev,nbtr)) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ALLOCATE(d_tr_insc_o(klon,klev,nbtr)) + ALLOCATE(d_tr_bcscav_o(klon,klev,nbtr)) + ALLOCATE(d_tr_evapls_o(klon,klev,nbtr)) + ALLOCATE(d_tr_ls_o(klon,klev,nbtr)) + ALLOCATE(d_tr_dyn_o(klon,klev,nbtr)) + ALLOCATE(d_tr_cl_o(klon,klev,nbtr)) + ALLOCATE(d_tr_th_o(klon,klev,nbtr)) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + ALLOCATE(iregion_so4(klon)) + ALLOCATE(iregion_bb(klon)) + ALLOCATE(iregion_ind(klon)) + ALLOCATE(iregion_dust(klon)) + ALLOCATE(iregion_wstardust(klon)) + +!JE20150518<< + ALLOCATE(masque_aqua(klon)) + ALLOCATE(masque_terra(klon)) +! ALLOCATE(aod550_aqua(klon)) +! ALLOCATE(aod550_terra(klon)) +! ALLOCATE(aod670_aqua(klon)) +! ALLOCATE(aod670_terra(klon)) +! ALLOCATE(aod865_aqua(klon)) +! ALLOCATE(aod865_terra(klon)) + + ALLOCATE( aod550_terra(klon)) + ALLOCATE( aod550_tr2_terra(klon)) + ALLOCATE( aod550_ss_terra(klon)) + ALLOCATE( aod550_dust_terra(klon)) + ALLOCATE( aod550_dustsco_terra(klon)) + ALLOCATE( aod670_terra(klon)) + ALLOCATE( aod670_tr2_terra(klon)) + ALLOCATE( aod670_ss_terra(klon)) + ALLOCATE( aod670_dust_terra(klon)) + ALLOCATE( aod670_dustsco_terra(klon)) + ALLOCATE( aod865_terra(klon)) + ALLOCATE( aod865_tr2_terra(klon)) + ALLOCATE( aod865_ss_terra(klon)) + ALLOCATE( aod865_dust_terra(klon)) + ALLOCATE( aod865_dustsco_terra(klon)) + + ALLOCATE( aod550_aqua(klon)) + ALLOCATE( aod550_tr2_aqua(klon)) + ALLOCATE( aod550_ss_aqua(klon)) + ALLOCATE( aod550_dust_aqua(klon)) + ALLOCATE( aod550_dustsco_aqua(klon)) + ALLOCATE( aod670_aqua(klon)) + ALLOCATE( aod670_tr2_aqua(klon)) + ALLOCATE( aod670_ss_aqua(klon)) + ALLOCATE( aod670_dust_aqua(klon)) + ALLOCATE( aod670_dustsco_aqua(klon)) + ALLOCATE( aod865_aqua(klon)) + ALLOCATE( aod865_tr2_aqua(klon)) + ALLOCATE( aod865_ss_aqua(klon)) + ALLOCATE( aod865_dust_aqua(klon)) + ALLOCATE( aod865_dustsco_aqua(klon)) + + + masque_aqua(:)=0 + masque_terra(:)=0 +! aod550_aqua(:)=0. +! aod550_terra(:)=0. +! aod670_aqua(:)=0. +! aod670_terra(:)=0. +! aod865_aqua(:)=0. +! aod865_terra(:)=0. + + aod550_terra(:)=0. + aod550_tr2_terra(:)=0. + aod550_ss_terra(:)=0. + aod550_dust_terra(:)=0. + aod550_dustsco_terra(:)=0. + aod670_terra(:)=0. + aod670_tr2_terra(:)=0. + aod670_ss_terra(:)=0. + aod670_dust_terra(:)=0. + aod670_dustsco_terra(:)=0. + aod865_terra(:)=0. + aod865_tr2_terra(:)=0. + aod865_ss_terra(:)=0. + aod865_dust_terra(:)=0. + aod865_dustsco_terra(:)=0. + aod550_aqua(:)=0. + aod550_tr2_aqua(:)=0. + aod550_ss_aqua(:)=0. + aod550_dust_aqua(:)=0. + aod550_dustsco_aqua(:)=0. + aod670_aqua(:)=0. + aod670_tr2_aqua(:)=0. + aod670_ss_aqua(:)=0. + aod670_dust_aqua(:)=0. + aod670_dustsco_aqua(:)=0. + aod865_aqua(:)=0. + aod865_tr2_aqua(:)=0. + aod865_ss_aqua(:)=0. + aod865_dust_aqua(:)=0. + aod865_dustsco_aqua(:)=0. +!JE20150518>> + + + + + +! +!Config Key = iflag_lscav +!Config Desc = Large scale scavenging parametrization: 0=none, +!1=old(Genthon92), +! 2=1+PHeinrich, 3=Reddy_Boucher2004, 4=3+RPilon. +!Config Def = 4 +!Config + iflag_lscav_omp=4 + call getin('iflag_lscav', iflag_lscav_omp) + iflag_lscav=iflag_lscav_omp +! initialiation for time computation + + tia_spla=0. + tia_emis=0. + tia_depo=0. + tia_cltr=0. + tia_ther=0. + tia_sedi=0. + tia_gasp=0. + tia_wetap=0. + tia_cvltr=0. + tia_lscs=0. + tia_brop=0. + tia_outs=0. + tia_nophytracr=0. + clock_start_outphytracr=clock_end_outphytracr+1 +!$OMP END MASTER +!$OMP BARRIER + ENDIF ! debutphy + + lmt_dms(:)=0.0 + aux_var2(:)=0.0 + aux_var3(:,:)=0.0 + source_tr(:,:)=0.0 + flux_tr(:,:)=0.0 + flux_sparam_bb(:)=0.0 + flux_sparam_ff(:)=0.0 + flux_sparam_ind(:)=0.0 + flux_sparam_ddfine(:)=0.0 + flux_sparam_ddcoa(:)=0.0 + flux_sparam_ddsco(:)=0.0 + flux_sparam_ssfine(:)=0.0 + flux_sparam_sscoa(:)=0.0 + +! initialiation for time computation + + ti_spla=0 + ti_emis=0 + ti_depo=0 + ti_cltr=0 + ti_ther=0 + ti_sedi=0 + ti_gasp=0 + ti_wetap=0 + ti_cvltr=0 + ti_lscs=0 + ti_brop=0 + ti_outs=0 + + + DO k=1,klev + DO i=1,klon + Mint(i,k)=0. + END DO + END DO + + +! + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + d_tr_cv(i,k,it)=0. + d_tr_trsp(i,k,it)=0. + d_tr_sscav(i,k,it)=0. + d_tr_sat(i,k,it)=0. + d_tr_uscav(i,k,it)=0. + d_tr(i,k,it)=0. + d_tr_insc(i,k,it)=0. + d_tr_bcscav(i,k,it)=0. + d_tr_evapls(i,k,it)=0. + d_tr_ls(i,k,it)=0. + d_tr_cl(i,k,it)=0. + d_tr_th(i,k,it)=0. + + d_tr_cv_o(i,k,it)=0. + d_tr_trsp_o(i,k,it)=0. + d_tr_sscav_o(i,k,it)=0. + d_tr_sat_o(i,k,it)=0. + d_tr_uscav_o(i,k,it)=0. + + + qDi(i,k,it)=0. + qPr(i,k,it)=0. + qPa(i,k,it)=0. + qMel(i,k,it)=0. + qTrdi(i,k,it)=0. + dtrcvMA(i,k,it)=0. + zmfd1a(i,k,it)=0. + zmfdam(i,k,it)=0. + zmfphi2(i,k,it)=0. + END DO + END DO + END DO + + + DO it=1, nbtr + DO i=1,klon + qPrls(i,it)=0.0 + dtrconv(i,it)=0.0 +!JE20140507<< + d_tr_dry(i,it)=0.0 + flux_tr_dry(i,it)=0.0 +!JE20140507>> + ENDDO + ENDDO + + DO it=1, nbtr + DO i=1, klon + his_dh(i,it)=0.0 + his_dhlsc(i,it)=0.0 + his_dhcon(i,it)=0.0 + his_dhbclsc(i,it)=0.0 + his_dhbccon(i,it)=0.0 + trm(i,it)=0.0 + his_th(i,it)=0.0 + his_dhkecv(i,it)=0.0 + his_ds(i,it)=0.0 + his_dhkelsc(i,it)=0.0 + + ENDDO + ENDDO +!JE: + DO i=1, klon + his_g2pgas(i) = 0.0 + his_g2paer(i) = 0.0 + ENDDO +! endJE +! + + DO k=1, klev + DO i = 1, klon + zrho(i,k)=pplay(i,k)/t_seri(i,k)/RD + zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG + zmasse(i,k)=(paprs(i,k)-paprs(i,k+1))/RG + ENDDO + ENDDO +! + DO i = 1, klon + zalt(i,1)=pphis(i)/RG + ENDDO + DO k=1, klev-1 + DO i = 1, klon + zalt(i,k+1)=zalt(i,k)+zdz(i,k) + ENDDO + ENDDO + + + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_init=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_init=tia_init+REAL(ti_init)/REAL(clock_rate) + ENDIF + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + + + IF (debutphy) then + + c_FullName1='regions_dustacc' + !c_FullName1='regions_dust' + call readregions_spl(iregion_dust,c_FullName1) + c_FullName1='regions_ind' + call readregions_spl(iregion_ind,c_FullName1) + c_FullName1='regions_bb' + call readregions_spl(iregion_bb,c_FullName1) + c_FullName1='regions_pwstarwake' + call readregions_spl(iregion_wstardust,c_FullName1) + +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + + OPEN(25,FILE='dustregions_pyvar_je.data') + OPEN(55,FILE='indregions_pyvar_je.data') + OPEN(75,FILE='bbregions_pyvar_je.data') + OPEN(95,FILE='wstardustregions_pyvar_je.data') + OPEN(76,FILE='xlat.data') + OPEN(77,FILE='xlon.data') + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + + CALL gather(iregion_dust,iauxklon_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + DO k=1,klon_glo + WRITE(25,'(i10)') iauxklon_glo(k) + ENDDO + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + CALL gather(iregion_ind,iauxklon_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + DO k=1,klon_glo + WRITE(55,'(i10)') iauxklon_glo(k) + ENDDO + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + CALL gather(iregion_bb,iauxklon_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + DO k=1,klon_glo + WRITE(75,'(i10)') iauxklon_glo(k) + ENDDO + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + CALL gather(iregion_wstardust,iauxklon_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + DO k=1,klon_glo + WRITE(95,'(i10)') iauxklon_glo(k) + ENDDO + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + + + CALL gather(rlat,auxklon_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + DO k=1,klon_glo + WRITE(76,*) auxklon_glo(k) + ENDDO + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + CALL gather(rlon,auxklon_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + DO k=1,klon_glo + WRITE(77,*) auxklon_glo(k) + ENDDO + + CLOSE(25) + CLOSE(55) + CLOSE(75) + CLOSE(76) + CLOSE(77) + + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + + ENDIF ! debutphy + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_inittype=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_inittype=tia_inittype+REAL(ti_inittype)/REAL(clock_rate) + ENDIF + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + +! +!======================================================================= +! SAVING SURFACE TYPE +!======================================================================= + IF (debutphy) THEN +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + + OPEN(35,FILE='surface_ocean.data') + OPEN(45,FILE='surface_seaice.data') + OPEN(65,FILE='surface_land.data') + OPEN(85,FILE='surface_landice.data') + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + do i = 1, klon + aux_var2(i) = pctsrf(i,is_oce) + enddo + call gather(aux_var2,auxklon_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + DO i = 1, klon_glo + WRITE (35,103) auxklon_glo(i) + ENDDO + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + + do i = 1, klon + aux_var2(i) = pctsrf(i,is_sic) + enddo + call gather(aux_var2,auxklon_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + DO i = 1, klon_glo + WRITE (45,103) auxklon_glo(i) + ENDDO + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + + do i = 1, klon + aux_var2(i) = pctsrf(i,is_ter) + enddo + call gather(aux_var2,auxklon_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + DO i = 1, klon_glo + WRITE (65,103) auxklon_glo(i) + ENDDO + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + + do i = 1, klon + aux_var2(i) = pctsrf(i,is_lic) + enddo + call gather(aux_var2,auxklon_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + DO i = 1, klon_glo + WRITE (85,103) auxklon_glo(i) + ENDDO +! +! DO i = 1, klon +! WRITE (35,103) pctsrf(i,is_oce) +! WRITE (45,103) pctsrf(i,is_sic) +! WRITE (65,103) pctsrf(i,is_ter) +! WRITE (85,103) pctsrf(i,is_lic) +! ENDDO + CLOSE(35) + CLOSE(45) + CLOSE(65) + CLOSE(85) +103 FORMAT (f6.2) + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + ENDIF ! debutphy + +! stop +! +!======================================================================= +! + DO it=1, nbtr + DO j=1,klev + DO i=1,klon + tmp_var(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=tmp_var(i,j) + ENDDO + ENDDO + ENDDO + iscm3=.true. + +!======================================================================= +! + DO k=1, klev + DO i=1, klon + m_conc(i,k)=pplay(i,k)/t_seri(i,k)/RKBOL*1.e-6 + ENDDO + ENDDO + +! +! + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_avt_coarem') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'avt coarem') + ENDDO + CALL minmaxsource(source_tr,qmin,qmax,'src: avt coarem') + ENDIF + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_inittwrite=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_inittwrite=tia_inittwrite+REAL(ti_inittwrite)/REAL(clock_rate) + ENDIF + +! +! +!======================================================================= +! EMISSIONS OF COARSE AEROSOLS +!======================================================================= + + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + + +! + print *,'Number of tracers = ',nbtr + + print *,'AT BEGINNING OF PHYTRACR_SPL' +! print *,'tr_seri = ',SUM(tr_seri(:,:,3)),MINVAL(tr_seri(:,:,3)), +! . MAXVAL(tr_seri(:,:,3)) + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('sav'//str2,1,'SOURCE','',source_tr(:,it)) + call iophys_ecrit('fav'//str2,1,'SOURCE','',source_tr(:,it)) + enddo + + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRB'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + + + CALL coarsemission(pctsrf,pdtphys,t_seri, & + pmflxr,pmflxs,prfl,psfl, & + rlat,rlon,debutphy, & + zu10m,zv10m,wstar,ale_bl,ale_wake, & + scale_param_ssacc,scale_param_sscoa, & + scale_param_dustacc,scale_param_dustcoa, & + scale_param_dustsco, & + nbreg_dust, & + iregion_dust,dust_ec, & + param_wstarBLperregion,param_wstarWAKEperregion, & + nbreg_wstardust, & + iregion_wstardust, & + lmt_sea_salt,qmin,qmax, & + flux_sparam_ddfine,flux_sparam_ddcoa, & + flux_sparam_ddsco, & + flux_sparam_ssfine,flux_sparam_sscoa, & + id_prec,id_fine,id_coss,id_codu,id_scdu, & + ok_chimeredust, & + source_tr,flux_tr) + + + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('sap'//str2,1,'SOURCE','',source_tr(:,it)) + call iophys_ecrit('fap'//str2,1,'SOURCE','',source_tr(:,it)) + enddo + + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_coarem') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after coarem') + ENDDO + CALL minmaxsource(source_tr,qmin,qmax,'src: after coarem') + ENDIF + +! +! +! +!====================================================================== +! EMISSIONS OF AEROSOL PRECURSORS +!====================================================================== +! +! + print *,'INPUT TO PRECUREMISSION' + call iophys_ecrit('ftsol',4,'ftsol','',ftsol) + call iophys_ecrit('u10m_ec',1,'u10m_ec','',u10m_ec) + call iophys_ecrit('v10m_ec',1,'v10m_ec','',v10m_ec) + call iophys_ecrit('pctsrf',4,'pctsrf','',pctsrf) + call iophys_ecrit('u_seri',klev,'u_seri','',u_seri) + call iophys_ecrit('v_seri',klev,'v_seri','',v_seri) + call iophys_ecrit('paprs',klev,'paprs','',paprs) + call iophys_ecrit('pplay',klev,'pplay','',pplay) + call iophys_ecrit('cdragh',1,'cdragh','',cdragh) + call iophys_ecrit('cdragm',1,'cdragm','',cdragm) + call iophys_ecrit('t_seri',klev,'t_seri','',t_seri) + call iophys_ecrit('q_seri',klev,'q_seri','',q_seri) + call iophys_ecrit('tsol',1,'tsol','',tsol) + print*,'fracso2emis,frach2sofso2,bateau',fracso2emis,frach2sofso2,bateau + print*,'kminbc,kmaxbc,pdtphys',kminbc,kmaxbc,pdtphys + print*,'scale_param_bb,scale_param_ind',scale_param_bb,scale_param_ind + print*,'iregion_ind,iregion_bb,nbreg_ind, nbreg_bb',iregion_ind,iregion_bb,nbreg_ind, nbreg_bb + print*,'id_prec,id_fine',id_prec,id_fine + call iophys_ecrit('zdz',klev,'zdz','',zdz) + call iophys_ecrit('zalt',klev,'zalt','',zalt) + call iophys_ecrit('lmt_so2ff_l',1,'lmt_so2ff_l','',lmt_so2ff_l) + call iophys_ecrit('lmt_so2ff_h',1,'lmt_so2ff_h','',lmt_so2ff_h) + call iophys_ecrit('lmt_so2nff',1,'lmt_so2nff','',lmt_so2nff) + call iophys_ecrit('lmt_so2ba',1,'lmt_so2ba','',lmt_so2ba) + call iophys_ecrit('lmt_so2bb_l',1,'lmt_so2bb_l','',lmt_so2bb_l) + call iophys_ecrit('lmt_so2bb_h',1,'lmt_so2bb_h','',lmt_so2bb_h) + call iophys_ecrit('lmt_so2volc_cont',1,'lmt_so2volc_cont','',lmt_so2volc_cont) + call iophys_ecrit('lmt_altvolc_cont',1,'lmt_altvolc_cont','',lmt_altvolc_cont) + call iophys_ecrit('lmt_so2volc_expl',1,'lmt_so2volc_expl','',lmt_so2volc_expl) + call iophys_ecrit('lmt_altvolc_expl',1,'lmt_altvolc_expl','',lmt_altvolc_expl) + call iophys_ecrit('lmt_dmsbio',1,'lmt_dmsbio','',lmt_dmsbio) + call iophys_ecrit('lmt_h2sbio',1,'lmt_h2sbio','',lmt_h2sbio) + call iophys_ecrit('lmt_dmsconc',1,'lmt_dmsconc','',lmt_dmsconc) + call iophys_ecrit('lmt_dms',1,'lmt_dms','',lmt_dms) + call iophys_ecrit('flux_sparam_ind',1,'flux_sparam_ind','',flux_sparam_ind) + call iophys_ecrit('flux_sparam_bb',1,'flux_sparam_bb','',flux_sparam_bb) + + + + print*,'ON PASSE DANS precuremission' + CALL precuremission(ftsol,u10m_ec,v10m_ec,pctsrf, & + u_seri,v_seri,paprs,pplay,cdragh,cdragm, & + t_seri,q_seri,tsol,fracso2emis,frach2sofso2, & + bateau,zdz,zalt,kminbc,kmaxbc,pdtphys, & + scale_param_bb,scale_param_ind, & + iregion_ind, iregion_bb, & + nbreg_ind, nbreg_bb, & + lmt_so2ff_l,lmt_so2ff_h, lmt_so2nff,lmt_so2ba, & + lmt_so2bb_l,lmt_so2bb_h, & + lmt_so2volc_cont,lmt_altvolc_cont, & + lmt_so2volc_expl,lmt_altvolc_expl, & + lmt_dmsbio,lmt_h2sbio, lmt_dmsconc, lmt_dms, & + id_prec,id_fine, & + flux_sparam_ind, flux_sparam_bb, & + source_tr,flux_tr,tr_seri) +! + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after precur') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after precur') + ENDDO + CALL minmaxsource(source_tr,qmin,qmax,'src: after precur') + ENDIF + +!======================================================================= +! EMISSIONS OF FINE AEROSOLS +!======================================================================= +! + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('tpr'//str2,1,'SOURCE','',source_tr(:,it)) + call iophys_ecrit('fpr'//str2,1,'SOURCE','',flux_tr(:,it)) + enddo + + CALL finemission(zdz,pdtphys,zalt,kminbc,kmaxbc, & + scale_param_bb,scale_param_ff, & + iregion_ind,iregion_bb, & + nbreg_ind,nbreg_bb, & + lmt_bcff, lmt_bcnff, lmt_bcbb_l,lmt_bcbb_h, & + lmt_bcba, lmt_omff, lmt_omnff, & + lmt_ombb_l, lmt_ombb_h, lmt_omnat, lmt_omba, & + id_fine, & + flux_sparam_bb, flux_sparam_ff, & + source_tr,flux_tr,tr_seri) +! +! + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_fineem') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after fineem') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'after fineem') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: after fineem') + ENDIF + +! + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_emis=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_emis=tia_emis+REAL(ti_emis)/REAL(clock_rate) + ENDIF + + + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('t'//str2,1,'SOURCE','',source_tr(:,it)) + call iophys_ecrit('f'//str2,1,'SOURCE','',flux_tr(:,it)) + enddo +! +! + + + +! +!======================================================================= +! DRY DEPOSITION AND BOUNDARY LAYER MIXING +!======================================================================= +! +! DO it=1,nbtr +! CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, +! . pplay,t_seri,iscm3,'') +! ENDDO + +!====================================================================== +! -- Dry deposition -- +!====================================================================== + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + DO it=1, nbtr + DO j=1,klev + DO i=1,klon + tmp_var(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL cm3_to_kg(pplay,t_seri,tmp_var) + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=tmp_var(i,j) + ENDDO + ENDDO + ENDDO + iscm3=.false. +!---------------------------- + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_depo') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before depo') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'before depo') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: before depo') + ENDIF + + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRC'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + + CALL deposition(vdep_oce,vdep_sic,vdep_ter,vdep_lic,pctsrf, & + zrho,zdz,pdtphys,RHcl,masse,t_seri,pplay,paprs, & + lminmax,qmin,qmax, & + his_ds,source_tr,tr_seri) +! + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_depo') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after depo') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'after depo') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: after depo') + ENDIF + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_depo=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_depo=tia_depo+REAL(ti_depo)/REAL(clock_rate) + ENDIF + + +! +!====================================================================== +! -- Boundary layer mixing -- +!====================================================================== + + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRD'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + + + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + +! + + DO k = 1, klev + DO i = 1, klon + delp(i,k) = paprs(i,k)-paprs(i,k+1) + END DO + END DO +! + DO it=1, nbtr + DO j=1, klev + DO i=1, klon + tmp_var(i,j)=tr_seri(i,j,it) + aux_var2(i)=source_tr(i,it) + ENDDO + ENDDO + IF (iflag_conv.EQ.2) THEN +! Tiedke + CALL cltrac_spl(pdtphys,coefh,yu1,yv1,t_seri,tmp_var, & + aux_var2,paprs,pplay,aux_var3) + + ELSE IF (iflag_conv.GE.3) THEN +!KE + CALL cltrac(pdtphys, coefh,t_seri,tmp_var,aux_var2,paprs,pplay, & + delp,aux_var3,d_tr_dry,flux_tr_dry(:,it)) + ENDIF + + DO i=1, klon + DO j=1, klev + tr_seri(i,j,it)=tmp_var(i,j) + d_tr(i,j,it)=aux_var3(i,j) + d_tr_cl(i,j,it)=d_tr(i,j,it) + ENDDO + ENDDO + DO k = 1, klev + DO i = 1, klon + tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr(i,k,it) + ENDDO + ENDDO + print *,' AFTER Cltrac' + IF (lminmax) THEN + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after cltrac') + ENDIF + ENDDO !--end itr loop + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_cltr=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_cltr=tia_cltr+REAL(ti_cltr)/REAL(clock_rate) + ENDIF + + + +!====================================================================== +! -- Calcul de l'effet des thermiques for KE-- +!====================================================================== + + print*,'iflag_conv=',iflag_conv + call iophys_ecrit('coefh',klev,'coefh','',coefh) + call iophys_ecrit('yu1',1,'yu1','',yu1) + call iophys_ecrit('yv1',1,'yv1','',yv1) + call iophys_ecrit('delp',klev,'delp','',delp) + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRE'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + + + + IF (iflag_conv.GE.3) THEN + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + + + + + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before therm') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before therm') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'before therm') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'before therm') + ENDIF + + DO it=1,nbtr + DO k=1,klev + DO i=1,klon + tmp_var3(i,k,it)=tr_seri(i,k,it) + d_tr_th(i,k,it)=0. + tr_seri(i,k,it)=MAX(tr_seri(i,k,it),0.) +!JE: precursor >>1e10 tr_seri(i,k,it)=MIN(tr_seri(i,k,it),1.e10) + END DO + END DO + END DO + +!JE new implicit scheme 20140323 + DO it=1,nbtr + CALL thermcell_dq(klon,klev,1,pdtphys,fm_therm,entr_therm, & + zmasse,tr_seri(1:klon,1:klev,it), & + d_tr(1:klon,1:klev,it),ztra_th,0 ) + + DO k=1,klev + DO i=1,klon + d_tr(i,k,it)=pdtphys*d_tr(i,k,it) + d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k,it) + tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k,it),0.) + END DO + END DO + + ENDDO + +! old scheme explicit +! nsplit=10 +! DO it=1,nbtr +! DO isplit=1,nsplit +! CALL dqthermcell(klon,klev,pdtphys/nsplit, +! . fm_therm,entr_therm,zmasse, +! . tr_seri(1:klon,1:klev,it), +! . d_tr(1:klon,1:klev,it),ztra_th) +! DO k=1,klev +! DO i=1,klon +! d_tr(i,k,it)=pdtphys*d_tr(i,k,it)/nsplit +! d_tr_th(i,k,it)=d_tr_th(i,k,it)+d_tr(i,k,it) +! tr_seri(i,k,it)=MAX(tr_seri(i,k,it)+d_tr(i,k,it),0.) +! END DO +! END DO +! END DO ! nsplit1 +! END DO ! it +!JE end modif 20140323 + + DO it=1,nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=tr_seri(i,k,it)-tmp_var3(i,k,it) + ENDDO + ENDDO + IF (lminmax) THEN + IF (lcheckmass) THEN + CALL checkmass(tmp_var(:,:),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'dtr therm ') + ENDIF + ENDIF + CALL kg_to_cm3(pplay,t_seri,tmp_var) + + DO k=1,klev + DO i=1,klon + his_th(i,it)=his_th(i,it)+ & + (tmp_var(i,k))/RNAVO* & + masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + END DO !klon + END DO !klev + + END DO !it + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after therm') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after therm') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'after therm') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'after therm') + ENDIF + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_ther=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_ther=tia_ther+REAL(ti_ther)/REAL(clock_rate) + ENDIF + + + ENDIF ! iflag_conv KE +!------------------------------------ +! Sedimentation +!----------------------------------- + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + + DO it=1,nbtr + DO j=1,klev + DO i=1,klon + tmp_var(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=tmp_var(i,j) + ENDDO + ENDDO + ENDDO !--end itr loop + iscm3=.true. +!-------------------------------------- + print *,' BEFORE Sediment' + + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_sedi') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before sedi') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'before sedi') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: before sedi') + ENDIF + + print *,'SPLA VERSION OF SEDIMENTATION IS USED' + CALL sediment_mod(t_seri,pplay,zrho,paprs,pdtphys,RHcl, & + id_coss,id_codu,id_scdu, & + ok_chimeredust, & + sed_ss,sed_dust,sed_dustsco, & + sed_ss3D,sed_dust3D,sed_dustsco3D,tr_seri) + CALL cm3_to_kg(pplay,t_seri,sed_ss3D) + CALL cm3_to_kg(pplay,t_seri,sed_dust3D) + CALL cm3_to_kg(pplay,t_seri,sed_dustsco3D) + + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_sedi') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after sedi') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'after sedi') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: after sedi') + ENDIF + +! +!======================================================================= + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRF'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + + + +! + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_sedi=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_sedi=tia_sedi+REAL(ti_sedi)/REAL(clock_rate) + ENDIF + + DO it=1, nbtr + DO j=1,klev + DO i=1,klon + tmp_var(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL cm3_to_kg(pplay,t_seri,tmp_var) + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=tmp_var(i,j) + ENDDO + ENDDO + ENDDO + iscm3=.false. +! +! +!====================================================================== +! GAS TO PARTICLE CONVERSION +!====================================================================== +! + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_beforegastopar') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before gastopar') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'before gastopar') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: before gastopar') + ENDIF + + CALL gastoparticle(pdtphys,zdz,zrho,rlat, & + pplay,t_seri,id_prec,id_fine, & + tr_seri,his_g2pgas ,his_g2paer) +! + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_gastopar') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after gastopar') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'after gastopar') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: after gastopar') + ENDIF + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_gasp=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_gasp=tia_gasp+REAL(ti_gasp)/REAL(clock_rate) + ENDIF + + +! +!====================================================================== +! EFFECT OF PRECIPITATION: iflag_conv=2 +!====================================================================== +! + + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRG'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + + + IF (iflag_conv.EQ.2) THEN + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + + + + DO it=1, nbtr + DO j=1,klev + DO i=1,klon + tmp_var(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=tmp_var(i,j) + ENDDO + ENDDO + ENDDO + iscm3=.true. +!------------------------------ + + print *,'iflag_conv bef lessiv',iflag_conv + IF (lessivage) THEN +! + print *,' BEFORE Incloud' + + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_incloud') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before incloud') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'before incloud') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: before incloud') + ENDIF + + +! CALL incloud_scav(lminmax,qmin,qmax,masse,henry,kk,prfl, +! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys, + +! . his_dhlsc,his_dhcon,tr_seri) + print *,'iflag_conv bef incloud',iflag_conv + + IF (iflag_conv.EQ.2) THEN +! Tiedke + CALL incloud_scav(.false.,qmin,qmax,masse,henry,kk,prfl, & + psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys, & + his_dhlsc,his_dhcon,tr_seri) + +!---------- to use this option please comment lsc_scav at the end +! ELSE IF (iflag_conv.GE.3) THEN +! +! CALL incloud_scav_lsc(.false.,qmin,qmax,masse,henry,kk,prfl, +! . psfl,pmflxr,pmflxs,zrho,zdz,t_seri,pdtphys, +! . his_dhlsc,his_dhcon,tr_seri) +!-------------------------------------------------------------- + + ENDIF +! +! + print *,' BEFORE blcloud (after incloud)' + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_blcloud') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before blcloud') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'before blcloud') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: before blcloud') + ENDIF + +! CALL blcloud_scav(lminmax,qmin,qmax,pdtphys,prfl,psfl, +! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse, +! . his_dhbclsc,his_dhbccon,tr_seri) + + IF (iflag_conv.EQ.2) THEN +! Tiedke + + CALL blcloud_scav(.false.,qmin,qmax,pdtphys,prfl,psfl, & + pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse, & + his_dhbclsc,his_dhbccon,tr_seri) + +!---------- to use this option please comment lsc_scav at the end +! and comment IF iflag=2 after "EFFECT OF PRECIPITATION:" +! +! +! ELSE IF (iflag_conv.GE.3) THEN +! +! CALL blcloud_scav_lsc(.false.,qmin,qmax,pdtphys,prfl,psfl, +! . pmflxr,pmflxs,zdz,alpha_r,alpha_s,masse, +! . his_dhbclsc,his_dhbccon,tr_seri) +! +!---------------------------------------------------------------------- + ENDIF + + + print *,' AFTER blcloud ' + + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_blcloud') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after blcloud') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'after blcloud') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: after blcloud') + ENDIF + + + ENDIF !--lessivage + + DO it=1, nbtr + DO j=1,klev + DO i=1,klon + tmp_var(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL cm3_to_kg(pplay,t_seri,tmp_var) + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=tmp_var(i,j) + ENDDO + ENDDO + ENDDO + iscm3=.false. +! + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_wetap=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_wetap=tia_wetap+REAL(ti_wetap)/REAL(clock_rate) + ENDIF + + + + + ENDIF ! iflag_conv=2 + +! +! +!====================================================================== +! EFFECT OF CONVECTION +!====================================================================== +! + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRH'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + + IF (convection) THEN +! + print *,' BEFORE trconvect' + + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_trconve') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before trconve') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'before trconve') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: before trconve') + ENDIF + + +! JE CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u, +! . pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,lminmax,masse, +! . dtrconv,tr_seri) +! ------------------------------------------------------------- + IF (iflag_conv.EQ.2) THEN +! Tiedke + CALL trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u, & + pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,.false.,masse, & + dtrconv,tr_seri) + DO it=1, nbtr + d_tr_cv(:,:,it)=0. + ENDDO + + ELSE IF (iflag_conv.GE.3) THEN +! KE + print *,'JE: KE in phytracr_spl' + DO it=1, nbtr + DO k = 1, klev + DO i = 1, klon + tmp_var3(i,k,it)=tr_seri(i,k,it) + END DO + END DO + ENDDO + + DO it=1, nbtr +! routine for aerosols . otherwise, check cvltrorig + print *,'Check sum before cvltr it',it,SUM(tr_seri(:,:,it)) +! IF (.FALSE.) THEN + CALL cvltr_spl(pdtphys, da, phi,phi2,d1a,dam, mp,ep, & + sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, & + pmflxr,pmflxs,evapls,t_seri,wdtrainA,wdtrainM, & +! paprs,it,tr_seri,upwd,dnwd,itop_con,ibas_con, & + paprs,it,tmp_var3,upwd,dnwd,itop_con,ibas_con, & + henry,kk,zrho,ccntrAA_spla,ccntrENV_spla,coefcoli_spla, & + id_prec,id_fine,id_coss, id_codu, id_scdu, & + d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr, & + qPa,qMel,qTrdi,dtrcvMA,Mint, & + zmfd1a,zmfphi2,zmfdam) +! ENDIF +! +! IF (.FALSE.) THEN +! CALL cvltr(pdtphys, da, phi,phi2,d1a,dam, mp,ep, +! . sigd,sij,wght_cvfd,clw,elij,epmlmMm,eplaMm, +! . pmflxr,pmflxs,evapls,t_seri,wdtrainA,wdtrainM, +! . paprs,it,tmp_var3,upwd,dnwd,itop_con,ibas_con, +! . d_tr_cv,d_tr_trsp,d_tr_sscav,d_tr_sat,d_tr_uscav,qDi,qPr, +! . qPa,qMel,qTrdi,dtrcvMA,Mint, +! . zmfd1a,zmfphi2,zmfdam) +!! pas lessivage convectif pou n'est pas un aerosol (i/else with cvltr) +! ENDIF + + + +!!!!!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tr_seri, +!!! CALL cvltrorig(it,pdtphys, da, phi,mp,paprs,pplay,tmp_var3, +!!! . upwd,dnwd,d_tr_cv) +! print *,'justbefore cvltrnoscav it= ',it +! CALL checknanqfi(da(:,:),1.,-1.,' da') +! CALL checknanqfi(wght_cvfd(:,:),1.,-1.,'weigth ') +! CALL checknanqfi(mp(:,:),1.,-1.,'mp ') +! CALL checknanqfi(paprs(:,:),1.,-1.,'paprs ') +! CALL checknanqfi(pplay(:,:),1.,-1.,'pplay ') +! CALL checknanqfi(tmp_var3(:,:,it),1.,-1.,'tmp_var3 ') +! CALL checknanqfi(upwd(:,:),1.,-1.,'upwd ') +! CALL checknanqfi(dnwd(:,:),1.,-1.,'dnwd ') +! CALL checknanqfi(d_tr_cv(:,:,it),1.,-1.,'d_tr_cv ') +! IF (.TRUE.) THEN +! CALL cvltr_noscav(it,pdtphys, da, phi,mp,wght_cvfd,paprs, +! . pplay,tmp_var3,upwd,dnwd,d_tr_cv) +! ENDIF + DO k = 1, klev + DO i = 1, klon +! tr_seri(i,k,it) = tr_seri(i,k,it) + d_tr_cv(i,k,it) + tr_seri(i,k,it)=(tmp_var3(i,k,it)+d_tr_cv(i,k,it)) + tmp_var(i,k)=d_tr_cv(i,k,it) + + END DO + END DO + + CALL kg_to_cm3(pplay,t_seri,tmp_var) !just for his_* computation + + DO k = 1, klev + DO i = 1, klon + dtrconv(i,it)=0.0 + his_dhkecv(i,it)=his_dhkecv(i,it)-tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + END DO + END DO + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + CALL kg_to_cm3(pplay,t_seri,tmp_var) !just for his_* computation + + DO k = 1, klev + DO i = 1, klon + dtrconv(i,it)=0.0 + his_ds(i,it)=his_ds(i,it)-tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + END DO + END DO +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + IF (lminmax) THEN + + print *,'Check sum after cvltr it',it,SUM(tr_seri(:,:,it)) + CALL minmaxqfi2(d_tr_cv(:,:,it),qmin,qmax,'d_tr_cv:') + CALL minmaxqfi2(d_tr_trsp(:,:,it),qmin,qmax,'d_tr_trsp:') + CALL minmaxqfi2(d_tr_sscav(:,:,it),qmin,qmax,'d_tr_sscav:') + CALL minmaxqfi2(d_tr_sat(:,:,it),qmin,qmax,'d_tr_sat:') + CALL minmaxqfi2(d_tr_uscav(:,:,it),qmin,qmax,'d_tr_uscav:') + IF (lcheckmass) THEN + CALL checkmass(d_tr_cv(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,.false.,'d_tr_cv:') + ENDIF + ENDIF + ENDDO ! it=1,nbtr + + ENDIF ! iflag_conv + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_trcon') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after trconv') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'after trconv') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: after trconv') + ENDIF + ENDIF ! convection + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_cvltr=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_cvltr=tia_cvltr+REAL(ti_cvltr)/REAL(clock_rate) + ENDIF + + + +! +! +!======================================================================= +! LARGE SCALE SCAVENGING KE +!======================================================================= +! + call iophys_ecrit('da',klev,'da','',da) + call iophys_ecrit('phi',klev,'phi','',phi) + call iophys_ecrit('phi2',klev,'phi2','',phi2) + call iophys_ecrit('d1a',klev,'d1a','',d1a) + call iophys_ecrit('dam',klev,'dam','',dam) + call iophys_ecrit('mp',klev,'mp','',mp) + call iophys_ecrit('ep',klev,'ep','',ep) + call iophys_ecrit('sigd',klev,'sigd','',sigd) + call iophys_ecrit('sij',klev,'sij','',sij) + call iophys_ecrit('wght_cvfd',klev,'wght_cvfd','',wght_cvfd) + call iophys_ecrit('clw',klev,'clw','',clw) + call iophys_ecrit('elij',klev,'elij','',elij) + call iophys_ecrit('epmlmMm',klev,'epmlmMm','',epmlmMm) + call iophys_ecrit('eplaMm',klev,'eplaMm','',eplaMm) + call iophys_ecrit('pmflxr',klev,'pmflxr','',pmflxr) + call iophys_ecrit('pmflxs',klev,'pmflxs','',pmflxs) + call iophys_ecrit('evapls',klev,'evapls','',evapls) + call iophys_ecrit('wdtrainA',klev,'wdtrainA','',wdtrainA) + call iophys_ecrit('wdtrainM',klev,'wdtrainM','',wdtrainM) + + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRI'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + + + IF (iflag_conv.GE.3) THEN + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + + IF (lessivage) THEN + print *,' BEFORE lsc_scav ' + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_before_lsc_scav') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'before lsc_scav') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'before lsc_scav') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: before lsc_scav') + ENDIF + + + + ql_incloud_ref = 10.e-4 + ql_incloud_ref = 5.e-4 +! calcul du contenu en eau liquide au sein du nuage + ql_incl = ql_incloud_ref +! choix du lessivage + IF (iflag_lscav .EQ. 3 .OR. iflag_lscav .EQ. 4) THEN + print *,'JE iflag_lscav',iflag_lscav + DO it = 1, nbtr + +! incloud scavenging and removal by large scale rain ! orig : ql_incl +! was replaced by 0.5e-3 kg/kg +! the value 0.5e-3 kg/kg is from Giorgi and Chameides (1986), JGR +! Liu (2001) proposed to use 1.5e-3 kg/kg + +! CALL lsc_scav_orig(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl, +! . rneb,beta_fisrt, beta_v1,pplay,paprs, +! . t_seri,tr_seri,d_tr_insc, +! . d_tr_bcscav,d_tr_evapls,qPrls) + CALL lsc_scav_spl(pdtphys,it,iflag_lscav,ql_incl,prfl,psfl, & + rneb,beta_fisrt, beta_v1,pplay,paprs, & + t_seri,tr_seri,d_tr_insc, & + alpha_r,alpha_s,kk, henry, & + id_prec,id_fine,id_coss, id_codu, id_scdu, & + d_tr_bcscav,d_tr_evapls,qPrls) + +!large scale scavenging tendency + DO k = 1, klev + DO i = 1, klon + d_tr_ls(i,k,it)=d_tr_insc(i,k,it)+d_tr_bcscav(i,k,it) & + +d_tr_evapls(i,k,it) + tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr_ls(i,k,it) + tmp_var(i,k)=d_tr_ls(i,k,it) + ENDDO + ENDDO + + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + his_dhkelsc(i,it)=his_dhkelsc(i,it)-tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + + END DO + END DO + + END DO !tr + ELSE + his_dhkelsc(i,it)=0.0 + print *,'WARNING: NO lsc_scav, Please choose iflag_lscav=3 or 4' + ENDIF !iflag_lscav + + print *,' AFTER lsc_scav ' + IF (lminmax) THEN + DO it=1,nbtr + CALL checknanqfi(tr_seri(:,:,it),qmin,qmax,'nan_after_lsc_scav') + ENDDO + DO it=1,nbtr + CALL minmaxqfi2(tr_seri(:,:,it),qmin,qmax,'after lsc_scav') + ENDDO + IF (lcheckmass) THEN + DO it=1,nbtr + CALL checkmass(tr_seri(:,:,it),RNAVO,masse(it),zdz, & + pplay,t_seri,iscm3,'after lsc_scav') + ENDDO + ENDIF + CALL minmaxsource(source_tr,qmin,qmax,'src: after lsc_scav') + ENDIF + + ENDIF ! lessivage + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_lscs=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_lscs=tia_lscs+REAL(ti_lscs)/REAL(clock_rate) + ENDIF + + + + ENDIF !iflag_conv + + +!======================================================================= +! COMPUTING THE BURDEN +!======================================================================= + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRJ'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + +! + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + + DO it=1, nbtr + DO j=1,klev + DO i=1,klon + tmp_var(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=tmp_var(i,j) + ENDDO + ENDDO + ENDDO + iscm3=.true. + +! +! Computing burden in mg/m2 + DO it=1, nbtr + DO k=1, klev + DO i=1, klon + trm(i,it)=trm(i,it)+tr_seri(i,k,it)*1.e6*zdz(i,k)* & + masse(it)*1.e3/RNAVO !--mg S/m2 + ENDDO + ENDDO + ENDDO +! +! Computing Surface concentration in ug/m3 +! + DO it=1, nbtr + DO i=1, klon + sconc_seri(i,it)=tr_seri(i,1,it)*1.e6* & + masse(it)*1.e3/RNAVO !--mg/m3 (tr_seri ist in g/cm3) + ENDDO + ENDDO +! +!======================================================================= +! CALCULATION OF OPTICAL PROPERTIES +!======================================================================= +! + CALL aeropt_spl(zdz, tr_seri, RHcl, & + id_prec, id_fine, id_coss, id_codu, id_scdu, & + ok_chimeredust, & + diff_aod550_tot, diag_aod670_tot, diag_aod865_tot, & + diff_aod550_tr2, diag_aod670_tr2, diag_aod865_tr2, & + diag_aod550_ss, diag_aod670_ss, diag_aod865_ss, & + diag_aod550_dust,diag_aod670_dust,diag_aod865_dust, & + diag_aod550_dustsco,diag_aod670_dustsco,diag_aod865_dustsco) + + + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + dife=clock_end-clock_start + ti_brop=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_brop=tia_brop+REAL(ti_brop)/REAL(clock_rate) + ENDIF + + +!======================================================================= +! MODIS terra/aqua simulation output +!======================================================================= + masque_aqua_cur(:)=0 + masque_terra_cur(:)=0 + + CALL satellite_out_spla(jD_cur,jH_cur,pdtphys,rlat,rlon, & + masque_aqua_cur, masque_terra_cur ) + IF (jH_cur-pdtphys/86400. .LT. 0.) THEN + !new utc day: put in 0 everything +!JE20150518<< +! aod550_aqua(:) =0. +! aod550_terra(:) =0. +! aod670_aqua(:) =0. +! aod670_terra(:) =0. +! aod865_aqua(:) =0. +! aod865_terra(:) =0. + masque_aqua(:) =0 + masque_terra(:) =0 + aod550_terra(:)=0. + aod550_tr2_terra(:)=0. + aod550_ss_terra(:)=0. + aod550_dust_terra(:)=0. + aod550_dustsco_terra(:)=0. + aod670_terra(:)=0. + aod670_tr2_terra(:)=0. + aod670_ss_terra(:)=0. + aod670_dust_terra(:)=0. + aod670_dustsco_terra(:)=0. + aod865_terra(:)=0. + aod865_tr2_terra(:)=0. + aod865_ss_terra(:)=0. + aod865_dust_terra(:)=0. + aod865_dustsco_terra(:)=0. + aod550_aqua(:)=0. + aod550_tr2_aqua(:)=0. + aod550_ss_aqua(:)=0. + aod550_dust_aqua(:)=0. + aod550_dustsco_aqua(:)=0. + aod670_aqua(:)=0. + aod670_tr2_aqua(:)=0. + aod670_ss_aqua(:)=0. + aod670_dust_aqua(:)=0. + aod670_dustsco_aqua(:)=0. + aod865_aqua(:)=0. + aod865_tr2_aqua(:)=0. + aod865_ss_aqua(:)=0. + aod865_dust_aqua(:)=0. + aod865_dustsco_aqua(:)=0. +!JE20150518>> + ENDIF + + DO i=1,klon +! aod550_aqua(i)=aod550_aqua(i)+ & +! masque_aqua_cur(i)*diff_aod550_tot(i) +! aod670_aqua(i)=aod670_aqua(i)+ & +! masque_aqua_cur(i)*diag_aod670_tot(i) +! aod865_aqua(i)=aod865_aqua(i)+ & +! masque_aqua_cur(i)*diag_aod865_tot(i) + + aod550_terra(i)=aod550_terra(i)+ & + masque_terra_cur(i)*diff_aod550_tot(i) + aod550_tr2_terra(i)= aod550_tr2_terra(i)+ & + masque_terra_cur(i)*diff_aod550_tr2(i) + aod550_ss_terra(i)=aod550_ss_terra(i) + & + masque_terra_cur(i)*diag_aod550_ss(i) + aod550_dust_terra(i)= aod550_dust_terra(i) + & + masque_terra_cur(i)*diag_aod550_dust(i) + aod550_dustsco_terra(i)= aod550_dustsco_terra(i) + & + masque_terra_cur(i)*diag_aod550_dustsco(i) + aod670_terra(i)=aod670_terra(i)+ & + masque_terra_cur(i)*diag_aod670_tot(i) + aod670_tr2_terra(i)= aod670_tr2_terra(i)+ & + masque_terra_cur(i)*diag_aod670_tr2(i) + aod670_ss_terra(i)=aod670_ss_terra(i) + & + masque_terra_cur(i)*diag_aod670_ss(i) + aod670_dust_terra(i)= aod670_dust_terra(i) + & + masque_terra_cur(i)*diag_aod670_dust(i) + aod670_dustsco_terra(i)= aod670_dustsco_terra(i) + & + masque_terra_cur(i)*diag_aod670_dustsco(i) + aod865_terra(i)=aod865_terra(i)+ & + masque_terra_cur(i)*diag_aod865_tot(i) + aod865_tr2_terra(i)= aod865_tr2_terra(i)+ & + masque_terra_cur(i)*diag_aod865_tr2(i) + aod865_ss_terra(i)=aod865_ss_terra(i) + & + masque_terra_cur(i)*diag_aod865_ss(i) + aod865_dust_terra(i)= aod865_dust_terra(i) + & + masque_terra_cur(i)*diag_aod865_dust(i) + aod865_dustsco_terra(i)= aod865_dustsco_terra(i) + & + masque_terra_cur(i)*diag_aod865_dustsco(i) + + + + aod550_aqua(i)=aod550_aqua(i)+ & + masque_aqua_cur(i)*diff_aod550_tot(i) + aod550_tr2_aqua(i)= aod550_tr2_aqua(i)+ & + masque_aqua_cur(i)*diff_aod550_tr2(i) + aod550_ss_aqua(i)=aod550_ss_aqua(i) + & + masque_aqua_cur(i)*diag_aod550_ss(i) + aod550_dust_aqua(i)= aod550_dust_aqua(i) + & + masque_aqua_cur(i)*diag_aod550_dust(i) + aod550_dustsco_aqua(i)= aod550_dustsco_aqua(i) + & + masque_aqua_cur(i)*diag_aod550_dustsco(i) + aod670_aqua(i)=aod670_aqua(i)+ & + masque_aqua_cur(i)*diag_aod670_tot(i) + aod670_tr2_aqua(i)= aod670_tr2_aqua(i)+ & + masque_aqua_cur(i)*diag_aod670_tr2(i) + aod670_ss_aqua(i)=aod670_ss_aqua(i) + & + masque_aqua_cur(i)*diag_aod670_ss(i) + aod670_dust_aqua(i)= aod670_dust_aqua(i) + & + masque_aqua_cur(i)*diag_aod670_dust(i) + aod670_dustsco_aqua(i)= aod670_dustsco_aqua(i) + & + masque_aqua_cur(i)*diag_aod670_dustsco(i) + aod865_aqua(i)=aod865_aqua(i)+ & + masque_aqua_cur(i)*diag_aod865_tot(i) + aod865_tr2_aqua(i)= aod865_tr2_aqua(i)+ & + masque_aqua_cur(i)*diag_aod865_tr2(i) + aod865_ss_aqua(i)=aod865_ss_aqua(i) + & + masque_aqua_cur(i)*diag_aod865_ss(i) + aod865_dust_aqua(i)= aod865_dust_aqua(i) + & + masque_aqua_cur(i)*diag_aod865_dust(i) + aod865_dustsco_aqua(i)= aod865_dustsco_aqua(i) + & + masque_aqua_cur(i)*diag_aod865_dustsco(i) +! aod550_terra(i)=aod550_terra(i)+ & +! masque_terra_cur(i)*diff_aod550_tot(i) +! aod670_terra(i)=aod670_terra(i)+ & +! masque_terra_cur(i)*diag_aod670_tot(i) +! aod865_terra(i)=aod865_terra(i)+ & +! masque_terra_cur(i)*diag_aod865_tot(i) + masque_aqua(i)=masque_aqua(i)+masque_aqua_cur(i) + masque_terra(i)=masque_terra(i)+masque_terra_cur(i) + ENDDO + + IF (jH_cur+pdtphys/86400. .GE. 1.) THEN +! print *,'last step of the day' + DO i=1,klon + IF (masque_aqua(i).GT. 0) THEN + aod550_aqua(i)=aod550_aqua(i)/masque_aqua(i) + aod670_aqua(i)=aod670_aqua(i)/masque_aqua(i) + aod865_aqua(i)=aod865_aqua(i)/masque_aqua(i) + aod550_tr2_aqua(i)=aod550_tr2_aqua(i)/masque_aqua(i) + aod670_tr2_aqua(i)=aod670_tr2_aqua(i)/masque_aqua(i) + aod865_tr2_aqua(i)=aod865_tr2_aqua(i)/masque_aqua(i) + aod550_ss_aqua(i)=aod550_ss_aqua(i)/masque_aqua(i) + aod670_ss_aqua(i)=aod670_ss_aqua(i)/masque_aqua(i) + aod865_ss_aqua(i)=aod865_ss_aqua(i)/masque_aqua(i) + aod550_dust_aqua(i)=aod550_dust_aqua(i)/masque_aqua(i) + aod670_dust_aqua(i)=aod670_dust_aqua(i)/masque_aqua(i) + aod865_dust_aqua(i)=aod865_dust_aqua(i)/masque_aqua(i) + aod550_dustsco_aqua(i)=aod550_dustsco_aqua(i)/masque_aqua(i) + aod670_dustsco_aqua(i)=aod670_dustsco_aqua(i)/masque_aqua(i) + aod865_dustsco_aqua(i)=aod865_dustsco_aqua(i)/masque_aqua(i) + ELSE + aod550_aqua(i) = -999. + aod670_aqua(i) = -999. + aod865_aqua(i) = -999. + aod550_tr2_aqua(i)= -999. + aod670_tr2_aqua(i)= -999. + aod865_tr2_aqua(i)= -999. + aod550_ss_aqua(i)= -999. + aod670_ss_aqua(i)= -999. + aod865_ss_aqua(i)= -999. + aod550_dust_aqua(i)= -999. + aod670_dust_aqua(i)= -999. + aod865_dust_aqua(i)= -999. + aod550_dustsco_aqua(i)= -999. + aod670_dustsco_aqua(i)= -999. + aod865_dustsco_aqua(i)= -999. + ENDIF + IF (masque_terra(i).GT. 0) THEN + aod550_terra(i)=aod550_terra(i)/masque_terra(i) + aod670_terra(i)=aod670_terra(i)/masque_terra(i) + aod865_terra(i)=aod865_terra(i)/masque_terra(i) + aod550_tr2_terra(i)=aod550_tr2_terra(i)/masque_terra(i) + aod670_tr2_terra(i)=aod670_tr2_terra(i)/masque_terra(i) + aod865_tr2_terra(i)=aod865_tr2_terra(i)/masque_terra(i) + aod550_ss_terra(i)=aod550_ss_terra(i)/masque_terra(i) + aod670_ss_terra(i)=aod670_ss_terra(i)/masque_terra(i) + aod865_ss_terra(i)=aod865_ss_terra(i)/masque_terra(i) + aod550_dust_terra(i)=aod550_dust_terra(i)/masque_terra(i) + aod670_dust_terra(i)=aod670_dust_terra(i)/masque_terra(i) + aod865_dust_terra(i)=aod865_dust_terra(i)/masque_terra(i) + aod550_dustsco_terra(i)=aod550_dustsco_terra(i)/masque_terra(i) + aod670_dustsco_terra(i)=aod670_dustsco_terra(i)/masque_terra(i) + aod865_dustsco_terra(i)=aod865_dustsco_terra(i)/masque_terra(i) + ELSE + aod550_terra(i) = -999. + aod670_terra(i) = -999. + aod865_terra(i) = -999. + aod550_tr2_terra(i)= -999. + aod670_tr2_terra(i)= -999. + aod865_tr2_terra(i)= -999. + aod550_ss_terra(i)= -999. + aod670_ss_terra(i)= -999. + aod865_ss_terra(i)= -999. + aod550_dust_terra(i)= -999. + aod670_dust_terra(i)= -999. + aod865_dust_terra(i)= -999. + aod550_dustsco_terra(i)= -999. + aod670_dustsco_terra(i)= -999. + aod865_dustsco_terra(i)= -999. + ENDIF +! IF (masque_terra(i).GT. 0) THEN +! aod550_terra(i) = aod550_terra(i)/masque_terra(i) +! aod670_terra(i)=aod670_terra(i)/masque_terra(i) +! aod865_terra(i)=aod865_terra(i)/masque_terra(i) +! +! ELSE +! aod550_terra(i) = -999. +! aod670_terra(i) = -999. +! aod865_terra(i) = -999. +! ENDIF + ENDDO +! !write dbg +! CALL writefield_phy("aod550_aqua",aod550_aqua,1) +! CALL writefield_phy("aod550_terra",aod550_terra,1) +! CALL writefield_phy("masque_aqua",float(masque_aqua),1) +! CALL writefield_phy("masque_terra",float(masque_terra),1) + + + IF (ok_histrac) THEN +! write in output file + call gather(aod550_aqua,aod550_aqua_glo) + call gather(aod550_terra,aod550_terra_glo) + call gather(aod670_aqua,aod670_aqua_glo) + call gather(aod670_terra,aod670_terra_glo) + call gather(aod865_aqua,aod865_aqua_glo) + call gather(aod865_terra,aod865_terra_glo) + +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod550_aqua_glo ,zx_tmp_2d) + CALL histwrite(nid_tra3,"taue550_aqua",itra,zx_tmp_2d, & + nbp_lon*(nbp_lat),ndex2d) + + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod550_terra_glo ,zx_tmp_2d) + CALL histwrite(nid_tra3,"taue550_terra",itra,zx_tmp_2d, & + nbp_lon*(nbp_lat),ndex2d) + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod670_aqua_glo ,zx_tmp_2d) + CALL histwrite(nid_tra3,"taue670_aqua",itra,zx_tmp_2d, & + nbp_lon*(nbp_lat),ndex2d) + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod670_terra_glo ,zx_tmp_2d) + CALL histwrite(nid_tra3,"taue670_terra",itra,zx_tmp_2d, & + nbp_lon*(nbp_lat),ndex2d) + + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod865_aqua_glo ,zx_tmp_2d) + CALL histwrite(nid_tra3,"taue865_aqua",itra,zx_tmp_2d, & + nbp_lon*(nbp_lat),ndex2d) + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, aod865_terra_glo ,zx_tmp_2d) + CALL histwrite(nid_tra3,"taue865_terra",itra,zx_tmp_2d, & + nbp_lon*(nbp_lat),ndex2d) + ENDIF +!$OMP END MASTER +!$OMP BARRIER + ENDIF +! !put in 0 everything +! aod550_aqua(:) =0. +! aod550_terra(:) =0. +! aod670_aqua(:) =0. +! aod670_terra(:) =0. +! aod865_aqua(:) =0. +! aod865_terra(:) =0. +! masque_aqua(:) =0 +! masque_terra(:) =0 + ENDIF + + +! +!====================================================================== +! Stockage sur bande histoire +!====================================================================== + do it=1,nbtr + write(str2,'(i2.2)') it + call iophys_ecrit('TRK'//str2,klev,'SOURCE','',tr_seri(:,:,it)) + enddo + + +! + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_start) + ENDIF + + DO it=1, nbtr + DO j=1,klev + DO i=1,klon + tmp_var(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL cm3_to_kg(pplay,t_seri,tmp_var) + DO j=1,klev + DO i=1,klon + tr_seri(i,j,it)=tmp_var(i,j) + ENDDO + ENDDO + ENDDO + iscm3=.false. + +! +! +!====================================================================== +! SAVING AEROSOL RELATED VARIABLES INTO FILE +!====================================================================== +! +!JE20141224 IF (ok_histrac) THEN +! + ndex2d = 0 + ndex3d = 0 +! + itra=itra+1 + + print *,'SAVING VARIABLES FOR DAY ',itra +! + fluxbb(:)=0.0 + fluxff(:)=0.0 + fluxbcbb(:)=0.0 + fluxbcff(:)=0.0 + fluxbcnff(:)=0.0 + fluxbcba(:)=0.0 + fluxbc(:)=0.0 + fluxombb(:)=0.0 + fluxomff(:)=0.0 + fluxomnat(:)=0.0 + fluxomba(:)=0.0 + fluxomnff(:)=0.0 + fluxom(:)=0.0 + fluxh2sff(:)=0.0 + fluxh2snff(:)=0.0 + fluxh2sbio(:)=0.0 + fluxso2ff(:)=0.0 + fluxso2nff(:)=0.0 + fluxso2bb(:)=0.0 + fluxso2vol(:)=0.0 + fluxso2ba(:)=0.0 + fluxso2(:)=0.0 + fluxso4ff(:)=0.0 + fluxso4nff(:)=0.0 + fluxso4bb(:)=0.0 + fluxso4ba(:)=0.0 + fluxso4(:)=0.0 + fluxdms(:)=0.0 + fluxdustec(:)=0.0 + fluxddfine(:)=0.0 + fluxddcoa(:)=0.0 + fluxddsco(:)=0.0 + fluxdd(:)=0.0 + fluxssfine(:)=0.0 + fluxsscoa(:)=0.0 + fluxss(:)=0.0 + DO i=1, klon + IF (iregion_ind(i).GT.0) THEN ! LAND + ! SULFUR EMISSIONS + fluxh2sff(i)= (lmt_so2ff_l(i)+lmt_so2ff_h(i))*frach2sofso2* & + scale_param_ind(iregion_ind(i))* & + 1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s + fluxso2ff(i)=scale_param_ind(iregion_ind(i)) * fracso2emis * & + (lmt_so2ff_l(i)+lmt_so2ff_h(i)) * 1.e4/RNAVO * & + masse_s * 1.e3 ! mgS/m2/s + ! SULPHATE EMISSIONS + fluxso4ff(i)=scale_param_ind(iregion_ind(i))*(1-fracso2emis)* & + (lmt_so2ff_l(i)+lmt_so2ff_h(i)) * 1.e4/RNAVO * & + masse_s * 1.e3 ! mgS/m2/s + ! BLACK CARBON EMISSIONS + fluxbcff(i)=scale_param_ff(iregion_ind(i))* & + lmt_bcff(i)*1.e4*1.e3 !/g/m2/s + ! ORGANIC MATTER EMISSIONS + fluxomff(i)=scale_param_ff(iregion_ind(i))* & + (lmt_omff(i))*1.e4*1.e3 !/g/m2/s + ! FOSSIL FUEL EMISSIONS + fluxff(i)=fluxbcff(i)+fluxomff(i) + ENDIF + IF (iregion_bb(i).GT.0) THEN ! LAND + ! SULFUR EMISSIONS + fluxso2bb(i) =scale_param_bb(iregion_bb(i)) * fracso2emis * & + (lmt_so2bb_l(i)+lmt_so2bb_h(i))* & + (1.-pctsrf(i,is_oce))*1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s + ! SULPHATE EMISSIONS + fluxso4bb(i) =scale_param_bb(iregion_bb(i))*(1-fracso2emis)* & + (lmt_so2bb_l(i)+lmt_so2bb_h(i))* & + (1.-pctsrf(i,is_oce))*1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s + ! BLACK CARBON EMISSIONS + fluxbcbb(i)=scale_param_bb(iregion_bb(i))* & + (lmt_bcbb_l(i)+lmt_bcbb_h(i))*1.e4*1.e3 !mg/m2/s + ! ORGANIC MATTER EMISSIONS + fluxombb(i)=scale_param_bb(iregion_bb(i))* & + (lmt_ombb_l(i)+lmt_ombb_h(i))*1.e4*1.e3 !mg/m2/s + ! BIOMASS BURNING EMISSIONS + fluxbb(i)=fluxbcbb(i)+fluxombb(i) + ENDIF + ! H2S EMISSIONS + fluxh2sbio(i)=lmt_h2sbio(i)*1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s + fluxh2snff(i)= lmt_so2nff(i)*frach2sofso2* & + 1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s + ! SULFUR DIOXIDE EMISSIONS + fluxso2nff(i)=fracso2emis * lmt_so2nff(i) * 1.e4/RNAVO * & + masse_s * 1.e3 ! mgS/m2/s + fluxso2vol(i)=(lmt_so2volc_cont(i)+lmt_so2volc_expl(i)) & + *1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s + fluxso2ba(i) =lmt_so2ba(i)*1.e4/RNAVO*masse_s*1.e3* & + fracso2emis ! mgS/m2/s + fluxso2(i)=fluxso2ff(i)+fluxso2bb(i)+fluxso2nff(i)+ & + fluxso2vol(i)+fluxso2ba(i) + ! DMS EMISSIONS + fluxdms(i)=( lmt_dms(i)+lmt_dmsbio(i) ) & + *1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s + ! SULPHATE EMISSIONS + fluxso4ba(i) =lmt_so2ba(i)*1.e4/RNAVO*masse_s*1.e3 & + *(1-fracso2emis) ! mgS/m2/s + fluxso4nff(i)=(1-fracso2emis)*lmt_so2nff(i) * 1.e4/RNAVO * & + masse_s * 1.e3 ! mgS/m2/s + fluxso4(i)=fluxso4ff(i)+fluxso4bb(i)+fluxso4ba(i)+fluxso4nff(i) + ! BLACK CARBON EMISSIONS + + fluxbcnff(i)=lmt_bcnff(i)*1.e4*1.e3 !mg/m2/s + fluxbcba(i)=lmt_bcba(i)*1.e4*1.e3 !mg/m2/s + fluxbc(i)=fluxbcbb(i)+fluxbcff(i)+fluxbcnff(i)+fluxbcba(i) + ! ORGANIC MATTER EMISSIONS + fluxomnat(i)=lmt_omnat(i)*1.e4*1.e3 !mg/m2/s + fluxomba(i)=lmt_omba(i)*1.e4*1.e3 !mg/m2/s + fluxomnff(i)=lmt_omnff(i)*1.e4*1.e3 !mg/m2/s + fluxom(i)=fluxombb(i)+fluxomff(i)+fluxomnat(i)+fluxomba(i)+ & + fluxomnff(i) + ! DUST EMISSIONS + fluxdustec(i)=dust_ec(i)*1.e6 ! old dust emission scheme +!JE20140605<< old dust emission version +! fluxddfine(i)=scale_param_dustacc(iregion_dust(i)) +! . * dust_ec(i)*0.093*1.e6 +! fluxddcoa(i)=scale_param_dustcoa(iregion_dust(i)) +! . * dust_ec(i)*0.905*1.e6 +! fluxdd(i)=fluxddfine(i)+fluxddcoa(i) +!JE20140605>> + fluxddfine(i)=flux_sparam_ddfine(i) + fluxddcoa(i)=flux_sparam_ddcoa(i) + fluxddsco(i)=flux_sparam_ddsco(i) + fluxdd(i)=fluxddfine(i)+fluxddcoa(i)+fluxddsco(i) + ! SEA SALT EMISSIONS + fluxssfine(i)=scale_param_ssacc*lmt_sea_salt(i,1)*1.e4*1.e3 + fluxsscoa(i)=scale_param_sscoa*lmt_sea_salt(i,2)*1.e4*1.e3 + fluxss(i)=fluxssfine(i)+fluxsscoa(i) + ENDDO +! prepare outputs cvltr + + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_cv(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_cv_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_trsp(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_trsp_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_sscav(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_sscav_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_sat(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_sat_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_uscav(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_uscav_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_insc(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_insc_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + + + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_bcscav(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_bcscav_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + + + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_evapls(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_evapls_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + + + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_ls(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_ls_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + + + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_dyn(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_dyn_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + + + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_cl(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_cl_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + + + DO it=1, nbtr + DO k=1,klev + DO i=1,klon + tmp_var(i,k)=d_tr_th(i,k,it) + ENDDO + ENDDO + CALL kg_to_cm3(pplay,t_seri,tmp_var) + DO k=1,klev + DO i=1,klon + d_tr_th_o(i,k,it)=tmp_var(i,k) & + /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDDO + ENDDO + ENDDO + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + DO it=1,nbtr + WRITE(str2,'(i2.2)') it + DO i=1, klon + his_dh(i,it)= his_dhlsc(i,it)+his_dhcon(i,it)+ & + his_dhbclsc(i,it)+his_dhbccon(i,it) + + ENDDO + ENDDO + + IF (ok_histrac) THEN +! +! SAVING VARIABLES IN TRACEUR +! + call gather(diff_aod550_tot ,auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue550",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod670_tot , auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue670",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod865_tot , auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue865",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diff_aod550_tr2 , auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue550_tr2",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod670_tr2 , auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue670_tr2",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod865_tr2 , auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue865_tr2",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod550_ss, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue550_ss",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod670_ss , auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue670_ss",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod865_ss, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue865_ss",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod550_dust, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue550_dust",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod670_dust, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue670_dust",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod865_dust, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue865_dust",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod550_dustsco, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue550_dustsco",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod670_dustsco, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue670_dustsco",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( diag_aod865_dustsco, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1, klon_glo,nbp_lon,nbp_lat, auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"taue865_dustsco",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + +!$OMP MASTER + DO it=1,nbtr +! + WRITE(str2,'(i2.2)') it +! + call gather( trm, auxklonnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) , zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"trm"//str2,itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + call gather( sconc_seri, auxklonnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo) + CALL histwrite(nid_tra3,"sconc"//str2,itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER +! +! SAVING VARIABLES IN LESSIVAGE +! + call gather( flux_tr, auxklonnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"flux"//str2,itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + call gather( his_ds, auxklonnbtr_glo ) +!! $OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"ds"//str2,itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF +! !$OMP END MASTER +! !$OMP BARRIER + ENDDO + + DO it=1,nbtr + WRITE(str2,'(i2.2)') it + DO i=1, klon + zx_tmp_fi2d(i) = his_dhlsc(i,it)+his_dhcon(i,it)+ & + his_dhbclsc(i,it)+his_dhbccon(i,it) + his_dh(i,it)= his_dhlsc(i,it)+his_dhcon(i,it)+ & + his_dhbclsc(i,it)+his_dhbccon(i,it) + + ENDDO +! + call gather( zx_tmp_fi2d, auxklon_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"dh"//str2,itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + call gather( his_dhkecv, auxklonnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"dhkecv"//str2,itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + call gather( his_dhkelsc, auxklonnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"dhkelsc"//str2,itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER +! call gather( d_tr_cv_o, auxklonklevnbtr_glo ) + call gather( d_tr_cv, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_cv"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + call gather( d_tr_trsp_o, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_trsp"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + call gather( d_tr_sscav_o, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_sscav"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + call gather( d_tr_sat_o, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_sat"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + call gather( d_tr_uscav_o, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_uscav"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + call gather( d_tr_insc_o, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_insc"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + call gather( d_tr_bcscav_o, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_bcscav"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + call gather( d_tr_evapls_o, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_evapls"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! call gather( d_tr_ls_o, auxklonklevnbtr_glo ) + call gather( d_tr_ls, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_ls"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) + + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + + + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! call gather( d_tr_dyn_o, auxklonklevnbtr_glo ) + call gather( d_tr_dyn, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_dyn"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) + + print*,'ECRTIURES TENDANCES MODIFIEES NON MAIS' + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! call gather( d_tr_cl_o, auxklonklevnbtr_glo ) + call gather( d_tr_cl, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_cl"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) + + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! call gather( d_tr_th_o, auxklonklevnbtr_glo ) + call gather( d_tr_th, auxklonklevnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,auxklonklevnbtr_glo(1,1,it) , & + zx_tmp_3d_glo) + CALL histwrite(nid_tra2,"d_tr_th"//str2,itra,zx_tmp_3d_glo, & + nbp_lon*(nbp_lat)*nbp_lev,ndex3d) + + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + call gather( dtrconv,auxklonnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"dtrconv"//str2,itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER + call gather( his_th, auxklonnbtr_glo ) +! !$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklonnbtr_glo(1,it) ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"dtherm"//str2,itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) + ENDIF ! mpi root +! !$OMP END MASTER +! !$OMP BARRIER +! + + ENDDO +! +!$OMP END MASTER +!$OMP BARRIER + call gather( sed_ss, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"sed_ss",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( sed_dust, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"sed_dust",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( sed_dustsco, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"sed_dustsco",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( his_g2pgas, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"g2p_gas",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( his_g2paer, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra2,"g2p_aer",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! SAVING VARIABLES IN HISTRAC +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxbb, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxbb",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! +! ======================== BC ============================= + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxbcbb, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxbcbb",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxbcff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxbcff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxbcnff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxbcnff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxbcba, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxbcba",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxbc, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxbc",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! ======================== OM ============================= + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxombb, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxombb",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxomff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxomff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxomnff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxomnff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxomba, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxomba",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxomnat, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxomnat",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxom, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxom",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! ======================== SO4 ============================= + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso4ff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso4ff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso4nff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso4nff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso4bb, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso4bb",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso4ba, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso4ba",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso4, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo ,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso4",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! ======================== H2S ============================= + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxh2sff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxh2sff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxh2snff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxh2snff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxh2sbio, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxh2sbio",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! ======================== SO2 ============================= + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso2ff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso2ff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso2nff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso2nff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso2bb, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso2bb",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso2vol, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso2vol",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso2ba, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso2ba",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxso2, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxso2",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxdms, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxdms",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! ======================== DD ============================= + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxdustec, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxdustec",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxddfine, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxddfine",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxddcoa, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxddcoa",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxddsco, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxddsco",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxdd, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxdd",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! ======================== SS ============================= + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxssfine, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxssfine",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxsscoa, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxsscoa",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( fluxss, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"fluxss",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + +! call gather( , auxklon_glo ) +!!!! IF (is_mpi_root .AND. is_omp_root) THEN +!nhl CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,fluxso4chem,zx_tmp_3d_glo) +!nhl CALL histwrite(nid_tra1,"fluxso4chem",itra,zx_tmp_3d_glo, & +!nhl . nbp_lon*(nbp_lat)*nbp_lev,ndex3d) +! + call gather( flux_sparam_ind, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"flux_sparam_ind",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( flux_sparam_bb, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"flux_sparam_bb",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( flux_sparam_ff, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"flux_sparam_ff",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( flux_sparam_ddfine, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"flux_sparam_ddfine",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( flux_sparam_ddcoa, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"flux_sparam_ddcoa",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( flux_sparam_ddsco, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"flux_sparam_ddsco",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( flux_sparam_ssfine, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"flux_sparam_ssfine",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( flux_sparam_sscoa, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"flux_sparam_sscoa",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( u10m_ec, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"u10m",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + call gather( v10m_ec, auxklon_glo ) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + CALL gr_fi_ecrit(1,klon_glo,nbp_lon,nbp_lat,auxklon_glo,zx_tmp_2d_glo) + CALL histwrite(nid_tra1,"v10m",itra,zx_tmp_2d_glo, & + nbp_lon*(nbp_lat),ndex2d) +! +! call gather( , auxklon_glo ) +!!! !$OMP MASTER +! IF (is_mpi_root .AND. is_omp_root) THEN +!nhl CALL gr_fi_ecrit(nbp_lev,klon_glo,nbp_lon,nbp_lat,flux_sparam_sulf,zx_tmp_3d_glo) +!nhl CALL histwrite(nid_tra1,"flux_sparam_sulf",itra,zx_tmp_3d_glo, & +!nhl . nbp_lon*(nbp_lat)*nbp_lev,ndex3d) +! + ENDIF ! mpi root +!$OMP END MASTER +!$OMP BARRIER + + ENDIF ! ok_histrac + + + + +!JE20141224 +! saving variables for output +! 2D outputs + DO i=1, klon + trm01(i)=0. + trm02(i)=0. + trm03(i)=0. + trm04(i)=0. + trm05(i)=0. + sconc01(i)=0. + sconc02(i)=0. + sconc03(i)=0. + sconc04(i)=0. + sconc05(i)=0. + flux01(i)=0. + flux02(i)=0. + flux03(i)=0. + flux04(i)=0. + flux05(i)=0. + ds01(i)=0. + ds02(i)=0. + ds03(i)=0. + ds04(i)=0. + ds05(i)=0. + dh01(i)=0. + dh02(i)=0. + dh03(i)=0. + dh04(i)=0. + dh05(i)=0. + dtrconv01(i)=0. + dtrconv02(i)=0. + dtrconv03(i)=0. + dtrconv04(i)=0. + dtrconv05(i)=0. + dtherm01(i)=0. + dtherm02(i)=0. + dtherm03(i)=0. + dtherm04(i)=0. + dtherm05(i)=0. + dhkecv01(i)=0. + dhkecv02(i)=0. + dhkecv03(i)=0. + dhkecv04(i)=0. + dhkecv05(i)=0. + d_tr_ds01(i)=0. + d_tr_ds02(i)=0. + d_tr_ds03(i)=0. + d_tr_ds04(i)=0. + d_tr_ds05(i)=0. + dhkelsc01(i)=0. + dhkelsc02(i)=0. + dhkelsc03(i)=0. + dhkelsc04(i)=0. + dhkelsc05(i)=0. +! u10m_ss(i)=u10m_ec(i) +! v10m_ss(i)=v10m_ec(i) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + if(id_prec>0) trm01(i)=trm(i,id_prec) + if(id_fine>0) trm02(i)=trm(i,id_fine) + if(id_coss>0) trm03(i)=trm(i,id_coss) + if(id_codu>0) trm04(i)=trm(i,id_codu) + if(id_scdu>0) trm05(i)=trm(i,id_scdu) + if(id_prec>0) sconc01(i)=sconc_seri(i,id_prec) + if(id_fine>0) sconc02(i)=sconc_seri(i,id_fine) + if(id_coss>0) sconc03(i)=sconc_seri(i,id_coss) + if(id_codu>0) sconc04(i)=sconc_seri(i,id_codu) + if(id_scdu>0) sconc05(i)=sconc_seri(i,id_scdu) + if(id_prec>0) flux01(i)=flux_tr(i,id_prec) + if(id_fine>0) flux02(i)=flux_tr(i,id_fine) + if(id_coss>0) flux03(i)=flux_tr(i,id_coss) + if(id_codu>0) flux04(i)=flux_tr(i,id_codu) + if(id_scdu>0) flux05(i)=flux_tr(i,id_scdu) + if(id_prec>0) ds01(i)=his_ds(i,id_prec) + if(id_fine>0) ds02(i)=his_ds(i,id_fine) + if(id_coss>0) ds03(i)=his_ds(i,id_coss) + if(id_codu>0) ds04(i)=his_ds(i,id_codu) + if(id_scdu>0) ds05(i)=his_ds(i,id_scdu) + if(id_prec>0) dh01(i)=his_dh(i,id_prec) + if(id_fine>0) dh02(i)=his_dh(i,id_fine) + if(id_coss>0) dh03(i)=his_dh(i,id_coss) + if(id_codu>0) dh04(i)=his_dh(i,id_codu) + if(id_scdu>0) dh05(i)=his_dh(i,id_scdu) + if(id_prec>0) dtrconv01(i)=dtrconv(i,id_prec) + if(id_fine>0) dtrconv02(i)=dtrconv(i,id_fine) + if(id_coss>0) dtrconv03(i)=dtrconv(i,id_coss) + if(id_codu>0) dtrconv04(i)=dtrconv(i,id_codu) + if(id_scdu>0) dtrconv05(i)=dtrconv(i,id_scdu) + if(id_prec>0) dtherm01(i)=his_th(i,id_prec) + if(id_fine>0) dtherm02(i)=his_th(i,id_fine) + if(id_coss>0) dtherm03(i)=his_th(i,id_coss) + if(id_codu>0) dtherm04(i)=his_th(i,id_codu) + if(id_scdu>0) dtherm05(i)=his_th(i,id_scdu) + if(id_prec>0) dhkecv01(i)=his_dhkecv(i,id_prec) + if(id_fine>0) dhkecv02(i)=his_dhkecv(i,id_fine) + if(id_coss>0) dhkecv03(i)=his_dhkecv(i,id_coss) + if(id_codu>0) dhkecv04(i)=his_dhkecv(i,id_codu) + if(id_scdu>0) dhkecv05(i)=his_dhkecv(i,id_scdu) + if(id_prec>0) d_tr_ds01(i)=his_ds(i,id_prec) + if(id_fine>0) d_tr_ds02(i)=his_ds(i,id_fine) + if(id_coss>0) d_tr_ds03(i)=his_ds(i,id_coss) + if(id_codu>0) d_tr_ds04(i)=his_ds(i,id_codu) + if(id_scdu>0) d_tr_ds05(i)=his_ds(i,id_scdu) + if(id_prec>0) dhkelsc01(i)=his_dhkelsc(i,id_prec) + if(id_fine>0) dhkelsc02(i)=his_dhkelsc(i,id_fine) + if(id_coss>0) dhkelsc03(i)=his_dhkelsc(i,id_coss) + if(id_codu>0) dhkelsc04(i)=his_dhkelsc(i,id_codu) + if(id_scdu>0) dhkelsc05(i)=his_dhkelsc(i,id_scdu) + u10m_ss(i)=u10m_ec(i) + v10m_ss(i)=v10m_ec(i) + ENDDO +! 3D outs + DO i=1, klon + DO k=1,klev + d_tr_cv01(i,k) =0. + d_tr_cv02(i,k) =0. + d_tr_cv03(i,k) =0. + d_tr_cv04(i,k) =0. + d_tr_cv05(i,k) =0. + d_tr_trsp01(i,k) =0. + d_tr_trsp02(i,k) =0. + d_tr_trsp03(i,k) =0. + d_tr_trsp04(i,k) =0. + d_tr_trsp05(i,k) =0. + d_tr_sscav01(i,k)=0. + d_tr_sscav02(i,k)=0. + d_tr_sscav03(i,k)=0. + d_tr_sscav04(i,k)=0. + d_tr_sscav05(i,k)=0. + d_tr_sat01(i,k) =0. + d_tr_sat02(i,k) =0. + d_tr_sat03(i,k) =0. + d_tr_sat04(i,k) =0. + d_tr_sat05(i,k) =0. + d_tr_uscav01(i,k)=0. + d_tr_uscav02(i,k)=0. + d_tr_uscav03(i,k)=0. + d_tr_uscav04(i,k)=0. + d_tr_uscav05(i,k)=0. + d_tr_insc01(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + d_tr_insc02(i,k)=0. + d_tr_insc03(i,k)=0. + d_tr_insc04(i,k)=0. + d_tr_insc05(i,k)=0. + d_tr_bcscav01(i,k)=0. + d_tr_bcscav02(i,k)=0. + d_tr_bcscav03(i,k)=0. + d_tr_bcscav04(i,k)=0. + d_tr_bcscav05(i,k)=0. + d_tr_evapls01(i,k)=0. + d_tr_evapls02(i,k)=0. + d_tr_evapls03(i,k)=0. + d_tr_evapls04(i,k)=0. + d_tr_evapls05(i,k)=0. + d_tr_ls01(i,k)=0. + d_tr_ls02(i,k)=0. + d_tr_ls03(i,k)=0. + d_tr_ls04(i,k)=0. + d_tr_ls05(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + d_tr_dyn01(i,k)=0. + d_tr_dyn02(i,k)=0. + d_tr_dyn03(i,k)=0. + d_tr_dyn04(i,k)=0. + d_tr_dyn05(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + d_tr_cl01(i,k)=0. + d_tr_cl02(i,k)=0. + d_tr_cl03(i,k)=0. + d_tr_cl04(i,k)=0. + d_tr_cl05(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + d_tr_th01(i,k)=0. + d_tr_th02(i,k)=0. + d_tr_th03(i,k)=0. + d_tr_th04(i,k)=0. + d_tr_th05(i,k)=0.!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + if(id_prec>0) d_tr_cv01(i,k) =d_tr_cv_o(i,k,id_prec) + if(id_fine>0) d_tr_cv02(i,k) =d_tr_cv_o(i,k,id_fine) + if(id_coss>0) d_tr_cv03(i,k) =d_tr_cv_o(i,k,id_coss) + if(id_codu>0) d_tr_cv04(i,k) =d_tr_cv_o(i,k,id_codu) + if(id_scdu>0) d_tr_cv05(i,k) =d_tr_cv_o(i,k,id_scdu) + if(id_prec>0) d_tr_trsp01(i,k) =d_tr_trsp_o(i,k,id_prec) + if(id_fine>0) d_tr_trsp02(i,k) =d_tr_trsp_o(i,k,id_fine) + if(id_coss>0) d_tr_trsp03(i,k) =d_tr_trsp_o(i,k,id_coss) + if(id_codu>0) d_tr_trsp04(i,k) =d_tr_trsp_o(i,k,id_codu) + if(id_scdu>0) d_tr_trsp05(i,k) =d_tr_trsp_o(i,k,id_scdu) + if(id_prec>0) d_tr_sscav01(i,k)=d_tr_sscav_o(i,k,id_prec) + if(id_fine>0) d_tr_sscav02(i,k)=d_tr_sscav_o(i,k,id_fine) + if(id_coss>0) d_tr_sscav03(i,k)=d_tr_sscav_o(i,k,id_coss) + if(id_codu>0) d_tr_sscav04(i,k)=d_tr_sscav_o(i,k,id_codu) + if(id_scdu>0) d_tr_sscav05(i,k)=d_tr_sscav_o(i,k,id_scdu) + if(id_prec>0) d_tr_sat01(i,k) =d_tr_sat_o(i,k,id_prec) + if(id_fine>0) d_tr_sat02(i,k) =d_tr_sat_o(i,k,id_fine) + if(id_coss>0) d_tr_sat03(i,k) =d_tr_sat_o(i,k,id_coss) + if(id_codu>0) d_tr_sat04(i,k) =d_tr_sat_o(i,k,id_codu) + if(id_scdu>0) d_tr_sat05(i,k) =d_tr_sat_o(i,k,id_scdu) + if(id_prec>0) d_tr_uscav01(i,k)=d_tr_uscav_o(i,k,id_prec) + if(id_fine>0) d_tr_uscav02(i,k)=d_tr_uscav_o(i,k,id_fine) + if(id_coss>0) d_tr_uscav03(i,k)=d_tr_uscav_o(i,k,id_coss) + if(id_codu>0) d_tr_uscav04(i,k)=d_tr_uscav_o(i,k,id_codu) + if(id_scdu>0) d_tr_uscav05(i,k)=d_tr_uscav_o(i,k,id_scdu) + if(id_prec>0) d_tr_insc01(i,k)=d_tr_insc_o(i,k,id_prec) + if(id_fine>0) d_tr_insc02(i,k)=d_tr_insc_o(i,k,id_fine) + if(id_coss>0) d_tr_insc03(i,k)=d_tr_insc_o(i,k,id_coss) + if(id_codu>0) d_tr_insc04(i,k)=d_tr_insc_o(i,k,id_codu) + if(id_scdu>0) d_tr_insc05(i,k)=d_tr_insc_o(i,k,id_scdu) + if(id_prec>0) d_tr_bcscav01(i,k)=d_tr_bcscav_o(i,k,id_prec) + if(id_fine>0) d_tr_bcscav02(i,k)=d_tr_bcscav_o(i,k,id_fine) + if(id_coss>0) d_tr_bcscav03(i,k)=d_tr_bcscav_o(i,k,id_coss) + if(id_codu>0) d_tr_bcscav04(i,k)=d_tr_bcscav_o(i,k,id_codu) + if(id_scdu>0) d_tr_bcscav05(i,k)=d_tr_bcscav_o(i,k,id_scdu) + if(id_prec>0) d_tr_evapls01(i,k)=d_tr_evapls_o(i,k,id_prec) + if(id_fine>0) d_tr_evapls02(i,k)=d_tr_evapls_o(i,k,id_fine) + if(id_coss>0) d_tr_evapls03(i,k)=d_tr_evapls_o(i,k,id_coss) + if(id_codu>0) d_tr_evapls04(i,k)=d_tr_evapls_o(i,k,id_codu) + if(id_scdu>0) d_tr_evapls05(i,k)=d_tr_evapls_o(i,k,id_scdu) + ENDDO + ENDDO + IF(1==0) THEN + DO i=1, klon + DO k=1,klev + if(id_prec>0) d_tr_ls01(i,k)=d_tr_ls_o(i,k,id_prec) + if(id_fine>0) d_tr_ls02(i,k)=d_tr_ls_o(i,k,id_fine) + if(id_coss>0) d_tr_ls03(i,k)=d_tr_ls_o(i,k,id_coss) + if(id_codu>0) d_tr_ls04(i,k)=d_tr_ls_o(i,k,id_codu) + if(id_scdu>0) d_tr_ls05(i,k)=d_tr_ls_o(i,k,id_scdu) + if(id_prec>0) d_tr_dyn01(i,k)=d_tr_dyn_o(i,k,id_prec) + if(id_fine>0) d_tr_dyn02(i,k)=d_tr_dyn_o(i,k,id_fine) + if(id_coss>0) d_tr_dyn03(i,k)=d_tr_dyn_o(i,k,id_coss) + if(id_codu>0) d_tr_dyn04(i,k)=d_tr_dyn_o(i,k,id_codu) + if(id_scdu>0) d_tr_dyn05(i,k)=d_tr_dyn_o(i,k,id_scdu) + if(id_prec>0) d_tr_cl01(i,k)=d_tr_cl_o(i,k,id_prec) + if(id_fine>0) d_tr_cl02(i,k)=d_tr_cl_o(i,k,id_fine) + if(id_coss>0) d_tr_cl03(i,k)=d_tr_cl_o(i,k,id_coss) + if(id_codu>0) d_tr_cl04(i,k)=d_tr_cl_o(i,k,id_codu) + if(id_scdu>0) d_tr_cl05(i,k)=d_tr_cl_o(i,k,id_scdu) + if(id_prec>0) d_tr_th01(i,k)=d_tr_th_o(i,k,id_prec) + if(id_fine>0) d_tr_th02(i,k)=d_tr_th_o(i,k,id_fine) + if(id_coss>0) d_tr_th03(i,k)=d_tr_th_o(i,k,id_coss) + if(id_codu>0) d_tr_th04(i,k)=d_tr_th_o(i,k,id_codu) + if(id_scdu>0) d_tr_th05(i,k)=d_tr_th_o(i,k,id_scdu) + ENDDO + ENDDO + ELSE + DO i=1, klon + DO k=1,klev + if(id_prec>0) d_tr_ls01(i,k)=d_tr_ls(i,k,id_prec)/pdtphys + if(id_fine>0) d_tr_ls02(i,k)=d_tr_ls(i,k,id_fine)/pdtphys + if(id_coss>0) d_tr_ls03(i,k)=d_tr_ls(i,k,id_coss)/pdtphys + if(id_codu>0) d_tr_ls04(i,k)=d_tr_ls(i,k,id_codu)/pdtphys + if(id_scdu>0) d_tr_ls05(i,k)=d_tr_ls(i,k,id_scdu)/pdtphys + if(id_prec>0) d_tr_dyn01(i,k)=d_tr_dyn(i,k,id_prec)/pdtphys + if(id_fine>0) d_tr_dyn02(i,k)=d_tr_dyn(i,k,id_fine)/pdtphys + if(id_coss>0) d_tr_dyn03(i,k)=d_tr_dyn(i,k,id_coss)/pdtphys + if(id_codu>0) d_tr_dyn04(i,k)=d_tr_dyn(i,k,id_codu)/pdtphys + if(id_scdu>0) d_tr_dyn05(i,k)=d_tr_dyn(i,k,id_scdu)/pdtphys + if(id_prec>0) d_tr_cl01(i,k)=d_tr_cl(i,k,id_prec)/pdtphys + if(id_fine>0) d_tr_cl02(i,k)=d_tr_cl(i,k,id_fine)/pdtphys + if(id_coss>0) d_tr_cl03(i,k)=d_tr_cl(i,k,id_coss)/pdtphys + if(id_codu>0) d_tr_cl04(i,k)=d_tr_cl(i,k,id_codu)/pdtphys + if(id_scdu>0) d_tr_cl05(i,k)=d_tr_cl(i,k,id_scdu)/pdtphys + if(id_prec>0) d_tr_th01(i,k)=d_tr_th(i,k,id_prec)/pdtphys + if(id_fine>0) d_tr_th02(i,k)=d_tr_th(i,k,id_fine)/pdtphys + if(id_coss>0) d_tr_th03(i,k)=d_tr_th(i,k,id_coss)/pdtphys + if(id_codu>0) d_tr_th04(i,k)=d_tr_th(i,k,id_codu)/pdtphys + if(id_scdu>0) d_tr_th05(i,k)=d_tr_th(i,k,id_scdu)/pdtphys + ENDDO + ENDDO + ENDIF + + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + + dife=clock_end-clock_start + ti_outs=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_outs=tia_outs+REAL(ti_outs)/REAL(clock_rate) + ENDIF + + IF (logitime) THEN + CALL SYSTEM_CLOCK(COUNT=clock_end) + + dife=clock_end-clock_start_spla + ti_spla=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + + + tia_spla=tia_spla+REAL(ti_spla)/REAL(clock_rate) + print *,'times for this timestep:timeproc,timeproc/time_pytracr_spl-' + print *,'time spla',REAL(ti_spla)/REAL(clock_rate) & + ,REAL(ti_spla)/REAL(ti_spla) + print *,'time init',REAL(ti_init)/REAL(clock_rate) & + ,REAL(ti_init)/REAL(ti_spla) + print *,'time inittype',REAL(ti_inittype)/REAL(clock_rate) & + ,REAL(ti_inittype)/REAL(ti_spla) + print *,'time inittwrite',REAL(ti_inittwrite)/REAL(clock_rate) & + ,REAL(ti_inittwrite)/REAL(ti_spla) + print *,'time emis',REAL(ti_emis)/REAL(clock_rate) & + ,REAL(ti_emis)/REAL(ti_spla) + print *,'time depo ',REAL(ti_depo)/REAL(clock_rate) & + ,REAL(ti_depo)/REAL(ti_spla) + print *,'time cltr',REAL(ti_cltr)/REAL(clock_rate) & + ,REAL(ti_cltr)/REAL(ti_spla) + print *,'time ther',REAL(ti_ther)/REAL(clock_rate) & + ,REAL(ti_ther)/REAL(ti_spla) + print *,'time sedi',REAL(ti_sedi)/REAL(clock_rate) & + ,REAL(ti_sedi)/REAL(ti_spla) + print *,'time gas to part',REAL(ti_gasp)/REAL(clock_rate) & + ,REAL(ti_gasp)/REAL(ti_spla) + print *,'time AP wet',REAL(ti_wetap)/REAL(clock_rate) & + ,REAL(ti_wetap)/REAL(ti_spla) + print *,'time convective',REAL(ti_cvltr)/REAL(clock_rate) & + ,REAL(ti_cvltr)/REAL(ti_spla) + print *,'time NP lsc scav',REAL(ti_lscs)/REAL(clock_rate) & + ,REAL(ti_lscs)/REAL(ti_spla) + print *,'time opt,brdn,etc',REAL(ti_brop)/REAL(clock_rate) & + ,REAL(ti_brop)/REAL(ti_spla) + print *,'time outputs',REAL(ti_outs)/REAL(clock_rate) & + ,REAL(ti_outs)/REAL(ti_spla) + + + print *,'--time accumulated: time proc, time proc/time phytracr_spl--' + print *,'time spla',tia_spla + print *,'time init',tia_init,tia_init/tia_spla + print *,'time inittype',tia_inittype,tia_inittype/tia_spla + print *,'time inittwrite',tia_inittwrite,tia_inittwrite/tia_spla + print *,'time emis',tia_emis,tia_emis/tia_spla + print *,'time depo',tia_depo,tia_depo/tia_spla + print *,'time cltr',tia_cltr,tia_cltr/tia_spla + print *,'time ther',tia_ther,tia_ther/tia_spla + print *,'time sedi',tia_sedi,tia_sedi/tia_spla + print *,'time gas to part',tia_gasp,tia_gasp/tia_spla + print *,'time AP wet',tia_wetap,tia_wetap/tia_spla + print *,'time convective',tia_cvltr,tia_cvltr/tia_spla + print *,'time NP lsc scav',tia_lscs,tia_lscs/tia_spla + print *,'time opt,brdn,etc',tia_brop,tia_brop/tia_spla + print *,'time outputs',tia_outs,tia_outs/tia_spla + + + + dife=clock_end_outphytracr-clock_start_outphytracr + ti_nophytracr=dife*MAX(0,SIGN(1,dife)) & + +(dife+clock_per_max)*MAX(0,SIGN(1,-dife)) + tia_nophytracr=tia_nophytracr+REAL(ti_nophytracr)/REAL(clock_rate) + print *,'Time outside phytracr; Time accum outside phytracr' + print*,REAL(ti_nophytracr)/REAL(clock_rate),tia_nophytracr + + clock_start_outphytracr=clock_end + + ENDIF + print *,'END PHYTRACR_SPL ' + print *,'lmt_so2ff_l FIN' , MINVAL(lmt_so2ff_l), MAXVAL(lmt_so2ff_l) + +! CALL abort_gcm('TEST1', 'OK1', 1) + + RETURN + END SUBROUTINE phytracr_spl + + SUBROUTINE readregionsdims2_spl(nbreg,fileregions) + + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + + IMPLICIT NONE + CHARACTER*800 fileregions + CHARACTER*800 auxstr + INTEGER nbreg + + IF (is_mpi_root .AND. is_omp_root) THEN + + OPEN (UNIT=1,FILE=trim(adjustl(fileregions))) + READ(1,'(a)') auxstr + READ(1,'(i10)') nbreg + CLOSE(UNIT=1) + ENDIF + CALL bcast(nbreg) + + END SUBROUTINE readregionsdims2_spl + + SUBROUTINE readregionsdims_spl(nbreg_ind,fileregionsdimsind, & + nbreg_dust,fileregionsdimsdust, & + nbreg_bb,fileregionsdimsbb) + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + + IMPLICIT NONE + CHARACTER*800 fileregionsdimsind + CHARACTER*800 fileregionsdimsdust + CHARACTER*800 fileregionsdimsbb + CHARACTER*800 auxstr + INTEGER nbreg_ind,nbreg_dust,nbreg_bb + + IF (is_mpi_root .AND. is_omp_root) THEN + + OPEN (UNIT=1,FILE=trim(adjustl(fileregionsdimsind))) + READ(1,'(a)') auxstr + READ(1,'(i10)') nbreg_ind + CLOSE(UNIT=1) + + OPEN (UNIT=1,FILE=trim(adjustl(fileregionsdimsdust))) + READ(1,'(a)') auxstr + READ(1,'(i10)') nbreg_dust + CLOSE(UNIT=1) + + OPEN (UNIT=1,FILE=trim(adjustl(fileregionsdimsbb))) + READ(1,'(a)') auxstr + READ(1,'(i10)') nbreg_bb + CLOSE(UNIT=1) + + + ENDIF + CALL bcast(nbreg_ind) + CALL bcast(nbreg_dust) + CALL bcast(nbreg_bb) + + END SUBROUTINE readregionsdims_spl + + SUBROUTINE readregions_spl(iregion,filenameregion) + USE dimphy + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + + IMPLICIT NONE + CHARACTER*(*) filenameregion + INTEGER iregion(klon) + INTEGER iregion_glo(klon_glo) + INTEGER k + + IF (is_mpi_root .AND. is_omp_root) THEN + + print *,trim(adjustl(filenameregion)) + OPEN(1,file=trim(adjustl(filenameregion))) + DO k=1,klon_glo + READ(1,'(i10)') iregion_glo(k) + ENDDO + CLOSE(UNIT=1) + ENDIF + CALL scatter(iregion_glo,iregion) + + END SUBROUTINE readregions_spl + + SUBROUTINE readscaleparams_spl(scale_param, nbreg, & + filescaleparams) + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + IMPLICIT NONE + + CHARACTER*800 filescaleparams + INTEGER nbreg + REAL scale_param(nbreg) + INTEGER k + + IF (is_mpi_root .AND. is_omp_root) THEN + OPEN(1,file=trim(adjustl(filescaleparams)),form='unformatted') + do k=1,nbreg + read(1) scale_param(k) + enddo + CLOSE(1) + ENDIF + CALL bcast(scale_param) +! print *,'holaaaaaaaaaaaa' +! print *,scale_param + + END SUBROUTINE readscaleparams_spl + + SUBROUTINE readscaleparamsnc_spl(scale_param_ind, & + nbreg_ind, paramname_ind, & + scale_param_ff, nbreg_ff,paramname_ff, & + scale_param_bb, nbreg_bb,paramname_bb, & + scale_param_dustacc, nbreg_dustacc,paramname_dustacc, & + scale_param_dustcoa, nbreg_dustcoa,paramname_dustcoa, & + scale_param_dustsco, nbreg_dustsco,paramname_dustsco, & + param_wstarBLperregion, nbreg_wstardustBL, paramname_wstarBL, & + param_wstarWAKEperregion, nbreg_wstardustWAKE, paramname_wstarWAKE, & + scale_param_ssacc , paramname_ssacc, & + scale_param_sscoa , paramname_sscoa, & + filescaleparams,julien,jH_phys, pdtphys,debutphy) +! SUBROUTINE readscaleparamsnc_spl(scale_param, nbreg, & +! filescaleparams,paramname,& +! julien,jH_phys, pdtphys,debutphy) + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + IMPLICIT NONE + + CHARACTER*800 filescaleparams + CHARACTER*100 paramname_ind,paramname_ff,paramname_bb + CHARACTER*100 paramname_dustacc, paramname_dustcoa + CHARACTER*100 paramname_dustsco + CHARACTER*100 paramname_ssacc + CHARACTER*100 paramname_sscoa + CHARACTER*100 paramname_wstarBL + CHARACTER*100 paramname_wstarWAKE + + INTEGER nbreg,iday + INTEGER nbreg_ind, nbreg_ff, nbreg_bb , nbreg_dustacc + INTEGER nbreg_dustcoa , nbreg_dustsco, nbreg_wstardustBL + INTEGER nbreg_wstardustWAKE + INTEGER,PARAMETER :: nbreg_ssacc=1 + INTEGER,PARAMETER :: nbreg_sscoa=1 + REAL,PARAMETER :: sca_resol = 24. ! resolution of scalig params in hours + REAL scale_param_ind(nbreg_ind) + REAL scale_param_bb(nbreg_bb) + REAL scale_param_ff(nbreg_ff) + REAL scale_param_dustacc(nbreg_dustacc) + REAL scale_param_dustcoa(nbreg_dustcoa) + REAL scale_param_dustsco(nbreg_dustsco) + REAL param_wstarBLperregion(nbreg_wstardustBL) + REAL param_wstarWAKEperregion(nbreg_wstardustWAKE) + REAL scale_param_ssacc + REAL scale_param_ssacc_tmp(nbreg_ssacc) + REAL scale_param_sscoa + REAL scale_param_sscoa_tmp(nbreg_sscoa) + + INTEGER k,step_sca,test_sca + REAL :: jH_phys, pdtphys + REAL,SAVE :: jH_sca, jH_ini + INTEGER julien + LOGICAL debutphy + SAVE step_sca,test_sca,iday +!$OMP THREADPRIVATE(step_sca,test_sca,iday) +!$OMP THREADPRIVATE(jH_sca,jH_ini) + + IF (debutphy) THEN + iday=julien + step_sca=1 + test_sca=0 + jH_ini=jH_phys + jH_sca=jH_phys + ENDIF + + IF (test_sca .EQ. 0 ) THEN + ! READ file!! + call read_scalenc(filescaleparams,paramname_ind, & + nbreg_ind,step_sca, & + scale_param_ind) + call read_scalenc(filescaleparams,paramname_bb, & + nbreg_bb,step_sca, & + scale_param_bb) + call read_scalenc(filescaleparams,paramname_ff, & + nbreg_ff,step_sca, & + scale_param_ff) + call read_scalenc(filescaleparams,paramname_dustacc, & + nbreg_dustacc,step_sca, & + scale_param_dustacc) + call read_scalenc(filescaleparams,paramname_dustcoa, & + nbreg_dustcoa,step_sca, & + scale_param_dustcoa) + call read_scalenc(filescaleparams,paramname_dustsco, & + nbreg_dustsco,step_sca, & + scale_param_dustsco) + call read_scalenc(filescaleparams,paramname_wstarBL, & + nbreg_wstardustBL,step_sca, & + param_wstarBLperregion) + call read_scalenc(filescaleparams,paramname_wstarWAKE, & + nbreg_wstardustWAKE,step_sca, & + param_wstarWAKEperregion) + call read_scalenc(filescaleparams,paramname_ssacc, & + nbreg_ssacc,step_sca, & + scale_param_ssacc_tmp) + call read_scalenc(filescaleparams,paramname_sscoa, & + nbreg_sscoa,step_sca, & + scale_param_sscoa_tmp) + scale_param_ssacc=scale_param_ssacc_tmp(1) + scale_param_sscoa=scale_param_sscoa_tmp(1) + + !print *,'JEREADFILE',julien,jH_phys + step_sca= step_sca + 1 + test_sca=1 + ENDIF + + jH_sca=jH_sca+pdtphys/(24.*3600.) + IF (jH_sca.GT.(sca_resol)/24.) THEN + test_sca=0 + jH_sca=jH_ini + ENDIF + + END SUBROUTINE readscaleparamsnc_spl + + SUBROUTINE read_scalenc(filescaleparams,paramname,nbreg,step_sca, & + scale_param) + + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + IMPLICIT NONE + + include "netcdf.inc" + + CHARACTER*800 filescaleparams + CHARACTER*100 paramname + INTEGER nbreg, step_sca + REAL scale_param(nbreg) + !local vars + integer nid,ierr,nvarid + real rcode,auxreal + integer start(4),count(4), status +! local + integer debutread,countread + CHARACTER*104 varname + CHARACTER*2 aux_2s + integer i, j, ig +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + !nci=NCOPN(trim(adjustl(filescaleparams)),NCNOWRIT,rcode) + ierr = NF_OPEN (trim(adjustl(filescaleparams)),NF_NOWRITE, nid) + if (ierr .EQ. NF_NOERR) THEN + debutread=step_sca + countread=1 + + do i=1,nbreg + WRITE(aux_2s,'(i2.2)') i + varname= trim(adjustl(paramname))//aux_2s + print *,varname + ierr = NF_INQ_VARID (nid,trim(adjustl(varname)), nvarid) + ierr = NF_GET_VARA_DOUBLE (nid, nvarid, debutread, & + countread, auxreal) + IF (ierr .NE. NF_NOERR) THEN + PRINT*, 'Pb de lecture pour modvalues' + print *,'JE scale_var, step_sca',trim(adjustl(varname)),step_sca + CALL HANDLE_ERR(ierr) + print *,'error ierr= ',ierr + CALL exit(1) + call abort_gcm('read_scalenc','error reading variable',1) + ENDIF + + print *,auxreal + scale_param(i)=auxreal + enddo + + ierr = NF_CLOSE(nid) + else + print *,'File '//trim(adjustl(filescaleparams))//' not found' + print *,'doing nothing...' + endif + + ENDIF ! mpi_root +!$OMP END MASTER +!$OMP BARRIER +! CALL scatter(var local _glo,var local) o algo asi + call bcast(scale_param) + END SUBROUTINE read_scalenc + + + + END MODULE Index: /LMDZ5/trunk/libf/phylmd/Dust/precuremission.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/precuremission.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/precuremission.F (revision 2630) @@ -0,0 +1,263 @@ +C Subroutine that calculates the emission of aerosols precursors + SUBROUTINE precuremission(ftsol,u10m_ec,v10m_ec, + . pctsrf,u_seri,v_seri,paprs,pplay,cdragh, + . cdragm,t_seri,q_seri,tsol,fracso2emis, + . frach2sofso2,bateau,zdz,zalt, + . kminbc,kmaxbc,pdtphys,scale_param_bb, + . scale_param_ind,iregion_ind,iregion_bb, + . nbreg_ind, nbreg_bb, + . lmt_so2ff_l,lmt_so2ff_h,lmt_so2nff, + . lmt_so2ba,lmt_so2bb_l,lmt_so2bb_h, + . lmt_so2volc_cont,lmt_altvolc_cont, + . lmt_so2volc_expl,lmt_altvolc_expl, + . lmt_dmsbio,lmt_h2sbio, lmt_dmsconc, + . lmt_dms,id_prec,id_fine, + . flux_sparam_ind,flux_sparam_bb, + . source_tr,flux_tr,tr_seri) + + USE dimphy + USE indice_sol_mod + USE infotrac +! USE phytracr_spl_mod, ONLY : nbreg_dust, nbreg_ind, nbreg_bb + IMPLICIT NONE + +#include "dimensions.h" +#include "chem.h" +#include "chem_spla.h" +#include "YOMCST.h" +#include "paramet.h" + +c============================= INPUT =================================== + INTEGER kminbc, kmaxbc + REAL ftsol(klon,nbsrf) ! temperature du sol par type + REAL tsol(klon) ! temperature du sol moyenne + REAL t_seri(klon,klev) ! temperature + REAL u_seri(klon,klev) ! vent + REAL v_seri(klon,klev) ! vent + REAL q_seri(klon,klev) ! vapeur d eau kg/kg + REAL u10m_ec(klon), v10m_ec(klon) ! vent a 10 metres + REAL pctsrf(klon,nbsrf) + REAL pdtphys ! pas d'integration pour la physique (seconde) + REAL paprs(klon,klev+1) ! pression pour chaque inter-couche (en Pa) + REAL pplay(klon,klev) ! pression pour le mileu de chaque couche (en Pa) + REAL cdragh(klon), cdragm(klon) + REAL fracso2emis !--fraction so2 emis en so2 + REAL frach2sofso2 !--fraction h2s from so2 + REAL zdz(klon,klev) + LOGICAL edgar, bateau + INTEGER id_prec,id_fine +c +c------------------------- Scaling Parameters -------------------------- +c + INTEGER nbreg_ind, nbreg_bb + INTEGER iregion_ind(klon) !Defines regions for SO2, BC & OM + INTEGER iregion_bb(klon) !Defines regions for SO2, BC & OM + REAL scale_param_bb(nbreg_bb) !Scaling parameter for biomas burning + REAL scale_param_ind(nbreg_ind) !Scaling parameter for industrial emissions +c +c============================= OUTPUT ================================== +c + REAL source_tr(klon,nbtr) + REAL flux_tr(klon,nbtr) + REAL tr_seri(klon,klev,nbtr) ! traceur + REAL flux_sparam_ind(klon), flux_sparam_bb(klon) +c========================= LOCAL VARIABLES ============================= + INTEGER i, k, kkk_cont(klon), kkk_expl(klon) + REAL zalt(klon,klev), zaltmid(klon,klev) + REAL zzdz +c------------------------- SULFUR emissions ---------------------------- + REAL lmt_so2volc_cont(klon) ! emissions so2 volcan (continuous) + REAL lmt_altvolc_cont(klon) ! altitude so2 volcan (continuous) + REAL lmt_so2volc_expl(klon) ! emissions so2 volcan (explosive) + REAL lmt_altvolc_expl(klon) ! altitude so2 volcan (explosive) + REAL lmt_so2ff_l(klon) ! emissions so2 fossil fuel (low) + REAL lmt_so2ff_h(klon) ! emissions so2 fossil fuel (high) + REAL lmt_so2nff(klon) ! emissions so2 non-fossil fuel + REAL lmt_so2bb_l(klon) ! emissions de so2 biomass burning (low) + REAL lmt_so2bb_h(klon) ! emissions de so2 biomass burning (high) + REAL lmt_so2ba(klon) ! emissions de so2 bateau + REAL lmt_dms(klon) ! emissions de dms + REAL lmt_dmsconc(klon) ! concentration de dms oceanique + REAL lmt_dmsbio(klon) ! emissions de dms bio + REAL lmt_h2sbio(klon) ! emissions de h2s bio + + EXTERNAL condsurfs, liss, nightingale +c========================================================================= +c Modifications introduced by NHL +c -Variables to save fluxes were introduced +c -lmt_so2ba was multiplied by fracso2emis in line 117 +c -scale_param_bb was introduced in line 105 +c The last two modifications were errors existing in the original version +c========================================================================= +c========================================================================= +c LOW LEVEL EMISSIONS +c========================================================================= + + CALL nightingale(u_seri, v_seri, u10m_ec, v10m_ec, paprs, + . pplay, cdragh, cdragm, t_seri, q_seri, ftsol, + . tsol, pctsrf, lmt_dmsconc, lmt_dms) + + IF (.not.bateau) THEN + DO i=1, klon + lmt_so2ba(i)=0.0 + ENDDO + ENDIF + + DO i=1, klon + IF (iregion_ind(i).GT.0) THEN + IF(id_prec>0) source_tr(i,id_prec)=source_tr(i,id_prec) + . + fracso2emis + . *scale_param_ind(iregion_ind(i))*lmt_so2ff_l(i)*1.e4 + . +scale_param_ind(iregion_ind(i))*lmt_so2ff_l(i)*1.e4 + . *frach2sofso2 ! molec/m2/s +c + IF(id_fine>0) source_tr(i,id_fine)= + . source_tr(i,id_fine)+(1-fracso2emis) + . *scale_param_ind(iregion_ind(i))*lmt_so2ff_l(i) + . *1.e4*masse_ammsulfate/RNAVO ! g/m2/s +c + IF(id_prec>0) flux_tr(i,id_prec)=flux_tr(i,id_prec) + ( + . scale_param_ind(iregion_ind(i))*(lmt_so2ff_l(i)+ + . lmt_so2ff_h(i)) + . *frach2sofso2 + . +scale_param_ind(iregion_ind(i))*(lmt_so2ff_l(i)+ + . lmt_so2ff_h(i)) + . *fracso2emis + . )*1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s +c + IF(id_fine>0) flux_tr(i,id_fine)= + . flux_tr(i,id_fine)+(1-fracso2emis) + . *scale_param_ind(iregion_ind(i))*(lmt_so2ff_l(i)+ + . lmt_so2ff_h(i)) + . *1.e4/RNAVO*masse_ammsulfate*1.e3 ! mgS/m2/s +c + flux_sparam_ind(i)=flux_sparam_ind(i)+ (1-fracso2emis) + . *scale_param_ind(iregion_ind(i))*(lmt_so2ff_l(i)+ + . lmt_so2ff_h(i)) + . *1.e4/RNAVO*masse_ammsulfate*1.e3 ! mgS/m2/s + ENDIF + IF (iregion_bb(i).GT.0) THEN + IF(id_prec>0) source_tr(i,id_prec)= + . source_tr(i,id_prec) + fracso2emis + . *scale_param_bb(iregion_bb(i))*lmt_so2bb_l(i) + . *(1.-pctsrf(i,is_oce))*1.e4 +c + IF(id_fine>0) source_tr(i,id_fine)= + . source_tr(i,id_fine)+(1-fracso2emis) + . *scale_param_bb(iregion_bb(i))*lmt_so2bb_l(i)* + . (1.-pctsrf(i,is_oce))*1.e4* + . masse_ammsulfate/RNAVO ! g/m2/s +c + IF(id_prec>0) flux_tr(i,id_prec)=flux_tr(i,id_prec) + + . (scale_param_bb(iregion_bb(i))*lmt_so2bb_l(i) + . +scale_param_bb(iregion_bb(i))*lmt_so2bb_h(i)) + . * (1.-pctsrf(i,is_oce))*fracso2emis + . *1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s +c + IF(id_fine>0) flux_tr(i,id_fine)= + . flux_tr(i,id_fine)+(1-fracso2emis) + . *(scale_param_bb(iregion_bb(i))*lmt_so2bb_l(i) + . +scale_param_bb(iregion_bb(i))*lmt_so2bb_h(i)) + . *(1.-pctsrf(i,is_oce)) + . *1.e4/RNAVO*masse_ammsulfate*1.e3 ! mgS/m2/s +c + flux_sparam_bb(i)= + . scale_param_bb(iregion_bb(i))*(lmt_so2bb_l(i)+ + . lmt_so2bb_h(i)) + . * (1.-pctsrf(i,is_oce))*fracso2emis + . *1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s + flux_sparam_bb(i)= flux_sparam_bb(i) + (1-fracso2emis) * + . (scale_param_bb(iregion_bb(i))*lmt_so2bb_l(i)+ + . scale_param_bb(iregion_bb(i))*lmt_so2bb_h(i)) + . *(1.-pctsrf(i,is_oce)) + . *1.e4/RNAVO*masse_ammsulfate*1.e3 ! mgS/m2/s + ENDIF + IF(id_prec>0) source_tr(i,id_prec)=source_tr(i,id_prec) + . + fracso2emis + . *(lmt_so2ba(i)+lmt_so2nff(i))*1.e4 + . +(lmt_h2sbio(i) + . +lmt_dms(i)+lmt_dmsbio(i))*1.e4 ! molec/m2/s +c + IF(id_fine>0) source_tr(i,id_fine)=source_tr(i,id_fine) + . +(1-fracso2emis) + . *(lmt_so2ba(i)+lmt_so2nff(i))*1.e4* + . masse_ammsulfate/RNAVO ! g/m2/s +c + IF(id_prec>0) flux_tr(i,id_prec)=flux_tr(i,id_prec) + . + (lmt_h2sbio(i) + . +lmt_so2volc_cont(i)+lmt_so2volc_expl(i) + . +(lmt_so2ba(i)+lmt_so2nff(i))*fracso2emis + . +lmt_dms(i)+lmt_dmsbio(i) ) + . *1.e4/RNAVO*masse_s*1.e3 ! mgS/m2/s +c + IF(id_fine>0) flux_tr(i,id_fine)=flux_tr(i,id_fine) + . +(1-fracso2emis) + . *(lmt_so2ba(i) + lmt_so2nff(i)) + . *1.e4/RNAVO*masse_ammsulfate*1.e3 ! mgS/m2/s +c + flux_sparam_ind(i)=flux_sparam_ind(i)+ (1-fracso2emis) + . *lmt_so2nff(i) + . *1.e4/RNAVO*masse_ammsulfate*1.e3 ! mgS/m2/s +c + ENDDO + +c======================================================================== +c HIGH LEVEL EMISSIONS +c======================================================================== +c Source de SO2 volcaniques + DO i = 1, klon + kkk_cont(i)=1 + kkk_expl(i)=1 + ENDDO + DO k=1, klev-1 + DO i = 1, klon + zaltmid(i,k)=zalt(i,k)+zdz(i,k)/2. + IF (zalt(i,k+1).LT.lmt_altvolc_cont(i)) kkk_cont(i)=k+1 + IF (zalt(i,k+1).LT.lmt_altvolc_expl(i)) kkk_expl(i)=k+1 + ENDDO + ENDDO + IF(id_prec>0) THEN + DO i = 1, klon + tr_seri(i,kkk_cont(i),id_prec)=tr_seri(i,kkk_cont(i),id_prec) + + . lmt_so2volc_cont(i)/zdz(i,kkk_cont(i))/100.*pdtphys + tr_seri(i,kkk_expl(i),id_prec)=tr_seri(i,kkk_expl(i),id_prec) + + . lmt_so2volc_expl(i)/zdz(i,kkk_expl(i))/100.*pdtphys + ENDDO + ENDIF +c Sources hautes de SO2 + +c +c--only GEIA SO2 emissions has high emissions +c--unit: molec/cm2/s divided by layer height (in cm) multiplied by timestep +c + k=2 !introducing emissions in level 2 + DO i = 1, klon +c + IF (iregion_bb(i).GT.0) THEN + IF(id_prec>0) tr_seri(i,k,id_prec)= + . tr_seri(i,k,id_prec) + fracso2emis + . *scale_param_bb(iregion_bb(i))*lmt_so2bb_h(i) + . /zdz(i,k)/100.*pdtphys +c + IF(id_fine>0) tr_seri(i,k,id_fine)=tr_seri(i,k,id_fine) + . + (1.-fracso2emis) + . *scale_param_bb(iregion_bb(i))*lmt_so2bb_h(i) + . *masse_ammsulfate/RNAVO/zdz(i,k)/100.*pdtphys !g/cm3 + ENDIF + IF (iregion_ind(i).GT.0) THEN + IF(id_prec>0) tr_seri(i,k,id_prec)= + . tr_seri(i,k,id_prec) + (fracso2emis + . *scale_param_ind(iregion_ind(i))*lmt_so2ff_h(i) + . + frach2sofso2 + . *scale_param_ind(iregion_ind(i))*lmt_so2ff_h(i)) + . /zdz(i,k)/100.*pdtphys +c + IF(id_fine>0) tr_seri(i,k,id_fine)=tr_seri(i,k,id_fine) + . + (1.-fracso2emis) + . *scale_param_ind(iregion_ind(i))*lmt_so2ff_h(i) + . *masse_ammsulfate/RNAVO/zdz(i,k)/100.*pdtphys !g/cm3 + ENDIF +c + ENDDO + + END Index: /LMDZ5/trunk/libf/phylmd/Dust/read_dust.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/read_dust.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/read_dust.F (revision 2630) @@ -0,0 +1,84 @@ + SUBROUTINE read_dust(debutphy, step, nbjour, dust_ec) + USE dimphy + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + IMPLICIT NONE +c +#include "dimensions.h" +#include "paramet.h" +#include "netcdf.inc" +c + INTEGER step, nbjour + LOGICAL debutphy + real dust_ec(klon) + real dust_ec_glo(klon_glo) +c + real dust_nc(iip1,jjp1) + real dust_nc_glo(nbp_lon+1,nbp_lat) + real rcode + integer ncid1, varid1, ncid2, varid2 + + save ncid1, varid1, ncid2, varid2 +!$OMP THREADPRIVATE(ncid1, varid1, ncid2, varid2) + integer start(4),count(4), status + integer i, j, ig +c +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + if (debutphy) then +c + ncid1=NCOPN('dust.nc',NCNOWRIT,rcode) + varid1=NCVID(ncid1,'EMISSION',rcode) +c + endif +c + start(1)=1 + start(2)=1 + start(4)=0 + +! count(1)=iip1 + count(1)=nbp_lon+1 +! count(2)=jjp1 + count(2)=nbp_lat + count(3)=1 + count(4)=0 +c + start(3)=step +c +#ifdef NC_DOUBLE +! status=NF_GET_VARA_DOUBLE(ncid1,varid1,start,count,dust_nc) + status=NF_GET_VARA_DOUBLE(ncid1,varid1,start,count,dust_nc_glo) +#else +! status=NF_GET_VARA_REAL(ncid1,varid1,start,count,dust_nc) + status=NF_GET_VARA_REAL(ncid1,varid1,start,count,dust_nc_glo) +#endif +c +! call correctbid(iim,jjp1,dust_nc) + call correctbid(nbp_lon,nbp_lat,dust_nc_glo) +c +c--upside down + physical grid +c +c--OB=change jjp1 to 1 here +! dust_ec(1)=MAX(dust_nc(1,jjp1),0.0) + dust_ec(1)=MAX(dust_nc(1,nbp_lat),0.0) + ig=2 +! DO j=2,jjm + DO j=2,nbp_lat-1 +! DO i = 1, iim + DO i = 1, nbp_lon +c--OB=change jjp1+1-j to j here +! dust_ec(ig)=MAX(dust_nc(i,jjp1+1-j),0.0) + dust_ec_glo(ig)=MAX(dust_nc_glo(i,nbp_lat+1-j),0.0) + ig=ig+1 + ENDDO + ENDDO +c--OB=change second 1 to jjp1 here + dust_ec_glo(ig)=MAX(dust_nc_glo(1,1),0.0) +! end if master + ENDIF +!$OMP END MASTER +!$OMP BARRIER + CALL scatter(dust_ec_glo,dust_ec) +c + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/read_newemissions.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/read_newemissions.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/read_newemissions.F (revision 2630) @@ -0,0 +1,371 @@ +C Routine to read the emissions of the different species +C + subroutine read_newemissions(julien, jH_emi ,edgar, flag_dms, + I debutphy, + I pdtphys,lafinphy, nbjour, pctsrf, + I t_seri, xlat, xlon, + I pmflxr, pmflxs, prfl, psfl, + O u10m_ec, v10m_ec, dust_ec, + O lmt_sea_salt, lmt_so2ff_l, + O lmt_so2ff_h, lmt_so2nff, lmt_so2ba, + O lmt_so2bb_l, lmt_so2bb_h, + O lmt_so2volc_cont, lmt_altvolc_cont, + O lmt_so2volc_expl, lmt_altvolc_expl, + O lmt_dmsbio, lmt_h2sbio, lmt_dmsconc, + O lmt_bcff, lmt_bcnff, lmt_bcbb_l, + O lmt_bcbb_h, lmt_bcba, lmt_omff, + O lmt_omnff, lmt_ombb_l, lmt_ombb_h, + O lmt_omnat, lmt_omba) + + USE dimphy + USE indice_sol_mod + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + + IMPLICIT NONE + + +#include "dimensions.h" +c INCLUDE 'dimphy.h' + INCLUDE 'paramet.h' + INCLUDE 'chem.h' + INCLUDE 'chem_spla.h' +c INCLUDE 'indicesol.h' + + logical debutphy, lafinphy, edgar + INTEGER test_vent, test_day, step_vent, flag_dms, nbjour + INTEGER julien, i, iday + SAVE step_vent, test_vent, test_day, iday +!$OMP THREADPRIVATE(step_vent, test_vent, test_day, iday) + REAL pct_ocean(klon), pctsrf(klon,nbsrf) + REAL pdtphys ! pas d'integration pour la physique (seconde) + REAL t_seri(klon,klev) ! temperature + + REAL xlat(klon) ! latitudes pour chaque point + REAL xlon(klon) ! longitudes pour chaque point + +c +c Emissions: +c --------- +c +c---------------------------- SEA SALT & DUST emissions ------------------------ + REAL lmt_sea_salt(klon,ss_bins) !Sea salt 0.03-8.0 um !NOT SAVED OK + REAL clyfac, avgdryrate, drying +c je REAL u10m_ec1(klon), v10m_ec1(klon), dust_ec1(klon) +c je REAL u10m_ec2(klon), v10m_ec2(klon), dust_ec2(klon) + + REAL, SAVE, ALLOCATABLE :: u10m_ec1(:), v10m_ec1(:), dust_ec1(:) + REAL, SAVE, ALLOCATABLE :: u10m_ec2(:), v10m_ec2(:), dust_ec2(:) +!$OMP THREADPRIVATE(u10m_ec1, v10m_ec1, dust_ec1) +!$OMP THREADPRIVATE(u10m_ec2, v10m_ec2, dust_ec2) + REAL u10m_nc(iip1,jjp1), v10m_nc(iip1,jjp1) + REAL u10m_ec(klon), v10m_ec(klon), dust_ec(klon) +c REAL cly(klon), wth(klon), zprecipinsoil(klon) + REAL, SAVE, ALLOCATABLE :: cly(:), wth(:), zprecipinsoil(:) + REAL :: cly_glo(klon_glo), wth_glo(klon_glo) + REAL :: zprecipinsoil_glo(klon_glo) +!$OMP THREADPRIVATE(cly,wth,zprecipinsoil) + + +c je SAVE u10m_ec2, v10m_ec2, dust_ec2 +c je SAVE u10m_ec1, v10m_ec1, dust_ec1 ! Added on titane +c je SAVE cly, wth, zprecipinsoil ! Added on titane +! SAVE cly, wth, zprecipinsoil, u10m_ec2, v10m_ec2, dust_ec2 +c------------------------- BLACK CARBON emissions ---------------------- + REAL lmt_bcff(klon) ! emissions de BC fossil fuels + REAL lmt_bcnff(klon) ! emissions de BC non-fossil fuels + REAL lmt_bcbb_l(klon) ! emissions de BC biomass basses + REAL lmt_bcbb_h(klon) ! emissions de BC biomass hautes + REAL lmt_bcba(klon) ! emissions de BC bateau +c------------------------ ORGANIC MATTER emissions --------------------- + REAL lmt_omff(klon) ! emissions de OM fossil fuels + REAL lmt_omnff(klon) ! emissions de OM non-fossil fuels + REAL lmt_ombb_l(klon) ! emissions de OM biomass basses + REAL lmt_ombb_h(klon) ! emissions de OM biomass hautes + REAL lmt_omnat(klon) ! emissions de OM Natural + REAL lmt_omba(klon) ! emissions de OM bateau +c------------------------- SULFUR emissions ---------------------------- + REAL lmt_so2ff_l(klon) ! emissions so2 fossil fuels (low) + REAL lmt_so2ff_h(klon) ! emissions so2 fossil fuels (high) + REAL lmt_so2nff(klon) ! emissions so2 non-fossil fuels + REAL lmt_so2bb_l(klon) ! emissions de so2 biomass burning basse + REAL lmt_so2bb_h(klon) ! emissions de so2 biomass burning hautes + REAL lmt_so2ba(klon) ! emissions de so2 bateau + REAL lmt_so2volc_cont(klon) ! emissions so2 volcan continuous + REAL lmt_altvolc_cont(klon) ! altitude so2 volcan continuous + REAL lmt_so2volc_expl(klon) ! emissions so2 volcan explosive + REAL lmt_altvolc_expl(klon) ! altitude so2 volcan explosive + REAL lmt_dmsconc(klon) ! concentration de dms oceanique + REAL lmt_dmsbio(klon) ! emissions de dms bio + REAL lmt_h2sbio(klon) ! emissions de h2s bio + + REAL,SAVE,ALLOCATABLE :: lmt_dms(:) ! emissions de dms +!$OMP THREADPRIVATE(lmt_dms) +c +c Lessivage +c --------- +c + REAL pmflxr(klon,klev+1), pmflxs(klon,klev+1) !--convection + REAL prfl(klon,klev+1), psfl(klon,klev+1) !--large-scale +! REAL pmflxr(klon,klev), pmflxs(klon,klev) !--convection +! REAL prfl(klon,klev), psfl(klon,klev) !--large-scale +c +c Variable interne +c ---------------- +c + INTEGER icount + REAL tau_1, tau_2 + REAL max_flux, min_flux + INTRINSIC MIN, MAX +c +c JE: Changes due to new pdtphys in new physics. +c REAL windintime ! time in hours of the wind input files resolution +c REAL dayemintime ! time in hours of the other emissions input files resolution + REAL jH_init ! shift in the hour (count as days) respecto to +! ! realhour = (pdtphys*i)/3600/24 -days_elapsed + REAL jH_emi,jH_vent,jH_day + SAVE jH_init,jH_vent,jH_day +!$OMP THREADPRIVATE(jH_init,jH_vent,jH_day) + REAL,PARAMETER :: vent_resol = 6. ! resolution of winds in hours + REAL,PARAMETER :: day_resol = 24. ! resolution of daily emmis. in hours +! INTEGER test_day1 +! SAVE test_day1 +! REAL tau_1j,tau_2j +c je +c allocate if necessary +c + + IF (.NOT. ALLOCATED(u10m_ec1)) ALLOCATE(u10m_ec1(klon)) + IF (.NOT. ALLOCATED(v10m_ec1)) ALLOCATE(v10m_ec1(klon)) + IF (.NOT. ALLOCATED(dust_ec1)) ALLOCATE(dust_ec1(klon)) + IF (.NOT. ALLOCATED(u10m_ec2)) ALLOCATE(u10m_ec2(klon)) + IF (.NOT. ALLOCATED(v10m_ec2)) ALLOCATE(v10m_ec2(klon)) + IF (.NOT. ALLOCATED(dust_ec2)) ALLOCATE(dust_ec2(klon)) + IF (.NOT. ALLOCATED(cly)) ALLOCATE(cly(klon)) + IF (.NOT. ALLOCATED(wth)) ALLOCATE(wth(klon)) + IF (.NOT. ALLOCATED(zprecipinsoil)) ALLOCATE(zprecipinsoil(klon)) + IF (.NOT. ALLOCATED(lmt_dms)) ALLOCATE(lmt_dms(klon)) +c end je nov2013 +c +C*********************************************************************** +C DUST EMISSIONS +C*********************************************************************** +c + IF (debutphy) THEN +C---Fields are read only at the beginning of the period +c--reading wind and dust + iday=julien + step_vent=1 + test_vent=0 + test_day=0 + CALL read_vent(.true.,step_vent,nbjour,u10m_ec2,v10m_ec2) + print *,'Read (debut) dust emissions: step_vent,julien,nbjour', + . step_vent,julien,nbjour + CALL read_dust(.true.,step_vent,nbjour,dust_ec2) +C Threshold velocity map +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + zprecipinsoil_glo(:)=0.0 + OPEN(51,file='wth.dat',status='unknown',form='formatted') + READ(51,'(G18.10)') (wth_glo(i),i=1,klon_glo) + CLOSE(51) +c Clay content + OPEN(52,file='cly.dat',status='unknown',form='formatted') + READ(52,'(G18.10)') (cly_glo(i),i=1,klon_glo) + CLOSE(52) + OPEN(53,file='precipinsoil.dat', + . status='old',form='formatted',err=999) + READ(53,'(G18.10)') (zprecipinsoil_glo(i),i=1,klon_glo) + PRINT *,'lecture precipinsoil.dat' + 999 CONTINUE + CLOSE(53) + ENDIF +!$OMP END MASTER +!$OMP BARRIER + call scatter(wth_glo,wth) + call scatter(cly_glo,cly) + call scatter(zprecipinsoil_glo,zprecipinsoil) + +!JE20140908<< GOTO 1000 +! DO i=1, klon +! zprecipinsoil(i)=0.0 +! ENDDO +! 1000 CLOSE(53) +!JE20140908>> + jH_init=jH_emi + jH_vent=jH_emi + jH_day=jH_emi +! test_day1=0 +!JE end +c + + ENDIF !--- debutphy + + print *,'READ_EMISSION: test_vent & test_day = ',test_vent, + + test_day + IF (test_vent.EQ.0) THEN !--on lit toutes les 6 h + CALL SCOPY(klon, u10m_ec2, 1, u10m_ec1, 1) + CALL SCOPY(klon, v10m_ec2, 1, v10m_ec1, 1) + CALL SCOPY(klon, dust_ec2, 1, dust_ec1, 1) + step_vent=step_vent+1 + !PRINT *,'step_vent=', step_vent + CALL read_vent(.false.,step_vent,nbjour,u10m_ec2,v10m_ec2) + print *,'Reading dust emissions: step_vent, julien, nbjour ', + . step_vent, julien, nbjour + !print *,'test_vent, julien = ',test_vent, julien + CALL read_dust(.false.,step_vent,nbjour,dust_ec2) + + ENDIF !--test_vent + +c ubicacion original +c test_vent=test_vent+1 +c IF (test_vent.EQ.(6*2)) test_vent=0 !on remet a zero ttes les 6 h + +!JE tau_2=FLOAT(test_vent)/12. +!JE tau_1=1.-tau_2 + tau_2=(jH_vent-jH_init)*24./(vent_resol) + tau_1=1.-tau_2 +! print*,'JEdec jHv,JHi,ventres',jH_vent,jH_init,vent_resol +! print*,'JEdec tau2,tau1',tau_2,tau_1 +! print*,'JEdec step_vent',step_vent + DO i=1, klon +! PRINT*,'JE tau_2,tau_2j',tau_2,tau_2j + u10m_ec(i)=tau_1*u10m_ec1(i)+tau_2*u10m_ec2(i) + v10m_ec(i)=tau_1*v10m_ec1(i)+tau_2*v10m_ec2(i) + dust_ec(i)=tau_1*dust_ec1(i)+tau_2*dust_ec2(i) + ENDDO +c +cJE IF (test_vent.EQ.(6*2)) THEN +cJE PRINT *,'6 hrs interval reached' +cJE print *,'day in read_emission, test_vent = ',julien, test_vent +cJE ENDIF +cJE +!JE test_vent=test_vent+1 +!JE IF (test_vent.EQ.(6*2)) test_vent=0 !on remet a zero ttes les 6 h +c JE + jH_vent=jH_vent+pdtphys/(24.*3600.) + test_vent=test_vent+1 + IF (jH_vent.GT.(vent_resol)/24.) THEN + test_vent=0 + jH_vent=jH_init + ENDIF +! PRINT*,'JE test_vent,test_vent1,jH_vent ', test_vent,test_vent1 +! . ,jH_vent +c endJEi +c + avgdryrate=300./365.*pdtphys/86400. +c + DO i=1, klon +c + IF (cly(i).LT.9990..AND.wth(i).LT.9990.) THEN + zprecipinsoil(i)=zprecipinsoil(i) + + . (pmflxr(i,1)+pmflxs(i,1)+prfl(i,1)+psfl(i,1))*pdtphys +c + clyfac=MIN(16., cly(i)*0.4+8.) ![mm] max amount of water hold in top soil + drying=avgdryrate*exp(0.03905491* + . exp(0.17446*(t_seri(i,1)-273.15))) ! [mm] + zprecipinsoil(i)=min(max(0.,zprecipinsoil(i)-drying),clyfac) ! [mm] + ENDIF +! zprecipinsoil(i)=0.0 ! Temporarely introduced to reproduce obelix result + ENDDO + +! print *,'cly = ',sum(cly),maxval(cly),minval(cly) +! print *,'wth = ',sum(wth),maxval(wth),minval(wth) +! print *,'t_seri = ',sum(t_seri),maxval(t_seri),minval(t_seri) +! print *,'precipinsoil = ',sum(zprecipinsoil),maxval(zprecipinsoil) +! . ,minval(zprecipinsoil) + icount=0 + DO i=1, klon + IF (cly(i).GE.9990..OR.wth(i).GE.9990..OR. + . t_seri(i,1).LE.273.15.OR.zprecipinsoil(i).GT.1.e-8) THEN + dust_ec(i)=0.0 ! commented out for test dustemtest +! print *,'Dust emissions surpressed at grid = ',i +! icount=icount+1 + ENDIF + ENDDO +c + print *,'Total N of grids with surpressed emission = ',icount + print *,'dust_ec = ',SUM(dust_ec),MINVAL(dust_ec), + . MAXVAL(dust_ec) +cnhl Transitory scaling of desert dust emissions + +cnhl DO i=1, klon +cnhl dust_ec(i)=dust_ec(i)/2. +cnhl ENDDO + +C-saving precipitation field to be read in next simulation + + IF (lafinphy) THEN +c + CALL gather(zprecipinsoil,zprecipinsoil_glo) +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + + OPEN(53,file='newprecipinsoil.dat', + . status='unknown',form='formatted') + WRITE(53,'(G18.10)') (zprecipinsoil_glo(i),i=1,klon_glo) + CLOSE(53) + ENDIF +!$OMP END MASTER +!$OMP BARRIER +c + ENDIF +c +C*********************************************************************** +C SEA SALT EMISSIONS +C*********************************************************************** +c + DO i=1,klon + pct_ocean(i)=pctsrf(i,is_oce) + ENDDO + + print *,'IS_OCE = ',is_oce + CALL seasalt(v10m_ec, u10m_ec, pct_ocean, lmt_sea_salt) !mgSeaSalt/cm2/s +! print *,'SUM, MAX & MIN Sea Salt = ',SUM(lmt_sea_salt), +! . MAXVAL(lmt_sea_salt),MINVAL(lmt_sea_salt) +c +C*********************************************************************** +C SULFUR & CARBON EMISSIONS +C*********************************************************************** +c + + IF (test_day.EQ.0) THEN + print *,'Computing SULFATE emissions for day : ',iday,julien, + . step_vent + CALL condsurfs_new(iday, edgar, flag_dms, + O lmt_so2ff_l, lmt_so2ff_h, lmt_so2nff, + O lmt_so2bb_l, lmt_so2bb_h, lmt_so2ba, + O lmt_so2volc_cont, lmt_altvolc_cont, + O lmt_so2volc_expl, lmt_altvolc_expl, + O lmt_dmsbio, lmt_h2sbio, lmt_dms,lmt_dmsconc) + print *,'Computing CARBON emissions for day : ',iday,julien, + . step_vent + CALL condsurfc_new(iday, + O lmt_bcff,lmt_bcnff,lmt_bcbb_l,lmt_bcbb_h, + O lmt_bcba,lmt_omff,lmt_omnff,lmt_ombb_l, + O lmt_ombb_h, lmt_omnat, lmt_omba) + print *,'IDAY = ',iday + iday=iday+1 + print *,'BCBB_L emissions :',SUM(lmt_bcbb_l), MAXVAL(lmt_bcbb_l) + . ,MINVAL(lmt_bcbb_l) + print *,'BCBB_H emissions :',SUM(lmt_bcbb_h), MAXVAL(lmt_bcbb_h) + . ,MINVAL(lmt_bcbb_h) + ENDIF + +!JE test_day=test_day+1 +!JE IF (test_day.EQ.(24*2.)) THEN +!JE test_day=0 !on remet a zero ttes les 24 h +!JE print *,'LAST TIME STEP OF DAY ',julien +!JE ENDIF + + + jH_day=jH_day+pdtphys/(24.*3600.) + test_day=test_day+1 + IF (jH_day.GT.(day_resol)/24.) THEN + print *,'LAST TIME STEP OF DAY ',julien + test_day=0 + jH_day=jH_init + ENDIF +! PRINT*,'test_day,test_day1',test_day,test_day1 + + END Index: /LMDZ5/trunk/libf/phylmd/Dust/read_surface.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/read_surface.F90 (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/read_surface.F90 (revision 2630) @@ -0,0 +1,164 @@ + subroutine read_surface(name,surfa) + + +! common +! ------ + USE ioipsl +! USE comgeomphy + USE dimphy + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para + USE iophy +! USE netcdf + IMPLICIT NONE + + include "netcdf.inc" +#include "dimensions.h" +#include "paramet.h" + + character*10 name + character*10 varname +! + real tmp_dyn(iip1,jjp1) + real tmp_dyn_glo(nbp_lon+1,nbp_lat) +! real tmp_dyn_glo(nbp_lon,nbp_lat) + REAL tmp_dyn_invers(iip1,jjp1) + real tmp_dyn_invers_glo(nbp_lon+1,nbp_lat) +! real tmp_dyn_invers_glo(nbp_lon,nbp_lat) + real tmp_fi(klon) + real tmp_fi_glo(klon_glo) + real surfa(klon,5) + real surfa_glo(klon_glo,5) +! + integer ncid + integer varid + real rcode + integer start(2),count(2),status + integer i,j,l,ig + character*1 str1 + +!JE20140526<< + character*4 :: latstr,aux4s + logical :: outcycle, isinversed + real, dimension(jjp1) :: lats + real, dimension(nbp_lat) :: lats_glo + real :: rcode2 + integer, dimension(1) :: startj,endj +!JE20140526>> +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + + print*,'Lecture du fichier donnees_lisa.nc' + ncid=NCOPN('donnees_lisa.nc',NCNOWRIT,rcode) + +!JE20140526<<: check if are inversed or not the latitude grid in donnes_lisa + outcycle=.false. + latstr='null' + isinversed=.false. + do i=1,5 + if (i==1) aux4s='latu' + if (i==2) aux4s='LATU' + if (i==3) aux4s='LatU' + if (i==4) aux4s='Latu' + if (i==5) aux4s='latU' + status = NF_INQ_VARID (ncid, aux4s, rcode) +! print *,'stat,i',status,i,outcycle,aux4s +! print *,'ifclause',status.NE. NF_NOERR ,outcycle == .false. + IF ((.not.(status.NE. NF_NOERR) ).and.( .not. outcycle )) THEN + outcycle=.true. + latstr=aux4s + ENDIF + enddo ! check if it inversed lat + startj(1)=1 +! endj(1)=jjp1 + endj(1)=nbp_lat + varid=NCVID(ncid,latstr,rcode) + +#ifdef NC_DOUBLE + status=NF_GET_VARA_DOUBLE(ncid,varid,startj,endj,lats_glo) +#else + status=NF_GET_VARA_REAL(ncid,varid,startj,endj,lats_glo) +#endif +! print *,latstr,varid,status,jjp1,rcode +! IF (status .NE. NF_NOERR) print*,'NOOOOOOO' +! print *,lats +!stop + +! check if netcdf is latitude inversed or not. + if (lats_glo(1)> + + + DO i=1,5 + write(str1,'(i1)') i + varname=trim(name)//str1 + print*,'lecture variable:',varname + varid=NCVID(ncid,trim(varname),rcode) +! varid=NCVID(ncid,varname,rcode) + +! dimensions pour les champs scalaires et le vent zonal +! ----------------------------------------------------- + + start(1)=1 + start(2)=1 + count(1)=nbp_lon+1 +! count(1)=iip1 + count(2)=nbp_lat +! count(2)=jjp1 + +! mise a zero des tableaux +! ------------------------ + tmp_dyn(:,:)=0.0 + tmp_fi(:)=0.0 +! Lecture +! ----------------------- +#ifdef NC_DOUBLE + status=NF_GET_VARA_DOUBLE(ncid,varid,start,count,tmp_dyn_glo) +#else + status=NF_GET_VARA_REAL(ncid,varid,start,count,tmp_dyn_glo) +#endif + +! call dump2d(iip1,jjp1,tmp_dyn,'tmp_dyn ') + DO j=1, nbp_lat + DO ig=1, nbp_lon+1 + tmp_dyn_invers_glo(ig,j)=tmp_dyn_glo(ig,nbp_lat-j+1) + ENDDO + ENDDO + + +!JE20140522! call gr_dyn_fi_p(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi) + +!JE20140526<< +! call gr_dyn_fi(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi) + if (isinversed) then + call gr_dyn_fi(1, nbp_lon+1, nbp_lat, klon_glo, & + & tmp_dyn_invers_glo, tmp_fi_glo) +! call gr_dyn_fi(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi) +! call gr_dyn_fi_p(1, iip1, jjp1, klon, tmp_dyn_invers, tmp_fi) + else + call gr_dyn_fi(1, nbp_lon+1, nbp_lat, klon_glo, & + & tmp_dyn_glo, tmp_fi_glo) +! call gr_dyn_fi(1, iip1, jjp1, klon, tmp_dyn, tmp_fi) +! call gr_dyn_fi_p(1, iip1, jjp1, klon, tmp_dyn, tmp_fi) + endif +!JE20140526>> +! call dump2d(iim,jjm-1,tmp_fi(2),'tmp_fi ') +! + DO j=1,klon_glo + + surfa_glo(j,i)=tmp_fi_glo(j) + + ENDDO ! Fin de recopie du tableau +! + ENDDO ! Fin boucle 1 a 5 + print*,'Passage Grille Dyn -> Phys' + + + ENDIF !mpi +!$OMP END MASTER +!$OMP BARRIER + call scatter(surfa_glo,surfa) + + + return + end subroutine read_surface Index: /LMDZ5/trunk/libf/phylmd/Dust/read_vent.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/read_vent.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/read_vent.F (revision 2630) @@ -0,0 +1,145 @@ + SUBROUTINE read_vent(debutphy, step, nbjour, u10m_ec, v10m_ec) + USE dimphy + USE mod_grid_phy_lmdz + USE mod_phys_lmdz_para +! USE write_field_phy + IMPLICIT NONE +#include "dimensions.h" +c #include "dimphy.h" +#include "paramet.h" +#include "netcdf.inc" +c + INTEGER step, nbjour + LOGICAL debutphy + real u10m_ec(klon), v10m_ec(klon) + real u10m_ec_glo(klon_glo), v10m_ec_glo(klon_glo) +c +! real u10m_nc(iip1,jjp1) !, v10m_nc(iip1,jjm) ! dim 97x72 +! real v10m_nc(iip1,jjp1) ! dim 97x73 + real u10m_nc_glo(nbp_lon+1,nbp_lat) !, v10m_nc(iip1,jjm) ! dim 97x72 + real v10m_nc_glo(nbp_lon+1,nbp_lat) ! dim 97x73 + real rcode + integer ncidu1, varidu1, ncidv1, varidv1 + save ncidu1, varidu1, ncidv1, varidv1 +!$OMP THREADPRIVATE(ncidu1, varidu1, ncidv1, varidv1) + integer start(4),count(4), status + integer i, j, ig + + +c +!$OMP MASTER + IF (is_mpi_root .AND. is_omp_root) THEN + if (debutphy) then +c + ncidu1=NCOPN('u10m.nc',NCNOWRIT,rcode) + varidu1=NCVID(ncidu1,'UWND',rcode) + ncidv1=NCOPN('v10m.nc',NCNOWRIT,rcode) + varidv1=NCVID(ncidv1,'VWND',rcode) +c + endif +c + start(1)=1 + start(2)=1 + start(4)=0 + +! count(1)=iip1 + count(1)=nbp_lon+1 +! count(2)=jjp1 + count(2)=nbp_lat + count(3)=1 + count(4)=0 +c + start(3)=step +c +#ifdef NC_DOUBLE +! status=NF_GET_VARA_DOUBLE(ncidu1,varidu1,start,count,u10m_nc) + status=NF_GET_VARA_DOUBLE(ncidu1,varidu1,start,count,u10m_nc_glo) +#else +! status=NF_GET_VARA_REAL(ncidu1,varidu1,start,count,u10m_nc) + status=NF_GET_VARA_REAL(ncidu1,varidu1,start,count,u10m_nc_glo) +#endif +! print *,status +c +#ifdef NC_DOUBLE +! status=NF_GET_VARA_DOUBLE(ncidv1,varidv1,start,count,v10m_nc) + status=NF_GET_VARA_DOUBLE(ncidv1,varidv1,start,count,v10m_nc_glo) +#else +! status=NF_GET_VARA_REAL(ncidv1,varidv1,start,count,v10m_nc) + status=NF_GET_VARA_REAL(ncidv1,varidv1,start,count,v10m_nc_glo) +#endif +c + +! print *,'beforebidcor u10m_nc', u10m_nc(1,jjp1) +! print *,'beforebidcor v10m_nc', v10m_nc(1,jjp1) + +! print *,status +! call correctbid(iim,jjp1,u10m_nc) +! call correctbid(iim,jjp1,v10m_nc) + call correctbid(nbp_lon,nbp_lat,u10m_nc_glo) + call correctbid(nbp_lon,nbp_lat,v10m_nc_glo) + +! print *,'afterbidcor u10m_nc', u10m_nc(1,jjp1) +! print *,'afterbidcor v10m_nc', v10m_nc(1,jjp1) +c +c--upside down + physical grid +c +! u10m_ec(1)=u10m_nc(1,jjp1) +! v10m_ec(1)=v10m_nc(1,jjp1) + u10m_ec_glo(1)=u10m_nc_glo(1,nbp_lat) + v10m_ec_glo(1)=v10m_nc_glo(1,nbp_lat) + ig=2 +! DO j=2,jjm +! DO i = 1, iim + DO j=2,nbp_lat-1 + DO i = 1, nbp_lon +! u10m_ec(ig)=u10m_nc(i,jjp1+1-j) +! v10m_ec(ig)=v10m_nc(i,jjp1+1-j) + u10m_ec_glo(ig)=u10m_nc_glo(i,nbp_lat+1-j) + v10m_ec_glo(ig)=v10m_nc_glo(i,nbp_lat+1-j) + ig=ig+1 +! print *,u10m_ec(ig) ,v10m_ec(ig) + ENDDO + ENDDO + u10m_ec_glo(ig)=u10m_nc_glo(1,1) + v10m_ec_glo(ig)=v10m_nc_glo(1,1) + + +! end if master + ENDIF +!$OMP END MASTER +!$OMP BARRIER + CALL scatter(u10m_ec_glo,u10m_ec) + CALL scatter(v10m_ec_glo,v10m_ec) + +! print *,'JE tamagno viento ig= ', ig +! print *,'READ_VENT U = ',SUM(u10m_ec),MINVAL(u10m_ec), +! . MAXVAL(u10m_ec) +! print *,'READ_VENT V = ',SUM(v10m_ec),MINVAL(v10m_ec), +! . MAXVAL(v10m_ec) +! print *,'u v 1 ', u10m_ec(1),v10m_ec(1) +! print *,'u v klon ', u10m_ec(klon),v10m_ec(klon) + RETURN + END + +c added by JE from the nh SPLA, dyn3d/read_reanalyse.F which is not available any more + subroutine correctbid(iim,nl,x) + integer iim,nl + real x(iim+1,nl) + integer i,l + real zz + + do l=1,nl + do i=2,iim-1 + if(abs(x(i,l)).gt.1.e10) then + zz=0.5*(x(i-1,l)+x(i+1,l)) +c print*,'correction ',i,l,x(i,l),zz + x(i,l)=zz + endif + enddo + enddo + + return + end + + + Index: /LMDZ5/trunk/libf/phylmd/Dust/satellite_out_spla.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/satellite_out_spla.F90 (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/satellite_out_spla.F90 (revision 2630) @@ -0,0 +1,192 @@ + +SUBROUTINE satellite_out_spla(jD_cur,jH_cur,pdtphys,rlat,rlon, & + masque_aqua, masque_terra ) + + USE dimphy + USE IOIPSL + USE write_field_phy + + IMPLICIT NONE + + REAL :: pdtphys, jD_cur,jH_cur, hour + INTEGER :: year_cur, mth_cur, day_cur + INTEGER :: masque_polder(klon) ! masque polder + INTEGER :: masque_aqua(klon) ! masque polder + INTEGER :: masque_terra(klon) ! masque polder + INTEGER :: i + REAL :: overpassaqua, overpassterra + REAL,dimension(klon) :: rlat,rlon + + + masque_polder(:) = 0. + + CALL ju2ymds(jD_cur+jH_cur, year_cur, mth_cur, day_cur, hour) +! print*,'JDcur=',jD_cur,'JHcur=',jH_cur,'year_cur' ,year_cur,'mth_cur' ,mth_cur, 'day_cur',day_cur,'hour' ,hour + +! IF ( (year_cur*100.+mth_cur .GE. 199611 ) .AND. (year_cur*100.+mth_cur .LE. 199706)) THEN +! CALL swathpolder(year_cur,mth_cur,day_cur,hour/86400., & +! pdtphys,rlon,rlat,masque_polder) +! ENDIF +! +! DO i=1,klon +! IF ( masque_polder(i) .EQ. 1 ) THEN +! print *,'polder output point, lon:', rlon(i),', lat: ',rlat(i) +! ENDIF +! ENDDO +! CALL writefield_phy("masque_polder",float(masque_polder),1) + +! Aqua + masque_aqua(:) = 0. + overpassaqua=48600. ! 13.30 p.m. local time + CALL swathpolarsat(year_cur,mth_cur,day_cur,hour, & + pdtphys,rlon,rlat,overpassaqua,masque_aqua) + +! DO i=1,klon +! IF ( masque_aqua(i) .EQ. 1 ) THEN +! print *,'aqua output point, lon:', rlon(i),', lat: ',rlat(i) +! ENDIF +! ENDDO +! CALL writefield_phy("masque_aqua",float(masque_aqua),1) + + masque_terra(:) = 0. + overpassterra=37800. ! 10.30 a.m. local time + CALL swathpolarsat(year_cur,mth_cur,day_cur,hour, & + pdtphys,rlon,rlat,overpassterra,masque_terra) + +! DO i=1,klon +! IF ( masque_terra(i) .EQ. 1 ) THEN +! print *,'terra output point, lon:', rlon(i),', lat: ',rlat(i) +! ENDIF +! ENDDO +! CALL writefield_phy("masque_terra",float(masque_terra),1) + + RETURN +END SUBROUTINE satellite_out_spla + + + + +SUBROUTINE swathpolarsat(annee,mois,jour,heure,pdtphys, & + rlon,rlat,overpasstime,masque) + ! Adaptation from the simple satellite simulator of AeroCom working group Indirect + ! forcing ( Johannes Quaas, MPI for Meteorology, Hamburg ) + ! http://wiki.esipfed.org/index.php/Indirect_forcing + + USE dimphy + IMPLICIT NONE + + INTEGER :: annee, mois, jour, i + REAL :: heure !--heure en jour + REAL :: pdtphys !--pas de temps en seconde + REAL :: rlon(1:klon), rlat(1:klon) !--longitude et latitude + INTEGER :: masque(1:klon) + REAL :: localtime(1:klon) + REAL :: overpasstime, utctime + + masque(:) = 0 + utctime=heure + DO i=1,klon + localtime(i) = utctime + 240. * rlon(i) ! for each degree of longitude east,4 min earlier local time +! IF ( localtime(i) > 86400. ) THEN ! this is still the previous day +! localtime(i) = localtime(i) - 86400. +! ENDIF + ! Select 10.30 a.m. ± dt/2 +! IF ( ABS( localtime(i) - overpasstime ) <= pdtphys/2. ) THEN + IF ( ABS(MOD(localtime(i)+86400.*100,86400.) - overpasstime ) <= pdtphys/2. ) THEN + masque(i) = 1 + ENDIF + ENDDO + + +END SUBROUTINE swathpolarsat + +SUBROUTINE swathpolder(annee,mois,jour,heure,pdtphys, & + rlon,rlat,masque) +! Adapted from INCA + +! USE inca_dim + USE dimphy + IMPLICIT NONE + + !--Auteurs : Francois-Marie Breon + Olivier Boucher + + !-- adapted to be used in INCA aerosol module Michael Schulz + + ! not needed? + + INTEGER :: annee, mois, jour + REAL :: heure !--heure en jour + REAL :: pdtphys !--pas de temps en seconde + REAL :: rlon(1:klon), rlat(1:klon) !--longitude et latitude + INTEGER :: masque(1:klon) + + REAL :: J0 !--origine des temps pour les orbites ADEOS + PARAMETER (J0=183.91267) + REAL :: secinday + PARAMETER (secinday=86400.) + REAL :: duree_orb !--Duree d une orbite ADEOS en jour + PARAMETER (duree_orb=6055.3715/secinday) + REAL :: deltalon !--Decalage en longitude entre 2 orbites successives + PARAMETER (deltalon=41./585.*360.) + REAL :: demi_larg_eq !--demi-largeur d'une orbite a l equateur + PARAMETER (demi_larg_eq=11.) + REAL :: incli, inclideg + PARAMETER (inclideg=98.59) + REAL :: RADEG, DTOR, RPI + REAL :: demi_periode + INTEGER :: jacum(1:12) + DATA jacum/0,31,59,90,120,151,181,212,243,273,304,334/ + INTEGER :: an, orb, i, j + REAL :: timepolder, lon0, posnorm, lim_nord, lim_sud + REAL :: tempo, lon_cen, demi_larg + REAL :: lat_debut, lat_fin, lon_west, lon_east + REAL :: zlon !--rlon mais remis entre 0 et 360 + REAL :: deltat !--plage de temps a considerer en jours + + + RPI = 4 * atan (1.0) + deltat=pdtphys/secinday + demi_periode=deltat/2./duree_orb + RADEG=180./RPI + DTOR=RPI/180. + incli=inclideg*DTOR + + an = MOD(annee, 100) + timepolder=FLOAT((an-96)*365+jacum(mois)+jour)+heure + orb=INT((timepolder-J0)/duree_orb+0.5) + lon0=360.-MOD(168.02+FLOAT(orb)*deltalon,360.) + posnorm=(timepolder-j0)/duree_orb-FLOAT(orb) + j=jacum(mois)+jour + lim_nord=60.5 + 25.*(1.-COS((FLOAT(J)+10.)/365.*2.*RPI)) + lim_sud=-53.0 - 20.*(1.+COS(FLOAT(J)/365.*2*RPI)) + !--lat de debut + lat_debut=MIN(MIN(90.,(-posnorm+demi_periode)*360.),lim_nord) + !--lat de fin + lat_fin =MAX(MAX(-90.,(-posnorm-demi_periode)*360.),lim_sud) + + DO i=1, klon + masque(i)=0 + tempo=ASIN( MAX(-1.,MIN(1., -SIN(rlat(i)*DTOR)/SIN(incli)))) + lon_cen=(ATAN(TAN(tempo)*COS(incli))-duree_orb*tempo)*RADEG + demi_larg=demi_larg_eq/COS(rlat(i)*DTOR) + IF (ABS(SIN(rlat(i)*DTOR)/SIN(incli)).GE.1.0) demi_larg=200.0 + IF (rlat(i).GE.lat_fin.AND.rlat(i).LE.lat_debut) THEN + IF (demi_larg.GE. 180.) THEN + masque(i)=1 + ELSE + lon_west = MOD(lon0+lon_cen-demi_larg+720., 360.) + lon_east = MOD(lon0+lon_cen+demi_larg, 360.) + zlon = MOD(rlon(i)+360., 360.) + IF (lon_west.LE.lon_east) THEN + IF (zlon.GE.lon_west.AND.zlon.LE.lon_east) masque(i)=1 + ELSE + IF (zlon.GE.lon_west.OR.zlon.LE.lon_east) masque(i)=1 + ENDIF + ENDIF + ENDIF + ENDDO + + RETURN +END SUBROUTINE swathpolder + + Index: /LMDZ5/trunk/libf/phylmd/Dust/seasalt.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/seasalt.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/seasalt.F (revision 2630) @@ -0,0 +1,52 @@ +c This subroutine estimateis Sea Salt emission fluxes over +c Oceanic surfaces. +c + SUBROUTINE seasalt(v_10m, u_10m, pct_ocean, lmt_sea_salt) + + USE dimphy + IMPLICIT NONE +c +#include "dimensions.h" +#include "chem.h" +#include "chem_spla.h" +#include "YOMCST.h" +#include "YOECUMF.h" +c + INTEGER i, bin !local variables + REAL pct_ocean(klon) !hfraction of Ocean in each grid + REAL v_10m(klon), u_10m(klon) !V&H components of wind @10 m + REAL w_speed_10m(klon) !wind speed at 10m from surface + REAL lmt_sea_salt(klon,ss_bins)!sea salt emission flux - mg/m2/s + REAL sea_salt_flux(ss_bins) !sea salt emission flux per unit wind speed + + REAL wind, ocean +c +c------Sea salt emission fluxes for each size bin calculated +c------based on on parameterisation of Gong et al. (1997). +c------Fluxes of sea salt for each size bin are given in mg/m^2/sec +c------at wind speed of 1 m/s at 10m height (at 80% RH). +c------Fluxes at various wind speeds (@10 m from sea +c------surfaces are estimated using relationship: F=flux*U_10^3.14 +c +cnhl for size bin of 0.03-0.5 and 0.5-20 + DATA sea_salt_flux/4.5E-09,8.7E-7/ + + DO i=1, klon + w_speed_10m(i)= (v_10m(i)**2.0+u_10m(i)**2.0)**0.5 + ENDDO +c + DO bin=1,ss_bins + wind=0.0 + ocean=0.0 + DO i=1, klon + lmt_sea_salt(i,bin)=sea_salt_flux(bin)*(w_speed_10m(i)**3.41) + . *pct_ocean(i)*1.e-4*1.e-3 !g/cm2/s + wind=wind+w_speed_10m(i) + ocean=ocean+pct_ocean(i) + ENDDO +! print *,'Sea Salt flux = ',sea_salt_flux(bin) + ENDDO +! print *,'SUM OF WIND = ',wind +! print *,'SUM OF OCEAN SURFACE = ',ocean + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/sediment_mod.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/sediment_mod.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/sediment_mod.F (revision 2630) @@ -0,0 +1,341 @@ +c----- This subroutine calculates the sedimentation flux of Tracers +c + SUBROUTINE sediment_mod(t_seri,pplay,zrho,paprs,time_step,RHcl, + . id_coss,id_codu,id_scdu, + . ok_chimeredust, + . sed_ss,sed_dust,sed_dustsco, + . sed_ss3D,sed_dust3D,sed_dustsco3D,tr_seri) +cnhl . xlon,xlat, +c + USE dimphy + USE infotrac + IMPLICIT NONE +c +#include "dimensions.h" +#include "chem.h" +c #include "dimphy.h" +#include "YOMCST.h" +#include "YOECUMF.h" +c + REAL RHcl(klon,klev) ! humidite relative ciel clair + REAL tr_seri(klon, klev,nbtr) !conc of tracers + REAL sed_ss(klon) !sedimentation flux of Sea Salt (g/m2/s) + REAL sed_dust(klon) !sedimentation flux of dust (g/m2/s) + REAL sed_dustsco(klon) !sedimentation flux of scoarse dust (g/m2/s) + REAL sed_ss3D(klon,klev) !sedimentation flux of Sea Salt (g/m2/s) + REAL sed_dust3D(klon,klev) !sedimentation flux of dust (g/m2/s) + REAL sed_dustsco3D(klon,klev) !sedimentation flux of scoarse dust (g/m2/s) + REAL t_seri(klon, klev) !Temperature at mid points of Z (K) + REAL v_dep_ss(klon,klev) ! sed. velocity for SS m/s + REAL v_dep_dust(klon,klev) ! sed. velocity for dust m/s + REAL v_dep_dustsco(klon,klev) ! sed. velocity for dust m/s + REAL pplay(klon, klev) !pressure at mid points of Z (Pa) + REAL zrho(klon, klev) !Density of air at mid points of Z (kg/m3) + REAL paprs(klon, klev+1) !pressure at interface of layers Z (Pa) + REAL time_step !time step (sec) + LOGICAL ok_chimeredust + REAL xlat(klon) ! latitudes pour chaque point + REAL xlon(klon) ! longitudes pour chaque point + INTEGER id_coss,id_codu,id_scdu +c +c------local variables +c + INTEGER i, k, nbre_RH + PARAMETER(nbre_RH=12) +c + REAL lambda, ss_g + REAL mmd_ss !mass median diameter of SS (um) + REAL mmd_dust !mass median diameter of dust (um) + REAL mmd_dustsco !mass median diameter of scoarse dust (um) + REAL rho_ss(nbre_RH),rho_ss1 !density of sea salt (kg/m3) + REAL rho_dust !density of dust(kg/m3) + REAL v_stokes, CC, v_sed, ss_growth_f(nbre_RH) + REAL sed_flux(klon,klev) ! sedimentation flux g/m2/s + REAL air_visco(klon,klev) + REAL zdz(klon,klev) ! layers height (m) + REAL temp ! temperature in degree Celius +c + INTEGER RH_num + REAL RH_MAX, DELTA, rh, RH_tab(nbre_RH) + PARAMETER (RH_MAX=95.) +c + DATA RH_tab/0.,10.,20.,30.,40.,50.,60.,70.,80.,85.,90.,95./ +c +c + DATA rho_ss/2160. ,2160. ,2160., 2160, 1451.6, 1367.9, + . 1302.9,1243.2,1182.7, 1149.5,1111.6, 1063.1/ +c + DATA ss_growth_f/0.503, 0.503, 0.503, 0.503, 0.724, 0.782, + . 0.838, 0.905, 1.000, 1.072, 1.188, 1.447/ +c +c + mmd_ss=12.7 !dia -um at 80% for bin 0.5-20 um but 90% of real mmd +! obsolete mmd_dust=2.8 !micrometer for bin 0.5-20 and 0.5-10 um +! 4tracer SPLA: mmd_dust=11.0 !micrometer for bin 0.5-20 and 0.5-10 um +!3days mmd_dust=3.333464 !micrometer for bin 0.5-20 and 0.5-10 um +!3days mmd_dustsco=12.91315 !micrometer for bin 0.5-20 and 0.5-10 um +!JE20140911 mmd_dust=3.002283 !micrometer for bin 0.5-20 and 0.5-10 um +!JE20140911 mmd_dustsco=13.09771 !micrometer for bin 0.5-20 and 0.5-10 um +!JE20140911 mmd_dust=5.156346 !micrometer for bin 0.5-20 and 0.5-10 um +!JE20140911 mmd_dustsco=15.56554 !micrometer for bin 0.5-20 and 0.5-10 um + IF (ok_chimeredust) THEN +!JE20150212<< : changes in ustar in dustmod changes emission distribution +! mmd_dust=3.761212 !micrometer for bin 0.5-3 and 0.5-10 um +! mmd_dustsco=15.06167 !micrometer for bin 3-20 and 0.5-10 um +!JE20150212>> +!JE20150618: Change in div3 of dustmod changes distribution. now is div3=6 +!div=3 mmd_dust=3.983763 +!div=3 mmd_dustsco=15.10854 + mmd_dust=3.898047 + mmd_dustsco=15.06167 + ELSE + mmd_dust=11.0 !micrometer for bin 0.5-20 and 0.5-10 um + mmd_dustsco=100. ! absurd value, bin not used in this scheme + ENDIF + + + rho_dust=2600. !kg/m3 +c +c--------- Air viscosity (poise=0.1 kg/m-sec)----------- +c + DO k=1, klev + DO i=1, klon +c + zdz(i,k)=(paprs(i,k)-paprs(i,k+1))/zrho(i,k)/RG +c + temp=t_seri(i,k)-RTT +c + IF (temp.LT.0.) THEN + air_visco(i,k)=(1.718+0.0049*temp-1.2e-5*temp*temp)*1.e-4 + ELSE + air_visco(i,k)=(1.718+0.0049*temp)*1.e-4 + ENDIF +c + ENDDO + ENDDO +c +c--------- for Sea Salt ------------------- +c +c +c + IF(id_coss>0) THEN + DO k=1, klev + DO i=1,klon +c +c---cal. correction factor hygroscopic growth of aerosols +c + rh=MIN(RHcl(i,k)*100.,RH_MAX) + RH_num = INT( rh/10. + 1.) + IF (rh.gt.85.) RH_num=10 + IF (rh.gt.90.) RH_num=11 + DELTA=(rh-RH_tab(RH_num))/(RH_tab(RH_num+1)-RH_tab(RH_num)) +c + ss_g=ss_growth_f(rh_num) + + . DELTA*(ss_growth_f(RH_num+1)-ss_growth_f(RH_num)) + + rho_ss1=rho_ss(rh_num) + + . DELTA*(rho_ss(RH_num+1)-rho_ss(RH_num)) +c + v_stokes=RG*(rho_ss1-zrho(i,k))* !m/sec + . (mmd_ss*ss_g)*(mmd_ss*ss_g)* + . 1.e-12/(18.0*air_visco(i,k)/10.) +c + lambda=6.6*1.e-8*(103125/pplay(i,k))*(t_seri(i,k)/293.15) +c + CC=1.0+1.257*lambda/(mmd_ss*ss_g)/1.e6 ! C-correction factor +c + v_sed=v_stokes*CC ! m/sec !orig +c +c---------check for v_sed*dt0) THEN + DO k=1, klev + DO i=1,klon +c + v_stokes=RG*(rho_dust-zrho(i,k))* !m/sec + . mmd_dust*mmd_dust* + . 1.e-12/(18.0*air_visco(i,k)/10.) +c + lambda=6.6*1.e-8*(103125/pplay(i,k))*(t_seri(i,k)/293.15) + CC=1.0+1.257*lambda/(mmd_dust)/1.e6 !dimensionless + v_sed=v_stokes*CC !m/sec +c +c---------check for v_sed*dt0) THEN + DO k=1, klev + DO i=1,klon +c + v_stokes=RG*(rho_dust-zrho(i,k))* !m/sec + . mmd_dustsco*mmd_dustsco* + . 1.e-12/(18.0*air_visco(i,k)/10.) +c + lambda=6.6*1.e-8*(103125/pplay(i,k))*(t_seri(i,k)/293.15) + CC=1.0+1.257*lambda/(mmd_dustsco)/1.e6 !dimensionless + v_sed=v_stokes*CC !m/sec +c +c---------check for v_sed*dt0) CALL histwrite_phy( o_taue550_tr2 , diff_aod550_tr2 ) + IF(id_fine>0) CALL histwrite_phy( o_taue670_tr2 , diag_aod670_tr2 ) + IF(id_fine>0) CALL histwrite_phy( o_taue865_tr2 , diag_aod865_tr2 ) + IF(id_coss>0) CALL histwrite_phy( o_taue550_ss , diag_aod550_ss ) + IF(id_coss>0) CALL histwrite_phy( o_taue670_ss , diag_aod670_ss ) + IF(id_coss>0) CALL histwrite_phy( o_taue865_ss , diag_aod865_ss ) + IF(id_codu>0) CALL histwrite_phy( o_taue550_dust , diag_aod550_dust ) + IF(id_codu>0) CALL histwrite_phy( o_taue670_dust , diag_aod670_dust ) + IF(id_codu>0) CALL histwrite_phy( o_taue865_dust , diag_aod865_dust ) + IF(id_scdu>0) CALL histwrite_phy( o_taue550_dustsco , diag_aod550_dustsco ) + IF(id_scdu>0) CALL histwrite_phy( o_taue670_dustsco , diag_aod670_dustsco ) + IF(id_scdu>0) CALL histwrite_phy( o_taue865_dustsco , diag_aod865_dustsco ) + CALL histwrite_phy( o_taue550_aqua , aod550_aqua ) + CALL histwrite_phy( o_taue550_terra , aod550_terra ) + CALL histwrite_phy( o_taue670_aqua , aod670_aqua ) + CALL histwrite_phy( o_taue670_terra , aod670_terra ) + CALL histwrite_phy( o_taue865_aqua , aod865_aqua ) + CALL histwrite_phy( o_taue865_terra , aod865_terra ) + + IF(id_fine>0) CALL histwrite_phy( o_taue550_fine_aqua ,aod550_tr2_aqua ) + IF(id_fine>0) CALL histwrite_phy( o_taue670_fine_aqua ,aod670_tr2_aqua ) + IF(id_fine>0) CALL histwrite_phy( o_taue865_fine_aqua ,aod865_tr2_aqua ) + IF(id_coss>0) CALL histwrite_phy( o_taue550_coss_aqua ,aod550_ss_aqua ) + IF(id_coss>0) CALL histwrite_phy( o_taue670_coss_aqua ,aod670_ss_aqua ) + IF(id_coss>0) CALL histwrite_phy( o_taue865_coss_aqua ,aod865_ss_aqua ) + IF(id_codu>0) CALL histwrite_phy( o_taue550_codu_aqua ,aod550_dust_aqua ) + IF(id_codu>0) CALL histwrite_phy( o_taue670_codu_aqua ,aod670_dust_aqua ) + IF(id_codu>0) CALL histwrite_phy( o_taue865_codu_aqua ,aod865_dust_aqua ) + IF(id_scdu>0) CALL histwrite_phy( o_taue670_scdu_aqua ,aod670_dustsco_aqua ) + IF(id_scdu>0) CALL histwrite_phy( o_taue550_scdu_aqua ,aod550_dustsco_aqua ) + IF(id_scdu>0) CALL histwrite_phy( o_taue865_scdu_aqua ,aod865_dustsco_aqua ) + + IF(id_fine>0) CALL histwrite_phy( o_taue550_fine_terra ,aod550_tr2_terra ) + IF(id_fine>0) CALL histwrite_phy( o_taue670_fine_terra ,aod670_tr2_terra ) + IF(id_fine>0) CALL histwrite_phy( o_taue865_fine_terra ,aod865_tr2_terra ) + IF(id_coss>0) CALL histwrite_phy( o_taue550_coss_terra ,aod550_ss_terra ) + IF(id_coss>0) CALL histwrite_phy( o_taue670_coss_terra ,aod670_ss_terra ) + IF(id_coss>0) CALL histwrite_phy( o_taue865_coss_terra ,aod865_ss_terra ) + IF(id_codu>0) CALL histwrite_phy( o_taue550_codu_terra ,aod550_dust_terra ) + IF(id_codu>0) CALL histwrite_phy( o_taue670_codu_terra ,aod670_dust_terra ) + IF(id_codu>0) CALL histwrite_phy( o_taue865_codu_terra ,aod865_dust_terra ) + IF(id_scdu>0) CALL histwrite_phy( o_taue670_scdu_terra ,aod670_dustsco_terra ) + IF(id_scdu>0) CALL histwrite_phy( o_taue550_scdu_terra ,aod550_dustsco_terra ) + IF(id_scdu>0) CALL histwrite_phy( o_taue865_scdu_terra ,aod865_dustsco_terra ) + + + IF(id_prec>0) CALL histwrite_phy( o_trm01 , trm01 ) + IF(id_fine>0) CALL histwrite_phy( o_trm02 , trm02 ) + IF(id_coss>0) CALL histwrite_phy( o_trm03 , trm03 ) + IF(id_codu>0) CALL histwrite_phy( o_trm04 , trm04 ) + IF(id_scdu>0) CALL histwrite_phy( o_trm05 , trm05 ) + IF(id_prec>0) CALL histwrite_phy( o_sconc01 , sconc01 ) + IF(id_fine>0) CALL histwrite_phy( o_sconc02 , sconc02 ) + IF(id_coss>0) CALL histwrite_phy( o_sconc03 , sconc03 ) + IF(id_codu>0) CALL histwrite_phy( o_sconc04 , sconc04 ) + IF(id_scdu>0) CALL histwrite_phy( o_sconc05 , sconc05 ) + +! Lessivage + + IF(id_prec>0) CALL histwrite_phy( o_flux01 , flux01 ) + IF(id_fine>0) CALL histwrite_phy( o_flux02 , flux02 ) + IF(id_coss>0) CALL histwrite_phy( o_flux03 , flux03 ) + IF(id_codu>0) CALL histwrite_phy( o_flux04 , flux04 ) + IF(id_scdu>0) CALL histwrite_phy( o_flux05 , flux05 ) + IF(id_prec>0) CALL histwrite_phy( o_ds01 , ds01 ) + IF(id_fine>0) CALL histwrite_phy( o_ds02 , ds02 ) + IF(id_coss>0) CALL histwrite_phy( o_ds03 , ds03 ) + IF(id_codu>0) CALL histwrite_phy( o_ds04 , ds04 ) + IF(id_scdu>0) CALL histwrite_phy( o_ds05 , ds05 ) + IF(id_prec>0) CALL histwrite_phy( o_dh01 , dh01 ) + IF(id_fine>0) CALL histwrite_phy( o_dh02 , dh02 ) + IF(id_coss>0) CALL histwrite_phy( o_dh03 , dh03 ) + IF(id_codu>0) CALL histwrite_phy( o_dh04 , dh04 ) + IF(id_scdu>0) CALL histwrite_phy( o_dh05 , dh05 ) + IF(id_prec>0) CALL histwrite_phy( o_dtrconv01 , dtrconv01 ) + IF(id_fine>0) CALL histwrite_phy( o_dtrconv02 , dtrconv02 ) + IF(id_coss>0) CALL histwrite_phy( o_dtrconv03 , dtrconv03 ) + IF(id_codu>0) CALL histwrite_phy( o_dtrconv04 , dtrconv04 ) + IF(id_scdu>0) CALL histwrite_phy( o_dtrconv05 , dtrconv05 ) + IF(id_prec>0) CALL histwrite_phy( o_dtherm01 , dtherm01 ) + IF(id_fine>0) CALL histwrite_phy( o_dtherm02 , dtherm02 ) + IF(id_coss>0) CALL histwrite_phy( o_dtherm03 , dtherm03 ) + IF(id_codu>0) CALL histwrite_phy( o_dtherm04 , dtherm04 ) + IF(id_scdu>0) CALL histwrite_phy( o_dtherm05 , dtherm05 ) + IF(id_prec>0) CALL histwrite_phy( o_dhkecv01 , dhkecv01 ) + IF(id_fine>0) CALL histwrite_phy( o_dhkecv02 , dhkecv02 ) + IF(id_coss>0) CALL histwrite_phy( o_dhkecv03 , dhkecv03 ) + IF(id_codu>0) CALL histwrite_phy( o_dhkecv04 , dhkecv04 ) + IF(id_scdu>0) CALL histwrite_phy( o_dhkecv05 , dhkecv05 ) + IF(id_prec>0) CALL histwrite_phy( o_d_tr_ds01 , d_tr_ds01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_ds02 , d_tr_ds02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_ds03 , d_tr_ds03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_ds04 , d_tr_ds04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_ds05 , d_tr_ds05 ) + IF(id_prec>0) CALL histwrite_phy( o_dhkelsc01 , dhkelsc01 ) + IF(id_fine>0) CALL histwrite_phy( o_dhkelsc02 , dhkelsc02 ) + IF(id_coss>0) CALL histwrite_phy( o_dhkelsc03 , dhkelsc03 ) + IF(id_codu>0) CALL histwrite_phy( o_dhkelsc04 , dhkelsc04 ) + IF(id_scdu>0) CALL histwrite_phy( o_dhkelsc05 , dhkelsc05 ) + IF(id_prec>0) CALL histwrite_phy( o_d_tr_cv01 , d_tr_cv01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_cv02 , d_tr_cv02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_cv03 , d_tr_cv03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_cv04 , d_tr_cv04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_cv05 , d_tr_cv05 ) + IF(id_prec>0) CALL histwrite_phy( o_d_tr_trsp01 , d_tr_trsp01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_trsp02 , d_tr_trsp02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_trsp03 , d_tr_trsp03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_trsp04 , d_tr_trsp04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_trsp05 , d_tr_trsp05 ) + IF(id_prec>0) CALL histwrite_phy( o_d_tr_sscav01 , d_tr_sscav01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_sscav02 , d_tr_sscav02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_sscav03 , d_tr_sscav03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_sscav04 , d_tr_sscav04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_sscav05 , d_tr_sscav05 ) + IF(id_prec>0) CALL histwrite_phy( o_d_tr_sat01 , d_tr_sat01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_sat02 , d_tr_sat02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_sat03 , d_tr_sat03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_sat04 , d_tr_sat04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_sat05 , d_tr_sat05 ) + IF(id_prec>0) CALL histwrite_phy( o_d_tr_uscav01 , d_tr_uscav01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_uscav02 , d_tr_uscav02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_uscav03 , d_tr_uscav03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_uscav04 , d_tr_uscav04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_uscav05 , d_tr_uscav05 ) + IF(id_prec>0) CALL histwrite_phy( o_d_tr_insc01 , d_tr_insc01 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + IF(id_fine>0) CALL histwrite_phy( o_d_tr_insc02 , d_tr_insc02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_insc03 , d_tr_insc03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_insc04 , d_tr_insc04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_insc05 , d_tr_insc05 ) + IF(id_prec>0) CALL histwrite_phy( o_d_tr_bcscav01 , d_tr_bcscav01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_bcscav02 , d_tr_bcscav02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_bcscav03 , d_tr_bcscav03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_bcscav04 , d_tr_bcscav04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_bcscav05 , d_tr_bcscav05 ) + IF(id_prec>0) CALL histwrite_phy( o_d_tr_evapls01 , d_tr_evapls01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_evapls02 , d_tr_evapls02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_evapls03 , d_tr_evapls03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_evapls04 , d_tr_evapls04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_evapls05 , d_tr_evapls05 ) + IF(id_prec>0) CALL histwrite_phy( o_d_tr_ls01 , d_tr_ls01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_ls02 , d_tr_ls02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_ls03 , d_tr_ls03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_ls04 , d_tr_ls04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_ls05 , d_tr_ls05 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + IF(id_prec>0) CALL histwrite_phy( o_d_tr_dyn01 , d_tr_dyn01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_dyn02 , d_tr_dyn02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_dyn03 , d_tr_dyn03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_dyn04 , d_tr_dyn04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_dyn05 , d_tr_dyn05 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + IF(id_prec>0) CALL histwrite_phy( o_d_tr_cl01 , d_tr_cl01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_cl02 , d_tr_cl02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_cl03 , d_tr_cl03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_cl04 , d_tr_cl04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_cl05 , d_tr_cl05 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + IF(id_prec>0) CALL histwrite_phy( o_d_tr_th01 , d_tr_th01 ) + IF(id_fine>0) CALL histwrite_phy( o_d_tr_th02 , d_tr_th02 ) + IF(id_coss>0) CALL histwrite_phy( o_d_tr_th03 , d_tr_th03 ) + IF(id_codu>0) CALL histwrite_phy( o_d_tr_th04 , d_tr_th04 ) + IF(id_scdu>0) CALL histwrite_phy( o_d_tr_th05 , d_tr_th05 ) !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + + + IF(id_coss>0) CALL histwrite_phy( o_sed_ss , sed_ss) + IF(id_codu>0) CALL histwrite_phy( o_sed_dust , sed_dust) + IF(id_scdu>0) CALL histwrite_phy( o_sed_dustsco , sed_dustsco) + IF(id_prec>0) CALL histwrite_phy( o_g2p_gas , his_g2pgas ) + IF(id_fine>0) CALL histwrite_phy( o_g2p_aer , his_g2paer) + +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + IF(id_coss>0) CALL histwrite_phy( o_sed_ss3D , sed_ss3D) + IF(id_codu>0) CALL histwrite_phy( o_sed_dust3D , sed_dust3D) + IF(id_scdu>0) CALL histwrite_phy( o_sed_dustsco3D , sed_dustsco3D) +!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! histrac_spl +! + CALL histwrite_phy( o_fluxbb , fluxbb ) + CALL histwrite_phy( o_fluxff , fluxff ) + CALL histwrite_phy( o_fluxbcbb , fluxbcbb ) + CALL histwrite_phy( o_fluxbcff , fluxbcff ) + CALL histwrite_phy( o_fluxbcnff , fluxbcnff ) + CALL histwrite_phy( o_fluxbcba , fluxbcba ) + CALL histwrite_phy( o_fluxbc , fluxbc ) + CALL histwrite_phy( o_fluxombb , fluxombb ) + CALL histwrite_phy( o_fluxomff , fluxomff ) + CALL histwrite_phy( o_fluxomnff , fluxomnff ) + CALL histwrite_phy( o_fluxomba , fluxomba ) + CALL histwrite_phy( o_fluxomnat , fluxomnat ) + CALL histwrite_phy( o_fluxom , fluxom ) + CALL histwrite_phy( o_fluxh2sff , fluxh2sff ) + CALL histwrite_phy( o_fluxh2snff , fluxh2snff ) + CALL histwrite_phy( o_fluxso2ff , fluxso2ff ) + CALL histwrite_phy( o_fluxso2nff , fluxso2nff ) + CALL histwrite_phy( o_fluxso2bb , fluxso2bb ) + CALL histwrite_phy( o_fluxso2vol , fluxso2vol ) + CALL histwrite_phy( o_fluxso2ba , fluxso2ba ) + CALL histwrite_phy( o_fluxso2 , fluxso2 ) + CALL histwrite_phy( o_fluxso4ff , fluxso4ff ) + CALL histwrite_phy( o_fluxso4nff , fluxso4nff ) + CALL histwrite_phy( o_fluxso4bb , fluxso4bb ) + CALL histwrite_phy( o_fluxso4ba , fluxso4ba ) + CALL histwrite_phy( o_fluxso4 , fluxso4 ) + CALL histwrite_phy( o_fluxdms , fluxdms ) + CALL histwrite_phy( o_fluxh2sbio , fluxh2sbio ) + CALL histwrite_phy( o_fluxdustec , fluxdustec ) + CALL histwrite_phy( o_fluxddfine , fluxddfine ) + CALL histwrite_phy( o_fluxddcoa , fluxddcoa ) + CALL histwrite_phy( o_fluxddsco , fluxddsco ) + CALL histwrite_phy( o_fluxdd , fluxdd ) + CALL histwrite_phy( o_fluxssfine , fluxssfine ) + CALL histwrite_phy( o_fluxsscoa , fluxsscoa ) + CALL histwrite_phy( o_fluxss , fluxss ) + CALL histwrite_phy( o_flux_sparam_ind , flux_sparam_ind ) + CALL histwrite_phy( o_flux_sparam_bb , flux_sparam_bb ) + CALL histwrite_phy( o_flux_sparam_ff , flux_sparam_ff ) + CALL histwrite_phy( o_flux_sparam_ddfine , flux_sparam_ddfine ) + CALL histwrite_phy( o_flux_sparam_ddcoa , flux_sparam_ddcoa ) + CALL histwrite_phy( o_flux_sparam_ddsco , flux_sparam_ddsco ) + CALL histwrite_phy( o_flux_sparam_ssfine , flux_sparam_ssfine ) + CALL histwrite_phy( o_flux_sparam_sscoa , flux_sparam_sscoa ) + CALL histwrite_phy( o_u10m_ss , u10m_ss ) + CALL histwrite_phy( o_v10m_ss , v10m_ss ) + +! CALL histwrite_phy( ,) +! + + + + Index: /LMDZ5/trunk/libf/phylmd/Dust/tiedqneg.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/tiedqneg.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/tiedqneg.F (revision 2630) @@ -0,0 +1,66 @@ + SUBROUTINE tiedqneg (pres_h,q,d_q) +c + USE dimphy + IMPLICIT none +c====================================================================== +c Auteur(s): CG (LGGE/CNRS) date: 19950201 +c O. Boucher (LOA/CNRS) date 19961125 +c Objet: Correction eventuelle des valeurs negatives d'humidite +c induites par le schema de convection de Tiedke +c====================================================================== +c Arguments: +c pres_h--input-R-la valeur de la pression aux interfaces +c q-------input-R-quantite de traceur +c d_q-----input-output-R-increment du traceur +c====================================================================== +c +#include "dimensions.h" +c #include "dimphy.h" + REAL pres_h(klon,klev+1) + REAL q(klon,klev) + REAL d_q(klon,klev) + INTEGER nb_neg + INTEGER i, l +c + REAL qmin + PARAMETER (qmin=0.0) +c + DO l = klev,2,-1 + nb_neg = 0 + DO i = 1,klon + IF (q(i,l)+d_q(i,l).LT.qmin) THEN + nb_neg = nb_neg + 1 + d_q(i,l-1) = d_q(i,l-1) + (q(i,l)+d_q(i,l)-qmin) + . *(pres_h(i,l)-pres_h(i,l+1))/(pres_h(i,l-1)-pres_h(i,l)) + d_q(i,l) = qmin - q(i,l) + ENDIF + ENDDO +c IF (nb_neg.NE.0) THEN +c PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives' +c ENDIF + ENDDO +c + DO l = 1, klev-1 + nb_neg = 0 + DO i = 1,klon + IF (q(i,l)+d_q(i,l).LT.qmin) THEN + nb_neg = nb_neg + 1 + d_q(i,l+1) = d_q(i,l+1) + (q(i,l)+d_q(i,l)-qmin) + . *(pres_h(i,l)-pres_h(i,l+1))/(pres_h(i,l+1)-pres_h(i,l+2)) + d_q(i,l) = qmin - q(i,l) + ENDIF + ENDDO +c IF (nb_neg.NE.0) THEN +c PRINT *,'niveau ', l,' ' , nb_neg, ' valeurs negatives' +c ENDIF + ENDDO +c + l = klev + DO i = 1,klon + IF (q(i,l)+d_q(i,l).LT.qmin) THEN + d_q(i,l) = qmin - q(i,l) + ENDIF + ENDDO +c + RETURN + END Index: /LMDZ5/trunk/libf/phylmd/Dust/trconvect.F =================================================================== --- /LMDZ5/trunk/libf/phylmd/Dust/trconvect.F (revision 2630) +++ /LMDZ5/trunk/libf/phylmd/Dust/trconvect.F (revision 2630) @@ -0,0 +1,114 @@ +c Subroutine that computes the convective mixing and transport + SUBROUTINE trconvect(pplay,t_seri,pdtphys,pmfu,pmfd,pen_u,pde_u, + . pen_d,pde_d,paprs,zdz,xconv,qmin,qmax,lminmax,masse, + . dtrconv,tr_seri) + + USE dimphy + USE infotrac + USE indice_sol_mod + + IMPLICIT NONE + +#include "dimensions.h" +#include "chem.h" +#include "YOMCST.h" +#include "paramet.h" + +c============================= INPUT =================================== + REAL qmin, qmax + REAL xconv(nbtr), masse(nbtr) + REAL pplay(klon,klev) ! pression pour le mileu de chaque couche (en Pa) + REAL t_seri(klon,klev) ! temperature + REAL zdz(klon,klev) ! zdz + REAL paprs(klon,klev+1) ! pression pour chaque inter-couche (en Pa) + REAL pmfu(klon,klev) ! flux de masse dans le panache montant + REAL pmfd(klon,klev) ! flux de masse dans le panache descendant + REAL pen_u(klon,klev) ! flux entraine dans le panache montant + REAL pde_u(klon,klev) ! flux detraine dans le panache montant + REAL pen_d(klon,klev) ! flux entraine dans le panache descendant + REAL pde_d(klon,klev) ! flux detraine dans le panache descendant + LOGICAL lminmax + REAL pdtphys +c============================= OUTPUT ================================== + REAL aux_var1(klon,klev) + REAL aux_var2(klon,klev) + REAL tr_seri(klon,klev,nbtr) ! traceur + REAL dtrconv(klon,nbtr) ! traceur +c========================= LOCAL VARIABLES ============================= + INTEGER it, k, i, j + REAL d_tr(klon,klev,nbtr) + + EXTERNAL nflxtr, tiedqneg, minmaxqfi + + DO it=1, nbtr +c + DO i=1, klon + dtrconv(i,it)=0.0 + ENDDO + DO i=1,klon + DO j=1,klev + aux_var1(i,j)=tr_seri(i,j,it) + aux_var2(i,j)=d_tr(i,j,it) + ENDDO + ENDDO + +c +cnhl CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, +cnhl . pplay, paprs, tr_seri(1,1,it), d_tr(1,1,it) ) + CALL nflxtr(pdtphys, pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, + . pplay, paprs, aux_var1, aux_var2 ) +c + CALL tiedqneg(paprs,aux_var1, aux_var2) +cnhl CALL tiedqneg(paprs,tr_seri(1,1,it), d_tr(1,1,it)) + DO i=1,klon + DO j=1,klev + tr_seri(i,j,it)=aux_var1(i,j) + d_tr(i,j,it)=aux_var2(i,j) + ENDDO + ENDDO +c + DO k = 1, klev + DO i = 1, klon + IF (d_tr(i,k,it).LT.0.) THEN + tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr(i,k,it) + ELSE + tr_seri(i,k,it)=tr_seri(i,k,it)+d_tr(i,k,it)*xconv(it) + ENDIF + ENDDO + ENDDO +c +cnhl CALL kg_to_cm3(pplay,t_seri,d_tr(1,1,it)) + CALL kg_to_cm3(pplay,t_seri,aux_var2) + DO i=1,klon + DO j=1,klev + d_tr(i,j,it)=aux_var2(i,j) + ENDDO + ENDDO + + DO k = 1, klev + DO i = 1, klon + IF (d_tr(i,k,it).GE.0.) THEN + dtrconv(i,it)=dtrconv(i,it)+(1.-xconv(it))*d_tr(i,k,it) + . /RNAVO*masse(it)*1.e3*1.e6*zdz(i,k)/pdtphys + ENDIF + ENDDO + ENDDO + + IF (lminmax) THEN + DO i=1,klon + DO j=1,klev + aux_var1(i,j)=tr_seri(i,j,it) + ENDDO + ENDDO + CALL minmaxqfi(aux_var1,qmin,qmax,'apr convection') +cnhl CALL minmaxqfi(tr_seri(1,1,it),qmin,qmax,'apr convection') + DO i=1,klon + DO j=1,klev + tr_seri(i,j,it)=aux_var1(i,j) + ENDDO + ENDDO + ENDIF +c + ENDDO + + END Index: /LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90 (revision 2629) +++ /LMDZ5/trunk/libf/phylmd/phys_output_ctrlout_mod.F90 (revision 2630) @@ -1658,3 +1658,7 @@ "inst(X)", "inst(X)", "inst(X)", "inst(X)", "inst(X)", "inst(X)" /)) +#ifdef CPP_Dust +#include "Dust/spla_output_dat.h" +#endif + END MODULE phys_output_ctrlout_mod Index: /LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90 (revision 2629) +++ /LMDZ5/trunk/libf/phylmd/phys_output_write_mod.F90 (revision 2630) @@ -1763,4 +1763,5 @@ ENDIF + END SUBROUTINE phys_output_write Index: /LMDZ5/trunk/libf/phylmd/physiq_mod.F90 =================================================================== --- /LMDZ5/trunk/libf/phylmd/physiq_mod.F90 (revision 2629) +++ /LMDZ5/trunk/libf/phylmd/physiq_mod.F90 (revision 2630) @@ -34,4 +34,7 @@ USE change_srf_frac_mod USE surface_data, ONLY : type_ocean, ok_veget, ok_snow +#ifdef CPP_Dust + USE phytracr_spl_mod, ONLY: phytracr_spl +#endif USE phys_local_var_mod, ONLY: phys_local_var_init, phys_local_var_end, & ! [Variables internes non sauvegardees de la physique] @@ -178,10 +181,14 @@ ! USE phys_state_var_mod ! Variables sauvegardees de la physique +#ifdef CPP_Dust + USE phys_output_write_spl_mod +#else USE phys_output_var_mod ! Variables pour les ecritures des sorties +#endif + USE phys_output_write_mod USE fonte_neige_mod, ONLY : fonte_neige_get_vars USE phys_output_mod USE phys_output_ctrlout_mod - USE iophy use open_climoz_m, only: open_climoz ! ozone climatology from a file use regr_pr_av_m, only: regr_pr_av @@ -905,7 +912,7 @@ REAL zx_lat(nbp_lon,nbp_lat) ! - INTEGER nid_day_seri, nid_ctesGCM - SAVE nid_day_seri, nid_ctesGCM - !$OMP THREADPRIVATE(nid_day_seri,nid_ctesGCM) + INTEGER nid_ctesGCM + SAVE nid_ctesGCM + !$OMP THREADPRIVATE(nid_ctesGCM) ! !IM 280405 BEG @@ -2479,4 +2486,5 @@ !jyg iflag_con est dans clesphys !c CALL concvl (iflag_con,iflag_clos, + clw=0. CALL concvl (iflag_clos, & dtime, paprs, pplay, k_upper_cv, t_undi,q_undi, & @@ -2498,4 +2506,5 @@ wdtrainA,wdtrainM,wght_cvfd,qtc_cv,sigt_cv, & tau_cld_cv,coefw_cld_cv,epmax_diag) + ! RomP <<< @@ -4264,4 +4273,22 @@ END IF +#ifdef CPP_Dust + CALL phytracr_spl ( debut,lafin , jD_cur,jH_cur,iflag_con, & ! I + pdtphys,ftsol, & ! I + t,q_seri,paprs,pplay,RHcl, & ! I + pmfu, pmfd, pen_u, pde_u, pen_d, pde_d, & ! I + coefh(1:klon,1:klev,is_ave), cdragh, cdragm, u1, v1, & ! I + u_seri, v_seri, latitude_deg, longitude_deg, & + pphis,pctsrf,pmflxr,pmflxs,prfl,psfl, & ! I + da,phi,phi2,d1a,dam,mp,ep,sigd,sij,clw,elij, & ! I + epmlmMm,eplaMm,upwd,dnwd,itop_con,ibas_con, & ! I + ev,wdtrainA, wdtrainM,wght_cvfd, & ! I + fm_therm, entr_therm, rneb, & ! I + beta_prec_fisrt,beta_prec, & !I + zu10m,zv10m,wstar,ale_bl,ale_wake, & ! I + d_tr_dyn,tr_seri) + +#else + call phytrac ( & itap, days_elapsed+1, jH_cur, debut, & @@ -4288,4 +4315,5 @@ d_tr_dyn, & !<