! Copyright 2008-2021 Earth Sciences Department, BSC-CNS
!
! This file is part of MONARCH.
!
! MONARCH is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! MONARCH is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with MONARCH. If not, see <http://www.gnu.org/licenses/>.
!-----------------------------------------------------------------------
!
      program dust_start
!
!-----------------------------------------------------------------------
!
      INTEGER dom, max_dom,imi,jmi,jm,im,lm,nfcst,l
      include 'lmimjm.inc'
!      include 'llgrid.inc'
!
!-----------------------------------------------------------------------
!
      logical run, global
      character*128 infile,fname
      integer idat(3),ihrst
     &,sizebins             !!number of dust transport bins
     &,soiltypes            !!number of soil types
     &,soilbins             !!number of soil grains categories
     &,soilbins2            !!number of soil grains categories + 1 category for kok emission scheme following Zender's approach for the threshold
     &,sourcemodes          !!number of source modes
     &,vegtypes             !!number of landuse (world olson ecosystems) types
     &,vegtypes2            !!number of landuse (USGS... NMMb) types  NEW!!!!!
     &,n
     &,s
     &,idst                 ! index in particle-size distribution for dust cut-off 
     &,psdmax 
     &,stypes

      parameter (sizebins=8,soilbins=4,sourcemodes=3,soiltypes=16
     &          ,vegtypes=99
     &          ,soilbins2=5
     &          ,vegtypes2=30
     &          ,stypes=12
     &          ,psdmax=60) ! psdmax: number of particle-size distribution bins 

      real
     & m
     &,dum
     &,dcut

      real
     & snow(imi,jmi)
     &,landusefrac(imi,jmi)
     &,wprim(imi,jmi)
     &,clayfrac(imi,jmi)
     &,siltfrac(imi,jmi)
     &,sandfrac(imi,jmi)
     &,snow_integer(imi,jmi)
     &,vegfrac(imi,jmi)
     &,vegfrcPv(imi,jmi)
     &,vegfrcNpv(imi,jmi)
     &,erodfrac(imi,jmi,3)
     &,height(imi,jmi)
     &,seamask(imi,jmi)
!     &,source(imi,jmi)
     &,source_old(imi,jmi) 
     &,source_nomask_old(imi,jmi) 
     &,source_new_nat(imi,jmi)
     &,source_new_ant(imi,jmi)
     &,fbare_modis(imi,jmi)
     &,pref(imi,jmi,4)
     &,drysmc(imi,jmi)
     &,a_smois(imi,jmi)
     &,b_smois(imi,jmi)
     &,psdm(imi,jmi,psdmax)
     &,dpsdm(imi,jmi,psdmax)
     &,psdf(imi,jmi,psdmax)
     &,dpsdf(imi,jmi,psdmax)
     &,ibin_u(sizebins)
     &,ibin_l(sizebins)
     &,mij(sourcemodes,sizebins)
!     &,mn(sizebins)
     &,mn1(sizebins)   !D'Almeida
     &,mn2(sizebins)   !Kok
     &,mn3(sizebins)   !Ginoux
     &,bedrock_fr(imi,jmi) !bedrock fraction
     &,z0_prig(imi,jmi) !roughness from ascat and polder
     &,sum_kount
     &,alpha(imi,jmi,2)
     &,alpha_soil(soilbins)
     &,bare_soil_fr(imi,jmi)
     &,pradi(sizebins)
     &,pradi_max(sizebins)
     &,pradi_min(sizebins)
     &,pdens(sizebins)
     &,soildens(soilbins2)
     &,soil_diam(soilbins2)
     &,soil_mf(imi,jmi,soilbins)
     &,soil_mf_orig(imi,jmi,soilbins)
     &,soil_sa(imi,jmi,soilbins)
     &,soil_sa_orig(imi,jmi,soilbins)
     &,soil_sa_tot(imi,jmi)
     &,soil_sa_tot_orig(imi,jmi)
     &,source_diam(sourcemodes)
     &,source_sigma(sourcemodes)
     &,source_mf(sourcemodes)
     &,gama(sizebins)
     &,ustrtrk(soilbins2)
     &,aa(sizebins)
     &,wpr(soiltypes)
     &,bcly(soiltypes)
     &,bslt(soiltypes)
     &,bsnd(soiltypes)
     &,t_bcly(soiltypes)
     &,t_bslt(soiltypes)
     &,t_mfsnd(soiltypes)
     &,t_csnd(soiltypes)
     &,t_bcly_k(soiltypes)
     &,t_bslt_k(soiltypes)
     &,t_mfsnd_k(soiltypes)
     &,t_csnd_k(soiltypes)
     &,dsmc(soiltypes)     
     &,a_sm(soiltypes)     
     &,b_sm(soiltypes)     
     &,d0(0:psdmax)
     &,dd(psdmax)
     &,psd_m(psdmax,stypes)
     &,dpsd_m(psdmax,stypes)
     &,psd_f(psdmax,stypes)
     &,dpsd_f(psdmax,stypes)
     &,dm(psdmax)     
     &,ustart0(psdmax)    
     &,pmass(psdmax)
     &,REYNTH(soilbins2)
     &,delta(imi,jmi,sizebins)
     &,gpss(sizebins)
     &,ustrtr(imi,jmi,soilbins2)
     &,prueba(imi,jmi)

      integer
     & topsoiltypecorr(imi,jmi)
     &,landusecorr(imi,jmi)
     &,landusenewcorr(imi,jmi)
     &,landusedust(imi,jmi)
     &,kount_landusenew(vegtypes,imi,jmi)
     &,kount_topsoiltype(30,imi,jmi)
     &,kount_landuse(vegtypes2,imi,jmi)
     &,kount_total(imi,jmi)
     &,kount_dust(imi,jmi)
     &,n053,n060,s026,s060,s030,e135,e142,n010,s015,w030
      real
     & padded2(im,jm),ipadded2(im,jm),paddedn(nwets,im,jm)
     &,paddedn2(im,jm,sizebins),paddedn3(im,jm,3)
     &,paddedn6(im,jm,2)
     &,paddedn4(im,jm,soilbins)
     &,paddedn5(im,jm,soilbins2)
     &,paddedn60(im,jm,psdmax)
!
     &,cdm(vegtypes),cvm(vegtypes),asmm(vegtypes),rsqcd0vm(vegtypes)
!     &,qext550(sizebins),z0vegusgs(vegtypes)
     &,z0vegusgs(vegtypes)
!
      real
     & z0corr(imi,jmi),roughness(imi,jmi),z0new(imi,jmi),z0base(imi,jmi)
!
      parameter (sbdtmp1=sbd+60.
     &,          sbdtmp2=sbd+58.,sbdtmp3=2.*sbd
     &,          wbdtmp1=wbd+90.,wbdtmp3=2.*wbd)
!
!      parameter (n060=jmi-jmi*sbdtmp1/sbdtmp3-tph0d*dphd                  ! model grid point at 60N
!     &,          n058=jmi-jmi*sbdtmp2/sbdtmp3-tph0d*dphd                  ! model grid point at 58N
!     &,          e090=imi-imi*wbdtmp1/wbdtmp3-tlm0d*dlmd)                 ! model grid point at 90E
!
!Australia dust sources
!      parameter (sbdtmp26=sbd-26.
!     &,          sbdtmp2=sbd+58.,sbdtmp3=2.*sbd
!     &,          wbdtmp1=wbd+90.,wbdtmp3=2.*wbd)
!

!      parameter (s26=jmi-jmi*sbdtmp1/sbdtmp3-tph0d*dphd                  ! model grid point at 26N
!     &,          s30=jmi-jmi*sbdtmp2/sbdtmp3-tph0d*dphd                  ! model grid point at 30S
!     &,          e135=imi-imi*wbdtmp1/wbdtmp3-tlm0d*dlmd                 ! model grid point at 135E
!     &,          e142=imi-imi*wbdtmp1/wbdtmp3-tlm0d*dlmd)                 ! model grid point at 142E

      parameter (dlm5=5/dlmd,dph5=5/dphd)
      CHARACTER (LEN=72) :: setwd
      CHARACTER (LEN=1) :: nchar
      CHARACTER (LEN=100) :: namelist_file,esmf_input,domain_input
      CHARACTER (LEN=100) :: domain_file,source_file,geo_input
! ------ VARIABLES from 'input_domain_0X' ------
      integer, parameter :: nfields=22,ndyn=6
      integer :: ihrend,ntsd,ij
      integer :: i_par_sta,j_par_sta,imm,jmm,lmm,lnsh2,lpt2
      real    :: pt2,pd,pdtop,dlmd2,dphd2,wbd2,sbd2,tlm0d2,tph0d2,lll
