! ! $Header: /home/cvsroot/LMDZ4/libf/phylmd/phytrac.F,v 1.16 2006/03/24 15:06:23 lmdzadmin Exp $ ! c c SUBROUTINE phytrac_emiss (debutphy, I lafin, I nqmax, I nlon, I nlev, I pdtphys, I paprs, I xlat,xlon, O tr_seri) c====================================================================== c Auteur(s) FH c Objet: Moniteur general des tendances traceurs c cAA Remarques en vrac: cAA-------------------- cAA 1/ le call phytrac se fait avec nqmax c c SL: Janvier 2014 c Version developed for surface emission c Maybe could be used just to compute the 'source' variable from physiq c c====================================================================== use infotrac_phy, only: tname, nqtot use clesphys_mod #ifdef CPP_XIOS use xios_output_mod, only: send_xios_field #endif use dimphy USE geometry_mod, only: cell_area USE chemparam_mod,only:M_tr,type_tr USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat IMPLICIT none #include "YOMCST.h" c#include "clesphys.h" c====================================================================== c Arguments: c EN ENTREE: c ========== logical debutphy ! le flag de l'initialisation de la physique logical lafin ! le flag de la fin de la physique integer nqmax ! nombre de traceurs auxquels on applique la physique integer nlon ! nombre de points horizontaux integer nlev ! nombre de couches verticales real pdtphys ! pas d'integration pour la physique (seconde) real paprs(nlon,nlev+1) ! pression pour chaque inter-couche (en Pa) REAL xlat(nlon) ! latitudes pour chaque point REAL xlon(nlon) ! longitudes pour chaque point c EN ENTREE/SORTIE: c ================= real tr_seri(nlon,nlev,nqmax) ! traceur cAA ---------------------------- cAA VARIABLES LOCALES TRACEURS cAA ---------------------------- c pour emission type effusion real :: deltatr(klon,klev,nqtot) c several identical tracers emitted at different places, with different c fluxes, at the same time : c same_tracer=.true. and various number of areas and fluxes c logical,parameter :: same_tracer=.true. c integer,parameter :: nblat=3,nblon=3,nbaire=3,nbflux=2,maxcell=16 c Otherwise, emission of one of the tracers only, in one area only logical,parameter :: same_tracer=.false. integer,parameter :: nblat=1,nblon=1,nbaire=1,nbflux=1 integer,save :: iq_co2,iq_n2 integer,parameter :: maxcell=10000 integer,parameter :: Nheight=3 ! layer emission (150m) integer,save :: Ncell(nbaire) real,save :: flux_surface_co2(nbflux) ! flux de CO2 emis (kg/m2/s) real :: flux(nlon,nqtot) real,save :: lat_zone(nblat),lon_zone(nblon) integer,save :: ig_zone(nblat,nblon,nbaire,nbflux,maxcell) integer,save :: numcell(nblat,nblon,nbaire,nbflux) INTEGER i, k, it integer ilat,ilon,iaire,iflux,ipos real deltalat,deltalon c====================================================================== c EMISSIONS TRACEURS c--------- c debutphy c--------- if (debutphy) then print*,"DEBUT PHYTRAC" print*,"PHYTRAC: EMISSION" ALLOCATE(M_tr(nqtot)) ALLOCATE(type_tr(nqtot)) do i=1,nqtot if (tname(i)(1:3).eq.'co2') then ! CO2 M_tr(i)=44. iq_co2 =i type_tr(i)=1 endif if (tname(i)(1:2).eq.'n2') then ! N2 M_tr(i)=28. iq_n2 =i type_tr(i)=1 endif enddo C========================================================================= c Caracteristiques des traceurs emis: C========================================================================= c nombre total de traceur if (nblat*nblon*nbaire*nbflux+1 .gt. nqtot) then print*, nblat*nblon*nbaire*nbflux+1, nqtot write(*,*) "Attention, pas assez de traceurs" write(*,*) "le dernier sera bien le dernier" endif c flux de CO2 (kg/s/m2) c 4.5e-7 correspond a 1% (en masse) d une couche de 2E6 Pa en 500 jV c donc avec 5E-7, on vide le N2 en 1000 jV c flux_surface_co2(1) = 5.E-5 flux_surface_co2(1) = 0. c nombre de cellule pour le cote du carre d'aire Ncell(1)= 9999 c localisation zone emission lat_zone(1) = 0. lon_zone(1) = 0. if ((nbp_lon*nbp_lat)==1) then ! running a 1D simulation deltalat=180. deltalon=360. else deltalat = 180./(nbp_lat-1) deltalon = 360./nbp_lon endif numcell(:,:,:,:)=0 ig_zone(:,:,:,:,:)=0 do i=1,nlon do ilat=1,nblat do ilon=1,nblon do iaire=1,nbaire if ( & (Ncell(iaire).ne.9999) c emission on some areas only & .and.((xlat(i).ge.lat_zone(ilat)) & .and.((xlat(i)-Ncell(iaire)*deltalat) & .lt.lat_zone(ilat)) & .and.(xlon(i).le.lon_zone(ilon)) & .and.((xlon(i)+Ncell(iaire)*deltalon) & .gt.lon_zone(ilon))) ) then do iflux=1,nbflux numcell(ilat,ilon,iaire,iflux)=numcell(ilat,ilon,iaire,iflux)+1 ig_zone(ilat,ilon,iaire,iflux,numcell(ilat,ilon,iaire,iflux))= i print*,"Lat,lon,naire,nflux,nlon=",ilat,ilon,iaire,iflux & ,i," OK" end do end if end do end do end do end do c Reinit des traceurs si necessaire if (reinit_trac) then tr_seri(:,:,:)=0. do i=1,klon do k=1,klev c Profile for VeGa2 c tr_seri(i,k,iq_n2) = M_tr(i_n2)/43.44*max(min(0.035, c & 0.035*(1.-log(paprs(i,k)/6.e6)/log(9.e6/6.e6))),0.) c tr_seri(i,k,iq_co2)= 1. - tr_seri(i,k,iq_n2) c Uniform initialization, yN2=3.5%, regular mean mol mass = 43.44 g/mol tr_seri(i,k,iq_n2) = 0.035*M_tr(iq_n2)/43.44 tr_seri(i,k,iq_co2)= 1. - tr_seri(i,k,iq_n2) end do end do endif C========================================================================= C========================================================================= ENDIF ! fin debutphy c------------- c fin debutphy c------------- c====================================================================== c Emission continue d'un traceur c necessite raz_date=1 dans run.def c et reinit_trac=y c====================================================================== deltatr(:,:,:) = 0. flux(:,:)=0. if (same_tracer) then c emet les traceurs qui sont presents sur la grille do ilat = 1,nblat do ilon = 1,nblon do iaire = 1,nbaire do iflux = 1,nbflux it=min( (ilat-1)*nblon*nbflux*nbaire+(iaire-1)*nbflux & +(ilon-1)*nbaire*nbflux+iflux , nqtot ) if (Ncell(iaire).ne.9999) then c column injection do ipos=1,maxcell if (ig_zone(ilat,ilon,iaire,iflux,ipos).ne.0) then i=ig_zone(ilat,ilon,iaire,iflux,ipos) flux(i,it)=flux_surface_co2(iflux) do k=1,Nheight deltatr(i,k,it) = flux_surface_co2(iflux) ! kg/s/m2 $ *RG/(paprs(i,1)-paprs(i,Nheight+1)) ! / (kg/m2) (masse colonne) tr_seri(i,k,it) = tr_seri(i,k,it)+deltatr(i,k,it)*pdtphys end do end if end do endif end do end do end do end do else ! same_tracer=.false. c column injection !! with constant mass !! do i=1,nlon flux(i,iq_co2)=flux_surface_co2(1) do k=1,Nheight deltatr(i,k,iq_co2) = min((1.-tr_seri(i,k,iq_co2))/pdtphys, $ flux(i,iq_co2)) ! kg/s/m2 $ *RG/(paprs(i,1)-paprs(i,Nheight+1)) ! / (kg/m2) (masse colonne) deltatr(i,k,iq_n2) = -deltatr(i,k,iq_co2) tr_seri(i,k,iq_co2) = tr_seri(i,k,iq_co2) $ +deltatr(i,k,iq_co2)*pdtphys tr_seri(i,k,iq_n2) = tr_seri(i,k,iq_n2) $ +deltatr(i,k,iq_n2)*pdtphys end do end do endif ! same_tracer c====================================================================== c====================================================================== #ifdef CPP_XIOS ! do it=1,nqtot ! CALL send_xios_field("flux_"//tname(it), ! & flux(:,it)) ! end do #endif RETURN END