SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/ch_aer

Go to the documentation of this file.
00001 !     #########
00002      SUBROUTINE CH_AER_DEP (PSVT, PFSVT,  PUSTAR, &
00003                       PRESA, PTA, PRHODREF)  
00004 !###########################################################
00005   !
00006   !!                   
00007   !!                       
00008   !!
00009   !!    PURPOSE
00010   !!    -------
00011   !!      
00012   !!    Compute dry deposition velocity for aerosol species 
00013   !!
00014   !!    AUTHOR
00015   !!    ------
00016   !!      P.Tulet      * CNRM *
00017   !!
00018   !!    MODIFICATIONS
00019   !!    -------------
00020   !!      Original      20/02/05 
00021   !!
00022   !-------------------------------------------------------------------------------
00023   !
00024   !*       0.    DECLARATIONS
00025   !              ------------
00026   !
00027   USE MODE_AER_SURF
00028   USE MODI_CH_AER_VELGRAV1D
00029   USE MODD_CHS_AEROSOL
00030   !
00031 !
00032   USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00033   USE PARKIND1  ,ONLY : JPRB
00034 !
00035   IMPLICIT NONE
00036   !
00037   !*       0.1   Declarations of dummy arguments :
00038   !
00039        REAL, DIMENSION(:,:),   INTENT(IN)    :: PSVT       ! friction velocity
00040        REAL, DIMENSION(:,:),   INTENT(INOUT) :: PFSVT      ! flux
00041        REAL, DIMENSION(:),     INTENT(IN)    :: PUSTAR       ! friction velocity
00042        REAL, DIMENSION(:),     INTENT(IN)    :: PRESA        ! aerodynamical resistance
00043        REAL, DIMENSION(:),     INTENT(IN)    :: PTA          ! ait temperature
00044        REAL, DIMENSION(:),     INTENT(IN)    :: PRHODREF     ! air density
00045   !
00046   !
00047   !*       0.2   Declarations of local variables :
00048   !
00049   REAL , DIMENSION(SIZE(PSVT,1), JPIN) :: ZRD ! surface  resistance
00050   REAL , DIMENSION(SIZE(PSVT,1), JPIN) :: ZVD  
00051   REAL , DIMENSION(SIZE(PSVT,1), JPIN) :: Stn ! Stockes number
00052   REAL , DIMENSION(SIZE(PSVT,1), JPIN) :: Sc
00053   REAL , DIMENSION(SIZE(PSVT,1))      :: WCn
00054   REAL , DIMENSION(SIZE(PSVT,1))      :: ZUSTAR, ZRESA
00055   REAL , DIMENSION(SIZE(PSVT,1), JPIN):: ZWORK
00056   REAL , DIMENSION(SIZE(PSVT,1),NSP+NCARB+NSOA,JPMODE):: ZCTOTA, ZCCTOT
00057   REAL, DIMENSION(SIZE(PSVT,1),JPMODE):: ZRHOP
00058   REAL, DIMENSION(SIZE(PSVT,1)) :: ZNU
00059   REAL, DIMENSION(SIZE(PSVT,1),JPIN)     :: Dg,zvs,zvsg, zdsg
00060   REAL, DIMENSION(SIZE(PSVT,1))        :: ZMU
00061   REAL, DIMENSION(SIZE(PSVT,1),JPIN)   :: ZVGK, ZDPK
00062   REAL, DIMENSION(SIZE(PSVT,1),JPMODE) :: ZSIG, ZRG, ZN
00063   REAL, DIMENSION(SIZE(PSVT,1),JPMODE) :: ZVG, ZDG
00064   REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2)) :: ZSVT
00065   REAL, DIMENSION(SIZE(PSVT,1))        :: ZSUM
00066   REAL, DIMENSION(NSP+NCARB+NSOA)      :: ZRHOI
00067   INTEGER :: JT, JJ, JSV, JN
00068   INTEGER :: M6I, M6J
00069   REAL :: ZDEN2MOL, ZG, ZTMP1, ZTMP2, ZTMP3, ZTMP4
00070   REAL(KIND=JPRB) :: ZHOOK_HANDLE
00071 
00072 
00073   !
00074   !============================================================================
00075   !
00076   !            Primilary
00077   !            ---------
00078   !Default values
00079   !--------------
00080 ! Cf Ackermann (all to black carbon except water)
00081 IF (LHOOK) CALL DR_HOOK('CH_AER_DEP',0,ZHOOK_HANDLE)
00082 ZRHOI(:) = 1.8e3
00083 ZRHOI(JP_AER_H2O) = 1.0e3   ! water
00084 
00085 ZDEN2MOL = 1E-6 * XAVOGADRO / XMD
00086 ZG       = 9.80665
00087 ZMU(:) = 0.
00088 ZVGK(:,:) = 0.
00089 ZVG (:,:) = 0.
00090 ZDPK(:,:) = 0.
00091 ZUSTAR(:) = MAX(PUSTAR(:), 1.E-20)
00092 ZRESA(:) = MIN(MAX(PRESA(:),   1.E-20), 9999.)
00093 ! molec./m3 to part/part
00094 DO JSV=1,SIZE(PSVT,2)
00095 ZSVT(:,JSV) = PSVT(:,JSV) * XMD / (XAVOGADRO * PRHODREF(:))
00096 ENDDO
00097 ZSVT(:,:) = MAX(ZSVT(:,:),1E-40)
00098 
00099  CALL PPP2AERO_SURF(ZSVT, PRHODREF, PSIG1D=ZSIG, PRG1D=ZRG, PN1D=ZN, PCTOTA=ZCTOTA)
00100 
00101 ZRHOP(:,:) = 0.
00102 DO JN=1,JPMODE
00103   ZSUM(:)=0.
00104   DO JJ=1,NSP+NCARB+NSOA
00105    ZSUM(:)=ZSUM(:)+ZCTOTA(:,JJ,JN)/ZRHOI(JJ)
00106   END DO
00107 
00108   DO JJ=1,NSP+NCARB+NSOA
00109    ZCCTOT(:,JJ,JN) = ZCTOTA(:,JJ,JN)/ZRHOI(JJ)/ZSUM(:)
00110    ZRHOP(:,JN)=ZRHOP(:,JN)+ZCCTOT(:,JJ,JN)*ZRHOI(JJ)
00111   ENDDO
00112 ENDDO
00113 
00114  CALL CH_AER_VELGRAV1D(ZSIG, ZRG, PTA, PRHODREF, ZRHOP, ZMU, ZVGK,ZDPK, ZVG, ZDG)
00115 
00116 Dg(:,:)  = MAX(ZDPK(:,:),1.E-40)
00117 zvs(:,:) = MAX(ZVGK(:,:),1.E-20)
00118 ZNU(:)   = ZMU(:)/PRHODREF(:)
00119 DO JN=1,JPMODE
00120 DO JJ= 0,2
00121 zvsg(:,3*JN+JJ-2) =  MAX(ZVG(:,JN),1.E-20)
00122 zdsg(:,3*JN+JJ-2) =  MAX(ZDG(:,JN),1.E-40)
00123 END DO
00124 END DO
00125 
00126 !     compute Schmidt number
00127 !     ----------------------
00128   DO  JN=1,JPIN
00129       !Sc(:,JN)= ZNU(:)/Dg(:,JN)
00130       Sc(:,JN)= ZNU(:)/zdsg(:,JN)
00131   END DO
00132 
00133 !Scale for convective velocity 
00134 ! WCn(:) = MAX((PTKE(:) - 4.65* ZUSTAR(:)**2)/0.3, 1.E-20)
00135 
00136 
00137         ! verifier l'echelle convective sinon laisser la formulation de seinfeld
00138 !    WHERE (WCn(:,:) /= XUNDEF)
00139 !     WCn(:,:) = SQRT(WCn(:,:))
00140 !    ELSEWHERE
00141      WCn(:) = 0.
00142 !    END WHERE
00143 !
00144 !
00145 Stn(:,:) =0.
00146 ZVD(:,:) = 0.
00147 ZWORK(:,:) = 0.
00148 DO JT=1,SIZE(PSVT,1)
00149  IF (ZUSTAR(JT).GE.1.E-10) THEN
00150   DO  JN=1,JPIN
00151      ZTMP1=0.
00152      ZTMP2=0.
00153      ZTMP3=0.
00154      ZTMP4=0.  
00155      Stn(JT,JN)= zvsg(JT,JN)*ZUSTAR(JT)**2/(ZG*ZNU(JT))
00156      ZTMP1=Sc(JT,JN)**(-2./3.)
00157      ZTMP2=(-3./Stn(JT,JN))
00158      IF (ZTMP2.gt.-10) then
00159        ZTMP3=10.**(ZTMP2)
00160      ELSE
00161        ZTMP3=0.
00162      ENDIF
00163      ZTMP4=ZTMP1+ZTMP3
00164      
00165      !ZRD(:,JN) = (Sc(:,JN)**(-2./3.)+ 10**(-3./Stn(:,JN)))&
00166      !      * (1 + 0.24 * WCn(:)**2 /ZUSTAR(:)**2) &
00167      !      * ZUSTAR(:)  
00168      !ZRD(:,JN) = ZUSTAR(:) * (Sc(:,JN)**(-2./3.)+ &
00169      !                           10**(-3./Stn(:,JN)))   
00170      ZRD(JT,JN) = ZUSTAR(JT) * ZTMP4                                
00171      ZRD(JT,JN) = MAX(ZRD(JT,JN),1.E-10) 
00172      ZRD(JT,JN) = 1. / ZRD(JT,JN) 
00173      ZWORK(JT,JN)= ZRESA(JT) + ZRD(JT,JN) + ZRESA(JT)*ZRD(JT,JN)*zvs(JT,JN)  
00174      ZWORK(JT,JN)= MAX(ZWORK(JT,JN), 1.E-10)
00175      ZWORK(JT,JN)= zvs(JT,JN) + 1./ ZWORK(JT,JN)
00176         !         deposition velocity for each cover type
00177         !         ----------------------------------------
00178      ZVD(JT,JN) = ZVD(JT,JN) + ZWORK(JT,JN)
00179   END DO
00180  ELSE
00181   ZVD(JT,JN)=0.
00182  END IF
00183 ENDDO  
00184 
00185 
00186 
00187   M6I=0
00188   M6J=0
00189   IF (LVARSIGI) M6I=1
00190   IF (LVARSIGJ) M6J=1
00191   DO JSV=1,SIZE(PSVT,2)-1-(2*JPMODE+M6I+M6J),2 ! mass deposition for I mode
00192   PFSVT(:,JSV) =  PFSVT(:,JSV) - PSVT(:,JSV)  * ZVD(:,2)
00193   ENDDO
00194   DO JSV=2,SIZE(PSVT,2)-(2*JPMODE+M6I+M6J),2   ! mass deposition for J mode
00195   PFSVT(:,JSV) =  PFSVT(:,JSV) - PSVT(:,JSV)  * ZVD(:,5)
00196   ENDDO
00197   ! number particles deposition I
00198   JSV = SIZE(PSVT,2)-(1+M6I+M6J)
00199   PFSVT(:,JSV) = PFSVT(:,JSV) - PSVT(:,JSV)  * ZVD(:,1)
00200   ! number particles deposition J
00201   JSV = SIZE(PSVT,2)-(M6I+M6J)
00202   PFSVT(:,JSV) = PFSVT(:,JSV) - PSVT(:,JSV)  * ZVD(:,4)
00203   ! m6 deposition I
00204   JSV = SIZE(PSVT,2)-M6J
00205   IF (LVARSIGI) PFSVT(:,JSV) = PFSVT(:,JSV) - PSVT(:,JSV)  * ZVD(:,3)
00206   ! m6 deposition J
00207   JSV = SIZE(PSVT,2)
00208   IF (LVARSIGJ) PFSVT(:,JSV) = PFSVT(:,JSV) - PSVT(:,JSV)  * ZVD(:,6)
00209 IF (LHOOK) CALL DR_HOOK('CH_AER_DEP',1,ZHOOK_HANDLE)
00210 !                                                                      
00211 !---------------------------------------------------------------------
00212 !
00213 END SUBROUTINE CH_AER_DEP