!      real, dimension(44+1) :: sgm,sg1,sg2
!      real, dimension(44) :: dsg1,sgml1,dsg2,sgml2
      real, ALLOCATABLE :: sgm(:),sg1(:),sg2(:),dum2d(:,:,:)
      real, ALLOCATABLE :: dsg1(:),sgml1(:),dsg2(:),sgml2(:)
      real, ALLOCATABLE :: stmp(:,:,:),smst(:,:,:),sh2o(:,:,:)
      real, ALLOCATABLE :: field(:,:,:),dyn(:,:,:),dum3d(:,:,:)
      integer, ALLOCATABLE :: ifield(:,:,:)
      character(10), dimension(nfields) :: field_name
      character(10), dimension(ndyn) :: dyn_name
        character :: nps_char, domain_char
        integer   :: nps, domain

      field_name=(/'fis       ','stdh      ','sm        ','pd        ',
     &             'albedo    ','albase    ','emissivity','snowalbedo',
     &             'tskin     ','sst       ','snow      ','snowheight',
     &             'cice      ',
     &             'deeptemp  ','canopwater','fz_prec_rm','ustar     ',
     &             'z0        ','z0base    ','topsoiltyp','landuse   ',
     &             'vegfra    '/)

      dyn_name  =(/'u         ','v         ','t         ','q         ',
     &             'w         ','o3        '/)


!
!----------------------------------------------------------------------
!!! WPR is calculated from Fecan et al 1999 as 0.0014(%clay)^2+0.17(%clay)
!----------------------------------------------------------------------
!
      data wpr /0.52,1.07,1.84,2.44,0.88,3.51,5.61,7.40,7.40,9.61,11.08
     &,14.57,0.00,0.00,0.00,0.00/
!
!----------------------------------------------------------------------
!!! OLD  FRACTIONS  (NOT USED)
!----------------------------------------------------------------------
!
!      data bcly /0.03,0.06,0.10,0.13,0.05,0.18,0.27,0.34,0.34,0.42,0.47
!     &,0.58,0.00,0.00,0.00,0.00/
!      data bslt /0.05,0.12,0.32,0.70,0.85,0.39,0.15,0.56,0.34,0.06,0.47
!     &,0.20,0.00,0.00,0.00,0.00/
!      data bsnd /0.92,0.82,0.58,0.17,0.10,0.43,0.58,0.10,0.32,0.52,0.06
!     &,0.22,0.00,0.00,0.00,0.00/
!
!----------------------------------------------------------------------
!!! TEGEN ET AL 2002 (same as below, but clay into silt fraction)
!----------------------------------------------------------------------
!
      data t_bcly /0.03,0.00,0.10,0.13,0.05,0.18,0.27,0.34,0.34
     &,0.42,0.47,0.58,0.00,0.00,0.00,0.00/
      data t_bslt /0.05,0.18,0.32,0.70,0.85,0.39,0.15,0.56,0.34
     &,0.06,0.47,0.20,0.00,0.00,0.00,0.00/
      data t_mfsnd /0.46,0.41,0.26,0.17,0.10,0.43,0.29,0.10,0.32
     &,0.52,0.06,0.22,0.00,0.00,0.00,0.00/
      data t_csnd /0.46,0.41,0.26,0.00,0.00,0.00,0.29,0.00,0.00
     &,0.00,0.00,0.00,0.00,0.00,0.00,0.00/
!
! 
! original mass fractions for STATSGO-FAO soil texture classes (but using the four categories from Tegen et al.)
      data t_bcly_k /0.03,0.06,0.10,0.13,0.05,0.18,0.27,0.34,0.34,0.42,0.47
     &,0.58,0.00,0.00,0.00,0.00/
      data t_bslt_k /0.05,0.12,0.32,0.70,0.85,0.39,0.15,0.56,0.34,0.06,0.47
     &,0.20,0.00,0.00,0.00,0.00/
      data t_mfsnd_k /0.46,0.41,0.26,0.17,0.10,0.43,0.29,0.10,0.32
     &,0.52,0.06,0.22,0.00,0.00,0.00,0.00/
      data t_csnd_k /0.46,0.41,0.26,0.00,0.00,0.00,0.29,0.00,0.00
     &,0.00,0.00,0.00,0.00,0.00,0.00,0.00/


!----------------------------------------------------------------------         
!!! 8 DUST TRANSPORT SIZE BINS
!----------------------------------------------------------------------
!
      data pradi /0.15,0.25,0.47,0.80,1.36,2.29,3.93,7.24/ !dust volume radius (microns)
      data pradi_max /0.18,0.3,0.6,1.,1.8,3.,6.,10./       !max radius of dust transport bin (microns)
      data pradi_min /0.1,0.18,0.3,0.6,1.,1.8,3.,6./       !min radius of dust transport bin (microns)
      data pdens /2.50,2.50,2.50,2.50,2.65,2.65,2.65,2.65/ !dust density (g/cm3)
!
!----------------------------------------------------------------------
!!! 4 SOIL SIZE CATEGORIES
!----------------------------------------------------------------------

!      data soil_diam /2.E-6,15.E-6,160.E-6,710.E-6/   !soil grains mean diameter (m)
!      data soildens /2500.,2650.,2650.,2650./            !soil grains density (kg/m3)
! added mode for kok emission scheme for diameter = 70 microns from Zender et al 2003
       data soil_diam /2.E-6,15.E-6,160.E-6,710.E-6,70.E-6/   !soil grains mean diameter (m)
       data soildens /2500.,2650.,2650.,2650.,2650./          !soil grains density (kg/m3)
