Changeset 2720 for LMDZ5/branches/testing/libf/phylmd/phytrac_mod.F90

Timestamp:

Nov 30, 2016, 1:28:41 PM (8 years ago)

Author:

Laurent Fairhead

Message:

Merged trunk changes r2664:2719 into testing branch

Location:

LMDZ5/branches/testing

Files:

• . (modified) (1 prop)
• libf/phylmd/phytrac_mod.F90 (modified) (16 diffs)

LMDZ5/branches/testing/libf/phylmd/phytrac_mod.F90

@@ -97 +97 @@
     USE tracreprobus_mod
     USE indice_sol_mod
-
     USE mod_phys_lmdz_mpi_data, ONLY :  is_mpi_root
     USE print_control_mod, ONLY: lunout
     USE aero_mod, ONLY : naero_grp
+
+#ifdef CPP_StratAer
+    USE traccoag_mod
+    USE phys_local_var_mod, ONLY: mdw, sulf_dep_dry, sulf_dep_wet
+    USE infotrac, ONLY: nbtr_sulgas, id_SO2_strat, id_H2SO4_strat
+    USE aerophys
+#endif
 
     IMPLICIT NONE
@@ -208 +214 @@
     !--------------
     !
-    !
     REAL,DIMENSION(:),INTENT(IN)   :: cdragh          ! (klon) coeff drag pour T et Q
     REAL,DIMENSION(:,:),INTENT(IN) :: coefh           ! (klon,klev) coeff melange CL (m**2/s)
@@ -215 +220 @@
     REAL,DIMENSION(:),INTENT(IN)   :: yu1             ! (klon) vents au premier niveau
     REAL,DIMENSION(:),INTENT(IN)   :: yv1             ! (klon) vents au premier niveau
-
     !
     !Lessivage:
@@ -238 +242 @@
     REAL,DIMENSION(klon,nbsrf),INTENT(IN) :: pctsrf ! Pourcentage de sol (nature du sol)
 
-
+#ifdef CPP_StratAer
+    REAL,DIMENSION(klon)           :: v_dep_dry !dry deposition velocity of stratospheric sulfate in m/s
+#endif
     ! Output argument
     !----------------
     REAL,DIMENSION(klon,klev,nbtr),INTENT(INOUT) :: tr_seri ! Concentration Traceur [U/KgA]
     REAL,DIMENSION(klon,klev)                    :: sourceBE 
+
     !=======================================================================================
     !                        -- LOCAL VARIABLES --
@@ -267 +274 @@
     INTEGER                   :: itau_w      ! pas de temps ecriture = nstep + itau_phy
     LOGICAL,PARAMETER         :: ok_sync=.TRUE.
-
     !
     ! Nature du traceur
@@ -369 +375 @@
     END DO
 
+    DO it=1, nbtr
+       DO i=1,klon
+          d_tr_dry(i,it)=0.
+          flux_tr_dry(i,it)=0.
+       END DO
+    END DO
+
     DO k = 1, klev
        DO i = 1, klon
@@ -456 +469 @@
        CASE('repr')
           source(:,:)=0.
+#ifdef CPP_StratAer
+       CASE('coag')
+          source(:,:)=0.
+          DO it= 1, nbtr_sulgas
+            aerosol(it)=.FALSE.
+            IF (it==id_H2SO4_strat) aerosol(it)=.TRUE.
+          ENDDO
+          DO it= nbtr_sulgas+1, nbtr
+            aerosol(it)=.TRUE.
+          ENDDO
+#endif
        END SELECT
 
@@ -504 +528 @@
                 !--for now we do not scavenge in cvltr
                 flag_cvltr(it)=.false.
+
+#ifdef CPP_StratAer
+             CASE('coag')
+                IF (convscav.and.aerosol(it)) THEN
+                   flag_cvltr(it)=.true.
+                   ccntrAA(it) =ccntrAA_in    
+                   ccntrENV(it)=ccntrENV_in
+                   coefcoli(it)=coefcoli_in
+                ELSE
+                   flag_cvltr(it)=.false.
+                ENDIF
+#endif
+
              END SELECT
           ENDDO
@@ -572 +609 @@
        ! Appel fait en fin de phytrac pour avoir les emissions modifiees par 
        ! la couche limite et la convection avant le calcul de la chimie 
+
     CASE('repr')
        !   -- CHIMIE REPROBUS --
-
        CALL tracreprobus(pdtphys, gmtime, debutphy, julien, &
             presnivs, xlat, xlon, pphis, pphi, &
@@ -580 +617 @@
             tr_seri)
 
+#ifdef CPP_StratAer
+    CASE('coag')
+       !   --STRATOSPHERIC AER IN THE STRAT --
+       CALL traccoag(pdtphys, gmtime, debutphy, julien, &
+            presnivs, xlat, xlon, pphis, pphi, &
+            t_seri, pplay, paprs, sh, rh , &
+            tr_seri)
+#endif
+
     END SELECT
     !======================================================================
