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

Go to the documentation of this file.
00001 SUBROUTINE INIT_DST(HPROGRAM,  &    ! Program calling unit
00002                   KSIZE_NATURE_P, & ! Number of nature points in a patch
00003                   KR_NATURE_P, &    ! Mask from patch --> nature vectors
00004                   KPATCH, &         ! Maximum number of patches
00005                   PVEGTYPE_PATCH  ) ! fraction (in a nature point) of a vegtype for a patch
00006 
00007 USE MODD_DST_n
00008 USE MODD_DST_SURF
00009 USE MODD_DATA_COVER_PAR, ONLY : NVT_NO, NVT_ROCK
00010 USE MODD_SURF_ATM_n,     ONLY : NSIZE_NATURE   ! Number of nature points
00011 !
00012 USE MODI_GET_LUOUT
00013 USE MODI_GET_VEGTYPE_2_PATCH_MASK
00014 USE MODI_ABOR1_SFX
00015 !
00016 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00017 USE PARKIND1  ,ONLY : JPRB
00018 !
00019 IMPLICIT NONE
00020 !
00021 !PASSED VARIABLES
00022  CHARACTER(LEN=6), INTENT(IN)      :: HPROGRAM              !Passing unit
00023 !
00024 INTEGER, DIMENSION(:), POINTER :: KSIZE_NATURE_P
00025 INTEGER, DIMENSION(:,:), POINTER :: KR_NATURE_P
00026 INTEGER, INTENT(IN)  :: KPATCH
00027 REAL, DIMENSION(:,:,:), POINTER :: PVEGTYPE_PATCH
00028 !
00029 !LOCAL VARIABLES
00030  CHARACTER(LEN=4)    :: CRGUNIT               ! type of log-normal geometric mean radius
00031 INTEGER             :: JVEG                  ! Counter for vegetation classes
00032 INTEGER             :: JVEG_IN               ! Vegetation index
00033 INTEGER             :: JPATCH                ! Counter for patches
00034 INTEGER             :: JMODE                 ! Counter for dust modes
00035 INTEGER             :: JMODE_IDX             ! Index for dust modes
00036 INTEGER             :: ILUOUT
00037 INTEGER             :: ISIZE_LARGEST_DST
00038 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00039 
00040 !get output listing unit
00041 IF (LHOOK) CALL DR_HOOK('INIT_DST',0,ZHOOK_HANDLE)
00042  CALL GET_LUOUT(HPROGRAM,ILUOUT)
00043 !
00044 !Allocate memory for the real values which will be used by the model
00045 ALLOCATE(XEMISRADIUS_DST(NDSTMDE))
00046 ALLOCATE(XEMISSIG_DST   (NDSTMDE))
00047 ALLOCATE(XMSS_FRC_SRC   (NDSTMDE))
00048 !
00049 !Get initial size distributions. This is cut and pasted
00050 !from dead routine dstpsd.F90
00051 !Check for different source parameterizations
00052 IF(CEMISPARAM_DST.EQ."She84")THEN
00053   CRGUNIT   = 'MASS'
00054   XEMISRADIUS_INI_DST(:) = 0.5d6 * (/ 0.0111e-6, 2.524e-6, 42.10e-6 /)  ! [um]  Mass median radius She84 p. 75 Table 1
00055   XEMISSIG_INI_DST   (:) = (/ 1.89 , 2.0  , 2.13 /)             ! [frc] Geometric standard deviation She84 p. 75 Table 1
00056   XMSS_FRC_SRC_INI   (:) = (/2.6e-6, 0.781, 0.219/)             ! [frc] Mass fraction She84 p. 75 Table 1
00057 ELSEIF(CEMISPARAM_DST.EQ."PaG77")THEN
00058   CRGUNIT   = 'MASS'
00059   XEMISRADIUS_INI_DST(:) = 0.5d6 * (/0.27e-6  ,  5.6e-6  ,  57.6e-6 /) ! [um] Mass median radius PaG77 p. 2080 Table 1 
00060   XEMISSIG_INI_DST   (:) = (/ 1.88, 2.2  , 1.62 /)              ! [frc] Geometric standard deviation PaG77 p. 2080 Table 1
00061   XMSS_FRC_SRC_INI   (:) = (/0.036, 0.957, 0.007/)              ! [frc] Mass fraction BSM96 p. 73 Table 2 (ad hoc)  
00062 ELSEIF(CEMISPARAM_DST.EQ."Dal87") THEN 
00063   ! D'Almeida, 1987 as default
00064   CRGUNIT   = 'MASS'
00065   XEMISRADIUS_INI_DST(:) = 0.5d6 * (/ 0.832e-6 ,  4.82e-6 , 19.38e-6 /) ! [um] Mass median radius BSM96 p. 73 Table 2
00066   XEMISSIG_INI_DST   (:) = (/ 2.10, 1.90 , 1.60 /)              ! [frc] Geometric standard deviation BSM96 p. 73 Table 2
00067   XMSS_FRC_SRC_INI   (:) = (/0.036, 0.957, 0.007/)              ! [frc] Mass fraction BSM96 p. 73 Table 2  
00068 ELSEIF (CEMISPARAM_DST.EQ."alf98".OR.CEMISPARAM_DST.eq."EXPLI") THEN  !  Alfaro et al 1998 as default
00069   IF (CEMISPARAM_DST.EQ."alf98") XFLX_MSS_FDG_FCT = 6e-4
00070   IF (CEMISPARAM_DST.EQ."EXPLI") XFLX_MSS_FDG_FCT = 3.5e-4
00071   CRGUNIT   = 'MASS'
00072   XEMISRADIUS_INI_DST(:) = 0.5*(/ 1.5, 6.7, 14.2 /)      ! [um] Mass median radius BSM96 p. 73 Table 2
00073   XEMISSIG_INI_DST   (:) = (/1.70, 1.60, 1.50/)          ! [frc] Geometric standard deviation BSM96 p. 73 Table 2
00074   XMSS_FRC_SRC_INI   (:) = (/0.01, 0.19, 0.8 /)          ! [frc] Mass fraction BSM96 p. 73 Table 2  
00075 ELSEIF (CEMISPARAM_DST.EQ."AMMA ") THEN ! Default: New distribution from AMMA
00076   XFLX_MSS_FDG_FCT = 60.e-4
00077   CRGUNIT   = 'NUMB' 
00078   XEMISRADIUS_INI_DST(:) = 0.5*(/ 0.078, 0.641, 5.00 /)  ! [um] Number median radius 
00079   XEMISSIG_INI_DST   (:) = (/ 1.75,  1.76, 1.70/)        ! [frc] Geometric standard deviation 
00080   XMSS_FRC_SRC_INI   (:) = (/0.008, 0.092, 0.99/)        ! [frc] Mass fraction  
00081 ELSEIF (CEMISPARAM_DST.EQ."CRUM ") THEN ! Default: New distribution from AMMA
00082   XFLX_MSS_FDG_FCT = 10.e-4
00083   CRGUNIT   = 'NUMB' 
00084   XEMISRADIUS_INI_DST(:) = 0.5*(/ 0.078, 0.641, 5.00 /)  ! [um] Number median radius 
00085   XEMISSIG_INI_DST   (:) = (/  1.75,   1.76, 1.70   /)   ! [frc] Geometric standard deviation   
00086   XMSS_FRC_SRC_INI   (:) = (/0.0005, 0.0029, 0.9966/)    ! [frc] Mass fraction  
00087 ELSE
00088   WRITE(ILUOUT,*) " FATAL ERROR "
00089   WRITE(ILUOUT,*) " YOU MUST DECIDE THE EMISSIUON PARAMETERIZATION, YOU USES "
00090   WRITE(ILUOUT,*) " CEMISPARAM_DST = ",CEMISPARAM_DST," AND IT IS NOT DEFINED "
00091   WRITE(ILUOUT,*) " see init_dstn.f90 to see what dust parameterization is available. "
00092   CALL ABOR1_SFX("INIT_DST: CEMISPARAM_DST not defined ")
00093 ENDIF
00094 !
00095 DO JMODE=1,NDSTMDE
00096   JMODE_IDX=JORDER_DST(JMODE)
00097   !
00098   XEMISSIG_DST   (JMODE) = XEMISSIG_INI_DST(JMODE_IDX)
00099   XEMISRADIUS_DST(JMODE) = XEMISRADIUS_INI_DST(JMODE_IDX)
00100   XMSS_FRC_SRC   (JMODE) = XMSS_FRC_SRC_INI(JMODE_IDX)
00101   !
00102   !Get emisradius, and at the same time convert to number median radius
00103   IF (CRGUNIT=='MASS') &
00104     XEMISRADIUS_DST(JMODE) = XEMISRADIUS_DST(JMODE) * EXP(-3.d0 * (LOG(XEMISSIG_DST(JMODE)))**2)  
00105   !
00106 ENDDO
00107 !
00108 !Normalize the sum of the emissions to 1 so that all dust is
00109 !put in one mode or the other
00110 IF(SUM(XMSS_FRC_SRC(:)).LT.1.) XMSS_FRC_SRC(:) = XMSS_FRC_SRC(:) / SUM(XMSS_FRC_SRC(:))
00111 !
00112 !Allocate memory
00113 !ALLOCATE(NVEGNO_DST)
00114 !Set the number of classes that can emit dust (fxm: set this elsewhere)
00115 NVEGNO_DST = 2
00116 !
00117 !Allocate memory for the vegtype-translator
00118 ALLOCATE(NVT_DST(NVEGNO_DST))
00119 !
00120 !Set the dust/vegtype translator vector
00121 NVT_DST(1)  = NVT_NO
00122 NVT_DST(2)  = NVT_ROCK
00123 !
00124 !Allocate memory for roughness lengths of erodible surfaces
00125 ALLOCATE(Z0_EROD_DST(NVEGNO_DST))
00126 !
00127 !Set the roughness lengths corresponding to erodible surfaces
00128 !Smooth roughness length is given to 1.d-5 (dstmbl.f90)
00129 Z0_EROD_DST(1) = 30.d-6    !m (30 um) 
00130 Z0_EROD_DST(2) = 200.d-6   !m (200 um) 
00131 !
00132 !Allocate memory for dust emitter surface vectors in patch vectors
00133 IF (.NOT.ASSOCIATED(NSIZE_PATCH_DST)) ALLOCATE(NSIZE_PATCH_DST(NVEGNO_DST,KPATCH))
00134 !
00135 DO JPATCH = 1,KPATCH
00136   DO JVEG = 1,NVEGNO_DST
00137     !Count all the points in the patch where you have dust emitter vegetation
00138     NSIZE_PATCH_DST(JVEG,JPATCH) = COUNT(PVEGTYPE_PATCH(:,NVT_DST(JVEG),JPATCH) > 0.) 
00139   ENDDO
00140 ENDDO
00141 !
00142 !Find the largest dust emitter vector in any patch
00143 !ALLOCATE (NSIZE_LARGEST_DST)
00144 ISIZE_LARGEST_DST = 0
00145 DO JPATCH=1,KPATCH
00146   DO JVEG = 1,NVEGNO_DST
00147     ISIZE_LARGEST_DST = max(ISIZE_LARGEST_DST,NSIZE_PATCH_DST(JVEG,JPATCH))
00148   ENDDO
00149 ENDDO
00150 !
00151 !Allocate memory for NR_PATCH_DST mask translate from patch vector to dust vector
00152 ALLOCATE(NR_PATCH_DST(ISIZE_LARGEST_DST,NVEGNO_DST,KPATCH))
00153 !
00154 !Initialize the mask array
00155 NR_PATCH_DST(:,:,:)=0
00156 !
00157 !Get values from the dust emitter vegetation mask
00158 DO JPATCH=1,KPATCH
00159   DO JVEG=1,NVEGNO_DST
00160     JVEG_IN = NVT_DST(JVEG)          ! Get the real vegtype index
00161     CALL GET_VEGTYPE_2_PATCH_MASK(ILUOUT,    &
00162              NSIZE_PATCH_DST(JVEG,JPATCH),             &!I Size of dust emitter vector
00163              KSIZE_NATURE_P(JPATCH),                   &!I Size of patch vector
00164              NSIZE_NATURE,                             &!I Size of nature vector
00165              KR_NATURE_P,                              &!I Mask from patch to nature
00166              PVEGTYPE_PATCH,                           &!I Fraction of vegtype of nature point within jpatch 
00167              NR_PATCH_DST(:NSIZE_PATCH_DST(JVEG,JPATCH),JVEG,JPATCH),  &!O Part of mask array to fill with values
00168              KPATCH,                                   &!I Number of possible patches
00169              JPATCH,                                   &!I Index of patch in question
00170              JVEG_IN                                  &!I Index of vegtype in question
00171              )  
00172   ENDDO !Loop on patches
00173 ENDDO    !Loop on veg-types
00174 !
00175 IF (LHOOK) CALL DR_HOOK('INIT_DST',1,ZHOOK_HANDLE)
00176 !
00177 END SUBROUTINE INIT_DST
00178