!
!----------------------------------------------------------------------
!!! TRI-MODAL SIZE DISTRIBUTION IN SOURCE REGIONS (D'ALMEIDA 1987) FROM ZENDER 2003
!----------------------------------------------------------------------
!
      data source_diam /0.832,4.82,19.38/            !mass mean diameter (microns)
      data source_sigma /2.10,1.9,1.6/               !geometric standard deviation
      data source_mf /0.036,0.957,0.007/             !mass fraction
!!!
      data adens /0.00122/
      data G /9.80/
      data gama /0.08,0.08,0.08,0.08,1.,1.,1.,1./
      data aa  /1.,0.9,0.8,0.8,0.7,0.6,0.5,0.4/
!!!      data qext550 /1.373,3.303,3.245,2.413,2.262,2.260,2.162,2.108/
!
      data cdm /.35,.35,.40,.50,.50,.50,.35,0.0,.35,.30                     !<-- local drag coefficient for vegetation
     &         ,0.0,0.0,0.0,0.0,0.0,.40,.40,.50,.50,.50
     &         ,.40,.40,.50,.50,.50,.50,.50,.50,.50,.30
     &         ,.30,.50,.50,.50,.30,.35,.30,.30,.30,.35
     &         ,.35,.35,.35,.35,.35,.40,.40,.50,0.0,0.0
     &         ,0.0,0.0,.30,.50,.50,.50,.50,.30,.40,.50
     &         ,.50,.40,.35,.40,.35,.35,.35,.35,.35,0.0
     &         ,0.0,.50,0.0,0.0,0.0,.30,.40,.50,0.0,.35
     &         ,0.0,0.0,0.0,0.0,.35,0.0,.35,0.0,.50,.50
     &         ,.35,.30,.35,.40,.50,.50,0.0,0.0,0.0/
      data cvm /.09,.09,.12,.16,.16,.16,.09,0.0,.09,.08                     !<-- local viscous drag coefficient for vegetation
     &         ,0.0,0.0,0.0,0.0,0.0,.12,.12,.16,.16,.16
     &         ,.12,.12,.16,.16,.16,.16,.16,.16,.16,.08
     &         ,.08,.16,.16,.16,.08,.09,.08,.08,.08,.09
     &         ,.09,.09,.09,.09,.09,.12,.12,.16,0.0,0.0
     &         ,0.0,0.0,.09,.16,.16,.16,.16,.09,.12,.16
     &         ,.16,.12,.09,.12,.09,.09,.09,.09,.09,0.0
     &         ,0.0,.16,0.0,0.0,0.0,.08,.12,.16,0.0,.09
     &         ,0.0,0.0,0.0,0.0,.09,0.0,.09,0.0,.16,.16
     &         ,.09,.08,.09,.12,.16,.16,0.0,0.0,0.0/
      data rsqcd0vm /3.0,3.0,2.5,2.0,2.0,2.0,3.0,0.0,3.0,3.5                !<-- root squared surface drag coefficient
     &              ,0.0,0.0,0.0,0.0,0.0,2.5,2.5,2.0,2.0,2.0
     &              ,2.5,2.5,2.0,2.0,2.0,2.0,2.0,2.0,2.0,3.5
     &              ,3.5,2.0,2.0,2.0,3.5,3.0,3.5,3.5,3.5,3.0
     &              ,3.0,3.0,3.0,3.0,3.0,2.5,2.5,2.0,0.0,0.0
     &              ,0.0,0.0,3.0,2.0,2.0,2.0,2.0,3.0,2.5,2.0
     &              ,2.0,2.5,3.0,2.5,3.0,3.0,3.0,3.0,3.0,0.0
     &              ,0.0,2.0,0.0,0.0,0.0,3.5,2.5,2.0,0.0,3.0
     &              ,0.0,0.0,0.0,0.0,3.0,0.0,3.0,0.0,2.0,2.0
     &              ,3.0,3.5,3.0,2.5,2.0,2.0,0.0,0.0,0.0/
      data asmm /3.2E-5,3.2E-5,0.0,0.0,0.0,0.0,3.2E-5,0.0,3.2E-5,1.4E-5     !<-- ratio between areas of small ...
     &          ,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0                    !<-- collectors and roughness elements
     &          ,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,1.4E-5
     &          ,1.4E-5,0.0,0.0,0.0,1.4E-5,3.2E-5,1.4E-5,1.4E-5,1.4E-5
     &          ,3.2E-5
     &          ,3.2E-5,3.2E-5,3.2E-5,3.2E-5,3.2E-5,0.0,0.0,0.0,0.0,0.0
     &          ,0.0,0.0,3.2E-5,0.0,0.0,0.0,0.0,3.2E-5,0.0,0.0
     &          ,0.0,0.0,3.2E-5,0.0,3.2E-5,3.2E-5,3.2E-5,3.2E-5,3.2E-5
     &          ,0.0
     &          ,0.0,0.0,0.0,0.0,0.0,1.4E-5,0.0,0.0,0.0,3.2E-5
     &          ,0.0,0.0,0.0,0.0,3.2E-5,0.0,3.2E-5,0.0,0.0,0.0
     &          ,3.2E-5,1.4E-5,3.2E-5,0.0,0.0,0.0,0.0,0.0,0.0/
!
!      data z0vegtbl / 1.000,0.070,0.070,0.070,0.070,0.150                  !<-- NMMB SSiB model vegetation roughness
!     &               ,0.080,0.030,0.050,0.860,0.800,0.850
!     &               ,2.650,1.090,0.800,0.001,0.040,0.050
!     &               ,0.010,0.040,0.060,0.050,0.030,0.001
!     &               ,0.010,0.150,0.010,0.000,0.000,0.000/
!
      data z0vegusgs /1.000,0.080,1.090,0.850,0.800,2.650,0.050,0.010       !<-- converted OLSEN vegetation roughness
     &               ,0.040,0.080,0.010,0.001,0.050,0.001,0.001,0.030
     &               ,0.030,0.800,0.800,2.650,1.090,1.090,0.800,0.800
     &               ,0.800,0.800,1.090,0.800,2.650,0.070,0.070,0.150
     &               ,2.650,0.150,0.070,0.070,0.070,0.070,0.070,0.050
     &               ,0.070,0.080,0.860,0.050,0.040,0.030,0.030,0.150
     &               ,0.150,0.010,0.010,0.010,0.010,0.050,0.150,0.150
     &               ,0.150,0.860,0.030,0.050,0.050,0.050,0.060,0.030
     &               ,0.040,0.040,0.040,0.040,0.010,0.150,0.010,0.050
     &               ,0.010,0.010,0.010,0.150,1.090,0.800,0.050,0.010
     &               ,0.010,0.010,0.010,0.010,0.010,0.150,0.050,0.030
     &               ,0.030,2.650,0.860,0.150,0.070,0.050,0.000,0.000
     &               ,0.000,0.000,0.000/
! Parameters needed for soil moisture correction of ustart
! dsmc, a_sm, b_sm:
! Data based on Shao and Jung, 2000, unpublished manuscript
! Data invented for sand, loamy sand, sandy loam, loam, clay loam, and clay
! Parameters published in Klose et al. (2014), JGR
      data dsmc /0.001, 0.003, 0.037, 0.061, 0.072, 0.049, 0.084, 0.110 
     &          ,0.095, 0.126, 0.141, 0.156, 0.000, 0.000, 0.000, 0.000/
      data a_sm /21.19, 33.03, 44.87, 20.81, 23.83, 17.79, 26.84, 27.51 
     &          ,29.86, 25.17, 22.82, 20.47, 0.00, 0.00, 0.00, 0.00 /
      data b_sm /0.68, 0.71, 0.85, 0.66, 0.71, 0.61, 0.75, 0.75
     &          ,0.80, 0.70, 0.64, 0.59, 0.00, 0.00, 0.00, 0.00 /
!
      data
     & infile/'
     &       '/
     &,fname /'
     &       '/
!
!---------------------
      call getarg(1, nps_char)
      read (nps_char, *) nps
!---------------------
!
!-----------------------------------------------------------------------
!!! reading of data
!----------------------------------------------------------------------
!
        print*,' '
        print*,'grid exclusions:',n058,n060,e090
        print*,' '
!
!
        if(nps==0)then !original reading of dust_start using serial prepocessing
!
!
        infile='../output/llspl.000'
        open(unit=1,file=infile,status='old',form='unformatted')
        read(1) run,idat,ihrst
        close(1)

        global=im.gt.imi
!
        nfcst=18
        write(fname,'(a)')'../output/soildust'
        open(unit=nfcst,file=fname
     &      ,status='unknown',form='unformatted')
        run=.true.
        write (nfcst) run,idat,ihrst
     
        print*, run,idat,ihrst
      
          open(unit=2,file='../output/snow'
     &        ,status='old',form='unformatted')
          read (2) snow
          close(2)
!
          open(unit=2,file='../output/topsoiltypecorr'
     &        ,status='old',form='unformatted')
          read (2) topsoiltypecorr
          close(2)
!
          open(unit=2,file='../output/landusecorr'
     &        ,status='old',form='unformatted')
          read (2) landusecorr
          close(2)

          open(unit=2,file='../output/landusenewcorr'
     &        ,status='old',form='unformatted')
          read (2) landusenewcorr                               !dominant landusenew type
!          print*, landusenewcorr(100,100)
          close(2)

          open(unit=2,file='../output/kount_landuse'
     &        ,status='old',form='unformatted')
          read (2) kount_landuse                                !kount of each landusenew type
          close(2)

          open(unit=2,file='../output/kount_landusenew'
     &        ,status='old',form='unformatted')
          read (2) kount_landusenew                             !kount of each landusenew type
          close(2)

          open(unit=2,file='../output/kount_topsoiltype'
     &       ,status='old',form='unformatted')
          read(2) kount_topsoiltype
          close(2)
!
          open(unit=2,file='../output/vegfrac'
     &        ,status='old',form='unformatted')
          read (2) vegfrac
          close(2)
!
          open(unit=2,file='../output/vegfrcPv'
     &        ,status='old',form='unformatted')
          read (2) vegfrcPv
          close(2)

          open(unit=2,file='../output/vegfrcNpv'
     &        ,status='old',form='unformatted')
          read (2) vegfrcNpv
          close(2)

          open(unit=2,file='../output/height'
     &        ,status='old',form='unformatted')
          read (2) height
          close(2)

          open(unit=2,file='../output/seamask'
     &        ,status='old',form='unformatted')
          read (2) seamask
          close(2)
!
!          open(unit=2,file='../output/source'
!     &        ,status='old',form='unformatted')
!          read (2) source
!          close(2)

!
          open(unit=2,file='../output/source_old'
     &        ,status='old',form='unformatted')
          read (2) source_old
          close(2)
!
          open(unit=2,file='../output/source_nomask_old'
     &        ,status='old',form='unformatted')
          read (2) source_nomask_old
          close(2)
!
          open(unit=2,file='../output/source_new_nat'
     &        ,status='old',form='unformatted')          
          read (2) source_new_nat
          close(2)
!
          open(unit=2,file='../output/source_new_ant'
     &        ,status='old',form='unformatted')
          read (2) source_new_ant
          close(2)

          open(unit=2,file='../output/fbare_modis'
     &        ,status='old',form='unformatted')
          read (2) fbare_modis
          close(2)

          open(unit=2,file='../output/roughness_prigent'
     &        ,status='old',form='unformatted')
          read (2) z0_prig 
          close(2)

          open(unit=2,file='../output/z0corr'
     &        ,status='old',form='unformatted')
          read (2) z0corr
          close(2)
!
          open(unit=2,file='../output/roughness'
     &        ,status='old',form='unformatted')
          read (2) roughness
          close(2)
!
!
       else !nps=1 reading output from parallel nps
       print *,'Reading from nps'
! all variables defined with lpt2 changed by lm
       allocate(field(imi,jmi,nfields))
       allocate(ifield(imi,jmi,nfields))
       allocate(dyn(imi,jmi,lm))
       allocate(stmp(nwets,imi,jmi),smst(nwets,imi,jmi),
     & sh2o(nwets,imi,jmi))
       allocate(sgm(lm+1),sg1(lm+1),dsg1(lmp))
       allocate(sgml1(lm),sg2(lm+1),dsg2(lm),sgml2(lm))
       allocate(dum2d(imi,jmi,1),dum3d(imi,jmi,lm)) ! ,24))


      global=im.gt.imi