@@ -591 +637 @@
           IF (iflag_con.LT.2) THEN
              !--pas de transport convectif
-
              d_tr_cv(:,:,it)=0.
+
           ELSE IF (iflag_con.EQ.2) THEN
              !--ancien transport convectif de Tiedtke
@@ -648 +694 @@
 
        END DO ! nbtr
+
+#ifdef CPP_StratAer
+       IF (type_trac=='coag') THEN
+         ! initialize wet deposition flux of sulfur
+         sulf_dep_wet(:)=0.0
+         ! compute wet deposition flux of sulfur (sum over gases and particles)
+         ! and convert to kg(S)/m2/s
+         DO i = 1, klon
+         DO k = 1, klev
+         DO it = 1, nbtr
+         !do not include SO2 because most of it comes trom the troposphere
+           IF (it==id_H2SO4_strat) THEN
+             sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_cv(i,k,it)*(mSatom/mH2SO4mol) &
+                            & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
+           ELSEIF (it.GT.nbtr_sulgas) THEN
+             sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_cv(i,k,it)*(mSatom/mH2SO4mol)  &
+                            & *dens_aer_dry*4./3.*RPI*(mdw(it-nbtr_sulgas)/2.)**3 &
+                            & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
+           ENDIF
+         ENDDO
+         ENDDO
+         ENDDO
+       ENDIF
+#endif
 
     END IF ! convection
@@ -692 +762 @@
        !  Injection during BL mixing
        !
+#ifdef CPP_StratAer
+       IF (type_trac=='coag') THEN
+
+         ! initialize dry deposition flux of sulfur
+         sulf_dep_dry(:)=0.0
+
+         ! compute dry deposition velocity as function of surface type (numbers
+         ! from IPSL note 23, 2002)
+         v_dep_dry(:) =  pctsrf(:,is_ter) * 2.5e-3 &
+                     & + pctsrf(:,is_oce) * 0.5e-3 &
+                     & + pctsrf(:,is_lic) * 2.5e-3 &
+                     & + pctsrf(:,is_sic) * 2.5e-3
+
+         ! compute surface dry deposition flux
+         zrho(:,1)=pplay(:,1)/t_seri(:,1)/RD
+
+         DO it=1, nbtr
+          source(:,it) = - v_dep_dry(:) * tr_seri(:,1,it) * zrho(:,1)
+         ENDDO
+
+       ENDIF
+#endif
+
        DO it=1, nbtr
           !
@@ -703 +796 @@
              tr_seri(:,:,it)=tr_seri(:,:,it)+d_tr_cl(:,:,it)
              !
-          END IF
+#ifdef CPP_StratAer
+             IF (type_trac=='coag') THEN
+               ! compute dry deposition flux of sulfur (sum over gases and particles)
+               IF (it==id_H2SO4_strat) THEN
+                 sulf_dep_dry(:)=sulf_dep_dry(:)-source(:,it)*(mSatom/mH2SO4mol)
+               ELSEIF (it.GT.nbtr_sulgas) THEN
+                 sulf_dep_dry(:)=sulf_dep_dry(:)-source(:,it)*(mSatom/mH2SO4mol)*dens_aer_dry &
+                                & *4./3.*RPI*(mdw(it-nbtr_sulgas)/2.)**3
+               ENDIF
+             ENDIF
+#endif
+             !
+          ENDIF
           !
-       END DO
+       ENDDO
        !
     ELSE IF (iflag_vdf_trac==0) THEN
@@ -720 +825 @@
        !
        ! Nothing happens
-       !
        d_tr_cl=0.
        !
@@ -772 +876 @@
 
           END DO  !tr
+
+#ifdef CPP_StratAer
+         IF (type_trac=='coag') THEN
+           ! compute wet deposition flux of sulfur (sum over gases and
+           ! particles) and convert to kg(S)/m2/s
+           ! adding contribution of d_tr_ls to d_tr_cv (above)
+           DO i = 1, klon
+           DO k = 1, klev
+           DO it = 1, nbtr
+             IF (it==id_H2SO4_strat) THEN
+               sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_ls(i,k,it)*(mSatom/mH2SO4mol) &
+                              & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
+             ELSEIF (it.GT.nbtr_sulgas) THEN
+               sulf_dep_wet(i)=sulf_dep_wet(i)+d_tr_ls(i,k,it)*(mSatom/mH2SO4mol)  &
+                              & *dens_aer_dry*4./3.*RPI*(mdw(it-nbtr_sulgas)/2.)**3 &
+                              & *(paprs(i,k)-paprs(i,k+1))/RG/pdtphys
+             ENDIF
+           ENDDO
+           ENDDO
+           ENDDO
+         ENDIF
+#endif
 
        ELSE IF (iflag_lscav .EQ. 2) THEN ! frac_impa, frac_nucl