subroutine read_anowbufr(nread,ndata,nodata,gstime,&
      infile,obstype,lunout,twindin,sis,nobs)
!$$$  subprogram documentation block
!                .      .    .                                       .
! subprogram:  read_anowbufr                read pm2_5 obs from AIRNow prepbufr file (based on other bufr readers)
!   prgmmr: pagowski                date: 2010-09-13
!
! abstract:  This routine reads conventional pm2_5 data from AIRNow
! prepbufr can be done similarly for ozone
!
!            When running the gsi in regional mode, the code only
!            retains those observations that fall within the regional
!            domain
!
! program history log:
!   2010-09-13  pagowski adopted prepbufr reader code for
!  AIRNow bufr for pm2_5
!   2013-01-26  parrish - change from grdcrd to grdcrd1 (to allow successful debug compile on WCOSS)
!   2013-11-01 pagowski - make code compatible with ncep/mhu airnow bufr
!   2015-02-23  Rancic/Thomas - add l4densvar to time window logical
!   2015-10-01  guo     - consolidate use of ob location (in deg)
!
!   input argument list:
!     infile   - unit from which to read BUFR data
!     obstype  - observation type to process
!     lunout   - unit to which to write data for further processing
!     twindin  - input group time window (hours)
!
!   output argument list:
!     nread    - number of type "obstype" observations read
!     ndata    - number of type "obstype" observations retained for further processing
!     nodata   - number of individual "obstype" observations retained for !further processing
!     sis      - satellite/instrument/sensor indicator
!     nobs     - array of observations on each subdomain for each processor
!
! attributes:
!   language: f90
!   machine:  ibm RS/6000 SP
!
!$$$
  use kinds, only: r_kind,r_double,i_kind
  use constants, only: zero,one,half,deg2rad,&
       rad2deg,r60inv
  use gridmod, only: diagnostic_reg,regional,nlon,nlat,&
       tll2xy,txy2ll,rlats,rlons,region_dx
  use convinfo, only: nconvtype,ctwind, &
       icuse,ioctype,ictype,cermin,cermax
  use gsi_4dvar, only: l4dvar,l4densvar,iwinbgn,winlen
  use chemmod, only : obs2model_anowbufr_pm,&
        iconc,ierror,ilat,ilon,itime,iid,ielev,isite,iikx,ilate,ilone,&
        elev_missing,site_scale,tunable_error,&
        code_pm25_ncbufr,code_pm25_anowbufr,&
        code_pm10_ncbufr,code_pm10_anowbufr
  use mpimod, only: npe

  implicit none

! declare passed variables
  character(len=*),intent(in   ) :: infile,obstype
  integer(i_kind) ,intent(in   ) :: lunout
  integer(i_kind) ,intent(inout) :: nread,ndata,nodata
  integer(i_kind),dimension(npe) ,intent(inout) :: nobs
  real(r_kind)    ,intent(in   ) :: gstime,twindin
  character(len=*),intent(in   ) :: sis

! declare local parameters

  integer(i_kind), parameter :: maxobs=1e5
  integer(i_kind), parameter :: nsid=1,nxob=2,&
        nyob=3,ndhr=4,ntyp=5,ncopopm=6
!see headr input format below
  integer(i_kind), parameter :: nfields=6
!output format parameters
  integer(i_kind), parameter:: nchanl=0,nreal=ilone

  real(r_kind),parameter :: r360 = 360.0_r_kind
  real(r_kind),parameter :: percent=1.e-2_r_kind

  real(r_kind), parameter :: anow_missing=1.0e11_r_kind,&
        conc_missing = anow_missing-1

! declare local variables
  logical outside

  integer(i_kind) lunin,i
  integer(i_kind) idate,iret,k
  integer(i_kind) kx,ikx
  integer(i_kind) nmind
  integer(i_kind) :: iy,im,id,ih,imin,site_char,site_id
!           (site_char=1,2,3,4: unknown,urban,suburban,rural)

  integer(i_kind) :: ireadmg,ireadsb
  integer(i_kind), dimension(5) :: idate5
  integer(i_kind), dimension(8) :: idate8
  real(r_kind), dimension(5)  :: rinc
  character(len=8) :: subset
  character(len=80) :: headr

  real(r_double), dimension(nfields) :: indata

  real(r_kind) :: tdiff,obstime,t4dv
  real(r_kind) :: dlat,dlon,error_1,error_2,obserror,dlat_earth,dlon_earth
  real(r_kind) :: dlat_earth_deg,dlon_earth_deg

  real(r_kind) cdist,disterr,disterrmax,rlon00,rlat00
  integer(i_kind) ntest,ios

  real(r_kind) :: conc,site_elev
  real(r_kind), dimension(nreal,maxobs):: cdata_all
  character(len=8):: sid
  character(len=10) :: cdate

  logical :: ncbufr,anowbufr

  equivalence (sid,indata(nsid))

  data lunin / 10 /

  ncbufr=.false.
  anowbufr=.false.

  site_char=1 ! set unknown site character
  site_elev=elev_missing ! set unknown site elevation

!**************************************************************************
! initialize variables
  disterrmax=zero
  ntest=0
  nread=0
  ndata = 0
  nodata = 0

! open, then read date from bufr data
  open(lunin,file=trim(infile),form='unformatted')

  call openbf(lunin,'IN',lunin)
  call datelen(10)

! reading each report from bufr

  do while (ireadmg(lunin,subset,idate) == 0)

     if (trim(obstype)=='pm2_5') then

        if ( (subset == 'NC008031') .or. (subset == 'NC008032' ) ) then
           headr='PTID CLONH CLATH TPHR TYPO COPOPM'
           ncbufr=.true.
           write(6,*)'READ_PM2_5:  AIRNOW data type, subset=',subset
        else if (subset == 'ANOWPM') then
           headr='SID XOB YOB DHR TYP COPOPM'
           anowbufr=.true.
           write(6,*)'READ_PM2_5:  AIRNOW data type, subset=',subset
        else
           cycle
        endif

     else if (trim(obstype)=='pm10') then

        if (subset == 'NC008033') then
           headr='PTID CLONH CLATH TPHR TYPO COPOPM'
           ncbufr=.true.
           write(6,*)'READ_PM10:  AIRNOW data type, subset=',subset
        else
           cycle
        endif

     else !keep option for ozone
        cycle
!     subset='AIRNOW' for ozone
     endif

     write(cdate,'(i10)') idate
     read (cdate,'(i4,3i2)') iy,im,id,ih
     imin=0

     do while (ireadsb(lunin) == 0)
        call ufbint(lunin,indata,nfields,1,iret,headr)

        if (anowbufr) then
           kx=indata(ntyp)
           read(sid,'(Z8)')site_id
        else if (ncbufr) then
           kx=indata(ntyp)
           if (kx/=code_pm25_ncbufr .or. kx/=code_pm10_ncbufr) then
              cycle
           else
              if (trim(obstype)=='pm2_5') then
                 kx=code_pm25_anowbufr
              else
                 kx=code_pm10_anowbufr
              endif
           endif
           read(sid,'(Z8)',iostat=ios)site_id
           if (ios/=0) site_id=nint(indata(nsid))
        endif

        nread = nread + 1
        conc=indata(ncopopm)

        if ( iret > 0 .and. (conc < conc_missing ) .and. &
               (conc >= zero)) then

           if(indata(nxob) >= r360)  indata(nxob) = indata(nxob) - r360
           if(indata(nxob) <  zero)  indata(nxob) = indata(nxob) + r360

           dlon_earth_deg=indata(nxob)
           dlat_earth_deg=indata(nyob)

           dlon_earth=indata(nxob)*deg2rad
           dlat_earth=indata(nyob)*deg2rad

           if(regional)then

              call tll2xy(dlon_earth,dlat_earth,dlon,dlat,outside)    ! convert to rotated coordinate

               if(diagnostic_reg) then

                 call txy2ll(dlon,dlat,rlon00,rlat00)
                 ntest=ntest+1
                 cdist=sin(dlat_earth)*sin(rlat00)+cos(dlat_earth)*cos(rlat00)* &
                      (sin(dlon_earth)*sin(rlon00)+cos(dlon_earth)*cos(rlon00))
                 cdist=max(-one,min(cdist,one))
                 disterr=acos(cdist)*rad2deg
                 disterrmax=max(disterrmax,disterr)
              end if

              if(outside) cycle ! check to see if outside regional domain

           else
              dlat = dlat_earth
              dlon = dlon_earth
              call grdcrd1(dlat,rlats,nlat,1)
              call grdcrd1(dlon,rlons,nlon,1)
           endif