!
      nfcst=18
      write(fname,'(a)')'../output/soildust'
      open(unit=nfcst,file=fname
     &     ,status='unknown',form='unformatted')
      run=.true.
      write (nfcst) run,idat,ihrst ! do we need idat and ihrst in monarch? here have null values.

      print*, run,idat,ihrst

      esmf_input='../input_domain'

      open(unit=3,file=esmf_input,status='old',form='unformatted')

      read(3) run,idat,ihrst,ihrend,ntsd
!      print*, run,idat,ihrst,ihrend,ntsd

      read(3) pt2,pdtop,lpt2,sgm,sg1,dsg1,sgml1,sg2,dsg2,sgml2
!      print*, pt,pdtop,lpt2,sgm,sg1,dsg1,sgml1,sg2,dsg2,sgml2

      read(3) i_par_sta,j_par_sta
!      print*, i_par_sta,j_par_sta

      read(3) dlmd2,dphd2,wbd2,sbd2,tlm0d2,tph0d2
!      print*, dlmd,dphd,wbd,sbd,tlm0d,tph0d

      read(3) imm,jmm,lmm,lnsh2
!      print*, imm,jmm,lmm,lnsh2
!---- HEIGHT (OR FIS) ---- 28th position      
      read(3) fis
        height = fis/9.81
      read(3) stdh
!---- SEAMASK ------------ 30th position
      read(3) seamask
!      print*,"seamask...",seamask

      read(3) pd
      !stop

      do i=1,ndyn
       do l=1,lm ! lpt2
          read(3) dyn(:,:,l) !,i)
       enddo
         print *,'Reading: ',dyn_name(i)
      enddo
!      stop
      do i=5,nfields-4 ! 5
         read(3) field(:,:,i)
         print *,'Reading: ',field_name(i)
      enddo
      read(3) z0corr
      print *,'Reading: z0corr' ! Z0BASE (currently same as Z0)
!      read(3) field(:,:,nfields-3)
!      stop     
!      do i = 1,nwets
      read(3) ! stmp(i,:,:)
      print *,'Reading: stc'
!      end do

!      do i = 1,nwets
      read(3) ! smst(i,:,:)
      print *,'Reading: smc'
!      end do

!      do i = 1,nwets
      read(3) ! sh2o(i,:,:)
      print *,'Reading: sh2o'
!      end do

!---- SOIL TYPE (56th position)
      read(3) ifield(:,:,nfields-2)
      topsoiltypecorr=ifield(:,:,nfields-2)
      print *,'Reading: ',field_name(nfields-2)
         !stop
!      print *,ifield(:,:,nfields-2)
!---- LSNDUSE (or VEGTYPE) (57th position)
      read(3) ifield(:,:,nfields-1)
      print *,'Reading: ',field_name(nfields-1)
!      print *,ifield(:,:,nfields-1)
!         landusecorr = ifield(:,:,nfields-1)
         landusecorr = ifield(:,:,nfields-1)
!        stop
!---- VEGFRAC (58th position)
      read(3) field(:,:,nfields)
      print *,'Reading: ',field_name(nfields)
!      print *,field(:,:,nfields)
      vegfrac = field(:,:,nfields)
!      print*,vegfrac
!       stop
      close(3)
!
!      open(unit=2,file='../output/landuse'
!     & ,status='old',form='unformatted')
!      read (2) landusecorr
!      print*,"landuse read"
!      close(2)

      open(unit=2,file='../output/landusenew'
     & ,status='old',form='unformatted')
      read (2) landusenewcorr
      print*,"landuse read"
      close(2)

      open(unit=2,file='../output/kount_landuse'
     & ,status='old',form='unformatted')
      read (2) kount_landuse 
      print*,"kount_landuse readed"
      close(2)

      open(unit=2,file='../output/kount_landusenew'
     & ,status='old',form='unformatted')
      read (2) kount_landusenew                                
      print*,"kount_landuse readed"
      close(2)

      open(unit=2,file='../output/kount_topsoiltype'
     & ,status='old',form='unformatted')
      read(2) kount_topsoiltype
      close(2)

      open(unit=2,file='../output/vegfrcPv'
     & ,status='old',form='unformatted')
      read (2) vegfrcPv
      close(2)

      open(unit=2,file='../output/vegfrcNpv'
     & ,status='old',form='unformatted')
      read (2) vegfrcNpv
      close(2)

      open(unit=2,file='../output/source_old'
     &  ,status='old',form='unformatted')
      read (2) source_old
      close(2)
!
      open(unit=2,file='../output/source_nomask_old'
     &  ,status='old',form='unformatted')
      read (2) source_nomask_old
      close(2)
!
      open(unit=2,file='../output/source_new_nat'
     &  ,status='old',form='unformatted')
      read (2) source_new_nat
      close(2)
!
      open(unit=2,file='../output/source_new_ant'
     &  ,status='old',form='unformatted')
      read (2) source_new_ant
      close(2)

      open(unit=2,file='../output/fbare_modis'
     &   ,status='old',form='unformatted')
      read (2) fbare_modis
      close(2)

      open(unit=2,file='../output/roughness_prigent'
     &   ,status='old',form='unformatted')
      read (2) z0_prig
      close(2)

!      open(unit=2,file='../output/z0corr'
!     &   ,status='old',form='unformatted')
!      read (2) z0corr
!      close(2)
!
      open(unit=2,file='../output/roughness'
     &   ,status='old',form='unformatted')
      read (2) roughness
      close(2)


      endif


!-----------------------------------------------------------------------
!!! CALCULATION OF USTAR THRESHOLD DRY FOR SOIL GRAINS FROM MARTICORENA
!-----------------------------------------------------------------------
!
      densair=1.23
!
      do k=1,soilbins2

        REYNTH(k)= 0.38+1331.*(100.*soil_diam(k))**1.56
!        print*, REYNTH(k)
!
        IF(REYNTH(k).LE.10.)THEN
!
!          ustrtrk(k)=((((0.1666681*denspart(k)*9.81*D_SOIL(k))
!     &    /(-1+1.928*REYNTH(k)**0.0922))*(1+(6E-7/(denspart(k)
!     &    *9.81*D_SOIL(k)**2.5))))**0.5)*densair**(-0.5)
!
          ustrtrk(k)=(1.+(6.E-7)/(soildens(k)*9.81*soil_diam(k)**2.5))
     &    **0.5*0.1291*(1.928*REYNTH(k)**0.0922-1.)**(-0.5)
     &    *sqrt(soildens(k)*9.81*soil_diam(k)/densair)
!
        ELSEIF(REYNTH(k).GT.10.)THEN
!
!          ustrtrk(k)=((0.0144*denspart(k)*9.81*D_SOIL(k)
!     &    *(1-0.0858*EXP(-0.0617*(REYNTH(k)-10)))*(1+(6E-7/
!     &    (denspart(k)*9.81*D_SOIL(k)**2.5))))**0.5)*densair**(-0.5)
!
          ustrtrk(k)=(1.+(6.E-7)/(soildens(k)*9.81*soil_diam(k)**2.5))
     &    **0.5*0.120*(1.-0.0858*EXP(-0.0617*(REYNTH(k)-10.)))
     &    *sqrt(soildens(k)*9.81*soil_diam(k)/densair)
!
        ENDIF
!
      enddo
!
      do j=1,jmi
        do i=1,imi
          do k=1,soilbins2
          ustrtr(i,j,k)=ustrtrk(k)
          enddo
        enddo
      enddo
!
!----------------------------------------------------------------------
!!! DUST PRODUCING CATEGORIES FROM USGS 94-cat LANDUSE TYPES 
!!! CALCULATION OF BARE SOIL FRACTION
!----------------------------------------------------------------------
!
           if(global) then
             n053=(90.+53.)/dphd
             n060=(90.+60.)/dphd
             n010=(90.+10.)/dphd
             s015=(90.-10.)/dphd
             s026=(90.-26.)/dphd
             s030=(90.-30.)/dphd
             s060=(90.-60.)/dphd
             e135=(180.+135.)/dlmd
             e142=(180.+142.)/dlmd
             w030=(180.-30.)/dlmd
           endif


        do j=1,jmi
          do i=1,imi
            kount_dust(i,j)=0
            kount_total(i,j)=0
