From fbc17540ef44ffccf1a26a0d76b54844deffc88d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Beno=C3=AEt=20Vi=C3=A9?= <benoit.vie@meteo.fr>
Date: Tue, 26 Apr 2022 10:29:55 +0200
Subject: [PATCH] add untracked files
---
src/MNH/aer2lima.f90 | 375 +++++++
src/MNH/aerocamsn.f90 | 82 ++
src/MNH/ch_aer_cond.f90 | 124 +++
src/MNH/ch_aer_kulmala.f90 | 178 ++++
src/MNH/ch_aer_maattanen_ionind.f90 | 644 ++++++++++++
src/MNH/ch_aer_maattanen_neutral.f90 | 335 +++++++
src/MNH/ch_aer_mode_merging.f90 | 176 ++++
src/MNH/ch_aer_vehkamaki.f90 | 216 +++++
src/MNH/ch_meteo_trans_lima.f90 | 348 +++++++
src/MNH/coupling_dmsn.F90 | 58 ++
src/MNH/dustcamsn.f90 | 214 ++++
src/MNH/emproc.F90 | 292 ++++++
src/MNH/mgn2mech.F90 | 323 +++++++
src/MNH/modd_dms_surf_fieldsn.F90 | 74 ++
src/MNH/modd_dmsn.F90 | 55 ++
src/MNH/mode_gamma_etc.F90 | 554 +++++++++++
src/MNH/mode_megan.F90 | 1235 ++++++++++++++++++++++++
src/MNH/read_chem_data_cams_case.f90 | 1108 +++++++++++++++++++++
src/MNH/read_chem_data_mozart_case.f90 | 812 ++++++++++++++++
src/MNH/read_dmsn.F90 | 102 ++
src/MNH/read_lima_data_netcdf_case.f90 | 898 +++++++++++++++++
src/MNH/saltcamsn.f90 | 281 ++++++
src/MNH/writesurf_dmsn.F90 | 91 ++
src/SURFEX/pgd_dms.F90 | 197 ++++
src/SURFEX/read_nam_pgd_dms.F90 | 154 +++
src/SURFEX/update_esm_tebn.F90 | 199 ++++
26 files changed, 9125 insertions(+)
create mode 100644 src/MNH/aer2lima.f90
create mode 100644 src/MNH/aerocamsn.f90
create mode 100644 src/MNH/ch_aer_cond.f90
create mode 100644 src/MNH/ch_aer_kulmala.f90
create mode 100644 src/MNH/ch_aer_maattanen_ionind.f90
create mode 100644 src/MNH/ch_aer_maattanen_neutral.f90
create mode 100644 src/MNH/ch_aer_mode_merging.f90
create mode 100644 src/MNH/ch_aer_vehkamaki.f90
create mode 100644 src/MNH/ch_meteo_trans_lima.f90
create mode 100644 src/MNH/coupling_dmsn.F90
create mode 100644 src/MNH/dustcamsn.f90
create mode 100644 src/MNH/emproc.F90
create mode 100644 src/MNH/mgn2mech.F90
create mode 100644 src/MNH/modd_dms_surf_fieldsn.F90
create mode 100644 src/MNH/modd_dmsn.F90
create mode 100644 src/MNH/mode_gamma_etc.F90
create mode 100644 src/MNH/mode_megan.F90
create mode 100644 src/MNH/read_chem_data_cams_case.f90
create mode 100644 src/MNH/read_chem_data_mozart_case.f90
create mode 100644 src/MNH/read_dmsn.F90
create mode 100644 src/MNH/read_lima_data_netcdf_case.f90
create mode 100644 src/MNH/saltcamsn.f90
create mode 100644 src/MNH/writesurf_dmsn.F90
create mode 100644 src/SURFEX/pgd_dms.F90
create mode 100644 src/SURFEX/read_nam_pgd_dms.F90
create mode 100644 src/SURFEX/update_esm_tebn.F90
diff --git a/src/MNH/aer2lima.f90 b/src/MNH/aer2lima.f90
new file mode 100644
index 000000000..885dc0dc0
--- /dev/null
+++ b/src/MNH/aer2lima.f90
@@ -0,0 +1,375 @@
+!MNH_LIC Copyright 1994-2019 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ########################
+ MODULE MODI_AER2LIMA
+! ########################
+!
+INTERFACE
+ SUBROUTINE AER2LIMA(PSVT, PRHODREF,PRV, PPABST, PTHT, PZZ)
+!
+USE MODD_CH_AEROSOL
+USE MODD_DUST
+USE MODD_SALT
+USE MODD_NSV
+USE MODD_CST
+USE MODD_CONF, ONLY : CPROGRAM
+USE MODD_PARAM_n, ONLY : CACTCCN
+USE MODD_PARAM_LIMA
+USE MODE_AERO_PSD
+USE MODE_SALT_PSD
+USE MODE_DUST_PSD
+USE MODI_CH_AER_EQSAM
+USE MODI_DUSTLFI_n
+USE MODI_SALTLFI_n
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF, PRV, PPABST, PTHT, PZZ
+!
+END SUBROUTINE AER2LIMA
+!
+END INTERFACE
+!
+END MODULE MODI_AER2LIMA
+
+! ############################################
+ SUBROUTINE AER2LIMA(PSVT, PRHODREF, PRV, PPABST, PTHT, PZZ)
+! ############################################
+!
+!
+!!**** *AER2LIMA* lima CCN and IFN fields in case of orilam aerosols
+!!
+!! PURPOSE
+!! -------
+!!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!! P. Tulet
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 20/01/22
+!! --------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CH_AEROSOL
+USE MODD_DUST
+USE MODD_SALT
+USE MODD_NSV
+USE MODD_CST
+USE MODD_CONF, ONLY : CPROGRAM
+USE MODD_PARAM_n, ONLY : CACTCCN
+USE MODD_PARAM_LIMA
+USE MODD_CH_M9_n, ONLY : CNAMES
+USE MODE_AERO_PSD
+USE MODE_SALT_PSD
+USE MODE_DUST_PSD
+USE MODI_CH_AER_EQSAM
+USE MODI_DUSTLFI_n
+USE MODI_SALTLFI_n
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSVT
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF, PRV, PPABST, PTHT, PZZ
+
+! 0.2 declaration of local variables
+
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3), NSP+NCARB+NSOA,JPMODE) :: ZCTOTA
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3)) :: ZSUM, ZSUM2, ZRATH2O, ZRATSO4, ZRATDST
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),JPMODE) :: ZSIG_AER, ZRG_AER, ZN0_AER
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NMODE_SLT) :: ZSIG_SLT, ZRG_SLT, ZN0_SLT
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NMODE_DST) :: ZSIG_DST, ZRG_DST, ZN0_DST
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NMOD_CCN) :: ZCCN_SUM
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NMOD_IFN) :: ZIFN_SUM
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3)) :: ZPKM, ZPKH2O, ZTEMP, ZSAT, ZRH
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),6) :: ZAER
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),NSV) :: ZTOT
+REAL, DIMENSION(SIZE(PSVT,1), SIZE(PSVT,2), SIZE(PSVT,3),JPMODE) :: ZOM
+REAL, DIMENSION(NSV) :: ZMI
+INTEGER :: JSV, JJ, JI, II, IJ, IK, JK
+REAL :: ZCCNRADIUS, ZRATMASSH2O
+
+ZCCNRADIUS = 0.04 ! to suppress the aitken mode (µm)
+
+IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) CMINERAL = "EQSAM"
+IF (CMINERAL /= 'NONE') THEN
+ ZRATMASSH2O = 0.05
+ELSE
+ ZRATMASSH2O = 0.
+END IF
+ZMI(:) = 250.
+ZMI(JP_AER_SO4) = 98.
+ZMI(JP_AER_NO3) = 63.
+ZMI(JP_AER_NH3) = 17.
+ZMI(JP_AER_H2O) = 18.
+ZCCN_SUM(:,:,:,:) = 0.
+ZIFN_SUM(:,:,:,:) = 0.
+
+! Anthopogenic part (orilam scheme)
+!
+IF (LORILAM) THEN
+
+! moments (PSVT;ppp) --> concentration (PN3D;#/m3)
+CALL PPP2AERO(PSVT(:,:,:,NSV_AERBEG:NSV_AEREND),PRHODREF,&
+ PSIG3D=ZSIG_AER,PRG3D=ZRG_AER,PN3D=ZN0_AER,PCTOTA=ZCTOTA)
+
+ZCTOTA=MAX(ZCTOTA,XMNH_TINY)
+
+ IF ((CPROGRAM=="REAL ").OR.(CPROGRAM=="IDEAL ")) THEN
+ JP_CH_HNO3 = 0
+ JP_CH_NH3 = 0
+ DO JJ=1,SIZE(CNAMES)
+ IF (CNAMES(JJ) == "HNO3") JP_CH_HNO3 = JJ
+ IF (CNAMES(JJ) == "NH3") JP_CH_NH3 = JJ
+ END DO
+ ZPKM(:,:,:) = 1E-3*PRHODREF(:,:,:) * 6.0221367E+23 / 28.9644
+ ZPKH2O(:,:,:) = ZPKM(:,:,:)*1.6077*PRV(:,:,:)
+!
+! compute air temperature
+ ZTEMP(:,:,:) = PTHT(:,:,:)*((PPABST(:,:,:)/XP00)**(XRD/XCPD))
+
+! compute relative humidity
+ ZSAT(:,:,:)=0.611*EXP(17.2694*(ZTEMP(:,:,:)-273.16)/(ZTEMP(:,:,:)-35.86))
+ ZSAT(:,:,:)=ZSAT(:,:,:)*1000.
+ ZRH(:,:,:)=(ZPKH2O(:,:,:)/(ZPKM(:,:,:)*1.6077))*PPABST(:,:,:)/&
+ &(0.622+(ZPKH2O(:,:,:)/(ZPKM(:,:,:)*1.6077)))/ZSAT(:,:,:)
+ ZRH(:,:,:) = MIN(0.95, MAX(ZRH(:,:,:), .01)) ! until 0.95 thermodynamic code is not valid
+
+! Gas-particles equilibrium => H2O, SO4 aerosol mass
+ DO JI=1,NSP
+ ZTOT(:,:,:,JI)=ZCTOTA(:,:,:,JI,1)+ZCTOTA(:,:,:,JI,2)
+ ZTOT(:,:,:,JI) = MAX(ZTOT(:,:,:,JI),XMNH_TINY)
+ ENDDO
+!
+ ZAER(:,:,:,:) = 0.
+ ZAER(:,:,:,1)=ZTOT(:,:,:,JP_AER_SO4)
+
+! conversion ppp to µg/m3
+ IF (JP_CH_NH3 .NE. 0) ZAER(:,:,:,2)=PSVT(:,:,:,NSV_CHEMBEG-1+JP_CH_NH3)*XNH3*1E-3*PRHODREF(:,:,:)/XMD
+! conversion ppp to µg/m3
+ IF (JP_CH_HNO3 .NE. 0) ZAER(:,:,:,3)=PSVT(:,:,:,NSV_CHEMBEG-1+JP_CH_HNO3)*XHNO3*1E-3*PRHODREF(:,:,:)/XMD
+ ZAER(:,:,:,4)=ZTOT(:,:,:,JP_AER_H2O)
+ ZAER(:,:,:,5)=ZTOT(:,:,:,JP_AER_NO3)
+ ZAER(:,:,:,6)=ZTOT(:,:,:,JP_AER_NH3)
+ ZAER(:,:,:,:)=MAX(ZAER(:,:,:,:),0.)
+
+ DO IK=1,SIZE(PSVT,3)
+ DO IJ=1,SIZE(PSVT,2)
+ CALL CH_AER_EQSAM(ZAER(:,IJ,IK,:),ZRH(:,IJ,IK),PPABST(:,IJ,IK),ZTEMP(:,IJ,IK))
+ END DO
+ END DO
+ ZTOT(:,:,:,JP_AER_SO4) = ZAER(:,:,:,1)
+ ZTOT(:,:,:,JP_AER_H2O) = ZAER(:,:,:,4)
+ ZTOT(:,:,:,JP_AER_NO3) = ZAER(:,:,:,5)
+ ZTOT(:,:,:,JP_AER_NH3) = ZAER(:,:,:,6)
+
+! Balance the mass according to size
+ ZSUM(:,:,:) = 0.
+ ZOM(:,:,:,:) = 0.
+ DO JSV=1,JPMODE
+ DO JJ=1,NSP
+ ZSUM(:,:,:) = ZSUM(:,:,:) + ZCTOTA(:,:,:,JJ,JSV)
+ ZOM(:,:,:,JSV) = ZOM(:,:,:,JSV) + ZCTOTA(:,:,:,JJ,JSV)
+ ENDDO
+ ENDDO
+
+ DO JSV=1,JPMODE
+ ZOM(:,:,:,JSV) = ZOM(:,:,:,JSV) / ZSUM(:,:,:)
+ ENDDO
+
+ DO JSV=1,JPMODE
+ DO JJ=1,NSP
+ ZCTOTA(:,:,:,JJ,JSV)=MAX(XMNH_TINY,ZTOT(:,:,:,JJ)*ZOM(:,:,:,JSV))
+ END DO
+ END DO
+
+END IF !end part of init in case of IDEAL or REAL
+
+! Compute mass ratio of sulfates, water and dusts
+DO JSV=1,JPMODE
+ ZRATH2O(:,:,:) = 0.
+ ZRATSO4(:,:,:) = 0.
+ ZRATDST(:,:,:) = 0.
+ ZSUM(:,:,:) = 0.
+ ZSUM2(:,:,:) = 0.
+
+ DO II=1,NSP+NCARB+NSOA
+ ZSUM(:,:,:) = ZSUM(:,:,:) + ZCTOTA(:,:,:,II,JSV)
+ END DO
+
+ ZSUM2(:,:,:) = ZSUM(:,:,:) - ZCTOTA(:,:,:,JP_AER_H2O,JSV)
+
+ WHERE (ZSUM(:,:,:) .GT. 0.)
+ ZRATH2O(:,:,:) = ZCTOTA(:,:,:,JP_AER_H2O,JSV) / ZSUM(:,:,:)
+ END WHERE
+
+ WHERE (ZSUM2(:,:,:) .GT. 0.)
+ ZRATSO4(:,:,:) = ZCTOTA(:,:,:,JP_AER_SO4,JSV) / ZSUM2(:,:,:)
+ END WHERE
+
+ WHERE (ZSUM2(:,:,:) .GT. 0.)
+ ZRATDST(:,:,:) = ZCTOTA(:,:,:,JP_AER_DST,JSV) / ZSUM2(:,:,:)
+ END WHERE
+
+! #/m3 --> #/kg
+ ZN0_AER(:,:,:,JSV) = ZN0_AER(:,:,:,JSV) / PRHODREF(:,:,:)
+
+! CCN_FREE initialization
+! aerosol radius greater than ZCCNRADIUS µm to be considers as CCN
+! water mass greater than ZRATMASSH2O %
+
+ IF (CACTCCN=="ABRK") THEN
+! only one CCN_FREE mode (activation is not performed upon aerosol class but by physical paramters)
+!
+ WHERE (ZRG_AER(:,:,:,JSV) .GT. ZCCNRADIUS)
+ !WHERE ((ZRG_AER(:,:,:,JSV) .GT. ZCCNRADIUS).AND.(ZRATH2O(:,:,:).GT.ZRATMASSH2O))
+ ZCCN_SUM(:,:,:,1) = ZCCN_SUM(:,:,:,1) + ZN0_AER(:,:,:,JSV)
+ END WHERE
+
+ ELSE
+ ! Sulfates
+ IF (NMOD_CCN .GE. 2) THEN
+ WHERE ((ZRG_AER(:,:,:,JSV) .GT. ZCCNRADIUS).AND.(ZRATH2O(:,:,:).GT.ZRATMASSH2O))
+ ZCCN_SUM(:,:,:,2) = ZCCN_SUM(:,:,:,2) + ZN0_AER(:,:,:,JSV) * ZRATSO4(:,:,:)
+ END WHERE
+ END IF
+
+ ! Hyrdophylic aerosols
+ IF (NMOD_CCN .GE. 3) THEN
+ WHERE ((ZRG_AER(:,:,:,JSV) .GT. ZCCNRADIUS).AND.(ZRATH2O(:,:,:).GT.ZRATMASSH2O))
+ ZCCN_SUM(:,:,:,3) = ZCCN_SUM(:,:,:,3) + ZN0_AER(:,:,:,JSV) * (1.-ZRATSO4(:,:,:))
+ END WHERE
+ END IF
+
+END IF
+
+! IFN_FREE initialization
+ WHERE (ZRATH2O(:,:,:) .LE. ZRATMASSH2O) ! fraction of dust if low water
+ ZIFN_SUM(:,:,:,1) = ZIFN_SUM(:,:,:,1) + ZN0_AER(:,:,:,JSV) * ZRATDST(:,:,:)
+ END WHERE
+
+! hydrophobic aerosols water mass less than 20%
+ IF (NMOD_IFN .GE. 2) THEN
+ WHERE (ZRATH2O(:,:,:) .LE. ZRATMASSH2O) ! hydrophobic aerosols can act as IFN
+ ZIFN_SUM(:,:,:,2) = ZIFN_SUM(:,:,:,2) + ZN0_AER(:,:,:,JSV) * (1.- ZRATSO4(:,:,:))
+ END WHERE
+ END IF
+
+END DO
+
+
+ELSE ! keep lima class intiatialization
+ IF (CACTCCN=="ABRK") THEN
+! only one CCN_FREE mode (activation is not performed upon aerosol class but by physical paramters)
+ IF (NMOD_CCN .GE. 2) &
+ ZCCN_SUM(:,:,:,1) = ZCCN_SUM(:,:,:,1) + &
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+1) + PSVT(:,:,:,NSV_LIMA_CCN_ACTI+1)
+ IF (NMOD_CCN .GE. 3) &
+ ZCCN_SUM(:,:,:,1) = ZCCN_SUM(:,:,:,1) + &
+ PSVT(:,:,:,NSV_LIMA_CCN_FREE+2) + PSVT(:,:,:,NSV_LIMA_CCN_ACTI+2)
+
+ ELSE
+ IF (NMOD_CCN .GE. 2) &
+ ZCCN_SUM(:,:,:,2) = PSVT(:,:,:,NSV_LIMA_CCN_FREE+1) + PSVT(:,:,:,NSV_LIMA_CCN_ACTI+1)
+
+ IF (NMOD_CCN .GE. 3) &
+ ZCCN_SUM(:,:,:,3) = PSVT(:,:,:,NSV_LIMA_CCN_FREE+2) + PSVT(:,:,:,NSV_LIMA_CCN_ACTI+2)
+ END IF
+
+ IF (.NOT.(LDUST)) &
+ ZIFN_SUM(:,:,:,1) = PSVT(:,:,:,NSV_LIMA_IFN_FREE) + PSVT(:,:,:,NSV_LIMA_IFN_NUCL)
+
+ IF (NMOD_IFN .GE. 2) &
+ ZIFN_SUM(:,:,:,2) = PSVT(:,:,:,NSV_LIMA_IFN_FREE+1) + PSVT(:,:,:,NSV_LIMA_IFN_NUCL+1)
+
+END IF ! end if sur LORILAM
+
+! Sea Salt part
+IF (LSALT) THEN
+!
+ IF (((CPROGRAM=="REAL ").AND.(LSLTINIT).AND.(.NOT.LSLTCAMS)).OR.(CPROGRAM=="IDEAL ")) THEN
+ CALL SALTLFI_n(PSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND), PRHODREF, PZZ)
+ END IF
+
+! moments (PSVT;ppp) --> concentration (PN3D;#/m3)
+ CALL PPP2SALT(PSVT(:,:,:,NSV_SLTBEG:NSV_SLTEND),PRHODREF,&
+ PSIG3D=ZSIG_SLT,PRG3D=ZRG_SLT,PN3D=ZN0_SLT)
+!
+ DO JSV=1,NMODE_SLT
+! #/m3 --> #/kg
+ ZN0_SLT(:,:,:,JSV) = ZN0_SLT(:,:,:,JSV) / PRHODREF(:,:,:)
+
+! CCN_FREE initialization
+!
+ WHERE (ZRG_SLT(:,:,:,JSV) .GT. ZCCNRADIUS)
+ ZCCN_SUM(:,:,:,1) = ZCCN_SUM(:,:,:,1) + ZN0_SLT(:,:,:,JSV)
+ END WHERE
+ END DO
+
+ELSE ! keep lima class intiatialization for sea salt + ccn from orilam
+
+
+ZCCN_SUM(:,:,:,1) = PSVT(:,:,:,NSV_LIMA_CCN_FREE) + PSVT(:,:,:,NSV_LIMA_CCN_ACTI)
+
+END IF ! end if sur LSALT
+
+! Dust part
+IF (LDUST) THEN
+ ! initatialization of dust if not macc
+ IF (((CPROGRAM=="REAL ").AND.(LDSTINIT).AND.(.NOT.LDSTCAMS)).OR.(CPROGRAM=="IDEAL ")) THEN
+ CALL DUSTLFI_n(PSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND), PRHODREF)
+ END IF
+
+! moments (PSVT;ppp) --> concentration (PN3D;#/m3)
+ CALL PPP2DUST(PSVT(:,:,:,NSV_DSTBEG:NSV_DSTEND),PRHODREF,&
+ PSIG3D=ZSIG_DST,PRG3D=ZRG_DST,PN3D=ZN0_DST)
+!
+ DO JSV=1,NMODE_DST
+
+! #/m3 --> #/kg
+ ZN0_DST(:,:,:,JSV) = ZN0_DST(:,:,:,JSV) / PRHODREF(:,:,:)
+
+! IFN_FREE initialization (all dusts)
+ ZIFN_SUM(:,:,:,1) = ZIFN_SUM(:,:,:,1) + ZN0_DST(:,:,:,JSV)
+
+ END DO
+
+ELSE ! keep lima class intiatialization
+
+ ZIFN_SUM(:,:,:,1) = PSVT(:,:,:,NSV_LIMA_IFN_FREE) + PSVT(:,:,:,NSV_LIMA_IFN_NUCL)
+
+END IF ! endif sur LDUST
+
+PSVT(:,:,:,NSV_LIMA_CCN_FREE) = MAX(ZCCN_SUM(:,:,:,1) - PSVT(:,:,:,NSV_LIMA_CCN_ACTI), 0.)
+
+IF (NMOD_CCN .GE. 2) &
+PSVT(:,:,:,NSV_LIMA_CCN_FREE+1) = MAX(ZCCN_SUM(:,:,:,2) - PSVT(:,:,:,NSV_LIMA_CCN_ACTI+1), 0.)
+
+
+IF (NMOD_CCN .GE. 3) &
+PSVT(:,:,:,NSV_LIMA_CCN_FREE+2) = MAX(ZCCN_SUM(:,:,:,3) - PSVT(:,:,:,NSV_LIMA_CCN_ACTI+2), 0.)
+
+PSVT(:,:,:,NSV_LIMA_IFN_FREE) = MAX(ZIFN_SUM(:,:,:,1) - PSVT(:,:,:,NSV_LIMA_IFN_NUCL), 0.)
+IF (NMOD_IFN .GE. 2) &
+PSVT(:,:,:,NSV_LIMA_IFN_FREE+1) = MAX(ZIFN_SUM(:,:,:,2) - PSVT(:,:,:,NSV_LIMA_IFN_NUCL+1), 0.)
+
+!
+!
+END SUBROUTINE AER2LIMA
diff --git a/src/MNH/aerocamsn.f90 b/src/MNH/aerocamsn.f90
new file mode 100644
index 000000000..b3ceb1d48
--- /dev/null
+++ b/src/MNH/aerocamsn.f90
@@ -0,0 +1,82 @@
+!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$
+! MASDEV4_7 chimie 2006/06/16 13:28:57
+!-----------------------------------------------------------------
+!! ########################
+ MODULE MODI_AEROCAMS_n
+!! ########################
+!!
+INTERFACE
+!!
+SUBROUTINE AEROCAMS_n(PSV, PRHODREF)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+END SUBROUTINE AEROCAMS_n
+!!
+END INTERFACE
+!!
+END MODULE MODI_AEROCAMS_n
+!!
+!!
+!! ############################################################
+ SUBROUTINE AEROCAMS_n(PSV, PRHODREF)
+!! ############################################################
+!!
+!! PURPOSE
+!! -------
+!! Converti les masses aerosols issues de CMAS (kg/kg) en variables aerosols (ppv)
+!! Realise l'équilibre des moments à partir du sigma et du diametre moyen
+!!
+!! REFERENCE
+!! ---------
+!! none
+!!
+!! AUTHOR
+!! ------
+!! Pierre TULET (LA)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+
+USE MODE_AERO_PSD
+!!
+IMPLICIT NONE
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+!
+!
+INTEGER :: JN
+!
+! SV conversion from kg.kg-3 --> µg/m3 )
+
+DO JN =1,SIZE(PSV, 4)
+ PSV(:,:,:,JN) = PSV(:,:,:,JN) * 1E9 / PRHODREF(:,:,:)
+ENDDO
+
+! Compute moment from aerosol mass and conversion SV aerosols variables into ppv
+
+CALL CON2MIX (PSV, PRHODREF)
+!
+!
+END SUBROUTINE AEROCAMS_n
diff --git a/src/MNH/ch_aer_cond.f90 b/src/MNH/ch_aer_cond.f90
new file mode 100644
index 000000000..2424b153b
--- /dev/null
+++ b/src/MNH/ch_aer_cond.f90
@@ -0,0 +1,124 @@
+!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_growth.f90,v $ $Revision: 1.1.4.1.2.1 $
+! MASDEV4_7 chimie 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+!! #########################
+ MODULE MODI_CH_AER_COND
+!! #########################
+!!
+INTERFACE
+!!
+SUBROUTINE CH_AER_COND(PM, PLNSIG, PRG, PPRESSURE, PTEMP, &
+ PDM3CDT, PDM6CDT )
+IMPLICIT NONE
+REAL, DIMENSION(:,:), INTENT(IN) :: PM, PLNSIG, PRG
+REAL, DIMENSION(:), INTENT(IN) :: PPRESSURE, PTEMP
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PDM3CDT, PDM6CDT
+END SUBROUTINE CH_AER_COND
+!!
+END INTERFACE
+!!
+END MODULE MODI_CH_AER_COND
+!!
+!! #################################################################
+ SUBROUTINE CH_AER_COND(PM, PLNSIG, PRG, PPRESSURE, PTEMP, &
+ PDM3CDT, PDM6CDT )
+!! #################################################################
+!!
+!! PURPOSE
+!! -------
+!!
+!! This routine computes the condensated mass and tendencies.
+!! Note that dM0_cond/dt = 0 : The condensation doesn't create particles.
+!! Only moments 3 and 6 are computed.
+!!
+!! REFERENCE
+!! ---------
+!!
+!! Method from CMAQ model:
+!!
+!! Binkowski, F.S. and U. Shankar, The regional particulate matter
+!! model 1. Model description and preliminary results, J. Geophys.
+!! Res., Vol 100, No D12, 26101-26209, 1995.
+!!
+!!
+!! AUTHOR
+!! ------
+!! Joris Pianezze (2018) * LACy *
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CH_AEROSOL
+USE MODD_CST, ONLY : XPI, XBOLTZ, XAVOGADRO
+USE MODD_CONF, ONLY : NVERB
+!!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PM, PLNSIG, PRG
+REAL, DIMENSION(:), INTENT(IN) :: PPRESSURE, PTEMP
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PDM3CDT, PDM6CDT
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER :: JI,JK
+REAL :: ZALPHA
+REAL, DIMENSION(SIZE(PM,1)) :: ZDIFFSULF, ZDIFFCORR, ZDV
+REAL, DIMENSION(SIZE(PM,1)) :: ZCBAR
+REAL, DIMENSION(SIZE(PM,1)) :: ZGNC3, ZGNC6, ZGFM3, ZGFM6
+REAL, DIMENSION(SIZE(PM,1),6,JPMODE) :: ZMOM
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZATION
+! --------------
+!
+ZALPHA = 0.1
+ZDIFFSULF = 9.36E-6 ! molecular diffusivity of sulfuric acid
+ZDIFFCORR = (101325.0/PPRESSURE) * (PTEMP/273.15)**(1.75) ! correction factor for atmospheric conditions
+ZDV = ZDIFFSULF * ZDIFFCORR ! corrected molecural diffusivity of sulfuric acid
+ZCBAR = SQRT(8.0*XBOLTZ*XAVOGADRO*PTEMP/(XPI*XH2SO4*1E-3)) ! molecular velocitie (temperature dependent)
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. COMPUTE CONDENSATED MASS AND TENDENCIES
+! ---------------------------------------
+!
+DO JI=1,JPMODE
+ !
+ ! ZMOM = Equation (after integration) for every moment (JK order): Tulet 2005
+ ! ZMOM = m**k.m**-3
+ DO JK=1,6
+ ZMOM(:,JK,JI) = PM(:,NM0(JI))*((PRG(:,JI)*1E-6)**JK)* &
+ EXP(((REAL(JK)**2)/2.)*(PLNSIG(:,JI)**2.0))
+ ENDDO
+ !
+ ZGNC3 = 2 * XPI * ZDV * ZMOM(:,1,JI) ! 3rd moment, near-continuum
+ ZGNC6 = 2 * XPI * ZDV * ZMOM(:,4,JI) ! 6th moment, near-continuum
+ ZGFM3 = (XPI / 4.0) * ZALPHA * ZCBAR * ZMOM(:,2,JI) ! 3rd moment, free-molecular
+ ZGFM6 = (XPI / 4.0) * ZALPHA * ZCBAR * ZMOM(:,5,JI) ! 6th moment, free-molecular
+ !
+ PDM3CDT(:,JI) = ZGNC3 * ZGFM3 / ( ZGNC3 + ZGFM3 ) ! 3rd moment : m**3 / m**3 s
+ PDM6CDT(:,JI) = ZGNC6 * ZGFM6 / ( ZGNC6 + ZGFM6 ) ! 6th moment : m**6 / m**3 s
+ !
+END DO
+!
+END SUBROUTINE CH_AER_COND
diff --git a/src/MNH/ch_aer_kulmala.f90 b/src/MNH/ch_aer_kulmala.f90
new file mode 100644
index 000000000..78da267c0
--- /dev/null
+++ b/src/MNH/ch_aer_kulmala.f90
@@ -0,0 +1,178 @@
+!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_nucl.f90,v $ $Revision: 1.1.4.1.18.1 $
+! MASDEV4_7 chimie 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+!! ################################
+MODULE MODI_CH_AER_KULMALA
+!! ################################
+!!
+INTERFACE
+ !!
+ SUBROUTINE CH_AER_KULMALA(PRH,PTEMP,PSULF,PJNUC,PRC)
+ IMPLICIT NONE
+ !!
+ REAL, DIMENSION(:), INTENT(IN) :: PRH, PTEMP, PSULF
+ REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PRC
+ !!
+ END SUBROUTINE CH_AER_KULMALA
+ !!
+END INTERFACE
+!
+END MODULE MODI_CH_AER_KULMALA
+!!
+!! #########################################################################
+SUBROUTINE CH_AER_KULMALA(PRH,PTEMP,PSULF,PJNUC,PRC)
+!###########################################################
+!!
+!! PURPOSE
+!! -------
+!!
+!! Compute nucleation rate for binary sulfate/H2O
+!! This is the Kulmala parametrization (1998)
+!!
+!! Valid for :
+!! 233.15 < T < 298.15 (K)
+!! 10 < RH < 100 (%)
+!! 1.10¹Ⱐ< [H2SO4]gas < 3.10¹Ⱐ(molec/cm3)
+!!
+!! AUTHOR
+!! ------
+!! B. Foucart * LACy *
+!!
+!! MODIFICATIONS
+!! -------------
+!! B. Foucart (18/06/2018) * LACy *
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CH_AEROSOL
+USE MODD_CST, ONLY : XAVOGADRO
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRH, PTEMP ! Relative humidity (%), Temp (kelvin)
+REAL, DIMENSION(:), INTENT(IN) :: PSULF ! Available acid mass (ug./m3)
+REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC ! Nucleation rate (#/cm3/s)
+REAL, DIMENSION(:), INTENT(INOUT) :: PRC ! Rayon du cluster critique en nm définit pour ch_aer_nucl
+INTEGER :: II
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZSULF ! Sulfuric acid concentration (molec/cm3)
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZAL ! Mole fraction of H2SO4 in the critical cluster
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZRA ! Relative acidity
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZH2O ! Water concentration (molec/cm3)
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZPVH2O ! Saturation vapor pressure for water (N/m2, T in K)
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZPVH2SO4 ! Saturation vapor pressure for sulfuric acid (N/m2, T in K)
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZKHI,ZSIG,ZNSULFC,ZNSULF ! Terms for nucleation rate calculation
+!
+REAL, PARAMETER :: ZKB=1.381E-23 ! Boltzman cste (m2 kg s-2 K-1)
+!
+PJNUC(:)=0.
+ZAL(:)=1E-5
+ZRA(:)=0.
+ZSULF(:)=0.
+ZPVH2SO4(:)=0.
+ZH2O(:)=0.
+ZRA(:)=0.
+ZSIG(:)=0.
+ZNSULFC(:)=0.
+ZKHI(:)=0.
+!
+! a. Sulfuric acid concentration definition: ZSULF from ug/m3 to molec/cm3
+!
+ZSULF(:) = PSULF(:)
+ZSULF(:) = ZSULF(:)*(XAVOGADRO*1.E-12) / XH2SO4
+!
+! b. Conditions on sulfuric acid concentration to use Kulmala
+!
+ ZSULF(:) = MAX(MIN(ZSULF(:), 3.E11), 0.)
+!
+! c. Restrictions for parametrization
+!
+ WHERE(((PTEMP(:)>=223.).OR.(PTEMP(:)<=298)).AND.(PRH(:)>=0.1))
+ !
+ ! 1. Saturation vapor pressure for H2SO4 over a flat surface (N/m-2, T in K)
+ !
+ ! a. Ayers et al., 1980
+ !
+ ZPVH2SO4(:)=EXP(27.78492066-10156.0/PTEMP(:))
+ !
+ ! b. Kulmala and Laaksonen., 1990
+ !
+ ! ZPVH2SO4(:)=EXP(-10156./ZT0+16.259+10156.*(-1./PTGAS(:)+1./ZT0+0.38/(ZTC-ZT0)*&
+ ! (1.+LOG(ZT0/PTGAS(:))-ZT0/PTGAS(:))))*101325.
+ !
+ ! c. Noppel et al., 2002
+ !
+ ! ZPVH2SO4(:)=EXP(-11.94+10156*((1/360.15)-(1/PTGAS(:))+(0.38/545)*&
+ ! (1+LOG((360.15/PTGAS(:))-(360.15/PTGAS(:))))))
+ !
+ ! 2. Saturation vapor pressure for water over a flat surface (N/m2, T in K)
+ ! (Preining et al, 1981)
+ !
+ ZPVH2O(:) = EXP(77.344913-7235.4247/PTEMP(:)-8.2*LOG(PTEMP(:))+0.0057113*PTEMP(:))
+ !
+ ! 3. Water concentration (molec/cm3)
+ !
+ ZH2O(:) = PRH(:)*ZPVH2O(:)/(ZKB*PTEMP(:))/1.E6
+ !
+ ! 4. Relative Acidity
+ !
+ ZRA(:)=ZSULF(:)*1.E6*(ZKB*PTEMP(:))/ZPVH2SO4(:)
+ !
+ END WHERE
+!
+! 5. H2SO4 mole fraction in the critical nucleous (no unity)
+!
+ WHERE ((ZSULF(:)>0.).AND.(ZH2O(:)>0.).AND.(ZRA(:)/=0.))
+ !
+ ZAL(:)=1.2233-(0.0154*ZRA(:))/(ZRA(:)+PRH(:))+0.0102*& ! (eq 17)
+ LOG(ZSULF(:))-0.0415*LOG(ZH2O(:))+0.0016*PTEMP(:)
+ !
+ END WHERE
+!
+ WHERE (((PTEMP(:)>=223.).OR.(PTEMP(:)<=298)).AND.(PRH(:)>=0.1).AND.ZAL(:)>1E-5)
+ !
+ ! 6. Sulfuric nucleation rate (molec/cm3/s)
+ !
+ ! a. Sulfuric acid vapor needed to produce jnuc = 1 cm-3.s-1
+ !
+ ZNSULFC(:)=EXP(-14.5125+0.1335*PTEMP(:)-10.5462*PRH(:)+1958.4*PRH(:)/PTEMP(:)) ! (eq 18)
+ !
+ ! b. Sigma term
+ !
+ ZSIG(:) = 1.+(PTEMP(:)-273.15)/273.15 ! (eq 22)
+ !
+ ! c. Sulfuric acid vapor ratio term
+ !
+ ZNSULF(:)=LOG(ZSULF(:)/ZNSULFC(:)) ! (eq 21)
+ !
+ !
+ ! d. Exponential term
+ !
+ ZKHI(:)=25.1289*ZNSULF(:)-4890.8*ZNSULF(:)/PTEMP(:)-1743.3/PTEMP(:)-2.2479*ZSIG(:)*ZNSULF(:)*PRH(:)+&
+ 7643.4*ZAL(:)/PTEMP(:)-1.9712*ZAL(:)*ZSIG(:)/PRH(:) ! (eq 20)
+ !
+ ! e. Nucleation rate
+ !
+ PJNUC(:)=EXP(ZKHI(:)) ! (eq 19)
+ !
+ END WHERE
+!
+PRC(:) = 0.5 ! The critical radius (nm) calculation is not given in Kulmala so we fix the values as 0.5
+!
+RETURN
+!
+END SUBROUTINE CH_AER_KULMALA
diff --git a/src/MNH/ch_aer_maattanen_ionind.f90 b/src/MNH/ch_aer_maattanen_ionind.f90
new file mode 100644
index 000000000..f29afa3c4
--- /dev/null
+++ b/src/MNH/ch_aer_maattanen_ionind.f90
@@ -0,0 +1,644 @@
+!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_nucl.f90,v $ $Revision: 1.1.4.1.18.1 $
+! MASDEV4_7 chimie 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+!! ################################
+MODULE MODI_CH_AER_MAATTANEN_IONIND
+!! ################################
+!!
+INTERFACE
+ !!
+ SUBROUTINE CH_AER_MAATTANEN_IONIND(PRH,PTEMP,PSULF,PJNUCI,PRCI)
+ IMPLICIT NONE
+ !!
+ REAL, DIMENSION(:), INTENT(IN) :: PRH,PTEMP,PSULF
+ REAL, DIMENSION(:), INTENT(INOUT) :: PJNUCI, PRCI
+ !!
+ !!
+ END SUBROUTINE CH_AER_MAATTANEN_IONIND
+ !!
+END INTERFACE
+!!
+END MODULE MODI_CH_AER_MAATTANEN_IONIND
+!!
+!! #########################################################################
+SUBROUTINE CH_AER_MAATTANEN_IONIND(PRH,PTEMP,PSULF,PJNUCI,PRCI)
+!###########################################################
+!
+!!
+!! PURPOSE
+!! -------
+!!
+!! Compute nucleation rate for binary H2SO4/H2O
+!! This is the Määttänen parametrization (2018)
+!! This is the ion-induced particle formation part
+!!
+!! Valid for :
+!! 195 < T < 400 (K)
+!! 10â»âµ < RH < 100 (%)
+!! 10ⴠ< [H2SO4]gas < 10¹ⶠ(molec/cm3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! B. Foucart * LACy *
+!!
+!! MODIFICATIONS
+!! -------------
+!! B. Foucart (18/06/2018) * LACy *
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XAVOGADRO
+USE MODD_CONF, ONLY : NVERB
+USE MODD_CH_AEROSOL
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRH, PTEMP, PSULF ! Relative humidity (%), Temp (kelvin)
+REAL, DIMENSION(:), INTENT(INOUT) :: PJNUCI, PRCI ! Nucleation rate (#/cm3/s) , Critical cluster radius (nm)
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZSULF ! Sulfuric acid concentration (molec/cm3)
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZAL ! Mole fraction of H2SO4 in the critical cluster
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZNTOTI ! Total number of molec in the critical cluster
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZKINTRI ! Threshold sulfuric acid for charged kinetic nucleation
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZNACI ! Sulfuric acid molecules in the charged critical cluster
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZIPR ! Ion pair production rate (cm-3 .s-1)
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZXLOSS ! Ion loss rate
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZCSI ! Ion condensation sink (s-1)
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZAIRN ! Air molecule concentration in (cm-3)
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZRECOMB ! Ion-ion recombination rate
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZNIPAIR ! Number of ion pairs in air (cm-3)
+!
+LOGICAL :: GKINETICI ! True if kinetic neutral nucleation
+!
+INTEGER :: II, ITEST ! Tests
+!
+IF (NVERB .GE. 10) WRITE(*,*) '~~~~ CH_AER_MAATT_ION : PSULF =',MINVAL(PSULF), MAXVAL(PSULF)
+IF (NVERB .GE. 10) WRITE(*,*) '~~~~ CH_AER_MAATT_ION : (XAVOGADRO*1.E-12) =',(XAVOGADRO*1.E-12)
+IF (NVERB .GE. 10) WRITE(*,*) '~~~~ CH_AER_MAATT_ION : XH2SO4=', XH2SO4
+IF (NVERB .GE. 10) WRITE(*,*) '~~~~ CH_AER_MAATT_ION : PTEMP =',MINVAL(PTEMP), MAXVAL(PTEMP)
+IF (NVERB .GE. 10) WRITE(*,*) '~~~~ CH_AER_MAATT_ION : PRH =',MINVAL(PRH), MAXVAL(PRH)
+!
+!----------------------------------------------------------------------------
+!
+! Parameters initialization
+!
+ZAL(:) = 0.17 ! must vary between 0 and 1
+PJNUCI(:) = 1E-7 ! must vary between 10E-7 and 10E10 cm3.s-1
+PRCI(:) = 2.8E-10 ! (meters) must vary between 0.28 and 1.2 nm
+ZNACI(:) = 0.
+ZNTOTI(:) = 10. ! must vary between 1 and 200 molecules
+ZKINTRI(:) = 0.
+ZIPR(:) = 20.
+GKINETICI = .FALSE. ! Logical: if kinetic ion-induced nucleation (FALSE by default)
+ZCSI(:) = 1.0/480. ! Inverse lifetime of ions
+!
+! a. Air molecule concentration calculation
+!
+ZAIRN(:) = 6.023E23 * 1.013E5 / 8.31 / PTEMP(:) / 1.E6 ! Air molecule concentration in (cm-3)
+!
+! b. Sulfuric acid concentration definition: ZSULF from ug/m3 to molec/cm3
+!
+ZSULF(:) = PSULF(:)*(XAVOGADRO*1.E-12) / XH2SO4
+!
+! c. Restrictions for parametrization
+!
+ITEST = 0.
+!
+DO II = 1, SIZE(PSULF,1)
+ IF ((PRH(II) > 1E-5).AND.(PTEMP(II)>195.).AND.(ZSULF(II)>1E4)) THEN
+ ITEST = ITEST+1
+ END IF
+END DO
+!
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (deb): ZSULF',MINVAL(ZSULF(:)), MAXVAL(ZSULF(:))
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (deb): PSULF',MINVAL(PSULF(:)), MAXVAL(PSULF(:))
+
+!
+
+DO II = 1, SIZE(PSULF,1)
+ !
+ IF ((PRH(II) > 1E-5).AND.(PTEMP(II)>195.).AND.(ZSULF(II)>1E4)) THEN
+ !
+ ! 1. Mole fraction of H2SO4 in the critical cluster (eq 1): composition
+ !
+ ZAL(II) = 7.9036365428891719E-1-2.8414059650092153E-3*PTEMP(II)+&
+ 1.4976802556584141E-2*LOG(PRH(II))-2.4511581740839115E-4*PTEMP(II)*LOG(PRH(II))+&
+ 3.4319869471066424E-3*(LOG(PRH(II)))**2-2.8799393617748428E-5*PTEMP(II)*(LOG(PRH(II)))**2+&
+ 3.0174314126331765E-4*(LOG(PRH(II)))**3-2.2673492408841294E-6*PTEMP(II)*(LOG(PRH(II)))**3-&
+ 4.3948464567032377E-3*LOG(ZSULF(II))+5.3305314722492146E-5*PTEMP(II)*LOG(ZSULF(II))
+ !
+ IF (ZIPR(II).GT.0.0) THEN ! if the ion production rate is above zero
+ !
+ ! Calculate the ion induced nucleation rate wrt. concentration of 1 ion/cm3
+ !
+ ZKINTRI(II) = 5.3742280876674478e1 - &
+ & 6.6837931590012266e-3 *log(PRH(II))**(-2) &
+ & - 1.0142598385422842e-01 * log(PRH(II))**(-1) - &
+ & 6.4170597272606873e+00 * log(PRH(II)) &
+ & - 6.4315798914824518e-01 * log(PRH(II))**2 - &
+ & 2.4428391714772721e-02 * log(PRH(II))**3 &
+ & - 3.5356658734539019e-04 * log(PRH(II))**4 + &
+ & 2.5400015099140506e-05 * PTEMP(II) * log(PRH(II))**(-2) &
+ & - 2.7928900816637790e-04 * PTEMP(II) * log(PRH(II))**(-1) + &
+ & 4.4108573484923690e-02 * PTEMP(II) * log(PRH(II)) &
+ & + 6.3943789012475532e-03 * PTEMP(II) * log(PRH(II))**(2) + &
+ & 2.3164296174966580e-04 * PTEMP(II) * log(PRH(II))**(3) &
+ & + 3.0372070669934950e-06 * PTEMP(II) * log(PRH(II))**4 + &
+ & 3.8255873977423475e-06 * PTEMP(II)**2 * log(PRH(II))**(-1) &
+ & - 1.2344793083561629e-04 * PTEMP(II)**2 * log(PRH(II)) - &
+ & 1.7959048869810192e-05 * PTEMP(II)**2 * log(PRH(II))**(2) &
+ & - 3.2165622558722767e-07 * PTEMP(II)**2 * log(PRH(II))**3 - &
+ & 4.7136923780988659e-09 * PTEMP(II)**3 * log(PRH(II))**(-1) &
+ & + 1.1873317184482216e-07 * PTEMP(II)**3 * log(PRH(II)) + &
+ & 1.5685860354866621e-08 * PTEMP(II)**3 * log(PRH(II))**2 &
+ & - 1.4329645891059557e+04 * PTEMP(II)**(-1) + &
+ & 1.3842599842575321e-01 * PTEMP(II) &
+ & - 4.1376265912842938e-04 * PTEMP(II)**(2) + &
+ & 3.9147639775826004e-07 * PTEMP(II)**3
+ !
+ ZKINTRI(II)=exp(ZKINTRI(II)) !1/cm3
+ !
+ IF( ZKINTRI(II).LT.ZSULF(II)) GKINETICI=.TRUE.
+ !
+ IF (GKINETICI) THEN
+ !
+ !
+ PJNUCI(II) = 1.0E6 * (0.3E-9 + 0.487E-9)**2. * sqrt(8. * 3.141593*1.38E-23 * &
+ & (1. / (1.661e-27 * 98.07)+1. / (1.661e-27*98.07))) * &
+ & sqrt(PTEMP(II))*ZSULF(II) !1/cm3s
+ !
+ ZNTOTI(II) = 1. !set to 1
+ !
+ ZNACI(II) = 1.
+ !
+ ZAL(II) = ZNACI(II) / ZNTOTI(II) ! so also set this to 1
+ !
+ PRCI(II) = 0.487E-9
+ !
+ ELSE
+ !
+ PJNUCI(II) = 3.0108954259038608e+01 + PTEMP(II) * &
+ 6.1176722090512577e+01 + PTEMP(II)**2 * &
+ 8.7240333618891663e-01 + PTEMP(II)**3* &
+ (-4.6191788649375719e-03) + PTEMP(II)**(-1) * &
+ 8.3537059107024481e-01
+ PJNUCI(II) = PJNUCI(II) + &
+ (1.5028549216690628e+01 + PTEMP(II) * &
+ (-1.9310989753720623e-01) + PTEMP(II)**2 * &
+ 8.0155514634860480e-04 + PTEMP(II)**3 * &
+ (-1.0832730707799128e-06) + PTEMP(II)**(-1) * &
+ 1.7577660457989019) * (LOG(PRH(II))**(-2))
+ PJNUCI(II) = PJNUCI(II) + &
+ (-2.0487870170216488e-01 + PTEMP(II) * &
+ 1.3263949252910405e-03 + PTEMP(II)**2 * &
+ (-8.4195688402450274e-06) + PTEMP(II)**3 * &
+ 1.6154895940993287e-08 + PTEMP(II)**(-1) * &
+ 3.8734212545203874e+01) * (LOG(PRH(II))**(-2) * LOG(ZSULF(II)))
+ PJNUCI(II) = PJNUCI(II) + &
+ (1.4955918863858371 + PTEMP(II) * &
+ 9.2290004245522454e+01 + PTEMP(II)**2 * &
+ (-8.9006965195392618e-01) + PTEMP(II)**3 * &
+ 2.2319123411013099e-03 + PTEMP(II)**(-1) * &
+ 4.0180079996840852e-03) * (LOG(PRH(II))**(-1) * LOG(ZSULF(II))**(-1))
+ PJNUCI(II) = PJNUCI(II) + &
+ (7.9018031228561085 + PTEMP(II) * &
+ (-1.1649433968658949e+01) + PTEMP(II)**2 * &
+ 1.1400827854910951e-01 + PTEMP(II)**3 * &
+ (-3.1941526492127755e-04) + PTEMP(II)**(-1) * &
+ (-3.7662115740271446e-01)) * (LOG(PRH(II))**(-1))
+ PJNUCI(II) = PJNUCI(II) + &
+ (1.5725237111225979e+02 + PTEMP(II) * &
+ (-1.0051649979836277) + PTEMP(II)**2 * &
+ 1.1866484014507624e-03 + PTEMP(II)**3 * &
+ 7.3557614998540389e-06 + PTEMP(II)**(-1) * &
+ 2.6270197023115189) * (LOG(PRH(II))**(-1) * LOG(ZSULF(II)))
+ PJNUCI(II) = PJNUCI(II) + &
+ (-1.6973840122470968e+01 + PTEMP(II) * &
+ 1.1258423691432135e-01 + PTEMP(II)**2 * &
+ (-2.9850139351463793e-04) + PTEMP(II)**3 * &
+ 1.4301286324827064e-07 + PTEMP(II)**(-1) * &
+ 1.3163389235253725e+01) * (LOG(PRH(II))**(-1) * LOG(ZSULF(II))**2)
+ PJNUCI(II) = PJNUCI(II) + &
+ (-1.0399591631839757 + PTEMP(II) * &
+ 2.7022055588257691e-03 + PTEMP(II)**2 * &
+ (-2.1507467231330936e-06) + PTEMP(II)**3 * &
+ 3.8059489037584171e-10 + PTEMP(II)**(-1) * &
+ 1.5000492788553410e+02) * (LOG(PRH(II))**(-1) * LOG(ZSULF(II))**3)
+ PJNUCI(II) = PJNUCI(II) + &
+ (1.2250990965305315 + PTEMP(II) * &
+ 3.0495946490079444e+01 + PTEMP(II)**2 * &
+ 2.1051563135187106e+01 + PTEMP(II)**3 * &
+ (-8.2200682916580878e-02) + PTEMP(II)**(-1) * &
+ 2.9965871386685029e-02) * (LOG(ZSULF(II))**(-2))
+ PJNUCI(II) = PJNUCI(II) + &
+ (4.8281605955680433 + PTEMP(II) * &
+ 1.7346551710836445e+02 + PTEMP(II)**2 * &
+ (-1.0113602140796010e+01) + PTEMP(II)**3 * &
+ 3.7482518458685089e-02 + PTEMP(II)**(-1) * &
+ (-1.4449998158558205e-01)) * (LOG(ZSULF(II))**(-1))
+ PJNUCI(II) = PJNUCI(II) + &
+ (2.3399230964451237e+02 + PTEMP(II) * &
+ (-2.3099267235261948e+01) + PTEMP(II)**2 * &
+ 8.0122962140916354e-02 + PTEMP(II)**3 * &
+ 6.1542576994557088e-05 + PTEMP(II)**(-1) * &
+ 5.3718413254843007) * (LOG(ZSULF(II)))
+ PJNUCI(II) = PJNUCI(II) + &
+ (1.0299715519499360e+02 + PTEMP(II) * &
+ (-6.4663357203364136e-02) + PTEMP(II)**2 * &
+ (-2.0487150565050316e-03) + PTEMP(II)**3 * &
+ 8.7935289055530897e-07 + PTEMP(II)**(-1) * &
+ 3.6013204601215229e+01) * (LOG(ZSULF(II))**2)
+ PJNUCI(II) = PJNUCI(II) + &
+ (-3.5452115439584042 + PTEMP(II) * &
+ 1.7083445731159330e-02 + PTEMP(II)**2 * &
+ (-1.2552625290862626e-05) + PTEMP(II)**3 * &
+ 1.2968447449182847e-09 + PTEMP(II)**(-1) * &
+ 1.5748687512056560e+02) * (LOG(ZSULF(II))**3)
+ PJNUCI(II) = PJNUCI(II) + &
+ (2.2338490119517975 + PTEMP(II) * &
+ 1.0229410216045540e+02 + PTEMP(II)**2 * &
+ (-3.2103611955174052) + PTEMP(II)**3 * &
+ 1.3397152304977591e-02 + PTEMP(II)**(-1) * &
+ (-2.4155187776460030e-02)) * (LOG(PRH(II))* LOG(ZSULF(II))**(-2))
+ PJNUCI(II) = PJNUCI(II) + &
+ (3.7592282990713963 + PTEMP(II) * &
+ (-1.5257988769009816e+02) + PTEMP(II)**2 * &
+ 2.6113805420558802 + PTEMP(II)**3 * &
+ (-9.0380721653694363e-03) + PTEMP(II)**(-1) * &
+ (-1.3974197138171082e-01)) * (LOG(PRH(II))* LOG(ZSULF(II))**(-1))
+ PJNUCI(II) = PJNUCI(II) + &
+ (1.8293600730573988e+01 + PTEMP(II) * &
+ 1.8344728606002992e+01 + PTEMP(II)**2 * &
+ (-4.0063363221106751e-01) + PTEMP(II)**3 * &
+ 1.4842749371258522e-03 + PTEMP(II)**(-1) * &
+ 1.1848846003282287) * (LOG(PRH(II)))
+ PJNUCI(II) = PJNUCI(II) + &
+ (-1.7634531623032314e+02 + PTEMP(II) * &
+ 4.9011762441271278 + PTEMP(II)**2 * &
+ (-1.3195821562746339e-02) + PTEMP(II)**3 * &
+ (-2.8668619526430859e-05) + PTEMP(II)**(-1) * &
+ (-2.9823396976393551e-01)) * (LOG(PRH(II))* LOG(ZSULF(II)))
+ PJNUCI(II) = PJNUCI(II) + &
+ (-3.2944043694275727e+01 + PTEMP(II) * &
+ 1.2517571921051887e-01 + PTEMP(II)**2 * &
+ 8.3239769771186714e-05 + PTEMP(II)**3 * &
+ 2.8191859341519507e-07 + PTEMP(II)**(-1) * &
+ (-2.7352880736682319e+01)) * (LOG(PRH(II))* LOG(ZSULF(II))**2)
+ PJNUCI(II) = PJNUCI(II) + &
+ (-1.1451811137553243 + PTEMP(II) * &
+ 2.0625997485732494e-03 + PTEMP(II)**2 * &
+ (-3.4225389469233624e-06) + PTEMP(II)**3 * &
+ 4.4437613496984567e-10 + PTEMP(II)**(-1) * &
+ 1.8666644332606754e+02) * (LOG(PRH(II))* LOG(ZSULF(II))**3)
+ PJNUCI(II) = PJNUCI(II) + &
+ (3.2270897099493567e+01 + PTEMP(II) * &
+ 7.7898447327513687e-01 + PTEMP(II)**2 * &
+ (-6.5662738484679626e-03) + PTEMP(II)**3 * &
+ 3.7899330796456790e-06 + PTEMP(II)**(-1) * &
+ 7.1106427501756542e-01) * (LOG(PRH(II))**2 * LOG(ZSULF(II))**(-1))
+ PJNUCI(II) = PJNUCI(II) + &
+ (-2.8901906781697811e+01 + PTEMP(II) * &
+ (-1.5356398793054860) + PTEMP(II)**2 * &
+ 1.9267271774384788e-02 + PTEMP(II)**3 * &
+ (-5.3886270475516162e-05) + PTEMP(II)**(-1) * &
+ 5.0490415975693426e-01) * (LOG(PRH(II))**2)
+ PJNUCI(II) = PJNUCI(II) + &
+ (3.3365683645733924e+01 + PTEMP(II) * &
+ (-3.6114561564894537e-01) + PTEMP(II)**2 * &
+ 9.2977354471929262e-04 + PTEMP(II)**3 * &
+ 1.9549769069511355e-07 + PTEMP(II)**(-1) * &
+ (-8.8865930095112855)) * (LOG(PRH(II))**2 * LOG(ZSULF(II)))
+ PJNUCI(II) = PJNUCI(II) + &
+ (2.4592563042806375 + PTEMP(II) * &
+ (-8.3227071743101084e-03) + PTEMP(II)**2 * &
+ 8.2563338043447783e-06 + PTEMP(II)**3 * &
+ (-8.4374976698593496e-09) + PTEMP(II)**(-1) * &
+ (-2.0938173949893473e+02)) * (LOG(PRH(II))**2 * LOG(ZSULF(II))**2)
+ PJNUCI(II) = PJNUCI(II) + &
+ (4.4099823444352317e+01 + PTEMP(II) * &
+ 2.5915665826835252 + PTEMP(II)**2 * &
+ (-1.6449091819482634e-02) + PTEMP(II)**3 * &
+ 2.6797249816144721e-05 + PTEMP(II)**(-1) * &
+ 5.5045672663909995e-01) * PRH(II)
+ !
+ PJNUCI(II) = EXP(PJNUCI(II))
+ !
+ ZNTOTI(II) = (-4.8324296064013375e+04 + PTEMP(II) * &
+ 5.0469120697428906e+02 + PTEMP(II)**2 * &
+ (-1.1528940488496042e+00) + PTEMP(II)**(-1) * &
+ (-8.6892744676239192e+02) + (PTEMP(II)**(3)) * &
+ 4.0030302028120469e-04)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-6.7259105232039847e+03 + PTEMP(II) * &
+ 1.9197488157452008e+02 + PTEMP(II)**2 * &
+ (-1.3602976930126354e+00) + PTEMP(II)**(-1) * &
+ (-1.1212637938360332e+02) + (PTEMP(II)**(3)) * &
+ 2.8515597265933207e-03) * LOG(PRH(II))**(-2) * LOG(ZSULF(II))**(-2)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (2.6216455217763342e+02 + PTEMP(II) * &
+ (-2.3687553252750821e+00) + PTEMP(II)**2 * &
+ 7.4074554767517521e-03 + PTEMP(II)**(-1) * &
+ (-1.9213956820114927e+03) + (PTEMP(II)**(3)) * &
+ (-9.3839114856129453e-06)) * LOG(PRH(II))**(-2)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (3.9652478944137344e+00 + PTEMP(II) * &
+ 1.2469375098256536e-02 + PTEMP(II)**2 * &
+ (-9.9837754694045633e-05) + PTEMP(II)**(-1) * &
+ (-5.1919499210175138e+02) + (PTEMP(II)**(3)) * &
+ 1.6489001324583862e-07) * LOG(PRH(II))**(-2) * LOG(ZSULF(II))
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (2.4975714429096206e+02 + PTEMP(II) * &
+ 1.7107594562445172e+02 + PTEMP(II)**2 * &
+ (-7.8988711365135289e-01) + PTEMP(II)**(-1) * &
+ (-2.2243599782483177e+01) + (PTEMP(II)**(3)) * &
+ (-1.6291523004095427e-04)) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))**(-2)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-8.9270715592533611e+02 + PTEMP(II) * &
+ 1.2053538883338946e+02 + PTEMP(II)**2 * &
+ (-1.5490408828541018e+00) + PTEMP(II)**(-1) * &
+ (-1.1243275579419826e+01) + (PTEMP(II)**(3)) * &
+ 4.8053105606904655e-03) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))**(-1)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (7.6426441642091631e+03 + PTEMP(II) * &
+ (-7.1785462414656578e+01) + PTEMP(II)**2 * &
+ 2.3851864923199523e-01 + PTEMP(II)**(-1) * &
+ 8.5591775688708395e+01 + (PTEMP(II)**(3)) * &
+ (-3.7000473243342858e-04)) * LOG(PRH(II))**(-1)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-5.1516826398607911e+01 + PTEMP(II) * &
+ 9.1385720811460558e-01 + PTEMP(II)**2 * &
+ (-3.5477100262158974e-03) + PTEMP(II)**(-1) * &
+ 2.7545544507625586e+03 + (PTEMP(II)**(3)) * &
+ 5.4708262093640928e-06) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-3.0386767129196176e+02 + PTEMP(II) * &
+ (-1.1033438883583569e+04) + PTEMP(II)**2 * &
+ 8.1296859732896067e+01 + PTEMP(II)**(-1) * &
+ 1.2625883141097162e+01 + (PTEMP(II)**(3)) * &
+ (-1.2728497822219101e-01)) * LOG(ZSULF(II))**(-2)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-3.3763494256461472e+03 + PTEMP(II) * &
+ 3.1916579136391006e+03 + PTEMP(II)**2 * &
+ (-2.7234339474441143e+01) + PTEMP(II)**(-1) * &
+ (-2.1897653262707397e+01) + (PTEMP(II)**(3)) * &
+ 5.1788505812259071e-02) * LOG(ZSULF(II))**(-1)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-1.8817843873687068e+03 + PTEMP(II) * &
+ 4.3038072285882070e+00 + PTEMP(II)**2 * &
+ 6.6244087689671860e-03 + PTEMP(II)**(-1) * &
+ (-2.7133073605696295e+03) + (PTEMP(II)**(3)) * &
+ (-1.7951557394285043e-05)) * LOG(ZSULF(II))
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-1.7668827539244447e+02 + PTEMP(II) * &
+ 4.8160932330629913e-01 + PTEMP(II)**2 * &
+ (-6.3133007671100293e-04) + PTEMP(II)**(-1) * &
+ 2.5631774669873157e+04 + (PTEMP(II)**(3)) * &
+ 4.1534484127873519e-07) * LOG(ZSULF(II))**(2)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-1.6661835889222382e+03 + PTEMP(II) * &
+ 1.3708900504682877e+03 + PTEMP(II)**2 * &
+ (-1.7919060052198969e+01) + PTEMP(II)**(-1) * &
+ (-3.5145029804436405e+01) + (PTEMP(II)**(3)) * &
+ 5.1047240947371224e-02) * LOG(PRH(II))* LOG(ZSULF(II))**(-2)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (1.0843549363030939e+04 + PTEMP(II) * &
+ (-7.3557073636139577e+01) + PTEMP(II)**2 * &
+ 1.2054625131778862e+00 + PTEMP(II)**(-1) * &
+ 1.9358737917864391e+02 + (PTEMP(II)**(3)) * &
+ (-4.2871620775911338e-03)) * LOG(PRH(II))* LOG(ZSULF(II))**(-1)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-2.4269802549752835e+03 + PTEMP(II) * &
+ 1.1348265061941714e+01 + PTEMP(II)**2 * &
+ (-5.0430423939495157e-02) + PTEMP(II)**(-1) * &
+ 2.3709874548950634e+03 + (PTEMP(II)**(3)) * &
+ 1.4091851828620244e-04) * LOG(PRH(II))
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (5.2745372575251588e+02 + PTEMP(II) * &
+ (-2.6080675912627314e+00) + PTEMP(II)**2 * &
+ 5.6902218056670145e-03 + PTEMP(II)**(-1) * &
+ (-3.2149319482897838e+04) + (PTEMP(II)**(3)) * &
+ (-5.4121996056745853e-06)) * LOG(PRH(II))* LOG(ZSULF(II))
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-1.6401959518360403e+01 + PTEMP(II) * &
+ 2.4322962162439640e-01 + PTEMP(II)**2 * &
+ 1.1744366627725344e-03 + PTEMP(II)**(-1) * &
+ (-8.2694427518413195e+03) + (PTEMP(II)**(3)) * &
+ (-5.0028379203873102e-06)) * LOG(PRH(II))**(2)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-2.7556572017167782e+03 + PTEMP(II) * &
+ 4.9293344495058264e+01 + PTEMP(II)**2 * &
+ (-2.6503456520676050e-01) + PTEMP(II)**(-1) * &
+ 1.2130698030982167e+03 + (PTEMP(II)**(3)) * &
+ 4.3530610668042957e-04) * LOG(PRH(II))**2 * LOG(ZSULF(II))**(-1)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (-6.3419182228959192e+00 + PTEMP(II) * &
+ 4.0636212834605827e-02 + PTEMP(II)**2 * &
+ (-1.0450112687842742e-04) + PTEMP(II)**(-1) * &
+ 3.1035882189759656e+02 +(PTEMP(II)**(3)) * &
+ 9.4328418657873500e-08) * LOG(PRH(II))**(-3)
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (3.0189213304689042e+03 + PTEMP(II) * &
+ (-2.3804654203861684e+01) + PTEMP(II)**2 * &
+ 6.8113013411972942e-02 + PTEMP(II)**(-1) * &
+ 6.3112071081188913e+02 + (PTEMP(II)**(3)) * &
+ (-9.4460854261685723e-05)) * (PRH(II)) * LOG(ZSULF(II))
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (1.1924791930673702e+04 + PTEMP(II) * &
+ (-1.1973824959206000e+02) + PTEMP(II)**2 * &
+ 1.6888713097971020e-01 + PTEMP(II)**(-1) * &
+ 1.8735938211539585e+02 + (PTEMP(II)**(3)) * &
+ 5.0974564680442852e-04) * (PRH(II))
+ ZNTOTI(II) = ZNTOTI(II) + &
+ (3.6409071302482083e+01 + PTEMP(II) * &
+ 1.7919859306449623e-01 + PTEMP(II)**2 * &
+ (-1.0020116255895206e-03) + PTEMP(II)**(-1) * &
+ (-8.3521083354432303e+03) + (PTEMP(II)**(3)) * &
+ 1.5879900546795635e-06) * PRH(II) * LOG(ZSULF(II))**(2)
+ !
+ ZNTOTI(II) = abs(ZNTOTI(II))
+ !
+ PRCI(II) = (-3.6318550637865524e-08 + PTEMP(II) * &
+ 2.1740704135789128e-09 + PTEMP(II)**2 * &
+ (-8.5521429066506161e-12) + PTEMP(II)**3 * &
+ (-9.3538647454573390e-15))
+ PRCI(II) = PRCI(II) + &
+ (2.1366936839394922e-08 + PTEMP(II) * &
+ (-2.4087168827395623e-10) + PTEMP(II)**2 * &
+ 8.7969869277074319e-13 + PTEMP(II)**3 * &
+ (-1.0294466881303291e-15)) * LOG(PRH(II))**(-2) * LOG(ZSULF(II))**(-1)
+ PRCI(II) = PRCI(II) + &
+ (-7.7804007761164303e-10 + PTEMP(II) * &
+ 1.0327058173517932e-11 + PTEMP(II)**2 * &
+ (-4.2557697639692428e-14) + PTEMP(II)**3 * &
+ 5.4082507061618662e-17) * LOG(PRH(II))**(-2)
+ PRCI(II) = PRCI(II) + &
+ (3.2628927397420860e-12 + PTEMP(II) * &
+ (-7.6475692919751066e-14) + PTEMP(II)**2 * &
+ 4.1985816845259788e-16 + PTEMP(II)**3 * &
+ (-6.2281395889592719e-19)) * LOG(PRH(II))**(-2) * LOG(ZSULF(II))
+ PRCI(II) = PRCI(II) + &
+ (2.0442205540818555e-09 + PTEMP(II) * &
+ 4.0441858911249830e-08 + PTEMP(II)**2 * &
+ (-3.3423487629482825e-10) + PTEMP(II)**3 * &
+ 6.8000404742985678e-13) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))**(-2)
+ PRCI(II) = PRCI(II) + &
+ (1.8381489183824627e-08 + PTEMP(II) * &
+ (-8.9853322951518919e-09) + PTEMP(II)**2 * &
+ 7.5888799566036185e-11 + PTEMP(II)**3 * &
+ (-1.5823457864755549e-13)) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))**(-1)
+ PRCI(II) = PRCI(II) + &
+ (1.1795760639695057e-07 + PTEMP(II) * &
+ (-8.1046722896375875e-10) + PTEMP(II)**2 * &
+ 9.1868604369041857e-14 + PTEMP(II)**3 * &
+ 4.7882428237444610e-15) * LOG(PRH(II))**(-1)
+ PRCI(II) = PRCI(II) + &
+ (-4.4028846582545952e-09 + PTEMP(II) * &
+ 4.6541269232626618e-11 + PTEMP(II)**2 * &
+ (-1.1939929984285194e-13) + PTEMP(II)**3 * &
+ 2.3602037016614437e-17) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))
+ PRCI(II) = PRCI(II) + &
+ (2.7885056884209128e-11 + PTEMP(II) * &
+ (-4.5167129624119121e-13) + PTEMP(II)**2 * &
+ 1.6558404997394422e-15 + PTEMP(II)**3 * &
+ (-1.2037336621218054e-18)) * LOG(PRH(II))**(-1) * LOG(ZSULF(II))**2
+ PRCI(II) = PRCI(II) + &
+ (-2.3719627171699983e-09 + PTEMP(II) * &
+ (-1.5260127909292053e-07) + PTEMP(II)**2 * &
+ 1.7177017944754134e-09 + PTEMP(II)**3 * &
+ (-4.7031737537526395e-12)) * LOG(ZSULF(II))**(-2)
+ PRCI(II) = PRCI(II) + &
+ (-5.6946433724699646e-09 + PTEMP(II) * &
+ 8.4629788237081735e-09 + PTEMP(II)**2 * &
+ (-1.7674135187061521e-10) + PTEMP(II)**3 * &
+ 6.6236547903091862e-13) * LOG(ZSULF(II))**(-1)
+ PRCI(II) = PRCI(II) + &
+ (-2.2808617930606012e-08 + PTEMP(II) * &
+ 1.4773376696847775e-10 + PTEMP(II)**2 * &
+ (-1.3076953119957355e-13) + PTEMP(II)**3 * &
+ 2.3625301497914000e-16) * LOG(ZSULF(II))
+ PRCI(II) = PRCI(II) + &
+ (1.4014269939947841e-10 + PTEMP(II) * &
+ (-2.3675117757377632e-12) + PTEMP(II)**2 * &
+ 5.1514033966707879e-15 + PTEMP(II)**3 * &
+ (-4.8864233454747856e-18)) * LOG(ZSULF(II))**2
+ PRCI(II) = PRCI(II) + &
+ (6.5464943868885886e-11 + PTEMP(II) * &
+ 1.6494354816942769e-08 + PTEMP(II)**2 * &
+ (-1.7480097393483653e-10) + PTEMP(II)**3 * &
+ 4.7460075628523984e-13) * LOG(PRH(II))* LOG(ZSULF(II))**(-2)
+ PRCI(II) = PRCI(II) + &
+ (8.4737893183927871e-09 + PTEMP(II) * &
+ (-6.0243327445597118e-09) + PTEMP(II)**2 * &
+ 5.8766070529814883e-11 + PTEMP(II)**3 * &
+ (-1.4926748560042018e-13)) * LOG(PRH(II))* LOG(ZSULF(II))**(-1)
+ PRCI(II) = PRCI(II) + &
+ (1.0761964135701397e-07 + PTEMP(II) * &
+ (-1.0142496009071148e-09) + PTEMP(II)**2 * &
+ 2.1337312466519190e-12 + PTEMP(II)**3 * &
+ 1.6376014957685404e-15) * LOG(PRH(II))
+ PRCI(II) = PRCI(II) + &
+ (-3.5621571395968670e-09 + PTEMP(II) * &
+ 4.1175339587760905e-11 + PTEMP(II)**2 * &
+ (-1.3535372357998504e-13) + PTEMP(II)**3 * &
+ 8.9334219536920720e-17) * LOG(PRH(II))* LOG(ZSULF(II))
+ PRCI(II) = PRCI(II) + &
+ (2.0700482083136289e-11 + PTEMP(II) * &
+ (-3.9238944562717421e-13) + PTEMP(II)**2 * &
+ 1.5850961422040196e-15 + PTEMP(II)**3 * &
+ (-1.5336775610911665e-18)) * LOG(PRH(II))* LOG(ZSULF(II))**2
+ PRCI(II) = PRCI(II) + &
+ (1.8524255464416206e-09 + PTEMP(II) * &
+ (-2.1959816152743264e-11) + PTEMP(II)**2 * &
+ (-6.4478119501677012e-14) + PTEMP(II)**3 * &
+ 5.5135243833766056e-16)* LOG(PRH(II))**2 * LOG(ZSULF(II))**(-1)
+ PRCI(II) = PRCI(II) + &
+ (1.9349488650922679e-09 + PTEMP(II) * &
+ (-2.2647295919976428e-11) + PTEMP(II)**2 * &
+ 9.2917479748268751e-14 + PTEMP(II)**3 * &
+ (-1.2741959892173170e-16))* LOG(PRH(II))**2
+ PRCI(II) = PRCI(II) + &
+ (2.1484978031650972e-11 + PTEMP(II) * &
+ (-9.3976642475838013e-14) + PTEMP(II)**2 * &
+ (-4.8892738002751923e-16) + PTEMP(II)**3 * &
+ 1.4676120441783832e-18)* LOG(PRH(II))**2 * LOG(ZSULF(II))
+ PRCI(II) = PRCI(II) + &
+ (6.7565715216420310e-13 + PTEMP(II) * &
+ (-3.5421162549480807e-15) + PTEMP(II)**2 * &
+ (-3.4201196868693569e-18) + PTEMP(II)**3 * &
+ 2.2260187650412392e-20)* LOG(PRH(II))**3 * LOG(ZSULF(II))
+ !
+ ZNACI(II) = ZAL(II) * ZNTOTI(II)
+ !
+ IF (ZNACI(II) .LT. 1.) THEN
+ !
+ !
+ ZNACI(II)=1.0
+ !
+ END IF
+ !
+ END IF
+ !
+ ! Ion loss rate (1/s)
+ !
+ ZXLOSS(II) = ZCSI(II) + PJNUCI(II)
+ !
+ ! Recombination (here following Brasseur and Chatel, 1983)
+ !
+ ZRECOMB(II) = 6.0e-8 * sqrt(300./PTEMP(II)) + &
+ 6.0e-26 * ZAIRN(II) * (300./PTEMP(II))**4
+ !
+ ! Small ion concentration in air (1/cm3) (following Dunne et al., 2016)
+ ! max function is to avoid n_i to go practically zero at very high J_ion
+ !
+ ZNIPAIR(II) = max(0.01,(sqrt(ZXLOSS(II)**2.0 + &
+ 4.0 * ZRECOMB(II) * ZIPR(II)) - ZXLOSS(II)) / (2.0 * ZRECOMB(II)))
+ !
+ ! Ion-induced nucleation rate
+ ! Min function is to ensure that max function above does not cause J_ion to overshoot
+ !
+ PJNUCI(II) = min(ZIPR(II),ZNIPAIR(II)*PJNUCI(II))
+ !
+ IF (PJNUCI(II).LT.1.E-7) THEN
+ !
+ PJNUCI(II) = 0.0
+ !
+ END IF
+ !
+ END IF
+ !
+ END IF
+ !
+END DO
+!
+!
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): PRH =',MINVAL(PRH), MAXVAL(PRH)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): PTEMP =',MINVAL(PTEMP), MAXVAL(PTEMP)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZSULF =',MINVAL(ZSULF), MAXVAL(ZSULF)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): PJNUCI =',MINVAL(PJNUCI), MAXVAL(PJNUCI)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZKINTRI =',MINVAL(ZKINTRI), MAXVAL(ZKINTRI)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZAL =',MINVAL(ZAL), MAXVAL(ZAL)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZNTOTI =',MINVAL(ZNTOTI), MAXVAL(ZNTOTI)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): PRCI =',MINVAL(PRCI), MAXVAL(PRCI)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZXLOSS =',MINVAL(ZXLOSS), MAXVAL(ZXLOSS)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZRECOMB =',MINVAL(ZRECOMB), MAXVAL(ZRECOMB)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_ION (fin): ZNIPAIR =',MINVAL(ZNIPAIR), MAXVAL(ZNIPAIR)
+!
+RETURN
+!
+END SUBROUTINE CH_AER_MAATTANEN_IONIND
+
diff --git a/src/MNH/ch_aer_maattanen_neutral.f90 b/src/MNH/ch_aer_maattanen_neutral.f90
new file mode 100644
index 000000000..8a9c8b5d3
--- /dev/null
+++ b/src/MNH/ch_aer_maattanen_neutral.f90
@@ -0,0 +1,335 @@
+!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_nucl.f90,v $ $Revision: 1.1.4.1.18.1 $
+! MASDEV4_7 chimie 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+!! ################################
+MODULE MODI_CH_AER_MAATTANEN_NEUTRAL
+!! ################################
+!!
+INTERFACE
+ !!
+ SUBROUTINE CH_AER_MAATTANEN_NEUTRAL(PRH,PTEMP,PSULF,PJNUCN,PRCN)
+ IMPLICIT NONE
+ !!
+ REAL, DIMENSION(:), INTENT(IN) :: PRH,PTEMP,PSULF
+ REAL, DIMENSION(:), INTENT(INOUT) :: PJNUCN, PRCN
+ !!
+ !!
+ END SUBROUTINE CH_AER_MAATTANEN_NEUTRAL
+ !!
+END INTERFACE
+!!
+END MODULE MODI_CH_AER_MAATTANEN_NEUTRAL
+!!
+!! #########################################################################
+SUBROUTINE CH_AER_MAATTANEN_NEUTRAL(PRH,PTEMP,PSULF,PJNUCN,PRCN)
+!###########################################################
+!
+!!
+!! PURPOSE
+!! -------
+!!
+!! Compute nucleation rate for binary H2SO4/H2O
+!! This is the Määttänen parametrization (2018)
+!! This is the neutral particle formation part
+!!
+!! Valid for :
+!! 165 < T < 400 (K)
+!! 0.001 < RH < 100 (%)
+!! 10ⴠ< [H2SO4]gas < 10¹³ (molec/cm3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! B. Foucart * LACy *
+!!
+!! MODIFICATIONS
+!! -------------
+!! B. Foucart (18/06/2018) * LACy *
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CST, ONLY : XAVOGADRO
+USE MODD_CONF, ONLY : NVERB
+USE MODD_CH_AEROSOL
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of dummy arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRH, PTEMP, PSULF ! Relative humidity (%), Temp (kelvin)
+REAL, DIMENSION(:), INTENT(INOUT) :: PJNUCN, PRCN ! Nucleation rate (#/cm3/s) , Critical cluster radius (nm)
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZSULF ! Sulfuric acid concentration (molec/cm3)
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZAL ! Mole fraction of H2SO4 in the critical cluster
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZNTOTN ! Total number of molec in the neutral critical cluster
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZKINTRN ! Threshold sulfuric acid for neutral kinetic nucleation
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZNACN ! Sulfuric acid molecules in the neutral critical cluster
+!
+LOGICAL :: GKINETICN ! True if kinetic neutral nucleation
+!
+INTEGER :: II, ITEST ! Tests
+!
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (deb): PSULF =',MINVAL(PSULF), MAXVAL(PSULF)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (deb): (XAVOGADRO*1.E-12) =',(XAVOGADRO*1.E-12)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (deb): XH2SO4=', XH2SO4
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (deb): PTEMP =',MINVAL(PTEMP), MAXVAL(PTEMP)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (deb): PRH =',MINVAL(PRH), MAXVAL(PRH)
+!
+!----------------------------------------------------------------------------
+!
+! Parameters initialization
+!
+ZAL(:) = 0.17 ! must vary between 0 and 1
+PJNUCN(:) = 1E-7 ! must vary between 10E-7 and 10E10 cm3.s-1
+PRCN(:) = 2.8E-10 ! (meters) must vary between 0.28 and 1.2 nm
+ZNACN(:) = 0.
+ZNTOTN(:) = 10. ! must vary between 1 and 200 molecules
+ZKINTRN(:) = 0.
+GKINETICN = .FALSE.
+!
+! a. Sulfuric acid concentration definition: ZSULF from ug/m3 to molec/cm3
+!
+ZSULF(:) = PSULF(:)*(XAVOGADRO*1.E-12) / XH2SO4
+!
+! b. Restrictions for parametrization
+!
+!
+ITEST = 0.
+!
+DO II = 1, SIZE(PSULF,1)
+ IF ((PRH(II) > 0.001).AND.(PTEMP(II)>165.).AND.(ZSULF(II)>1E4)) THEN
+ ITEST = ITEST+1
+ END IF
+END DO
+!
+DO II = 1, SIZE(PSULF,1)
+ !
+ IF ( (PRH(II)>0.001) .AND. (PTEMP(II)>165.) .AND. (ZSULF(II)>1E4) ) THEN
+ !
+ ! 1. Mole fraction of H2SO4 in the critical cluster (eq 1): composition
+ !
+ ZAL(II) = 7.9036365428891719E-1-2.8414059650092153E-3*PTEMP(II)+&
+ 1.4976802556584141E-2*LOG(PRH(II))-2.4511581740839115E-4*PTEMP(II)*LOG(PRH(II))+&
+ 3.4319869471066424E-3*(LOG(PRH(II)))**2-2.8799393617748428E-5*PTEMP(II)*(LOG(PRH(II)))**2+&
+ 3.0174314126331765E-4*(LOG(PRH(II)))**3-2.2673492408841294E-6*PTEMP(II)*(LOG(PRH(II)))**3-&
+ 4.3948464567032377E-3*LOG(ZSULF(II))+5.3305314722492146E-5*PTEMP(II)*LOG(ZSULF(II))
+ !
+ ! 2. Nucleation rate calculation in part.cm-3.s-1 (eq 2)
+ !
+ ! a) Kinetic limit check
+ !
+ IF (PRH(II) .GE. 1.e-2 .AND. PRH(II) .LE. 1.) THEN
+ !
+ ZKINTRN(II) = exp(7.8920778706888086e+1 + 7.3665492897447082*PRH(II) - 1.2420166571163805e+4/PTEMP(II) &
+ & + (-6.1831234251470971e+2*PRH(II))/PTEMP(II) - 2.4501159970109945e-2*PTEMP(II) &
+ & -1.3463066443605762e-2*PRH(II)*PTEMP(II) + 8.3736373989909194e-06*PTEMP(II)**2 &
+ & -1.4673887785408892*Log(PRH(II)) + (-3.2141890006517094e+1*Log(PRH(II)))/PTEMP(II) &
+ & + 2.7137429081917556e-3*PTEMP(II)*Log(PRH(II))) !1/cm3
+ !
+ IF (ZKINTRN(II).LT.ZSULF(II)) GKINETICN = .TRUE.
+ !
+ END IF
+ !
+ IF (PRH(II) .GE. 1.e-4 .AND. PRH(II) .LT. 1.e-2) THEN
+ !
+ ZKINTRN(II) = exp(7.9074383049843647e+1 - 2.8746005462158347e+1*PRH(II) - 1.2070272068458380e+4/PTEMP(II) &
+ & + (-5.9205040320056632e+3*PRH(II))/PTEMP(II) - 2.4800372593452726e-2*PTEMP(II) &
+ & -4.3983007681295948e-2*PRH(II)*PTEMP(II) + 2.5943854791342071e-5*PTEMP(II)**2 &
+ & -2.3141363245211317*Log(PRH(II)) + (9.9186787997857735e+1*Log(PRH(II)))/PTEMP(II) &
+ & + 5.6819382556144681e-3*PTEMP(II)*Log(PRH(II))) !1/cm3
+ !
+ IF (ZKINTRN(II).LT.ZSULF(II)) GKINETICN = .TRUE.
+ !
+ END IF
+ !
+ IF (PRH(II) .GE. 5.e-6 .AND. PRH(II) .LT. 1.e-4) THEN
+ !
+ ZKINTRN(II) = exp(8.5599712000361677e+1 + 2.7335119660796581e+3*PRH(II) - 1.1842350246291651e+4/PTEMP(II) &
+ & + (-1.2439843468881438e+6*PRH(II))/PTEMP(II) - 5.4536964974944230e-2*PTEMP(II) &
+ & + 5.0886987425326087*PRH(II)*PTEMP(II) + 7.1964722655507067e-5*PTEMP(II)**2 &
+ & -2.4472627526306372*Log(PRH(II)) + (1.7561478001423779e+2*Log(PRH(II)))/PTEMP(II) &
+ & + 6.2640132818141811e-3*PTEMP(II)*Log(PRH(II))) !1/cm3
+ !
+ IF(ZKINTRN(II).LT.ZSULF(II)) GKINETICN = .TRUE.
+ !
+ END IF
+ !
+ IF (GKINETICN) THEN
+ !
+ ! Nucleation rate calculation if dimer
+ !
+ PJNUCN(II) = 1.E6*(2.*0.3E-9)**2.*sqrt(8.*3.141593*1.38E-23*(1./(1.661e-27*98.07)+1./(1.661e-27*98.07))) &
+ & /2.*sqrt(PTEMP(II))*ZSULF(II)**2.
+ !
+ ZNTOTN(II) = 1. !set to 1
+ !
+ ZNACN(II) = 1. ! The critical cluster contains one molecule, but the produced cluster contains 2 molecules
+ !
+ ZAL(II) = ZNACN(II) / ZNTOTN(II) ! so also set this to 1
+ !
+ PRCN(II) = 0.3E-9
+ !
+ ELSE
+ !
+ ! c) Nucleation rate calculation if not dimer
+ !
+ PJNUCN(II) = 2.1361182605986115e-1 + &
+ & 3.3827029855551838 * PTEMP(II) - &
+ & 3.2423555796175563e-2 * PTEMP(II)**2 + &
+ & 7.0120069477221989e-5 * PTEMP(II)**3 + &
+ & 8.0286874752695141 / ZAL(II) + &
+ & -2.6939840579762231e-1 * LOG(PRH(II)) + &
+ & 1.6079879299099518 * PTEMP(II) * LOG(PRH(II)) + &
+ & -1.9667486968141933e-2 * PTEMP(II)**2 * LOG(PRH(II)) + &
+ & 5.5244755979770844e-5 * PTEMP(II)**3 * LOG(PRH(II)) + &
+ & (7.8884704837892468 * LOG(PRH(II))) / ZAL(II) + &
+ & 4.6374659198909596 * LOG(PRH(II))**2 - &
+ & 8.2002809894792153e-2 * PTEMP(II) * LOG(PRH(II))**2 + &
+ & 8.5077424451172196e-4 * PTEMP(II)**2 * LOG(PRH(II))**2 + &
+ & -2.6518510168987462e-6 * PTEMP(II)**3 * LOG(PRH(II))**2 + &
+ & (-1.4625482500575278 * LOG(PRH(II))**2)/ZAL(II) - &
+ & 5.2413002989192037e-1 * LOG(PRH(II))**3 + &
+ & 5.2755117653715865e-3 * PTEMP(II) * LOG(PRH(II))**3 + &
+ & -2.9491061332113830e-6 * PTEMP(II)**2 * LOG(PRH(II))**3 + &
+ & -2.4815454194486752e-8 * PTEMP(II)**3 * LOG(PRH(II))**3 + &
+ & (-5.2663760117394626e-2 * LOG(PRH(II))**3) / ZAL(II) + &
+ & 1.6496664658266762 * LOG(ZSULF(II)) + &
+ & -8.0809397859218401e-1 * PTEMP(II) * LOG(ZSULF(II)) + &
+ & 8.9302927091946642e-3 * PTEMP(II)**2 * LOG(ZSULF(II)) + &
+ & -1.9583649496497497e-5 * PTEMP(II)**3 * LOG(ZSULF(II)) + &
+ & (-8.9505572676891685 * LOG(ZSULF(II))) / ZAL(II) + &
+ & -3.0025283601622881e+1 * LOG(PRH(II)) * LOG(ZSULF(II)) + &
+ & 3.0783365644763633e-1 * PTEMP(II) * LOG(PRH(II)) * LOG(ZSULF(II)) + &
+ & -7.4521756337984706e-4 * PTEMP(II)**2 * LOG(PRH(II)) * LOG(ZSULF(II)) + &
+ & -5.7651433870681853e-7 * PTEMP(II)**3 * LOG(PRH(II)) * LOG(ZSULF(II)) + &
+ & (1.2872868529673207 * LOG(PRH(II)) * LOG(ZSULF(II))) / ZAL(II) + &
+ & -6.1739867501526535e-1 * LOG(PRH(II))**2 * LOG(ZSULF(II)) + &
+ & 7.2347385705333975e-3 * PTEMP(II) * LOG(PRH(II))**2 * LOG(ZSULF(II)) + &
+ & -3.0640494530822439e-5 * PTEMP(II)**2 * LOG(PRH(II))**2 * LOG(ZSULF(II)) + &
+ & 6.5944609194346214e-8 * PTEMP(II)**3 * LOG(PRH(II))**2 * LOG(ZSULF(II)) + &
+ & (-2.8681650332461055e-2 * LOG(PRH(II))**2 * LOG(ZSULF(II))) / ZAL(II) + &
+ & 6.5213802375160306 * LOG(ZSULF(II))**2 + &
+ & -4.7907162004793016e-2 * PTEMP(II) * LOG(ZSULF(II))**2 + &
+ & -1.0727890114215117e-4 * PTEMP(II)**2 * LOG(ZSULF(II))**2 + &
+ & 5.6401818280534507e-7 * PTEMP(II)**3 * LOG(ZSULF(II))**2 + &
+ & (5.4113070888923009e-1 * LOG(ZSULF(II))**2) / ZAL(II) + &
+ & 5.2062808476476330e-1 * LOG(PRH(II)) * LOG(ZSULF(II))**2 + &
+ & -6.0696882500824584e-3 * PTEMP(II) * LOG(PRH(II)) * LOG(ZSULF(II))**2 + &
+ & 2.3851383302608477e-5 * PTEMP(II)**2 * LOG(PRH(II)) * LOG(ZSULF(II))**2 + &
+ & -1.5243837103067096e-8 * PTEMP(II)**3 * LOG(PRH(II)) * LOG(ZSULF(II))**2 + &
+ & (-5.6543192378015687e-2 * LOG(PRH(II)) * LOG(ZSULF(II))**2) / ZAL(II) + &
+ & -1.1630806410696815e-1 * LOG(ZSULF(II))**3 + &
+ & 1.3806404273119610e-3 * PTEMP(II) * LOG(ZSULF(II))**3 + &
+ & -2.0199865087650833e-6 * PTEMP(II)**2 * LOG(ZSULF(II))**3 + &
+ & -3.0200284885763192e-9 * PTEMP(II)**3 * LOG(ZSULF(II))**3 + &
+ & (-6.9425267104126316e-3 * LOG(ZSULF(II))**3) / ZAL(II)
+ !
+ PJNUCN(II)=MIN(5.0E1,PJNUCN(II))
+ PJNUCN(II)=EXP(PJNUCN(II))
+ !
+ ! 3. Molecules number in the cluster calculation
+ !
+ ZNTOTN(II) = -3.5863435141979573e-3 - &
+ & 1.0098670235841110e-1*PTEMP(II) + &
+ & 8.9741268319259721e-4*PTEMP(II)**2 - &
+ & 1.4855098605195757e-6*PTEMP(II)**3 &
+ & - 1.2080330016937095e-1/ZAL(II) + &
+ & 1.1902674923928015e-3*LOG(PRH(II)) - &
+ & 1.9211358507172177e-2*PTEMP(II)*LOG(PRH(II)) + &
+ & 2.4648094311204255e-4*PTEMP(II)**2*LOG(PRH(II))- &
+ & 7.5641448594711666e-7*PTEMP(II)**3*LOG(PRH(II)) + &
+ & (-2.0668639384228818e-02*LOG(PRH(II)))/ZAL(II) - &
+ & 3.7593072011595188e-2*LOG(PRH(II))**2 + &
+ & 8.0993182774415718e-4*PTEMP(II)*LOG(PRH(II))**2 + &
+ & -9.5698412164297149e-6*PTEMP(II)**2*LOG(PRH(II))**2 + &
+ & 3.7163166416110421e-8*PTEMP(II)**3*LOG(PRH(II))**2 + &
+ & (1.1026579525210847e-2*LOG(PRH(II))**2)/ZAL(II) + &
+ & 1.1530844115561925e-2*LOG(PRH(II))**3 + &
+ & - 1.8083253906466668e-4*PTEMP(II)*LOG(PRH(II))**3 +&
+ & 8.0213604053330654e-7*PTEMP(II)**2*LOG(PRH(II))**3 + &
+ & -8.5797885383051337e-10*PTEMP(II)**3*LOG(PRH(II))**3 + &
+ & (1.0243693899717402e-3*LOG(PRH(II))**3)/ZAL(II) + &
+ & -1.7248695296299649e-2*LOG(ZSULF(II)) + &
+ & 1.1294004162437157e-2*PTEMP(II)*LOG(ZSULF(II)) + &
+ & -1.2283640163189278e-4*PTEMP(II)**2*LOG(ZSULF(II)) + &
+ & 2.7391732258259009e-7*PTEMP(II)**3*LOG(ZSULF(II)) + &
+ & (6.8505583974029602e-2*LOG(ZSULF(II)))/ZAL(II) + &
+ & 2.9750968179523635e-1*LOG(PRH(II))*LOG(ZSULF(II)) + &
+ & -3.6681154503992296e-3*PTEMP(II)*LOG(PRH(II))*LOG(ZSULF(II)) + &
+ & 1.0636473034653114e-5*PTEMP(II)**2*LOG(PRH(II))*LOG(ZSULF(II)) + &
+ & 5.8687098466515866e-9*PTEMP(II)**3*LOG(PRH(II))*LOG(ZSULF(II)) + &
+ & (-5.2028866094191509e-3*LOG(PRH(II))*LOG(ZSULF(II)))/ZAL(II) + &
+ & 7.6971988880587231e-4*LOG(PRH(II))**2*LOG(ZSULF(II)) - &
+ & 2.4605575820433763e-5*PTEMP(II)*LOG(PRH(II))**2*LOG(ZSULF(II)) + &
+ & 2.3818484400893008e-7*PTEMP(II)**2*LOG(PRH(II))**2*LOG(ZSULF(II)) + &
+ & -8.8474102392445200e-10*PTEMP(II)**3*LOG(PRH(II))**2*LOG(ZSULF(II)) + &
+ & (-1.6640566678168968e-4*LOG(PRH(II))**2*LOG(ZSULF(II)))/ZAL(II) - &
+ & 7.7390093776705471e-2*LOG(ZSULF(II))**2 + &
+ & 5.8220163188828482e-4*PTEMP(II)*LOG(ZSULF(II))**2 + &
+ & 1.2291679321523287e-6*PTEMP(II)**2*LOG(ZSULF(II))**2 + &
+ & -7.4690997508075749e-9*PTEMP(II)**3*LOG(ZSULF(II))**2 + &
+ & (-5.6357941220497648e-3*LOG(ZSULF(II))**2)/ZAL(II) + &
+ & -4.7170109625089768e-3*LOG(PRH(II))*LOG(ZSULF(II))**2 + &
+ & 6.9828868534370193e-5*PTEMP(II)*LOG(PRH(II))*LOG(ZSULF(II))**2 + &
+ & -3.1738912157036403e-7*PTEMP(II)**2*LOG(PRH(II))*LOG(ZSULF(II))**2 + &
+ & 2.3975538706787416e-10*PTEMP(II)**3*LOG(PRH(II))*LOG(ZSULF(II))**2 + &
+ & (4.2304213386288567e-4*LOG(PRH(II))*LOG(ZSULF(II))**2)/ZAL(II) + &
+ & 1.3696520973423231e-3*LOG(ZSULF(II))**3 + &
+ & -1.6863387574788199e-5*PTEMP(II)*LOG(ZSULF(II))**3 + &
+ & 2.7959499278844516e-8*PTEMP(II)**2*LOG(ZSULF(II))**3 + &
+ & 3.9423927013227455e-11*PTEMP(II)**3*LOG(ZSULF(II))**3 + &
+ & (8.6136359966337272e-5*LOG(ZSULF(II))**3)/ZAL(II)
+ !
+ ZNTOTN(II)=EXP(ZNTOTN(II))
+ !
+ ! 4. Critical cluster size calculation (in meters)
+ !
+ PRCN(II) = EXP(-22.378268374023630 + 0.44462953606125100 *ZAL(II) + 0.33499495707849131 * LOG(ZNTOTN(II)))
+ !
+ ! 5. Acid molecules in nucleation regime
+ !
+ ZNACN(II) = ZAL(II) * ZNTOTN(II)
+ !
+ IF (ZNACN(II) .lt. 1.) THEN
+ !
+ ! print *, 'Warning: number of acid molecules < 1 in nucleation regime, setting na_n=1'
+ !
+ ZNACN(II)=1.0
+ !
+ END IF
+ !
+ END IF
+ !
+ ! 3. Restrictions for nucleation rates
+ !
+ IF (PJNUCN(II) .LT. 1.0E-7) PJNUCN(II) = 0.0
+ !
+ !
+ END IF
+END DO
+!
+!
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): PRH =',MINVAL(PRH), MAXVAL(PRH)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): PTEMP =',MINVAL(PRH), MAXVAL(PRH)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): ZSULF =',MINVAL(ZSULF), MAXVAL(ZSULF)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): PJNUCN =',MINVAL(PJNUCN), MAXVAL(PJNUCN)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): ZAL =',MINVAL(ZAL), MAXVAL(ZAL)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): ZNTOTN =',MINVAL(ZNTOTN), MAXVAL(ZNTOTN)
+IF (NVERB .GE. 10) WRITE(*,*) '~~ CH_AER_MAATT_NEUT (fin): PRCN =',MINVAL(PRCN), MAXVAL(PRCN)
+!
+RETURN
+!
+END SUBROUTINE CH_AER_MAATTANEN_NEUTRAL
+
diff --git a/src/MNH/ch_aer_mode_merging.f90 b/src/MNH/ch_aer_mode_merging.f90
new file mode 100644
index 000000000..25ef16b27
--- /dev/null
+++ b/src/MNH/ch_aer_mode_merging.f90
@@ -0,0 +1,176 @@
+!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+!! #########################
+ MODULE MODI_CH_AER_MODE_MERGING
+!! #########################
+!!
+INTERFACE
+!!
+ SUBROUTINE CH_AER_MODE_MERGING(PM, PLNSIG, PRG, PDMGROW, PDMMERG)
+ !!
+ IMPLICIT NONE
+ REAL, DIMENSION(:,:), INTENT(IN) :: PM, PLNSIG, PRG
+ REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMGROW
+ REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMMERG
+ !!
+ END SUBROUTINE CH_AER_MODE_MERGING
+!!
+END INTERFACE
+!!
+END MODULE MODI_CH_AER_MODE_MERGING
+!!
+!! ##############################################
+ SUBROUTINE CH_AER_MODE_MERGING(PM, PLNSIG, PRG, PDMGROW, PDMMERG)
+!! ##############################################
+!!
+!! PURPOSE
+!! -------
+!! If the Aitken mode mass is growing faster than accumulation mode
+!! mass and the Aitken mode number concentration exceeds the
+!! accumulation mode number concentration, then moments tendency
+!! are adjusted. In the present developpement only moments 3 and 6
+!! based on the condensated moments are modified.
+!!
+!! METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!! none
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!! USE MODD_CH_AEROSOL
+!!
+!! REFERENCE
+!! ---------
+!! implementation adapted from
+!!
+!! Binkowski and Roselle (2003). Models-3 Community Multiscale Air Quality (CMAQ) model
+!! aerosol component: 1, Model description. J. Geophys. Res., 108(D6), 4183.
+!! doi:10.1029/2001JD001409
+!!
+!! for M3 and M6 tendencies.
+!!
+!! AUTHOR
+!! ------
+!! Joris Pianezze (LACy)
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/2018
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CH_AEROSOL
+USE MODD_CONF, ONLY : NVERB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PM, PLNSIG, PRG
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMGROW
+REAL, DIMENSION(:,:), INTENT(INOUT) :: PDMMERG
+!
+!* 0.2 Declarations of local variables
+!
+INTEGER :: JI,JJ
+REAL :: ZA, ZB, ZC, ZDELTA
+REAL :: ZC3, ZC2, ZC1, ZQ
+REAL :: ZXNUM
+REAL :: ZXM0, ZXM6, ZXM3
+REAL :: ZFNUM, ZFM0, ZFM3, ZFM6
+REAL :: ZPHNUM, ZPHM0, ZPHM3, ZPHM6
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. MODE MERGING
+! ------------
+!
+DO JI=1,SIZE(PM,1)
+ !
+! IF ( PDMGROW( JI , NM3(1) ) .GT. PDMGROW( JI , NM3(2) ) ) THEN
+ !
+ !
+ !* 1.1 CALCULATE XNUM
+ ! --------------
+ !
+ ! Solve equation of Ackermann et al. 1998
+ ! with xnum = ln (d/d_i) / (sqrt(2)*ln(sig_i))
+ !
+ ZC1 = PLNSIG(JI,1) / PLNSIG(JI,2)
+ ZC2 = LOG( PRG(JI,2) / PRG(JI,1) ) / ( SQRT(2.0) * PLNSIG(JI,1) )
+ ZC3 = LOG( ZC1 * PM(JI,NM0(2)) / PM(JI,NM0(1)) )
+ !
+ ! Calculate quadratic equation coefficients & discriminant
+ ! Resolution with Press et al. algorithm : page 208
+ ZA = 1.0 - ZC1 * ZC1
+ ZB = 2.0 * ZC2 * ZC1 * ZC1
+ ZC = ZC3 - ZC2 * ZC2 * ZC1 * ZC1
+ ZDELTA = ZB * ZB - 4.0 * ZA * ZC
+ !
+ ! If roots are imaginary, no mode merging takes place.
+ !
+ IF ( ZDELTA .LT. 0.0 ) THEN
+ ZQ = - 5.0
+ ZXNUM = 0.0
+ ELSE
+ ZQ = - 0.5 * ( ZB + SIGN( 1.0, ZB ) * SQRT( ZDELTA ) )
+ ZXNUM = ZC / ZQ
+ END IF
+ !
+ !-----------------------------------------------------------------------
+ ! Ensure that Xnum is large enough so that no more than half of
+ ! the Aitken mode mass is merged into the accumulation mode during
+ ! any given time step. This criterion is described in Paragraph 26
+ ! of Binkowski and Roselle (2003).
+ !
+ ZXNUM = MAX( ZXNUM, 3.0 * PLNSIG(JI,1) / SQRT(2.0) )
+ !
+ !
+ !* 1.2 MODIFCATION OF MOMENTS TENDENCY
+ ! -------------------------------
+ !
+ ZXM0 = ZXNUM
+ ZXM3 = ZXNUM - 3.0 * PLNSIG(JI,1) / SQRT(2.0)
+ ZXM6 = ZXNUM - 6.0 * PLNSIG(JI,1) / SQRT(2.0)
+ !
+ ! Calculate the fractions of the moments 0, 3 and 6
+ ! distributions with diameter greater than the intersection diameter
+ !
+ ZFM0 = 0.5 * ERFC( ZXM0 ) ! Eq 10a of B&R 2003
+ ZFM3 = 0.5 * ERFC( ZXM3 ) ! Eq 10b of B&R 2003
+ ZFM6 = 0.5 * ERFC( ZXM6 ) ! Adapted to 6th moment
+ !
+ ! Calculate the fractions of the moments 0, 3 and 6
+ ! distributions with diameters less than the intersection diameter.
+ !
+ ZPHM0 = 0.5 * ( 1.0 + ERF( ZXM0 ) ) ! Eq 10c of B&R 2003
+ ZPHM3 = 0.5 * ( 1.0 + ERF( ZXM3 ) ) ! Eq 10d of B&R 2003
+ ZPHM6 = 0.5 * ( 1.0 + ERF( ZXM6 ) ) ! Adapted to 6th moment
+ !
+ ! Update accumulation-mode moment tendencies using
+ ! Equations 11a - 11c of Binkowski and Roselle (2003).
+ !
+ PDMMERG(JI,NM0(2)) = PDMGROW(JI,NM0(1)) * ZFM0
+ PDMMERG(JI,NM3(2)) = PDMGROW(JI,NM3(1)) * ZFM3
+ PDMMERG(JI,NM6(2)) = PDMGROW(JI,NM6(1)) * ZFM6
+ !
+ ! Update Aitken-mode moment tendencies using
+ ! Equations 11d - 11f of Binkowski and Roselle (2003).
+ !
+ PDMMERG(JI,NM0(1)) = PDMGROW(JI,NM0(1)) * (ZPHM0 - 1.0)
+ PDMMERG(JI,NM3(1)) = PDMGROW(JI,NM3(1)) * (ZPHM3 - 1.0)
+ PDMMERG(JI,NM6(1)) = PDMGROW(JI,NM6(1)) * (ZPHM3 - 1.0)
+ !
+! END IF
+ !
+END DO
+!
+END SUBROUTINE CH_AER_MODE_MERGING
diff --git a/src/MNH/ch_aer_vehkamaki.f90 b/src/MNH/ch_aer_vehkamaki.f90
new file mode 100644
index 000000000..1ffc4e276
--- /dev/null
+++ b/src/MNH/ch_aer_vehkamaki.f90
@@ -0,0 +1,216 @@
+!ORILAM_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!ORILAM_LIC This is part of the ORILAM software governed by the CeCILL-C licence
+!ORILAM_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!ORILAM_LIC for details.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/ch_aer_nucl.f90,v $ $Revision: 1.1.4.1.18.1 $
+! MASDEV4_7 chimie 2006/05/18 13:07:25
+!-----------------------------------------------------------------
+!! ################################
+MODULE MODI_CH_AER_VEHKAMAKI
+!! ################################
+!!
+INTERFACE
+ !!
+ SUBROUTINE CH_AER_VEHKAMAKI(PRH,PTEMP,PSULF,PJNUC,PRC)
+ IMPLICIT NONE
+ !!
+ REAL, DIMENSION(:), INTENT(IN) :: PRH, PTEMP, PSULF
+ REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PRC
+ !!
+ END SUBROUTINE CH_AER_VEHKAMAKI
+ !!
+END INTERFACE
+!!
+END MODULE MODI_CH_AER_VEHKAMAKI
+!!
+!! #########################################################################
+SUBROUTINE CH_AER_VEHKAMAKI(PRH,PTEMP,PSULF,PJNUC,PRC)
+!! #########################################################################
+!!
+!! PURPOSE
+!! -------
+!!
+!! Compute nucleation rate for binary sulfate/H2O
+!! This is the Vhekamaki parametrization (2002)
+!!
+!! Valid for :
+!! 230.15 < T < 305.15 (K)
+!! 0.01 < RH < 100 (%)
+!! 10ⴠ< [H2SO4]gas < 10¹¹ (molec/cm3)
+!!
+!!
+!! AUTHOR
+!! ------
+!! B. Foucart (18/06/2018)
+!!
+!! MODIFICATIONS
+!! -------------
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_CONF , ONLY : NVERB
+USE MODD_CH_AEROSOL
+!
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments :
+!
+REAL, DIMENSION(:), INTENT(IN) :: PRH,PTEMP, PSULF
+REAL, DIMENSION(:), INTENT(INOUT) :: PJNUC, PRC ! Nucleation rate (#/cm3/s) , Radius of the critical cluster (nm)
+!
+!* 0.2 Declarations of local variables :
+!
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZCOJA,ZCOJB,ZCOJC,ZCOJD,ZCOJE,ZCOJF,ZCOJG,ZCOJH,ZCOJI,ZCOJJ
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZCOENA,ZCOENB,ZCOENC,ZCOEND,ZCOENE,ZCOENF,ZCOENG,ZCOENH,ZCOENI,ZCOENJ
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZSULF
+REAL, DIMENSION(SIZE(PSULF,1)) :: ZNTOT,ZRC,ZAL
+REAL, PARAMETER :: ZCSTAVOG = 6.0221367E+11 ! Avogadro number
+INTEGER :: II, ITEST
+!
+!----------------------------------------------------------------------------
+!
+! Parameters initialization
+!
+ZSULF(:) = 1.E4 ! must vary between 10E4 and 10E11
+ZAL(:) = 0.17 ! must vary between 0.17 and 0.62
+PJNUC(:) = 1E-7 ! must vary between 10E-7 and 10E9 cm3.s-1
+PRC(:) = 0.35 ! must vary between 0.35 and 0.92 nm
+ZNTOT(:) = 10. ! must vary between 4 and 70 molecules
+ZCOJA(:) = 0.
+ZCOJB(:) = 0.
+ZCOJC(:) = 0.
+ZCOJD(:) = 0.
+ZCOJE(:) = 0.
+ZCOJF(:) = 0.
+ZCOJG(:) = 0.
+ZCOJH(:) = 0.
+ZCOJI(:) = 0.
+ZCOJJ(:) = 0.
+ZCOENA(:) = 0.
+ZCOENB(:) = 0.
+ZCOENC(:) = 0.
+ZCOEND(:) = 0.
+ZCOENE(:) = 0.
+ZCOENF(:) = 0.
+ZCOENG(:) = 0.
+ZCOENH(:) = 0.
+ZCOENI(:) = 0.
+ZCOENJ(:) = 0.
+!
+! **** Define a local variable for PSUFL that we convert in to molec/cm3 for calculations ****
+!
+! a. Restrictions for nucleation
+
+!
+! ZSULF(:) = MAX(MIN(PSULF(:),1.E11), 0.)
+!
+ ZSULF(:) = PSULF(:)
+!
+! b. ZSULF from ug/m3 to molec/cm3
+!
+ ZSULF(:) = ZSULF(:)*ZCSTAVOG / XH2SO4
+!
+!----------------------------------------------------------------------------
+!
+!! **** START Vehkamaki calculations ****
+!
+ITEST = 0.
+!
+! Conditions
+!
+WHERE ((ZSULF(:) > 1.E4 .AND. ZSULF(:) < 1.E11).AND.(PRH(:) > 0.01).AND.(PTEMP(:)>230.15))
+!
+! 1) Mole fraction of H2SO4 in the critical cluster (no unity)
+!
+ZAL(:) = 0.740997-0.00266379*PTEMP(:)-&
+ 0.00349998*LOG(ZSULF(:))+0.0000504022*PTEMP(:)*LOG(ZSULF(:))+&
+ 0.00201048*LOG(PRH(:))-0.000183289*PTEMP(:)*LOG(PRH(:))+&
+ 0.00157407*(LOG(PRH(:)))**2-0.0000179059*PTEMP(:)*(LOG(PRH(:)))**2+&
+ 0.000184403*(LOG(PRH(:)))**3-1.50345E-6*PTEMP(:)*LOG(PRH(:))**3
+!
+! 2) Coefficient calculations for the NUCLEATION RATE (function of temperature and mole fraction)
+!
+ZCOJA(:) = 0.14309+2.21956*PTEMP(:)-0.0273911*(PTEMP(:))**2+&
+ 0.0000722811*(PTEMP(:))**3+(5.91822/ZAL(:))
+!
+ZCOJB(:) = 0.117489+0.462532*PTEMP(:)-0.0118059*(PTEMP(:))**2+&
+ 0.0000404196*(PTEMP(:))**3+(15.7963/ZAL(:))
+!
+ZCOJC(:) = -0.21554-0.0810269*PTEMP(:)+0.001143581*(PTEMP(:))**2-&
+ 4.7758E-6*(PTEMP(:))**3-(2.91297/ZAL(:))
+!
+ZCOJD(:) = -3.58856+0.049508*PTEMP(:)-0.00021382*(PTEMP(:))**2+&
+ 3.10801E-7*(PTEMP(:))**3-(0.0293333/ZAL(:))
+!
+ZCOJE(:) = 1.14598-0.600796*PTEMP(:)+0.00864245*(PTEMP(:))**2-&
+ 0.0000228947*(PTEMP(:))**3-(8.44985/ZAL(:))
+!
+ZCOJF(:) = 2.15855+0.0808121*PTEMP(:)-0.000407382*(PTEMP(:))**2-&
+ 4.01957E-7*(PTEMP(:))**3+(0.721326/ZAL(:))
+!
+ZCOJG(:) = 1.6241-0.0160106*PTEMP(:)+0.0000377124*(PTEMP(:))**2+&
+ 3.21794E-8*(PTEMP(:))**3-(0.0113255/ZAL(:))
+!
+ZCOJH(:) = 9.71682-0.115048*PTEMP(:)+0.000157098*(PTEMP(:))**2+&
+ 4.00914E-7*(PTEMP(:))**3+(0.71186/ZAL(:))
+!
+ZCOJI(:) = -1.05611+0.00903378*PTEMP(:)-0.0000198417*(PTEMP(:))**2+&
+ 2.46048E-8*(PTEMP(:))**3-(0.0579087/ZAL(:))
+!
+ZCOJJ(:) = -0.148712+0.00283508*PTEMP(:)-9.24619E-6*(PTEMP(:))**2+&
+ 5.00427E-9*(PTEMP(:))**3-(0.0127081/ZAL(:))
+!
+! 3) NUCLEATION RATE calculation (part.cm-3.s-1)
+!
+PJNUC(:) = EXP(ZCOJA(:)+ZCOJB(:)*LOG(PRH(:))+&
+ ZCOJC(:)*(LOG(PRH(:)))**2+ZCOJD(:)*(LOG(PRH(:)))**3+&
+ ZCOJE(:)*LOG(ZSULF(:))+ZCOJF(:)*LOG(PRH(:))*LOG(ZSULF(:))+&
+ ZCOJG(:)*(LOG(PRH(:)))**2*LOG(ZSULF(:))+ZCOJH(:)*(LOG(ZSULF(:)))**2+&
+ ZCOJI(:)*LOG(PRH(:))*(LOG(ZSULF(:)))**2+ZCOJJ(:)*(LOG(ZSULF(:)))**3)
+!
+! 4) Coefficient calculations for the MOLECULE NUMBER in the critical cluster (function of temperature and mole fraction)
+!
+ZCOENA(:) = -0.00295413-0.0976834*PTEMP(:)+0.00102485*(PTEMP(:))**2-2.18646E-6*(PTEMP(:))**3-(0.101717/ZAL(:))
+!
+ZCOENB(:) = -0.00205064-0.00758504*PTEMP(:)+0.000192654*(PTEMP(:))**2-6.7043E-7*(PTEMP(:))**3-(0.255774/ZAL(:))
+!
+ZCOENC(:) = 0.00322308+0.000852637*PTEMP(:)-0.0000154757*(PTEMP(:))**2+5.66661E-8*(PTEMP(:))**3+(0.0338444/ZAL(:))
+!
+ZCOEND(:) = 0.0474323-0.000625104*PTEMP(:)+2.65066E-6*(PTEMP(:))**2-3.67471E-9*(PTEMP(:))**3-(0.000267251/ZAL(:))
+!
+ZCOENE(:) = -0.0125211+0.00580655*PTEMP(:)-0.000101674*(PTEMP(:))**2+2.88195E-7*(PTEMP(:))**3+(0.0942243/ZAL(:))
+!
+ZCOENF(:) = -0.038546-0.000672316*PTEMP(:)+2.60288E-6*(PTEMP(:))**2+1.19416E-8*(PTEMP(:))**3-(0.00851515/ZAL(:))
+!
+ZCOENG(:) = -0.0183749+0.000172072*PTEMP(:)-3.71766E-7*(PTEMP(:))**2-5.14875E-10*(PTEMP(:))**3+(0.00026866/ZAL(:))
+!
+ZCOENH(:) = -0.0619974+0.000906958*PTEMP(:)-9.11728E-7*(PTEMP(:))**2-5.36796E-9*(PTEMP(:))**3-(0.00774234/ZAL(:))
+!
+ZCOENI(:) = 0.0121827-0.00010665*PTEMP(:)+2.5346E-7*(PTEMP(:))**2-3.63519E-10*(PTEMP(:))**3+(0.000610065/ZAL(:))
+!
+ZCOENJ(:) = 0.000320184-0.0000174762*PTEMP(:)+6.06504E-8*(PTEMP(:))**2-1.42177E-11*(PTEMP(:))**3+(0.000135751/ZAL(:))
+!
+! 5) MOLECULE NUMBER in the critical cluster calculation (should be between 4
+! and 70)
+!
+ZNTOT(:) = EXP(ZCOENA(:)+ZCOENB(:)*LOG(PRH(:))+ZCOENC(:)*(LOG(PRH(:)))**2+ZCOEND(:)*(LOG(PRH(:)))**3+&
+ ZCOENE(:)*LOG(ZSULF(:))+ZCOENF(:)*LOG(PRH(:))*LOG(ZSULF(:))+ZCOENG(:)*(LOG(PRH(:)))**2*LOG(ZSULF(:))+&
+ ZCOENH(:)*(LOG(ZSULF(:)))**2+ZCOENI(:)*LOG(PRH(:))*(LOG(ZSULF(:)))**2+ZCOENJ(:)*(LOG(ZSULF(:)))**3)
+!
+! 6) Cluster's radius in nm (should be between 0.35 and 0.92)
+!
+PRC(:) = EXP(-1.6524245 + 0.42316402 * ZAL(:) + 0.3346648 * LOG(ZNTOT(:)))
+!
+END WHERE
+
+!
+!
+RETURN
+END SUBROUTINE CH_AER_VEHKAMAKI
diff --git a/src/MNH/ch_meteo_trans_lima.f90 b/src/MNH/ch_meteo_trans_lima.f90
new file mode 100644
index 000000000..42e2a5006
--- /dev/null
+++ b/src/MNH/ch_meteo_trans_lima.f90
@@ -0,0 +1,348 @@
+!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source$ $Revision$ $Date$
+!-----------------------------------------------------------------
+!! ###############################
+ MODULE MODI_CH_METEO_TRANS_LIMA
+!! ###############################
+!!
+!
+INTERFACE
+!!
+SUBROUTINE CH_METEO_TRANS_LIMA(KL, PRHODJ, PRHODREF, PRTSM, PCCTSM, PCRTSM, &
+ PTHT, PABST, KVECNPT, KVECMASK, TPM, KDAY, &
+ KMONTH, KYEAR, PLAT, PLON, PLAT0, PLON0, &
+ OUSERV, OUSERC, OUSERR, KLUOUT, HCLOUD, PTSTEP )
+!
+USE MODD_CH_M9_n, ONLY: METEOTRANSTYPE
+!
+IMPLICIT NONE
+REAL, INTENT(IN), OPTIONAL :: PTSTEP ! Double timestep
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! air density
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRTSM ! moist variables at t or t-dt or water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCTSM ! Cloud water C. at t or t-dt or water m.r.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRTSM ! Rain water C. at t or t-dt or water m.r.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PABST ! theta and pressure at t
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KVECMASK
+!
+TYPE(METEOTRANSTYPE), DIMENSION(:), INTENT(INOUT) :: TPM
+ ! meteo variable for CCS
+INTEGER, INTENT(IN) :: KYEAR ! Current Year
+INTEGER, INTENT(IN) :: KMONTH ! Current Month
+INTEGER, INTENT(IN) :: KDAY ! Current Day
+INTEGER, INTENT(IN) :: KLUOUT ! channel for output listing
+INTEGER, INTENT(IN) :: KL, KVECNPT
+REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON
+REAL, INTENT(IN) :: PLAT0, PLON0
+LOGICAL, INTENT(IN) :: OUSERV, OUSERC, OUSERR
+END SUBROUTINE CH_METEO_TRANS_LIMA
+!!
+END INTERFACE
+!!
+END MODULE MODI_CH_METEO_TRANS_LIMA
+!!
+!! #########################################################################
+SUBROUTINE CH_METEO_TRANS_LIMA(KL, PRHODJ, PRHODREF, PRTSM, PCCTSM, PCRTSM, &
+ PTHT, PABST, KVECNPT, KVECMASK, TPM, KDAY, &
+ KMONTH, KYEAR, PLAT, PLON, PLAT0, PLON0, &
+ OUSERV, OUSERC, OUSERR, KLUOUT, HCLOUD, PTSTEP )
+!! #########################################################################
+!!
+!!*** *CH_METEO_TRANS*
+!!
+!! PURPOSE
+!! -------
+! Transfer of meteorological data, such as temperature, pressure
+! and water vapor mixing ratio for one point into the variable TPM(JM+1)
+! here LWC, LWR and mean radius computed from LIMA or KHKO schemes
+!!
+!! METHOD
+!! ------
+!! For the given grid-point KI,KJ,KK, the meteorological parameters
+!! will be transfered for use by CH_SET_RATES and CH_SET_PHOTO_RATES.
+!! Presently, the variables altitude, air density, temperature,
+!! water vapor mixing ratio, cloud water, longitude, latitude and date
+!! will be transfered. In the chemical definition file (.chf)
+!! these variables have to be transfered into variables like O2, H2O etc.
+!! Also, consistency is checked between the number of
+!! variables expected by the CCS (as defined in the .chf file) and
+!! the number of variables to be transfered here. If you change
+!! the meaning of XMETEOVARS in your .chf file, make sure to modify
+!! this subroutine accordingly.
+!! If the model is run in 1D mode, the model level instead of altitude
+!! is passed. In 2D and 3D, altitude is passed with a negative sign
+!! so that the radiation scheme TUV can make the difference between
+!! model levels and altitude.
+!!
+!! AUTHOR
+!! ------
+!! K. Suhre *Laboratoire d'Aerologie*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 24/05/95
+!! 04/08/96 (K. Suhre) restructured
+!! 21/02/97 (K. Suhre) add XLAT0 and XLON0 for LCARTESIAN=T case
+!! 27/08/98 (P. Tulet) add temperature at t for kinetic coefficient
+!! 09/03/99 (V. Crassier & K. Suhre) vectorization
+!! 09/03/99 (K. Suhre) modification for TUV
+!! 09/03/99 (C. Mari & J. Escobar) Code optimization
+!! 01/12/03 (D. Gazen) change Chemical scheme interface
+!! 01/12/03 (D. Gazen) change Chemical scheme interface
+!! 01/12/04 (P. Tulet) update ch_meteo_transn.f90 for Arome
+!! 01/12/07 (M. Leriche) include rain
+!! 14/05/08 (M. Leriche) include raindrops and cloud droplets mean radius
+!! 05/06/08 (M. Leriche) calculate LWC and LWR in coherence with time spliting scheme
+!! 05/11/08 (M. Leriche) split in two routines for 1-moment and 2-moment cloud schemes
+!!
+!! EXTERNAL
+!! --------
+!! GAMMA : gamma function
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!!
+USE MODD_CH_M9_n, ONLY: NMETEOVARS, &! number of meteorological variables
+ METEOTRANSTYPE !type for meteo . transfer
+!!
+USE MODD_CST, ONLY: XP00, &! Surface pressure
+ XRD, &! R gas constant
+ XCPD !specific heat for dry air
+!!
+USE MODD_CONF, ONLY: LCARTESIAN ! Logical for cartesian geometry
+!!
+USE MODD_PARAM_LIMA, ONLY: XNUC, XALPHAC, & ! Cloud droplets distrib. param.
+ XNUR, XALPHAR, & ! Raindrops distrib. param.
+ XRTMIN, & ! min values of the water m. r.
+ XCTMIN ! min values of the drop C.
+USE MODD_PARAM_LIMA_WARM, ONLY: XLBC, XLBEXC, & !shape param. of the cloud droplets
+ XLBR, XLBEXR !shape param. of the raindrops
+!!
+USE MODI_GAMMA
+!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, INTENT(IN), OPTIONAL :: PTSTEP ! Double timestep
+CHARACTER (LEN=4), INTENT(IN) :: HCLOUD ! Cloud parameterization
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF ! air density
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PRTSM ! moist variables at t or t-dt or water m.r. source
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCCTSM ! Cloud water C. at t or t-dt or water m.r.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRTSM ! Rain water C. at t or t-dt or water m.r.
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PTHT, PABST ! theta and pressure at t
+INTEGER, DIMENSION(:,:), INTENT(IN) :: KVECMASK
+!
+TYPE(METEOTRANSTYPE), DIMENSION(:), INTENT(INOUT) :: TPM
+ ! meteo variable for CCS
+INTEGER, INTENT(IN) :: KYEAR ! Current Year
+INTEGER, INTENT(IN) :: KMONTH ! Current Month
+INTEGER, INTENT(IN) :: KDAY ! Current Day
+INTEGER, INTENT(IN) :: KLUOUT ! channel for output listing
+INTEGER, INTENT(IN) :: KL, KVECNPT
+REAL, DIMENSION(:,:), INTENT(IN) :: PLAT, PLON
+REAL, INTENT(IN) :: PLAT0, PLON0
+LOGICAL, INTENT(IN) :: OUSERV, OUSERC, OUSERR
+!
+!* 0.2 declarations of local variables
+!
+REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3),3) :: ZRTSM
+REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2)) :: ZLAT, ZLON
+REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3)) :: ZCCTSM, ZCRTSM
+REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3)) :: ZRAYC, ZWLBDC, ZWLBDC3
+REAL,DIMENSION(SIZE(PRTSM,1),SIZE(PRTSM,2),SIZE(PRTSM,3)) :: ZRAYR, ZWLBDR, ZWLBDR3
+LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
+INTEGER :: JI,JJ,JK,JM
+INTEGER :: IDTI,IDTJ,IDTK
+!
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. INITIALIZE METEO VARIABLE TRANSFER
+! ----------------------------------
+!
+firstcall : IF (GSFIRSTCALL) THEN
+!
+ GSFIRSTCALL = .FALSE.
+!
+!* 1.1 check if number of variables NMETEOVARS
+! corresponds to what the CCS expects
+!
+ IF (NMETEOVARS /= 13) THEN
+ WRITE(KLUOUT,*) "CH_METEO_TRANS ERROR: number of meteovars to transfer"
+ WRITE(KLUOUT,*) "does not correspond to the number expected by the CCS:"
+ WRITE(KLUOUT,*) " meteovars to transfer: ", 13
+ WRITE(KLUOUT,*) " NMETEOVARS expected: ", NMETEOVARS
+ WRITE(KLUOUT,*) "Check the definition of NMETEOVARS in your .chf file."
+ WRITE(KLUOUT,*) "The program will be stopped now!"
+ STOP 1
+ END IF
+!
+!* 1.2 initialize names of meteo vars
+!
+ TPM(:)%CMETEOVAR(1) = "Model level"
+ TPM(:)%CMETEOVAR(2) = "Air density (kg/m3)"
+ TPM(:)%CMETEOVAR(3) = "Temperature (K)"
+ TPM(:)%CMETEOVAR(4) = "Water vapor (kg/kg)"
+ TPM(:)%CMETEOVAR(5) = "Cloud water (kg/kg)"
+ TPM(:)%CMETEOVAR(6) = "Latitude (rad)"
+ TPM(:)%CMETEOVAR(7) = "Longitude (rad)"
+ TPM(:)%CMETEOVAR(8) = "Current date (year)"
+ TPM(:)%CMETEOVAR(9) = "Current date (month)"
+ TPM(:)%CMETEOVAR(10)= "Current date (day)"
+ TPM(:)%CMETEOVAR(11)= "Rain water (kg/kg)"
+ TPM(:)%CMETEOVAR(12)= "Mean cloud droplets radius (m)"
+ TPM(:)%CMETEOVAR(13)= "Mean raindrops radius (m)"
+!
+ENDIF firstcall
+!
+! "Water vapor (kg/kg)"
+!
+IF (OUSERV) THEN
+! if split option, use tendency
+ IF (PRESENT(PTSTEP)) THEN
+ ZRTSM(:,:,:,1) = (PRTSM(:,:,:, 1)/ PRHODJ(:,:,:))*PTSTEP
+ ELSE
+ ZRTSM(:,:,:,1) = PRTSM(:,:,:, 1)
+ ENDIF
+ELSE
+ ZRTSM(:,:,:,1) = 0.0
+ENDIF
+!
+! "Cloud water (kg/kg)" and "Mean cloud droplets radius (m)"
+!
+IF (OUSERC) THEN
+ IF (PRESENT(PTSTEP)) THEN
+ ZRTSM(:,:,:,2) = (PRTSM(:,:,:, 2)/ PRHODJ(:,:,:))*PTSTEP
+ ZCCTSM(:,:,:) = (PCCTSM(:,:,:)/ PRHODJ(:,:,:))*PTSTEP
+ ELSE
+ ZRTSM(:,:,:,2) = PRTSM(:,:,:, 2)
+ ZCCTSM(:,:,:) = PCCTSM(:,:,:)
+ ENDIF
+ ZWLBDC3(:,:,:) = 1.E30
+ ZWLBDC(:,:,:) = 1.E10
+ ZRAYC(:,:,:) = 10.e-6 ! avoid division by zero
+ WHERE (ZRTSM(:,:,:, 2)>XRTMIN(2) .AND. ZCCTSM(:,:,:)>XCTMIN(2))
+ ZWLBDC3(:,:,:) = XLBC * ZCCTSM(:,:,:) / (PRHODREF(:,:,:) * ZRTSM(:,:,:, 2))
+ ZWLBDC(:,:,:) = ZWLBDC3(:,:,:)**XLBEXC
+ ZRAYC(:,:,:) = 0.5*GAMMA(XNUC+1./XALPHAC)/(GAMMA(XNUC)*ZWLBDC(:,:,:))
+ END WHERE
+ELSE
+ ZRTSM(:,:,:,2) = 0.0
+ ZCCTSM(:,:,:) = 0.0
+ ZRAYC(:,:,:) = 10.e-6 ! avoid division by zero
+ENDIF
+!
+! "Rain water (kg/kg)" and "Mean raindrops radius (m)"
+!
+IF (OUSERR) THEN
+ IF (PRESENT(PTSTEP)) THEN
+ ZRTSM(:,:,:,3) = (PRTSM(:,:,:, 3)/ PRHODJ(:,:,:))*PTSTEP
+ ZCRTSM(:,:,:) = (PCRTSM(:,:,:)/ PRHODJ(:,:,:))*PTSTEP
+ ELSE
+ ZRTSM(:,:,:,3) = PRTSM(:,:,:, 3)
+ ZCRTSM(:,:,:) = PCRTSM(:,:,:)
+ ENDIF
+ ZWLBDR3(:,:,:) = 1.E30
+ ZWLBDR(:,:,:) = 1.E10
+ ZRAYR(:,:,:) = 500.e-6 ! avoid division by zero
+ WHERE (ZRTSM(:,:,:, 3)>XRTMIN(3) .AND. ZCRTSM(:,:,:)>XCTMIN(3))
+ ZWLBDR3(:,:,:) = XLBR * ZCRTSM(:,:,:) / (PRHODREF(:,:,:) * ZRTSM(:,:,:, 3))
+ ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
+ ZRAYR(:,:,:) = 0.5*GAMMA(XNUR+1./XALPHAR)/(GAMMA(XNUR)*ZWLBDR(:,:,:))
+ END WHERE
+ELSE
+ ZRTSM(:,:,:,3) = 0.0
+ ZCRTSM(:,:,:) = 0.0
+ ZRAYR(:,:,:) = 500.e-6 ! avoid division by zero
+ENDIF
+
+IF(LCARTESIAN) THEN
+! "Latitude (rad)"
+ ZLAT(:,:) = PLAT0
+! "Longitude (rad)"
+ ZLON(:,:) = PLON0
+ELSE
+! "Latitude (rad)"
+ ZLAT(:,:) = PLAT(:,:)
+! "Longitude (rad)"
+ ZLON(:,:) = PLON(:,:)
+END IF
+!!
+!* 2. TRANSFER METEO VARIABLES
+! ------------------------
+!
+IDTI=KVECMASK(2,KL)-KVECMASK(1,KL)+1
+IDTJ=KVECMASK(4,KL)-KVECMASK(3,KL)+1
+IDTK=KVECMASK(6,KL)-KVECMASK(5,KL)+1
+!Vectorization:
+!ocl novrec
+!cdir nodep
+DO JM=0,KVECNPT-1
+ JI=JM-IDTI*(JM/IDTI)+KVECMASK(1,KL)
+ JJ=JM/IDTI-IDTJ*(JM/(IDTI*IDTJ))+KVECMASK(3,KL)
+ JK=JM/(IDTI*IDTJ)-IDTK*(JM/(IDTI*IDTJ*IDTK))+KVECMASK(5,KL)
+!
+!"Model Altitude"
+!
+ TPM(JM+1)%XMETEOVAR(1) = JK-1 ! assuming first model level is level 2
+! TPM(JM+1)%XMETEOVAR(1) = JK ! assuming first model level is level 1
+!
+! "Air density (kg/m3)"
+!
+ TPM(JM+1)%XMETEOVAR(2) = PRHODREF(JI, JJ, JK)
+!
+! "Temperature (K)"
+!
+ TPM(JM+1)%XMETEOVAR(3) = PTHT(JI,JJ,JK)*((PABST(JI,JJ,JK)/XP00)**(XRD/XCPD))
+!
+! "Water vapor (kg/kg)"
+!
+ TPM(JM+1)%XMETEOVAR(4) = ZRTSM(JI, JJ, JK, 1)
+!
+! "Cloud water (kg/kg)"
+!
+ TPM(JM+1)%XMETEOVAR(5) = ZRTSM(JI, JJ, JK, 2)
+!
+! "Latitude (rad)"
+!
+ TPM(JM+1)%XMETEOVAR(6) = ZLAT(JI, JJ)
+!
+! "Longitude (rad)"
+!
+ TPM(JM+1)%XMETEOVAR(7) = ZLON(JI, JJ)
+!
+! "Current date"
+!
+ TPM(JM+1)%XMETEOVAR(8) = FLOAT(KYEAR)
+ TPM(JM+1)%XMETEOVAR(9) = FLOAT(KMONTH)
+ TPM(JM+1)%XMETEOVAR(10)= FLOAT(KDAY)
+!
+! "Rain water (kg/kg)"
+!
+ TPM(JM+1)%XMETEOVAR(11) = ZRTSM(JI, JJ, JK, 3)
+!
+! "Mean cloud droplets radius (m)"
+!
+ TPM(JM+1)%XMETEOVAR(12) = ZRAYC(JI, JJ, JK)
+!
+! "Mean raindrops radius (m)"
+!
+ TPM(JM+1)%XMETEOVAR(13) = ZRAYR(JI, JJ, JK)
+!
+ENDDO
+!
+END SUBROUTINE CH_METEO_TRANS_LIMA
diff --git a/src/MNH/coupling_dmsn.F90 b/src/MNH/coupling_dmsn.F90
new file mode 100644
index 000000000..f9804bd58
--- /dev/null
+++ b/src/MNH/coupling_dmsn.F90
@@ -0,0 +1,58 @@
+SUBROUTINE COUPLING_DMS_n(KI,& !! number of sea points
+ PWIND, & !! wind (m s-1)
+ PSST,& !! sea surface temperature (K)
+ DMS_OCEANIC,& !! DMS oceanic content (mol m-3)
+ PSFDMS) !! DMS emssion flux (mol m-2 s-1)
+!
+ implicit none
+
+integer, intent(in) :: KI !! number of sea points
+real,dimension(KI), intent(in) :: PWIND !! wind (m s-1)
+real, dimension(KI), intent(in) :: PSST !! sea surface temperature (K)
+real, dimension(KI), intent(in) :: DMS_OCEANIC !! DMS ocenanic content (mol m-3)
+real,dimension(KI), intent(out) :: PSFDMS !! DMS emission flux (mol m-2 s-1)
+
+!!! local variables
+
+real,dimension(KI) :: sc_dms !! Schmidt number for DMS
+real,parameter :: sc_co2 = 600. !! Schmidt number for CO2
+real,dimension(KI) :: zsst !! sea surface temperature (°C)
+real,dimension(KI) :: k600 !! standard air-sea exchange coefficient for CO2 (m s-1)
+real,dimension(KI) :: k_dms !! air-sea exchange coefficient for DMS (m s-1)
+
+! sea surface temperature (in °C) must be comprised between 5 and 30 °C
+
+ZSST(:) = PSST(:) - 273.15
+where (ZSST(:) < 5.)
+ ZSST(:) = 5.
+endwhere
+
+where (ZSST(:) > 30.)
+ ZSST(:) = 30.
+endwhere
+
+
+! Schmidt number for DMS, using the sst in celsius, from
+! Saltzman et al., 1993 (without unit)
+
+sc_dms(:) = 2674.0 - (147.12*ZSST(:)) + (3.726*(ZSST(:)**2.0)) - (0.038*(ZSST(:)**3.0))
+
+! k600: Sea - air exchange coefficient from Nightingale et al. 2000 (in cm/hour)
+! k600 is the standard air-sea exchange coefficient for CO2 gas, related to
+! a Schmidt number of 600
+
+k600(:) = 0.222*(PWIND(:)**2.0) + 0.333*PWIND(:)
+! conversion into m s-1
+k600(:) = k600(:) *1.0e-2/3600.
+
+
+! k_dms : air-sea exchange coefficient for DMS in m s-1
+
+k_dms(:) = k600(:)*(sc_dms(:)/sc_co2)**(-0.5)
+
+! DMS emsission flux in mol m-2 s-1
+
+PSFDMS(:) = k_dms(:) * DMS_OCEANIC(:)
+
+END SUBROUTINE COUPLING_DMS_n
+
diff --git a/src/MNH/dustcamsn.f90 b/src/MNH/dustcamsn.f90
new file mode 100644
index 000000000..33966adfd
--- /dev/null
+++ b/src/MNH/dustcamsn.f90
@@ -0,0 +1,214 @@
+
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/dustlfin.f90,v $ $Revision: 1.1.2.2.2.1.2.1 $
+! MASDEV4_7 newsrc 2007/01/25 13:13:15
+!-----------------------------------------------------------------
+! ########################
+ MODULE MODI_DUSTCAMS_n
+! ########################
+!
+INTERFACE
+!
+SUBROUTINE DUSTCAMS_n(PSV, PMASSCAMS, PRHODREF)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PSV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMASSCAMS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+END SUBROUTINE DUSTCAMS_n
+!
+END INTERFACE
+!
+END MODULE MODI_DUSTCAMS_n
+!
+!
+! ############################################################
+ SUBROUTINE DUSTCAMS_n(PSV, PMASSCAMS,PRHODREF)
+! ############################################################
+!
+!! PURPOSE
+!! -------
+!! Initialise le champs de dusts à partir des analyses CAMS
+!!
+!! REFERENCE
+!! ---------
+!! none
+!!
+!! AUTHOR
+!! ------
+!! Pierre TULET (LACy)
+!!
+!! MODIFICATIONS
+!! -------------
+!! none
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DUST
+USE MODD_NSV
+USE MODD_CSTS_DUST
+USE MODE_DUST_PSD
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV
+REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PMASSCAMS
+REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF
+!
+!
+!* 0.2 declarations local variables
+!
+REAL :: ZDEN2MOL, ZRHOI, ZMI, ZFAC, ZRGMIN
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZCTOTA
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMA
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZMASS
+INTEGER,DIMENSION(:), ALLOCATABLE :: IM0, IM3, IM6
+REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN
+REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS, ZINISIGMA
+REAL :: ZRHOMIN
+INTEGER :: IKU, IMOMENTS
+INTEGER :: JJ, JN, JK ! loop counter
+INTEGER :: IMODEIDX ! index mode
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. TRANSFER FROM GAS TO AEROSOL MODULE
+! -----------------------------------
+!
+! 1.1 initialisation
+!
+IKU = SIZE(PSV,3)
+ZRHOMIN=MINVAL(PRHODREF)
+!
+ALLOCATE (IM0(NMODE_DST))
+ALLOCATE (IM3(NMODE_DST))
+ALLOCATE (IM6(NMODE_DST))
+ALLOCATE (ZCTOTA(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_DST))
+ALLOCATE (ZM(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_DST*3))
+ALLOCATE (ZSIGMA(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3)))
+ALLOCATE (ZINIRADIUS(NMODE_DST))
+ALLOCATE (ZINISIGMA(NMODE_DST))
+ALLOCATE (ZMMIN(NMODE_DST*3))
+ALLOCATE (ZMASS(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3),NMODE_DST))
+!
+!
+DO JN = 1, NMODE_DST
+ IM0(JN) = 1 + (JN - 1) * 3
+ IM3(JN) = 2 + (JN - 1) * 3
+ IM6(JN) = 3 + (JN - 1) * 3
+ !
+ !Get the dust mode we are talking about, MODE 2 is treated first, then mode 3, then 1
+ !This index is only needed to get the right radius out of the XINIRADIUS array and the
+ !right XINISIG out of the XINISIG-array
+ IMODEIDX = JPDUSTORDER(JN)
+ !
+ !Convert initial mass median radius to number median radius
+ IF (CRGUNITD=="MASS") THEN
+ ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX) * EXP(-3.*(LOG(XINISIG(IMODEIDX)))**2)
+ ELSE
+ ZINIRADIUS(JN) = XINIRADIUS(IMODEIDX)
+ END IF
+ ZINISIGMA(JN) = XINISIG(IMODEIDX)
+ !
+ ZMMIN(IM0(JN)) = XN0MIN(IMODEIDX)
+ ZRGMIN = ZINIRADIUS(JN)
+ ZMMIN(IM3(JN)) = XN0MIN(IMODEIDX) * (ZRGMIN**3)*EXP(4.5 * LOG(ZINISIGMA(JN))**2)
+ ZMMIN(IM6(JN)) = XN0MIN(IMODEIDX) * (ZRGMIN**6)*EXP(18. * LOG(ZINISIGMA(JN))**2)
+
+ IF (JPDUSTORDER(JN) == 1) ZMASS(:,:,:,JN) = PMASSCAMS(:,:,:,1) ! fin mode
+ IF (JPDUSTORDER(JN) == 2) ZMASS(:,:,:,JN) = PMASSCAMS(:,:,:,2) ! median mode
+ IF (JPDUSTORDER(JN) == 3) ZMASS(:,:,:,JN) = PMASSCAMS(:,:,:,3) ! large mode
+
+ENDDO
+
+ZMASS(:,:,:,:) = MAX(ZMASS(:,:,:,:), 1E-40)
+!
+!
+ZRHOI = XDENSITY_DUST !1.8e3 !++changed alfgr
+ZMI = XMOLARWEIGHT_DUST
+ZDEN2MOL = 1E-6 * XAVOGADRO / XMD
+ZFAC = (4. / 3.) * XPI * ZRHOI * 1.e-9
+
+!
+DO JN = 1, NMODE_DST
+
+!* 1.1 calculate moment 0 from ZMASS
+!
+ ZM(:,:,:,IM0(JN)) = ZMASS(:,:,:,JN) &![kg_{dust}/kg_{air}
+ / XDENSITY_DUST &![kg__{dust}/m3_{dust}==>m3_{dust}/m3{air}
+ * (6.d0 / XPI) &
+ / (2.d0 * ZINIRADIUS(JN) * 1.d-6)**3 &![particle/m_dust^{-3}]==> particle/m3
+ * EXP(-4.5*(LOG(ZINISIGMA(JN)))**2) !Take into account distribution
+!
+ ZM(:,:,:,IM0(JN)) = MAX(ZMMIN(IM0(JN)), ZM(:,:,:,IM0(JN)))
+!
+!* 1.2 calculate moment 3 from m0, RG and SIG
+!
+ ZM(:,:,:,IM3(JN)) = ZM(:,:,:,IM0(JN)) * &
+ (ZINIRADIUS(JN)**3) * &
+ EXP(4.5*LOG(ZINISIGMA(JN))**2)
+
+ ZM(:,:,:,IM3(JN)) = MAX(ZMMIN(IM3(JN)), ZM(:,:,:,IM3(JN)))
+!
+!* 1.3 calculate moment 6 from m0, RG and SIG
+!
+ ZM(:,:,:,IM6(JN))= ZM(:,:,:,IM0(JN)) * ((ZINIRADIUS(JN)**6) * &
+ EXP(18.*(LOG(ZINISIGMA(JN)))**2))
+!
+ ZM(:,:,:,IM6(JN)) = MAX(ZMMIN(IM6(JN)), ZM(:,:,:,IM6(JN)))
+!
+!* 1.4 output concentration
+!
+ IMOMENTS = INT(NSV_DSTEND - NSV_DSTBEG+1) / NMODE_DST
+ IF (IMOMENTS == 3) THEN
+ PSV(:,:,:,1+(JN-1)*3) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:))
+ XSVMIN(NSV_DSTBEG-1+1+(JN-1)*3) = ZMMIN(IM0(JN)) * XMD / (XAVOGADRO*ZRHOMIN)
+
+ PSV(:,:,:,2+(JN-1)*3) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. * ZRHOI / &
+ (ZMI*XM3TOUM3*PRHODREF(:,:,:))
+ XSVMIN(NSV_DSTBEG-1+2+(JN-1)*3) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / &
+ (ZMI*XM3TOUM3**ZRHOMIN)
+
+ PSV(:,:,:,3+(JN-1)*3) = ZM(:,:,:,IM6(JN)) * XMD / (XAVOGADRO*1.d-6*PRHODREF(:,:,:))
+ XSVMIN(NSV_DSTBEG-1+3+(JN-1)*3) = ZMMIN(IM6(JN)) * XMD / (XAVOGADRO*1.d-6* ZRHOMIN)
+
+ ELSE IF (IMOMENTS == 2) THEN
+ PSV(:,:,:,1+(JN-1)*2) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:))
+ XSVMIN(NSV_DSTBEG-1+1+(JN-1)*2) = ZMMIN(IM0(JN)) * XMD / (XAVOGADRO*ZRHOMIN)
+
+ PSV(:,:,:,2+(JN-1)*2) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. * ZRHOI / &
+ (ZMI*XM3TOUM3*PRHODREF(:,:,:))
+ XSVMIN(NSV_DSTBEG-1+2+(JN-1)*2) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / &
+ (ZMI*XM3TOUM3**ZRHOMIN)
+ ELSE
+ PSV(:,:,:,JN) = ZM(:,:,:,IM3(JN)) * XMD*XPI * 4./3. * ZRHOI / &
+ (ZMI*XM3TOUM3*PRHODREF(:,:,:))
+ XSVMIN(NSV_DSTBEG-1+JN) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / &
+ (ZMI*XM3TOUM3**ZRHOMIN)
+
+ END IF
+END DO
+
+!
+DEALLOCATE(ZMMIN)
+DEALLOCATE(ZINISIGMA)
+DEALLOCATE(ZINIRADIUS)
+DEALLOCATE(ZSIGMA)
+DEALLOCATE(ZM)
+DEALLOCATE(ZCTOTA)
+DEALLOCATE(IM6)
+DEALLOCATE(IM3)
+DEALLOCATE(IM0)
+DEALLOCATE(ZMASS)
+!
+END SUBROUTINE DUSTCAMS_n
diff --git a/src/MNH/emproc.F90 b/src/MNH/emproc.F90
new file mode 100644
index 000000000..7cb60b64f
--- /dev/null
+++ b/src/MNH/emproc.F90
@@ -0,0 +1,292 @@
+
+SUBROUTINE EMPROC(KTIME, KDATE, PPFD24, T24, PDI, PRECADJ, &
+ PLAT, PLONG, PLAIP, PLAIC, PTEMP, PPFD, &
+ PWIND, PRES, PQV, KSLTYP, PSOILM, PSOILT, &
+ PFTF, OSOIL, PCFNO, PCFNOG, PCFSPEC )
+
+!***********************************************************************
+! THIS PROGRAM COMPUTES BIOGENIC EMISSION USING INPUT EMISSION
+! CAPACITY MAPS AND MCIP OUTPUT VARIABLES.
+! THE EMISSION CAPACITY MAP (INPNAME) ARE GRIDDED IN NETCDF-IOAPI FORMAT
+! WITH ALL THE DAILY AVERAGE PPFD AND DAILY AVERAGE TEMPERATURE.
+!
+! NOTE: THE PROJECTION AND INPUT GRIDS OF THE TWO FILES MUST BE
+! IDENTICAL.
+!
+!
+! CALL:
+! CHECKMEM
+! MODULE GAMMA_ETC
+! GAMMA_LAI
+! GAMMA_P
+! GAMMA_TLD
+! GAMMA_TLI
+! GAMMA_A
+! GAMMA_S
+!
+! HISTORY:
+! CREATED BY JACK CHEN 11/04
+! MODIFIED BY TAN 11/21/06 FOR MEGAN V2.0
+! MODIFIED BY XUEMEI WANG 11/04/2007 FOR MEGAN2.1
+! MODIFIED BY JULIA LEE-TAYLOR 03/18/2008 FOR MEGAN2.1
+! MODIFIED BY XUEMEI WANG 09/30/2008 FOR MEGAN2.1
+! MODIFIED BY TAN 07/28/2011 FOR MEGAN2.1
+! MODIFIED BY P. TULET 01/11/2014 FOR COUPLING WITH ISBA (MESONH)
+! MODIFIED BY J. PIANEZZEJ 13/02/2019 BUG in FARCE case
+!
+!***********************************************************************
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! SCIENTIFIC ALGORITHM
+!
+! EMISSION = [EF][GAMMA][RHO]
+! WHERE [EF] = EMISSION FACTOR (UG/M2H)
+! [GAMMA] = EMISSION ACTIVITY FACTOR (NON-DIMENSION)
+! [RHO] = PRODUCTION AND LOSS WITHIN PLANT CANOPIES
+! (NON-DIMENSIONAL)
+! ASSUMPTION: [RHO] = 1 (11/27/06) (SEE PDT_LOT_CP.EXT)
+!
+! GAMMA = [GAMMA_CE][GAMMA_AGE][GAMMA_SM]
+! WHERE [GAMMA_CE] = CANOPY CORRECTION FACTOR
+! [GAMMA_AGE] = LEAF AGE CORRECTION FACTOR
+! [GAMMA_SM] = SOIL MOISTURE CORRECTION FACTOR
+! ASSUMPTION: [GAMMA_SM] = 1 (11/27/06)
+
+! GAMMA_CE = [GAMMA_LAI][GAMMA_P][GAMMA_T]
+! WHERE [GAMMA_LAI] = LEAF AREA INDEX FACTOR
+! [GAMMA_P] = PPFD EMISSION ACTIVITY FACTOR
+! [GAMMA_T] = TEMPERATURE RESPONSE FACTOR
+!
+! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE]
+! DERIVATION:
+! EMISSION = [EF][GAMMA](1-LDF) + [EF][GAMMA][LDF][GAMMA_P]
+! EMISSION = [EF][GAMMA]{ (1-LDF) + [LDF][GAMMA_P] }
+! EMISSION = [EF][GAMMA]{ (1-LDF) + [LDF][GAMMA_P] }
+! WHERE LDF = LIGHT DEPENDENT FUNCTION (NON-DIMENSION)
+! (SEE LD_FCT.EXT)
+!
+! FINAL EQUATION
+! EMISSION = [EF][GAMMA_LAI][GAMMA_AGE]*
+! { (1-LDF)[GAMMA_TLI] + [LDF][GAMMA_P][GAMMA_TLD] } !FOR MEGAN2.1 ZER(:) = ZGAM_AGE * ZGAM_SMT * ZRHO * ((1.-ZLDF) * ZGAM_TLI * ZGAM_LHT + ZLDF * ZGAM_TLD)
+! WHERE GAMMA_TLI IS LIGHT INDEPENDENT
+! GAMMA_TLD IS LIGHT DEPENDENT
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+USE MODD_MEGAN
+
+USE MODI_INDEX1
+USE MODI_SOILNOX
+!
+USE MODE_MEGAN
+USE MODE_GAMMA_ETC ! MODULE CONTAINING GAMMA FUNCTIONS
+!
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: KTIME !I TIME OF THE DAY HHMMSS
+INTEGER, INTENT(IN) :: KDATE !I DATE YYYYDDD
+!
+!REAL, INTENT(IN) :: PPFD_D !I DAILY PAR (UMOL/M2.S)
+REAL, DIMENSION(:), INTENT(IN) :: T24, PPFD24 !I DAILY TEMPERATURE (K)
+REAL, INTENT(IN) :: PDI !I DROUGHT INDEX (0 NORMAL, -2 MODERATE DROUGHT, -3 SEVERE DROUGHT, -4 EXTREME DROUGHT)
+REAL, INTENT(IN) :: PRECADJ !I RAIN ADJUSTMENT FACTOR
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLAT !I LATITUDE OF GRID CELL
+REAL, DIMENSION(:), INTENT(IN) :: PLONG !I LONGITUDE OF GRID CELL
+REAL, DIMENSION(:), INTENT(IN) :: PLAIP !I PREVIOUS MONTHLY LAI
+REAL, DIMENSION(:), INTENT(IN) :: PLAIC !I CURRENT MONTHLY LAI
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP !I TEMPERATURE (K)
+REAL, DIMENSION(:), INTENT(INOUT) :: PPFD !I CALCULATED PAR (UMOL/M2.S)
+REAL, DIMENSION(:), INTENT(IN) :: PWIND !I WIND VELOCITY (M/S)
+REAL, DIMENSION(:), INTENT(IN) :: PRES !I ATMOSPHERIC PRESSURE (PA)
+REAL, DIMENSION(:), INTENT(IN) :: PQV !I AIR HUMIDITY (KG/KG)
+INTEGER,DIMENSION(:),INTENT(IN) :: KSLTYP !I SOIL CATEGORY (FUNCTION OF SILT, CLAY AND SAND))
+REAL, DIMENSION(:), INTENT(IN) :: PSOILM !I SOIL MOISTURE (M3/M3)
+REAL, DIMENSION(:), INTENT(IN) :: PSOILT !I SOIL TEMPERATURE (K)
+REAL, DIMENSION(:,:),INTENT(IN) :: PFTF ! PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM)
+LOGICAL, INTENT(IN) :: OSOIL !I LOGICAL FOR ACTIVE NO CORRECTION FACTOR
+REAL, DIMENSION(:), INTENT(INOUT) :: PCFNO !O NO CORRECTION FACTOR
+REAL, DIMENSION(:), INTENT(INOUT) :: PCFNOG !O NO CORRECTION FACTOR FOR GRASS
+REAL, DIMENSION(:,:),INTENT(INOUT) :: PCFSPEC !O OUTPUT EMISSION BUFFER
+
+! LOCAL VARIABLES AND THEIR DESCRIPTIONS:
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_LHT ! LAI CORRECTION FACTOR
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_AGE ! LEAF AGE CORRECTION FACTOR
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_SMT ! SOIL MOISTURE CORRECTION FACTOR
+REAL, DIMENSION(SIZE(PSOILM)) :: ZER ! EMISSION BUFFER
+! NUMBER OF LAT, LONG, AND PFT FACTOR VARIABLES
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_TLD
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAM_TLI
+!
+CHARACTER(LEN=100), DIMENSION(N_MGN_SPC+7) :: YVNAME3D
+!
+REAL, DIMENSION(SIZE(PSOILM)) :: ZADJUST_FACTOR_LD, ZADJUST_FACTOR_LI
+REAL, DIMENSION(SIZE(PSOILM)) :: ZGAMMA_TD, ZGAMMA_TI, ZTOTALPFT
+
+REAL :: ZLDF ! LIGHT DEPENDENT FACTOR
+REAL :: ZRHO ! PRODUCTION AND LOSS WITHIN CANOPY
+!REAL :: ZPFD_D
+!
+INTEGER :: I_PFT
+INTEGER :: ILAIP_DY, ILAIP_HR, ILAIC_DY, ILAIC_HR
+INTEGER :: IMXPFT, IMXLAI
+
+! LOOP INDICES
+INTEGER :: JT, JS, JI, JJ , JK, JN, INP, JL ! COUNTERS
+INTEGER :: INMAP ! INDEX
+INTEGER :: INVARS3D
+
+!***********************************************************************
+
+!--=====================================================================
+!... BEGIN PROGRAM
+!--=====================================================================
+
+!-----------------------------------------------------------------------
+!.....1) INITIALIZATION
+!-----------------------------------------------------------------------
+!
+
+INVARS3D = N_MGN_SPC + 7
+!
+DO JS = 1,N_MGN_SPC
+ YVNAME3D(JS) = TRIM( CMGN_SPC(JS) )
+! VDESC3D(S) = 'ENVIRONMENTAL ACTIVITY FACTOR FOR '//
+! & TRIM( MGN_SPC(S) )
+! UNITS3D(S) = 'NON-DIMENSION '
+! VTYPE3D(S) = M3REAL
+ENDDO
+
+YVNAME3D(N_MGN_SPC+1) = 'D_TEMP'
+! UNITS3D(N_MGN_SPC+1) = 'K'
+! VTYPE3D(N_MGN_SPC+1) = M3REAL
+! VDESC3D(N_MGN_SPC+1) = 'VARIABLE '//'K'
+
+YVNAME3D(N_MGN_SPC+2) = 'D_PPFD'
+! UNITS3D(N_MGN_SPC+2) = 'UMOL/M2.S'
+! VTYPE3D(N_MGN_SPC+2) = M3REAL
+! VDESC3D(N_MGN_SPC+2) = 'VARIABLE '//'UMOL/M2.S'
+
+YVNAME3D(N_MGN_SPC+3) = 'LAT'
+! UNITS3D(N_MGN_SPC+3) = ' '
+! VTYPE3D(N_MGN_SPC+3) = M3REAL
+! VDESC3D(N_MGN_SPC+3) = ' '
+
+YVNAME3D(N_MGN_SPC+4) = 'LONG'
+! UNITS3D(N_MGN_SPC+4) = ' '
+! VTYPE3D(N_MGN_SPC+4) = M3REAL
+! VDESC3D(N_MGN_SPC+4) = ' '
+
+YVNAME3D(N_MGN_SPC+5) = 'CFNO'
+! UNITS3D(N_MGN_SPC+5) = ' '
+! VTYPE3D(N_MGN_SPC+5) = M3REAL
+! VDESC3D(N_MGN_SPC+5) = ' '
+
+YVNAME3D(N_MGN_SPC+6) = 'CFNOG'
+! UNITS3D(N_MGN_SPC+6) = ' '
+! VTYPE3D(N_MGN_SPC+6) = M3REAL
+! VDESC3D(N_MGN_SPC+6) = ' '
+
+YVNAME3D(N_MGN_SPC+7) = 'SLTYP'
+! UNITS3D(N_MGN_SPC+7) = ' '
+! VTYPE3D(N_MGN_SPC+7) = M3INT
+! VDESC3D(N_MGN_SPC+7) = ' '
+
+!-----------------------------------------------------------------------
+!.....2) PROCESS EMISSION RATES
+!-----------------------------------------------------------------------
+!
+INP = SIZE(PLAT)
+!
+! ************************************************************************************************
+
+! PPFD: SRAD - SHORT WAVE FROM SUN (W/M2)
+! ASSUMING 4.766 (UMOL M-2 S-1) PER (W M-2)
+! ASSUME 1/2 OF SRAD IS IN 400-700NM BAND
+!D_PPFD = D_PPFD * 4.766 * 0.5
+! UPG PT bug: SURFEX give PAR in UMOL M-2 S-1 : comment the lines above
+!ZPFD_D = PPFD_D * 4.5 * 0.5
+
+!ZPFD_D = PPFD24
+
+!PPFD = PPFD * 4.5
+!UPG PT end bug
+! *****************************************************************************************
+
+! GO OVER ALL THE CHEMICAL SPECIES
+DO JS = 1, N_MGN_SPC
+
+ ! INITIALIZE VARIABLES
+ ZER = 0.
+ ZGAM_LHT = 1.
+ ZGAM_AGE = 1.
+ ZGAM_SMT = 1.
+ ZGAM_TLD = 1.
+ ZGAM_TLI = 1.
+
+ PCFNO = 1.
+ PCFNOG = 1.
+
+ CALL GAMMA_LAI(PLAIC, ZGAM_LHT)
+
+! IF (JS == 1) print*, "ZGAM_LHT", ZGAM_LHT
+
+ CALL GAMMA_A(KDATE, KTIME, NTSTLEN, YVNAME3D(JS), T24, PLAIP, PLAIC, ZGAM_AGE)
+
+! IF (JS == 1) print*, "ZGAM_AGE", ZGAM_AGE
+
+ CALL GAMMA_S(ZGAM_SMT)
+
+ ZADJUST_FACTOR_LD(:) = 0.0
+ ZADJUST_FACTOR_LI(:) = 0.0
+ ZGAMMA_TD(:) = 0.0
+ ZGAMMA_TI(:) = 0.0
+ ZTOTALPFT(:) = 0.0
+
+ DO I_PFT = 1,N_MGN_PFT !CANOPY TYPES
+ ZTOTALPFT(:) = ZTOTALPFT(:) + PFTF(I_PFT,:) * 0.01 !!la division par 100 ZTOTALPFT(:) = ZTOTALPFT(:) + PFTF(I_PFT,:) * 0.01
+ ENDDO ! ENDDO I_PFT
+
+ DO I_PFT = 1,N_MGN_PFT !CANOPY TYPES
+
+ CALL GAMME_CE(KDATE, KTIME, XCANOPYCHAR, I_PFT, YVNAME3D(JS), &
+ PPFD24, PPFD24, T24, T24, PDI, &
+ PPFD, PLAT, PLONG, PTEMP, PWIND, PQV, PLAIC, &
+ PRES, ZGAMMA_TD, ZGAMMA_TI)
+
+ ZADJUST_FACTOR_LD(:) = ZADJUST_FACTOR_LD(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TD(:) !!ZADJUST_FACTOR_LD(:) = ZADJUST_FACTOR_LD(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TD(:)
+ ZADJUST_FACTOR_LI(:) = ZADJUST_FACTOR_LI(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TI(:) !! attention le 0.01 ZADJUST_FACTOR_LI(:) = ZADJUST_FACTOR_LI(:) + 0.01 * PFTF(I_PFT,:) * ZGAMMA_TI(:)
+ ENDDO ! ENDDO I_PFT
+
+ WHERE (ZTOTALPFT(:).GT.0.)
+ ZGAM_TLD(:) = ZADJUST_FACTOR_LD(:) / ZTOTALPFT(:)
+ ZGAM_TLI(:) = ZADJUST_FACTOR_LI(:) / ZTOTALPFT(:)
+ ELSEWHERE
+ ZGAM_TLD(:) = 1.
+ ZGAM_TLI(:) = 1.
+ END WHERE
+
+ !IF (JS == 1) print*, "ZGAM_TLD(:)", ZGAM_TLD(:)
+
+ INMAP = INDEX1(YVNAME3D(JS), CMGN_SPC)
+ ZLDF = XLDF_FCT(INMAP)
+ INMAP = INDEX1(YVNAME3D(JS), CMGN_SPC)
+ ZRHO = XMGN_MWT(INMAP)
+
+
+!... CALCULATE EMISSION
+ ZER(:) = ZGAM_AGE * ZGAM_SMT * ZRHO * ((1.-ZLDF) * ZGAM_TLI * ZGAM_LHT + ZLDF * ZGAM_TLD)
+ WHERE( ZER(:).GT.0. )
+ PCFSPEC(JS,:) = ZER(:)
+ ELSEWHERE
+ PCFSPEC(JS,:) = 0.0
+ END WHERE
+
+ENDDO
+
+!... ESTIATE CFNO AND CFNOG
+CALL SOILNOX(KDATE, KTIME, OSOIL, KSLTYP, PRECADJ, &
+ PLAT, PTEMP, PSOILM, PSOILT, PLAIC, PCFNO, PCFNOG )
+
+!--=====================================================================
+END SUBROUTINE EMPROC
+
diff --git a/src/MNH/mgn2mech.F90 b/src/MNH/mgn2mech.F90
new file mode 100644
index 000000000..f6c19ec07
--- /dev/null
+++ b/src/MNH/mgn2mech.F90
@@ -0,0 +1,323 @@
+SUBROUTINE MGN2MECH(KDATE, PLAT, PEF, PPFT, PCFNO, PCFNOG, PCFSPEC, &
+ KSPMH_MAP, KMECH_MAP, PCONV_FAC, OCONVERSION, PFLUX)
+
+!***********************************************************************
+! THIS PROGRAM DOES CHEMICAL SPECIATION AND MECHANISM CONVERSION.
+! THE OUTPUT FROM MEGAN.F IS CONVERTED FROM 20 TO 150 SPECIES WHICH
+! ARE THEN LUMPED ACCORDING TO THE MECHANISM ASSIGNED IN THE RUN SCRIPT.
+! THE PROGRAM LOOPS THROUGH ALL TIMESTEPS OF THE INPUT FILE.
+!
+! PROCEDURE
+! 1) FILE SET UP AND ASSIGN I/O PARAMETERS
+! 2) CONVERSION FROM MGN 20 TO SPECIATED 150
+! 3) CONVERSION FROM SPECIATED SPECIES TO MECHANISM SPECIES
+! 4) CONVERT TO TONNE/HOUR IF NEEDED
+!
+! THE INPUT FILE GIVES VARIABLES IN UNITS OF G-SPECIES/SEC.
+! ALL OUTPUTS ARE IN MOLE/SEC OR TONNE/HR DEPENDING ON ASSIGNMENT.
+!
+!
+! INPUT:
+! 1) MEGAN OUTPUT (NETCDF-IOAPI)
+!
+! OUTPUT:
+! 1) MEGAN SPECIATION OR MECHANISM SPECIES (NETCDF-IOAPI)
+!
+! REQUIREMENT:
+! REQUIRES LIBNETCDF.A AND LIBIOAPI.A TO COMPILE
+!
+! SETENV MGERFILE <DEFANGED_INPUT MEGAN OUTPUT FOR EMISSION ACTIVITY FACTORS>
+! SETENV OUTPFILE <OUTPUT SPECIATED EMISSION>
+!
+! CALLS: CHECKMEM
+!
+! ORIGINALLY CREATED BY JACK CHEN 11/04 FOR MEGAN V.0
+! FOR MEGAN V2.0 CREATED BY TAN 12/01/06
+! FOR MEGAN V2.1 CREATED BY XUEMEI WANG 11/04/07
+! FOR MEGAN V2.1 TO USE 150 SPECIES CREATED BY XUEMEI WANG 09/30/09
+!
+! HISTORY:
+! 08/14/07 TAN - MOVE TO MEGANV2.02 WITH NO UPDATE
+! 08/29/07 MODIFIED BY A. GUENTHER TO CORRECT ERROR IN ASSIGNING
+! EMISSION FACTOR. THIS VERSION IS CALLED MEGANV2.03
+! 10/29/07 MODIFIED BY A. GUENTHER TO CORRECT OMISSION OF DIURNAL VARIATION
+! FACTOR. THIS VERSION IS CALLED MEGANV2.04
+! 11/04/07 MODIFIED BY XUEMEI WANG TO GIVE TWO OPTIONS FOR MAP OR LOOKUP TABLE FOR
+! THE EMISSION FACTORS. ALSO GIVES OPTIONS FOR DIFFERENT CHEMICAL MECHANISMS
+! IN THE CODE: USER MODIFIES THE EXTERNAL SCRIPT TO ASSIGN MECHANISM.
+! THIS VERSION IS CALLED MEGANV2.1.0
+! 06/04/08 MODIFIED BY J. LEE-TAYLOR TO ACCEPT VEGETATION-DEPENDENT SPECIATION FACTORS
+! IN TABLE FORMAT (RESHAPE TABLES) RATHER THAN FROM DATA STATEMENTS.
+! 09/30/08 MODIFIED BY XUEMEI WANG TO GIVE OPTIONS FOR INPUT FILE AND TEST DIFFERENT MECHANISMS
+! 09/27/11 TAN&XUEMEI MEGANV2.10 INCLUDES SOIL NOX ADJUSTMENT AND A LOT OF UPDATES
+! 20/12/14 P. TULET - ON-LINE COUPLING IN THE ISBA/SURFEX SCHEME. ALL INIT VARIABLES HAS BEEN
+! MOVED IN INIT_MEGANN.F90.
+!***********************************************************************
+
+USE MODD_MGN2MECH
+USE MODD_MEGAN
+
+USE MODE_SOILNOX
+
+USE MODI_INDEX1
+
+IMPLICIT NONE
+
+INTEGER, INTENT(IN) :: KDATE ! DATE YYYYDDD
+REAL, DIMENSION(:), INTENT(IN) :: PLAT !I LATITUDE OF GRID CELL
+REAL, DIMENSION(:,:),INTENT(IN) :: PPFT !I PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM)
+REAL, DIMENSION(:,:),INTENT(IN) :: PEF !I PFT FACTOR ARRAY (NRTYP 1-16 IN THE FIRST DIM)
+REAL, DIMENSION(:), INTENT(IN) :: PCFNO !I NO CORRECTION FACTOR
+REAL, DIMENSION(:), INTENT(IN) :: PCFNOG !I NO CORRECTION FACTOR FOR GRASS
+REAL, DIMENSION(:,:), INTENT(IN) :: PCFSPEC
+LOGICAL, INTENT(IN) :: OCONVERSION
+INTEGER, DIMENSION(:), INTENT(IN) :: KSPMH_MAP
+INTEGER, DIMENSION(:), INTENT(IN) :: KMECH_MAP
+REAL, DIMENSION(:), INTENT(IN) :: PCONV_FAC
+REAL, DIMENSION(:,:),INTENT(INOUT) :: PFLUX !IO EMISSION FLUX IN MOL/M2/S
+
+!***********************************************************************
+! THIS PROGRAM DOES CHEMICAL SPECIATION AND MECHANISM CONVERSION.
+!... PROGRAM I/O FILES
+! PROGRAM NAME
+! INPUT MEGAN ER FILE
+! CHARACTER*16 :: MGNERS = 'MGNERS' ! INPUT MEGAN ER FILE LOGICAL NAME
+! NETCDF FILE
+! CHARACTER*16 :: EFMAPS = 'EFMAPS' ! EFMAP INPUT FILE NAME
+! CHARACTER*16 :: PFTS16 = 'PFTS16' ! INPUT PFT FILE LOGICAL
+! OUTPUT FILE
+! CHARACTER*16 :: MGNOUT = 'MGNOUT' ! OUTPUT FILE LOGICAL NAME
+! PARAMETERS FOR FILE UNITS
+! INTEGER :: LOGDEV ! LOGFILE UNIT NUMBER
+
+!... PROGRAM I/O PARAMETERS
+!... EXTERNAL PARAMETERS
+
+REAL, DIMENSION(N_SPCA_SPC,SIZE(PFLUX,2)) :: ZTMPER ! TEMP EMISSION BUFFER
+REAL, DIMENSION(SIZE(PFLUX,1),SIZE(PFLUX,2)) :: ZOUTER ! OUTPUT EMISSION BUFFER
+REAL, DIMENSION(SIZE(PLAT)) :: ZTMP1, ZTMP2, ZTMP3, ZTMP4
+REAL :: ZTMO1, ZTMO2, ZTMO3
+REAL :: Z2CRATIO
+
+!... INTERNAL PARAMETERS
+! INTERNAL PARAMTERS (STATUS AND BUFFER)
+INTEGER, DIMENSION(SIZE(PLAT)) :: ILEN, IDAY
+INTEGER :: JS, JJ, JI, JM, JN ! COUNTERS
+INTEGER :: JMPMG, JMPSP, JMPMC ! COUNTERS
+INTEGER :: INO
+INTEGER :: INP, IN_SCON_SPC
+
+!***********************************************************************
+
+!=======================================================================
+!... BEGIN PROGRAM
+!=======================================================================
+
+INP = SIZE(PLAT)
+IN_SCON_SPC = SIZE(KSPMH_MAP)
+
+! CHANGE THE UNIT ACCORDING TO TONPHR FLAG
+! IF ( TONPHR ) THEN
+! UNITS3D(1:NVARS3D) = 'TONS/HR'
+! ELSE
+! UNITS3D(1:NVARS3D) = 'MG/M*M/H'
+! ENDIF
+!
+! DO S = 1, NVARS3D
+! PRINT*,'OUTPUT VARIABLE:',VNAME3D(S),UNITS3D(S)
+! ENDDO
+
+! CALL NAMEVAL ( MGNERS , MESG ) ! GET INPUT FILE NAME AND PATH
+! FDESC3D( 2 ) = 'INPUT MEGAN FILE: '//TRIM(MESG)
+
+!... ALLOCATE MEMORY
+
+!.....2) CONVERSION FROM MGN 20 TO SPECIATED 150
+!-----------------------------------------------------------------------
+ZTMPER = 0.
+ZOUTER = 0.
+
+INO = INDEX1('NO',CMGN_SPC)
+
+!... LOOP THROUGH TIME
+DO JS = 1, N_SMAP_SPC
+
+ JMPMG = NMG20_MAP(JS)
+ JMPSP = NSPCA_MAP(JS)
+! PRINT*,'CONVERT '//MGN_SPC(NMPMG)//' TO '//SPCA_SPC(NMPSP)
+
+ IF ( JMPMG.NE.INO ) THEN
+
+ !... NOT NO
+ IF ( XEF_ALL(1,JMPMG).LT.0. ) THEN
+
+ !... USE EFMAPS
+ ZTMP1(:) = 0.
+ ZTMP2(:) = 0.
+ DO JM = 1,N_MGN_PFT
+ ZTMP1 = ZTMP1 + PPFT(JM,:)
+ ZTMP2 = ZTMP2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,:)
+ ENDDO
+ WHERE( ZTMP1(:).EQ.0. )
+ ZTMPER(JMPSP,:) = 0.
+ ELSEWHERE
+ ZTMPER(JMPSP,:) = PCFSPEC(JMPMG,:) * PEF(JMPMG,:) * ZTMP2(:)/ZTMP1(:)
+ ENDWHERE
+
+ ELSE
+
+ !... USE PFT-EF
+ ZTMP3(:) = 0.0
+ ZTMP4(:) = 0.0
+ DO JM = 1,N_MGN_PFT
+ !ZTMP3 = ZTMP3 + XEF_ALL(JM,JMPMG) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,:)/100.
+ ZTMP4(:) = ZTMP4(:) + PPFT(JM,:)
+ ZTMP3(:) = ZTMP3(:) + XEF_ALL(JM,JMPMG) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,:) ! bug S. Oumami
+ ENDDO
+ WHERE( ZTMP4(:).EQ.0. )
+ ZTMPER(JMPSP,:) = 0.
+ ELSEWHERE
+ ZTMPER(JMPSP,:) = PCFSPEC(JMPMG,:) * ZTMP3(:) / ZTMP4(:)
+ ENDWHERE
+
+
+ ENDIF
+
+ ELSE IF ( JMPMG.EQ.INO ) THEN
+
+!!-----------------NO STUFF-----------------------
+
+ CALL GROWSEASON(KDATE, PLAT, IDAY, ILEN)
+
+ DO JJ = 1,SIZE(PPFT,2)
+
+ ! CHECK FOR GROWING SEASON
+ IF ( IDAY(JJ).EQ.0 ) THEN
+
+ ! NON GROWING SEASON
+ ! CFNOG FOR EVERYWHERE
+ ! OVERRIDE CROP WITH GRASS WARM = 14
+ IF ( XEF_ALL(1,INO).LT.0. ) THEN
+
+ ! WITH EFMAPS
+ ZTMO1 = 0.
+ ZTMO2 = 0.
+ DO JM = 1,14
+ ZTMO1 = ZTMO1 + PPFT(JM,JJ)
+ ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)
+ ENDDO
+ DO JM = 15,N_MGN_PFT
+ ZTMO1 = ZTMO1 + PPFT(JM,JJ)
+ Z2CRATIO = XEF_ALL(14,INO)/XEF_ALL(JM,INO)
+ ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * Z2CRATIO
+ ENDDO
+ IF ( ZTMO1.EQ.0. ) THEN
+ ZTMPER(JMPSP,JJ) = 0.
+ ELSE
+ !ZTMPER(JMPSP,JJ) = &
+ ! PCFSPEC(INO,JJ) * PEF(INO,JJ) * PCFNOG(JJ) * ZTMO2/ZTMO1
+ ZTMPER(JMPSP,JJ) = &
+ PCFSPEC(INO,JJ) * PEF(INO,JJ) * PCFNOG(JJ) * ZTMO2/ZTMO1 * XN2NO
+ ENDIF
+
+ ELSE
+
+ ! WITHOUT EFMAPS
+ ZTMO3 = 0.0
+ DO JM = 1,14
+ ZTMO3 = ZTMO3 + XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100.
+ ENDDO
+ DO JM = 15,N_MGN_PFT
+ ZTMO3 = ZTMO3 + XEF_ALL(14,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100.
+ ENDDO
+ !ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PCFNOG(JJ) * ZTMO3
+ ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PCFNOG(JJ) * ZTMO3 * XN2NO
+
+ ENDIF
+
+ ELSE IF ( IDAY(JJ).GT.0 .AND. IDAY(JJ).LE.366 ) THEN
+
+ ! GROWING SEASON
+ ! CFNOG FOR EVERYWHERE EXCEPT CROPS
+ ! CFNO FOR CROP AND CORN
+ IF ( XEF_ALL(1,INO).LT.0. ) THEN
+
+ ! WITH EFMAPS
+ ZTMO1 = 0.
+ ZTMO2 = 0.
+ DO JM = 1,14
+ ZTMO1 = ZTMO1 + PPFT(JM,JJ)
+ ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * PCFNOG(JJ)
+ ENDDO
+ DO JM = 15,N_MGN_PFT
+ ZTMO1 = ZTMO1 + PPFT(JM,JJ)
+ ZTMO2 = ZTMO2 + XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ) * PCFNO(JJ)
+ ENDDO
+ IF ( ZTMO1.EQ.0. ) THEN
+ ZTMPER(JMPSP,JJ) = 0.
+ ELSE
+ !ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PEF(INO,JJ) * ZTMO2/ZTMO1
+ ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * PEF(INO,JJ) * ZTMO2/ZTMO1 * XN2NO
+ ENDIF
+
+ ELSE
+
+ ! WITHOUT EFMAPS
+ ZTMO3 = 0.0
+ DO JM = 1,14
+ ZTMO3 = ZTMO3 + &
+ XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100. * PCFNOG(JJ)
+ ENDDO
+ DO JM = 15,N_MGN_PFT
+ ZTMO3 = ZTMO3 + &
+ XEF_ALL(JM,INO) * XEFFS_ALL(JM,JMPSP) * PPFT(JM,JJ)/100. * PCFNO(JJ)
+ ENDDO
+ !ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * ZTMO3
+ ZTMPER(JMPSP,JJ) = PCFSPEC(INO,JJ) * ZTMO3 * XN2NO
+ ENDIF
+
+ ELSE
+
+ WRITE(*,*) "MGN2MECH: BAD IDAY"
+ STOP
+
+ ENDIF
+
+ ENDDO !DO R = 1,NROWS
+
+!-----------------END OF NO----------------------
+ ENDIF !IF ( NMPMG .NE. INO ) THEN
+
+ENDDO ! END SPECIES LOOP
+
+!-----------------------------------------------------------------------
+!.....3) CONVERSION FROM SPECIATED SPECIES TO MECHANISM SPECIES
+!-----------------------------------------------------------------------
+! ! CONVERT FROM UG/M^2/HR TO MOL/M^2/S USING THEIR MW
+
+DO JS = 1, N_SPCA_SPC
+ ZTMPER(JS,:) = ZTMPER(JS,:) / XSPCA_MWT(JS) * XUG2G / XHR2SEC
+ENDDO
+!
+ ! LUMPING TO MECHANISM SPECIES
+!
+IF ( OCONVERSION ) THEN
+
+ DO JS = 1, IN_SCON_SPC
+
+ JMPSP = KSPMH_MAP(JS) ! MAPPING VALUE FOR SPCA
+ JMPMC = KMECH_MAP(JS) ! MAPPING VALUE FOR MECHANISM
+ ZOUTER(JMPMC,:) = ZOUTER(JMPMC,:) + ( ZTMPER(JMPSP,:) * PCONV_FAC(JS) )
+! ! UNITS OF THESE SPECIES ARE IN MOLE/S ------> MOLE/M²/S
+
+ ENDDO ! END SPECIES LOOP
+
+ELSE
+ ! ! GET ALL 150 SPECIES INTO THE OUTPUT ARRAY
+ ZOUTER(:,:) = ZTMPER(:,:)
+ ! ! UNITS OF THESE SPECIES ARE IN MOLE/M2/S
+
+ENDIF
+PFLUX(:,:) = ZOUTER(:,:)
+
+END SUBROUTINE MGN2MECH
diff --git a/src/MNH/modd_dms_surf_fieldsn.F90 b/src/MNH/modd_dms_surf_fieldsn.F90
new file mode 100644
index 000000000..524a1d0d0
--- /dev/null
+++ b/src/MNH/modd_dms_surf_fieldsn.F90
@@ -0,0 +1,74 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! ####################
+ MODULE MODD_DMS_SURF_FIELDS_n
+! ####################
+!
+!!**** *MODD_DMS_SURF_FIELDS* - declaration of megan physiographic data arrays
+!!
+!! PURPOSE
+!! -------
+! The purpose of this declarative module is to specify the
+! megan physiographic data arrays.
+!
+!!
+!! AUTHOR
+!! ------
+!! P. Tulet & M. Leriche *LACy & LA*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/2017
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+
+TYPE DMS_SURF_FIELDS_t
+!
+ INTEGER :: NDMS_NBR
+! ! number of megan pgd fields chosen by user
+ CHARACTER(LEN=3) , DIMENSION(:), POINTER :: CDMS_AREA
+! ! areas where megan pgd fields are defined
+! ! 'ALL' : everywhere
+! ! 'SEA' : where sea exists
+! ! 'LAN' : where land exists
+! ! 'WAT' : where inland water exists
+! ! 'NAT' : where natural or agricultural areas exist
+! ! 'TWN' : where town areas exist
+! ! 'STR' : where streets are present
+! ! 'BLD' : where buildings are present
+! !
+ CHARACTER(LEN=20), DIMENSION(:), POINTER :: CDMS_NAME
+! ! name of the megan pgd fields (for information)
+ REAL, DIMENSION(:,:), POINTER :: XDMS_FIELDS
+! ! megan pgd fields themselves
+!
+!-------------------------------------------------------------------------------
+!
+END TYPE DMS_SURF_FIELDS_t
+
+ CONTAINS
+!
+!
+SUBROUTINE DMS_SURF_FIELDS_INIT(YDMS_SURF_FIELDS)
+TYPE(DMS_SURF_FIELDS_t), INTENT(INOUT) :: YDMS_SURF_FIELDS
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_DMS_SURF_FIELDS_N:DMS_SURF_FIELDS_INIT",0,ZHOOK_HANDLE)
+NULLIFY(YDMS_SURF_FIELDS%CDMS_NAME)
+NULLIFY(YDMS_SURF_FIELDS%CDMS_AREA)
+NULLIFY(YDMS_SURF_FIELDS%XDMS_FIELDS)
+YDMS_SURF_FIELDS%NDMS_NBR=0
+IF (LHOOK) CALL DR_HOOK("MODD_DMS_SURF_FIELDS_N:DMS_SURF_FIELDS_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE DMS_SURF_FIELDS_INIT
+
+
+END MODULE MODD_DMS_SURF_FIELDS_n
diff --git a/src/MNH/modd_dmsn.F90 b/src/MNH/modd_dmsn.F90
new file mode 100644
index 000000000..2dbb65266
--- /dev/null
+++ b/src/MNH/modd_dmsn.F90
@@ -0,0 +1,55 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #####################
+ MODULE MODD_DMS_n
+! ######################
+!
+!!
+!! PURPOSE
+!! -------
+!
+!
+!
+!!
+!!** IMPLICIT ARGUMENTS
+!! ------------------
+!! None
+!!
+!
+!! AUTHOR
+!! ------
+!! P. Tulet *LAERO
+!!
+!! MODIFICATIONS
+!! -------------
+!------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+TYPE DMS_t
+!
+ REAL, POINTER, DIMENSION(:) :: XDMS ! contenu en DMS marin (nmole.dm-3)
+!
+END TYPE DMS_t
+
+ CONTAINS
+!
+SUBROUTINE DMS_INIT(YDMS)
+TYPE(DMS_t), INTENT(INOUT) :: YDMS
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+IF (LHOOK) CALL DR_HOOK("MODD_DMS_n:DMS_INIT",0,ZHOOK_HANDLE)
+NULLIFY(YDMS%XDMS)
+IF (LHOOK) CALL DR_HOOK("MODD_DMS_n:DMS_INIT",1,ZHOOK_HANDLE)
+END SUBROUTINE DMS_INIT
+
+
+END MODULE MODD_DMS_n
diff --git a/src/MNH/mode_gamma_etc.F90 b/src/MNH/mode_gamma_etc.F90
new file mode 100644
index 000000000..04a1b2091
--- /dev/null
+++ b/src/MNH/mode_gamma_etc.F90
@@ -0,0 +1,554 @@
+!=======================================================================
+! MODULE GAMMA
+!
+! THIS MODULE CONTAIN FUNCTIONS TO CALCULATE
+! GAMMA_P, GAMMA_T, GAMMA_L, GAMMA_A FOR BVOCS.
+!
+! CONTAINS: 1)GAMMA_LAI
+! 2)GAMMA_P
+! 3)GAMMA_TLD
+! 4)GAMMA_TLI
+! 5)GAMMA_A
+! 6)GAMMA_S
+! 7)GAMMA_CO2
+! 8)GAMMA_LAIBIDIR
+!
+! NOTE:
+!
+! REQUIREMENT:
+!
+! CALLS: SOLARANGLE
+!
+! CREATED BY TAN 11/21/06 FOR MEGAN V2.0
+!
+! HISTORY:
+! 08/01/07 GUENTHER A. - MOVE TO MEGANV2.02 WITH MODIFICATION TO
+! CORRECT CALCULATION OF GAMMA_P
+!
+!=======================================================================
+
+MODULE MODE_GAMMA_ETC
+!
+USE MODD_MEGAN
+!
+!USE MODI_SOLARANGLE
+USE MODI_INDEX1
+!
+IMPLICIT NONE
+
+!... PROGRAM I/O PARAMETERS
+
+!... EXTERNAL PARAMETERS
+
+CONTAINS
+!***********************************************************************
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!
+! SCIENTIFIC ALGORITHM
+!
+! EMISSION = [EF][GAMMA][RHO]
+! WHERE [EF] = EMISSION FACTOR (UG/M2H)
+! [GAMMA] = EMISSION ACTIVITY FACTOR (NON-DIMENSION)
+! [RHO] = PRODUCTION AND LOSS WITHIN PLANT CANOPIES
+! (NON-DIMENSINO)
+! ASSUMPTION: [RHO] = 1 (11/27/06) (SEE PDT_LOT_CP.EXT)
+!
+! GAMMA = [GAMMA_CE][GAMMA_AGE][GAMMA_SM]
+! WHERE [GAMMA_CE] = CANOPY CORRECTION FACTOR
+! [GAMMA_AGE] = LEAF AGE CORRECTION FACTOR
+! [GAMMA_SM] = SOIL MOISTURE CORRECTION FACTOR
+! ASSUMPTION: [GAMMA_SM] = 1 (11/27/06)
+!
+! GAMMA_CE = [GAMMA_LAI][GAMMA_P][GAMMA_T]
+! WHERE [GAMMA_LAI] = LEAF AREA INDEX FACTOR
+! [GAMMA_P] = PPFD EMISSION ACTIVITY FACTOR
+! [GAMMA_T] = TEMPERATURE RESPONSE FACTOR
+!
+! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE][GAMMA_SM]
+! DERIVATION:
+! EMISSION = [EF][GAMMA_ETC](1-LDF) + [EF][GAMMA_ETC][LDF][GAMMA_P]
+! EMISSION = [EF][GAMMA_ETC]{ (1-LDF) + [LDF][GAMMA_P] }
+! EMISSION = [EF][GAMMA_ECT]{ (1-LDF) + [LDF][GAMMA_P] }
+! WHERE LDF = LIGHT DEPENDENT FUNCTION (NON-DIMENSION)
+!
+! FOR ISOPRENE
+! ASSUMPTION: LDF = 1 FOR ISOPRENE (11/27/06)
+!
+! FINAL EQUATION
+! EMISSION = [EF][GAMMA_LAI][GAMMA_P][GAMMA_T][GAMMA_AGE][GAMMA_SM]
+!
+! FOR NON-ISOPRENE
+! FINAL EQUATION
+! EMISSION = [EF][GAMMA_LAI][GAMMA_T][GAMMA_AGE][GAMMA_SM]*
+! { (1-LDF) + [LDF][GAMMA_P] }
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+!=======================================================================
+!... BEGIN MODULE
+!=======================================================================
+
+
+!-----------------------------------------------------------------------
+!.....1) CALCULATE GAM_L (GAMMA_LAI)
+!-----------------------------------------------------------------------
+! 0.49[LAI]
+! GAMMA_LAI = ---------------- (NON-DIMENSION)
+! (1+0.2LAI^2)^0.5
+!
+! SUBROUTINE GAMMA_LAI RETURNS THE GAMMA_LAI VALUES
+!-----------------------------------------------------------------------
+SUBROUTINE GAMMA_LAI(PLAI, PGAM_L)
+
+IMPLICIT NONE
+! INPUT
+REAL,DIMENSION(:),INTENT(IN) :: PLAI
+! OUTPUT
+REAL,DIMENSION(:),INTENT(OUT) :: PGAM_L
+
+PGAM_L(:) = (0.49*PLAI(:)) / ( (1.+0.2*(PLAI(:)**2))**0.5 )
+
+END SUBROUTINE GAMMA_LAI
+!-----------------------------------------------------------------------
+
+!-----------------------------------------------------------------------
+!.....5) CALCULATE GAM_A (GAMMA_AGE)
+!-----------------------------------------------------------------------
+!
+! GAMMA_AGE = FNEW*ANEW + FGRO*AGRO + FMAT*AMAT + FOLD*AOLD
+! WHERE FNEW = NEW FOLIAGE FRACTION
+! FGRO = GROWING FOLIAGE FRACTION
+! FMAT = MATURE FOLIAGE FRACTION
+! FOLD = OLD FOLIAGE FRACTION
+! ANEW = RELATIVE EMISSION ACTIVITY FOR NEW FOLIAGE
+! AGRO = RELATIVE EMISSION ACTIVITY FOR GROWING FOLIAGE
+! AMAT = RELATIVE EMISSION ACTIVITY FOR MATURE FOLIAGE
+! AOLD = RELATIVE EMISSION ACTIVITY FOR OLD FOLIAGE
+!
+!
+! FOR FOLIAGE FRACTION
+! CASE 1) LAIC = LAIP
+! FNEW = 0.0 , FGRO = 0.1 , FMAT = 0.8 , FOLD = 0.1
+!
+! CASE 2) LAIP > LAIC
+! FNEW = 0.0 , FGRO = 0.0
+! FMAT = 1-FOLD
+! FOLD = (LAIP-LAIC)/LAIP
+!
+! CASE 3) LAIP < LAIC
+! FNEW = 1-(LAIP/LAIC) T <= TI
+! = (TI/T) * ( 1-(LAIP/LAIC) ) T > TI
+!
+! FMAT = LAIP/LAIC T <= TM
+! = (LAIP/LAIC) +
+! ( (T-TM)/T ) * ( 1-(LAIP/LAIC) ) T > TM
+!
+! FGRO = 1 - FNEW - FMAT
+! FOLD = 0.0
+!
+! WHERE
+! TI = 5 + (0.7*(300-TT)) TT <= 303
+! = 2.9 TT > 303
+! TM = 2.3*TI
+!
+! T = LENGTH OF THE TIME STEP (DAYS)
+! TI = NUMBER OF DAYS BETWEEN BUDBREAK AND THE INDUCTION OF
+! EMISSION
+! TM = NUMBER OF DAYS BETWEEN BUDBREAK AND THE INITIATION OF
+! PEAK EMISSIONS RATES
+! TT = AVERAGE TEMPERATURE (K) NEAR TOP OF THE CANOPY DURING
+! CURRENT TIME PERIOD (DAILY AVE TEMP FOR THIS CASE)
+!
+!
+! FOR RELATIVE EMISSION ACTIVITY
+! CASE 1) CONSTANT
+! ANEW = 1.0 , AGRO = 1.0 , AMAT = 1.0 , AOLD = 1.0
+!
+! CASE 2) MONOTERPENES
+! ANEW = 2.0 , AGRO = 1.8 , AMAT = 0.95 , AOLD = 1.0
+!
+! CASE 3) SESQUITERPENES
+! ANEW = 0.4 , AGRO = 0.6 , AMAT = 1.075, AOLD = 1.0
+!
+! CASE 4) METHANOL
+! ANEW = 3.0 , AGRO = 2.6 , AMAT = 0.85 , AOLD = 1.0
+!
+! CASE 5) ISOPRENE
+! ANEW = 0.05 , AGRO = 0.6 , AMAT = 1.125, AOLD = 1.0
+!
+! SUBROUTINE GAMMA_A RETURNS GAMMA_A
+!-----------------------------------------------------------------------
+SUBROUTINE GAMMA_A(KDATE, KTIME, KTSTLEN, HSPC_NAME, PTEMP_D, PLAIARP, PLAIARC, PGAM_A)
+
+IMPLICIT NONE
+
+! INPUT
+INTEGER, INTENT(IN) :: KDATE, KTIME, KTSTLEN
+CHARACTER(LEN=16), INTENT(IN) :: HSPC_NAME
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP_D
+REAL, DIMENSION(:), INTENT(IN) :: PLAIARP, PLAIARC
+! OUTPUT
+REAL,DIMENSION(:),INTENT(OUT) :: PGAM_A
+
+! LOCAL PARAMETERS
+REAL :: ZFNEW, ZFGRO, ZFMAT, ZFOLD
+REAL :: ZTI, ZTM ! NUMBER OF DAYS BETWEEN BUDBREAK
+ ! AND INDUCTION OF EMISSION,
+ ! INITIATION OF PEAK EMISSIONS RATES
+INTEGER :: IAINDX ! RELATIVE EMISSION ACITIVITY INDEX
+INTEGER :: ISPCNUM
+INTEGER :: JJ
+
+!... CHOOSE RELATIVE EMISSION ACTIVITY
+!--------CODE BY XUEMEI WANG 11/04/2007----------------
+!
+ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC)
+IAINDX = NREA_INDEX(ISPCNUM)
+!
+!---------------------------------------------------
+! LOCAL PARAMETER ARRAYS
+DO JJ = 1,SIZE(PLAIARP)
+ IF ( PTEMP_D(JJ).LE.303. ) THEN
+ ZTI = 5.0 + 0.7*(300.-PTEMP_D(JJ))
+ ELSE
+ ZTI = 2.9
+ ENDIF
+ ZTM = 2.3 * ZTI
+!
+
+
+!... CALCULATE FOLIAGE FRACTION
+
+! PRINT*,'LAIP,LAIC, TT=',MINVAL(LAIP), MAXVAL(LAIP),
+! S MINVAL(LAIC), MAXVAL(LAIC), MINVAL(TT), MAXVAL(TT)
+
+! WHERE (LAIP .LT. LAIC)
+
+! CALCULATE TI AND TM
+ IF ( PLAIARP(JJ).EQ.PLAIARC(JJ) ) THEN
+
+ ZFNEW = 0.0
+ ZFGRO = 0.1
+ ZFMAT = 0.8
+ ZFOLD = 0.1
+
+ ELSEIF ( PLAIARP(JJ).GT.PLAIARC(JJ) ) THEN
+
+ ZFNEW = 0.0
+ ZFGRO = 0.0
+ ZFOLD = ( PLAIARP(JJ)-PLAIARC(JJ) ) / PLAIARP(JJ)
+ ZFMAT = 1. - ZFOLD
+
+ ELSE
+
+ ZFMAT = PLAIARP(JJ)/PLAIARC(JJ)
+ ! CALCULATE FNEW AND FMAT, THEN FGRO AND FOLD
+ ! FNEW
+ IF ( ZTI.GE.KTSTLEN ) THEN
+ ZFNEW = 1.0 - ZFMAT
+ ELSE
+ ZFNEW = (ZTI/KTSTLEN) * ( 1. - ZFMAT )
+ ENDIF
+! FMAT
+ IF ( ZTM.LT.KTSTLEN ) THEN
+ ZFMAT = ZFMAT + ( (KTSTLEN-ZTM)/KTSTLEN ) * ( 1.-ZFMAT )
+ ENDIF
+
+ ZFGRO = 1.0 - ZFNEW - ZFMAT
+ ZFOLD = 0.0
+
+ ENDIF
+
+ !... CALCULATE GAMMA_A
+ PGAM_A(JJ) = ZFNEW * XANEW(IAINDX) + ZFGRO * XAGRO(IAINDX) + &
+ ZFMAT * XAMAT(IAINDX) + ZFOLD * XAOLD(IAINDX)
+
+ENDDO
+
+END SUBROUTINE GAMMA_A
+
+!-----------------------------------------------------------------------
+!.....6) CALCULATE GAM_SMT (GAMMA_SM)
+!-----------------------------------------------------------------------
+!
+! GAMMA_SM = 1.0 (NON-DIMENSION)
+!
+!
+! SUBROUTINE GAMMA_S RETURNS THE GAMMA_SM VALUES
+!-----------------------------------------------------------------------
+SUBROUTINE GAMMA_S( PGAM_S )
+
+IMPLICIT NONE
+
+REAL,DIMENSION(:) :: PGAM_S
+
+PGAM_S = 1.0
+
+END SUBROUTINE GAMMA_S
+
+!-----------------------------------------------------------------------
+!.....2) CALCULATE GAM_P (GAMMA_P)
+!-----------------------------------------------------------------------
+! GAMMA_P = 0.0 A<=0, A>=180, SIN(A) <= 0.0
+!
+! GAMMA_P = SIN(A)[ 2.46*(1+0.0005(PDAILY-400))*PHI - 0.9*PHI^2 ]
+! 0<A<180, SIN(A) > 0.0
+! WHERE PHI = ABOVE CANOPY PPFD TRANSMISSION (NON-DIMENSION)
+! PDAILY = DAILY AVERAGE ABOVE CANOPY PPFD (UMOL/M2S)
+! A = SOLAR ANGLE (DEGREE)
+!
+! NOTE: AAA = 2.46*BBB*PHI - 0.9*PHI^2
+! BBB = (1+0.0005(PDAILY-400))
+! GAMMA_P = SIN(A)*AAA
+!
+! PAC
+! PHI = -----------
+! SIN(A)*PTOA
+! WHERE PAC = ABOVE CANOPY PPFD (UMOL/M2S)
+! PTOA = PPFD AT THE TOP OF ATMOSPHERE (UMOL/M2S)
+!
+! PAC = SRAD * 4.766 MMMOL/M2-S * 0.5
+!
+! PTOA = 3000 + 99*COS[2*3.14-( DOY-10)/365 )]
+! WHERE DOY = DAY OF YEAR
+!
+! SUBROUTINE GAMMA_P RETURNS THE GAMMA_P VALUES
+!-----------------------------------------------------------------------
+!SUBROUTINE GAMMA_P( KDATE, KTIME, PLAT, PLONG, PPFD, PPFD_D, PGAM_P )
+!
+!IMPLICIT NONE
+!
+!! INPUT
+!INTEGER,INTENT(IN) :: KDATE, KTIME
+!
+!REAL,DIMENSION(:),INTENT(IN) :: PLAT, PLONG
+!! PHOTOSYNTHETIC PHOTON FLUX DENSITY: INSTANTANEOUS, DAILY
+!REAL,DIMENSION(:),INTENT(IN) :: PPFD, PPFD_D
+!! OUTPUT
+!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_P ! GAMMA_P
+!
+!! LOCAL PARAMETERS
+!REAL, DIMENSION(SIZE(PLAT)) :: ZHOUR, ZSINBETA ! HOUR IS SOLAR HOUR
+!INTEGER, DIMENSION(SIZE(PLAT)) :: IDAY ! DAY IS DOY (JDATE)
+!
+!REAL :: ZPTOA, ZPHI
+!REAL :: ZAAA, ZBBB
+!REAL :: ZBETA ! SOLAR ZENITH ANGLE
+!INTEGER :: JJ
+!
+!!... BEGIN ESTIMATING GAMMA_P
+!
+!!... CONVERT DATE AND TIME FORMAT TO LOCAL TIME
+!! DAY IS JULIAN DAY
+!IDAY(:) = MOD(KDATE,1000)
+!
+!! CONVERT FROM XXXXXX FORMAT TO XX.XX (SOLAR HOUR)
+!! HOUR = 0 -> 23.XX
+!! SOLAR HOUR
+!ZHOUR(:) = KTIME/10000. + PLONG(:)/15.
+!
+!WHERE ( ZHOUR(:).LT.0. )
+! ZHOUR(:) = ZHOUR(:) + 24.0
+! IDAY(:) = IDAY(:) - 1.
+!ENDWHERE
+!
+!! GET SOLAR ELEVATION ANGLE
+!CALL SOLARANGLE(IDAY, ZHOUR, PLAT, ZSINBETA)
+!
+!DO JJ = 1,SIZE(ZSINBETA)
+!
+! IF ( ZSINBETA(JJ).LE.0. ) THEN
+!
+! PGAM_P(JJ) = 0.
+!
+! ELSE IF ( ZSINBETA(JJ).GT.0. ) THEN
+!
+! ZPTOA = 3000.0 + 99.0 *COS(2. * 3.14 * (IDAY(JJ)-10.)/365.)
+!
+! ZPHI = PPFD(JJ) / (ZSINBETA(JJ) * ZPTOA)
+!
+! ZBBB = 1. + 0.0005 * (PPFD_D(JJ)-400. )
+! ZAAA = ( 2.46 * ZBBB * ZPHI ) - ( 0.9 * ZPHI**2 )
+!
+! PGAM_P(JJ) = ZSINBETA(JJ) * ZAAA
+!
+! ZBETA = ASIN(ZSINBETA(JJ)) * XRPI180 ! DEGREE
+!
+! ! SCREENING THE UNFORCED ERRORS
+! ! IF SOLAR ELEVATION ANGLE IS LESS THAN 1 THEN
+! ! GAMMA_P CAN NOT BE GREATER THAN 0.1.
+! IF ( ZBETA.LT.1.0 .AND. PGAM_P(JJ).GT.0.1 ) THEN
+! PGAM_P(JJ) = 0.0
+! ENDIF
+!
+! ELSE
+!
+! WRITE(*,*) "ERROR: SOLAR ANGLE IS INVALID - FATAL ERROR GAMMA_P, STOP"
+! STOP
+!
+! ENDIF
+! ! END LOOP FOR NROWS
+!ENDDO ! END LOOP FOR NCOLS
+!
+!END SUBROUTINE GAMMA_P
+!!-----------------------------------------------------------------------
+!
+!
+!!-----------------------------------------------------------------------
+!!.....3) CALCULATE GAM_T (GAMMA_T) FOR ISOPRENE
+!!-----------------------------------------------------------------------
+!! EOPT*CT2*EXP(CT1*X)
+!! GAMMA_T = ------------------------
+!! [CT2-CT1*(1-EXP(CT2*X))]
+!! WHERE X = [ (1/TOPT)-(1/THR) ] / 0.00831
+!! EOPT = 1.75*EXP(0.08(TDAILY-297)
+!! CT1 = 80
+!! CT2 = 200
+!! THR = HOURLY AVERAGE AIR TEMPERATURE (K)
+!! TDAILY = DAILY AVERAGE AIR TEMPERATURE (K)
+!! TOPT = 313 + 0.6(TDAILY-297)
+!!
+!! NOTE: AAA = EOPT*CT2*EXP(CT1*X)
+!! BBB = [CT2-CT1*(1-EXP(CT2*X))]
+!! GAMMA_T = AAA/BBB
+!!
+!! SUBROUTINE GAMMA_TLD RETURNS THE GAMMA_T VALUE FOR ISOPRENE
+!!-----------------------------------------------------------------------
+!SUBROUTINE GAMMA_TLD( PTEMP, PTEMP_D, PGAM_T, HSPC_NAME )
+!
+!IMPLICIT NONE
+!
+!! INPUT
+!REAL,DIMENSION(:),INTENT(IN) :: PTEMP, PTEMP_D ! DAILY, HOURLY SURFACE TEMPERATURE
+!! OUTPUT
+!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_T ! GAMMA_T
+!CHARACTER(LEN=16),INTENT(IN) :: HSPC_NAME
+!!
+!! LOCAL PARAMETERS
+!REAL :: ZEOPT, ZTOPT, ZX, ZAAA, ZBBB
+!INTEGER :: ISPCNUM, JJ
+!
+!ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC)
+!
+!DO JJ = 1,SIZE(PTEMP)
+!
+! ZEOPT = XCLEO(ISPCNUM) * EXP(0.08*(PTEMP_D(JJ)-297.))
+! ZTOPT = 313.0 + ( 0.6*(PTEMP_D(JJ)-297.) )
+! ZX = ( (1/ZTOPT)-(1/PTEMP(JJ)) ) / 0.00831
+!
+! ZAAA = ZEOPT * XCT2 * EXP(XCTM1(ISPCNUM)*ZX)
+! ZBBB = ( XCT2- XCTM1(ISPCNUM)*( 1.-EXP(XCT2*ZX) ) )
+! PGAM_T(JJ) = ZAAA/ZBBB
+!
+!ENDDO
+!
+!END SUBROUTINE GAMMA_TLD
+!!-----------------------------------------------------------------------
+!
+!
+!!-----------------------------------------------------------------------
+!!.....4) CALCULATE GAM_T (GAMMA_T) FOR NON-ISOPRENE
+!!-----------------------------------------------------------------------
+!!
+!! GAMMA_T = EXP[TDP_FCT*(T-TS)]
+!! WHERE TDP_FCT = TEMPERATURE DEPENDENT PARAMETER ('BETA')
+!! TS = STANDARD TEMPERATURE (NORMALLY 303K, 30C)
+!!
+!! SUBROUTINE GAMMA_TLI RETURNS THE GAMMA_T VALUE FOR NON-ISOPRENE
+!!-----------------------------------------------------------------------
+!SUBROUTINE GAMMA_TLI(HSPCNAM, PTEMP, PGAM_T)
+!
+!IMPLICIT NONE
+!
+!CHARACTER(LEN=16), INTENT(IN) :: HSPCNAM
+!REAL,DIMENSION(:), INTENT(IN):: PTEMP
+!REAL, DIMENSION(:), INTENT(OUT) :: PGAM_T
+!!
+!INTEGER :: ISPCNUM ! SPECIES NUMBER
+!
+!!--END OF DECLARATIONS--
+!
+!ISPCNUM = INDEX1(HSPCNAM, CMGN_SPC)
+!!
+!PGAM_T = EXP( XTDF_PRM(ISPCNUM) * (PTEMP-XTS) )
+!
+!END SUBROUTINE GAMMA_TLI
+!!-----------------------------------------------------------------------
+!
+!!=======================================================================
+!!-----------------------------------------------------------------------
+!!.....7) CALCULATE GAM_CO2(GAMMA_CO2)
+!!-----------------------------------------------------------------------
+!!
+!! GAMMA_CO2 = 1.0 (NON-DIMENSION)
+!! WHEN CO2 =400PPM
+!!
+!! SUBROUTINE GAM_CO2 RETURNS THE GAMMA_CO2 VALUES
+!! XUEMEI WANG-2009-06-22
+!!-----------------------------------------------------------------------
+!SUBROUTINE GAMMA_CO2(PCO2, PGAM_CO2)
+!
+!IMPLICIT NONE
+!
+!REAL, DIMENSION(:), INTENT(IN) :: PCO2
+!REAL, DIMENSION(:), INTENT(OUT) :: PGAM_CO2
+!
+!REAL :: ZCI
+!INTEGER :: JJ
+!
+!DO JJ = 1,SIZE(PCO2)
+!
+! IF ( PCO2(JJ).EQ.400. ) THEN
+! PGAM_CO2(JJ) = 1.0
+! ELSE
+! ZCI = 0.7* PCO2(JJ)
+! PGAM_CO2(JJ) = XISMAX - ((XISMAX*ZCI**XH) /(XCSTAR**XH+ZCI**XH))
+! ENDIF
+!
+!ENDDO
+!
+!END SUBROUTINE GAMMA_CO2
+!
+!!=======================================================================
+!!=======================================================================
+!!-----------------------------------------------------------------------
+!!.....8) CALCULATE GAMMA_LAIBIDIR(GAM_LAIBIDIR,LAI)
+!!-----------------------------------------------------------------------
+!!FROM ALEX GUENTHER 2010-01-26
+!!IF LAI < 2 THEN
+!!GAMMALAIBIDIR= 0.5 * LAI
+!!ELSEIF LAI <= 6 THEN
+!!GAMMALAIBIDIR= 1 - 0.0625 * (LAI - 2)
+!!ELSE
+!!GAMMALAIBIDIR= 0.75
+!!END IF
+!!
+!! SUBROUTINE GAMMA_LAIBIDIR RETURNS THE GAM_LAIBIDIR VALUES
+!! XUEMEI WANG-2010-01-28
+!!
+!!-----------------------------------------------------------------------
+!SUBROUTINE GAMMA_LAIBIDIR(PLAI, PGAM_LAIBIDIR)
+!
+!IMPLICIT NONE
+!
+!REAL,DIMENSION(:),INTENT(IN) :: PLAI
+!REAL,DIMENSION(:),INTENT(OUT) :: PGAM_LAIBIDIR
+!
+!INTEGER :: JJ
+!!
+!DO JJ = 1,SIZE(PLAI)
+!
+! IF ( PLAI(JJ)<2. ) THEN
+! PGAM_LAIBIDIR(JJ) = 0.5 * PLAI(JJ)
+! ELSEIF ( PLAI(JJ).GE.2. .AND. PLAI(JJ).LE.6. ) THEN
+! PGAM_LAIBIDIR(JJ) = 1. - 0.0625 * ( PLAI(JJ)-2. )
+! ELSE
+! PGAM_LAIBIDIR(JJ) = 0.75
+! ENDIF
+!
+!ENDDO
+!
+!END SUBROUTINE GAMMA_LAIBIDIR
+!!=======================================================================
+!
+END MODULE MODE_GAMMA_ETC
diff --git a/src/MNH/mode_megan.F90 b/src/MNH/mode_megan.F90
new file mode 100644
index 000000000..584fda604
--- /dev/null
+++ b/src/MNH/mode_megan.F90
@@ -0,0 +1,1235 @@
+MODULE MODE_MEGAN
+!
+USE MODD_MEGAN
+!
+USE MODI_SOLARANGLE
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!
+! INPUT AND OUTPUT FILES MUST BE SELECTED BEFORE STARTING THE PROGRAM
+!
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!!
+! INPUT VARIBLES
+!
+! DAY JULIAN DAY
+! LAT LATITUDE
+! HOUR HOUR OF THE DAY
+! TC TEMPERATURE [C]
+! PPFD INCOMING PHOTOSYNTHETIC ACTIVE RADIATION [UMOL/M2/S1]
+! WIND WIND SPEED [M S-1]
+! HUMIDITY RELATIVE HUMIDITY [%]
+! CANTYPYE DEFINES SET OF CANOPY CHARACTERISTICS
+! LAI LEAF AREA INDEX [M2 PER M2 GROUND AREA]
+! DI ???
+! PRES PRESSURE [PA]
+!
+! USED VARIABLES:
+!
+! PPFDFRAC FRACTION OF TOTAL SOLAR RADIATION THAT IS PPFD
+! SOLAR SOLAR RADIATION [W/M2]
+! MAXSOLAR MAXIMUM OF SOLAR RADIATION
+! BETA SIN OF SOLAR ANGLE ABOVE HORIZON
+! SINBETA SOLAR ANGLE ABOVE HORIZON
+! TAIRK0 ABOVE CANOPY AIR TEMPERATURE [K]
+! TAIRK ARRAY OF CANOPY AIR TEMPERATURE [K]
+! WS0 ABOVE CANOPY WIND SPEED [M/S]
+! WS ARRAY OF CANOPY WIND SPEED [M/S]
+! HUMIDAIRPA0 ABOVE CANOPY AMBIENT HUMIDITY [PA]
+! HUMIDAIRPA ARRAY OF CANOPY AMBIENT HUMIDITY IN [PA]
+! STOMATADI INDEX FOR WATER STATUS OF LEAVES. USED TO MODIFY STOMATAL CONDUCTANCE
+! TRANSMIS TRANSMISSION OF PPFD THAT IS DIFFUSE
+! DIFFFRAC FRACTION OF PPFD THAT IS DIFFUSE
+! PPFDFRAC FRACTION OF SOLAR RAD THAT IS PPFD
+! TRATE STABILITY OF BOUNDARY ???
+! SH SENSIBLE HEAT FLUX ???
+! VPGAUSWT ARRAY OF GAUSSIAN WEIGHTING FACTORS
+! VPGAUSDIS ARRAY OF GAUSSIAN WEIGHTING FACTORS
+! VPSLWWT ARRAY OF GAUSSIAN WEIGHTING FACTORS
+! SUNFRAC ARRAY OF THE FRACTION OF SUN LEAVES. I = 1 IS THE TOP CANOPY LAYER, 2 IS THE NEXT LAYER, ETC.
+! SUNPPFD ARRAY OF INCOMING (NOT ABSORBED) PPFD ON A SUN LEAF [UMOL/M2/S]
+! SHADEPPFD ARRAY OF INCOMING (NOT ABSORBED) PPFD ON A SHADE LEAF [UMOL/M2/S]
+! SUNQV ARRAY OF VISIBLE RADIATION (IN AND OUT) FLUXES ON SUN LEAVES
+! SHADEQV ARRAY OF ABSORBED VISIBLE RADIATION (IN AND OUT) FLUXES ON SHADE LEAVES
+! SUNQN ARRAY OF ABSORBED NEAR IR RADIATION (IN AND OUT) FLUXES ON SUN LEAVES
+! SHADEQN ARRAY OF ABSORBED NEAR IR RADIATION (IN AND OUT) FLUXES ON SHADE LEAVES
+! SUNLEAFTK ARRAY OF LEAF TEMPERATURE FOR SUN LEAVES [K]
+! SUNLEAFSH ARRAY OF SENSIBLE HEAT FLUX FOR SUN LEAVES [W/M2]
+! SUNLEAFLH ARRAY OF LATENT HEAT FLUX FOR SUN LEAVES [W/M2]
+! SUNLEAFIR ARRAY OF INFRARED FLUX FOR SUN LEAVES [W/M2]
+! SHADELEAFTK ARRAY OF LEAF TEMPERATURE FOR SHADE LEAVES [K]
+! SHADELEAFSH ARRAY OF SENSIBLE HEAT FLUX FOR SHADE LEAVES [W/M2]
+! SHADELEAFLH ARRAY OF LATENT HEAT FLUX FOR SHADE LEAVES [W/M2]
+! SHADELEAFIR ARRAY OF INFRARED FLUX FOR SHADE LEAVES [W/M2]
+! QBABSV, QBABSN ABSORBED DIRECT BEAM LIGHT FOR VISIBLE AND NEAR INFRA RED
+! QDABSV, QDABSN ARRAY OF ABSORBED DIFFUSE LIGHT FOR VISIBLE AND NEAR INFRA RED
+! QSABSV, QSABSN ARRAY OF ABSORBED SCATTERED LIGHT FOR VISIBLE AND NEAR INFRA RED
+! QBEAMV, QBEAMN ABOVE CANOPY BEAM (DIRECT) LIGHT FOR VISIBLE AND NEAR INFRA RED
+! QDIFFV, QDIFFN ABOVE CANOPY DIFFUSE LIGHT FOR VISIBLE AND NEAR INFRA RED
+! EA1PLAYER ARRAY OF EMISSION ACTIVITY OF LIGHT PER LAYER
+! EA1TLAYER ARRAY OF EMISSION ACTIVITY OF TEMPERATURE PER LAYER
+! EA1LAYER ARRAY OF COMPANIED EMISSION ACTIVITY
+! EA1PCANOPY TOTAL EMISSION ACTIVITY OF LIGHT
+! EATILAYER ARRAY OF EMISSION ACTIVITY OF TEMPERATURE INDENDENT PER LAYER
+! EA1TCANOPY TOTAL EMISSION ACTIVITY OF TEMPERATURE DEPEDENT FACTOR
+! PEA1CANOPY TOTAL COMPANIED EMISSION ACTIVITY
+! PEATICANOPY TOTAL EMISSION ACTIVITY OF TEMPERATURE INDEPEDENT FACTOR
+! CALCBETA FUNCTION: CALCULATION OF SOLAR ZENITH ANGLE
+! WATERVAPPRES FUNCTION: CONVERT WATER MIXING RATIO (KG/KG) TO WATER VAPOR PRESSURE
+! STABILITY FUNCTION: TEMPERATURE LAPSE RATE
+! EA1T99 FUNCTION: TEMPERATURE DEPENDENCE ACTIVITY FACTOR FOR EMISSION TYPE 1
+! EA1P99 FUNCTION: LIGHT DEPENDENCE ACTIVITY FACTOR FOR EMISSION
+! EALTI FUNCTION: TEMPERATURE INDEPENDENCE ACTIVITY FACTOR FOR EMISSION
+! DISTOMATA FUNCTION:
+! CALCECCENTRICITY FUNCTION:
+!
+!XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
+!
+CONTAINS
+!
+SUBROUTINE GAMME_CE(KDATE, KTIME, PCANOPYCHAR, KCANTYPE, HSPCNAME, &
+ PPFD24, PPFD240, PT24, PT240, PDI, &
+ PPFD0, PLAT, PLONG, PTC, PWIND, PHUMIDITY, &
+ PLAI, PRES, PEA1CANOPY, PEATICANOPY) !!
+!
+IMPLICIT NONE
+! INPUT
+INTEGER,INTENT(IN) :: KDATE, KTIME, KCANTYPE
+REAL,DIMENSION(:,:),INTENT(IN) :: PCANOPYCHAR
+CHARACTER(LEN=16), INTENT(IN) :: HSPCNAME
+!
+REAL, DIMENSION(:), INTENT(IN) :: PT24, PT240, PPFD24, PPFD240
+REAL, INTENT(IN) :: PDI
+!
+REAL, DIMENSION(:), INTENT(IN) :: PPFD0
+REAL, DIMENSION(:), INTENT(IN) :: PLONG, PLAT
+REAL, DIMENSION(:), INTENT(IN) :: PTC, PRES, PWIND, PHUMIDITY, PLAI
+! ARRAY OF CANOPY CHARACTERISTICS FOR KRTYP OF CANOPY TYPE
+! OUTPUT
+REAL, DIMENSION(:), INTENT(OUT) :: PEA1CANOPY, PEATICANOPY
+!
+! LOCAL VARIABLES
+REAL, DIMENSION(NLAYERS) :: ZVPGAUSWT, ZVPGAUSDIS2, ZVPGAUSDIS
+!
+REAL, DIMENSION(SIZE(PLONG),NLAYERS) :: ZEA1LAYER, ZEATILAYER, ZVPSLWWT
+REAL, DIMENSION(SIZE(PLONG),NLAYERS) :: ZSUNFRAC, ZSUNQV, ZSHADEQV, ZSUNQN, ZSHADEQN, &
+ ZSUNPPFD, ZSHADEPPFD, ZSUNLEAFTK, ZSHADELEAFTK, &
+ ZSUNLEAFSH, ZSHADELEAFSH, Z_PPFD, Z_ALPHAP
+!
+REAL, DIMENSION(SIZE(PLONG)) :: ZHOUR, ZSINBETA, ZSOLAR, &
+ ZMAXSOLAR, ZQDIFFV, ZQBEAMV, ZQDIFFN, ZQBEAMN, &
+ ZHUMIDAIRPA0, ZTRATE
+!
+REAL :: ZSTOMATADI
+INTEGER, DIMENSION(SIZE(PLONG)) :: IDAY
+INTEGER :: JI, JJ
+!
+!---------------------------HEADER OVER--------------------------------
+!
+IDAY(:) = MOD(KDATE,1000)
+! CONVERT FROM XXXXXX FORMAT TO XX.XX (SOLAR HOUR)
+! HOUR = 0 -> 23.XX
+! SOLAR HOUR
+ZHOUR(:) = KTIME/10000. + PLONG(:)/15.
+!
+WHERE ( ZHOUR(:).LT.0. )
+ ZHOUR(:) = ZHOUR(:) + 24.
+ IDAY (:) = IDAY (:) - 1
+ELSEWHERE ( ZHOUR.GT.24. )
+ ZHOUR(:) = ZHOUR(:) - 24.
+ IDAY (:) = IDAY (:) + 1
+END WHERE
+!
+CALL SOLARANGLE(IDAY, ZHOUR, PLAT, ZSINBETA)
+
+!
+ZSOLAR (:) = PPFD0(:)/2.25
+ZMAXSOLAR(:) = ZSINBETA(:) * XSOLARCONSTANT * CALCECCENTRICITY(IDAY(:))
+CALL SOLARFRACTIONS(ZSOLAR, ZMAXSOLAR, ZQDIFFV, ZQBEAMV, ZQDIFFN, ZQBEAMN)
+!
+CALL GAUSSIANINTEGRATION(ZVPGAUSWT, ZVPGAUSDIS, ZVPGAUSDIS2)
+!
+CALL CANOPYRAD(KCANTYPE, PCANOPYCHAR, ZVPGAUSDIS, &
+ PLAI, ZSINBETA, ZQBEAMV, ZQDIFFV, ZQBEAMN, ZQDIFFN, &
+ ZSUNFRAC, ZSUNQV, ZSHADEQV, ZSUNQN, ZSHADEQN, &
+ ZSUNPPFD, ZSHADEPPFD)
+!
+ZTRATE (:) = STABILITY(PCANOPYCHAR, KCANTYPE, ZSOLAR)
+!
+ZSTOMATADI = DISTOMATA(PDI)
+!
+ZHUMIDAIRPA0(:) = WATERVAPPRES(XWATERAIRRATIO, PHUMIDITY, PRES)
+!
+CALL CANOPYEB(KCANTYPE, PCANOPYCHAR, ZVPGAUSDIS, ZSTOMATADI, &
+ PTC, PWIND, ZTRATE, ZHUMIDAIRPA0, &
+ ZSUNQV, ZSHADEQV, ZSUNQN, ZSHADEQN, ZSUNPPFD, ZSHADEPPFD, &
+ ZSUNLEAFTK, ZSHADELEAFTK, ZSUNLEAFSH, ZSHADELEAFSH)
+
+!ZEA1TCANOPY(:) = 0.
+!ZEA1PCANOPY(:) = 0.
+PEA1CANOPY (:) = 0.
+PEATICANOPY(:) = 0.
+
+DO JI = 1,SIZE(ZEA1LAYER,2)
+
+
+ !ZEA1TLAYER(:,JI) = EA1T99(ZSUNLEAFTK (:,JI), PT24, PT240, HSPCNAME) * ZSUNFRAC(:,JI) + &
+ ! EA1T99(ZSHADELEAFTK(:,JI), PT24, PT240, HSPCNAME) *(1.-ZSUNFRAC(:,JI))
+
+! PSTD = 200 FOR SUN LEAVES
+! PSTD = 50 FOR SHADE LEAVES
+ !ZEA1PLAYER(:,JI) = EA1P99(ZSUNPPFD(:,JI), PPFD24*0.5, PPFD240*0.5, XPSTD_SUN) * ZSUNFRAC(:,JI) + &
+ ! EA1P99(ZSHADEPPFD(:,JI), PPFD24*0.16, PPFD240*0.16, XPSTD_SHADE) * (1.-ZSUNFRAC(:,JI))
+
+ ZEA1LAYER(:,JI) = EA1T99(HSPCNAME , PT24 , PT240 , ZSUNLEAFTK (:,JI)) * &
+ EA1P99(XPSTD_SUN , PPFD24*0.5 , PPFD240*0.5 , ZSUNPPFD (:,JI)) * ZSUNFRAC(:,JI) + &
+ EA1T99(HSPCNAME , PT24 , PT240 , ZSHADELEAFTK(:,JI)) * &
+ EA1P99(XPSTD_SHADE, PPFD24*0.16, PPFD240*0.16, ZSHADEPPFD (:,JI) ) * (1.-ZSUNFRAC(:,JI))
+
+ ZEATILAYER(:,JI) = EALTI99(HSPCNAME, ZSUNLEAFTK (:,JI)) * ZSUNFRAC(:,JI) + &
+ EALTI99(HSPCNAME, ZSHADELEAFTK(:,JI)) * (1-ZSUNFRAC(:,JI))
+
+ Z_PPFD(:,JI) = ZSUNPPFD(:,JI) * ZSUNFRAC(:,JI) + ZSHADEPPFD(:,JI) * (1.-ZSUNFRAC(:,JI))
+
+ Z_ALPHAP(:,JI) = EA1P99(XPSTD_SUN , PPFD24*0.5 , PPFD240*0.5 , ZSUNPPFD (:,JI)) * ZSUNFRAC(:,JI) + &
+ EA1P99(XPSTD_SHADE, PPFD24*0.16, PPFD240*0.16, ZSHADEPPFD (:,JI) ) * (1.-ZSUNFRAC(:,JI)) !!
+ ! IF (KCANTYPE == 15) THEN
+ ! PRINT*, JI, ZSUNPPFD(:,JI)
+ !ENDIF
+
+ENDDO
+
+CALL WEIGHTSLW(ZVPGAUSDIS, PLAI, ZVPSLWWT)
+!
+DO JJ = 1,SIZE(PEA1CANOPY)
+! ZEA1PCANOPY(JJ) = SUM(ZEA1PLAYER(JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) )
+! ZEA1TCANOPY(JJ) = SUM(ZEA1TLAYER(JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) )
+ PEA1CANOPY (JJ) = SUM(ZEA1LAYER (JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) )
+ PEATICANOPY(JJ) = SUM(ZEATILAYER(JJ,:) * ZVPSLWWT(JJ,:) * ZVPGAUSWT(:) )
+! THIS QUANTITY IS APPARENTLY NOT PASSED OUT OF THE SUBROUTINE
+! ZSH(JJ) = SUM( ( ZSUNLEAFSH (JJ,:) * ZSUNFRAC(:,JJ) + &
+! ZSHADELEAFSH(JJ,:) * (1 - ZSUNFRAC(:,JJ))) * PLAI(:) * ZVPGAUSWT(:) )
+ENDDO
+
+
+PEA1CANOPY(:) = PEA1CANOPY(:) * XCCE * PLAI(:)
+
+
+END SUBROUTINE GAMME_CE
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE GAUSSIANINTEGRATION
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE GAUSSIANINTEGRATION(PWEIGHTGAUSS, PDISTGAUSS, PDISTGAUSS2)
+!
+IMPLICIT NONE
+!
+REAL,DIMENSION(:),INTENT(OUT) :: PWEIGHTGAUSS, PDISTGAUSS, PDISTGAUSS2
+!
+! LOCAL VARIABLES
+INTEGER :: JI
+!--------------------------------------------------------------------
+!
+IF ( NLAYERS.EQ.1 ) THEN
+ PWEIGHTGAUSS(1) = 1
+ PDISTGAUSS (1) = 0.5
+ PDISTGAUSS2 (1) = 1
+ELSEIF ( NLAYERS.EQ.3 ) THEN
+ PWEIGHTGAUSS(1) = 0.277778
+ PWEIGHTGAUSS(2) = 0.444444
+ PWEIGHTGAUSS(3) = 0.277778
+ PDISTGAUSS(1) = 0.112702
+ PDISTGAUSS(2) = 0.5
+ PDISTGAUSS(3) = 0.887298
+ PDISTGAUSS2(1) = 0.277778
+ PDISTGAUSS2(2) = 0.722222
+ PDISTGAUSS2(3) = 1
+ELSEIF ( NLAYERS.EQ.5 ) THEN
+ PWEIGHTGAUSS(1) = 0.1184635
+ PWEIGHTGAUSS(2) = 0.2393144
+ PWEIGHTGAUSS(3) = 0.284444444
+ PWEIGHTGAUSS(4) = 0.2393144
+ PWEIGHTGAUSS(5) = 0.1184635
+ PDISTGAUSS(1) = 0.0469101
+ PDISTGAUSS(2) = 0.2307534
+ PDISTGAUSS(3) = 0.5
+ PDISTGAUSS(4) = 0.7692465
+ PDISTGAUSS(5) = 0.9530899
+ PDISTGAUSS2(1) = 0.1184635
+ PDISTGAUSS2(2) = 0.3577778
+ PDISTGAUSS2(3) = 0.6422222
+ PDISTGAUSS2(4) = 0.881536
+ PDISTGAUSS2(5) = 1.0
+ELSE
+ DO JI = 1,NLAYERS
+ PWEIGHTGAUSS(JI) = 1. / NLAYERS
+ PDISTGAUSS (JI) = (JI - 0.5) / NLAYERS
+ PDISTGAUSS2 (JI) = JI / NLAYERS
+ ENDDO
+ENDIF
+
+END SUBROUTINE GAUSSIANINTEGRATION
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE WEIGHTSLW
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE WEIGHTSLW(PDISTGAUSS, PLAI, PSLW)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PLAI
+REAL, DIMENSION(:), INTENT(IN) :: PDISTGAUSS
+
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSLW
+
+! LOCAL VARIABLES
+INTEGER :: JI
+!--------------------------------------------------
+
+DO JI = 1,NLAYERS
+ PSLW(:,JI) = 0.63 + 0.37 * EXP(-((PLAI(:) * PDISTGAUSS(JI)) - 1.))
+ENDDO
+
+END SUBROUTINE WEIGHTSLW
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE SOLARFRACTIONS
+! TRANSMISSION, FRACTION OF PPFD THAT IS DIFFUSE,
+! FRACTION OF SOLAR RAD THAT IS PPFD
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE SOLARFRACTIONS(PSOLAR, PMAXSOLAR, PQDIFFV, PQBEAMV, PQDIFFN, PQBEAMN)
+!
+IMPLICIT NONE
+!
+! INTEGER,INTENT(IN) :: TIMEPERIOD
+REAL, DIMENSION(:), INTENT(IN) :: PSOLAR, PMAXSOLAR
+!
+REAL, DIMENSION(:), INTENT(OUT) :: PQDIFFV, PQBEAMV, PQDIFFN, PQBEAMN
+!
+! INTERNAL VARIABLES
+REAL :: ZFRACDIFF, ZPPFDFRAC, ZPPFDDIFFRAC, ZQV, ZQN
+REAL :: ZTRANSMIS
+INTEGER :: JJ
+!-----------------------------------------------------
+! IF (TIMEPERIOD .EQ. 1) THEN ! DAILY TRANSMISSION
+! TRANSMIN = 0.26
+! TRANSSLOPE= 1.655
+! ELSE ! HOURLY TRANSMISSION
+! TRANSMIN = 0.26
+! TRANSSLOPE = 1.655
+! ENDIF
+DO JJ = 1,SIZE(PSOLAR)
+
+ IF (PMAXSOLAR(JJ)<=0) THEN
+ ZTRANSMIS = 0.5
+ ELSEIF (PMAXSOLAR(JJ)<PSOLAR(JJ)) THEN
+ ZTRANSMIS = 1.0
+ ELSE
+ ZTRANSMIS = PSOLAR(JJ) / PMAXSOLAR(JJ)
+ ENDIF
+
+! ESTIMATE DIFFUSE FRACTION BASED ON DAILY TRANSMISSION (RODERICK 1999, GOUDRIANN AND VAN LAAR 1994- P.33)
+
+! IF (TRANSMIS > 0.81) THEN
+! FRACDIFF = 0.05
+! ELSEIF (TRANSMIS > TRANSMIN) THEN
+! FRACDIFF = 0.96-TRANSSLOPE * (TRANSMIS - TRANSMIN)
+! ELSE
+! FRACDIFF = 0.96
+! ENDIF
+
+! THE FRACTION OF TOTAL SOLAR RADIATION THAT IS PPFD (43% TO 55%)
+! G. AND L. 84
+! PPFDFRAC = 0.43 + FRACDIFF * 0.12
+
+!FRACDIFF IS BASED ON LIZASO 2005
+!MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT
+ ZFRACDIFF = 0.156 + 0.86/(1 + EXP(11.1*(ZTRANSMIS -0.53)))
+
+!PPFDFRAC IS BASED ON G.L. 84
+!MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT
+ ZPPFDFRAC = 0.55 -ZTRANSMIS*0.12
+
+!PPFDDIFFRAC IS BASED ON DATA IN JACOVIDES 2007
+!MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT
+ ZPPFDDIFFRAC = ZFRACDIFF * (1.06 + ZTRANSMIS*0.4)
+
+! CALCULTE QDIFFV,QBEAMV, QDIFFN, QBEAMN IN THE SUBROUTINE
+! MODIFIED BY XUEMEI 2010-01-26 ACCORDING TO ALEX'S DOCUMENT
+ IF (ZPPFDDIFFRAC > 1.0) ZPPFDDIFFRAC = 1.0
+
+ ZQV = ZPPFDFRAC * PSOLAR(JJ)
+ PQDIFFV(JJ) = ZQV * ZPPFDDIFFRAC
+ PQBEAMV(JJ) = ZQV - PQDIFFV(JJ)
+ ZQN = PSOLAR(JJ) - ZQV
+ PQDIFFN(JJ) = ZQN * ZFRACDIFF
+ PQBEAMN(JJ) = ZQN - PQDIFFN(JJ)
+
+ENDDO
+
+END SUBROUTINE SOLARFRACTIONS
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE CANOPYRAD
+!
+! CANOPY LIGHT ENVIRONMENT MODEL
+! CODE DEVELOPED BY ALEX GUENTHER, BASED ON SPITTERS ET AL. (1986),
+! GOUDRIAN AND LAAR (1994), LEUNING (1997)
+! INITIAL CODE 8-99, MODIFIED 7-2000 AND 12-2001
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+SUBROUTINE CANOPYRAD(KCANTYPE, PCANOPYCHAR, PDISTGAUSS, &
+ PLAI, PSINBETA, PQBEAMV, PQDIFFV, PQBEAMN, PQDIFFN, &
+ PSUNFRAC, PSUNQV, PSHADEQV, PSUNQN, PSHADEQN, &
+ PSUNPPFD, PSHADEPPFD, &
+ PQDABSV, PQDABSN, PQSABSV, PQSABSN, PQBABSV, PQBABSN)
+
+IMPLICIT NONE
+
+! INPUT
+INTEGER, INTENT(IN) :: KCANTYPE
+REAL, DIMENSION(:,:), INTENT(IN) :: PCANOPYCHAR
+REAL, DIMENSION(:), INTENT(IN) :: PDISTGAUSS
+!
+REAL, DIMENSION(:), INTENT(IN) :: PLAI, PSINBETA, PQBEAMV, PQDIFFV, PQBEAMN, PQDIFFN
+! OUTPUT
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSUNFRAC, PSUNQV, PSHADEQV, &
+ PSUNQN, PSHADEQN, PSHADEPPFD, PSUNPPFD
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PQDABSV, PQDABSN, PQSABSV, PQSABSN
+REAL, DIMENSION(:), INTENT(OUT), OPTIONAL :: PQBABSV, PQBABSN
+
+! INTERNAL VARIABLES
+REAL, DIMENSION(SIZE(PQBEAMV)) :: ZKB, ZLAIDEPTH, ZQDABSVL, ZQSABSVL, ZQDABSNL, ZQSABSNL, &
+ ZREFLBV, ZREFLBN, ZKBPV, ZKBPN, ZKDPV, ZKDPN
+REAL, DIMENSION(SIZE(PQBEAMV)) :: ZQBABSV, ZQBABSN
+REAL :: ZSCATV, ZSCATN, ZREFLDV, ZREFLDN, ZKD, ZCLUSTER
+!
+INTEGER :: JI, JJ
+!
+!---------------------------------------------------------------------
+
+
+! SCATTERING COEFFICIENTS (SCATV,SCATN), DIFFUSE AND BEAM REFLECTION
+! COEFFICIENTS (REF..) FOR VISIBLE OR NEAR IR
+ZSCATV = PCANOPYCHAR(5,KCANTYPE)
+ZSCATN = PCANOPYCHAR(6,KCANTYPE)
+ZREFLDV = PCANOPYCHAR(7,KCANTYPE)
+ZREFLDN = PCANOPYCHAR(8,KCANTYPE)
+ZCLUSTER = PCANOPYCHAR(9,KCANTYPE)
+!
+! EXTINCTION COEFFICIENTS FOR BLACK LEAVES FOR BEAM (KB) OR DIFFUSE (KD)
+ZKB(:) = ZCLUSTER * 0.5 / MAX(0.00002,PSINBETA(:))
+! (0.5 ASSUMES A SPHERICAL LEAF ANGLE DISTRIBUTION (0.5 = COS (60 DEG))
+ZKD = 0.8 * ZCLUSTER
+! (0.8 ASSUMES A SPHERICAL LEAF ANGLE DISTRIBUTION)
+
+CALL CALCEXTCOEFF(ZSCATV,ZKD,PQBEAMV,ZKB,ZREFLBV,ZKBPV,ZKDPV,ZQBABSV)
+CALL CALCEXTCOEFF(ZSCATN,ZKD,PQBEAMN,ZKB,ZREFLBN,ZKBPN,ZKDPN,ZQBABSN)
+
+PSUNFRAC(:,:) = 0.
+DO JI = 1,NLAYERS
+
+! PLAI DEPTH AT THIS LAYER
+ ZLAIDEPTH(:) = PLAI(:) * PDISTGAUSS(JI)
+!FRACTION OF LEAVES THAT ARE SUNLIT
+ PSUNFRAC(:,JI) = EXP(-ZKB(:) * ZLAIDEPTH(:))
+
+
+ CALL CALCRADCOMPONENTS(ZSCATV, ZREFLDV, PQDIFFV, PQBEAMV, ZKDPV, ZKBPV, ZKB, &
+ ZREFLBV, ZLAIDEPTH, ZQDABSVL, ZQSABSVL)
+
+ CALL CALCRADCOMPONENTS(ZSCATN, ZREFLDN, PQDIFFN, PQBEAMN, ZKDPN, ZKBPN, ZKB, &
+ ZREFLBN, ZLAIDEPTH, ZQDABSNL, ZQSABSNL)
+
+
+ PSHADEPPFD(:,JI) = (ZQDABSVL(:) + ZQSABSVL(:)) * XCONVERTSHADEPPFD / (1. - ZSCATV)
+ PSUNPPFD (:,JI) = PSHADEPPFD(:,JI) + (ZQBABSV(:) * XCONVERTSUNPPFD / (1. - ZSCATV))
+ PSHADEQV (:,JI) = ZQDABSVL(:) + ZQSABSVL(:)
+ PSUNQV (:,JI) = PSHADEQV(:,JI) + ZQBABSV(:)
+ PSHADEQN (:,JI) = ZQDABSNL(:) + ZQSABSNL(:)
+ PSUNQN (:,JI) = PSHADEQN(:,JI) + ZQBABSN(:)
+ IF (PRESENT(PQDABSV)) PQDABSV (:,JI) = ZQDABSVL(:)
+ IF (PRESENT(PQSABSV)) PQSABSV (:,JI) = ZQSABSVL(:)
+ IF (PRESENT(PQDABSN)) PQDABSN (:,JI) = ZQDABSNL(:)
+ IF (PRESENT(PQSABSN)) PQSABSN (:,JI) = ZQSABSNL(:)
+!
+
+ENDDO
+
+
+DO JJ = 1,SIZE(PQBEAMV)
+
+ IF ( (PQBEAMV(JJ)+PQDIFFV(JJ))<=0.001 .OR. PSINBETA(JJ)<=0.00002 .OR. PLAI(JJ)<=0.001 ) THEN
+ ! NIGHT TIME
+ ZQBABSV(JJ) = 0.
+ ZQBABSN(JJ) = 0.
+
+ PSUNFRAC (JJ,:) = 0.2
+ PSUNQN (JJ,:) = 0.
+ PSHADEQN (JJ,:) = 0.
+ PSUNQV (JJ,:) = 0.
+ PSHADEQV (JJ,:) = 0.
+ PSUNPPFD (JJ,:) = 0.
+ PSHADEPPFD(JJ,:) = 0.
+ IF (PRESENT(PQDABSV)) PQDABSV(JJ,:) = 0.
+ IF (PRESENT(PQSABSV)) PQSABSV(JJ,:) = 0.
+ IF (PRESENT(PQDABSN)) PQDABSN(JJ,:) = 0.
+ IF (PRESENT(PQSABSN)) PQSABSN(JJ,:) = 0.
+
+ ENDIF
+
+END DO
+
+IF (PRESENT(PQBABSV)) PQBABSV(:) = ZQBABSV(:)
+IF (PRESENT(PQBABSN)) PQBABSN(:) = ZQBABSN(:)
+
+END SUBROUTINE CANOPYRAD
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE CALCEXTCOEFF
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE CALCEXTCOEFF(PSCAT, PKD, PQBEAM, PKB, PREFLB, PKBP, PKDP, PQBEAMABSORB)
+!
+IMPLICIT NONE
+!
+REAL, INTENT(IN) :: PSCAT, PKD
+REAL, DIMENSION(:), INTENT(IN) :: PQBEAM, PKB
+REAL, DIMENSION(:), INTENT(OUT) :: PREFLB, PKBP, PKDP, PQBEAMABSORB
+
+! LOCAL VARIABLES
+REAL :: ZP
+INTEGER :: JJ
+!-------------------------------------------------------------------
+
+ZP = (1.-PSCAT)**0.5
+
+DO JJ = 1,SIZE(PKB)
+
+ PREFLB(JJ) = 1. - EXP((-2. * ((1.-ZP)/(1.+ZP)) * PKB(JJ)) / (1. + PKB(JJ)))
+
+ ! EXTINCTION COEFFICIENTS
+ PKBP(JJ) = PKB(JJ) * ZP
+ PKDP(JJ) = PKD * ZP
+ ! ABSORBED BEAM RADIATION
+ PQBEAMABSORB(JJ) = PKB(JJ) * PQBEAM(JJ) * (1 - PSCAT)
+
+ENDDO
+
+END SUBROUTINE CALCEXTCOEFF
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE CALCRADCOMPONENTS
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE CALCRADCOMPONENTS(PSCAT, PREFLD, PQDIFF, PQBEAM, PKDP, PKBP, PKB, &
+ PREFLB, PLAIDEPTH, PQDABS, PQSABS)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PSCAT, PREFLD
+REAL, DIMENSION(:), INTENT(IN) :: PQDIFF, PQBEAM, PKDP, PKBP, PKB, PREFLB, PLAIDEPTH
+REAL, DIMENSION(:), INTENT(OUT) :: PQDABS, PQSABS
+!-------------------------------------------------------------------
+
+PQDABS(:) = PQDIFF(:) * PKDP(:) * (1. - PREFLD) * EXP(-PKDP(:) * PLAIDEPTH(:))
+
+PQSABS(:) = PQBEAM(:) * ((PKBP(:) * (1. - PREFLB(:)) * EXP(-PKBP(:) * PLAIDEPTH(:))) &
+ - (PKB(:) * (1. - PSCAT) * EXP(-PKB (:) * PLAIDEPTH(:))))
+
+END SUBROUTINE CALCRADCOMPONENTS
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE CANOPYEB
+!
+! CANOPY ENERGY BALANCE MODEL FOR ESTIMATING LEAF TEMPERATURE
+! CODE DEVELOPED BY ALEX GUENTHER, BASED ON GOUDRIAN AND LAAR (1994),
+! LEUNING (1997)
+! INITIAL CODE 8-99, MODIFIED 7-2000 AND 12-2001
+!
+! NOTE: I DENOTES AN ARRAY CONTAINING A VERTICAL PROFILE THROUGH THE
+! CANOPY WITH 0
+! (ABOVE CANOPY CONDITIONS) PLUS 1 TO NUMBER OF CANOPY LAYERS
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE CANOPYEB(KCANTYPE, PCANOPYCHAR, PDISTGAUSS, PSTOMATADI, &
+ PTAIRK0, PWS0, PTRATE, PHUMIDAIRPA0, &
+ PSUNQV, PSHADEQV, PSUNQN, PSHADEQN, PSUNPPFD, PSHADEPPFD, &
+ PSUNLEAFTK, PSHADELEAFTK, PSUNLEAFSH, PSHADELEAFSH, &
+ PTAIRK, PHUMIDAIRPA, PWS, &
+ PSUNLEAFLH, PSUNLEAFIR, PSHADELEAFLH, PSHADELEAFIR)
+
+IMPLICIT NONE
+
+! INPUTS
+INTEGER, INTENT(IN) :: KCANTYPE
+REAL, DIMENSION(:,:), INTENT(IN) :: PCANOPYCHAR
+REAL, DIMENSION(:), INTENT(IN) :: PDISTGAUSS
+REAL, INTENT(IN) :: PSTOMATADI
+!
+REAL, DIMENSION(:), INTENT(IN) :: PTRATE, PTAIRK0, PWS0, PHUMIDAIRPA0
+REAL, DIMENSION(:,:), INTENT(IN) :: PSUNQV, PSHADEQV, &
+ PSUNQN, PSHADEQN, PSUNPPFD, PSHADEPPFD
+
+! OUTPUTS
+REAL, DIMENSION(:,:), INTENT(OUT) :: PSUNLEAFTK, PSHADELEAFTK, PSUNLEAFSH, PSHADELEAFSH
+!
+REAL, DIMENSION(:,:), INTENT(OUT), OPTIONAL :: PTAIRK, PHUMIDAIRPA, PWS, &
+ PSUNLEAFLH, PSHADELEAFLH,&
+ PSUNLEAFIR, PSHADELEAFIR
+! LOCAL VARIABLES
+REAL :: ZLDEPTH, ZWSH
+REAL, DIMENSION(SIZE(PTRATE)) :: ZTAIRK, ZHUMIDAIRPA, ZWS, &
+ ZSUNLEAFLH, ZSHADELEAFLH, ZSUNLEAFIR, ZSHADELEAFIR
+!
+REAL, DIMENSION(SIZE(PTRATE)) :: ZDELTAH, ZIRIN, ZIROUT
+REAL :: ZCDEPTH, ZLWIDTH, ZLLENGTH, ZCHEIGHT, ZEPS, ZTRANSPIRETYPE
+INTEGER :: JI
+!
+!-----------------------------------------------------------------------
+
+ZCDEPTH = PCANOPYCHAR(1, KCANTYPE)
+!ZLWIDTH = PCANOPYCHAR(2, KCANTYPE)
+ZLLENGTH = PCANOPYCHAR(3, KCANTYPE)
+ZCHEIGHT = PCANOPYCHAR(4, KCANTYPE)
+ZEPS = PCANOPYCHAR(10,KCANTYPE)
+ZTRANSPIRETYPE = PCANOPYCHAR(11,KCANTYPE)
+
+WHERE ( PTAIRK0(:) >288. )
+! PA M-1 (PHUMIDITY PROFILE FOR T < 288)
+ ZDELTAH(:) = PCANOPYCHAR(14,KCANTYPE) / ZCHEIGHT
+ELSEWHERE ( PTAIRK0(:)>278. )
+ ZDELTAH(:) = ( PCANOPYCHAR(14,KCANTYPE) - ( (288.-PTAIRK0(:))/10.) * &
+ ( PCANOPYCHAR(14,KCANTYPE) - PCANOPYCHAR(15,KCANTYPE)) ) / ZCHEIGHT
+ELSEWHERE
+! PA M-1 (PHUMIDITY PROFILE FOR T <278)
+ ZDELTAH(:) = PCANOPYCHAR(15,KCANTYPE) / ZCHEIGHT
+END WHERE
+
+DO JI = 1,SIZE(PDISTGAUSS)
+
+ ZLDEPTH = ZCDEPTH * PDISTGAUSS(JI)
+ ZWSH = ( ZCHEIGHT - ZLDEPTH ) - ( PCANOPYCHAR(16,KCANTYPE) * ZCHEIGHT )
+
+ ZTAIRK (:) = PTAIRK0 (:) + (PTRATE (:) * ZLDEPTH) ! CHECK THIS
+ ZHUMIDAIRPA(:) = PHUMIDAIRPA0(:) + (ZDELTAH(:) * ZLDEPTH)
+ IF ( ZWSH.GT.1E-3 ) THEN
+ ZWS(:) = ( PWS0(:) * LOG(ZWSH) / LOG(ZCHEIGHT-PCANOPYCHAR(16,KCANTYPE)*ZCHEIGHT) )
+ ELSE
+ ZWS(:) = 0.05
+ END IF
+
+ ZIRIN(:) = UNEXPOSEDLEAFIRIN(ZEPS, ZTAIRK)
+
+ ZSUNLEAFIR(:) = 0.5 * EXPOSEDLEAFIRIN(PHUMIDAIRPA0,PTAIRK0) + 1.5*ZIRIN(:)
+
+! SUN
+ CALL LEAFEB(ZEPS, ZTRANSPIRETYPE, ZLLENGTH, PSTOMATADI, &
+ PSUNPPFD(:,JI), PSUNQV(:,JI)+PSUNQN(:,JI), &
+ ZSUNLEAFIR, ZTAIRK, ZHUMIDAIRPA, ZWS, &
+ PSUNLEAFTK(:,JI), PSUNLEAFSH(:,JI), ZSUNLEAFLH, &
+ ZIROUT )
+!
+ IF (PRESENT(PSUNLEAFIR)) PSUNLEAFIR(:,JI) = ZSUNLEAFIR(:) - ZIROUT(:)
+
+! SHADE
+ ZSHADELEAFIR(:) = 2. * ZIRIN(:)
+
+ CALL LEAFEB(ZEPS, ZTRANSPIRETYPE, ZLLENGTH, PSTOMATADI, &
+ PSHADEPPFD(:,JI), PSHADEQV(:,JI)+PSHADEQN(:,JI), &
+ ZSHADELEAFIR, ZTAIRK, ZHUMIDAIRPA, ZWS, &
+ PSHADELEAFTK(:,JI), PSHADELEAFSH(:,JI), ZSHADELEAFLH, &
+ ZIROUT )
+!
+ IF (PRESENT(PSHADELEAFIR)) PSHADELEAFIR(:,JI) = ZSHADELEAFIR(:) - ZIROUT(:)
+
+ IF (PRESENT(PTAIRK)) PTAIRK (:,JI) = ZTAIRK (:)
+ IF (PRESENT(PHUMIDAIRPA)) PHUMIDAIRPA (:,JI) = ZHUMIDAIRPA (:)
+ IF (PRESENT(PWS)) PWS (:,JI) = ZWS (:)
+ IF (PRESENT(PSUNLEAFLH)) PSUNLEAFLH (:,JI) = ZSUNLEAFLH (:)
+ IF (PRESENT(PSHADELEAFLH)) PSHADELEAFLH(:,JI) = ZSHADELEAFLH(:)
+
+ENDDO
+!
+END SUBROUTINE CANOPYEB
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! SUBROUTINE LEAFEB
+!
+! LEAF ENERGY BALANCE
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+SUBROUTINE LEAFEB(PEPS, PTRANSPIRETYPE, PLLENGTH, PSTOMATADI, &
+ PPFD, PQ, PIRIN, PTAIRK, PHUMIDAIRPA, PWS, &
+ PTLEAF, PSH, PLH, PIROUT)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PEPS, PTRANSPIRETYPE, PLLENGTH, PSTOMATADI
+REAL, DIMENSION(:), INTENT(IN) :: PPFD, PQ, PIRIN, PTAIRK, PHUMIDAIRPA, PWS
+REAL, DIMENSION(:), INTENT(OUT) :: PTLEAF, PSH, PLH, PIROUT
+
+! LOCAL VARIABLES
+REAL, DIMENSION(SIZE(PPFD)) :: ZHUMIDAIRKGM3, ZGHFORCED, ZSTOMRES, ZIROUTAIRT, ZLATHV, &
+ ZLHAIRT, ZTDELT, ZBALANCE, ZGH1, ZSH1, ZLH1, ZE1, ZIROUT1, ZGH, &
+ ZTAIRK, ZVAPDEFICIT
+INTEGER :: JI
+!----------------------------------------------------
+
+! AIR VAPOR DENSITY KG M-3
+ZHUMIDAIRKGM3(:) = CONVERTHUMIDITYPA2KGM3(PHUMIDAIRPA, PTAIRK)
+
+! LATENT HEAT OF VAPORIZATION (J KG-1)
+ZLATHV(:) = LHV(PTAIRK)
+!
+! HEAT CONVECTION COEFFICIENT (W M-2 K-1) FOR FORCED CONVECTION.
+! NOBEL PAGE 366
+ZGHFORCED(:) = 0.0259 / (0.004 * ((PLLENGTH / PWS(:))**0.5))
+!
+! STOMATAL RESISTENCE S M-1
+ZSTOMRES (:) = RESSC(PSTOMATADI, PPFD)
+!
+! LATENT HEAT FLUX
+ZVAPDEFICIT(:) = SVDTK(PTAIRK(:)) - ZHUMIDAIRKGM3(:)
+ZLHAIRT(:) = LEAFLE(PTRANSPIRETYPE, ZVAPDEFICIT, ZLATHV, ZGHFORCED, ZSTOMRES)
+!
+ZIROUTAIRT(:) = LEAFIROUT(PEPS, PTAIRK)
+ZE1(:) = (PQ(:) + PIRIN(:) - ZIROUTAIRT(:) - ZLHAIRT(:))
+WHERE ( ZE1(:).EQ.0. ) ZE1(:) = -1.
+!
+ZTDELT (:) = 1.
+ZBALANCE(:) = 10.
+DO JI = 1, 10
+ !
+ WHERE ( ABS(ZBALANCE(:))>2. )
+ !
+ ZTAIRK (:) = PTAIRK(:) + ZTDELT(:)
+ !
+ ! LATENT HEAT OF VAPORIZATION (J KG-1)
+ ZLATHV(:) = LHV(ZTAIRK)
+ ! BOUNDARY LAYER CONDUCTANCE
+ ZGH1 (:) = LEAFBLC(PLLENGTH, ZGHFORCED, ZTDELT)
+ !
+ ZVAPDEFICIT(:) = SVDTK(ZTAIRK(:)) - ZHUMIDAIRKGM3(:)
+ PLH (:) = LEAFLE(PTRANSPIRETYPE, ZVAPDEFICIT, ZLATHV, ZGH1, ZSTOMRES)
+ !
+ PIROUT (:) = LEAFIROUT(PEPS, PTAIRK+ZTDELT)
+ ZIROUT1(:) = PIROUT(:) - ZIROUTAIRT(:)
+ !
+ ! CONVECTIVE HEAT FLUX
+ ZSH1(:) = LEAFH(ZTDELT, ZGH1)
+ ZLH1(:) = PLH(:) - ZLHAIRT(:)
+ !
+ ZTDELT (:) = ZE1(:) / ((ZSH1(:) + ZLH1(:) + ZIROUT1(:)) / ZTDELT(:))
+ ZBALANCE(:) = PQ(:) + PIRIN(:) - PIROUT(:) - ZSH1(:) - PLH(:)
+ END WHERE
+ !
+ IF (ALL(ZBALANCE(:)<=2.)) EXIT
+ !
+ENDDO
+!
+ZTDELT(:) = MAX(-10.,MIN(ZTDELT(:),10.))
+!
+PTLEAF(:) = PTAIRK(:) + ZTDELT(:)
+!
+ZGH(:) = LEAFBLC(PLLENGTH, ZGHFORCED, ZTDELT)
+PSH(:) = LEAFH (ZTDELT, ZGH)
+!
+ZVAPDEFICIT(:) = SVDTK(PTLEAF(:)) - ZHUMIDAIRKGM3(:)
+PLH(:) = LEAFLE (PTRANSPIRETYPE, ZVAPDEFICIT, ZLATHV, ZGH, ZSTOMRES)
+PIROUT(:) = LEAFIROUT(PEPS, PTLEAF)
+!
+END SUBROUTINE LEAFEB
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION DISTOMATA
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION DISTOMATA(PDI) RESULT(PDISTOMATA)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PDI
+REAL :: PDISTOMATA
+INTEGER :: JJ
+! > -.5 INCIPIENT, MILD OR NO DROUGHT; < -4 EXTREME DROUGHT
+!--------------------------------------------------------------------
+
+IF ( PDI>XDIHIGH ) THEN
+ PDISTOMATA = 1. ! NO DROUGHT
+ELSEIF ( PDI>XDILOW ) THEN
+ ! INTERPOLATE
+ PDISTOMATA = 1. - (0.9 * ((PDI - XDIHIGH) / (XDILOW - XDIHIGH)))
+ELSE
+ PDISTOMATA = 0. ! MAXIMUM DROUGHT, MAXIMUM STOMATAL RESISTANCE
+ENDIF
+
+END FUNCTION DISTOMATA
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION CALCECCENTRICITY
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION CALCECCENTRICITY(KDAY) RESULT(PCALCECCENTRICITY)
+
+IMPLICIT NONE
+
+INTEGER, DIMENSION(:), INTENT(IN) :: KDAY
+!
+REAL, DIMENSION(SIZE(KDAY)) :: PCALCECCENTRICITY
+!
+!--------------------------------------------------------------------
+
+PCALCECCENTRICITY(:) = 1. + 0.033 * COS(2*3.14*(KDAY(:)-10)/365)
+
+END FUNCTION CALCECCENTRICITY
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION UNEXPOSEDLEAFIRIN
+!
+! CALCULATE IR INTO LEAF THAT IS NOT EXPOSED TO THE SKY
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION UNEXPOSEDLEAFIRIN(PEPS, PTK) RESULT(PUNEXPOSEDLEAFIRIN)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PEPS
+REAL, DIMENSION(:), INTENT(IN) :: PTK
+REAL, DIMENSION(SIZE(PTK)) :: PUNEXPOSEDLEAFIRIN
+!--------------------------------------------------------------------
+
+PUNEXPOSEDLEAFIRIN(:) = PEPS * XSB * (PTK(:)**4.)
+
+END FUNCTION UNEXPOSEDLEAFIRIN
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION EXPOSEDLEAFIRIN
+!
+! CALCULATE IR INTO LEAF THAT IS EXPOSED TO THE SKY
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION EXPOSEDLEAFIRIN(PHUMIDPA, PTK) RESULT(PEXPOSEDLEAFIRIN)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PTK, PHUMIDPA
+REAL, DIMENSION(SIZE(PTK)) :: PEXPOSEDLEAFIRIN
+REAL :: ZEMISSATM
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+! APPARENT ATMOSPHERIC EMISSIVITY FOR CLEAR SKIES:
+! FUNCTION OF WATER VAPOR PRESSURE (PA)
+! AND AMBIENT TEMPERATURE (K) BASED ON BRUTSAERT(1975)
+! REFERENCED IN LEUNING (1997)
+
+DO JJ = 1,SIZE(PTK)
+ ZEMISSATM = 0.642 * (PHUMIDPA(JJ) / PTK(JJ))**(1./7.)
+ PEXPOSEDLEAFIRIN(JJ) = ZEMISSATM * XSB * (PTK(JJ)**4.)
+ENDDO
+
+END FUNCTION EXPOSEDLEAFIRIN
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION WATERVAPPRES
+!
+! CONVERT WATER MIXING RATIO (KG/KG) TO WATER VAPOR PRESSURE
+! (PA OR KPA DEPENDING ON UNITS OF INPUT )
+! MIXING RATIO (KG/KG), TEMP (C), PRESSURE (KPA)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION WATERVAPPRES(PWATERAIRRATIO, PDENS, PRES) RESULT(PWATERVAPPRES)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PWATERAIRRATIO
+REAL, DIMENSION(:), INTENT(IN) :: PDENS, PRES
+REAL, DIMENSION(SIZE(PDENS)) :: PWATERVAPPRES
+!--------------------------------------------------------------------
+
+PWATERVAPPRES(:) = (PDENS(:) / (PDENS(:) + PWATERAIRRATIO)) * PRES(:)
+
+END FUNCTION WATERVAPPRES
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION STABILITY
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION STABILITY(PCANOPYCHAR, KCANTYPE, PSOLAR) RESULT(PSTABILITY)
+
+IMPLICIT NONE
+!
+REAL, DIMENSION(:,:), INTENT(IN) :: PCANOPYCHAR
+INTEGER, INTENT(IN) :: KCANTYPE
+REAL, DIMENSION(:), INTENT(IN) :: PSOLAR
+REAL, DIMENSION(SIZE(PSOLAR)) :: PSTABILITY
+REAL :: ZTRATEBOUNDARY
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+ZTRATEBOUNDARY = 500
+
+DO JJ = 1,SIZE(PSOLAR)
+ IF ( PSOLAR(JJ)>ZTRATEBOUNDARY ) THEN
+ ! DAYTIME TEMPERATURE LAPSE RATE
+ PSTABILITY(JJ) = PCANOPYCHAR(12,KCANTYPE)
+ ELSEIF ( PSOLAR(JJ)>0. ) THEN
+ PSTABILITY(JJ) = PCANOPYCHAR(12,KCANTYPE) - &
+ ( (ZTRATEBOUNDARY - PSOLAR(JJ)) / ZTRATEBOUNDARY ) * &
+ (PCANOPYCHAR(12,KCANTYPE) - PCANOPYCHAR(13,KCANTYPE))
+ ELSE
+ ! NIGHTIME TEMPERATURE LAPSE RATE
+ PSTABILITY = PCANOPYCHAR(13,KCANTYPE)
+ ENDIF
+ENDDO
+
+END FUNCTION STABILITY
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION CONVERTHUMIDITYPA2KGM3
+!
+! SATURATION VAPOR DENSITY (KG/M3)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION CONVERTHUMIDITYPA2KGM3(PA, PTK) RESULT(PCONVERTHUMIDITYPA2KGM3)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PA, PTK
+REAL, DIMENSION(SIZE(PA)) :: PCONVERTHUMIDITYPA2KGM3
+!--------------------------------------------------------------------
+
+PCONVERTHUMIDITYPA2KGM3(:) = 0.002165 * PA(:) / PTK(:)
+
+END FUNCTION CONVERTHUMIDITYPA2KGM3
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION RESSC
+!
+! LEAF STOMATAL COND. RESISTANCE S M-1
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION RESSC(PSTOMATADI, PAR) RESULT(PRESSC)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PSTOMATADI
+REAL, DIMENSION(:), INTENT(IN) :: PAR
+REAL, DIMENSION(SIZE(PAR)) :: PRESSC
+REAL, DIMENSION(SIZE(PAR)) :: ZSCADJ
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+ZSCADJ(:) = PSTOMATADI * &
+ ( (0.0027*1.066*PAR(:)) / ((1 + 0.0027*0.0027*PAR(:)**2.)**0.5) )
+!
+WHERE (ZSCADJ(:)<0.1)
+ PRESSC(:) = 2000.
+ELSE WHERE
+ PRESSC(:) = 200./ZSCADJ(:)
+END WHERE
+
+END FUNCTION RESSC
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION LEAFIROUT
+!
+! IR THERMAL RADIATION ENERGY OUTPUT BY LEAF
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION LEAFIROUT(PEPS, PTLEAF) RESULT(PLEAFIROUT)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PEPS
+REAL, DIMENSION(:), INTENT(IN) :: PTLEAF
+REAL, DIMENSION(SIZE(PTLEAF)) :: PLEAFIROUT
+!--------------------------------------------------------------------
+
+! PRINT*,'EPS, SB, TLEAF =', EPS, SB, TLEAF
+PLEAFIROUT(:) = PEPS * XSB * (2 * (PTLEAF(:)**4.))
+
+END FUNCTION LEAFIROUT
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION LHV
+!
+! LATENT HEAT OF VAPORIZATION(J KG-1) FROM STULL P641
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION LHV(PTK) RESULT(PLHV)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PTK
+REAL, DIMENSION(SIZE(PTK)) :: PLHV
+!--------------------------------------------------------------------
+
+PLHV(:) = 2501000. - (2370. * (PTK(:) - 273.))
+
+END FUNCTION LHV
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION LEAFLE
+!
+! LATENT ENERGY TERM IN ENERGY BALANCE
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION LEAFLE(PTRANSPIRETYPE, PVAPDEFICIT, PLATHV, PGH, PSTOMRES) RESULT(PLEAFLE)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PTRANSPIRETYPE
+REAL, DIMENSION(:), INTENT(IN) :: PVAPDEFICIT, PLATHV, PGH, PSTOMRES
+REAL, DIMENSION(SIZE(PLATHV)) :: PLEAFLE
+REAL, DIMENSION(SIZE(PLATHV)) :: ZLEAFRES
+!INTEGER :: JJ
+!--------------------------------------------------------------------
+
+ZLEAFRES(:) = (1. / (1.075 * (PGH(:) / 1231.))) + PSTOMRES(:)
+
+! LATENT HEAT OF VAP (J KG-1) * VAP DEFICIT(KG M-3) /
+! LEAF RESISTENCE (S M-1)
+PLEAFLE(:) = PTRANSPIRETYPE * (1./ZLEAFRES(:)) * PLATHV(:) * PVAPDEFICIT(:)
+!
+PLEAFLE(:) = MAX(PLEAFLE(:),0.)
+!
+END FUNCTION LEAFLE
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION LEAFBLC
+!
+! BOUNDARY LAYER CONDUCTANCE
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION LEAFBLC(PLLENGTH, PGHFORCED, PTDELTA) RESULT(PLEAFBLC)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PLLENGTH
+REAL, DIMENSION(:), INTENT(IN) :: PGHFORCED, PTDELTA
+REAL, DIMENSION(SIZE(PTDELTA)) :: PLEAFBLC
+REAL, DIMENSION(SIZE(PTDELTA)) :: ZGHFREE
+REAL :: ZLLENGTH3
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+! THIS IS BASED ON LEUNING 1995 P.1198 EXCEPT USING MOLECULAR
+! CONDUCTIVITY (.00253 W M-1 K-1 STULL P 640) INSTEAD OF MOLECULAR
+! DIFFUSIVITY SO THAT YOU END UP WITH A HEAT CONVECTION COEFFICIENT
+! (W M-2 K-1) INSTEAD OF A CONDUCTANCE FOR FREE CONVECTION
+!
+ZLLENGTH3 = PLLENGTH**3
+!
+WHERE (PTDELTA(:)>=0.)
+ ZGHFREE (:) = 0.5 * 0.00253 * ((160000000. * PTDELTA(:) / (ZLLENGTH3))**0.25) / PLLENGTH
+ PLEAFBLC(:) = PGHFORCED(:) + ZGHFREE(:)
+ELSE WHERE
+ PLEAFBLC(:) = PGHFORCED(:)
+END WHERE
+!
+END FUNCTION LEAFBLC
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION LEAFH
+!
+! CONVECTIVE ENERGY TERM IN ENERGY BALANCE (W M-2 HEAT FLUX FROM
+! BOTH SIDES OF LEAF)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION LEAFH(PTDELTA, PGH) RESULT(PLEAFH)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PTDELTA, PGH
+REAL, DIMENSION(SIZE(PGH)) :: PLEAFH
+!--------------------------------------------------------------------
+
+! 2 SIDES X CONDUCTANCE X TEMPERATURE GRADIENT
+PLEAFH(:) = 2. * PGH(:) * PTDELTA(:)
+
+END FUNCTION LEAFH
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION SVDTK
+!
+! SATURATION VAPOR DENSITY (KG/M3)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION SVDTK(PTK) RESULT(PSVDTK)
+
+IMPLICIT NONE
+
+REAL, DIMENSION(:), INTENT(IN) :: PTK
+REAL, DIMENSION(SIZE(PTK)) :: PSVDTK
+REAL, DIMENSION(SIZE(PTK)) :: ZSVP
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+! SATURATION VAPOR PRESSURE (MILLIBARS)
+ZSVP (:) = 10.**((-2937.4 / PTK(:)) - (4.9283 * LOG10(PTK(:))) + 23.5518)
+PSVDTK(:) = 0.2165 * ZSVP(:) / PTK(:)
+
+END FUNCTION SVDTK
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION EA1T99
+!
+! TEMPERATURE DEPENDENCE ACTIVITY FACTOR FOR EMISSION TYPE 1
+! (E.G. ISOPRENE, MBO)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION EA1T99(HSPC_NAME, PT24, PT240, PT1) RESULT(PEA1T99)
+
+USE MODI_INDEX1
+
+IMPLICIT NONE
+
+CHARACTER(LEN=16),INTENT(IN) :: HSPC_NAME
+REAL, DIMENSION(:), INTENT(IN) :: PT1, PT24, PT240
+REAL, DIMENSION(SIZE(PT1)) :: PEA1T99
+REAL :: ZTOPT, ZX, ZEOPT
+INTEGER :: ISPCNUM
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+ISPCNUM = INDEX1(HSPC_NAME, CMGN_SPC)
+!
+DO JJ = 1,SIZE(PT1)
+ IF ( PT1(JJ)<260. ) THEN
+ PEA1T99(JJ) = 0.
+ ELSE
+ ! ENERGY OF ACTIVATION AND DEACTIVATION
+ ! TEMPERATURE AT WHICH MAXIMUM EMISSION OCCURS
+ ZTOPT = 312.5 + 0.6 * (PT240(JJ) - 297)
+ ZX = ((1 / ZTOPT) - (1 / PT1(JJ))) / 0.00831
+
+ ! MAXIMUM EMISSION (RELATIVE TO EMISSION AT 30 C)
+ ZEOPT = XCLEO(ISPCNUM) * EXP(0.05 * (PT24(JJ) - 297)) * EXP(0.05*(PT240(JJ)-297))
+
+ PEA1T99(JJ) = ZEOPT * XCTM2 * EXP(XCTM1(ISPCNUM)*ZX) / &
+ (XCTM2 - XCTM1(ISPCNUM) * (1.-EXP(XCTM2*ZX)))
+ ENDIF
+
+ENDDO
+
+END FUNCTION EA1T99
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION EA1PP
+!
+! PSTD = 200 FOR SUN LEAVES AND 50 FOR SHADE LEAVES
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION EA1P99(PSTD, PPFD24, PPFD240, PPFD1) RESULT(PEA1P99)
+
+IMPLICIT NONE
+
+REAL, INTENT(IN) :: PSTD
+REAL, DIMENSION(:), INTENT(IN) :: PPFD1, PPFD24, PPFD240
+REAL, DIMENSION(SIZE(PPFD1)) :: PEA1P99
+REAL :: ZALPHA, ZC1
+INTEGER :: JJ
+!--------------------------------------------------------------------
+
+DO JJ = 1,SIZE(PPFD1)
+
+ IF ( PPFD240(JJ)<0.01 ) THEN
+ PEA1P99(JJ) = 0.
+ ELSE
+ ZALPHA = 0.004 - 0.0005 * LOG(PPFD240(JJ))
+ ZC1 = 0.0468 * EXP(0.0005 * (PPFD24(JJ) - PSTD)) * (PPFD240(JJ)**0.6)
+ PEA1P99(JJ) = (ZALPHA * ZC1 * PPFD1(JJ)) / ((1 + ZALPHA**2. * PPFD1(JJ)**2.)**0.5)
+ ENDIF
+
+ENDDO
+
+END FUNCTION EA1P99
+
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+! FUNCTION EALTI99
+!
+! CALCULATE LIGHT INDEPENT ALGORITHMS
+! CODED BY XUEMEI WANG 05 NOV. 2007
+!-- GAMMA_TLI = EXP[BETA*(T-TS)]
+! WHERE BETA = TEMPERATURE DEPENDENT PARAMETER
+! TS = STANDARD TEMPERATURE (NORMALLY 303K, 30C)
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+
+FUNCTION EALTI99(HSPCNAM, PTEMP) RESULT(PEALTI99)
+
+USE MODI_INDEX1
+
+IMPLICIT NONE
+
+CHARACTER(LEN=16), INTENT(IN) :: HSPCNAM
+REAL, DIMENSION(:), INTENT(IN) :: PTEMP
+REAL, DIMENSION(SIZE(PTEMP)) :: PEALTI99
+!
+INTEGER :: ISPCNUM ! SPECIES NUMBER
+!--------------------------------------------------------------------
+ISPCNUM = INDEX1(HSPCNAM, CMGN_SPC)
+PEALTI99(:) = EXP( XTDF_PRM(ISPCNUM)*(PTEMP(:)-XTS) )
+
+END FUNCTION EALTI99
+!
+!OOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOOO
+!
+END MODULE MODE_MEGAN
diff --git a/src/MNH/read_chem_data_cams_case.f90 b/src/MNH/read_chem_data_cams_case.f90
new file mode 100644
index 000000000..a8487d33a
--- /dev/null
+++ b/src/MNH/read_chem_data_cams_case.f90
@@ -0,0 +1,1108 @@
+!iMNH_LIC Copyright 2012-2017 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ####################################
+ MODULE MODI_READ_CHEM_DATA_CAMS_CASE
+! ####################################
+INTERFACE
+SUBROUTINE READ_CHEM_DATA_CAMS_CASE(TPPRE_REAL1,HFILE,TPPGDFILE,PTIME_HORI, &
+ KVERB,ODUMMY_REAL,OUSECHEM )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file
+TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields
+LOGICAL, INTENT(IN) :: OUSECHEM ! flag to initialize chemistry
+END SUBROUTINE READ_CHEM_DATA_CAMS_CASE
+!
+END INTERFACE
+END MODULE MODI_READ_CHEM_DATA_CAMS_CASE
+! #############################################################################
+ SUBROUTINE READ_CHEM_DATA_CAMS_CASE(TPPRE_REAL1,HFILE,TPPGDFILE,PTIME_HORI, &
+ KVERB,ODUMMY_REAL,OUSECHEM )
+! #############################################################################
+!
+!!**** *READ_CHEM_DATA_CAMS_CASE* - reads data for the initialization of real cases.
+!!
+!! PURPOSE
+!! -------
+! This routine reads the two input files :
+! The PGD which is closed after reading
+! The CAMS file
+! Projection is read in READ_LFIFM_PGD (MODD_GRID).
+! Grid and definition of large domain are read in PGD file and
+! NETCDF files.
+! The PGD files are also read in READ_LFIFM_PGD.
+! The PGD file is closed.
+! Vertical grid is defined in READ_VER_GRID.
+! PGD fields are stored on MESO-NH domain (in TRUNC_PGD).
+!!
+!!** METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Read PGD file
+!! 1. Domain restriction
+!! 2. Coordinate conversion to lat,lon system
+!! 2. Read Netcdf fields and transfer CAMS var. in MNH var.
+!! 3. Vertical grid
+!! 4. Free all temporary allocations
+!!
+!! EXTERNAL
+!! --------
+!! subroutine READ_LFIFM_PGD : to read PGD file
+!! subroutine READ_VER_GRID : to read the vertical grid in namelist file.
+!! subroutine HORIBL : horizontal bilinear interpolation
+!! subroutine XYTOLATLON : projection from conformal to lat,lon
+!!
+!! Module MODI_READ_VER_GRID : interface for subroutine READ_VER_GRID
+!! Module MODI_HORIBL : interface for subroutine HORIBL
+!! Module MODI_XYTOLATLON : interface for subroutine XYTOLATLON
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!! Module MODD_LUNIT : contains logical unit names for all models
+!! CLUOUT0 : name of output-listing
+!! Module MODD_PGDDIM : contains dimension of PGD fields
+!! NPGDIMAX: dimension along x (no external point)
+!! NPGDJMAX: dimension along y (no external point)
+!! Module MODD_PARAMETERS
+!! JPHEXT
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 23/01/12 (C. Mari)
+!! A. Berger 20/03/12 adapt whatever the chemical mechanism in BASIC
+!! P. Wautelet 30/10/17 use F90 module for netCDF
+!! J.Pianezzej 13/02/2019 : correction for use of MEGAN
+!! M. Leriche 26/01/2021 : adapt to CAMS reanalysis file
+!! M. Leriche 26/02/2021 : add initialization for dust and sea salt
+!! P. Tulet 01/02/2022 : unit conversion for aerosols (SALTCAMn, AEROCAMn, DUSTCAMn)
+!! M. Leriche 02/02/2022 : compute air density from CAMS
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BLANK_n
+USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,&
+ JPMODE, LVARSIGI, LVARSIGJ,CAERONAMES,LAERINIT
+USE MODD_CH_M9_n, ONLY: NEQ , CNAMES
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LUSECHAQ,LUSECHIC,LCH_PH
+USE MODD_DUST, ONLY : LDUST, LDSTCAMS
+USE MODD_SALT, ONLY : LSALT, LSLTCAMS
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST
+USE MODD_DIM_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT, ONLY: TLUOUT0
+USE MODE_MODELN_HANDLER
+USE MODD_NETCDF, ONLY:CDFINT
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PREP_REAL
+USE MODD_TIME
+USE MODD_TIME_n
+!
+!UPG*PT
+!USE MODE_FM
+!USE MODE_IO
+USE MODE_TOOLS, ONLY: UPCASE
+USE MODE_TOOLS_ll
+USE MODE_IO_FILE, only: IO_File_close
+!UPG*PT
+USE MODE_MPPDB
+USE MODE_THERMO
+USE MODE_TIME
+!
+USE MODI_CH_AER_INIT_SOA
+USE MODI_CH_INIT_SCHEME_n
+USE MODI_CH_OPEN_INPUT
+USE MODI_DUSTCAMS_n
+USE MODI_HORIBL
+USE MODI_INI_NSV
+USE MODI_READ_HGRID_n
+USE MODI_READ_VER_GRID
+USE MODI_SALTCAMS_n
+USE MODI_XYTOLATLON
+USE MODI_AEROCAMS_n
+!
+USE NETCDF
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file
+TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields
+LOGICAL, INTENT(IN) :: OUSECHEM ! flag to initialize chemistry
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+! General purpose variables
+INTEGER :: ILUOUT0 ! Unit used for output msg.
+INTEGER :: IRET ! Return code from subroutines
+INTEGER :: JI,JJ,JK ! Dummy counters
+INTEGER :: JLOOP1 !
+INTEGER :: JN ! conter of dust/SS modes
+INTEGER :: JNCHEM, JNAER ! conters of chemical species in BASIC
+! Variables used by the PGD reader
+CHARACTER(LEN=28) :: YPGD_NAME ! not used - dummy argument
+CHARACTER(LEN=28) :: YPGD_DAD_NAME ! not used - dummy argument
+CHARACTER(LEN=2) :: YPGD_TYPE ! not used - dummy argument
+! PGD Grib definition variables
+INTEGER :: INO ! Number of points of the grid
+INTEGER :: IIU ! Number of points along X
+INTEGER :: IJU ! Number of points along Y
+REAL, DIMENSION(:), ALLOCATABLE :: ZLONOUT ! mapping PGD -> Grib (lon.)
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATOUT ! mapping PGD -> Grib (lat.)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! X of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points
+! Variable involved in the task of reading the netcdf file
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALUE ! Intermediate array
+REAL,DIMENSION(:),ALLOCATABLE :: ZVALUE1D ! Intermediate array
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZOUT ! Intermediate arrays
+REAL,DIMENSION(:),ALLOCATABLE :: ZOUT1D ! Intermediate arrays
+INTEGER :: ind_netcdf ! Indice for netcdf var.
+!chemistry field infile CAM1.nam
+INTEGER :: ICHANNEL
+CHARACTER(LEN=8) :: YCAM="CAM1.nam"
+integer :: ICAM
+CHARACTER(LEN=100) :: YFORMAT
+CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YSPCMNH
+integer, dimension(:), ALLOCATABLE :: ISPCCAM
+CHARACTER(LEN=9) :: YA
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZCOEFCAMSEU
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZMASMOLCAMSEU
+CHARACTER(LEN=18),dimension(:,:),ALLOCATABLE :: YSPCCAMSEU
+type TZCAM
+real :: ZCOEFCAM, ZMASMOLCAM
+character(16) :: YSPCCAM
+end type TZCAM
+type(TZCAM), DIMENSION(:,:),ALLOCATABLE :: TZSTOC
+! model indice
+INTEGER :: IMI
+TYPE(TFILEDATA),POINTER :: TZFILE
+! for dust and sea salt
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: ZMASS1, ZMASS2
+!
+! For netcdf
+!
+integer(kind=CDFINT) :: status, ncid, varid
+integer(kind=CDFINT) :: lat_varid, lon_varid, lev_varid
+integer(kind=CDFINT) :: t_varid, q_varid, ps_varid
+integer(kind=CDFINT) :: recid, latid, lonid, levid
+integer(kind=CDFINT) :: latlen, lonlen, levlen
+integer(kind=CDFINT) :: KILEN
+integer :: mmr_dust1_varid, mmr_dust2_varid, mmr_dust3_varid ! for init. dust
+integer :: mmr_seasalt1_varid, mmr_seasalt2_varid, mmr_seasalt3_varid ! for init sea salt
+CHARACTER(LEN=40) :: recname
+REAL, DIMENSION(:), ALLOCATABLE :: lats
+REAL, DIMENSION(:), ALLOCATABLE :: lons
+REAL, DIMENSION(:), ALLOCATABLE :: levs
+INTEGER, DIMENSION(:), ALLOCATABLE :: count3d, start3d
+INTEGER, DIMENSION(:), ALLOCATABLE :: count2d, start2d
+INTEGER, DIMENSION(:), ALLOCATABLE :: kinlo
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3d,vartemp3dbis,vartemp3dter
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3dquater
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCHEMCAM, ZTCAM, ZQCAM, ZPRESSCAM
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPSCAM
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_dust1, mmr_dust2, mmr_dust3
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_seasalt1, mmr_seasalt2, mmr_seasalt3
+REAL :: scale, offset
+! for reverse altitude
+REAL, DIMENSION(:), ALLOCATABLE :: TMP1, TMP2
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: TMP3
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: TMP4,TMP5
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPRESS_SV_LS, ZRHO_SV_LS
+!
+!----------------------------------------------------------------------
+TZFILE => NULL()
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!* 1. READ PGD FILE
+! -------------
+!
+ILUOUT0 = TLUOUT0%NLU
+CALL READ_HGRID_n(TPPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
+!
+!* 1.1 Domain restriction
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+INO = IIU * IJU
+!
+!* 1.2 Coordinate conversion to lat,lon system
+!
+ALLOCATE (ZXM(IIU,IJU))
+ALLOCATE (ZYM(IIU,IJU))
+ALLOCATE (ZLONM(IIU,IJU))
+ALLOCATE (ZLATM(IIU,IJU))
+ZXM(1:IIU-1,1) = (XXHAT(1:IIU-1) + XXHAT(2:IIU) ) / 2.
+ZXM(IIU,1) = XXHAT(IIU) - XXHAT(IIU-1) + ZXM(IIU-1,1)
+ZXM(:,2:IJU) = SPREAD(ZXM(:,1),2,IJU-1)
+ZYM(1,1:IJU-1) = (XYHAT(1:IJU-1) + XYHAT(2:IJU)) / 2.
+ZYM(1,IJU) = XYHAT(IJU) - XYHAT(IJU-1) + ZYM(1,IJU-1)
+ZYM(2:IIU,:) = SPREAD(ZYM(1,:),1,IIU-1)
+CALL SM_XYTOLATLON_A (XLAT0,XLON0,XRPK,XLATORI,XLONORI,ZXM,ZYM,ZLATM,ZLONM, &
+ IIU,IJU)
+ALLOCATE (ZLONOUT(INO))
+ALLOCATE (ZLATOUT(INO))
+JLOOP1 = 0
+DO JJ = 1, IJU
+ ZLONOUT(JLOOP1+1:JLOOP1+IIU) = ZLONM(1:IIU,JJ)
+ ZLATOUT(JLOOP1+1:JLOOP1+IIU) = ZLATM(1:IIU,JJ)
+ JLOOP1 = JLOOP1 + IIU
+ENDDO
+DEALLOCATE (ZYM)
+DEALLOCATE (ZXM)
+DEALLOCATE (ZLONM)
+DEALLOCATE (ZLATM)
+!
+!
+!* 2. READ NETCDF FIELDS
+! ------------------
+!
+!* 2.1 Open netcdf files
+!
+status = nf90_open(HFILE, nf90_nowrite, ncid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+!* 2.2 Read netcdf files
+!
+! get dimension IDs
+!
+!* get dimension ID of unlimited variable in netcdf file
+!status = nf90_inquire(ncid, unlimitedDimId = recid)
+!if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_dimid(ncid, "latitude", latid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_dimid(ncid, "longitude", lonid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_dimid(ncid, "level", levid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+! get dimensions
+!
+!* get dimension and name of unlimited variable in netcdf file
+!status = nf90_inquire_dimension(ncid, recid, name=recname, len=nrecs)
+!if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inquire_dimension(ncid, latid, len=latlen)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inquire_dimension(ncid, lonid, len=lonlen)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inquire_dimension(ncid, levid, len=levlen)
+if (status /= nf90_noerr) call handle_err(status)
+!
+! get variable IDs
+!
+status = nf90_inq_varid(ncid, "latitude", lat_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "longitude", lon_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "level", lev_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "t", t_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "q", q_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "sp", ps_varid)
+if (status /= nf90_noerr) call handle_err(status)
+IF (LDUST .AND. LDSTCAMS) THEN
+ status = nf90_inq_varid(ncid, "aermr04", mmr_dust1_varid)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, "aermr05", mmr_dust2_varid)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, "aermr06", mmr_dust3_varid)
+ if (status /= nf90_noerr) call handle_err(status)
+ENDIF
+IF (LSALT .AND. LSLTCAMS) THEN
+ status = nf90_inq_varid(ncid, "aermr01", mmr_seasalt1_varid)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, "aermr02", mmr_seasalt2_varid)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, "aermr03", mmr_seasalt3_varid)
+ if (status /= nf90_noerr) call handle_err(status)
+ENDIF
+
+!
+KILEN = latlen * lonlen
+!
+!* 2.3 Read data.
+!
+ALLOCATE (count3d(4))
+ALLOCATE (start3d(4))
+ALLOCATE (count2d(3))
+ALLOCATE (start2d(3))
+ALLOCATE (lats(latlen))
+ALLOCATE (lons(lonlen))
+ALLOCATE (levs(levlen))
+ALLOCATE (kinlo(latlen))
+kinlo(:) = lonlen
+IF (OUSECHEM) THEN ! chem and possibly orilam
+ ALLOCATE (vartemp3d(lonlen,latlen,levlen))
+ ALLOCATE (vartemp3dbis(lonlen,latlen,levlen))
+ ALLOCATE (vartemp3dter(lonlen,latlen,levlen))
+ ALLOCATE (vartemp3dquater(lonlen,latlen,levlen))
+ ALLOCATE (ZCHEMCAM(lonlen,latlen,levlen))
+ENDIF
+IF (LDUST .AND. LDSTCAMS) THEN
+ ALLOCATE (mmr_dust1(lonlen,latlen,levlen))
+ ALLOCATE (mmr_dust2(lonlen,latlen,levlen))
+ ALLOCATE (mmr_dust3(lonlen,latlen,levlen))
+ENDIF
+IF (LSALT .AND. LSLTCAMS) THEN
+ ALLOCATE (mmr_seasalt1(lonlen,latlen,levlen))
+ ALLOCATE (mmr_seasalt2(lonlen,latlen,levlen))
+ ALLOCATE (mmr_seasalt3(lonlen,latlen,levlen))
+ENDIF
+ALLOCATE (ZTCAM(lonlen,latlen,levlen))
+ALLOCATE (ZQCAM(lonlen,latlen,levlen))
+ALLOCATE (ZPSCAM(lonlen,latlen))
+ALLOCATE (ZPRESSCAM(lonlen,latlen,levlen))
+ALLOCATE (XA_SV_LS(levlen))
+ALLOCATE (XB_SV_LS(levlen))
+ALLOCATE (XT_SV_LS(IIU,IJU,levlen))
+ALLOCATE (XQ_SV_LS(IIU,IJU,levlen,1))
+ALLOCATE (XPS_SV_LS(IIU,IJU))
+ALLOCATE (XZS_SV_LS(IIU,IJU))
+ALLOCATE (ZPRESS_SV_LS(IIU,IJU,levlen))
+ALLOCATE (ZRHO_SV_LS(IIU,IJU,levlen))
+! take the orography from ECMWF
+XZS_SV_LS(:,:) = XZS_LS(:,:)
+!
+! get values of variables
+!
+status = nf90_get_var(ncid, lat_varid, lats(:))
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_var(ncid, lon_varid, lons(:))
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_var(ncid, lev_varid, levs(:))
+if (status /= nf90_noerr) call handle_err(status)
+!
+!
+! Reference pressure (needed for the vertical interpolation)
+!!! XP00_SV_LS = p0
+XP00_SV_LS = 101325.0
+!
+! a and b coefficients (needed for the vertical interpolation)
+!
+XA_SV_LS(:) = (/ 20.000000000, 38.425343000, 63.647804000, 95.636963000, 134.48330700, &
+ 180.58435100, 234.77905300, 298.49578900, 373.97192400, 464.61813400, &
+ 575.65100100, 713.21807900, 883.66052200, 1094.8347170, 1356.4746090, &
+ 1680.6402590, 2082.2739260, 2579.8886720, 3196.4216310, 3960.2915040, &
+ 4906.7084960, 6018.0195310, 7306.6313480, 8765.0537110, 10376.126953, &
+ 12077.446289, 13775.325195, 15379.805664, 16819.474609, 18045.183594, &
+ 19027.695313, 19755.109375, 20222.205078, 20429.863281, 20384.480469, &
+ 20097.402344, 19584.330078, 18864.750000, 17961.357422, 16899.468750, &
+ 15706.447266, 14411.124023, 13043.218750, 11632.758789, 10209.500977, &
+ 8802.3564450, 7438.8032230, 6144.3149410, 4941.7783200, 3850.9133300, &
+ 2887.6965330, 2063.7797850, 1385.9125980, 855.36175500, 467.33358800, &
+ 210.39389000, 65.889244000, 7.3677430000, 0.0000000000, 0.0000000000 /)
+
+XB_SV_LS(:) = (/ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00007600, 0.00046100, &
+ 0.00181500, 0.00508100, 0.01114300, 0.02067800, 0.03412100, &
+ 0.05169000, 0.07353400, 0.09967500, 0.13002300, 0.16438400, &
+ 0.20247600, 0.24393300, 0.28832300, 0.33515500, 0.38389200, &
+ 0.43396300, 0.48477200, 0.53571000, 0.58616800, 0.63554700, &
+ 0.68326900, 0.72878600, 0.77159700, 0.81125300, 0.84737500, &
+ 0.87965700, 0.90788400, 0.93194000, 0.95182200, 0.96764500, &
+ 0.97966300, 0.98827000, 0.99401900, 0.99763000, 1.00000000 /)
+!
+! Read 1 record of lon*lat values, starting at the
+! beginning of the record (the (1, 1, rec=time) element in the netCDF
+! file).
+count2d(1) = lonlen
+count2d(2) = latlen
+count2d(3) = 1
+start2d(1) = 1
+start2d(2) = 1
+start2d(3) = 1
+! Read 1 record of lon*lat*lev values, starting at the
+! beginning of the record (the (1, 1, 1, rec) element in the netCDF
+! file).
+count3d(1) = lonlen
+count3d(2) = latlen
+count3d(3) = levlen
+count3d(4) = 1
+start3d(1) = 1
+start3d(2) = 1
+start3d(3) = 1
+start3d(4) = 1
+!
+!
+ALLOCATE(ZVALUE(levlen,KILEN))
+ALLOCATE(ZOUT(levlen,INO))
+ALLOCATE(ZVALUE1D(KILEN))
+ALLOCATE(ZOUT1D(INO))
+!
+!* 2.3.1 read meteo veriables
+! temperature, spec. hum. and surface pressure
+! needed for the vertical interpolation
+!
+status = nf90_get_var(ncid, t_varid, ZTCAM(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, t_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, t_varid, "add_offset", offset)
+ZTCAM(:,:,:) = offset + scale * ZTCAM(:,:,:)
+!
+status = nf90_get_var(ncid, q_varid, ZQCAM(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, q_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, q_varid, "add_offset", offset)
+ZQCAM(:,:,:) = offset + scale * ZQCAM(:,:,:)
+!
+status = nf90_get_var(ncid, ps_varid, ZPSCAM(:,:), start=start2d, count=count2d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, ps_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, ps_varid, "add_offset", offset)
+ZPSCAM(:,:) = offset + scale * ZPSCAM(:,:)
+!
+DO JK = 1, levlen
+ IF (JK.EQ.1) THEN
+ ZPRESSCAM(:,:,JK) = (XA_SV_LS(JK) + XB_SV_LS(JK)*ZPSCAM(:,:)) ! ZPRESCAM = 0. for n=0
+ ELSE
+ ZPRESSCAM(:,:,JK) = ( XA_SV_LS(JK) + XA_SV_LS(JK-1) + &
+ ( XB_SV_LS(JK) + XB_SV_LS(JK-1))*ZPSCAM(:,:)) / 2.
+ ENDIF
+END DO
+
+!
+where (ZLONOUT(:) < 0.) ZLONOUT(:) = ZLONOUT(:) + 360. ! correct longitudes
+!
+!* 2.3.2 meteo. variables horizontal interpolation
+!
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZTCAM(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.)
+!
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XT_SV_LS(:,:,JK))
+ENDDO
+!
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZQCAM(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.)
+!
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XQ_SV_LS(:,:,JK,1))
+ENDDO
+!
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZPRESSCAM(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.)
+!
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ ZPRESS_SV_LS(:,:,JK))
+ENDDO
+!
+JLOOP1 = 0
+DO JJ = 1, latlen
+ ZVALUE1D(JLOOP1+1:JLOOP1+lonlen) = ZPSCAM(1:lonlen,JJ)
+ JLOOP1 = JLOOP1 + lonlen
+ENDDO
+CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE1D(:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT1D(:),.FALSE.,PTIME_HORI,.FALSE.)
+!
+CALL ARRAY_1D_TO_2D(INO,ZOUT1D(:),IIU,IJU, &
+ XPS_SV_LS(:,:))
+!
+! air density in kg/m3 RHO=PM/RT
+ZRHO_SV_LS(:,:,:) = (ZPRESS_SV_LS(:,:,:))/(XRD*XT_SV_LS(:,:,:))
+
+!
+!* 2.3.3 correct negative values produced by the horizontal interpolations
+!
+XPS_SV_LS(:,:) = MAX(XPS_SV_LS(:,:),0.)
+XT_SV_LS(:,:,:) = MAX(XT_SV_LS(:,:,:),0.)
+XQ_SV_LS(:,:,:,1) = MAX(XQ_SV_LS(:,:,:,1),0.)
+ZRHO_SV_LS(:,:,:) = MAX(ZRHO_SV_LS(:,:,:),0.)
+!
+!
+!* 2.4 initialize NSV variables
+!
+! Always initialize chemical scheme variables before INI_NSV call !
+CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT0,KVERB)
+IF (LORILAM) THEN
+ CORGANIC = "MPMPO"
+ LVARSIGI = .TRUE.
+ LVARSIGJ = .TRUE.
+ CALL CH_AER_INIT_SOA(ILUOUT0, KVERB)
+END IF
+IF (OUSECHEM) LUSECHEM = .TRUE.
+! initialise NSV_* variables
+CALL INI_NSV(1)
+IF (ALLOCATED(XSV_LS)) DEALLOCATE(XSV_LS)
+ALLOCATE (XSV_LS(IIU,IJU,levlen,NSV))
+XSV_LS(:,:,:,:) = 0.
+!
+!* 2.5 read chem. variables and convert them into MNH variables
+!
+IF (OUSECHEM) THEN
+ WRITE (ILUOUT0,'(A,A4,A)') ' | Reading CAMS species (ppp) from ',HFILE,'file'
+!
+! read CAMS species from the file CAM1.nam
+!
+! open input file
+ CALL CH_OPEN_INPUT(YCAM,"CAM2MESONH",TZFILE,ILUOUT0,KVERB)
+ ICHANNEL = TZFILE%NLU
+!
+!read number of cams species to transfer into mesonh
+ READ(ICHANNEL, *) ICAM
+ IF (KVERB >= 5) WRITE (ILUOUT0,*) "number of cams species to transfer into &
+ & mesonh : ", ICAM
+!
+!read data input format
+ READ(ICHANNEL,"(A)") YFORMAT
+ YFORMAT=UPCASE(YFORMAT)
+ IF (KVERB >= 5) WRITE (ILUOUT0,*) "input format is: ", YFORMAT
+!
+!allocate fields
+ ALLOCATE(YSPCMNH(ICAM)) !MESONH species
+ ALLOCATE(TZSTOC(ICAM,4)) !CAMS coefficient and CAMS species associated
+ ALLOCATE(ISPCCAM(ICAM)) !number of CAMS species into each MESONH species
+ ALLOCATE(ZCOEFCAMSEU(ICAM,4))!Coef stoich of each CAMS species
+ ALLOCATE(ZMASMOLCAMSEU(ICAM,4))!molar mass of each CAMS species
+ ALLOCATE(YSPCCAMSEU(ICAM,4)) !CAMS species name
+!read MESONH variable names and CAMS variable names associated
+ DO JI = 1,ICAM !for every MNH species existing in CAM1.nam
+ READ(ICHANNEL,YFORMAT) YSPCMNH(JI), ISPCCAM(JI), & !reading line by line
+ TZSTOC(JI,1)%ZCOEFCAM, TZSTOC(JI,1)%YSPCCAM, TZSTOC(JI,1)%ZMASMOLCAM, &
+ TZSTOC(JI,2)%ZCOEFCAM, TZSTOC(JI,2)%YSPCCAM, TZSTOC(JI,2)%ZMASMOLCAM, &
+ TZSTOC(JI,3)%ZCOEFCAM, TZSTOC(JI,3)%YSPCCAM, TZSTOC(JI,3)%ZMASMOLCAM, &
+ TZSTOC(JI,4)%ZCOEFCAM, TZSTOC(JI,4)%YSPCCAM, TZSTOC(JI,4)%ZMASMOLCAM
+ WRITE(ILUOUT0,YFORMAT) YSPCMNH(JI), ISPCCAM(JI),&
+!writing in arrays
+ TZSTOC(JI,1)%ZCOEFCAM, TZSTOC(JI,1)%YSPCCAM, TZSTOC(JI,1)%ZMASMOLCAM, &
+ TZSTOC(JI,2)%ZCOEFCAM, TZSTOC(JI,2)%YSPCCAM, TZSTOC(JI,2)%ZMASMOLCAM, &
+ TZSTOC(JI,3)%ZCOEFCAM, TZSTOC(JI,3)%YSPCCAM, TZSTOC(JI,3)%ZMASMOLCAM, &
+ TZSTOC(JI,4)%ZCOEFCAM, TZSTOC(JI,4)%YSPCCAM, TZSTOC(JI,4)%ZMASMOLCAM
+!
+ ZCOEFCAMSEU(JI,1) = (TZSTOC(JI,1)%ZCOEFCAM) !coef stoich of each CAMS species set into an array
+ ZCOEFCAMSEU(JI,2) = (TZSTOC(JI,2)%ZCOEFCAM)
+ ZCOEFCAMSEU(JI,3) = (TZSTOC(JI,3)%ZCOEFCAM)
+ ZCOEFCAMSEU(JI,4) = (TZSTOC(JI,4)%ZCOEFCAM)
+!
+ YSPCCAMSEU(JI,1)=trim(TZSTOC(JI,1)%YSPCCAM) !specie name of each CAMS specie set into an array
+ YSPCCAMSEU(JI,2)=trim(TZSTOC(JI,2)%YSPCCAM)
+ YSPCCAMSEU(JI,3)=trim(TZSTOC(JI,3)%YSPCCAM)
+ YSPCCAMSEU(JI,4)=trim(TZSTOC(JI,4)%YSPCCAM)
+!
+ ZMASMOLCAMSEU(JI,1)= (TZSTOC(JI,1)%ZMASMOLCAM) ! molar mass to convert kg/kg to ppp
+ ZMASMOLCAMSEU(JI,2)= (TZSTOC(JI,2)%ZMASMOLCAM)
+ ZMASMOLCAMSEU(JI,3)= (TZSTOC(JI,3)%ZMASMOLCAM)
+ ZMASMOLCAMSEU(JI,4)= (TZSTOC(JI,4)%ZMASMOLCAM)
+!
+! read chem. variables and exchange CAMS values onto prognostic variables XSV_LS
+! convert CAMS fields to 2D for use in horizontal interpolation routine HORIBL.f90
+!
+ DO JNCHEM = NSV_CHEMBEG, NSV_CHEMEND !loop on all MNH species
+ IF (trim(CNAMES(JNCHEM-NSV_CHEMBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species
+ IF (ISPCCAM(JI)==1) THEN
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3d(:,:,:)=offset + scale * vartemp3d(:,:,:)
+ ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,1)
+ ELSE IF (ISPCCAM(JI)==2) THEN
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:)
+ ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,1) + &
+ ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,2)
+ ELSE IF (ISPCCAM(JI)==3) THEN
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,3)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dter(:,:,:)=offset + scale*vartemp3dter(:,:,:)
+ ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,1) +&
+ ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,2) +&
+ ZCOEFCAMSEU(JI,3)*vartemp3dter(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,3)
+ ELSE IF (ISPCCAM(JI)==4) THEN
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,3)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dter(:,:,:)=offset + scale*vartemp3dter(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,4)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dquater, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dquater(:,:,:)=offset + scale*vartemp3dquater(:,:,:)
+ ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,1)+&
+ ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,2)+&
+ ZCOEFCAMSEU(JI,3)*vartemp3dter(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,3)+&
+ ZCOEFCAMSEU(JI,4)*vartemp3dquater(:,:,:)*XMD*1E3/ZMASMOLCAMSEU(JI,4)
+ ENDIF
+ DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMCAM(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1+lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XSV_LS(:,:,JK,JNCHEM) )
+ ENDDO ! levlen
+ ENDIF
+ XSV_LS(:,:,:,JNCHEM) = MAX(XSV_LS(:,:,:,JNCHEM), 0.)
+ ENDDO ! JNCHEM
+!
+ DO JNAER = NSV_AERBEG, NSV_AEREND ! no need to convert to ppp
+ IF (trim(CAERONAMES(JNAER-NSV_AERBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species
+
+ IF (ISPCCAM(JI)==1) THEN
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*(offset + scale*vartemp3d(:,:,:))
+ ELSE IF (ISPCCAM(JI)==2) THEN
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:)
+ ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:) + &
+ ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)
+ ELSE IF (ISPCCAM(JI)==3) THEN
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,3)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dter(:,:,:)=offset + scale*vartemp3dter(:,:,:)
+ ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)+&
+ ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)+&
+ ZCOEFCAMSEU(JI,3)*vartemp3dter(:,:,:)
+ ELSE IF (ISPCCAM(JI)==4) THEN
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3d(:,:,:)=offset + scale*vartemp3d(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dbis(:,:,:)=offset + scale*vartemp3dbis(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,3)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dter(:,:,:)=offset + scale*vartemp3dter(:,:,:)
+ status = nf90_inq_varid(ncid, trim(YSPCCAMSEU(JI,4)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dquater, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, ind_netcdf, "scale_factor", scale)
+ status = nf90_get_att(ncid, ind_netcdf, "add_offset", offset)
+ vartemp3dquater(:,:,:)=offset + scale*vartemp3dquater(:,:,:)
+ ZCHEMCAM(:,:,:)=ZCOEFCAMSEU(JI,1)*vartemp3d(:,:,:)+&
+ ZCOEFCAMSEU(JI,2)*vartemp3dbis(:,:,:)+&
+ ZCOEFCAMSEU(JI,3)*vartemp3dter(:,:,:)+&
+ ZCOEFCAMSEU(JI,4)*vartemp3dquater(:,:,:)
+ ENDIF
+ DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMCAM(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1+lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XSV_LS(:,:,JK,JNAER) )
+ ENDDO ! levlen
+ ENDIF
+ XSV_LS(:,:,:,JNAER) = MAX(XSV_LS(:,:,:,JNAER), 1E-40)
+ ENDDO ! JNAER
+ ENDDO ! ICAM loop on MNH species in CAM1.nam
+ DEALLOCATE(YSPCMNH)
+ DEALLOCATE(TZSTOC)
+ DEALLOCATE(ISPCCAM)
+ DEALLOCATE(ZCOEFCAMSEU)
+ DEALLOCATE(ZMASMOLCAMSEU)
+ DEALLOCATE(YSPCCAMSEU)
+!
+ IF (LORILAM) THEN ! convert kg/kg into ppv and moments
+ CALL AEROCAMS_n(XSV_LS(:,:,:,NSV_AERBEG:NSV_AEREND), ZRHO_SV_LS)
+ LAERINIT = .FALSE. ! to avoid enter in the routine ch_reallfin
+ ENDIF
+ENDIF ! OUSECHEM
+!
+!* 2.6 read dust variables and convert them into MNH variables
+!
+IF (LDUST .AND. LDSTCAMS) THEN
+ WRITE (ILUOUT0,'(A)') ' | Reading CAMS dust (kg/kg)'
+ !
+ status = nf90_get_var(ncid, mmr_dust1_varid, mmr_dust1(:,:,:), start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, mmr_dust1_varid, "scale_factor", scale)
+ status = nf90_get_att(ncid, mmr_dust1_varid, "add_offset", offset)
+ mmr_dust1(:,:,:) = offset + scale * mmr_dust1(:,:,:)
+ !
+ status = nf90_get_var(ncid, mmr_dust2_varid, mmr_dust2(:,:,:), start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, mmr_dust2_varid, "scale_factor", scale)
+ status = nf90_get_att(ncid, mmr_dust2_varid, "add_offset", offset)
+ mmr_dust2(:,:,:) = offset + scale * mmr_dust2(:,:,:)
+ !
+ status = nf90_get_var(ncid, mmr_dust3_varid, mmr_dust3(:,:,:), start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, mmr_dust3_varid, "scale_factor", scale)
+ status = nf90_get_att(ncid, mmr_dust3_varid, "add_offset", offset)
+ mmr_dust3(:,:,:) = offset + scale * mmr_dust3(:,:,:)
+ !
+ ALLOCATE (ZMASS1(lonlen,latlen,levlen,3))
+ ALLOCATE (ZMASS2(SIZE(XSV_LS,1), SIZE(XSV_LS,2), SIZE(XSV_LS,3),3))
+!
+ ZMASS1(:,:,:,1) = mmr_dust1(:,:,:)
+ ZMASS1(:,:,:,2) = mmr_dust2(:,:,:)
+ ZMASS1(:,:,:,3) = mmr_dust3(:,:,:)
+
+ ZMASS1(:,:,:,:) = MAX(ZMASS1(:,:,:,:),1E-40)
+
+ DO JN=1,3
+ DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZMASS1(1:lonlen,JJ,JK,JN)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,ZMASS2(:,:,JK,JN))
+ ENDDO
+ ENDDO
+!
+ ! conversion kg/kg into moment units (ppv)
+ CALL DUSTCAMS_n(XSV_LS(:,:,:,NSV_DSTBEG:NSV_DSTEND), ZMASS2(:,:,:,:), ZRHO_SV_LS(:,:,:))
+
+ DEALLOCATE (ZMASS1)
+ DEALLOCATE (ZMASS2)
+END IF
+!
+!* 2.7 read sea salt variables and convert them into MNH variables
+!
+IF (LSALT .AND. LSLTCAMS) THEN
+ WRITE (ILUOUT0,'(A)') ' | Reading CAMS sea salt (kg/kg)'
+ !
+ status = nf90_get_var(ncid, mmr_seasalt1_varid, mmr_seasalt1(:,:,:), start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, mmr_seasalt1_varid, "scale_factor", scale)
+ status = nf90_get_att(ncid, mmr_seasalt1_varid, "add_offset", offset)
+ mmr_seasalt1(:,:,:) = offset + scale * mmr_seasalt1(:,:,:)
+ !
+ status = nf90_get_var(ncid, mmr_seasalt2_varid, mmr_seasalt2(:,:,:), start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, mmr_seasalt2_varid, "scale_factor", scale)
+ status = nf90_get_att(ncid, mmr_seasalt2_varid, "add_offset", offset)
+ mmr_seasalt2(:,:,:) = offset + scale * mmr_seasalt2(:,:,:)
+ !
+ status = nf90_get_var(ncid, mmr_seasalt3_varid, mmr_seasalt3(:,:,:), start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_att(ncid, mmr_seasalt3_varid, "scale_factor", scale)
+ status = nf90_get_att(ncid, mmr_seasalt3_varid, "add_offset", offset)
+ mmr_seasalt3(:,:,:) = offset + scale * mmr_seasalt3(:,:,:)
+ !
+ ALLOCATE (ZMASS1(lonlen,latlen,levlen,3))
+ ALLOCATE (ZMASS2(SIZE(XSV_LS,1), SIZE(XSV_LS,2), SIZE(XSV_LS,3),3))
+!
+ ZMASS1(:,:,:,1) = mmr_seasalt1(:,:,:)
+ ZMASS1(:,:,:,2) = mmr_seasalt2(:,:,:)
+ ZMASS1(:,:,:,3) = mmr_seasalt3(:,:,:)
+ ZMASS1(:,:,:,:) = MAX(ZMASS1(:,:,:,:),1E-40)
+ DO JN=1,3
+ DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZMASS1(1:lonlen,JJ,JK,JN)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,ZMASS2(:,:,JK,JN))
+ ENDDO
+ ENDDO
+!
+ ! conversion kg/kg into moment units (ppv)
+ CALL SALTCAMS_n(XSV_LS(:,:,:,NSV_SLTBEG:NSV_SLTEND),ZMASS2(:,:,:,:), ZRHO_SV_LS(:,:,:))
+ !
+ DEALLOCATE (ZMASS1)
+ DEALLOCATE (ZMASS2)
+ENDIF
+!
+!
+!* 3. If netcdf vertical levels have to be reversed
+!
+ALLOCATE(TMP1(levlen))
+ALLOCATE(TMP2(levlen))
+ALLOCATE(TMP3(IIU,IJU,levlen))
+ALLOCATE(TMP4(IIU,IJU,levlen,NRR))
+ALLOCATE(TMP5(IIU,IJU,levlen,NSV))
+!
+XA_SV_LS(:) = XA_SV_LS(:) / XP00_SV_LS
+!
+DO JJ=1,levlen
+! inv. lev
+ TMP1(JJ) = XA_SV_LS(levlen+1-JJ)
+ TMP2(JJ) = XB_SV_LS(levlen+1-JJ)
+ TMP3(:,:,JJ) = XT_SV_LS(:,:,levlen+1-JJ)
+ TMP4(:,:,JJ,:) = XQ_SV_LS(:,:,levlen+1-JJ,:)
+ TMP5(:,:,JJ,:) = XSV_LS(:,:,levlen+1-JJ,:)
+ENDDO
+!
+XA_SV_LS(:) = TMP1(:)
+XB_SV_LS(:) = TMP2(:)
+XT_SV_LS(:,:,:) = TMP3(:,:,:)
+XQ_SV_LS(:,:,:,:) = TMP4(:,:,:,:)
+XSV_LS(:,:,:,:) = TMP5(:,:,:,:)
+
+DEALLOCATE(TMP1)
+DEALLOCATE(TMP2)
+DEALLOCATE(TMP3)
+DEALLOCATE(TMP4)
+DEALLOCATE(TMP5)
+!
+!* 4 close the netcdf file
+!
+status = nf90_close(ncid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+DEALLOCATE(ZVALUE)
+DEALLOCATE(ZOUT)
+IF (ALLOCATED(ZVALUE1D)) DEALLOCATE(ZVALUE1D)
+IF (ALLOCATED(ZOUT1D)) DEALLOCATE(ZOUT1D)
+!
+! close
+! file
+IF (OUSECHEM) CALL IO_FILE_CLOSE(TZFILE)
+!
+!
+!-------------------------------------------------------------
+!
+!* 5. VERTICAL GRID
+! -------------
+!
+!* 5.1 Read VERTICAL GRID
+!
+WRITE (ILUOUT0,'(A)') ' | Reading of vertical grid in progress'
+CALL READ_VER_GRID(TPPRE_REAL1)
+!
+!--------------------------------------------------------------
+!
+!* 6. Free all temporary allocations
+! ------------------------------
+!
+DEALLOCATE (count3d)
+DEALLOCATE (count2d)
+DEALLOCATE (start3d)
+DEALLOCATE (start2d)
+DEALLOCATE (lats)
+DEALLOCATE (lons)
+DEALLOCATE (levs)
+DEALLOCATE (kinlo)
+DEALLOCATE (ZLATOUT)
+DEALLOCATE (ZLONOUT)
+DEALLOCATE (ZTCAM)
+DEALLOCATE (ZQCAM)
+DEALLOCATE (ZPSCAM)
+DEALLOCATE (ZPRESSCAM)
+DEALLOCATE (ZPRESS_SV_LS)
+DEALLOCATE (ZRHO_SV_LS)
+IF (ALLOCATED(ZCHEMCAM)) DEALLOCATE(ZCHEMCAM)
+IF (ALLOCATED(vartemp3d)) DEALLOCATE(vartemp3d)
+IF (ALLOCATED(vartemp3dbis)) DEALLOCATE(vartemp3dbis)
+IF (ALLOCATED(vartemp3dter)) DEALLOCATE(vartemp3dter)
+IF (ALLOCATED(vartemp3dquater)) DEALLOCATE(vartemp3dquater)
+IF (ALLOCATED(mmr_dust1)) DEALLOCATE(mmr_dust1)
+IF (ALLOCATED(mmr_dust2)) DEALLOCATE(mmr_dust2)
+IF (ALLOCATED(mmr_dust3)) DEALLOCATE(mmr_dust3)
+IF (ALLOCATED(mmr_seasalt1)) DEALLOCATE(mmr_seasalt1)
+IF (ALLOCATED(mmr_seasalt2)) DEALLOCATE(mmr_seasalt2)
+IF (ALLOCATED(mmr_seasalt3)) DEALLOCATE(mmr_seasalt3)
+!
+WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successfully'
+!
+
+CONTAINS
+!
+! #############################
+ SUBROUTINE HANDLE_ERR(STATUS)
+! #############################
+ INTEGER(KIND=CDFINT) STATUS
+ IF (STATUS .NE. NF90_NOERR) THEN
+ PRINT *, NF90_STRERROR(STATUS)
+ STOP 'Stopped'
+ ENDIF
+ END SUBROUTINE HANDLE_ERR
+!
+!
+! #############################################
+ SUBROUTINE ARRAY_1D_TO_2D (KN1,P1,KL1,KL2,P2)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+USE MODE_MSG
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KN1
+REAL,DIMENSION(KN1), INTENT(IN) :: P1
+INTEGER, INTENT(IN) :: KL1
+INTEGER, INTENT(IN) :: KL2
+REAL,DIMENSION(KL1,KL2),INTENT(OUT) :: P2
+INTEGER :: JLOOP1_A1T2
+INTEGER :: JLOOP2_A1T2
+INTEGER :: JPOS_A1T2
+!
+IF (KN1 < KL1*KL2) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match')
+END IF
+JPOS_A1T2 = 1
+DO JLOOP2_A1T2 = 1, KL2
+ DO JLOOP1_A1T2 = 1, KL1
+ P2(JLOOP1_A1T2,JLOOP2_A1T2) = P1(JPOS_A1T2)
+ JPOS_A1T2 = JPOS_A1T2 + 1
+ END DO
+END DO
+END SUBROUTINE ARRAY_1D_TO_2D
+!
+END SUBROUTINE READ_CHEM_DATA_CAMS_CASE
diff --git a/src/MNH/read_chem_data_mozart_case.f90 b/src/MNH/read_chem_data_mozart_case.f90
new file mode 100644
index 000000000..e8a65c705
--- /dev/null
+++ b/src/MNH/read_chem_data_mozart_case.f90
@@ -0,0 +1,812 @@
+!MNH_LIC Copyright 2012-2017 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################################
+ MODULE MODI_READ_CHEM_DATA_MOZART_CASE
+! #################################
+INTERFACE
+SUBROUTINE READ_CHEM_DATA_MOZART_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, &
+ PTIME_HORI,KVERB,ODUMMY_REAL )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file
+TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields
+END SUBROUTINE READ_CHEM_DATA_MOZART_CASE
+!
+END INTERFACE
+END MODULE MODI_READ_CHEM_DATA_MOZART_CASE
+! ####################################################################
+ SUBROUTINE READ_CHEM_DATA_MOZART_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, &
+ PTIME_HORI,KVERB,ODUMMY_REAL )
+! ####################################################################
+!
+!!**** *READ_CHEM_DATA_MOZART_CASE* - reads data for the initialization of real cases.
+!!
+!! PURPOSE
+!! -------
+! This routine reads the two input files :
+! The PGD which is closed after reading
+! The MOZART file
+! Projection is read in READ_LFIFM_PGD (MODD_GRID).
+! Grid and definition of large domain are read in PGD file and
+! MOZART files.
+! The PGD files are also read in READ_LFIFM_PGD.
+! The PGD file is closed.
+! Vertical grid is defined in READ_VER_GRID.
+! PGD fields are stored on MESO-NH domain (in TRUNC_PGD).
+!!
+!!** METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Read PGD file
+!! 1. Domain restriction
+!! 2. Coordinate conversion to lat,lon system
+!! 2. Read Netcdf fields
+!! 3. Vertical grid
+!! 4. Free all temporary allocations
+!!
+!! EXTERNAL
+!! --------
+!! subroutine READ_LFIFM_PGD : to read PGD file
+!! subroutine READ_VER_GRID : to read the vertical grid in namelist file.
+!! subroutine HORIBL : horizontal bilinear interpolation
+!! subroutine XYTOLATLON : projection from conformal to lat,lon
+!!
+!! Module MODI_READ_VER_GRID : interface for subroutine READ_VER_GRID
+!! Module MODI_HORIBL : interface for subroutine HORIBL
+!! Module MODI_XYTOLATLON : interface for subroutine XYTOLATLON
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!! Module MODD_LUNIT : contains logical unit names for all models
+!! CLUOUT0 : name of output-listing
+!! Module MODD_PGDDIM : contains dimension of PGD fields
+!! NPGDIMAX: dimension along x (no external point)
+!! NPGDJMAX: dimension along y (no external point)
+!! Module MODD_PARAMETERS
+!! JPHEXT
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 23/01/12 (C. Mari)
+!! A. Berger 20/03/12 adapt whatever the chemical mechanism in BASIC
+!! P. Wautelet 30/10/17 use F90 module for netCDF
+!! J.Pianezzej 13/02/2019 : correction for use of MEGAN
+! P. Wautelet 18/09/2019: correct support of 64bit integers (MNH_INT=8)
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+!------------
+!
+USE MODD_BLANK_n
+USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,&
+ JPMODE, LVARSIGI, LVARSIGJ,CAERONAMES
+USE MODD_CH_M9_n, ONLY: NEQ , CNAMES
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LUSECHAQ,LUSECHIC,LCH_PH
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST
+USE MODD_DIM_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT, ONLY: TLUOUT0
+USE MODE_MODELN_HANDLER
+USE MODD_NETCDF, ONLY:CDFINT
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_n, ONLY : CTURB
+USE MODD_PREP_REAL
+USE MODD_TIME
+USE MODD_TIME_n
+!
+!UPG*PT
+!USE MODE_FM
+!USE MODE_IO_ll
+USE MODE_TOOLS, ONLY: UPCASE
+use MODE_TOOLS_ll
+USE MODE_IO_FILE, only: IO_File_close
+!UPG*PT
+
+USE MODE_MPPDB
+USE MODE_THERMO
+USE MODE_TIME
+!
+USE MODI_CH_AER_INIT_SOA
+USE MODI_CH_INIT_SCHEME_n
+USE MODI_CH_OPEN_INPUT
+USE MODI_HORIBL
+USE MODI_INI_NSV
+USE MODI_READ_HGRID_n
+USE MODI_READ_VER_GRID
+USE MODI_XYTOLATLON
+!
+USE NETCDF
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the MOZART file
+TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+! General purpose variables
+INTEGER :: ILUOUT0 ! Unit used for output msg.
+INTEGER :: IRET ! Return code from subroutines
+INTEGER :: JI,JJ,JK ! Dummy counters
+INTEGER :: JLOOP1 ! |
+INTEGER :: JNCHEM, JNAER ! conters of chemical species in BASIC
+! Variables used by the PGD reader
+CHARACTER(LEN=28) :: YPGD_NAME ! not used - dummy argument
+CHARACTER(LEN=28) :: YPGD_DAD_NAME ! not used - dummy argument
+CHARACTER(LEN=2) :: YPGD_TYPE ! not used - dummy argument
+! PGD Grib definition variables
+INTEGER :: INO ! Number of points of the grid
+INTEGER :: IIU ! Number of points along X
+INTEGER :: IJU ! Number of points along Y
+REAL, DIMENSION(:), ALLOCATABLE :: ZLONOUT ! mapping PGD -> Grib (lon.)
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATOUT ! mapping PGD -> Grib (lat.)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! X of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points
+! Variable involved in the task of reading the netcdf file
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALUE ! Intermediate array
+REAL,DIMENSION(:),ALLOCATABLE :: ZVALUE1D ! Intermediate array
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZOUT ! Intermediate arrays
+REAL,DIMENSION(:),ALLOCATABLE :: ZOUT1D ! Intermediate arrays
+INTEGER(kind=CDFINT) :: ind_netcdf ! Indice for netcdf var.
+!chemistry field infile MOZ1.nam
+INTEGER :: ICHANNEL
+CHARACTER(LEN=8) :: YMOZ="MOZ1.nam"
+integer :: IMOZ
+CHARACTER(LEN=100) :: YFORMAT
+CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: YSPCMNH
+integer, dimension(:), ALLOCATABLE :: ISPCMOZ
+CHARACTER(LEN=9) :: YA
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZCOEFMOZART
+CHARACTER(LEN=18),dimension(:,:),ALLOCATABLE :: YCHANGE
+type TZMOZ
+real :: ZCOEFMOZ
+character(16) :: YSPCMOZ
+end type TZMOZ
+type(TZMOZ), DIMENSION(:,:),ALLOCATABLE :: TZSTOC
+! model indice
+INTEGER :: IMI
+TYPE(TFILEDATA),POINTER :: TZFILE
+!
+! For netcdf
+!
+integer(kind=CDFINT) :: status, ncid, varid
+integer(kind=CDFINT) :: lat_varid, lon_varid, lev_varid, time_varid
+integer(kind=CDFINT) :: hyam_varid, hybm_varid, p0_varid, t_varid, q_varid, ps_varid
+integer(kind=CDFINT) :: recid, latid, lonid, levid, timeid
+integer(kind=CDFINT) :: latlen, lonlen, levlen, nrecs,timelen
+integer(kind=CDFINT) :: itimeindex
+integer :: KILEN
+CHARACTER(LEN=40) :: recname
+REAL, DIMENSION(:), ALLOCATABLE :: lats
+REAL, DIMENSION(:), ALLOCATABLE :: lons
+REAL, DIMENSION(:), ALLOCATABLE :: levs
+INTEGER(kind=CDFINT), DIMENSION(:), ALLOCATABLE :: count3d, start3d
+INTEGER(kind=CDFINT), DIMENSION(:), ALLOCATABLE :: count2d, start2d
+REAL, DIMENSION(:), ALLOCATABLE :: time, hyam, hybm
+REAL :: p0
+INTEGER, DIMENSION(:), ALLOCATABLE :: kinlo
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3d,vartemp3dbis,vartemp3dter
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: vartemp3dquater
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCHEMMOZ, ZTMOZ, ZQMOZ
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPSMOZ
+
+real ::a,b
+
+!----------------------------------------------------------------------
+TZFILE => NULL()
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!* 1. READ PGD FILE
+! -------------
+!
+ILUOUT0 = TLUOUT0%NLU
+CALL READ_HGRID_n(TPPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
+!
+! 1.1 Domain restriction
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+INO = IIU * IJU
+!
+!
+! 1.2 Coordinate conversion to lat,lon system
+!
+ALLOCATE (ZXM(IIU,IJU))
+ALLOCATE (ZYM(IIU,IJU))
+ALLOCATE (ZLONM(IIU,IJU))
+ALLOCATE (ZLATM(IIU,IJU))
+ZXM(1:IIU-1,1) = (XXHAT(1:IIU-1) + XXHAT(2:IIU) ) / 2.
+ZXM(IIU,1) = XXHAT(IIU) - XXHAT(IIU-1) + ZXM(IIU-1,1)
+ZXM(:,2:IJU) = SPREAD(ZXM(:,1),2,IJU-1)
+ZYM(1,1:IJU-1) = (XYHAT(1:IJU-1) + XYHAT(2:IJU)) / 2.
+ZYM(1,IJU) = XYHAT(IJU) - XYHAT(IJU-1) + ZYM(1,IJU-1)
+ZYM(2:IIU,:) = SPREAD(ZYM(1,:),1,IIU-1)
+CALL SM_XYTOLATLON_A (XLAT0,XLON0,XRPK,XLATORI,XLONORI,ZXM,ZYM,ZLATM,ZLONM, &
+ IIU,IJU)
+ALLOCATE (ZLONOUT(INO))
+ALLOCATE (ZLATOUT(INO))
+JLOOP1 = 0
+DO JJ = 1, IJU
+ ZLONOUT(JLOOP1+1:JLOOP1+IIU) = ZLONM(1:IIU,JJ)
+ ZLATOUT(JLOOP1+1:JLOOP1+IIU) = ZLATM(1:IIU,JJ)
+ JLOOP1 = JLOOP1 + IIU
+ENDDO
+DEALLOCATE (ZYM)
+DEALLOCATE (ZXM)
+!
+!
+!* 2. READ NETCDF FIELDS
+! ------------------
+!
+! 2.1 Open netcdf files
+!
+status = nf90_open(HFILE, nf90_nowrite, ncid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+! 2.2 Read netcdf files
+!
+! get dimension IDs
+!
+!* get dimension ID of unlimited variable in netcdf file
+status = nf90_inquire(ncid, unlimitedDimId = recid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_dimid(ncid, "lat", latid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_dimid(ncid, "lon", lonid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_dimid(ncid, "lev", levid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+! get dimensions
+!
+!* get dimension and name of unlimited variable in netcdf file
+status = nf90_inquire_dimension(ncid, recid, name=recname, len=nrecs)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inquire_dimension(ncid, latid, len=latlen)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inquire_dimension(ncid, lonid, len=lonlen)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inquire_dimension(ncid, levid, len=levlen)
+if (status /= nf90_noerr) call handle_err(status)
+!
+! get variable IDs
+!
+status = nf90_inq_varid(ncid, "lat", lat_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "lon", lon_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "lev", lev_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "time", time_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "P0", p0_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "hyam", hyam_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "hybm", hybm_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "T", t_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "Q", q_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "PS", ps_varid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+KILEN = latlen * lonlen
+!
+! 2.3 Read data.
+!
+ALLOCATE (count3d(4))
+ALLOCATE (start3d(4))
+ALLOCATE (count2d(3))
+ALLOCATE (start2d(3))
+ALLOCATE (lats(latlen))
+ALLOCATE (lons(lonlen))
+ALLOCATE (levs(levlen))
+ALLOCATE (time(nrecs))
+ALLOCATE (kinlo(latlen))
+kinlo(:) = lonlen
+ALLOCATE (vartemp3d(lonlen,latlen,levlen))
+ALLOCATE (vartemp3dbis(lonlen,latlen,levlen))
+ALLOCATE (vartemp3dter(lonlen,latlen,levlen))
+ALLOCATE (vartemp3dquater(lonlen,latlen,levlen))
+ALLOCATE (ZCHEMMOZ(lonlen,latlen,levlen))
+ALLOCATE (ZTMOZ(lonlen,latlen,levlen))
+ALLOCATE (ZQMOZ(lonlen,latlen,levlen))
+ALLOCATE (ZPSMOZ(lonlen,latlen))
+ALLOCATE (XA_SV_LS(levlen))
+ALLOCATE (hyam(levlen))
+ALLOCATE (XB_SV_LS(levlen))
+ALLOCATE (hybm(levlen))
+ALLOCATE (XT_SV_LS(IIU,IJU,levlen))
+ALLOCATE (XQ_SV_LS(IIU,IJU,levlen,1))
+ALLOCATE (XPS_SV_LS(IIU,IJU))
+ALLOCATE (XZS_SV_LS(IIU,IJU))
+! take the orography from ECMWF
+XZS_SV_LS(:,:) = XZS_LS(:,:)
+!
+! get values of variables
+!
+status = nf90_get_var(ncid, lat_varid, lats(:))
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_var(ncid, lon_varid, lons(:))
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_var(ncid, lev_varid, levs(:))
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_var(ncid, time_varid, time(:))
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_var(ncid, hyam_varid, hyam)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_var(ncid, hybm_varid, hybm)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_var(ncid, p0_varid, p0)
+if (status /= nf90_noerr) call handle_err(status)
+XP00_SV_LS = p0
+!
+! hyam and hybm coefficients for pressure calculations have to be reversed
+! from top-bottom to bottom-up direction
+do JJ = 1, levlen
+ XA_SV_LS(JJ) = hyam(levlen+1-JJ)
+ XB_SV_LS(JJ) = hybm(levlen+1-JJ)
+end do
+!
+!
+! Read 1 record of lon*lat*lev values, starting at the
+! beginning of the record (the (1, 1, 1, rec) element in the netCDF
+! file).
+ count3d(1) = lonlen
+ count3d(2) = latlen
+ count3d(3) = levlen
+ count3d(4) = 1
+ start3d(1) = 1
+ start3d(2) = 1
+ start3d(3) = 1
+! Choose time index according to the chosen time in namelist
+! 1 for 06h - 2 for 12h - 3 for 18h - 4 for 24h
+IF (CDUMMY1=="06") THEN
+ itimeindex=1
+ELSEIF (CDUMMY1=="12") THEN
+ itimeindex=2
+ELSEIF (CDUMMY1=="18") THEN
+ itimeindex=3
+ELSEIF ((CDUMMY1=="24").OR.(CDUMMY1=="00")) THEN
+ itimeindex=4
+ENDIF
+ start3d(4) = itimeindex
+!
+ status = nf90_get_var(ncid, t_varid, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+!
+do JJ=1,levlen
+! lev, lat, lon
+ ZTMOZ(:,:,JJ) = vartemp3d(:,:,levlen+1-JJ)
+enddo
+!
+ status = nf90_get_var(ncid, q_varid, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+!
+do JJ=1,levlen
+! lev, lat, lon
+ ZQMOZ(:,:,JJ) = vartemp3d(:,:,levlen+1-JJ)
+enddo
+!
+ count2d(1) = lonlen
+ count2d(2) = latlen
+ count2d(3) = 1
+ start2d(1) = 1
+ start2d(2) = 1
+ start2d(3) = itimeindex
+ status = nf90_get_var(ncid, ps_varid, ZPSMOZ(:,:), start=start2d, count=count2d)
+ if (status /= nf90_noerr) call handle_err(status)
+
+
+!------------------------------------------------------------------------
+!* 3 Interpolation of MOZART variable
+!---------------------------------------------------------------------
+ ! Always initialize chemical scheme variables before INI_NSV call !
+ CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT0,KVERB)
+ LUSECHEM = .TRUE.
+ IF (LORILAM) THEN
+ CORGANIC = "MPMPO"
+ LVARSIGI = .TRUE.
+ LVARSIGJ = .TRUE.
+ CALL CH_AER_INIT_SOA(ILUOUT0, KVERB)
+ END IF
+ ! initialise NSV_* variables
+ CALL INI_NSV(1)
+ DEALLOCATE(XSV_LS)
+ ALLOCATE (XSV_LS(IIU,IJU,levlen,NSV))
+ XSV_LS(:,:,:,:) = 0.
+!
+ WRITE (ILUOUT0,'(A,A4,A)') ' | Reading MOZART species (ppp) from ',HFILE,' file'
+
+where (ZLONOUT(:) < 0.) ZLONOUT(:) = ZLONOUT(:) + 360.
+!
+ALLOCATE(ZVALUE(levlen,KILEN))
+ALLOCATE(ZOUT(levlen,INO))
+ALLOCATE(ZVALUE1D(KILEN))
+ALLOCATE(ZOUT1D(INO))
+
+!
+!* 2.6.1 read MOZART species from the file MOZ1.nam
+!
+! open input file
+CALL CH_OPEN_INPUT(YMOZ,"MOZ2MESONH",TZFILE,ILUOUT0,KVERB)
+ICHANNEL = TZFILE%NLU
+!
+!read number of mocage species to transfer into mesonh
+READ(ICHANNEL, *) IMOZ
+IF (KVERB >= 5) WRITE (ILUOUT0,*) "number of mozart species to transfer into &
+& mesonh : ", IMOZ
+!
+!read data input format
+READ(ICHANNEL,"(A)") YFORMAT
+YFORMAT=UPCASE(YFORMAT)
+IF (KVERB >= 5) WRITE (ILUOUT0,*) "input format is: ", YFORMAT
+
+!
+!allocate fields
+ALLOCATE(YSPCMNH(IMOZ)) !MESONH species
+ALLOCATE(TZSTOC(IMOZ,4)) !MOZART coefficient and MOZART species associated
+ALLOCATE(ISPCMOZ(IMOZ)) !MOZART species number into MESONH species
+ALLOCATE(ZCOEFMOZART(IMOZ,4))!Coef stoich of each MOZART species
+ALLOCATE(YCHANGE(IMOZ,4)) !MOZART species with _VMR_inst
+!read MESONH variable names and MOZART variable names associated
+DO JI = 1,IMOZ !for every MNH species existing in MOZ1.nam
+
+ READ(ICHANNEL,YFORMAT) YSPCMNH(JI), ISPCMOZ(JI), TZSTOC(JI,1)%ZCOEFMOZ,& !reading line by line
+ TZSTOC(JI,1)%YSPCMOZ, TZSTOC(JI,2)%ZCOEFMOZ,& !of string
+ TZSTOC(JI,2)%YSPCMOZ, TZSTOC(JI,3)%ZCOEFMOZ,&
+ TZSTOC(JI,3)%YSPCMOZ, TZSTOC(JI,4)%ZCOEFMOZ,&
+ TZSTOC(JI,4)%YSPCMOZ
+ WRITE(ILUOUT0,YFORMAT) YSPCMNH(JI), ISPCMOZ(JI),& !writing in arrays
+ TZSTOC(JI,1)%ZCOEFMOZ, TZSTOC(JI,1)%YSPCMOZ,&
+ TZSTOC(JI,2)%ZCOEFMOZ, TZSTOC(JI,2)%YSPCMOZ,&
+ TZSTOC(JI,3)%ZCOEFMOZ, TZSTOC(JI,3)%YSPCMOZ,&
+ TZSTOC(JI,4)%ZCOEFMOZ, TZSTOC(JI,4)%YSPCMOZ
+!
+ ZCOEFMOZART(JI,1) = (TZSTOC(JI,1)%ZCOEFMOZ) !coef stoich of each MOZART species set into an array
+ ZCOEFMOZART(JI,2) = (TZSTOC(JI,2)%ZCOEFMOZ)
+ ZCOEFMOZART(JI,3) = (TZSTOC(JI,3)%ZCOEFMOZ)
+ ZCOEFMOZART(JI,4) = (TZSTOC(JI,4)%ZCOEFMOZ)
+!
+ YA="_VMR_inst"
+ YCHANGE(JI,1)=trim(TZSTOC(JI,1)%YSPCMOZ)//YA !set into an array MOZART species with _VMR_inst
+ YCHANGE(JI,2)=trim(TZSTOC(JI,2)%YSPCMOZ)//YA
+ YCHANGE(JI,3)=trim(TZSTOC(JI,3)%YSPCMOZ)//YA
+ YCHANGE(JI,4)=trim(TZSTOC(JI,4)%YSPCMOZ)//YA
+!
+!* exchange mozart values onto prognostic variables XSV_LS
+! and convert MOZART fields to 2D for use in horizontal interpolation
+! routine HORIBL.f90
+!
+ DO JNCHEM = NSV_CHEMBEG, NSV_CHEMEND !loop on all MNH species
+ IF (trim(CNAMES(JNCHEM-NSV_CHEMBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species
+ IF (ISPCMOZ(JI)==1) THEN
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==2) THEN
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ) + &
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==3) THEN
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==4) THEN
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,4)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dquater, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,4)*vartemp3dquater(:,:,levlen+1-JJ)
+ ENDDO
+ ENDIF
+ DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMMOZ(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1+lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ int(latlen,kind=kind(1)),kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XSV_LS(:,:,JK,JNCHEM) )
+ ENDDO ! levlen
+ ENDIF
+
+ ENDDO ! JNCHEM
+ DO JNAER = NSV_AERBEG, NSV_AEREND
+ IF (trim(CAERONAMES(JNAER-NSV_AERBEG+1))==trim(YSPCMNH(JI))) THEN !MNH mechanism species
+ IF (ISPCMOZ(JI)==1) THEN
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==2) THEN
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ) + &
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==3) THEN
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)
+ ENDDO
+ ELSE IF (ISPCMOZ(JI)==4) THEN
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,1)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3d, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,2)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dbis, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,3)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dter, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_inq_varid(ncid, trim(YCHANGE(JI,4)), ind_netcdf)
+ if (status /= nf90_noerr) call handle_err(status)
+ status = nf90_get_var(ncid, ind_netcdf, vartemp3dquater, start=start3d, count=count3d)
+ if (status /= nf90_noerr) call handle_err(status)
+ DO JJ=1,levlen ! lev, lat, lon
+ ZCHEMMOZ(:,:,JJ)=ZCOEFMOZART(JI,1)*vartemp3d(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,2)*vartemp3dbis(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,3)*vartemp3dter(:,:,levlen+1-JJ)+&
+ ZCOEFMOZART(JI,4)*vartemp3dquater(:,:,levlen+1-JJ)
+ ENDDO
+ ENDIF
+ DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZCHEMMOZ(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1+lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ int(latlen,kind=kind(1)),kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE.)
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XSV_LS(:,:,JK,JNAER) )
+ ENDDO ! levlen
+ ENDIF
+ ENDDO ! JNAER
+ENDDO ! JIDO JNCHEM = NSV_CHEMBEG, NSV_CHEMEND !loop on all MNH species
+DEALLOCATE(YSPCMNH)
+DEALLOCATE(TZSTOC)
+DEALLOCATE(ISPCMOZ)
+DEALLOCATE(ZCOEFMOZART)
+DEALLOCATE(YCHANGE)
+!
+XSV_LS(:,:,:,:) = MAX(XSV_LS(:,:,:,:),0.)
+!
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZTMOZ(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ int(latlen,kind=kind(1)),kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.)
+!
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XT_SV_LS(:,:,JK))
+ENDDO
+XT_SV_LS(:,:,:) = MAX(XT_SV_LS(:,:,:),0.)
+!
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZQMOZ(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ int(latlen,kind=kind(1)),kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.FALSE.)
+!
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU, &
+ XQ_SV_LS(:,:,JK,1))
+ENDDO
+XQ_SV_LS(:,:,:,1) = MAX(XQ_SV_LS(:,:,:,1),0.)
+!
+JLOOP1 = 0
+DO JJ = 1, latlen
+ ZVALUE1D(JLOOP1+1:JLOOP1+lonlen) = ZPSMOZ(1:lonlen,JJ)
+ JLOOP1 = JLOOP1 + lonlen
+ENDDO
+CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ int(latlen,kind=kind(1)),kinlo,KILEN, &
+ ZVALUE1D(:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT1D(:),.FALSE.,PTIME_HORI,.FALSE.)
+!
+CALL ARRAY_1D_TO_2D(INO,ZOUT1D(:),IIU,IJU, &
+ XPS_SV_LS(:,:))
+XPS_SV_LS(:,:) = MAX(XPS_SV_LS(:,:),0.)
+!
+!
+!
+! close the netcdf file
+status = nf90_close(ncid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+ DEALLOCATE (ZVALUE)
+ DEALLOCATE (ZOUT)
+ DEALLOCATE (ZVALUE1D)
+ DEALLOCATE (ZOUT1D)
+!!
+
+! close
+! file
+CALL IO_File_close(TZFILE)
+
+
+!-------------------------------------------------------------
+!
+!* 4. VERTICAL GRID
+!
+!* 4.1 Read VERTICAL GRID
+!
+WRITE (ILUOUT0,'(A)') ' | Reading of vertical grid in progress'
+CALL READ_VER_GRID(TPPRE_REAL1)
+!
+!--------------------------------------------------------------
+!
+!* 4.2 Interpolate on Meso-NH VERTICAL GRID
+!
+!* 4.3 Free all temporary allocations
+!
+DEALLOCATE (ZLATOUT)
+DEALLOCATE (ZLONOUT)
+DEALLOCATE (hyam)
+DEALLOCATE (hybm)
+DEALLOCATE (vartemp3d)
+DEALLOCATE (vartemp3dbis)
+DEALLOCATE (vartemp3dter)
+DEALLOCATE (vartemp3dquater)
+!
+WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successfully'
+!
+!
+CONTAINS
+!
+! #############################
+ SUBROUTINE HANDLE_ERR(STATUS)
+! #############################
+ INTEGER(KIND=CDFINT) STATUS
+ IF (STATUS .NE. NF90_NOERR) THEN
+ PRINT *, NF90_STRERROR(STATUS)
+ STOP 'Stopped'
+ ENDIF
+ END SUBROUTINE HANDLE_ERR
+!
+!
+! #############################################
+ SUBROUTINE ARRAY_1D_TO_2D (KN1,P1,KL1,KL2,P2)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+USE MODE_MSG
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KN1
+REAL,DIMENSION(KN1), INTENT(IN) :: P1
+INTEGER, INTENT(IN) :: KL1
+INTEGER, INTENT(IN) :: KL2
+REAL,DIMENSION(KL1,KL2),INTENT(OUT) :: P2
+INTEGER :: JLOOP1_A1T2
+INTEGER :: JLOOP2_A1T2
+INTEGER :: JPOS_A1T2
+!
+IF (KN1 < KL1*KL2) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match')
+END IF
+JPOS_A1T2 = 1
+DO JLOOP2_A1T2 = 1, KL2
+ DO JLOOP1_A1T2 = 1, KL1
+ P2(JLOOP1_A1T2,JLOOP2_A1T2) = P1(JPOS_A1T2)
+ JPOS_A1T2 = JPOS_A1T2 + 1
+ END DO
+END DO
+END SUBROUTINE ARRAY_1D_TO_2D
+!
+END SUBROUTINE READ_CHEM_DATA_MOZART_CASE
diff --git a/src/MNH/read_dmsn.F90 b/src/MNH/read_dmsn.F90
new file mode 100644
index 000000000..c5a34c317
--- /dev/null
+++ b/src/MNH/read_dmsn.F90
@@ -0,0 +1,102 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE READ_DMS_n(DSF, U, HPROGRAM)
+! #################################
+!
+!!**** *READ_DMS_n* - routine to read oceanic DMS surface fields
+!!
+!! PURPOSE
+!! -------
+!!
+!! AUTHOR
+!! ------
+!! P. Tulet *LAERO*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/2021
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DMS_SURF_FIELDS_n, ONLY : DMS_SURF_FIELDS_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+!
+USE MODI_READ_SURF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+TYPE(DMS_SURF_FIELDS_t), INTENT(INOUT) :: DSF
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JDMS ! loop counter
+CHARACTER(LEN=3) :: YDMS
+!
+ CHARACTER(LEN=20 ):: YSTRING20 ! string
+ CHARACTER(LEN=3 ):: YSTRING03 ! string
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+ CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+ CHARACTER(LEN=100):: YCOMMENT ! Comment string
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Number of dummy fields :
+! ----------------------
+!
+IF (LHOOK) CALL DR_HOOK('READ_DMS_N',0,ZHOOK_HANDLE)
+!
+YRECFM='DMS_GR_NBR'
+YCOMMENT=' '
+!
+ CALL READ_SURF(HPROGRAM,YRECFM,DSF%NDMS_NBR,IRESP,HCOMMENT=YCOMMENT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Dummy fields :
+! ------------
+!
+ALLOCATE(DSF%CDMS_NAME(DSF%NDMS_NBR))
+ALLOCATE(DSF%CDMS_AREA(DSF%NDMS_NBR))
+ALLOCATE(DSF%XDMS_FIELDS(U%NSIZE_FULL,DSF%NDMS_NBR))
+DSF%CDMS_NAME(:) = ' '
+DSF%CDMS_AREA(:) = 'SEA'
+!
+!
+DO JDMS=1,DSF%NDMS_NBR
+ !
+ WRITE(YDMS,'(I3.3)') (JDMS)
+ YRECFM='DMS_NB'//ADJUSTL(YDMS(:LEN_TRIM(YDMS)))
+ YSTRING20=DSF%CDMS_NAME(JDMS)
+ YSTRING03=DSF%CDMS_AREA(JDMS)
+ YCOMMENT='X_Y_'//ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//'_'//ADJUSTL(YSTRING20(:LEN_TRIM(YSTRING20)))//&
+ '_'//ADJUSTL(YSTRING03(:LEN_TRIM(YSTRING03)))
+
+ CALL READ_SURF(HPROGRAM,YRECFM,DSF%XDMS_FIELDS(:,JDMS),IRESP,HCOMMENT=YCOMMENT)
+
+ YRECFM='DMS_NAME'//ADJUSTL(YDMS(:LEN_TRIM(YDMS)))
+ CALL READ_SURF(HPROGRAM,YRECFM,DSF%CDMS_NAME(JDMS),IRESP,HCOMMENT=YCOMMENT)
+ !
+END DO
+!
+IF (LHOOK) CALL DR_HOOK('READ_DMS_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_DMS_n
diff --git a/src/MNH/read_lima_data_netcdf_case.f90 b/src/MNH/read_lima_data_netcdf_case.f90
new file mode 100644
index 000000000..e6ffb4742
--- /dev/null
+++ b/src/MNH/read_lima_data_netcdf_case.f90
@@ -0,0 +1,898 @@
+!MNH_LIC Copyright 2012-2017 CNRS, Meteo-France and Universite Paul Sabatier
+!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence
+!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!MNH_LIC for details. version 1.
+!-----------------------------------------------------------------
+! ################################
+ MODULE MODI_READ_LIMA_DATA_NETCDF_CASE
+! #################################
+INTERFACE
+SUBROUTINE READ_LIMA_DATA_NETCDF_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, &
+ PTIME_HORI,KVERB,ODUMMY_REAL )
+!
+USE MODD_IO, ONLY: TFILEDATA
+!
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file
+TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields
+END SUBROUTINE READ_LIMA_DATA_NETCDF_CASE
+!
+END INTERFACE
+END MODULE MODI_READ_LIMA_DATA_NETCDF_CASE
+! ####################################################################
+ SUBROUTINE READ_LIMA_DATA_NETCDF_CASE(TPPRE_REAL1,HFILE,TPPGDFILE, &
+ PTIME_HORI,KVERB,ODUMMY_REAL )
+! ####################################################################
+!
+!!**** *READ_LIMA_DATA_NETCDF_CASE* - reads data for the initialization of real cases.
+!!
+!! PURPOSE
+!! -------
+! This routine reads the two input files :
+! The PGD which is closed after reading
+! The NETCDF file
+! Projection is read in READ_LFIFM_PGD (MODD_GRID).
+! Grid and definition of large domain are read in PGD file and
+! NETCDF files.
+! The PGD files are also read in READ_LFIFM_PGD.
+! The PGD file is closed.
+! Vertical grid is defined in READ_VER_GRID.
+! PGD fields are stored on MESO-NH domain (in TRUNC_PGD).
+!!
+!!** METHOD
+!! ------
+!! 0. Declarations
+!! 1. Declaration of arguments
+!! 2. Declaration of local variables
+!! 1. Read PGD file
+!! 1. Domain restriction
+!! 2. Coordinate conversion to lat,lon system
+!! 2. Read Netcdf fields
+!! 3. Vertical grid
+!! 4. Free all temporary allocations
+!!
+!! EXTERNAL
+!! --------
+!! subroutine READ_LFIFM_PGD : to read PGD file
+!! subroutine READ_VER_GRID : to read the vertical grid in namelist file.
+!! subroutine HORIBL : horizontal bilinear interpolation
+!! subroutine XYTOLATLON : projection from conformal to lat,lon
+!!
+!! Module MODI_READ_VER_GRID : interface for subroutine READ_VER_GRID
+!! Module MODI_HORIBL : interface for subroutine HORIBL
+!! Module MODI_XYTOLATLON : interface for subroutine XYTOLATLON
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! Module MODD_CONF : contains configuration variables for all models.
+!! NVERB : verbosity level for output-listing
+!! Module MODD_LUNIT : contains logical unit names for all models
+!! CLUOUT0 : name of output-listing
+!! Module MODD_PGDDIM : contains dimension of PGD fields
+!! NPGDIMAX: dimension along x (no external point)
+!! NPGDJMAX: dimension along y (no external point)
+!! Module MODD_PARAMETERS
+!! JPHEXT
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 23/01/12 (C. Mari)
+!! P. Wautelet 30/10/17 use F90 module for netCDF
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_BLANK_n
+USE MODD_CH_AEROSOL, ONLY: CORGANIC, NCARB, NSOA, NSP, LORILAM,&
+ JPMODE, LVARSIGI, LVARSIGJ,CAERONAMES
+USE MODD_CH_M9_n, ONLY: NEQ , CNAMES
+USE MODD_CH_MNHC_n, ONLY: LUSECHEM,LUSECHAQ,LUSECHIC,LCH_PH
+USE MODD_CONF
+USE MODD_CONF_n
+USE MODD_CST
+USE MODD_DIM_n
+USE MODD_GRID
+USE MODD_GRID_n
+USE MODD_IO, ONLY: TFILEDATA
+USE MODD_LUNIT, ONLY: TLUOUT0
+USE MODE_MODELN_HANDLER
+USE MODD_NETCDF, ONLY:CDFINT
+USE MODD_NSV
+USE MODD_PARAMETERS
+USE MODD_PARAM_n, ONLY : CTURB
+USE MODD_PREP_REAL
+USE MODD_TIME
+USE MODD_TIME_n
+!
+!UPG*PT
+!USE MODE_FM
+!USE MODE_IO_ll
+USE MODE_IO
+USE MODE_TOOLS_ll
+!UPG*PT
+USE MODE_MPPDB
+USE MODE_THERMO
+USE MODE_TIME
+!
+USE MODI_CH_AER_INIT_SOA
+USE MODI_CH_INIT_SCHEME_n
+USE MODI_CH_OPEN_INPUT
+USE MODI_HORIBL
+USE MODI_INI_NSV
+USE MODI_READ_HGRID_n
+USE MODI_READ_VER_GRID
+USE MODI_XYTOLATLON
+!
+USE NETCDF
+!
+USE MODD_PARAM_n, ONLY : CCLOUD
+USE MODD_PARAM_LIMA, ONLY : NMOD_CCN, LSCAV, LAERO_MASS, HINI_CCN, HTYPE_CCN, &
+ NMOD_IFN, NMOD_IMM, LHHONI, NINDICE_CCN_IMM
+!
+IMPLICIT NONE
+!
+!* 0.1. Declaration of arguments
+! ------------------------
+!
+TYPE(TFILEDATA),POINTER,INTENT(IN) :: TPPRE_REAL1 ! PRE_REAL1 file
+CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of the NETCDF file
+TYPE(TFILEDATA), INTENT(IN) :: TPPGDFILE ! physiographic data file
+REAL, INTENT(INOUT) :: PTIME_HORI ! time spent in hor. interpolations
+INTEGER, INTENT(IN) :: KVERB ! verbosity level
+LOGICAL, INTENT(IN) :: ODUMMY_REAL! flag to interpolate dummy fields
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+! General purpose variables
+INTEGER :: ILUOUT0 ! Unit used for output msg.
+INTEGER :: JI,JJ,JK ! Dummy counters
+INTEGER :: JLOOP1
+! Variables used by the PGD reader
+CHARACTER(LEN=28) :: YPGD_NAME ! not used - dummy argument
+CHARACTER(LEN=28) :: YPGD_DAD_NAME ! not used - dummy argument
+CHARACTER(LEN=2) :: YPGD_TYPE ! not used - dummy argument
+! PGD Grib definition variables
+INTEGER :: INO ! Number of points of the grid
+INTEGER :: IIU ! Number of points along X
+INTEGER :: IJU ! Number of points along Y
+REAL, DIMENSION(:), ALLOCATABLE :: ZLONOUT ! mapping PGD -> Grib (lon.)
+REAL, DIMENSION(:), ALLOCATABLE :: ZLATOUT ! mapping PGD -> Grib (lat.)
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZXM ! X of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZYM ! Y of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLATM ! Lat of PGD mass points
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZLONM ! Lon of PGD mass points
+! Variable involved in the task of reading the netcdf file
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZVALUE ! Intermediate array
+REAL,DIMENSION(:),ALLOCATABLE :: ZVALUE1D ! Intermediate array
+REAL,DIMENSION(:,:),ALLOCATABLE :: ZOUT ! Intermediate arrays
+REAL,DIMENSION(:),ALLOCATABLE :: ZOUT1D ! Intermediate arrays
+! model indice
+INTEGER :: IMI
+TYPE(TFILEDATA),POINTER :: TZFILE
+!
+! For netcdf
+!
+integer(kind=CDFINT) :: status, ncid, varid
+integer(kind=CDFINT) :: lat_varid, lon_varid, lev_varid, time_varid
+integer(kind=CDFINT) :: a_varid, b_varid, p0_varid, ps_varid, t_varid, q_varid
+integer(kind=CDFINT) :: mmr_dust1_varid, mmr_dust2_varid, mmr_dust3_varid
+integer(kind=CDFINT) :: mmr_seasalt1_varid, mmr_seasalt2_varid, mmr_seasalt3_varid
+integer(kind=CDFINT) :: mmr_bc_hydrophilic_varid, mmr_bc_hydrophobic_varid
+integer(kind=CDFINT) :: mmr_oc_hydrophilic_varid, mmr_oc_hydrophobic_varid
+integer(kind=CDFINT) :: mmr_sulfaer_varid
+integer(kind=CDFINT) :: recid, latid, lonid, levid, timeid
+integer(kind=CDFINT) :: latlen, lonlen, levlen, nrecs,timelen
+integer(kind=CDFINT) :: KILEN
+CHARACTER(LEN=40) :: recname
+REAL, DIMENSION(:), ALLOCATABLE :: lats
+REAL, DIMENSION(:), ALLOCATABLE :: lons
+REAL, DIMENSION(:), ALLOCATABLE :: levs
+INTEGER, DIMENSION(:), ALLOCATABLE :: count3d, start3d
+INTEGER, DIMENSION(:), ALLOCATABLE :: count2d, start2d
+REAL, DIMENSION(:), ALLOCATABLE :: time, a, b
+REAL :: p0
+INTEGER, DIMENSION(:), ALLOCATABLE :: kinlo
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_dust1, mmr_dust2, mmr_dust3
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_seasalt1, mmr_seasalt2, mmr_seasalt3
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_bc_hydrophilic, mmr_bc_hydrophobic
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_oc_hydrophilic, mmr_oc_hydrophobic
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: mmr_sulfaer
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWORK
+!REAL, DIMENSION(:,:,:), ALLOCATABLE :: TMOZ, QMOZ, PSMOZ
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTCAM, ZQCAM
+REAL, DIMENSION(:,:), ALLOCATABLE :: ZPSCAM
+REAL :: scale, offset
+! for reverse altitude
+REAL, DIMENSION(:), ALLOCATABLE :: TMP1, TMP2
+REAL, DIMENSION(:,:,:), ALLOCATABLE :: TMP3
+REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: TMP4,TMP5
+!----------------------------------------------------------------------
+TZFILE => NULL()
+!
+IMI = GET_CURRENT_MODEL_INDEX()
+!
+!--------------------------------------------------------------
+!
+!* 1. READ PGD FILE
+! -------------
+!
+ILUOUT0 = TLUOUT0%NLU
+CALL READ_HGRID_n(TPPGDFILE,YPGD_NAME,YPGD_DAD_NAME,YPGD_TYPE)
+!
+! 1.1 Domain restriction
+!
+CALL GET_DIM_EXT_ll('B',IIU,IJU)
+INO = IIU * IJU
+!
+!
+! 1.2 Coordinate conversion to lat,lon system
+!
+ALLOCATE (ZXM(IIU,IJU))
+ALLOCATE (ZYM(IIU,IJU))
+ALLOCATE (ZLONM(IIU,IJU))
+ALLOCATE (ZLATM(IIU,IJU))
+ZXM(1:IIU-1,1) = (XXHAT(1:IIU-1) + XXHAT(2:IIU) ) / 2.
+ZXM(IIU,1) = XXHAT(IIU) - XXHAT(IIU-1) + ZXM(IIU-1,1)
+ZXM(:,2:IJU) = SPREAD(ZXM(:,1),2,IJU-1)
+ZYM(1,1:IJU-1) = (XYHAT(1:IJU-1) + XYHAT(2:IJU)) / 2.
+ZYM(1,IJU) = XYHAT(IJU) - XYHAT(IJU-1) + ZYM(1,IJU-1)
+ZYM(2:IIU,:) = SPREAD(ZYM(1,:),1,IIU-1)
+CALL SM_XYTOLATLON_A (XLAT0,XLON0,XRPK,XLATORI,XLONORI,ZXM,ZYM,ZLATM,ZLONM, &
+ IIU,IJU)
+ALLOCATE (ZLONOUT(INO))
+ALLOCATE (ZLATOUT(INO))
+JLOOP1 = 0
+DO JJ = 1, IJU
+ ZLONOUT(JLOOP1+1:JLOOP1+IIU) = ZLONM(1:IIU,JJ)
+ ZLATOUT(JLOOP1+1:JLOOP1+IIU) = ZLATM(1:IIU,JJ)
+ JLOOP1 = JLOOP1 + IIU
+ENDDO
+DEALLOCATE (ZYM)
+DEALLOCATE (ZXM)
+!
+!--------------------------------------------------------------
+!
+!* 2. READ NETCDF FIELDS
+! ------------------
+!
+! 2.1 Open netcdf files
+!
+status = nf90_open(HFILE, nf90_nowrite, ncid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+! 2.2 Read netcdf files
+!
+! get dimension IDs
+!
+!* get dimension ID of unlimited variable in netcdf file
+status = nf90_inquire(ncid, unlimitedDimId = recid)
+!status = nf90_inq_dimid(ncid, "time", timeid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_dimid(ncid, "latitude", latid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_dimid(ncid, "longitude", lonid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_dimid(ncid, "level", levid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+! get dimensions
+!
+!* get dimension and name of unlimited variable in netcdf file
+status = nf90_inquire_dimension(ncid, recid, name=recname, len=nrecs)
+!status = nf90_inquire_dimension(ncid, timeid, len=nrecs)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inquire_dimension(ncid, latid, len=latlen)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inquire_dimension(ncid, lonid, len=lonlen)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inquire_dimension(ncid, levid, len=levlen)
+if (status /= nf90_noerr) call handle_err(status)
+!
+! get variable IDs
+!
+status = nf90_inq_varid(ncid, "latitude", lat_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "longitude", lon_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "level", lev_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "time", time_varid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+!!! status = nf90_inq_varid(ncid, "a", a_varid)
+!!! if (status /= nf90_noerr) call handle_err(status)
+!!! status = nf90_inq_varid(ncid, "b", b_varid)
+!!! if (status /= nf90_noerr) call handle_err(status)
+!
+status = nf90_inq_varid(ncid, "aermr04", mmr_dust1_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "aermr05", mmr_dust2_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "aermr06", mmr_dust3_varid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+status = nf90_inq_varid(ncid, "aermr01", mmr_seasalt1_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "aermr02", mmr_seasalt2_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "aermr03", mmr_seasalt3_varid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+status = nf90_inq_varid(ncid, "aermr10", mmr_bc_hydrophilic_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "aermr09", mmr_bc_hydrophobic_varid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+status = nf90_inq_varid(ncid, "aermr08", mmr_oc_hydrophilic_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "aermr07", mmr_oc_hydrophobic_varid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+status = nf90_inq_varid(ncid, "aermr11", mmr_sulfaer_varid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+!!! status = nf90_inq_varid(ncid, "p0", p0_varid)
+!!! if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "sp", ps_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "t", t_varid)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_inq_varid(ncid, "q", q_varid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+
+KILEN = latlen * lonlen
+!
+! 2.3 Read data.
+!
+ALLOCATE (count3d(4))
+ALLOCATE (start3d(4))
+ALLOCATE (count2d(3))
+ALLOCATE (start2d(3))
+ALLOCATE (lats(latlen))
+ALLOCATE (lons(lonlen))
+ALLOCATE (levs(levlen))
+ALLOCATE (kinlo(latlen))
+kinlo(:) = lonlen
+!ALLOCATE (time(nrecs))
+!ALLOCATE (a(levlen))
+!ALLOCATE (b(levlen))
+! T, Q, Ps :
+ALLOCATE (ZTCAM(lonlen,latlen,levlen))
+ALLOCATE (ZQCAM(lonlen,latlen,levlen))
+!ALLOCATE (ZPSCAM(lonlen,latlen,levlen))
+ALLOCATE (ZPSCAM(lonlen,latlen))
+! transformed a, b :
+ALLOCATE (XA_SV_LS(levlen))
+ALLOCATE (XB_SV_LS(levlen))
+! meteo var
+ALLOCATE (XT_SV_LS(IIU,IJU,levlen))
+ALLOCATE (XQ_SV_LS(IIU,IJU,levlen,1))
+ALLOCATE (XPS_SV_LS(IIU,IJU))
+ALLOCATE (XZS_SV_LS(IIU,IJU))
+! take the orography from ECMWF
+XZS_SV_LS(:,:) = XZS_LS(:,:)
+! aerosol mr from CAMS or MACC
+ALLOCATE (mmr_dust1(lonlen,latlen,levlen))
+ALLOCATE (mmr_dust2(lonlen,latlen,levlen))
+ALLOCATE (mmr_dust3(lonlen,latlen,levlen))
+!
+ALLOCATE (mmr_seasalt1(lonlen,latlen,levlen))
+ALLOCATE (mmr_seasalt2(lonlen,latlen,levlen))
+ALLOCATE (mmr_seasalt3(lonlen,latlen,levlen))
+!
+ALLOCATE (mmr_bc_hydrophilic(lonlen,latlen,levlen))
+ALLOCATE (mmr_bc_hydrophobic(lonlen,latlen,levlen))
+!
+ALLOCATE (mmr_oc_hydrophilic(lonlen,latlen,levlen))
+ALLOCATE (mmr_oc_hydrophobic(lonlen,latlen,levlen))
+!
+ALLOCATE (mmr_sulfaer(lonlen,latlen,levlen))
+!
+ALLOCATE (ZWORK(lonlen,latlen,levlen))
+!
+! get values of variables
+!
+status = nf90_get_var(ncid, lat_varid, lats(:))
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_var(ncid, lon_varid, lons(:))
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_var(ncid, lev_varid, levs(:))
+if (status /= nf90_noerr) call handle_err(status)
+!!! status = nf90_get_var(ncid, time_varid, time(:))
+!!! if (status /= nf90_noerr) call handle_err(status)
+!!! status = nf90_get_var(ncid, a_varid, a(:))
+!!! if (status /= nf90_noerr) call handle_err(status)
+!!! status = nf90_get_var(ncid, b_varid, b(:))
+!!! if (status /= nf90_noerr) call handle_err(status)
+!!! status = nf90_get_var(ncid, p0_varid, p0)
+!!! if (status /= nf90_noerr) call handle_err(status)
+!
+! Reference pressure (needed for the vertical interpolation)
+!
+!!! XP00_SV_LS = p0
+XP00_SV_LS = 101325.0
+!
+! a and b coefficients (needed for the vertical interpolation)
+!
+XA_SV_LS(:) = (/ 20.000000000, 38.425343000, 63.647804000, 95.636963000, 134.48330700, &
+ 180.58435100, 234.77905300, 298.49578900, 373.97192400, 464.61813400, &
+ 575.65100100, 713.21807900, 883.66052200, 1094.8347170, 1356.4746090, &
+ 1680.6402590, 2082.2739260, 2579.8886720, 3196.4216310, 3960.2915040, &
+ 4906.7084960, 6018.0195310, 7306.6313480, 8765.0537110, 10376.126953, &
+ 12077.446289, 13775.325195, 15379.805664, 16819.474609, 18045.183594, &
+ 19027.695313, 19755.109375, 20222.205078, 20429.863281, 20384.480469, &
+ 20097.402344, 19584.330078, 18864.750000, 17961.357422, 16899.468750, &
+ 15706.447266, 14411.124023, 13043.218750, 11632.758789, 10209.500977, &
+ 8802.3564450, 7438.8032230, 6144.3149410, 4941.7783200, 3850.9133300, &
+ 2887.6965330, 2063.7797850, 1385.9125980, 855.36175500, 467.33358800, &
+ 210.39389000, 65.889244000, 7.3677430000, 0.0000000000, 0.0000000000 /)
+
+XA_SV_LS(:) = XA_SV_LS(:) / XP00_SV_LS
+
+XB_SV_LS(:) = (/ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00000000, 0.00000000, &
+ 0.00000000, 0.00000000, 0.00000000, 0.00007582, 0.00046139, &
+ 0.00181516, 0.00508112, 0.01114291, 0.02067788, 0.03412116, &
+ 0.05169041, 0.07353383, 0.09967469, 0.13002251, 0.16438432, &
+ 0.20247594, 0.24393314, 0.28832296, 0.33515489, 0.38389215, &
+ 0.43396294, 0.48477158, 0.53570992, 0.58616841, 0.63554746, &
+ 0.68326861, 0.72878581, 0.77159661, 0.81125343, 0.84737492, &
+ 0.87965691, 0.90788388, 0.93194032, 0.95182151, 0.96764523, &
+ 0.97966272, 0.98827010, 0.99401945, 0.99763012, 1.00000000 /)
+!
+! Read 1 record of lon*lat values, starting at the
+! beginning of the record (the (1, 1, rec=time) element in the netCDF
+! file).
+count2d(1) = lonlen
+count2d(2) = latlen
+count2d(3) = 1
+start2d(1) = 1
+start2d(2) = 1
+start2d(3) = 1
+!
+! Read 1 record of lon*lat*lev values, starting at the
+! beginning of the record (the (1, 1, 1, rec=time) element in the netCDF
+! file).
+count3d(1) = lonlen
+count3d(2) = latlen
+count3d(3) = levlen
+count3d(4) = 1
+start3d(1) = 1
+start3d(2) = 1
+start3d(3) = 1
+start3d(4) = 1
+!
+! Temperature and spec. hum. (needed for the vertical interpolation)
+!
+status = nf90_get_var(ncid, t_varid, ZTCAM(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, t_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, t_varid, "add_offset", offset)
+ZTCAM(:,:,:) = offset + scale * ZTCAM(:,:,:)
+!
+status = nf90_get_var(ncid, q_varid, ZQCAM(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, q_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, q_varid, "add_offset", offset)
+ZQCAM(:,:,:) = offset + scale * ZQCAM(:,:,:)
+!
+status = nf90_get_var(ncid, ps_varid, ZPSCAM(:,:), start=start2d, count=count2d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, ps_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, ps_varid, "add_offset", offset)
+ZPSCAM(:,:) = offset + scale * ZPSCAM(:,:)
+!ZPSCAM(:,:) = EXP( ZPSCAM(:,:) )
+!
+! Aerosol concentrations
+!
+status = nf90_get_var(ncid, mmr_dust1_varid, mmr_dust1(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_dust1_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_dust1_varid, "add_offset", offset)
+mmr_dust1(:,:,:) = offset + scale * mmr_dust1(:,:,:)
+!
+status = nf90_get_var(ncid, mmr_dust2_varid, mmr_dust2(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_dust2_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_dust2_varid, "add_offset", offset)
+mmr_dust2(:,:,:) = offset + scale * mmr_dust2(:,:,:)
+!
+status = nf90_get_var(ncid, mmr_dust3_varid, mmr_dust3(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_dust3_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_dust3_varid, "add_offset", offset)
+mmr_dust3(:,:,:) = offset + scale * mmr_dust3(:,:,:)
+!
+!
+status = nf90_get_var(ncid, mmr_seasalt1_varid, mmr_seasalt1(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_seasalt1_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_seasalt1_varid, "add_offset", offset)
+mmr_seasalt1(:,:,:) = offset + scale * mmr_seasalt1(:,:,:)
+!
+status = nf90_get_var(ncid, mmr_seasalt2_varid, mmr_seasalt2(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_seasalt2_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_seasalt2_varid, "add_offset", offset)
+mmr_seasalt2(:,:,:) = offset + scale * mmr_seasalt2(:,:,:)
+!
+status = nf90_get_var(ncid, mmr_seasalt3_varid, mmr_seasalt3(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_seasalt3_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_seasalt3_varid, "add_offset", offset)
+mmr_seasalt3(:,:,:) = offset + scale * mmr_seasalt3(:,:,:)
+!
+!
+status = nf90_get_var(ncid, mmr_bc_hydrophilic_varid, mmr_bc_hydrophilic(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_bc_hydrophilic_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_bc_hydrophilic_varid, "add_offset", offset)
+mmr_bc_hydrophilic(:,:,:) = offset + scale * mmr_bc_hydrophilic(:,:,:)
+!
+status = nf90_get_var(ncid, mmr_bc_hydrophobic_varid, mmr_bc_hydrophobic(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_bc_hydrophobic_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_bc_hydrophobic_varid, "add_offset", offset)
+mmr_bc_hydrophobic(:,:,:) = offset + scale * mmr_bc_hydrophobic(:,:,:)
+!
+!
+status = nf90_get_var(ncid, mmr_oc_hydrophilic_varid, mmr_oc_hydrophilic(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_oc_hydrophilic_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_oc_hydrophilic_varid, "add_offset", offset)
+mmr_oc_hydrophilic(:,:,:) = offset + scale * mmr_oc_hydrophilic(:,:,:)
+!
+status = nf90_get_var(ncid, mmr_oc_hydrophobic_varid, mmr_oc_hydrophobic(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_oc_hydrophobic_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_oc_hydrophobic_varid, "add_offset", offset)
+mmr_oc_hydrophobic(:,:,:) = offset + scale * mmr_oc_hydrophobic(:,:,:)
+!
+!
+status = nf90_get_var(ncid, mmr_sulfaer_varid, mmr_sulfaer(:,:,:), start=start3d, count=count3d)
+if (status /= nf90_noerr) call handle_err(status)
+status = nf90_get_att(ncid, mmr_sulfaer_varid, "scale_factor", scale)
+status = nf90_get_att(ncid, mmr_sulfaer_varid, "add_offset", offset)
+mmr_sulfaer(:,:,:) = offset + scale * mmr_sulfaer(:,:,:)
+!
+!--------------------------------------------------------------
+!
+!* 3 Conversion of MACC or CAMS variables into LIMA variables
+! ------------------------------------------------
+!
+! initialise NSV_* variables
+! cas simple : 3 modes de CCN (dont 1 actif par immersion), 2 modes IFN
+! CCN1 : seasalt
+! CCN2 : sulfates
+! CCN3 (IMM) : hydrophilic OM and BC
+! IFN1 : dust
+! IFN2 : hydrophobic OM and BC
+!
+! XSV : Nc, Nr, 3 CCN free, 3 CCN activés, Ni, 2 IN free, 2 IN activé = 11 variables
+!
+! Concentrations en nombre par kilo !
+!
+CCLOUD='LIMA'
+NMOD_CCN=3
+LSCAV=.FALSE.
+LAERO_MASS=.FALSE.
+NMOD_IFN=2
+NMOD_IMM=1
+LHHONI=.FALSE.
+HINI_CCN='AER'
+HTYPE_CCN(1)='M'
+HTYPE_CCN(2)='C'
+HTYPE_CCN(3)='C'
+!
+! 3.1 initialize lima sv var.
+!
+! Always initialize chemical scheme variables before INI_NSV call !
+CALL CH_INIT_SCHEME_n(IMI,LUSECHAQ,LUSECHIC,LCH_PH,ILUOUT0,KVERB)
+IF (LORILAM) THEN
+ CORGANIC = "MPMPO"
+ LVARSIGI = .TRUE.
+ LVARSIGJ = .TRUE.
+ CALL CH_AER_INIT_SOA(ILUOUT0, KVERB)
+END IF
+!
+CALL INI_NSV(1)
+DEALLOCATE(XSV_LS_LIMA)
+ALLOCATE (XSV_LS_LIMA(IIU,IJU,levlen,NSV))
+XSV_LS_LIMA(:,:,:,:) = 0.
+!
+ALLOCATE(NINDICE_CCN_IMM(1))
+NINDICE_CCN_IMM(1)=3
+!
+! Define work arrays
+!
+ALLOCATE(ZVALUE(levlen,KILEN))
+ALLOCATE(ZVALUE1D(KILEN))
+ALLOCATE(ZOUT(levlen,INO))
+ALLOCATE(ZOUT1D(INO))
+!
+where (ZLONOUT(:) < 0.) ZLONOUT(:) = ZLONOUT(:) + 360. ! correct longitudes
+!
+!
+! 3.2 Select CAMS/MACC mixing ratios and perform the horizontal interpolation
+!
+! Free CCN concentration (mode 1)
+!
+ZWORK(:,:,:)=mmr_seasalt1(:,:,:)+mmr_seasalt2(:,:,:)+mmr_seasalt3(:,:,:)
+!!! ZWORK(:,:,:)=mmr_seasalt2(:,:,:)
+!!!JPP ZWORK(:,:,:)=ZWORK(:,:,:)*1.E18/3620.
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZWORK(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XSV_LS_LIMA(:,:,JK,NSV_LIMA_CCN_FREE))
+ENDDO
+!
+! Free CCN concentration (mode 2)
+!
+!!!JPP ZWORK(:,:,:)=mmr_sulfaer(:,:,:)*1.E18/345
+ZWORK(:,:,:)=mmr_sulfaer(:,:,:)
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZWORK(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XSV_LS_LIMA(:,:,JK,NSV_LIMA_CCN_FREE + 1))
+ENDDO
+!
+! Free CCN concentration (mode 3, IMM)
+!
+!!!JPP ZWORK(:,:,:)=mmr_bc_hydrophilic(:,:,:)*1.E18/20.
+!!!JPP ZWORK(:,:,:)=ZWORK(:,:,:) + mmr_oc_hydrophilic(:,:,:)*1.E18/16.
+ZWORK(:,:,:)=mmr_bc_hydrophilic(:,:,:)+mmr_oc_hydrophilic(:,:,:)
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZWORK(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XSV_LS_LIMA(:,:,JK,NSV_LIMA_CCN_FREE + 2))
+ENDDO
+!
+! Free IFN concentration (mode 1)
+!
+!!!JPP ZWORK(:,:,:)=mmr_dust2(:,:,:)*1.E18/(1204.*0.58)
+!!!JPP ZWORK2(:,:,:)=max(0.,(mmr_dust3(:,:,:)*1.E18/1204.-2.4*ZWORK(:,:,:))/70.)
+ZWORK(:,:,:)=mmr_dust1(:,:,:) + mmr_dust2(:,:,:) + mmr_dust3(:,:,:)
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZWORK(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XSV_LS_LIMA(:,:,JK,NSV_LIMA_IFN_FREE))
+ENDDO
+!
+! Free IFN concentration (mode 2)
+!
+!!!JPP ZWORK(:,:,:)=mmr_bc_hydrophobic(:,:,:)*1.E18/20.
+!!!JPP ZWORK(:,:,:)=ZWORK(:,:,:) + mmr_oc_hydrophobic(:,:,:)*1.E18/16.
+ZWORK(:,:,:)=mmr_bc_hydrophobic(:,:,:)+mmr_oc_hydrophobic(:,:,:)
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZWORK(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XSV_LS_LIMA(:,:,JK,NSV_LIMA_IFN_FREE + 1))
+ENDDO
+!
+! 3.3 Meteo ver. perform the horizontal interpolation
+!
+! Temperature (needed for the vertical interpolation)
+!
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZTCAM(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XT_SV_LS(:,:,JK))
+ENDDO ! levlen
+!
+! Spec. Humidity (needed for the vertical interpolation)
+!
+DO JK = 1, levlen
+ JLOOP1 = 0
+ DO JJ = 1, latlen
+ ZVALUE(JK,JLOOP1+1:JLOOP1+lonlen) = ZQCAM(1:lonlen,JJ,JK)
+ JLOOP1 = JLOOP1 + lonlen
+ ENDDO
+ CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE(JK,:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT(JK,:),.FALSE.,PTIME_HORI,.TRUE. )
+ CALL ARRAY_1D_TO_2D(INO,ZOUT(JK,:),IIU,IJU,XQ_SV_LS(:,:,JK,1))
+ENDDO ! levlen
+!
+! Surface pressure (needed for the vertical interpolation)
+!
+JLOOP1 = 0
+DO JJ = 1, latlen
+ ZVALUE1D(JLOOP1+1:JLOOP1+lonlen) = ZPSCAM(1:lonlen,JJ)
+ JLOOP1 = JLOOP1 + lonlen
+ENDDO
+CALL HORIBL(lats(1),lons(1),lats(latlen),lons(lonlen), &
+ latlen,kinlo,KILEN, &
+ ZVALUE1D(:),INO,ZLONOUT,ZLATOUT, &
+ ZOUT1D(:),.FALSE.,PTIME_HORI,.TRUE. )
+CALL ARRAY_1D_TO_2D(INO,ZOUT1D(:),IIU,IJU,XPS_SV_LS(:,:))
+!
+! 3.4 Correct negative values produced by the horizontal interpolations
+!
+XSV_LS_LIMA(:,:,:,:) = MAX(XSV_LS_LIMA(:,:,:,:),0.)
+XPS_SV_LS(:,:) = MAX(XPS_SV_LS(:,:),0.)
+XT_SV_LS(:,:,:) = MAX(XT_SV_LS(:,:,:),0.)
+XQ_SV_LS(:,:,:,1) = MAX(XQ_SV_LS(:,:,:,1),0.)
+!
+! 3.5 If Netcdf vertical levels have to be reversed :
+!
+ALLOCATE(TMP1(levlen))
+ALLOCATE(TMP2(levlen))
+ALLOCATE(TMP3(IIU,IJU,levlen))
+ALLOCATE(TMP4(IIU,IJU,levlen,NRR))
+ALLOCATE(TMP5(IIU,IJU,levlen,NSV))
+DO JJ=1,levlen
+ ! inv. lev
+ TMP1(JJ) = XA_SV_LS(levlen+1-JJ)
+ TMP2(JJ) = XB_SV_LS(levlen+1-JJ)
+ TMP3(:,:,JJ) = XT_SV_LS(:,:,levlen+1-JJ)
+ TMP4(:,:,JJ,:) = XQ_SV_LS(:,:,levlen+1-JJ,:)
+ TMP5(:,:,JJ,:) = XSV_LS(:,:,levlen+1-JJ,:)
+ENDDO
+XA_SV_LS(:) = TMP1(:)
+XB_SV_LS(:) = TMP2(:)
+XT_SV_LS(:,:,:) = TMP3(:,:,:)
+XQ_SV_LS(:,:,:,:) = TMP4(:,:,:,:)
+XSV_LS(:,:,:,:) = TMP5(:,:,:,:)
+DEALLOCATE(TMP1)
+DEALLOCATE(TMP2)
+DEALLOCATE(TMP3)
+DEALLOCATE(TMP4)
+DEALLOCATE(TMP5)
+!
+! 3.6 close the netcdf file
+!
+status = nf90_close(ncid)
+if (status /= nf90_noerr) call handle_err(status)
+!
+DEALLOCATE (ZVALUE)
+DEALLOCATE (ZOUT)
+!!
+!-------------------------------------------------------------
+!
+!* 4. VERTICAL GRID
+! -------------
+!
+! 4.1 Read VERTICAL GRID
+!
+WRITE (ILUOUT0,'(A)') ' | Reading of vertical grid in progress'
+CALL READ_VER_GRID(TPPRE_REAL1)
+!
+!--------------------------------------------------------------
+!
+! 5. Free all temporary allocations
+! ------------------------------
+!
+DEALLOCATE (ZLATOUT)
+DEALLOCATE (ZLONOUT)
+DEALLOCATE (count3d)
+DEALLOCATE (start3d)
+DEALLOCATE (count2d)
+DEALLOCATE (start2d)
+!
+DEALLOCATE (lats)
+DEALLOCATE (lons)
+DEALLOCATE (levs)
+!DEALLOCATE (time)
+!DEALLOCATE (a)
+!DEALLOCATE (b)
+! ps, T, Q :
+DEALLOCATE (ZPSCAM)
+DEALLOCATE (ZTCAM)
+DEALLOCATE (ZQCAM)
+!
+DEALLOCATE (mmr_dust1)
+DEALLOCATE (mmr_dust2)
+DEALLOCATE (mmr_dust3)
+!
+DEALLOCATE (mmr_seasalt1)
+DEALLOCATE (mmr_seasalt2)
+DEALLOCATE (mmr_seasalt3)
+!
+DEALLOCATE (mmr_bc_hydrophilic)
+DEALLOCATE (mmr_bc_hydrophobic)
+!
+DEALLOCATE (mmr_oc_hydrophilic)
+DEALLOCATE (mmr_oc_hydrophobic)
+!
+DEALLOCATE (mmr_sulfaer)
+!
+DEALLOCATE (ZWORK)
+!
+WRITE (ILUOUT0,'(A,A4,A)') ' -- netcdf decoder for ',HFILE,' file ended successfully'
+WRITE (ILUOUT0,'(A,A4,A)') 'MACC mixing ratios are interpolated horizontally'
+!
+!
+CONTAINS
+!
+! #############################
+ SUBROUTINE HANDLE_ERR(STATUS)
+! #############################
+ INTEGER(KIND=CDFINT) STATUS
+ IF (STATUS .NE. NF90_NOERR) THEN
+ PRINT *, NF90_STRERROR(STATUS)
+ STOP 'Stopped'
+ ENDIF
+ END SUBROUTINE HANDLE_ERR
+!
+!
+! #############################################
+ SUBROUTINE ARRAY_1D_TO_2D (KN1,P1,KL1,KL2,P2)
+! #############################################
+!
+! Small routine used to store a linear array into a 2 dimension array
+!
+USE MODE_MSG
+IMPLICIT NONE
+INTEGER, INTENT(IN) :: KN1
+REAL,DIMENSION(KN1), INTENT(IN) :: P1
+INTEGER, INTENT(IN) :: KL1
+INTEGER, INTENT(IN) :: KL2
+REAL,DIMENSION(KL1,KL2),INTENT(OUT) :: P2
+INTEGER :: JLOOP1_A1T2
+INTEGER :: JLOOP2_A1T2
+INTEGER :: JPOS_A1T2
+!
+IF (KN1 < KL1*KL2) THEN
+ CALL PRINT_MSG(NVERB_FATAL,'GEN','ARRAY_1D_TO_2D','sizes do not match')
+END IF
+JPOS_A1T2 = 1
+DO JLOOP2_A1T2 = 1, KL2
+ DO JLOOP1_A1T2 = 1, KL1
+ P2(JLOOP1_A1T2,JLOOP2_A1T2) = P1(JPOS_A1T2)
+ JPOS_A1T2 = JPOS_A1T2 + 1
+ END DO
+END DO
+END SUBROUTINE ARRAY_1D_TO_2D
+!
+END SUBROUTINE READ_LIMA_DATA_NETCDF_CASE
diff --git a/src/MNH/saltcamsn.f90 b/src/MNH/saltcamsn.f90
new file mode 100644
index 000000000..1747bddc7
--- /dev/null
+++ b/src/MNH/saltcamsn.f90
@@ -0,0 +1,281 @@
+!-----------------------------------------------------------------
+!--------------- special set of characters for RCS information
+!-----------------------------------------------------------------
+! $Source: /home/cvsroot/MNH-VX-Y-Z/src/MNH/saltlfin.f90,v $ $Revision: 1.1.2.2.2.1.2.1 $
+! MASDEV4_7 newsrc 2007/01/25 13:13:15
+!-----------------------------------------------------------------
+! ########################
+ MODULE MODI_SALTCAMS_n
+! ########################
+!
+INTERFACE
+!
+SUBROUTINE SALTCAMS_n(PSV,PMASSCAMS,PRHODREF)
+IMPLICIT NONE
+REAL, DIMENSION(:,:,:,:),INTENT(INOUT) :: PSV
+REAL, DIMENSION(:,:,:,:),INTENT(IN) :: PMASSCAMS
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHODREF
+END SUBROUTINE SALTCAMS_n
+!
+END INTERFACE
+!
+END MODULE MODI_SALTCAMS_n
+!
+!
+! ############################################################
+ SUBROUTINE SALTCAMS_n(PSV, PMASSCAMS, PRHODREF)
+! ############################################################
+!
+!! PURPOSE
+!! -------
+!! Initialise le champs de salts à partir des analyses CAMS
+!!
+!! REFERENCE
+!! ---------
+!! none
+!!
+!! AUTHOR
+!! ------
+!! Pierre TULET (LACy)
+!!
+!! MODIFICATIONS
+!! -------------
+!! none
+!!
+!! EXTERNAL
+!! --------
+!! None
+!!
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_SALT
+USE MODD_NSV
+USE MODD_CSTS_SALT
+USE MODE_SALT_PSD
+USE MODI_INIT_SALT
+!
+IMPLICIT NONE
+!
+!* 0.1 declarations of arguments
+!
+REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PSV
+REAL, DIMENSION(:,:,:,:),INTENT(IN) :: PMASSCAMS ! macc salt concentration (kg.kg-1)
+REAL, DIMENSION(:,:,:),INTENT(IN) :: PRHODREF
+!
+!
+!* 0.2 declarations local variables
+!
+REAL :: ZDEN2MOL, ZRHOI, ZMI, ZFAC, ZRGMIN
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZCTOTA
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZM
+REAL,DIMENSION(:,:,:), ALLOCATABLE :: ZSIGMA
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZMASS
+INTEGER,DIMENSION(:), ALLOCATABLE :: IM0, IM3, IM6
+REAL,DIMENSION(:), ALLOCATABLE :: ZMMIN
+REAL,DIMENSION(:), ALLOCATABLE :: ZINIRADIUS, ZINISIGMA
+INTEGER :: IKU, IMOMENTS
+INTEGER :: JJ, JN, JK ! loop counter
+INTEGER :: IMODEIDX ! index mode
+REAL :: ZRHOMIN
+
+REAL :: DELTA_1,DELTA_2,DELTA_3,DELTA_4,DELTA_5,DELTA_6,DELTA_7
+REAL :: RATIO_1,RATIO_2,RATIO_3,RATIO_4,RATIO_5, RATIO_6,RATIO_7
+REAL :: DELTA_CAMS_1,DELTA_CAMS_2,DELTA_CAMS_3
+REAL :: RAY_CAMS_1,RAY_CAMS_2,RAY_CAMS_3,RAY_CAMS_4
+REAL :: RAY_2,RAY_3,RAY_4
+REAL,DIMENSION(:,:,:,:), ALLOCATABLE :: ZMASS_TEST
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. TRANSFER FROM GAS TO AEROSOL MODULE
+! -----------------------------------
+!
+! 1.1 initialisation
+!
+CALL INIT_SALT
+IKU = SIZE(PSV,3)
+ZRHOMIN=MINVAL(PRHODREF)
+!
+ALLOCATE (IM0(NMODE_SLT))
+ALLOCATE (IM3(NMODE_SLT))
+ALLOCATE (IM6(NMODE_SLT))
+ALLOCATE (ZCTOTA(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_SLT))
+ALLOCATE (ZM(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3), NMODE_SLT*3))
+ALLOCATE (ZSIGMA(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3)))
+ALLOCATE (ZINIRADIUS(NMODE_SLT))
+ALLOCATE (ZINISIGMA(NMODE_SLT))
+ALLOCATE (ZMMIN(NMODE_SLT*3))
+ALLOCATE (ZMASS(SIZE(PSV,1), SIZE(PSV,2), SIZE(PSV,3),NMODE_SLT))
+!
+! Rayons des bins CAMS
+
+RAY_CAMS_1 = 0.03
+RAY_CAMS_2 = 0.5
+RAY_CAMS_3 = 5
+RAY_CAMS_4 = 20
+
+! Choix des diametres de separation (selon Ovadnevaite et al., 2014)
+
+RAY_2 = 0.045
+RAY_3 = 0.11
+RAY_4 = 0.41
+
+! Calcul des proportions
+
+! Calcul des écarts bin CAMS
+
+DELTA_CAMS_1 = RAY_CAMS_2 - RAY_CAMS_1
+DELTA_CAMS_2 = RAY_CAMS_3 - RAY_CAMS_2
+DELTA_CAMS_3 = RAY_CAMS_4 - RAY_CAMS_3
+
+! Calcul des ecarts par mode en fonction des rayons de separation
+! puis calcul de la masse correspondante avec facteur correctif pour eviter
+! la surestimation des concentrations en aerosols
+
+DELTA_1 = RAY_2 - RAY_CAMS_1
+RATIO_1 = DELTA_1 / DELTA_CAMS_1
+ZMASS(:,:,:,2) = PMASSCAMS(:,:,:,1) * RATIO_1 ! * 1E-2 ! Attribution Mode 2 ORILAM
+
+DELTA_2 = RAY_3 - RAY_2
+RATIO_2 = DELTA_2 / DELTA_CAMS_1
+ZMASS(:,:,:,3) = PMASSCAMS(:,:,:,1) * RATIO_2 ! * 1E-2 ! Attribution Mode 3 ORILAM
+
+DELTA_3 = RAY_4 - RAY_3
+RATIO_3 = DELTA_3 / DELTA_CAMS_1
+ZMASS(:,:,:,4) = PMASSCAMS(:,:,:,1) * RATIO_3 ! * 1E-1 ! Attribution Mode 4 ORILAM
+
+DELTA_4 = RAY_CAMS_2 - RAY_4
+RATIO_4 = DELTA_4 / DELTA_CAMS_1
+ZMASS(:,:,:,5) = PMASSCAMS(:,:,:,1) * RATIO_4 ! Attribution Mode 5 ORILAM
+
+DELTA_5 = RAY_CAMS_3 - RAY_CAMS_2
+RATIO_5 = DELTA_5 / DELTA_CAMS_2
+ZMASS(:,:,:,5) = (PMASSCAMS(:,:,:,2) * RATIO_5) + ZMASS(:,:,:,5) ! Attribution Mode 5 bis ORILAM
+
+DELTA_6 = 10 - RAY_CAMS_3
+RATIO_6 = DELTA_3 / DELTA_CAMS_1
+ZMASS(:,:,:,5) = (PMASSCAMS(:,:,:,3) * RATIO_6) + ZMASS(:,:,:,5) ! Attribution Mode 5 ter ORILAM
+
+ZMASS(:,:,:,5) = ZMASS(:,:,:,5) * 1E-1
+
+! Hyp : the ultrafine mode is neglected for orilam-lima coupling
+ZMASS(:,:,:,1) = PMASSCAMS(:,:,:,1) * 1E-5 ! ultrafin mode
+!
+!========================================================
+! Adjust the mass / SSA emissions after a few hours
+ZMASS(:,:,:,1) = ZMASS(:,:,:,1) * 1.
+ZMASS(:,:,:,2) = ZMASS(:,:,:,2) * 1.
+ZMASS(:,:,:,3) = ZMASS(:,:,:,3) * 1.
+ZMASS(:,:,:,4) = ZMASS(:,:,:,4) * 1.
+ZMASS(:,:,:,5) = ZMASS(:,:,:,5) * 1.
+!========================================================
+
+DO JN = 1, NMODE_SLT
+ IM0(JN) = 1 + (JN - 1) * 3
+ IM3(JN) = 2 + (JN - 1) * 3
+ IM6(JN) = 3 + (JN - 1) * 3
+ !
+ !Get the salt mode we are talking about, MODE 2 is treated first, then mode 3, then 1
+ !This index is only needed to get the right radius out of the XINIRADIUS array and the
+ !right XINISIG out of the XINISIG-array
+ IMODEIDX = JPSALTORDER(JN)
+ !
+ !Convert initial mass median radius to number median radius
+ IF (CRGUNITS=="MASS") THEN
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX) * EXP(-3.*(LOG(XINISIG_SLT(IMODEIDX)))**2)
+ ELSE
+ ZINIRADIUS(JN) = XINIRADIUS_SLT(IMODEIDX)
+ END IF
+ ZINISIGMA(JN) = XINISIG_SLT(IMODEIDX)
+ !
+ ZMMIN(IM0(JN)) = XN0MIN_SLT(IMODEIDX)
+ ZRGMIN = ZINIRADIUS(JN)
+ ZMMIN(IM3(JN)) = XN0MIN_SLT(IMODEIDX) * (ZRGMIN**3)*EXP(4.5 * LOG(ZINISIGMA(JN))**2)
+ ZMMIN(IM6(JN)) = XN0MIN_SLT(IMODEIDX) * (ZRGMIN**6)*EXP(18. * LOG(ZINISIGMA(JN))**2)
+
+END DO
+
+ZMASS(:,:,:,:) = MAX(ZMASS(:,:,:,:), 1E-40)
+!
+!
+ZRHOI = XDENSITY_SALT
+ZMI = XMOLARWEIGHT_SALT
+ZDEN2MOL = 1E-6 * XAVOGADRO / XMD
+ZFAC = (4. / 3.) * XPI * ZRHOI * 1.e-9
+
+!
+DO JN = 1, NMODE_SLT
+
+!* 1.1 calculate moment 0 from ZMASS
+!
+ ZM(:,:,:,IM0(JN)) = ZMASS(:,:,:,JPSALTORDER(JN)) &![kg_{salt}/kg_{air}
+ / XDENSITY_SALT &![kg__{salt}/m3_{salt}==>m3_{salt}/m3{air}
+ * (6.d0 / XPI) &
+ / (2.d0 * ZINIRADIUS(JN) * 1.d-6)**3 &![particle/m_salt^{-3}]==> particle/m3
+ * EXP(-4.5*(LOG(ZINISIGMA(JN)))**2) !Take into account distribution
+
+ ZM(:,:,:,IM0(JN)) = MAX(ZMMIN(IM0(JN)), ZM(:,:,:,IM0(JN)))
+!
+!* 1.2 calculate moment 3 from m0, RG and SIG
+!
+ ZM(:,:,:,IM3(JN)) = ZM(:,:,:,IM0(JN)) * &
+ (ZINIRADIUS(JN)**3) * &
+ EXP(4.5*LOG(ZINISIGMA(JN))**2)
+
+ ZM(:,:,:,IM3(JN)) = MAX(ZMMIN(IM3(JN)), ZM(:,:,:,IM3(JN)))
+!
+!* 1.3 calculate moment 6 from m0, RG and SIG
+!
+ ZM(:,:,:,IM6(JN))= ZM(:,:,:,IM0(JN)) * ((ZINIRADIUS(JN)**6)*&
+ EXP(18. * (LOG(ZINISIGMA(JN)))**2))
+ ZM(:,:,:,IM6(JN)) = MAX(ZMMIN(IM6(JN)), ZM(:,:,:,IM6(JN)))
+!
+!* 1.4 output concentration (in ppv)
+!
+ IMOMENTS = INT(NSV_SLTEND - NSV_SLTBEG+1) / NMODE_SLT
+ IF (IMOMENTS == 3) THEN
+ PSV(:,:,:,1+(JN-1)*3) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:))
+ XSVMIN(NSV_SLTBEG-1+1+(JN-1)*3) = ZMMIN(IM0(JN)) * XMD / (XAVOGADRO*ZRHOMIN)
+
+ PSV(:,:,:,2+(JN-1)*3) = ZM(:,:,:,IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / &
+ (ZMI*XM3TOUM3_SALT*PRHODREF(:,:,:))
+ XSVMIN(NSV_SLTBEG-1+2+(JN-1)*3) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / &
+ (ZMI*XM3TOUM3_SALT**ZRHOMIN)
+
+ PSV(:,:,:,3+(JN-1)*3) = ZM(:,:,:,IM6(JN)) * XMD / (XAVOGADRO*1.d-6*PRHODREF(:,:,:))
+ XSVMIN(NSV_SLTBEG-1+3+(JN-1)*3) = ZMMIN(IM6(JN)) * XMD / (XAVOGADRO*1.d-6* ZRHOMIN)
+ ELSE IF (IMOMENTS == 2) THEN
+ PSV(:,:,:,1+(JN-1)*2) = ZM(:,:,:,IM0(JN)) * XMD / (XAVOGADRO*PRHODREF(:,:,:))
+ XSVMIN(NSV_SLTBEG-1+1+(JN-1)*2) = ZMMIN(IM0(JN)) * XMD / (XAVOGADRO*ZRHOMIN)
+
+ PSV(:,:,:,2+(JN-1)*2) = ZM(:,:,:,IM3(JN)) * XMD * XPI * 4./3. * ZRHOI / &
+ (ZMI*XM3TOUM3_SALT*PRHODREF(:,:,:))
+ XSVMIN(NSV_SLTBEG-1+2+(JN-1)*2) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / &
+ (ZMI*XM3TOUM3_SALT**ZRHOMIN)
+
+ ELSE
+ PSV(:,:,:,JN) = ZM(:,:,:,IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / &
+ (ZMI * XM3TOUM3_SALT*PRHODREF(:,:,:))
+ XSVMIN(NSV_SLTBEG-1+JN) = ZMMIN(IM3(JN)) * XMD * XPI * 4. / 3. * ZRHOI / &
+ (ZMI*XM3TOUM3_SALT**ZRHOMIN)
+
+ END IF
+END DO
+
+!
+DEALLOCATE(ZMMIN)
+DEALLOCATE(ZINISIGMA)
+DEALLOCATE(ZINIRADIUS)
+DEALLOCATE(ZSIGMA)
+DEALLOCATE(ZM)
+DEALLOCATE(ZCTOTA)
+DEALLOCATE(IM6)
+DEALLOCATE(IM3)
+DEALLOCATE(IM0)
+DEALLOCATE(ZMASS)
+!
+!
+END SUBROUTINE SALTCAMS_n
diff --git a/src/MNH/writesurf_dmsn.F90 b/src/MNH/writesurf_dmsn.F90
new file mode 100644
index 000000000..f3ab4258b
--- /dev/null
+++ b/src/MNH/writesurf_dmsn.F90
@@ -0,0 +1,91 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE WRITESURF_DMS_n(HSELECT, DSF, HPROGRAM)
+! ##########################################
+!
+!!**** *WRITESURF_DMS_n* - routine to write dummy surface fields
+!!
+!! PURPOSE
+!! -------
+!!
+!! AUTHOR
+!! ------
+!! P. Tulet *LAERO*
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 06/2021
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+USE MODD_DMS_SURF_FIELDS_n, ONLY : DMS_SURF_FIELDS_t
+!
+USE MODI_WRITE_SURF
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+ CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
+TYPE(DMS_SURF_FIELDS_t), INTENT(INOUT) :: DSF
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM !
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: JDMS ! loop counter
+CHARACTER(LEN=3) :: YDMS
+!
+CHARACTER(LEN=20) :: YSTRING20 ! string
+CHARACTER(LEN=3 ) :: YSTRING03 ! string
+!
+INTEGER :: IRESP ! IRESP : return-code if a problem appears
+CHARACTER(LEN=LEN_HREC) :: YRECFM ! Name of the article to be read
+CHARACTER(LEN=100):: YCOMMENT ! Comment string
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Number of megan fields :
+! ----------------------
+!
+IF (LHOOK) CALL DR_HOOK('WRITESURF_DMS_N',0,ZHOOK_HANDLE)
+!
+YRECFM='DMS_GR_NBR'
+YCOMMENT=' '
+!
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DSF%NDMS_NBR,IRESP,HCOMMENT=YCOMMENT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. DMS fields :
+! ------------
+!
+DO JDMS=1,DSF%NDMS_NBR
+ !
+ WRITE(YDMS,'(I3.3)') (JDMS)
+ YRECFM='DMS_NB'//ADJUSTL(YDMS(:LEN_TRIM(YDMS)))
+ YSTRING20=DSF%CDMS_NAME(JDMS)
+ YSTRING03=DSF%CDMS_AREA(JDMS)
+ YCOMMENT='X_Y_'//ADJUSTL(YRECFM(:LEN_TRIM(YRECFM)))//'_'//ADJUSTL(YSTRING20(:LEN_TRIM(YSTRING20)))//&
+ '_'//ADJUSTL(YSTRING03(:LEN_TRIM(YSTRING03)))
+ CALL WRITE_SURF(HSELECT,HPROGRAM,YRECFM,DSF%XDMS_FIELDS(:,JDMS),IRESP,HCOMMENT=YCOMMENT)
+ !
+ YRECFM='DMS_NAME'//ADJUSTL(YDMS(:LEN_TRIM(YDMS)))
+ CALL WRITE_SURF(HSELECT, HPROGRAM,YRECFM,DSF%CDMS_NAME(JDMS),IRESP,HCOMMENT=YCOMMENT)
+ !
+ END DO
+IF (LHOOK) CALL DR_HOOK('WRITESURF_DMS_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE WRITESURF_DMS_n
diff --git a/src/SURFEX/pgd_dms.F90 b/src/SURFEX/pgd_dms.F90
new file mode 100644
index 000000000..e9f1dd56d
--- /dev/null
+++ b/src/SURFEX/pgd_dms.F90
@@ -0,0 +1,197 @@
+!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
+!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SFX_LIC for details. version 1.
+! #########
+ SUBROUTINE PGD_DMS(DTCO, UG, U, USS, DSF, HPROGRAM, OCH_DMSEMIS)
+! ##############################################################
+!
+!!**** *PGD_DMS* monitor for averaging and interpolations of physiographic fields
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! P. Tulet *LAERO*
+!!
+!! MODIFICATION
+!! ------------
+!!
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
+USE MODD_SURF_ATM_GRID_n, ONLY : SURF_ATM_GRID_t
+USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
+USE MODD_SSO_n, ONLY : SSO_t
+USE MODD_DMS_SURF_FIELDS_n,ONLY : DMS_SURF_FIELDS_t
+!
+USE MODD_PGD_GRID, ONLY : NL
+USE MODD_PGDWORK, ONLY : CATYPE
+USE MODD_SURF_PAR, ONLY : XUNDEF
+!
+USE MODI_GET_LUOUT
+USE MODI_PGD_FIELD
+USE MODI_READ_NAM_PGD_DMS
+USE MODI_UNPACK_SAME_RANK
+USE MODI_GET_SURF_SIZE_n
+USE MODI_GET_SURF_MASK_n
+!
+USE MODE_POS_SURF
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
+TYPE(SURF_ATM_GRID_t), INTENT(INOUT) :: UG
+TYPE(SURF_ATM_t), INTENT(INOUT) :: U
+TYPE(SSO_t), INTENT(INOUT) :: USS
+TYPE(DMS_SURF_FIELDS_t), INTENT(INOUT) :: DSF
+!
+CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
+LOGICAL, INTENT(OUT) :: OCH_DMSEMIS ! emission flag
+
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: ILUOUT ! output listing logical unit
+INTEGER :: JNBR ! loop counter on dummy fields
+INTEGER :: ILU, IL_SEA, IL_LAND, IL
+!
+!* 0.3 Declaration of namelists
+! ------------------------
+!
+INTEGER :: IDMS_NBR
+CHARACTER(LEN=20), DIMENSION(1000) :: YDMS_NAME
+CHARACTER(LEN=3), DIMENSION(1000) :: YDMS_AREA
+CHARACTER(LEN=3), DIMENSION(1000) :: CDMS_ATYPE ! avg type for dummy pgd fields
+! ! 'ARI' , 'INV'
+CHARACTER(LEN=28), DIMENSION(1000) :: CDMS_FILE ! data files
+CHARACTER(LEN=6), DIMENSION(1000) :: CDMS_FILETYPE ! type of these files
+REAL, DIMENSION(:), ALLOCATABLE :: ZDMS_FIELD, ZDMS_FIELDS
+INTEGER, DIMENSION(:), ALLOCATABLE :: IMASK
+CHARACTER(LEN=6) :: YMASK
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!-------------------------------------------------------------------------------
+!
+!* 1. Initializations of defaults
+! ---------------------------
+!
+IF (LHOOK) CALL DR_HOOK('PGD_DMS',0,ZHOOK_HANDLE)
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Reading of namelist
+! -------------------
+!
+ CALL READ_NAM_PGD_DMS(HPROGRAM, IDMS_NBR, YDMS_NAME, YDMS_AREA, &
+ CDMS_ATYPE, CDMS_FILE, CDMS_FILETYPE )
+!
+DSF%NDMS_NBR = IDMS_NBR
+!
+ALLOCATE(DSF%CDMS_NAME(DSF%NDMS_NBR))
+ALLOCATE(DSF%CDMS_AREA(DSF%NDMS_NBR))
+DSF%CDMS_NAME(:) = YDMS_NAME(1:DSF%NDMS_NBR)
+DSF%CDMS_AREA(:) = YDMS_AREA(1:DSF%NDMS_NBR)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Allocation
+! ----------
+!
+ALLOCATE(DSF%XDMS_FIELDS(NL,DSF%NDMS_NBR))
+ CALL GET_SURF_SIZE_n(DTCO, U,'LAND', IL_LAND)
+ CALL GET_SURF_SIZE_n(DTCO, U,'SEA ',IL_SEA)
+!
+ALLOCATE(ZDMS_FIELDS (NL))
+!
+!-------------------------------------------------------------------------------
+OCH_DMSEMIS = DSF%NDMS_NBR > 0
+!-------------------------------------------------------------------------------
+!
+!
+!* 4. Computations
+! ------------
+!
+DO JNBR=1,DSF%NDMS_NBR
+
+ CATYPE = CDMS_ATYPE(JNBR)
+ SELECT CASE (DSF%CDMS_AREA(JNBR))
+ CASE ('LAN')
+ IL = IL_LAND
+ YMASK='LAND '
+ CASE ('SEA')
+ IL = IL_SEA
+ YMASK='SEA '
+ CASE ('ALL')
+ IL = NL
+ YMASK='FULL '
+ CASE DEFAULT
+ CALL ABOR1_SFX('PGD_DMS (1): DMS AREA NOT SUPPORTED')
+ END SELECT
+ ALLOCATE(ZDMS_FIELD (IL))
+ ALLOCATE(IMASK(IL))
+!
+ CALL PGD_FIELD(DTCO, UG, U, USS, &
+ HPROGRAM,DSF%CDMS_NAME(JNBR),DSF%CDMS_AREA(JNBR),CDMS_FILE(JNBR), &
+ CDMS_FILETYPE(JNBR),XUNDEF,ZDMS_FIELD(:) )
+ CATYPE = 'ARI'
+!
+!* 4.2 Expends field on all surface points
+ ILU=0
+ CALL GET_SURF_MASK_n(DTCO, U, &
+ YMASK,IL,IMASK,ILU,ILUOUT)
+ CALL UNPACK_SAME_RANK(IMASK,ZDMS_FIELD(:),ZDMS_FIELDS(:))
+ DEALLOCATE(ZDMS_FIELD)
+ DEALLOCATE(IMASK)
+!
+!* 4.3 Weights field on all surface points
+! (zero weight where field is not defined)
+ SELECT CASE (DSF%CDMS_AREA(JNBR))
+ CASE ('LAN')
+ DSF%XDMS_FIELDS(:,JNBR) = (U%XNATURE(:)+U%XTOWN(:))*ZDMS_FIELDS(:)
+ CASE ('SEA')
+ DSF%XDMS_FIELDS(:,JNBR) = U%XSEA*ZDMS_FIELDS(:)
+ CASE ('ALL')
+ DSF%XDMS_FIELDS(:,JNBR) = ZDMS_FIELDS(:)
+ CASE DEFAULT
+ CALL ABOR1_SFX('PGD_DMS (2): DMS AREA NOT SUPPORTED')
+ END SELECT
+
+END DO
+
+DEALLOCATE(ZDMS_FIELDS)
+
+IF (LHOOK) CALL DR_HOOK('PGD_DMS',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE PGD_DMS
diff --git a/src/SURFEX/read_nam_pgd_dms.F90 b/src/SURFEX/read_nam_pgd_dms.F90
new file mode 100644
index 000000000..2cccb4f88
--- /dev/null
+++ b/src/SURFEX/read_nam_pgd_dms.F90
@@ -0,0 +1,154 @@
+!SURFEX_LIC Copyright 1994-2014 Meteo-France
+!SURFEX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
+!SURFEX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
+!SURFEX_LIC for details. version 1.
+! #########
+ SUBROUTINE READ_NAM_PGD_DMS(HPROGRAM, KDMS_NBR, HDMS_NAME, HDMS_AREA, &
+ HDMS_ATYPE, HDMS_FILE, HDMS_FILETYPE )
+! ##############################################################
+!
+!!**** *READ_NAM_PGD_DMS* reads namelist NAM_DMS_PGD
+!!
+!! PURPOSE
+!! -------
+!!
+!! METHOD
+!! ------
+!!
+!
+!! EXTERNAL
+!! --------
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!! AUTHOR
+!! ------
+!!
+!! P. Tulet *LAERO*
+!!
+!! MODIFICATION
+!! ------------
+!!
+!! Original 06/2021
+!!
+!----------------------------------------------------------------------------
+!
+!* 0. DECLARATION
+! -----------
+!
+USE MODI_GET_LUOUT
+USE MODI_OPEN_NAMELIST
+USE MODI_CLOSE_NAMELIST
+!
+USE MODE_POS_SURF
+!
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declaration of arguments
+! ------------------------
+!
+ CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! Type of program
+INTEGER, INTENT(OUT) :: KDMS_NBR
+! ! number of megan pgd fields chosen by user
+ CHARACTER(LEN=20), DIMENSION(1000), INTENT(OUT) :: HDMS_NAME
+! ! name of the megan pgd fields (for information)
+ CHARACTER(LEN=3), DIMENSION(1000), INTENT(OUT) :: HDMS_AREA
+! ! areas where megan pgd fields are defined
+! ! 'ALL' : everywhere
+! ! 'SEA' : where sea exists
+! ! 'LAN' : where land exists
+! ! 'WAT' : where inland water exists
+! ! 'NAT' : where natural or agricultural areas exist
+! ! 'TWN' : where town areas exist
+! ! 'STR' : where streets are present
+! ! 'BLD' : where buildings are present
+ CHARACTER(LEN=3), DIMENSION(1000), INTENT(OUT) :: HDMS_ATYPE ! avg type for megan pgd fields
+! ! 'ARI' , 'INV'
+ CHARACTER(LEN=28), DIMENSION(1000), INTENT(OUT) :: HDMS_FILE ! data files
+ CHARACTER(LEN=6), DIMENSION(1000), INTENT(OUT) :: HDMS_FILETYPE ! type of these files
+!
+!
+!* 0.2 Declaration of local variables
+! ------------------------------
+!
+INTEGER :: ILUOUT ! output listing logical unit
+INTEGER :: ILUNAM ! namelist file logical unit
+LOGICAL :: GFOUND ! flag when namelist is present
+!
+!* 0.3 Declaration of namelists
+! ------------------------
+!
+INTEGER :: NDMS_NBR
+! ! number of megan pgd fields chosen by user
+ CHARACTER(LEN=20), DIMENSION(1000) :: CDMS_NAME
+! ! name of the megan pgd fields (for information)
+ CHARACTER(LEN=3), DIMENSION(1000) :: CDMS_AREA
+! ! areas where megan pgd fields are defined
+! ! 'ALL' : everywhere
+! ! 'SEA' : where sea exists
+! ! 'LAN' : where land exists
+! ! 'WAT' : where inland water exists
+! ! 'NAT' : where natural or agricultural areas exist
+! ! 'TWN' : where town areas exist
+! ! 'STR' : where streets are present
+! ! 'BLD' : where buildings are present
+ CHARACTER(LEN=3), DIMENSION(1000) :: CDMS_ATYPE ! avg type for megan pgd fields
+! ! 'ARI' , 'INV'
+ CHARACTER(LEN=28), DIMENSION(1000) :: CDMS_FILE ! data files
+ CHARACTER(LEN=6), DIMENSION(1000) :: CDMS_FILETYPE ! type of these files
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+NAMELIST/NAM_DMS_PGD/ NDMS_NBR, CDMS_NAME, CDMS_AREA, &
+ CDMS_ATYPE, CDMS_FILE, CDMS_FILETYPE
+!-------------------------------------------------------------------------------
+!
+!* 1. Initializations of defaults
+! ---------------------------
+!
+IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_DMS',0,ZHOOK_HANDLE)
+NDMS_NBR = 0
+!
+CDMS_NAME = " "
+CDMS_FILE = " "
+CDMS_FILETYPE = " "
+CDMS_AREA = "ALL"
+CDMS_ATYPE = "ARI"
+!
+ CALL GET_LUOUT(HPROGRAM,ILUOUT)
+!
+!-------------------------------------------------------------------------------
+!
+!* 2. Reading of namelist
+! -------------------
+!
+ CALL OPEN_NAMELIST(HPROGRAM,ILUNAM)
+!
+ CALL POSNAM(ILUNAM,'NAM_DMS_PGD',GFOUND,ILUOUT)
+IF (GFOUND) READ(UNIT=ILUNAM,NML=NAM_DMS_PGD)
+!
+ CALL CLOSE_NAMELIST(HPROGRAM,ILUNAM)
+!
+!-------------------------------------------------------------------------------
+!
+!* 3. Fills output arguments
+! ----------------------
+!
+KDMS_NBR = NDMS_NBR
+HDMS_NAME(:) = CDMS_NAME(:)
+HDMS_AREA(:) = CDMS_AREA(:)
+HDMS_ATYPE(:) = CDMS_ATYPE(:)
+HDMS_FILE(:) = CDMS_FILE(:)
+HDMS_FILETYPE(:) = CDMS_FILETYPE(:)
+IF (LHOOK) CALL DR_HOOK('READ_NAM_PGD_DMS',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE READ_NAM_PGD_DMS
diff --git a/src/SURFEX/update_esm_tebn.F90 b/src/SURFEX/update_esm_tebn.F90
new file mode 100644
index 000000000..5ae13b2a4
--- /dev/null
+++ b/src/SURFEX/update_esm_tebn.F90
@@ -0,0 +1,199 @@
+! #######################################################################################
+ SUBROUTINE UPDATE_ESM_TEB_n(TOP, TPN, NT, NB, GDM, GRM, KI,KSW,PZENITH,PSW_BANDS,&
+ PDIR_ALB,PSCA_ALB,PEMIS,PTSRAD,PTSURF)
+! #######################################################################################
+!
+!!**** *UPDATE_ESM_TEB_n* - routine to update TEB radiative properties in Earth
+!! System Model after the call to OASIS coupler in order
+!! to close the energy budget between radiative scheme and surfex
+!!
+!! PURPOSE
+!! -------
+!!
+!!** METHOD
+!! ------
+!!
+!! EXTERNAL
+!! --------
+!!
+!!
+!! IMPLICIT ARGUMENTS
+!! ------------------
+!!
+!! REFERENCE
+!! ---------
+!!
+!!
+!! AUTHOR
+!! ------
+!! C. Lebeaupin Brossier
+!!
+!! MODIFICATIONS
+!! -------------
+!! Original 01/2015
+!-------------------------------------------------------------------------------
+!
+!* 0. DECLARATIONS
+! ------------
+!
+
+USE MODD_TEB_OPTION_n, ONLY : TEB_OPTIONS_t
+USE MODD_TEB_PANEL_n, ONLY : TEB_PANEL_t
+USE MODD_TEB_n, ONLY : TEB_NP_t
+USE MODD_BEM_n, ONLY : BEM_NP_t
+USE MODD_SURFEX_n, ONLY : TEB_GARDEN_MODEL_t, TEB_GREENROOF_MODEL_t
+
+!
+USE MODD_SURF_PAR, ONLY: XUNDEF
+USE MODD_CSTS, ONLY : XPI
+!
+USE MODI_TEB_VEG_PROPERTIES
+USE MODI_AVERAGED_TSRAD_TEB
+USE MODI_AVERAGED_ALBEDO_TEB
+!
+USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
+USE PARKIND1 ,ONLY : JPRB
+!
+IMPLICIT NONE
+!
+!* 0.1 Declarations of arguments
+! -------------------------
+!
+TYPE(TEB_OPTIONS_t), INTENT(INOUT) :: TOP
+TYPE(TEB_PANEL_t), INTENT(INOUT) :: TPN
+TYPE(TEB_NP_t), INTENT(INOUT) :: NT
+TYPE(BEM_NP_t), INTENT(INOUT) :: NB
+TYPE(TEB_GARDEN_MODEL_t), INTENT(INOUT) :: GDM
+TYPE(TEB_GREENROOF_MODEL_t), INTENT(INOUT) :: GRM
+!
+INTEGER, INTENT(IN) :: KI ! number of points
+INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands
+!
+REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! solar zenithal angle
+REAL, DIMENSION(KSW), INTENT(IN) :: PSW_BANDS ! middle wavelength of each band
+!
+REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PDIR_ALB ! direct albedo for each band
+REAL, DIMENSION(KI,KSW),INTENT(OUT) :: PSCA_ALB ! diffuse albedo for each band
+REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity
+REAL, DIMENSION(KI), INTENT(OUT) :: PTSRAD ! radiative temperature
+REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF ! surface temperature
+REAL(KIND=JPRB) :: ZHOOK_HANDLE
+!
+!
+!* 0.2 Declarations of local variables
+! -------------------------------
+!
+INTEGER :: ILU ! sizes of TEB arrays
+INTEGER :: ISWB ! number of shortwave spectral bands
+INTEGER :: JSWB ! loop on shortwave spectral bands
+!
+REAL, DIMENSION(:), ALLOCATABLE :: ZDIR_ALB ! direct town albedo
+REAL, DIMENSION(:), ALLOCATABLE :: ZSCA_ALB ! diffuse town albedo
+!
+! local variables for urban green areas
+REAL, DIMENSION(KI,KSW) :: ZDIR_ALB_GARDEN ! direct albedo for each band
+REAL, DIMENSION(KI,KSW) :: ZSCA_ALB_GARDEN ! diffuse albedo for each band
+REAL, DIMENSION(KI,KSW) :: ZDIR_SW ! direct SW for each band
+REAL, DIMENSION(KI,KSW) :: ZSCA_SW ! diffuse SW for each band
+REAL, DIMENSION(KI) :: ZEMIS_GARDEN ! emissivity
+REAL, DIMENSION(KI) :: ZALB_GARDEN ! albedo
+REAL, DIMENSION(KI) :: ZTS_GARDEN ! radiative temperature
+!
+REAL, DIMENSION(KI) :: ZEMIS_GREENROOF ! emissivity
+REAL, DIMENSION(KI) :: ZALB_GREENROOF ! albedo
+REAL, DIMENSION(KI) :: ZTS_GREENROOF ! radiative temperature
+!
+REAL, DIMENSION(KI) :: ZAZIM !** strong simplification: to change
+REAL, DIMENSION(KI) :: ZWGT !** weight sum
+!
+INTEGER :: JP
+!
+!-------------------------------------------------------------------------------
+!
+!
+!* 1. Emissivity, radiative temperature and surf temperature
+! ------------------------------------------------------
+!
+IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_TEB_N',0,ZHOOK_HANDLE)
+! *copy from init_tebn *
+ILU = SIZE(TOP%XCOVER,1)
+!
+PTSURF(:)=0.
+ZWGT(:)=0.
+!
+DO JP=1,TOP%NTEB_PATCH
+!
+ IF (TOP%LGARDEN) THEN
+ ZDIR_SW=0. ! night as first guess for albedo computation
+ ZSCA_SW=0. !
+ CALL TEB_VEG_PROPERTIES(NT%AL(JP)%XGARDEN, GDM%O, GDM%NPE%AL(JP), &
+ ZDIR_SW, ZSCA_SW, PSW_BANDS, KSW, &
+ ZTS_GARDEN, ZEMIS_GARDEN, ZALB_GARDEN )
+ ELSE
+ ZALB_GARDEN = XUNDEF
+ ZEMIS_GARDEN= XUNDEF
+ ZTS_GARDEN = XUNDEF
+ END IF
+!
+ IF (TOP%LGREENROOF) THEN
+ ZDIR_SW=0. ! night as first guess for albedo computation
+ ZSCA_SW=0. !
+ CALL TEB_VEG_PROPERTIES(NT%AL(JP)%XGREENROOF, GRM%O, GRM%NPE%AL(JP), &
+ ZDIR_SW, ZSCA_SW, PSW_BANDS, KSW, &
+ ZTS_GREENROOF, ZEMIS_GREENROOF, ZALB_GREENROOF )
+ ELSE
+ ZALB_GREENROOF = XUNDEF
+ ZEMIS_GREENROOF = XUNDEF
+ ZTS_GREENROOF = XUNDEF
+ END IF
+!
+!* averaged emissivity and radiative temperature
+!
+ CALL AVERAGED_TSRAD_TEB(NT%AL(JP), NB%AL(JP), ZEMIS_GARDEN, ZTS_GARDEN, &
+ ZEMIS_GREENROOF, ZTS_GREENROOF, PEMIS, PTSRAD )
+!* averaged surface temperature
+!* - CLB: to verify
+ PTSURF(:)=PTSURF(:)+NT%AL(JP)%XROAD(:)*NT%AL(JP)%XT_ROAD(:,1)+NT%AL(JP)%XBLD(:)*NT%AL(JP)%XT_ROOF(:,1)&
+ +NT%AL(JP)%XWALL_O_HOR(:)*NT%AL(JP)%XT_WALL_A(:,1)
+ ZWGT(:)=ZWGT(:) +NT%AL(JP)%XROAD(:)+NT%AL(JP)%XBLD(:)+NT%AL(JP)%XWALL_O_HOR(:)
+!
+ IF (TOP%LGARDEN) THEN
+ PTSURF(:)=PTSURF(:)+NT%AL(JP)%XGARDEN(:)*ZTS_GARDEN(:)
+ ZWGT(:) = ZWGT(:) + NT%AL(JP)%XGARDEN(:)
+ ENDIF
+ IF (TOP%LGREENROOF) THEN
+ PTSURF(:)=PTSURF(:)+NT%AL(JP)%XGREENROOF(:)*ZTS_GREENROOF(:)
+ ZWGT(:) = ZWGT(:) + NT%AL(JP)%XGREENROOF(:)
+ ENDIF
+!*
+!
+!
+!* 2. Visible and near-infra-red Radiative fields:
+! -------------------------------------------
+!
+ ALLOCATE(ZDIR_ALB(ILU))
+ ALLOCATE(ZSCA_ALB(ILU))
+!
+ ZAZIM=XPI !PAZIM?
+ CALL AVERAGED_ALBEDO_TEB(TOP,NT%AL(JP),TPN,NB%AL(JP),PZENITH,ZAZIM, &
+ ZALB_GARDEN, ZALB_GREENROOF,ZDIR_ALB, ZSCA_ALB)
+!
+ ISWB=SIZE(PSW_BANDS)
+ DO JSWB=1,ISWB
+ PDIR_ALB(:,JSWB) = ZDIR_ALB(:)
+ PSCA_ALB(:,JSWB) = ZSCA_ALB(:)
+ END DO
+!
+ DEALLOCATE(ZDIR_ALB)
+ DEALLOCATE(ZSCA_ALB)
+!
+ENDDO
+!
+! - verif?
+PTSURF(:) = PTSURF(:)/ZWGT(:)
+!
+IF (LHOOK) CALL DR_HOOK('UPDATE_ESM_TEB_N',1,ZHOOK_HANDLE)
+!
+!-------------------------------------------------------------------------------
+!
+END SUBROUTINE UPDATE_ESM_TEB_n
--
GitLab