!  extract date information.  if time outside window, skip this obs

           idate5(1) = iy !year
           idate5(2) = im !month
           idate5(3) = id !day
           idate5(4) = ih !hour
           idate5(5) = imin !minute

           idate8(1:3)=idate5(1:3)
           idate8(4)=0
           idate8(5:6)=idate5(4:5)
           idate8(7:8)=0

           rinc(1)=zero
! half below accounts for the fact that in bufr file measurement
! at 5:30 (ie. average from 5:00 to 6:00) is assigned time 6:00
           rinc(2)=indata(ndhr)-half
           rinc(3:5)=zero

           call w3movdat(rinc,idate8,idate8)

           idate5(1:3)=idate8(1:3)
           idate5(4:5)=idate8(5:6)

           ikx = 0
           do i = 1, nconvtype
              if (obstype == ioctype(i) .and. kx == ictype(i) .and. &
                    abs(icuse(i))== 1) ikx=i
           end do
           if(ikx == 0) cycle             ! not ob type used

           call w3fs21(idate5,nmind)
           t4dv=real((nmind-iwinbgn),r_kind)*r60inv
           obstime=real(nmind,r_kind)
           tdiff=(obstime-gstime)*r60inv

           if (l4dvar.or.l4densvar) then
              if (t4dv < zero .or. t4dv > winlen) cycle
           else
              if(abs(tdiff) > twindin .or. &
                    abs(tdiff) > ctwind(ikx)) cycle  ! outside time window
           endif

!at a later stage search for site character and elevation
!based on sid when reference table available
!for now assign default sitecharacter and unknown elevation

!calculate pm2_5 obs error
!obs error for pm2_5/pm10 is calculated as
!obserror=sqrt(error_1^2+error_2^2)
!measurement error:
!error_1=cermax+cermin*conc
!(1.5ug/m3+0.0075*concentration)
!cermin, cermax in convinfo.txt are nonstandard
!cermax is a constant part, cermin is a percentage part
!representativeness error:
!error_2=tunable_error*error_1*sqrt(dx/site_scale)
!similar for ozone

           conc=conc*obs2model_anowbufr_pm()

           error_1=cermax(ikx)+cermin(ikx)*percent*conc
           error_2=tunable_error*error_1*&
                 sqrt(region_dx(nint(dlat),nint(dlon))/&
                 site_scale(site_char))
           obserror=sqrt(error_1**2+error_2**2)

           ndata=ndata+1
           nodata=nodata+1

           cdata_all(iconc,ndata)  = conc                    ! pm2_5 obs
           cdata_all(ierror,ndata) = obserror                ! pm2_5 obs error
           cdata_all(ilat,ndata)   = dlat                    ! grid relative latitude

           cdata_all(ilon,ndata)   = dlon                    ! grid relative longitude
           cdata_all(itime,ndata)  = tdiff                   ! time of obs
           cdata_all(iid,ndata)    = site_id                 ! site id
           cdata_all(ielev,ndata)  = site_elev               ! elevation
           cdata_all(isite,ndata)  = site_char               ! site character
           cdata_all(iikx,ndata)   = ikx                     ! ordered number in convinfo table
           cdata_all(ilate,ndata)  = dlat_earth_deg          ! earth relative latitude (degrees)
           cdata_all(ilone,ndata)  = dlon_earth_deg          ! earth relative longitude (degrees)

        end if
     enddo
  enddo

1000 continue

  call closbf(lunin)

  if(diagnostic_reg .and. &
       ntest > 0) write(6,*)'read_airnow_bufr: ',&
       'ntest,disterrmax=',ntest,disterrmax

  if (nodata == 0) then
     write(6,*)'did not find pm2_5 in airnow_bufr '
     write(6,*)'check input airnow_bufr file'
  endif

! write header record and data to output file for further processing
  call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs)
  write(lunout) obstype,sis,nreal,nchanl,ilat,ilon
  write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)

  return

end subroutine read_anowbufr


C  ICOMMON.f
      SUBROUTINE ICOMMON
c
      COMMON /SNTCP/ G,AJ,PRPC,ICASE,PREVER,MFSTOP,JUMP,LOPIN,ISCASE,
     .KN,GAMF,IP,SCRIT,PTRN,ISECT,KSTG,WTOL,RHOTOL,PRTOL,TRLOOP,LSTG,
     .LBRC,IBRC,ICHOKE,ISORR,CHOKE,PT0PS1(6,8),PTRS2(6,8),TRDIAG,SC,RC,
     .DELPR,PASS,IPC,LOPC,ISS

      COMMON /GEBE/TGEBE(10),IGEBE(9),TGEBE1(22),IGEBE1
      COMMON /SADIN2/ PTINH(6),TTINH(6),ALF0H(6)

C     COMMON /SINPUT/
C    .PTPS,PTIN,TTIN,WAIR,FAIR,DELC,DELL,DELA,AACS,VCTD,STG,SECT,EXPN,
C    .EXPP,EXPRE,RG,RPM,PAF,SLI,STGCH,ENDJOB,XNAME(20),TITLE(20),
C    .PCNH(6),GAM(6,8),DR(6,8),DT(6,8),RWG(6,8),ALPHAS(6,8),ALPHA1(6,8),
C    .ETARS(6,8),ETAS(6,8),CFS(6,8),ANDO(6,8),BETA1(6,8),BETA2(6,8),ETAR
C    .R(6,8),ETAR(6,8),CFR(6,8),TFR(6,8),ANDOR(6,8),OMEGAS(6,8),AS0(6,8)
C    .,ASMP0(6,8),ACMN0(6,8),A1(6,8),A2(6,8),A3(6,8),A4(6,8),A5(6,8),A6(
C    .6,8),OMEGAR(6,8),BSIA(6,8),BSMPIA(6,8),BCMNIA(6,8),B1(6,8),B2(6,8)
C    .,B3(6,8),B4(6,8),B5(6,8),B6(6,8),SESTHI(8),RERTHI(8)
C    .,fairx(5,8),wairx(5,8),rg1(8),rg1a(8),rg2(8),rg2a(8)

      COMMON/SINPUT/tsinput(1751)

      COMMON /SADDIN/ PS1P(8),PS2P(8)

C     COMMON /GETPR/ TRY1,TRY2,PTRY1,PTRY2,PFIND,DHFIND,PFIND1,
C    .DHFND1
      COMMON /GETPR/ TGETPR(8)

      COMMON /DESOPT/ RVU1(6,8),RVU2(6,8),WG,EPR

      REAL MR2,M2     ,MF2
      COMMON /SFLOW2/ TS2(6,8),CP2(8),R2(6,8),RHOS2(6,8),BET2E(6,8),
     .RU2(6,8),VU2(6,8),DPDR2(6,8),VZ2(6,8),MR2(6,8),MF2(6,8),M2(6,8)

      common/cfi/icf

      COMMON /TDIL/TWG (6,8),pwg(6,8)

      COMMON /PLOTT/ ENDPLT,IPCAS,IPSCAS(20),xnname(20),iplot(3)
      COMMON /SINIT/H1(6,8),H2(6,8),DP0(6,8),DP1(6,8),DP1A(6,8),DP2(6,8)
     1,DP2A(6,8),CSALF1(6,8),ALF1(6,8),CSBET2(6,8),BET2(6,8),RADSD(6,8),
     2RADRD(6,8),ANN1(6,8),ANN2(6,8),ANN2A(6,8),ANN1A(6,8),U1A(6,8),
     3U2(6,8),ANN0(6,8),PT0(6,8),TT0(6,8),ALPHA0(6,8),PTP(6,8)

      COMMON/RPMCOM/RPMK(8)
      REAL M0
      COMMON /SSTA01/CP0(8),w0(6),               PS0(6,8),V0(6,8),TS0(6,
     18),VU0(6,8),VZ0(6,8),RHOS0(6,8),PS1(6,8),WGT1(8),TA1(8),WG1(6,8),
     2            DPDR1(6,8),SI(6,8),  CP1(8),PHI1(6,8),TS1(6,8),V1(6,8)
     3,RHOS1(6,8),ALF1E(6,8),VU1(6,8),VZ1(6,8),M0(6,8)
      COMMON/TPT1/PT1(6),TT1(6,8)
C      COMMON /SOVRAL/DELHT(6,8),DELHTI(6,8),DELHSI(6,8),DEHATI(6,8),
C    1ETATT(6,8),ETATS(6,8),ETATAT(6,8),delhtu(6,8)

       COMMON /SOVRAL/TSOVRAL(384)