!
            do n=1,vegtypes2
              kount_total(i,j)=kount_total(i,j)+kount_landuse(n,i,j)     !total number of kounts in each cell
            enddo

              kount_dust(i,j)=kount_landuse(8,i,j) +                     !Kounts of dust producing categories
     &                        kount_landuse(19,i,j)

            if(global) then
             if(i.ge.e135.and.i.le.e142.and.j.ge.s030.and.
     &          j.le.s026) then
              kount_dust(i,j)=kount_dust(i,j)+kount_landuse(7,i,j)
             endif
!
             if(j.gt.n053) then
              kount_dust(i,j)=0
             endif
!           
            endif
!
            bare_soil_fr(i,j)=real(kount_dust(i,j))
     &                       /real(kount_total(i,j))              !!BARE SOIL FRACTION
!
          enddo
        enddo
!
        write(*,*) ' '
        write(*,*) 'bare_soil_fr'
          do j=1,jmi,40
          write(*,7777) (bare_soil_fr(i,jmi+1-j)*100,i=1,imi,40)
          enddo
        write(*,*) ' '
        write(*,*) 'kount_dust'
          do j=1,jmi,40
          write(*,5555) (kount_dust(i,jmi+1-j),i=1,imi,40)
          enddo
        write(*,*) ' '
        write(*,*) 'kount_total'
          do j=1,jmi,40
          write(*,5555) (kount_total(i,jmi+1-j),i=1,imi,40)
          enddo
        write(*,*) ' '
        write(*,*) 'kount_dust/kount_total'
          do j=1,jmi,40
          write(*,5555) (kount_dust(i,jmi+1-j)/kount_total(i,jmi+1-j)
     &                   ,i=1,imi,40)
          enddo

5555  format(' ',20I6)
!
!----------------------------------------------------------------------
!!! Desert Mask (lansusefrac) and erodfrac
!----------------------------------------------------------------------
!
          do j=1,jmi
            do i=1,imi

             landusefrac(i,j)=0.0
             landusedust(i,j)=landusecorr(i,j)
             erodfrac(i,j,1)=1.0-vegfrac(i,j) 
!

             if(landusedust(i,j).eq.19) then
               landusefrac(i,j)=1.0           !barren or spaersely vegetated
             endif
             if(landusedust(i,j).eq.8) then
               landusefrac(i,j)=0.2           !shrubland
             endif
!
             if(global) then
              if(i.ge.e135.and.i.le.e142.and.j.ge.s030.and.
     &           j.le.s026.and.landusedust(i,j).eq.7) then
                landusefrac(i,j)=0.8          !grassland is a source in the lake Eyre (Australia)
              endif
!
              if(j.le.n010.and.j.ge.s015.and.i.le.w030.
     &           and.landusedust(i,j).eq.8) then
                landusefrac(i,j)=0.0  !exclude shrubland from here
              endif
!
              if(j.gt.n053) then
               landusefrac(i,j)=0.0
              endif
!
             endif !global

           enddo
          enddo
          
8888  format(' ',20I2)
        write(*,*) ' '
        write(*,*) 'landusedust'
          do j=1,jmi,40
        write(*,8888) (landusedust(i,jmi+1-j),i=1,imi,40)
          enddo
!
7777  format(' ',20f5.2)
        write(*,*) ' '
        write(*,*) 'landusefrac'
          do j=1,jmi,40
        write(*,7777) (landusefrac(i,jmi+1-j)*100,i=1,imi,40)
          enddo
        write(*,*) ' '
        write(*,*) 'seamask'
          do j=1,jmi,40
        write(*,7777) (seamask(i,jmi+1-j),i=1,imi,40)
          enddo
!
9999  format(' ',20f10.2)
        write(*,*) ' '
        write(*,*) 'height'
          do j=1,jmi,40
        write(*,9999) (height(i,jmi+1-j),i=1,imi,40)
          enddo
!
!----------------------------------------------------------------------
!!! PREFERENTIAL SOURCES form Ginoux 2001
!!! TAKES 5 DEGREES OF GLOBAL GRID AROUND ONE SPOT INTO ACCOUNT
!----------------------------------------------------------------------
!
!          do j=1,jmi
!            do i=1,imi
!            pref(i,j)=0.
!            enddo
!          enddo
!
!          do j=20,jmi-20
!            do i=20,imi-20
!          do j=3+dph5,jmi-2-dph5
!            do i=3+dlm5,imi-2-dlm5
!            if (seamask(i,j).eq.0.)then
!!
!            hmax=height(i,j)
!            hmin=height(i,j)
!!              do k=j-15,j+15
!!              do l=i-11,i+11
!              do k=j-dph5,j+dph5
!                do l=i-dlm5,i+dlm5
!                  if (seamask(l,k).eq.0.)then
!                  hmax=max(hmax,height(l,k))
!                  hmin=min(hmin,height(l,k))
!                  endif
!                enddo
!              enddo
!!            pref(i,j)=landusefrac(i,j)*erodfrac(i,j)
!             pref(i,j)=((hmax-height(i,j))/(hmax-hmin))**2
!!     &                *landusefrac(i,j)*bare_soil_fr(i,j)*erodfrac(i,j)
!!            pref(i,j)=pref(i,j)*((hmax-height(i,j))/(hmax-hmin))**5
!            endif
!!
!            enddo
!          enddo
!
!!! Include directly the sources from ginoux (from read_paul_source.f90)
! Bedrock fraction
             do j=1,jmi
              do i=1,imi
                sum_kount=0.
                do l=1,30
                sum_kount=sum_kount + kount_topsoiltype(l,i,j)
                enddo
                if(sum_kount.gt.0.)then
                bedrock_fr(i,j)=kount_topsoiltype(15,i,j)/sum_kount
                else
                bedrock_fr(i,j)=0.
                endif
              enddo
             enddo
!
          do j=1,jmi
            do i=1,imi
!            pref(i,j)=source(i,j)
              pref(i,j,1)=source_old(i,j)
              pref(i,j,2)=source_nomask_old(i,j)
!Filter low values of FoO
              if(source_new_nat(i,j).gt.0.025)then
                pref(i,j,3)=source_new_nat(i,j)
              else
                pref(i,j,3)=0.0
              endif
              if(source_new_ant(i,j).gt.0.025)then
                pref(i,j,4)=source_new_ant(i,j)
              else
                pref(i,j,4)=0.0
              endif
! 
              erodfrac(i,j,1)=erodfrac(i,j,1)
              erodfrac(i,j,2)=fbare_modis(i,j)
              erodfrac(i,j,3)=1.-vegfrcPv(i,j)-vegfrcNpv(i,j)
              if (erodfrac(i,j,3).lt.0.) erodfrac(i,j,3) = 0.   ! safety check
            enddo
          enddo
!
!fill coastlines in roughness prigent
          do s=1,8 !refill coastlines as needed

          do j=1,jmi-2
            do i=1,imi+2
              if(seamask(i,j).le.0.5.and.z0_prig(i,j).le.0..and.
     &          (pref(i,j,1).gt.0..or.pref(i,j,2).gt.0..or.
     &           pref(i,j,3).gt.0..or.pref(i,j,4).gt.0..or.
     &           erodfrac(i,j,1).gt.0..or.erodfrac(i,j,2).gt.0..or.
     &           erodfrac(i,j,3).gt.0.))then
                
                 n=0
                 if(z0_prig(i+1,j).gt.0) then
                    z0_prig(i,j)=z0_prig(i+1,j)
                    n=n+1
                 endif

                 if(z0_prig(i-1,j).gt.0) then
                    z0_prig(i,j)=z0_prig(i,j)+z0_prig(i-1,j)
                    n=n+1
                 endif

                  if(z0_prig(i,j+1).gt.0) then
                    z0_prig(i,j)=z0_prig(i,j)+z0_prig(i,j+1)
                    n=n+1
                 endif   
                 
                  if(z0_prig(i,j-1).gt.0) then
                    z0_prig(i,j)=z0_prig(i,j)+z0_prig(i,j-1)
                    n=n+1
                 endif

                 if(z0_prig(i,j).gt.0.and.n.gt.0) 
     &              z0_prig(i,j)=z0_prig(i,j)/n
                 
              endif
  
            enddo
          enddo

          enddo


          if(global) then    !clean spot in the antartic
          do j=1,jmi
            do i=1,imi
             if(j.le.s060) then
              pref(i,j,2)=0.
              pref(i,j,3)=0.
              pref(i,j,4)=0.
             endif
             if(j.ge.n060) then
              pref(i,j,2)=0.
              pref(i,j,3)=0.
              pref(i,j,4)=0.
             endif
            enddo
          enddo
          endif


!        write(*,*) ' '
!        write(*,*) 'pref'
!          do j=1,jmi,40
!        write(*,9999) (pref(i,jmi+1-j),i=1,imi,40)
!          enddo
!
!----------------------------------------------------------------------
!!! máximum amount of absorbed water
!----------------------------------------------------------------------
!
          do j=1,jmi
           do i=1,imi
            wprim(i,j)=0.0
            k=topsoiltypecorr(i,j)
            wprim(i,j)=wpr(k)
           enddo
          enddo
!
!----------------------------------------------------------------------
!!! MASS FRACTION OF EACH SOIL GRAIN BIN
!----------------------------------------------------------------------
!
           do j=1,jmi
           do i=1,imi
           ll=topsoiltypecorr(i,j)
            soil_mf(i,j,1)=t_bcly(ll)
            soil_mf(i,j,2)=t_bslt(ll)
            soil_mf(i,j,3)=t_mfsnd(ll)
            soil_mf(i,j,4)=t_csnd(ll)

           enddo
           enddo 
!
           do j=1,jmi
           do i=1,imi
           ll=topsoiltypecorr(i,j)
            soil_mf_orig(i,j,1)=t_bcly_k(ll)
            soil_mf_orig(i,j,2)=t_bslt_k(ll)
            soil_mf_orig(i,j,3)=t_mfsnd_k(ll)
            soil_mf_orig(i,j,4)=t_csnd_k(ll)

           enddo
           enddo

!----------------------------------------------------------------------
!!! RELATIVE SURFACE AREA OF EACH SOIL GRAIN BIN
!----------------------------------------------------------------------
!
           do j=1,jmi
           do i=1,imi
            soil_sa(i,j,1)=  3.*soil_mf(i,j,1)
     &                     /(2.*soildens(1)*soil_diam(1))

            soil_sa(i,j,2)=  3.*soil_mf(i,j,2)
     &                     /(2.*soildens(2)*soil_diam(2))

            soil_sa(i,j,3)=  3.*soil_mf(i,j,3)
     &                     /(2.*soildens(3)*soil_diam(3))

            soil_sa(i,j,4)=  3.*soil_mf(i,j,4)
     &                     /(2.*soildens(4)*soil_diam(4))

            soil_sa_tot(i,j)=soil_sa(i,j,1)+soil_sa(i,j,2)+
     &                      soil_sa(i,j,3)+soil_sa(i,j,4)

            if(soil_sa_tot(i,j).gt.0.)then
             do n=1,soilbins
             soil_sa(i,j,n)=soil_sa(i,j,n)/soil_sa_tot(i,j)
             enddo
            else
             do n=1,soilbins
             soil_sa(i,j,n)=0.
             enddo
            endif

           enddo
           enddo
!
           do j=1,jmi
           do i=1,imi
            soil_sa_orig(i,j,1)=  3.*soil_mf_orig(i,j,1)
     &                     /(2.*soildens(1)*soil_diam(1))

            soil_sa_orig(i,j,2)=  3.*soil_mf_orig(i,j,2)
     &                     /(2.*soildens(2)*soil_diam(2))

            soil_sa_orig(i,j,3)=  3.*soil_mf_orig(i,j,3)
     &                     /(2.*soildens(3)*soil_diam(3))

            soil_sa_orig(i,j,4)=  3.*soil_mf_orig(i,j,4)
     &                     /(2.*soildens(4)*soil_diam(4))

            soil_sa_tot_orig(i,j)=soil_sa_orig(i,j,1)+
     &                            soil_sa_orig(i,j,2)+
     &                            soil_sa_orig(i,j,3)+
     &                            soil_sa_orig(i,j,4)

            if(soil_sa_tot_orig(i,j).gt.0.)then
             do n=1,soilbins
             soil_sa_orig(i,j,n)=soil_sa_orig(i,j,n)
     &                          /soil_sa_tot_orig(i,j)
             enddo
            else
             do n=1,soilbins
             soil_sa_orig(i,j,n)=0.
             enddo
            endif

           enddo
           enddo



!----------------------------------------------------------------------
!!! Vertical to Horizontal flux ratio alpha
!----------------------------------------------------------------------
!
           alpha_soil(1)=1.e-6  !1/cm    !CLAY (IF mclay<0.45)
           alpha_soil(2)=1.e-5  !1/cm    !SILT
           alpha_soil(3)=1.e-6  !1/cm    !FINE/MEDIUM SAND
           alpha_soil(4)=1.e-7  !1/cm    !COARSE SAND
!
           do j=1,jmi
           do i=1,imi
            alpha(i,j,1)=0.
             do n=1,soilbins
              dum=alpha_soil(n)
!
!              if (n==1.and.pref(i,j).gt.0.5) dum=alpha_soil(2)*pref(i,j)
!              if (n==2.and.pref(i,j).gt.0.) dum=alpha_soil(2)*pref(i,j)

              if (n==1.and.soil_mf(i,j,1).gt.0.45) dum=1.e-7   !CLAY (IF mclay>0.45)

!              alpha(i,j)=alpha(i,j)+dum*soil_sa(i,j,n)  !!! original ksn4
              alpha(i,j,1)=alpha(i,j,1)+dum*soil_mf(i,j,n)  !!new ksn4

             enddo
!             dum=1.e-5*pref(i,j)                          !If it is a preferential source we increase alpah scaling with pref
!             if(dum.gt.alpha(i,j)) alpha(i,j)=dum
           enddo
           enddo
!TEST alpha from Marticorena and Bergametti

           do j=1,jmi
           do i=1,imi
           alpha(i,j,2)=0.

           if(soil_mf(i,j,1).le.0.25)then
!           alpha(i,j)=0.01*exp(0.308*soil_mf(i,j,1)-13.82)
!           alpha(i,j)=100.*exp((13.4*soil_mf(i,j,1)-6.)*log(10.)) 
           alpha(i,j,2)=10.**(13.4*soil_mf(i,j,1)-6.)
           endif
          
           enddo
           enddo

!
!----------------------------------------------------------------------
!!! Error function to distribute the emitted mass from source
!!! distribution to transport bins after Zender et al. (2003)
!----------------------------------------------------------------------
!
        do n=1,sizebins
         m=0.
         do i=1,sourcemodes

         mij(i,n)=erf(log(2.*pradi_max(n)/source_diam(i))/
     &               (sqrt(2.)*log(source_sigma(i))))

         mij(i,n)=mij(i,n)-
     &            erf(log(2.*pradi_min(n)/source_diam(i))/
     &               (sqrt(2.)*log(source_sigma(i))))

         mij(i,n)=mij(i,n)*0.5

         m=m+mij(i,n)*source_mf(i)

        enddo

         mn1(n)=m                                      !Mass fraction in transport bin j
!          print*,'n=',n,'mn1=',mn1(n)

        enddo
 
        mn1 = mn1/sum(mn1)
        do n=1,sizebins
           print*,'n=',n,'mn1=',mn1(n)
        enddo

        print*,'m1=',mn1(1)+mn1(2)+mn1(3)+mn1(4)+mn1(5)+mn1(6)
     &             +mn1(7)+mn1(8)

!!AD
!----------------------------------------------------------------------
!!! Size distribution at emission Kok et al. (2011)
!----------------------------------------------------------------------
        mn2(1)=0.0003023675 
        mn2(2)=0.0014400196 
        mn2(3)=0.0107924045 
        mn2(4)=0.0310110880 
        mn2(5)=0.1064167079
        mn2(6)=0.2194141414 
        mn2(7)=0.4860034376 
        mn2(8)=0.1446198335

        do n=1,sizebins
         print*,'n=',n,'mn2=',mn2(n)
        enddo

        print*,'m2=',mn2(1)+mn2(2)+mn2(3)+mn2(4)+mn2(5)+mn2(6)
     &             +mn2(7)+mn2(8)

!----------------------------------------------------------------------
!!! Size distribution at emission Ginoux et al. (2001)
!----------------------------------------------------------------------
        mn3(1)=0.002
        mn3(2)=0.008
        mn3(3)=0.025
        mn3(4)=0.065
        mn3(5)=0.225
        mn3(6)=0.225
        mn3(7)=0.225
        mn3(8)=0.225
        do n=1,sizebins
           print*,'n=',n,'mn3=',mn3(n)
        enddo
        print*, 'm3=', sum(mn3(:))
!----------------------------------------------------------------------
!!! MODEL ROUGHNESS LENGTH NOW WITH THE UPDATED USGS DATASET WITH 96
!!! CATEGORIES (CONVERSION FROM 27 TYPES BY MEANS OF ROUGH GUESS !!!)
!----------------------------------------------------------------------
!!! PREPARATION OF NEW HIGHRES ROUGHNESS LENGTH WHICH IS A COMBINATION
!!! OF Z0CORR AND THE Z0 DATASET FOR AFRICA AND ASIA
!!! PROVIDED BY BENOIT LAURENT DERIVED FROM POLDER-I
!----------------------------------------------------------------------
!
      do j=1,jmi
        do i=1,imi
          z0new(i,j)=0.
          if (roughness(i,j).gt.0.000002) then
            z0new(i,j)=roughness(i,j)
          elseif (z0corr(i,j).eq.0.0013) then
            z0new(i,j)=z0corr(i,j)
          else
            z0new(i,j)=0.1+z0vegusgs(landusenewcorr(i,j))*vegfrac(i,j)        !compare z0vegustar.f90
          endif
        enddo
      enddo