C      COMMON /SSTA1A/VU1A(6,8),WG1A(6,8),WGT1A(8),VZ1A(6,8),  CP1A(8),
C    1PS1A(6,8),RU1A(6,8),R1A(6,8),BET1A(6,8),RI(6,8),TTR1A(6,8),PTR1A(6
C    2,8),MR1A(6,8)

       COMMON /SSTA1A/TSTA1A(544)
c
C      COMMON /SSTA2/V2(6,8),TTR2(6,8),PTR2(6,8),WG2(6,8),WGT2(8),TA2(8),
C    1           PS2(6,8),PHI2(6,8)

       COMMON /SSTA2/TSSTA2(304)
       COMMON /SSTA2A/TSTA2A(656)
       COMMON /C1FIT1/TC1FIT(427),IC1FIT(3)
       COMMON /C2FIT1/TC2FIT(42)
       COMMON /BDINST/IBDINS(244)
       COMMON RES(8),DALF(6),DSTS(6),DALFE(6),DCPS(6),DSTR(6),
     *DBT2(6),DCPR(6),DSR2(6)
C
       COMMON /SLSHFT/TSLSH(102)
C
       COMMON /DATTRF/ HP1, TT123(48), PT123(48), WG123(48),
     *                 ETAS123(48), ETAR123(48), KS1

C      Common Block SNTCP variables:
         G = 0.
         AJ = 0.
         PRPC = 0.
         ICASE = 0
         PREVER = 0.
         MFSTOP = 0
         JUMP = 0
         LOPIN = 0.
         ISCASE = 0.
         KN = 0.
         GAMF = 0.
         IP = 0.
         SCRIT = 0.
         PTRN = 0.
         ISECT = 0
         KSTG = 0
         WTOL = 0.
         PHOTOL = 0.
         PRTOL = 0.
         TRLOOP = 0.
         LSTG = 0.
         LBRC = 0
         IBRC = 0
         ICHOKE = 0
         ISORR = 0
         CHOKE = 0.
         TRDIAG = 0
         SC = 0
         RC = 0
         DELPR = 0
         PASS = 0
         IPC = 0
         LOPC = 0
         ISS = 0
C
         WG = 0.
         EPR = 0.

C     COMMON BLOCK GEBE
      IGEBE1 = 0
      DO K = 1,10
         TGEBE(K) = 0.
      ENDDO
      DO K = 1,9
         IGEBE(K) = 0.
      ENDDO
      DO K = 1,22
         TGEBE1(K) = 0.
      ENDDO

C     COMMON BLOCK  SDDIN
      DO K = 1,8
         PS1P(K) = 0.
         PS2P(K) = 0.
         DO I = 1,6
            PT0PS1(I,K) = 0.
            PTRS2(I,K) = 0.
            TWG(I,K) = 0.
            PWG(I,K) = 0.
            RVU1(I,K) = 0.
            RVU2(I,K) = 0.
         ENDDO
      ENDDO

       DO K = 1,1751
          TSINPUT(K) = 0.
      ENDDO
C
C     COMMON BLOCK GETPR
C
      DO J = 1,8
       TGETPR(J) = 0.
      ENDDO
C
C     COMMON BLOCK Varaiables ...  SFLOW2
      DO K = 1,8
        CP2(K) = 0.
         DO I = 1,6
           TS2(I,K) = 0
           RHOS2(I,K) = 0.
           BET2E(I,K) = 0.
           R2(I,K) = 0.
           RU2(I,K) = 0.
           VU2(I,K) = 0.
           DPDR2(I,K) = 0.
           VZ2(I,K) = 0.
           MR2(I,K) = 0.
           MF2(I,K) = 0.
           M2(I,K) = 0.
        ENDDO
      ENDDO

C     COMMON BLOCK Varaiables ...  SINIT
      DO K = 1,8
         RPMK(K) = 0.
         DO I = 1,6
            H1(I,K) = 0.
            H2(I,K) = 0.
            DP0(I,K) = 0.
            DP1(I,K) = 0.
            DP1A(I,K) = 0.
            DP2(I,K) = 0.
            DP2A(I,K) = 0.
            CSALF1(I,K) = 0.
            ALF1(I,K) = 0.
            CSBET2(I,K) = 0.
            BET2(I,K) = 0.
            RADSD(I,K) = 0.
            RADRD(I,K) = 0.
            ANN1(I,K) = 0.
            ANN2(I,K) = 0.
            ANN2A(I,K) = 0.
            ANN1A(I,K) = 0.
            U1A(I,K) = 0.
            U2(I,K) = 0.
            ANN0(I,K) = 0.
            PT0(I,K) = 0.
            TT0(I,K) = 0.
            ALPHA0(I,K) = 0.
            PTP(I,K) = 0.
c
            PTINH(I) = 0.
            TTINH(I) = 0.
            ALF0H(I) = 0.
        ENDDO
      ENDDO

C     COMMON BLOCK Varaiables ...  TPT1,SSTA01
      DO K = 1,8
         CP0(K) = 0.
         CP1(K) = 0.
         WGT1(K) = 0.
         TA1(K) =  0.
         DO I = 1,6
            PT1(I) = 0.
            W0(I) = 0.
            TT1(I,K) = 0.
            PS0(I,K) = 0.
            V0(I,K) = 0.
            TS0(I,K) = 0.
            VU0(I,K) = 0.
            VZ0(I,K) = 0.
            RHOS0(I,K) = 0.
            PS1(I,K) = 0.
            WG1(I,K) = 0.
            DPDR1(I,K) = 0.0
            SI(I,K) = 0.
            PHI1(I,K) = 0.
            TS1(I,K) = 0.
            V1(I,K) = 0.
            RHOS1(I,K) = 0.
            ALF1E(I,K) = 0.
            VU1(I,K) = 0.
            VZ1(I,K) = 0.
            M0(I,K) = 0.
        ENDDO
      ENDDO

       DO K = 1,384
          TSOVRAL(K) = 0.
      ENDDO
       DO K = 1,544
         TSTA1A(K) = 0
      ENDDO

C     COMMON BLOCK Varaiables ... SSTA2
       DO K = 1,304
          TSSTA2(K) = 0.
      ENDDO
C     COMMON BLOCK Varaiables ...  SSTA2A
       DO K = 1,656
          TSTA2A(K) = 0.
      ENDDO
C     COMMON BLOCK Varaiables ... C1FIT1
       DO K = 1,427
          TC1FIT(K) = 0.
      ENDDO
       DO K = 1,3
          IC1FIT(K) = 0.
      ENDDO
C     COMMON BLOCK Varaiables ... C2FIT1
       DO K = 1,42
          TC2FIT(K) = 0.
      ENDDO
C     COMMON BLOCK Varaiables ... BDINST
       DO K = 1,244
          IBDINS(K) = 0.
      ENDDO
C     COMMON BLOCK ... NO name
      DO K = 1,8
         RES(K) = 0.
      ENDDO
      DO K = 1,6
         DALF(K) = 0.
         DSTS(K) = 0.
         DALFE(K) = 0.
         DCPS(K) = 0.
         DSTR(K) = 0.
         DBT2(K) = 0.
         DCPR(K) = 0.
         DSR2(K) = 0.
      ENDDO

C     COMMON BLOCK ... SLSHFT
      DO K = 1,102
         TSLSH(K) = 0.
      ENDDO
C     COMMON BLOCK ... DATTRF
      HP1 = 0
      KS1 = 0
      DO  K = 1, 48
        TT123(K) = 0.
        PT123(K) = 0.
        WG123(K) = 0.
        ETAS123(K) = 0.
        ETAR123(K) = 0.
      ENDDO
C
      RETURN
      END


varying vec3 position;
varying vec3 normal;

#define hasSpecMap %hasSpecMap%
#define hasBumpMap %hasBumpMap%
#define hasAlphaMap %hasAlphaMap%
#define hasColorMap %hasColorMap%
#define hasLumiMap %hasLumiMap%
#define hasShadowMap0 %hasShadowMap0%
#define hasShadowMap1 %hasShadowMap1%
#define hasShadowMap2 %hasShadowMap2%
#define hasShadowMap3 %hasShadowMap3%
#define hasShadowMap4 %hasShadowMap4%
#define hasShadowMap5 %hasShadowMap5%
#define hasShadowMap6 %hasShadowMap6%
#define hasShadowMap7 %hasShadowMap7%
#define hasEnvSphereMap %hasEnvSphereMap%
#define hasReflectionMap %hasReflectionMap%
#define hasLightMap %hasLightMap%
#define hasParallaxMap %hasParallaxMap%