!
7788  format(' ',20f6.2)
!
      write(*,*) ' '
      write(*,*) 'z0corr'
      do j=1,jmi,40
        write(*,7788) (z0corr(i,jmi+1-j),i=1,imi,40)
      enddo
!
      write(*,*) ' '
      write(*,*) 'roughness'
      do j=1,jmi,40
        write(*,7788) (roughness(i,jmi+1-j),i=1,imi,40)
      enddo
!
      write(*,*) ' '
      write(*,*) 'z0new'
      do j=1,jmi,40
        write(*,7788) (z0new(i,jmi+1-j),i=1,imi,40)
      enddo
!
! ----------------------------------------------------------------------------------------------
!MONARCH 2017 - the following is input for dust emission schemes 4 through 6
! ----------------------------------------------------------------------------------------------
! get particle-size distritutions for all soil texture classes ---
!       dcut = maxval(pradi_max)*2    
      call psd_create_all (idst, psdmax, stypes, sizebins, pradi_max*2,  
     &     d0, dd, psd_m, dpsd_m, psd_f, dpsd_f, ibin_u, ibin_l)

! get u*t, particle area and particle mass
      dm = dd*1.d-6                                                      ! dd in [um], dm in [m]  
      call ustart0_calc(psdmax, dm, pdens(8)*1000, g, densair, ustart0)    ! ustart0 in [m s-1]
      call parea_calc(psdmax, dm, pdens(8)*1000, parea, pmass)             ! parea [m2], pmass [kg]
!
      do j=1,jmi
         do i=1,imi
            k=topsoiltypecorr(i,j)  
            if (k .le. 12) then 
               psdm(i,j,:) = psd_m(:,k)
               psdf(i,j,:) = psd_f(:,k)
               dpsdm(i,j,:) = dpsd_m(:,k)
               dpsdf(i,j,:) = dpsd_f(:,k)
! assign grid-based air-dry soil moisture             
               drysmc(i,j)=dsmc(k)
               a_smois(i,j)=a_sm(k)
               b_smois(i,j)=b_sm(k)
            endif
         enddo
      enddo      

!-----------------------------------------------------------------------
!!! WRITE FILE FOR NMMB
!-----------------------------------------------------------------------

        if (global) then                           ! global branch
!
          call padih2(landusenewcorr,ipadded2)     ! landusenewcorr
          write(nfcst) ipadded2
!
          call padh2(bare_soil_fr,padded2)         !bare soil fraction between 0 and 1
          write(nfcst) padded2
!
!          call padh2(pref,padded2)                 !preferential sources between 0 and 1
!          write(nfcst) padded2
!          call padhn2(pref,paddedn3,3)                 !preferential sources between 0 and 1
          call padhn2(pref,paddedn4,4)                 !preferential sources between 0 and 1
          write(nfcst) paddedn4
!
          call padh2(landusefrac,padded2)          !0 or 1 Desert mask
!          call padh2(prueba,padded2)          !0 or 1 Desert mask
          write(nfcst) padded2
!
! !          call padh2(erodfrac,padded2)             !1 minus vegetation fraction between 0 and 1
!           call padhn2(erodfrac,paddedn6,2)             !1 minus vegetation fraction between 0 and 1
!           write(nfcst) paddedn6
!           write(0,*) 'min, max', minval(paddedn6),maxval(paddedn6)
          call padhn2(erodfrac,paddedn3,3)             !1 minus vegetation fraction between 0 and 1
          write(nfcst) paddedn3
!
          call padh2(bedrock_fr,padded2)          !Bedrock fraction
          write(nfcst) padded2
!
          call padh2(vegfrac,padded2)              !vegetation fraction between 0 and 1
          write(nfcst) padded2
          call padh2(vegfrcPv,padded2)             !vegetation fraction between 0 and 1
          write(nfcst) padded2
! 
          call padhn2(soil_mf,paddedn4,soilbins)   !soil mass fractions
          write(nfcst) paddedn4
          call padhn2(soil_mf_orig,paddedn4,soilbins)   !soil mass fractions
          write(nfcst) paddedn4
          call padhn2(soil_sa,paddedn4,soilbins)   !soil relative area fractions
          write(nfcst) paddedn4
          call padhn2(soil_sa_orig,paddedn4,soilbins)   !soil relative area fractions
          write(nfcst) paddedn4
!          call padh2(alpha,padded2)                !vertical to horizontal flux ratio
!          write(nfcst) padded2
          call padhn2(alpha,paddedn6,2)                !vertical to horizontal flux ratio
          write(nfcst) paddedn6
! 
          call padh2(wprim,padded2)                !maximum amount of absorbed water in soil
          write(nfcst) padded2       
!
! added mode for threshold for D=70 microns
!          call padhn2(ustrtr,paddedn4,soilbins)    !threshold friction velocity
!          write(nfcst) paddedn4
          call padhn2(ustrtr,paddedn5,soilbins2)    !threshold friction velocity
          write(nfcst) paddedn5
          call padh2(z0new,padded2)                !new hires rougness length for dust sources (africa/asia)
          write(nfcst) padded2
!
          call padh2(z0corr,padded2)               !model rougness length
          write(nfcst) padded2
!
          call padh2(roughness,padded2)            !POLDER-1 rougness length
          write(nfcst) padded2
          call padh2(z0_prig,padded2)              !ASCAT/POLDER roughness from Prigent et al. 2012
          write(nfcst) padded2
!          write(nfcst) mn                          !mass fraction of total mass in transport bin
          write(nfcst) mn1                          !mass fraction of total mass in transport bin
          write(nfcst) mn2                          !mass fraction of total mass in transport bin
          write(nfcst) mn3                          !mass fraction of total mass in transport bin
          write(nfcst) aa
          write(nfcst) cdm
          write(nfcst) cvm
          write(nfcst) rsqcd0vm
          write(nfcst) asmm 
          call padh2(drysmc,padded2)               ! dry soil moisture content (volumetric)
          write(nfcst) padded2
          
          call padh2(a_smois,padded2)              ! a coefficient in soil moisture correction
          write(nfcst) padded2
          
          call padh2(b_smois,padded2)              ! b coefficient in soil moisture correction  
          write(nfcst) padded2          
          
          write(nfcst) psdmax          
          
          call padhn2(psdm,paddedn60,psdmax)        ! minimally-dispersed particle-size distribution 
          write(nfcst) paddedn60        

          call padhn2(psdf,paddedn60,psdmax)        ! fully-dispersed particle-size distribution 
          write(nfcst) paddedn60  
          
          call padhn2(dpsdm,paddedn60,psdmax)        ! minimally-dispersed particle-size distribution, differential
          write(nfcst) paddedn60  
          
          call padhn2(dpsdf,paddedn60,psdmax)        ! fully-dispersed particle-size distribution, differential 
          write(nfcst) paddedn60    
          
          write(nfcst) idst
          write(nfcst) ibin_u
          write(nfcst) ibin_l          
          write(nfcst) d0
          write(nfcst) dd
          write(nfcst) ustart0
          write(nfcst) pradi_max
          write(nfcst) pmass
!          write(nfcst) qext550
!
          print*, ' '
          print*, 'Global branch done'
                     
        else                                               !regional branch
!
          write(nfcst) landusenewcorr
          write(nfcst) bare_soil_fr
          write(nfcst) pref 
          write(nfcst) landusefrac
          write(nfcst) erodfrac
          write(nfcst) bedrock_fr
          write(nfcst) vegfrac
          write(nfcst) vegfrcPv
          write(nfcst) soil_mf
          write(nfcst) soil_mf_orig
          write(nfcst) soil_sa
          write(nfcst) soil_sa_orig
          write(nfcst) alpha
          write(nfcst) wprim
          write(nfcst) ustrtr
          write(nfcst) z0new
          write(nfcst) z0corr
          write(nfcst) roughness
          write(nfcst) z0_prig
!          write(nfcst) mn
          write(nfcst) mn1
          write(nfcst) mn2
          write(nfcst) mn3
          write(nfcst) aa
          write(nfcst) cdm
          write(nfcst) cvm
          write(nfcst) rsqcd0vm
          write(nfcst) asmm
!          write(nfcst) qext550
          write(nfcst) drysmc
          write(nfcst) a_smois
          write(nfcst) b_smois
          write(nfcst) psdmax          
          write(nfcst) psdm
          write(nfcst) psdf
          write(nfcst) dpsdm
          write(nfcst) dpsdf            
          write(nfcst) idst
          write(nfcst) ibin_u
          write(nfcst) ibin_l           
          write(nfcst) d0
          write(nfcst) dd     
          write(nfcst) ustart0     
          write(nfcst) pradi_max  
          write(nfcst) pmass
!
          print*, ' '
          print*, 'Regional branch done'          

        endif
!
!-----------------------------------------------------------------------
!
        close(unit=nfcst)
!
     
!        deallocate(sgm)
!        deallocate(sg1)
!        deallocate(dsg1)
!        deallocate(sgml1)
!        deallocate(sg2)
!        deallocate(dsg2)
!        deallocate(sgml2)
!        deallocate(field)
!        deallocate(ifield)
!        deallocate(dyn)
!        deallocate(stmp)
!        deallocate(smst)
!        deallocate(sh2o)
!        deallocate(dum2d)
!        deallocate(dum3d)

!-----------------------------------------------------------------------
!
      end
!
!-----------------------------------------------------------------------
!#######################################################################
!-----------------------------------------------------------------------
!
      subroutine padhn(h2,ph2,km)
!
!-----------------------------------------------------------------------
      include 'lmimjm.inc'
!-----------------------------------------------------------------------
!
      dimension h2(km,imi,jmi),ph2(km,im,jm)
!
!-------------averaging at polar points---------------------------------
!
      rim=1./(imi-1)
      do l=1,km
        h2s=0.
        h2n=0.
        do i=1,imi-1
          h2s=h2(l,i,1)+h2s
          h2n=h2(l,i,jmi)+h2n
        enddo
        h2s=h2s*rim
        h2n=h2n*rim
        do i=1,imi
          h2(l,i,1)=h2s
          h2(l,i,jmi)=h2n
        enddo
      enddo
!-------------padding---------------------------------------------------
      do l=1,km
!
        do j=1,jmi
          do i=1,imi
            ph2(l,i+1,j+1)=h2(l,i,j)
          enddo
        enddo          
!
        do i=2,im-1
          ph2(l,i,1 )=ph2(l,i,3   )
          ph2(l,i,jm)=ph2(l,i,jm-2)
        enddo
!
        do j=1,jm
          ph2(l,1   ,j)=ph2(l,im-2,j)
          ave=(ph2(l,2,j)+ph2(l,im-1,j))*0.5
          ph2(l,2   ,j)=ave
          ph2(l,im-1,j)=ave
          ph2(l,im  ,j)=ph2(l,3   ,j)
        enddo
!
      enddo
!-----------------------------------------------------------------------
      return
      end
!
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      subroutine padhn2(h2,ph2,km)
!-----------------------------------------------------------------------
      include 'lmimjm.inc'
!-----------------------------------------------------------------------
      dimension h2(imi,jmi,km),ph2(im,jm,km)
!-------------averaging at polar points---------------------------------
      rim=1./(imi-1)
      do l=1,km
        h2s=0.
        h2n=0.
        do i=1,imi-1
          h2s=h2(i,1,l)+h2s
          h2n=h2(i,jmi,l)+h2n
        enddo
        h2s=h2s*rim
        h2n=h2n*rim
        do i=1,imi
          h2(i,1,l)=h2s
          h2(i,jmi,l)=h2n
        enddo
      enddo
!-------------padding---------------------------------------------------
      do l=1,km
!
        do j=1,jmi
          do i=1,imi
            ph2(i+1,j+1,l)=h2(i,j,l)
          enddo
        enddo
!
        do i=2,im-1
          ph2(i,1,l )=ph2(i,3,l   )
          ph2(i,jm,l)=ph2(i,jm-2,l)
        enddo
!
        do j=1,jm
          ph2(1   ,j,l)=ph2(im-2,j,l)
          ave=(ph2(2,j,l)+ph2(im-1,j,l))*0.5
          ph2(2   ,j,l)=ave
          ph2(im-1,j,l)=ave
          ph2(im  ,j,l)=ph2(3   ,j,l)
        enddo
!
      enddo
      return
      end
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      subroutine padih2(ih2,iih2)
!-----------------------------------------------------------------------
      include 'lmimjm.inc'
!-----------------------------------------------------------------------
      dimension ih2(imi,jmi),iih2(im,jm)
!-------------averaging at polar points---------------------------------
      rim=1./(imi-1)
      ih2s=0.
      ih2n=0.
      do i=1,imi-1
        ih2s=ih2(i,1  )+ih2s
        ih2n=ih2(i,jmi)+ih2n
      enddo
      ih2s=ih2s*rim
      ih2n=ih2n*rim
      do i=1,imi
        ih2(i,1  )=ih2s
        ih2(i,jmi)=ih2n
      enddo
!-------------padding---------------------------------------------------
      do j=1,jmi
        do i=1,imi
          iih2(i+1,j+1)=ih2(i,j)
        enddo
      enddo
!
      do i=2,im-1
        iih2(i,1 )=iih2(i,3   )
        iih2(i,jm)=iih2(i,jm-2)
      enddo
!
      do j=1,jm
        iih2(1   ,j)=iih2(im-2,j)
        iave=(iih2(2,j)+iih2(im-1,j))*0.5
        iih2(2   ,j)=iave
        iih2(im-1,j)=iave
        iih2(im  ,j)=iih2(3   ,j)
      enddo
!-----------------------------------------------------------------------
      return
      end
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      subroutine padh2(h2,ph2)
!-----------------------------------------------------------------------
      include 'lmimjm.inc'
!-----------------------------------------------------------------------
      dimension h2(imi,jmi),ph2(im,jm)
!-------------averaging at polar points---------------------------------
      rim=1./(imi-1)
      h2s=0.
      h2n=0.
      do i=1,imi-1
        h2s=h2(i,1)+h2s
        h2n=h2(i,jmi)+h2n
      enddo
      h2s=h2s*rim
      h2n=h2n*rim
      do i=1,imi
        h2(i,1  )=h2s
        h2(i,jmi)=h2n
      enddo
!-------------padding---------------------------------------------------
      do j=1,jmi
        do i=1,imi
          ph2(i+1,j+1)=h2(i,j)
        enddo
      enddo
!
      do i=2,im-1
        ph2(i,1 )=ph2(i,3   )
        ph2(i,jm)=ph2(i,jm-2)
      enddo
!
      do j=1,jm
        ph2(1   ,j)=ph2(im-2,j)
        ave=(ph2(2,j)+ph2(im-1,j))*0.5
        ph2(2   ,j)=ave
        ph2(im-1,j)=ave
        ph2(im  ,j)=ph2(3   ,j)
      enddo
!-----------------------------------------------------------------------
      return
      end
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      subroutine ustart0_calc(psdmax, d, rhop, g, rho, ustart0_out)
!
! Y. Shao,  13 June 2000
! M. Klose, 17 Nov  2017 - Minor modifications for implementation in NMMB-MONARCH
!
! Calculate ustar0(d) using Shao and Lu (2000) for uncovered
! dry surface
!
! d     : particle diameter                     [m]
! ustar0: threshold friction velocity           [m s-1]
! rhop  : particle density                      [kg m-3]
! rho   : air density                           [kg m-3]
! g     : gravitational acceleration            [m s-2]
!
      integer, intent(in) :: psdmax
      real, intent(in)    :: g, rho, rhop
      real, intent(in),  dimension(psdmax) :: d 
      real, intent(out), dimension(psdmax) :: ustart0_out
      real, parameter     :: gamma = 1.65d-4      ! a constant
      real, parameter     :: f = 0.0123
      real                :: sigma

      write(*,*) 'calculate ustart0 from Shao and Lu (2000)'
      sigma = rhop/rho
      ustart0_out = f*(sigma*g*d + gamma/(rho*d) )
      ustart0_out = sqrt( ustart0_out )
      end 
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
      subroutine parea_calc(psdmax, d, rhop, parea_out, pmass_out)
!
!     Calculate particle cross-sectional area and particle mass
!     psdmax : number of particle-size distribution bins
!     d    : particle size  [m]
!     rhop : particle density [kg m-3]
!---------------------------------------------------------------------------------
      implicit none
!---------------------------------------------------------------------------------

      INTEGER, intent(in)  :: psdmax
      REAL,    intent(in)  :: rhop
      REAL,    intent(in),  dimension(psdmax) :: d   
      REAL,    intent(out), dimension(psdmax) :: parea_out, pmass_out
      
      REAL, PARAMETER       :: pi=3.1415927
      write(*,*) 'calculate particle area and mass for psd bins'
      parea_out = (pi*d**2.)/4.
      pmass_out = (rhop*pi*d**3.)/6.  

      end 