#if hasSpecMap
uniform sampler2D specMap;
#endif

#if hasBumpMap
uniform sampler2D bumpMap;
#endif

//#if hasAlphaMap
//uniform sampler2D alphaMap;
//#endif

#if hasColorMap
uniform sampler2D colorMap;
#endif

#if hasLumiMap
uniform sampler2D lumiMap;
#endif

#if hasLightMap
uniform sampler2D lightMap;
#endif

#if hasEnvSphereMap
	uniform sampler2D envSphereMap;
	uniform vec4 projEnv;
	uniform float envAmount;
#if hasBumpMap
	varying vec3 u;
#endif
#endif

#if hasReflectionMap
	uniform sampler2D reflectionMap;
#endif

#if hasShadowMap0|hasShadowMap1|hasShadowMap2|hasShadowMap3|hasShadowMap4|hasShadowMap5|hasShadowMap6|hasShadowMap7
	uniform sampler2DShadow shadowMap0;
	varying vec4 ProjShadow0;
#endif

#if hasParallaxMap
	uniform sampler2D parallaxMap;
	uniform float parallaxScale;
	uniform float parallaxBias;
	varying vec3 eyeVec;
#endif

void main()
{
#if hasParallaxMap
	  float height = texture2D(parallaxMap, gl_TexCoord[0].xy).r;
	  float eyev = (height) * parallaxScale - parallaxBias;
	  vec3 eye = normalize(eyeVec);
	  vec2 texCoord = gl_TexCoord[0].xy + (eye.xy * eyev);
#else
	  vec2 texCoord = gl_TexCoord[0].xy;
#endif

    vec3 l = gl_LightSource[%LIGHTID%].position.xyz - position;
    float d = length(l);
    float atten = 1.0 / (gl_LightSource[%LIGHTID%].constantAttenuation +
                         gl_LightSource[%LIGHTID%].linearAttenuation * d +
                         gl_LightSource[%LIGHTID%].quadraticAttenuation * d * d);

    l = normalize(l);

    float spotDot = dot(-l, normalize(gl_LightSource[%LIGHTID%].spotDirection));

    float spotEffect = (spotDot < gl_LightSource[%LIGHTID%].spotCosCutoff)
                        ? 0.0 : pow(spotDot, gl_LightSource[%LIGHTID%].spotExponent);

    atten *= spotEffect;

    vec3 n;

#if hasBumpMap
		vec3 bumpNorm = vec3(texture2D(bumpMap, texCoord));
		n = normalize(normal+((bumpNorm-0.5)*2.0));
#else
		n = normalize(normal);
#endif

    vec3 v = normalize(-position);
    vec3 h = normalize(l + v);

    float nDotL = max(0.0, dot(n, l));
    float nDotH = max(0.0, dot(n, h));
    float power = (nDotL == 0.0) ? 0.0 : pow(nDotH, gl_FrontMaterial.shininess);

    vec4 diffuse = gl_FrontLightProduct[%LIGHTID%].diffuse * nDotL * atten;

	vec4 specVal;

#if hasSpecMap
			specVal = texture2D(specMap, texCoord);
#else
			specVal = gl_FrontMaterial.specular;
#endif

    vec4 specular = specVal * gl_FrontLightProduct[%LIGHTID%].specular * power * atten;

    vec4 ambient = gl_FrontLightProduct[%LIGHTID%].ambient + gl_LightSource[%LIGHTID%].ambient;
    vec4 color = gl_FrontLightModelProduct.sceneColor + diffuse + specular;

#if hasEnvSphereMap|hasLightMap
	vec4 litColor = color;
#endif

#if hasShadowMap0|hasShadowMap1|hasShadowMap2|hasShadowMap3|hasShadowMap4|hasShadowMap5|hasShadowMap6|hasShadowMap7
		color *= clamp(shadow2DProj(shadowMap0, ProjShadow0),0.0,1.0);
#endif

		color += ambient*gl_FrontMaterial.diffuse;

#if hasColorMap
		color *= texture2D(colorMap, texCoord);
#endif

#if hasLumiMap
		color.rgb += (vec3(1.0,1.0,1.0)-color.rgb) * 2.0 * texture2D(lumiMap, texCoord).rgb;
#endif

#if hasLightMap
		color.rgb += (texture2D(lightMap, gl_TexCoord[2].st).rgb*2.0)*texture2D(colorMap, texCoord).rgb;
#endif

#if hasEnvSphereMap

#if hasBumpMap
	vec3 r = reflect( u, n );
	float m = 2.0 * sqrt( r.x*r.x + r.y*r.y + (r.z+1.0)*(r.z+1.0) );
//
	vec3 coord;
	coord.s = r.x/m + 0.5;
	coord.t = r.y/m + 0.5;

	#if hasReflectionMap
		color += litColor * texture2D( envSphereMap, coord.st) * texture2D( reflectionMap, texCoord);
	#else
		color += litColor * texture2D( envSphereMap, coord.st) * envAmount;
	#endif

#else
	#if hasReflectionMap
		color += litColor * texture2D( envSphereMap, gl_TexCoord[1].st) * texture2D( reflectionMap, texCoord);
	#else
		color += litColor * texture2D( envSphereMap, gl_TexCoord[1].st) * envAmount;
	#endif
#endif

#endif

#if hasAlphaMap
		color.a = texture2D(colorMap, texCoord).a;
#else
		color.a = gl_FrontLightModelProduct.sceneColor.a;
#endif

	gl_FragColor = color;
}


!> Module containing the SoilProfile class definition
module SoilProfileModule
    use Globals
    use UtilModule
    use mo_netcdf
    use netcdf, only: nf90_fill_real
    use datetime_module
    use ResultModule, only: Result
    use AbstractSoilProfileModule
    use SoilLayerModule
    use DataInputModule, only: DATASET
    implicit none

    !> A SoilProfile class acts as a container for a collection of SoilLayer objects,
    !! which collectively define the layout of the SoilProfile
    type, public, extends(AbstractSoilProfile) :: SoilProfile
      contains
        procedure :: create => createSoilProfile
        procedure :: update => updateSoilProfile
        procedure :: percolate => percolateSoilProfile
        procedure :: erode => erodeSoilProfile
        procedure :: bioturbation => bioturbationSoilProfile
        procedure :: imposeSizeDistribution => imposeSizeDistributionSoilProfile
        procedure :: calculateAverageGrainSize => calculateAverageGrainSizeSoilProfile
        procedure :: calculateSizeDistribution => calculateSizeDistributionSoilProfile
        procedure :: parseInputData => parseInputDataSoilProfile
        procedure :: parseNewBatchData => parseNewBatchDataSoilProfile
        ! Getters
        procedure :: get_m_np => get_m_np_SoilProfile
        procedure :: get_m_transformed => get_m_transformed_SoilProfile
        procedure :: get_m_dissolved => get_m_dissolved_SoilProfile
        procedure :: get_C_np => get_C_np_SoilProfile
        procedure :: get_C_transformed => get_C_transformed_SoilProfile
        procedure :: get_C_dissolved => get_C_dissolved_SoilProfile
    end type

  contains
    !> Creating the SoilProfile parses input data and fills the corresponding object properties,
    !! as well as setting up the contained SoilLayers
    function createSoilProfile(me, x, y, p, n_river, area, q_precip_timeSeries, &
                               q_evap_timeSeries) result(r)
        class(SoilProfile)  :: me                           !! The `SoilProfile` instance.
        integer             :: x                            !! Containing `GridCell` x index
        integer             :: y                            !! Containing `GridCell` y index
        integer             :: p                            !! `SoilProfile` reference (redundant for now as only one `SoilProfile` per `GridCell`)
        real(dp)            :: n_river                      !! Manning's roughness coefficient for the `GridCell`'s rivers [-]
        real(dp)            :: area                         !! The surface area of the `SoilProfile` [m3]
        real, allocatable   :: q_precip_timeSeries(:)       !! Precipitation time series [m/timestep]
        real, allocatable   :: q_evap_timeSeries(:)         !! Evaporation time series [m/timestep]
        type(Result)        :: r                            !! The `Result` object
        integer             :: l                            ! Soil layer iterator
        type(SoilLayer), allocatable :: sl                  ! Temporary SoilLayer variable

        ! Generate the reference name for this SoilProfile
        me%ref = ref("SoilProfile", x, y, p)
        ! Allocate the object properties that need to be
        allocate(me%erodedSediment(C%nSizeClassesSpm), &
            me%distributionSediment(C%nSizeClassesSpm), &
            me%m_np(C%npDim(1), C%npDim(2), C%npDim(3)), &
            me%m_np_buried(C%npDim(1), C%npDim(2), C%npDim(3)), &
            me%m_np_eroded(C%npDim(1), C%npDim(2), C%npDim(3)), &
            me%m_np_in(C%npDim(1), C%npDim(2), C%npDim(3)), &
            me%m_transformed(C%npDim(1), C%npDim(2), C%npDim(3)), &
            me%m_transformed_buried(C%npDim(1), C%npDim(2), C%npDim(3)), &
            me%m_transformed_eroded(C%npDim(1), C%npDim(2), C%npDim(3)), &
            me%m_transformed_in(C%npDim(1), C%npDim(2), C%npDim(3)), &
            me%colSoilLayers(C%nSoilLayers))
        ! Initialise variables
        me%x = x                                            ! GridCell x index
        me%y = y                                            ! GridCell y index
        me%p = p                                            ! SoilProfile index within the GridCell
        me%n_river = n_river
        me%area = area                                      ! Surface area
        allocate(me%q_precip_timeSeries, source=q_precip_timeSeries)            ! [m/timestep]
        allocate(me%q_evap_timeSeries, source=q_evap_timeSeries)                ! [m/timestep]
        me%V_buried = 0.0_dp                                ! Volume of water "lost" from the bottom of SoilProfile
        me%m_np_buried = 0.0_dp                             ! Mass of NM "lost" from the bottom of the SoilProfile
        me%m_np = 0.0_dp                                    ! Nanomaterial mass
        me%m_np_eroded = 0.0_dp
        me%m_np_in = 0.0_dp
        me%m_transformed = 0.0_dp
        me%m_transformed_eroded = 0.0_dp
        me%m_transformed_in = 0.0_dp
        me%m_transformed_buried = 0.0_dp
        me%m_dissolved = 0.0_dp
        me%m_dissolved_in = 0.0_dp
        me%m_dissolved_buried = 0.0_dp

        ! Parse and store input data in this object's properties
        call r%addErrors(.errors. me%parseInputData())
        if (r%hasCriticalError()) return                    ! Return early if there are critical errors

        ! Set up the SoilLayers
        do l = 1, C%nSoilLayers
            allocate(sl)        ! Must be allocated on every time step
            ! Create the SoilLayer and add any errors to Result object
            call r%addErrors(.errors. &
                sl%create( &
                    me%x, &
                    me%y, &
                    me%p, &
                    l, &
                    me%WC_sat, &
                    me%WC_FC, &
                    me%K_s, &
                    me%area, &
                    me%bulkDensity, &
                    me%d_grain, &
                    me%porosity, &
                    me%earthwormDensity * DATASET%earthwormVerticalDistribution(l) &    ! Split earthworm density into vertical distribution
                ) &
            )
            call move_alloc(sl, me%colSoilLayers(l)%item)
        end do
        call r%addToTrace("Creating " // trim(me%ref))
    end function

    !> Perform the simulation of the SoilProfile for the current time step, including
    !! percolation of soil through soil layers and soil erosion
    function updateSoilProfile(me, t, j_np_diffuseSource, j_transformed_diffuseSource, j_dissolved_diffuseSource) result(r)
        class(SoilProfile)  :: me                                   !! This `SoilProfile` instance
        integer             :: t                                    !! The current timestep
        real(dp)            :: j_np_diffuseSource(:,:,:)            !! Diffuse source of NM for this timestep [kg/m2/timestep]
        real(dp)            :: j_transformed_diffuseSource(:,:,:)   !! Diffuse source of NM for this timestep [kg/m2/timestep]
        real(dp)            :: j_dissolved_diffuseSource            !! Diffuse source of NM for this timestep [kg/m2/timestep]
        type(Result)        :: r                                    !! Result object to return

        ! Reset for this timestep
        me%V_pool = 0.0_dp

        if (.not. me%isUrban) then
            ! Set the timestep-specific object properties
            me%q_precip = me%q_precip_timeSeries(t)                 ! Get the relevant time step's precipitation [m/timestep]
            me%q_evap = me%q_evap_timeSeries(t)                     ! and evaporation [m/timestep]
            me%q_in = max(me%q_precip - me%q_evap, 0.0_dp)          ! Infiltration = precip - evap. This is supplied to SoilLayer_1 [m/timestep]. Minimum = 0.
                ! TODO: Should the minimum q_in be 0, or should evaporation be allowed to remove water from top soil layer?

            ! Add NM from the diffuse source
            me%m_np = me%m_np + j_np_diffuseSource * me%area          ! j_np_diffuseSource is in kg/m2/timestep
            me%m_np_in = j_np_diffuseSource * me%area
            me%m_transformed_in = j_transformed_diffuseSource * me%area
            me%m_transformed = me%m_transformed + me%m_transformed_in
            me%m_dissolved_in = j_dissolved_diffuseSource * me%area
            me%m_dissolved = me%m_dissolved + me%m_dissolved_in

            ! Perform percolation, erosion and bioturbation simluations
            call r%addErrors([ &
                .errors. me%erode(t), &
                .errors. me%percolate(t, j_np_diffuseSource, j_transformed_diffuseSource, j_dissolved_diffuseSource), &
                .errors. me%bioturbation() &
            ])

            ! Remove buried NM (eroded NM removed in me%erode)
            ! TODO unify where me%m_np is updated (or deprecate, see me%erode())
            me%m_np = me%m_np - me%m_np_buried

        else
            ! If this is an urban cell, presume no erosion
            me%erodedSediment = 0
        end if

        ! Add this procedure to the Result object's trace
        call r%addToTrace("Updating " // trim(me%ref) // " on timestep #" // trim(str(t)))
    end function

    !> Percolate water through the `SoilProfile`, by looping through `SoilLayer`s
    !! and running their individual percolation procedures, and then passing
    !! percolated and pooled flows between `SoilLayer`s. Pooled water from top
    !! `SoilLayer` forms surface runoff, and "lost" water from bottom `SoilLayer`
    !! is kept track of in `me%V_buried`
    function percolateSoilProfile(me, t, j_np_diffuseSource, j_transformed_diffuseSource, j_dissolved_diffuseSource) result(r)
        class(SoilProfile)  :: me                               !! This `SoilProfile` instance
        integer             :: t                                !! The current time step
        real(dp)            :: j_np_diffuseSource(:,:,:)        !! Difffuse source of NM for this timestep [kg/m2/timestep]
        real(dp)            :: j_transformed_diffuseSource(:,:,:)
        real(dp)            :: j_dissolved_diffuseSource
        type(Result)        :: r                                !! The `Result` object to return
        integer             :: l, i                             ! Loop iterator for SoilLayers
        real(dp)            :: q_l_in                           ! Temporary water inflow for a particular SoilLayer
        real(dp)            :: m_np_l_in(C%npDim(1), &          ! Temporary NM inflow for particular SoilLayer
                                         C%npDim(2), &
                                         C%npDim(3))
        real(dp)            :: m_transformed_l_in(C%npDim(1), C%npDim(2), C%npDim(3))
        real(dp)            :: m_dissolved_l_in

        ! Loop through SoilLayers and percolate
        do l = 1, C%nSoilLayers
            if (l == 1) then
                 ! If it's the first SoilLayer, water and NM inflow will be from precip - ET
                 ! and the diffuse source, respectively
                q_l_in = me%q_in                                    ! [m3/m2/timestep]
                m_np_l_in = j_np_diffuseSource * me%area            ! [kg/timestep]
                m_transformed_l_in = j_transformed_diffuseSource * me%area
                m_dissolved_l_in = j_dissolved_diffuseSource * me%area
            else
                ! Otherwise, they'll be from the layer above
                q_l_in = me%colSoilLayers(l-1)%item%V_perc          ! [m3/m2/timestep]
                m_np_l_in = me%colSoilLayers(l-1)%item%m_np_perc    ! [kg/timestep]
                m_transformed_l_in = me%colSoilLayers(l-1)%item%m_transformed_perc  ! [kg/timestep]
                m_dissolved_l_in = me%colSoilLayers(l-1)%item%m_dissolved_perc      ! [kg/timestep]
            end if

            ! Run the percolation simulation for individual layer, setting V_perc, V_pool, m_np_perc etc.
            call r%addErrors(.errors. &
                me%colSoilLayers(l)%item%update(t, q_l_in, m_np_l_in, m_transformed_l_in, m_dissolved_l_in) &
            )
            ! If there is pooled water, we must push up to the previous layer, recursively
            ! for each SoilLayer above this
            do i = 1, l
                ! Check if the layer beneath has pooled any water
                if (abs(me%colSoilLayers(l-i+1)%item%V_pool) > C%epsilon) then
                    if (l-i == 0) then                          ! If it's the top soil layer, track how much pooled above soil
                        me%V_pool = me%colSoilLayers(l-i+1)%item%V_pool
                    else                                        ! Else, add pooled volume to layer above
                        call r%addErrors(.errors. &
                            me%colSoilLayers(l-i)%item%addPooledWater( &
                                me%colSoilLayers(l-i+1)%item%V_pool &
                            ) &
                        )
                    end if
                end if
            end do
        end do

        ! Keep track of "lost" NM and water from the bottom soil layer. Not cumulative.
        me%V_buried = me%colSoilLayers(C%nSoilLayers)%item%V_perc
        me%m_np_buried = me%colSoilLayers(C%nSoilLayers)%item%m_np_perc
        me%m_transformed_buried = me%colSoilLayers(C%nSoilLayers)%item%m_transformed_perc
        me%m_dissolved_buried = me%colSoilLayers(C%nSoilLayers)%item%m_dissolved_perc

        ! Add this procedure to the Result object's trace
        call r%addToTrace("Percolating water on time step #" // trim(str(t)))
    end function

    !> Calculate the soil erosion for this timestep and updates this GridCell's `erodedSediment` property.
    !! Soil erosion based on RUSLE, with R-factor derived from kinetic energy calculated by Davison method:
    !! [Davison et al. 2005](https://doi.org/10.1016/j.scitotenv.2005.02.002). Europe specific parameterisation
    !! include in a1, a2, a3 and b parameters (provided by input data). K factor based on [modified Morgan
    !! Finney](https://doi.org/10.1002/esp.1530) and in g/J. Using these units, R-factor is simply equal to
    !! kinetic energy (J/m2) and sediment yield is in g/m2.
    !! Note that here we're just calculating the total sediment yield, *not* the amount this is transported to
    !! the reaches, which is scaled by the sediment transport capacity, as calculated by reaches.
    function erodeSoilProfile(me, t) result(rslt)
        class(SoilProfile)  :: me
        integer             :: t
        type(Result)        :: rslt
        real(dp)            :: E_k
        real(dp)            :: K_MMF
        real(dp)            :: erodedSedimentTotal
        type(datetime)      :: currentDate
        integer             :: julianDay
        integer             :: i

        ! Only calculate erosion yield if we're meant to be
        if (C%includeSoilErosion) then
            ! TODO This function only works with daily timesteps

            ! Convert the current date to Julian day number (https://en.wikipedia.org/wiki/Julian_day).
            ! date2num converts to number of days since 0001-01-01, and 1721423 is the Julian day
            ! number of 0001-01-01.
            currentDate = C%startDate + timedelta(days=t-1)
            julianDay = currentDate%yearday()
            ! Then calculate the kinetic energy [J/m2/day]. Precip needs converting to [mm/day] from [m/timestep].
            E_k = (me%erosivity_a1 + me%erosivity_a2 * cos(julianDay * (2*C%pi/365) + me%erosivity_a3)) &
                    * (me%q_precip_timeSeries(t)*1.0e3)**me%erosivity_b
            ! Now the modified MMF version of K, dependent on sand, silt and clay content [g/J]
            K_MMF = 0.1*(me%clayContent/100.0_dp) + 0.3*(me%sandContent/100.0_dp) + 0.5*(me%siltContent/100.0_dp)
            ! Total eroded sediment [g/m2/day]
            erodedSedimentTotal = E_k * K_MMF * me%usle_C * me%usle_P * me%usle_LS
            ! Split this into a size distribution and convert to [kg/m2/day]
            me%erodedSediment = me%imposeSizeDistribution(erodedSedimentTotal*1.0e-3)
        else
            ! If we're not meant to be modelling erosion, then set yield to zero
            me%erodedSediment = 0.0_dp
        end if

        ! The top soil layer deals with eroding NM
        call rslt%addErrors(.errors. me%colSoilLayers(1)%item%erode(me%erodedSediment, me%bulkDensity, me%area))
        ! Remove this eroded soil from the total m_np in the profile
        do i = 1, C%nSizeClassesNM
            ! Transfer NM eroded from attached to heteroaggregated, by imposing the size distribution
            ! as for eroded SPM. The logic here is that the soil the NM is attached to will end up
            ! as SPM and thus the NM attached it will be heteroaggregated rather than attached/bound.
            me%m_np_eroded(i,1,3:) = me%imposeSizeDistribution(me%colSoilLayers(1)%item%m_np_eroded(i,1,2))     ! [kg/gridcell/timestep]
            me%m_transformed_eroded(i,1,3:) = me%imposeSizeDistribution(me%colSoilLayers(1)%item%m_transformed_eroded(i,1,2))
        end do
        ! TODO why is attached being set? m_np_eroded has double the mass it should now
        me%m_np_eroded(:,1,2) = me%colSoilLayers(1)%item%m_np_eroded(:,1,2)
        me%m_transformed_eroded(:,1,2) = me%colSoilLayers(1)%item%m_transformed_eroded(:,1,2)
        me%m_np(:,1,2) = me%m_np(:,1,2) - me%m_np_eroded(:,1,2)     ! Remove the eroded NM from the soil
        me%m_transformed(:,1,2) = me%m_transformed(:,1,2) - me%m_transformed_eroded(:,1,2)

    end function

    !> Perform bioturbation on a time step by mixing calculated depth of two layers together
    function bioturbationSoilProfile(me) result(rslt)
        class(SoilProfile)  :: me           !! This `SoilProfile` instance
        type(Result)        :: rslt         !! The `Result` object to return
        integer             :: i            ! Iterator
        real                :: fractionOfLayerToMix
        ! Only model bioturbation if config file has asked us to
        if (C%includeBioturbation) then
            ! Perform bioturbation for each layer, except final layer
            ! TODO set some proper boundary conditions
            do i = 1, C%nSoilLayers - 1
                fractionOfLayerToMix = me%colSoilLayers(i)%item%calculateBioturbationRate() * C%timeStep
                ! Only attached NM are mixed
                me%colSoilLayers(i)%item%m_np(:,1,2) = me%colSoilLayers(i)%item%m_np(:,1,2) &
                    + fractionOfLayerToMix * (me%colSoilLayers(i+1)%item%m_np(:,1,2) - me%colSoilLayers(i)%item%m_np(:,1,2))
                me%colSoilLayers(i+1)%item%m_np(:,1,2) = me%colSoilLayers(i+1)%item%m_np(:,1,2) &
                    + fractionOfLayerToMix * (me%colSoilLayers(i)%item%m_np(:,1,2) - me%colSoilLayers(i+1)%item%m_np(:,1,2))
                ! Same for transformed NM
                me%colSoilLayers(i)%item%m_transformed(:,1,2) &
                    = me%colSoilLayers(i)%item%m_transformed(:,1,2) + fractionOfLayerToMix &
                    * (me%colSoilLayers(i+1)%item%m_transformed(:,1,2) - me%colSoilLayers(i)%item%m_transformed(:,1,2))
                me%colSoilLayers(i+1)%item%m_transformed(:,1,2) &
                    = me%colSoilLayers(i+1)%item%m_transformed(:,1,2) + fractionOfLayerToMix &
                    * (me%colSoilLayers(i)%item%m_transformed(:,1,2) - me%colSoilLayers(i+1)%item%m_transformed(:,1,2))
            end do
        end if
    end function

    !> Impose a size class distribution on a total mass to split it up into separate size classes.
    !! If no distribution has been specified for this `SoilProfile`, then a default global size
    !! distribution is used. Clay enrichment is calculated by the calculateClayEnrichment function,
    !! based on clay enrichment factors from the input data (or defaults).
    function imposeSizeDistributionSoilProfile(me, mass) result(distribution)
        class(SoilProfile)  :: me                               !! This `SoilProfile` instance
        real(dp)            :: mass                             !! The mass to split into size classes
        real(dp)            :: distribution(C%nSizeClassesSpm)  !! The resulting distribution
        distribution = mass * me%distributionSediment
    end function

    !> Re-bin the clay-silt-sand content into the binned sediment size classes used in the model
    function calculateSizeDistributionSoilProfile(me, clay, silt, sand, enrichClay) result(ssd)
        class(SoilProfile) :: me                                    !! This soil profile
        real    :: clay, silt, sand                                 !! Percentage clay, silt and sand
        logical :: enrichClay                                       !! Should we enrich the clay content of the sediment?
        real    :: ssd(C%nSizeClassesSpm)                           !! Calculated sediment size distribution
        real    :: texture(3)                                       !! Array to store clay, silt and sand content in
        real    :: clayEnrichmentRatio                              ! Clay enrichment ratio
        real    :: dClay                                            ! Change in clay content
        real    :: textureEnriched(3)                               ! Texture distribution, clay enriched
        real    :: texture_bins(3,2)                                ! Array to store texture size class bounds in
        real    :: ssd_bins(C%nSizeClassesSpm,2)                    ! Array to store sediment size class bounds in
        real    :: frac_ssd_in_texture_bin(3,C%nSizeClassesSpm)     ! Fraction of SSD bin in texture bin
        integer :: i, j                                             ! Iterators
        logical :: not_in_ssd_bin                                   ! Is this texture bin within this SSD bin?
        real    :: lower, upper                                     ! Lower and upper bounds of overlap between texture and SSD bins
        real    :: ssd_(3,C%nSizeClassesSpm)                        ! Temporary SSD array, before summing across SSD dimension
        ! Bins for texture content, based on definition of clay, silt and sand. First bins
        ! have non-zero lower bound to avoid numerical errors when logging
        texture = [clay, silt, sand] / 100.0
        if (enrichClay) then
            clayEnrichmentRatio = 0.26 + 1 / (1 - texture(3))               ! Ref: Stefano and Ferro, 2002: https://doi.org/10.1006/bioe.2001.0034
            dClay = texture(1) * clayEnrichmentRatio - texture(1)           ! Change in clay content due to enrichment
            textureEnriched = [texture(1) * clayEnrichmentRatio, texture(2) - dClay / 2, texture(3) - dClay / 2]
        else
            textureEnriched = texture
        end if
        texture_bins = log(reshape([1e-9, 0.002, 0.06, 0.002, 0.06, 2.0], [3,2]))
        ssd_bins(1,1) = log(1e-9)
        do i = 1, C%nSizeClassesSpm
            ! Set the upper bound for this bin to the diameter given in config, then set the
            ! lower bound for the next bin to the same
            ssd_bins(i,2) = log(C%d_spm(i) * 1e3)
            if (i < C%nSizeClassesSpm) then
                ssd_bins(i+1,1) = log(C%d_spm(i) * 1e3)
            end if
        end do
        ! Loop through texture bins and calculate the fraction of each SSD bin in that texture bin
        do i = 1, 3
            do j = 1, C%nSizeClassesSpm
                not_in_ssd_bin = .false.
                ! Lower overlap bound
                if (texture_bins(i,1) <= ssd_bins(j,2)) then
                    lower = max(texture_bins(i,1), ssd_bins(j,1))
                else
                    not_in_ssd_bin = .true.
                end if
                ! Upper overlap bound
                if (texture_bins(i,2) >= ssd_bins(j,1)) then
                    upper = min(texture_bins(i,2), ssd_bins(j,2))
                else
                    not_in_ssd_bin = .true.
                end if
                ! Set the fraction of SSD bin in this texture bin, based on lower and upper bounds
                if (not_in_ssd_bin) then
                    frac_ssd_in_texture_bin(i,j) = 0.0
                else
                    frac_ssd_in_texture_bin(i,j) = (upper - lower) / (texture_bins(i,2) - texture_bins(i,1))
                end if
            end do
            ssd_(i,:) = textureEnriched(i) * frac_ssd_in_texture_bin(i,:)
        end do
        ! Sum the ssd_ array into the final sediment distribution
        ssd = sum(ssd_, dim=1)
    end function

    !> Calculate the average grain size from soil texture properties, using RUSLE handbook
    !! http://www.grr.ulaval.ca/gae_3005/Documents/References/RUSLE/ah703_ch3.pdf (p76):
    !! d_grain = exp(%clay * ln(0.001) + %silt * ln(0.026) + %sand * ln(1.025))
    function calculateAverageGrainSizeSoilProfile(me, clay, silt, sand) result(d_grain)
        class(SoilProfile) :: me            !! This soil profile
        real :: clay, silt, sand            !! Percentage clay, silt and sand
        real :: d_grain                     !! The average grain size
        d_grain = 1e-3 * exp(0.01 * (clay * log(0.001) + silt * log(0.026) + sand * log(1.025)))
    end function

    !> Get the data from the input file and set object properties
    !! accordingly, including the allocation of arrays that depend on
    !! this input data
    function parseInputDataSoilProfile(me) result(r)
        class(SoilProfile)     :: me                        !! This `SoilProfile` instance
        type(Result)            :: r                        !! `Result` object to return
        integer                 :: landUse                  ! Index of max land use fraction in this profile

        me%distributionSediment = DATASET%defaultSpmSizeDistribution ! TODO we can probably get rid of this, but check
        me%bulkDensity = DATASET%soilBulkDensity(me%x, me%y)
        me%WC_sat = DATASET%soilWaterContentSaturation(me%x, me%y)
        me%WC_FC = DATASET%soilWaterContentFieldCapacity(me%x, me%y)
        me%K_s = DATASET%soilHydraulicConductivity(me%x, me%y)
        ! Soil hydraulic properties contain no data where in urban areas. For the moment,
        ! until land cover properly incorporated into model, we'll use this as a proxy
        ! for urban areas (which therefore contain no soil profile). In the future, we should
        ! account for this properly by splitting grid cells into different soil profiles.
        if (me%WC_sat == nf90_fill_real) me%WC_sat = 0.8
        if (me%WC_FC == nf90_fill_real) me%WC_FC = 0.5
        if (me%K_s == nf90_fill_real) me%K_s = 1e-6
        if (me%bulkDensity == nf90_fill_real) me%bulkDensity = 1220

        me%clayContent = DATASET%soilTextureClayContent(me%x, me%y)
        me%sandContent = DATASET%soilTextureSandContent(me%x, me%y)
        me%siltContent = DATASET%soilTextureSiltContent(me%x, me%y)
        me%coarseFragContent = DATASET%soilTextureCoarseFragContent(me%x, me%y)
        if (me%coarseFragContent == nf90_fill_real) then
            me%coarseFragContent = 0.0
        end if
        ! Calculate the average grain diameter from soil texture
        me%d_grain = me%calculateAverageGrainSize(me%clayContent, me%siltContent, me%sandContent)
        me%distributionSediment = me%calculateSizeDistribution( &
            me%clayContent, &
            me%siltContent, &
            me%sandContent, &
            C%includeClayEnrichment &
        )
        me%porosity = DATASET%soilDefaultPorosity       ! TODO change to be spatial

        ! USLE params
        me%usle_C = DATASET%soilUsleCFactor(me%x, me%y)
        if (me%usle_C == nf90_fill_double) then
            me%usle_C = 0.00055095          ! Pick a small value to represent urban, if there's no data
        end if
        me%usle_P = DATASET%soilUslePFactor(me%x, me%y)
        if (me%usle_P == nf90_fill_double) then
            me%usle_P = 1.0                 ! If there's no data, assume no support practice
        end if
        me%usle_LS = DATASET%soilUsleLSFactor(me%x, me%y)
        if (me%usle_LS == nf90_fill_double) then
            me%usle_LS = 0.3                 ! Pick an average value if there's no data
        end if

        ! Get earthworm density from land use. Select the maximum land use fraction and use all
        ! of profile as that
        landUse = maxloc(DATASET%landUse(me%x, me%y, :), dim=1)
        ! TODO get these values more intelligently
        select case (landUse)
            case (1)
                me%earthwormDensity = DATASET%earthwormDensityUrbanCapped
                me%dominantLandUseName = 'urban_no_soil'
            case (2)
                me%earthwormDensity = DATASET%earthwormDensityUrbanParks
                me%dominantLandUseName = 'urban_parks_leisure'
            case (3)
                me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
                me%dominantLandUseName = 'urban_industrial_soil'
            case (4)
                me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
                me%dominantLandUseName = 'urban_green_residential'
            case (5)
                me%earthwormDensity = DATASET%earthwormDensityArable
                me%dominantLandUseName = 'arable'
            case (6)
                me%earthwormDensity = DATASET%earthwormDensityGrassland
                me%dominantLandUseName = 'grassland'
            case (7)
                me%earthwormDensity = DATASET%earthwormDensityDeciduous
                me%dominantLandUseName = 'deciduous'
            case (8)
                me%earthwormDensity = DATASET%earthwormDensityConiferous
                me%dominantLandUseName = 'coniferous'
            case (9)
                me%earthwormDensity = DATASET%earthwormDensityHeathland
                me%dominantLandUseName = 'heathland'
            case (10)
                me%earthwormDensity = 0.0_dp
                me%dominantLandUseName = 'water'
            case (11)
                me%earthwormDensity = 0.0_dp
                me%dominantLandUseName = 'desert'
            case default
                me%earthwormDensity = 0.0_dp
                me%dominantLandUseName = 'other'
        end select

        ! Auditing
        call r%addError( &
            ERROR_HANDLER%equal( &
                value = sum(me%distributionSediment), &
                criterion = 1.0_dp, &
                message = "Grain size distribution does not sum to 100%. " &
                            // "Have you set sediment size classes correctly?" &
            ) &
        )

        me%erosivity_a1 = DATASET%soilErosivity_a1
        me%erosivity_a2 = DATASET%soilErosivity_a2
        me%erosivity_a3 = DATASET%soilErosivity_a3
        me%erosivity_b = DATASET%soilErosivity_b

        ! Add this procedure to the trace
        call r%addToTrace('Parsing input data')
    end function

    subroutine parseNewBatchDataSoilProfile(me)
        class(SoilProfile) :: me
        integer :: landUse

        ! These timeseries are passed to soil profile in create(), so we need to set again here
        deallocate(me%q_evap_timeSeries, me%q_precip_timeSeries)
        allocate(me%q_evap_timeSeries, source=DATASET%evap(me%x, me%y, :))
        allocate(me%q_precip_timeSeries, source=DATASET%precip(me%x, me%y, :))

        me%bulkDensity = DATASET%soilBulkDensity(me%x, me%y)
        me%WC_sat = DATASET%soilWaterContentSaturation(me%x, me%y)
        me%WC_FC = DATASET%soilWaterContentFieldCapacity(me%x, me%y)
        me%K_s = DATASET%soilHydraulicConductivity(me%x, me%y)
        ! Soil hydraulic properties contain no data where in urban areas. For the moment,
        ! until land cover properly incorporated into model, we'll use this as a proxy
        ! for urban areas (which therefore contain no soil profile). In the future, we should
        ! account for this properly by splitting grid cells into different soil profiles.
        if (me%WC_sat == nf90_fill_real) me%WC_sat = 0.8
        if (me%WC_FC == nf90_fill_real) me%WC_FC = 0.5
        if (me%K_s == nf90_fill_real) me%K_s = 1e-6
        if (me%bulkDensity == nf90_fill_real) me%bulkDensity = 1220

        me%clayContent = DATASET%soilTextureClayContent(me%x, me%y)
        me%sandContent = DATASET%soilTextureSandContent(me%x, me%y)
        me%siltContent = DATASET%soilTextureSiltContent(me%x, me%y)
        me%coarseFragContent = DATASET%soilTextureCoarseFragContent(me%x, me%y)
        if (me%coarseFragContent == nf90_fill_real) then
            me%coarseFragContent = 0.0
        end if
        ! Calculate the average grain diameter from soil texture
        me%d_grain = me%calculateAverageGrainSize(me%clayContent, me%siltContent, me%sandContent)
        me%porosity = DATASET%soilDefaultPorosity       ! TODO change to be spatial

        ! USLE params
        me%usle_C = DATASET%soilUsleCFactor(me%x, me%y)
        ! TODO make usle_C not temporal
        if (me%usle_C == nf90_fill_double) then
            me%usle_C = 0.00055095          ! Pick a small value to represent urban, if there's no data
        end if
        me%usle_P = DATASET%soilUslePFactor(me%x, me%y)
        if (me%usle_P == nf90_fill_double) then
            me%usle_P = 1.0                 ! If there's no data, assume no support practice
        end if
        me%usle_LS = DATASET%soilUsleLSFactor(me%x, me%y)
        if (me%usle_LS == nf90_fill_double) then
            me%usle_LS = 0.3                 ! Pick an average value if there's no data
        end if

        ! Get earthworm density from land use. Select the maximum land use fraction and use all
        ! of profile is that.
        landUse = maxloc(DATASET%landUse(me%x, me%y, :), dim=1)
        ! TODO get these values more intelligently
        select case (landUse)
            case (1)
                me%earthwormDensity = DATASET%earthwormDensityUrbanCapped
            case (2)
                me%earthwormDensity = DATASET%earthwormDensityUrbanParks
            case (3)
                me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
            case (4)
                me%earthwormDensity = DATASET%earthwormDensityUrbanGardens
            case (5)
                me%earthwormDensity = DATASET%earthwormDensityArable
            case (6)
                me%earthwormDensity = DATASET%earthwormDensityGrassland
            case (7)
                me%earthwormDensity = DATASET%earthwormDensityDeciduous
            case (8)
                me%earthwormDensity = DATASET%earthwormDensityConiferous
            case (9)
                me%earthwormDensity = DATASET%earthwormDensityHeathland
            case default
                me%earthwormDensity = 0.0_dp
        end select
    end subroutine

    !> Calculate the mean NM PEC across all soil layers for this soil profile
    function get_C_np_SoilProfile(me) result(C_np)
        class(SoilProfile)     :: me                        !! This SoilProfile instance
        real(dp), allocatable   :: C_np(:,:,:)              !! Mass concentration of NM [kg/kg soil]
        ! For some reason, ifort 18 won't compile if C_np isn't allocatable. Same for the other getter functions
        allocate(C_np(C%npDim(1), C%npDim(2), C%npDim(3)))
        C_np = me%get_m_np() / (me%bulkDensity * me%area * sum(C%soilLayerDepth))
    end function

    !> Calculate the mean transformed NM PEC across all soil layers for this soil profile
    function get_C_transformed_SoilProfile(me) result(C_transformed)
        class(SoilProfile)     :: me                                !! This SoilProfile instance
        real(dp), allocatable   :: C_transformed(:,:,:)             !! Mass concentration of NM [kg/kg soil]
        allocate(C_transformed(C%npDim(1), C%npDim(2), C%npDim(3)))
        C_transformed = me%get_m_transformed() / (me%bulkDensity * me%area * sum(C%soilLayerDepth))
    end function

    !> Calculate the mean dissolved species PEC across all soil layers for this soil profile
    function get_C_dissolved_SoilProfile(me) result(C_dissolved)
        class(SoilProfile) :: me                            !! This SoilProfile instance
        real(dp)            :: C_dissolved                  !! Mass concentration of dissolved species [kg/kg soil]
        C_dissolved = me%get_m_dissolved() / (me%bulkDensity * me%area * sum(C%soilLayerDepth))
    end function

    !> Get the total NM mass in the soil profile
    function get_m_np_SoilProfile(me) result(m_np)
        class(SoilProfile)     :: me                !! This SoilProfile instance
        real(dp), allocatable   :: m_np(:,:,:)      !! NM mass in the soil profile [kg]
        integer                 :: i                ! Iterator
        allocate(m_np(C%npDim(1), C%npDim(2), C%npDim(3)))
        m_np = 0.0_dp
        ! Loop through the soil layers and sum m_np
        do i = 1, C%nSoilLayers
            m_np = m_np + me%colSoilLayers(i)%item%m_np
        end do
    end function

    !> Get the total transformed NM mass in the soil profile
    function get_m_transformed_SoilProfile(me) result(m_transformed)
        class(SoilProfile)     :: me                        !! This SoilProfile instance
        real(dp), allocatable   :: m_transformed(:,:,:)     !! Transformed NM mass in the soil profile [kg]
        integer                 :: i                        ! Iterator
        allocate(m_transformed(C%npDim(1), C%npDim(2), C%npDim(3)))
        m_transformed = 0.0_dp
        ! Loop through the soil layers and sum m_transformed
        do i = 1, C%nSoilLayers
            m_transformed = m_transformed + me%colSoilLayers(i)%item%m_transformed
        end do
    end function

    !> Get the total dissolved NM mass in the soil profile
    function get_m_dissolved_SoilProfile(me) result(m_dissolved)
        class(SoilProfile) :: me                !! This SoilProfile instance
        real(dp)            :: m_dissolved      !! Dissolved NM mass in the soil profile [kg]
        integer             :: i                ! Iterator
        m_dissolved = 0.0_dp
        ! Loop through the soil layers and sum m_dissolved
        do i = 1, C%nSoilLayers
            m_dissolved = m_dissolved + me%colSoilLayers(i)%item%m_dissolved
        end do
    end function
end module