From 64831ce68d18b7c41411ff31fff02c590390d7d1 Mon Sep 17 00:00:00 2001
From: Gaelle TANGUY <gaelle.tanguy@meteo.fr>
Date: Tue, 8 Nov 2016 15:47:07 +0100
Subject: [PATCH] M.Leriche 11/2016 : Chemistry
---
src/MNH/ch_aqueous_sedimc2r2.f90 | 348 ---------------------------
src/MNH/ch_aqueous_sedimkhko.f90 | 316 ------------------------
src/MNH/modd_ch_const.f90 | 53 ----
src/MNH/modd_ch_depn.f90 | 100 --------
src/SURFEX/readwrite_emis_fieldn.F90 | 190 ---------------
5 files changed, 1007 deletions(-)
delete mode 100644 src/MNH/ch_aqueous_sedimc2r2.f90
delete mode 100644 src/MNH/ch_aqueous_sedimkhko.f90
delete mode 100644 src/MNH/modd_ch_const.f90
delete mode 100644 src/MNH/modd_ch_depn.f90
delete mode 100644 src/SURFEX/readwrite_emis_fieldn.F90
diff --git a/src/MNH/ch_aqueous_sedimc2r2.f90 b/src/MNH/ch_aqueous_sedimc2r2.f90
deleted file mode 100644
index d09c51995..000000000
--- a/src/MNH/ch_aqueous_sedimc2r2.f90
+++ /dev/null
@@ -1,348 +0,0 @@
-!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.
-! ################################
- MODULE MODI_CH_AQUEOUS_SEDIMC2R2
-! ################################
-!
-INTERFACE
- SUBROUTINE CH_AQUEOUS_SEDIMC2R2 (PTIME, PTSTEP, PRTMIN_AQ, PZZ, PRHODREF, &
- PRHODJ, PRRM, PRRS, PCRM, PCRS, PSVT, PRSVS )
-!
-REAL, INTENT(IN) :: PTIME ! Current time
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PRTMIN_AQ ! LWC threshold liq. chem.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRM ! Rain water C at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Precip. aq. species source
-!
-END SUBROUTINE CH_AQUEOUS_SEDIMC2R2
-END INTERFACE
-END MODULE MODI_CH_AQUEOUS_SEDIMC2R2
-!
-! ##############################################################################
- SUBROUTINE CH_AQUEOUS_SEDIMC2R2 (PTIME, PTSTEP, PRTMIN_AQ, PZZ, PRHODREF, &
- PRHODJ, PRRM, PRRS, PCRM, PCRS, PSVT, PRSVS )
-! ##############################################################################
-!
-!!**** * - compute the explicit microphysical sources
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the sedimentation of chemical
-!! species in the raindrops for the C2R2 and C3R5 cloud microphysical schemes.
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process). see rain_c2r2.f90
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!! Module MODD_CONF :
-!! CCONF configuration of the model for the first time step
-!!
-!! REFERENCE
-!! ---------
-!! Book1 of the documentation ( routine CH_AQUEOUS_SEDIMC2R2 )
-!!
-!! AUTHOR
-!! ------
-!! M. Leriche & J.P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 30/10/08
-!! 2014 G.Delautier : remplace MODD_RAIN_C2R2_PARAM par MODD_RAIN_C2R2_KHKO_PARAM
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_RAIN_C2R2_DESCR, ONLY : XCEXVT, XRTMIN, XCTMIN, &
- XLBR, XLBEXR, XDR
-USE MODD_RAIN_C2R2_KHKO_PARAM, ONLY : XFSEDRR, XFSEDCR
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-REAL, INTENT(IN) :: PTIME ! Current time
-REAL, INTENT(IN) :: PTSTEP ! Time step
-REAL, INTENT(IN) :: PRTMIN_AQ ! LWC threshold liq. chem.
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRM ! Rain water m.r. at t-dt
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PCRM ! Rain water C at t-dt
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Precip. aq. species source
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JK,JI,JJ ! Vertical loop index for the rain sedimentation
-INTEGER :: JN ! Temporal loop index for the rain sedimentation
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB !
-INTEGER :: IKE !
-!
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-!
-INTEGER :: ISEDIM ! Case number of sedimentation
-LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: GSEDIM ! where to compute the SED processes
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZRRS ! rain water m.r.source for sedim
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZCRS ! rain water C source for sedim
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRRS ! Rain water m.r. source phys.tendency (*dt)
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZCRS ! Rain water C source phys.tendency
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZWLBDR3, ZWLBDR ! Slope parameter of the raindrops distribution
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZW ! work array
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZWSEDR, ZWSEDC ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRR_SEDIM ! Drain/Dt sur ZTSPLIT
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZCR_SEDIM ! Drain/Dt sur ZTSPLIT
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZSV_SEDIM_FACT ! Cumul des Dsv/DT
-REAL, DIMENSION(:), ALLOCATABLE :: ZZZRRS ! Rain water m.r. source
-REAL, DIMENSION(:), ALLOCATABLE :: ZZZCRS ! Rain water C source
-REAL, DIMENSION(:), ALLOCATABLE :: ZLBDR ! slope parameter
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
- ZZW1, ZZW2, ZZW3 ! Work array
-REAL, SAVE :: ZRTMIN, ZCTMIN
-!
-REAL :: ZVTRMAX, ZDZMIN, ZT
-LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
-INTEGER, SAVE :: ISPLITR
-!
-INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-!-------------------------------------------------------------------------------
-!
-!!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
-! ---------------------------------------
-!
-ZRRS(:,:,:) = PRRS(:,:,:) / PRHODJ(:,:,:)
-ZCRS(:,:,:) = PCRS(:,:,:) / PRHODJ(:,:,:)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-!* 3.1 splitting factor for high Courant number C=v_fall*(del_Z/del_T)
-!
-firstcall : IF (GSFIRSTCALL) THEN
- GSFIRSTCALL = .FALSE.
- ZVTRMAX = 30. !cf. ini_rain_c2r2.f90
- ZDZMIN = MINVAL(PZZ(IIB:IIE,IJB:IJE,IKB+1:IKE+1)-PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
- ISPLITR = 1
- SPLIT : DO
- ZT = PTSTEP / FLOAT(ISPLITR)
- IF ( ZT * ZVTRMAX / ZDZMIN .LT. 1.) EXIT SPLIT
- ISPLITR = ISPLITR + 1
- END DO SPLIT
- ZRTMIN = XRTMIN(3) / PTSTEP
- ZCTMIN = XCTMIN(3) / PTSTEP
-END IF firstcall
-!
-!* 3.2 Compute the slope parameter
-!
- ZWLBDR3(:,:,:) = 1.E30
- ZWLBDR(:,:,:) = 1.E10
-! WHERE (ZRRS(:,:,:)>0.0.AND.ZCRS(:,:,:)>0.0 )
- WHERE ( ZRRS(:,:,:)>ZRTMIN .AND. ZCRS(:,:,:)>ZCTMIN )
- ZWLBDR3(:,:,:) = XLBR * ZCRS(:,:,:) / (PRHODREF(:,:,:) * ZRRS(:,:,:))
- ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
- END WHERE
-!
-!* 3.3 time splitting loop initialization
-!
-ZTSPLITR = PTSTEP / FLOAT(ISPLITR) ! Small time step
-!
-!* 3.4 compute the fluxes
-!
-! optimization by looking for locations where
-! the precipitating fields are larger than a minimal value only !!!
-!
-ZZRRS(:,:,:) = 0.0
-ZZRRS(:,:,:) = ZRRS(:,:,:) - PRRM(:,:,:) / PTSTEP
-ZRRS(:,:,:) = PRRM(:,:,:) / PTSTEP
-ZZCRS(:,:,:) = 0.0
-ZZCRS(:,:,:) = ZCRS(:,:,:) - PCRM(:,:,:) / PTSTEP
-ZCRS(:,:,:) = PCRM(:,:,:) / PTSTEP
-ZSV_SEDIM_FACT(:,:,:) = 1.0
-DO JN = 1 , ISPLITR
-!
- GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZRRS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN
- ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- IF( ISEDIM >= 1 ) THEN
- IF( JN==1 ) THEN
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZZRRS(:,:,:) / ISPLITR
- ZRRS(:,:,:) = ZRRS(:,:,:) * PTSTEP
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZZCRS(:,:,:) / ISPLITR
- ZCRS(:,:,:) = ZCRS(:,:,:) * PTSTEP
- ZW(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZW(:,:,JK) =ZTSPLITR/(PZZ(:,:,JK+1)-PZZ(:,:,JK))
- END DO
- ELSE
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZZRRS(:,:,:) * ZTSPLITR
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZZCRS(:,:,:) * ZTSPLITR
- END IF
- ALLOCATE(ZRHODREF(ISEDIM))
- ALLOCATE(ZZZRRS(ISEDIM))
- ALLOCATE(ZZZCRS(ISEDIM))
- ALLOCATE(ZLBDR(ISEDIM))
- DO JL=1,ISEDIM
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZZRRS(JL) = ZRRS(I1(JL),I2(JL),I3(JL))
- ZZZCRS(JL) = ZCRS(I1(JL),I2(JL),I3(JL))
- ZLBDR(JL) = ZWLBDR(I1(JL),I2(JL),I3(JL))
- ENDDO
- ALLOCATE(ZZW1(ISEDIM)) ; ZZW1(:) = 0.0
- ALLOCATE(ZZW2(ISEDIM)) ; ZZW2(:) = 0.0
- ALLOCATE(ZZW3(ISEDIM)) ; ZZW3(:) = 0.0
-!
-!* for rain
-!
-!microphysical tendency
- WHERE( ZZZRRS(:)>XRTMIN(3) )
- ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * (ZLBDR(:)**(-XDR))
- ZZW1(:) = XFSEDRR * ZZZRRS(:)* ZZW3(:) * ZRHODREF(:)
- ZZW2(:) = XFSEDCR * ZZZCRS(:)* ZZW3(:)
- END WHERE
- ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZWSEDC(:,:,:) = UNPACK( ZZW2(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK)) &
- /PRHODREF(:,:,JK)
- ZCR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSEDC(:,:,JK+1)-ZWSEDC(:,:,JK))
- END DO
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZRR_SEDIM(:,:,:)
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZCR_SEDIM(:,:,:)
-! WHERE (ZRRS(:,:,:)>0.0.AND.ZCRS(:,:,:)>0.0 )
- WHERE (ZRRS(:,:,:)>XRTMIN(3) .AND. ZCRS(:,:,:)>XCTMIN(3) )
- ZWLBDR3(:,:,:) = XLBR * ZCRS(:,:,:) / (PRHODREF(:,:,:) * ZRRS(:,:,:))
- ZWLBDR(:,:,:) = ZWLBDR3(:,:,:)**XLBEXR
- END WHERE
-!
-!chemistry tendency
- ZZW1(:) = 0.
- ZZW3(:) = 0.
- WHERE( (ZZZRRS(:)*ZRHODREF(:)/1.e3) > PRTMIN_AQ )
- ZZW3(:) = ZRHODREF(:)**(-XCEXVT) * (ZLBDR(:)**(-XDR))
- ZZW1(:) = XFSEDRR * ZZW3(:) * ZRHODREF(:)
- END WHERE
- ZWSEDR(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZRR_SEDIM(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSEDR(:,:,JK+1)-ZWSEDR(:,:,JK)) &
- /PRHODREF(:,:,JK)
- END DO
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZZRRS)
- DEALLOCATE(ZZZCRS)
- DEALLOCATE(ZLBDR)
- DEALLOCATE(ZZW1)
- DEALLOCATE(ZZW2)
- DEALLOCATE(ZZW3)
- ZSV_SEDIM_FACT(:,:,:) = ZSV_SEDIM_FACT(:,:,:) * (1.0 + ZRR_SEDIM(:,:,:))
-!! (1.0 + ZRR_SEDIM(:,:,:)/MAX(ZZRRS(:,:,:),PRTMIN_AQ))
- END IF
-END DO
-!
-! Apply the rain sedimentation rate to the WR_xxx aqueous species
-!
-DO JL= 1, SIZE(PRSVS,4)
- PRSVS(:,:,:,JL) = MAX( 0.0,ZSV_SEDIM_FACT(:,:,:)*PRSVS(:,:,:,JL) )
-END DO
-!
-CONTAINS
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: IC
-INTEGER :: JI,JJ,JK
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE CH_AQUEOUS_SEDIMC2R2
diff --git a/src/MNH/ch_aqueous_sedimkhko.f90 b/src/MNH/ch_aqueous_sedimkhko.f90
deleted file mode 100644
index 63f5eacbf..000000000
--- a/src/MNH/ch_aqueous_sedimkhko.f90
+++ /dev/null
@@ -1,316 +0,0 @@
-!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.
-! ################################
- MODULE MODI_CH_AQUEOUS_SEDIMKHKO
-! ################################
-!
-INTERFACE
- SUBROUTINE CH_AQUEOUS_SEDIMKHKO (PTSTEP, PZZ, PRHODREF, PRHODJ, &
- PRRT, PRRS, PCRT, PCRS, PSVT, PRSVS )
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRT ! Rain water C. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Precip. aq. species source
-!
-END SUBROUTINE CH_AQUEOUS_SEDIMKHKO
-END INTERFACE
-END MODULE MODI_CH_AQUEOUS_SEDIMKHKO
-!
-! #############################################################################
- SUBROUTINE CH_AQUEOUS_SEDIMKHKO (PTSTEP, PZZ, PRHODREF, PRHODJ, &
- PRRT, PRRS, PCRT, PCRS, PSVT, PRSVS )
-! #############################################################################
-!
-!!**** * - compute the explicit microphysical sources
-!!
-!! PURPOSE
-!! -------
-!! The purpose of this routine is to compute the sedimentation of chemical
-!! species in the raindrops for the KHKO cloud microphysical schemes.
-!! The sedimentation rates are computed with a time spliting technique:
-!! an upstream scheme, written as a difference of non-advective fluxes.
-!! This source term is added to the next coming time step (split-implicit
-!! process). see rain_khko.f90
-!!
-!!
-!!** METHOD
-!! ------
-!!
-!! EXTERNAL
-!! --------
-!! None
-!!
-!! IMPLICIT ARGUMENTS
-!! ------------------
-!! Module MODD_PARAMETERS
-!! JPHEXT : Horizontal external points number
-!! JPVEXT : Vertical external points number
-!! Module MODD_CONF :
-!! CCONF configuration of the model for the first time step
-!!
-!! REFERENCE
-!! ---------
-!! Book1 of the documentation ( routine CH_AQUEOUS_SEDIMC2R2 )
-!!
-!! AUTHOR
-!! ------
-!! M. Leriche & J.P. Pinty * Laboratoire d'Aerologie*
-!!
-!! MODIFICATIONS
-!! -------------
-!! Original 03/11/08
-!! J.Escobar : 15/09/2015 : WENO5 & JPHEXT <> 1
-!!
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_CST
-USE MODD_PARAMETERS
-USE MODD_CONF
-USE MODD_RAIN_C2R2_DESCR, ONLY : XRTMIN, XCTMIN
-!
-IMPLICIT NONE
-!
-!* 0.1 Declarations of dummy arguments :
-!
-!
-REAL, INTENT(IN) :: PTSTEP ! Time step
-!
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PZZ ! Height (z)
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODREF! Reference density
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRHODJ ! Dry density * Jacobian
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRT ! Rain water m.r. at t
-REAL, DIMENSION(:,:,:), INTENT(IN) :: PRRS ! Rain water m.r. source
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRT ! Rain water C. at t
-REAL, DIMENSION(:,:,:), INTENT(INOUT) :: PCRS ! Rain water C. source
-REAL, DIMENSION(:,:,:,:), INTENT(IN) :: PSVT ! Precip. aq. species at t
-REAL, DIMENSION(:,:,:,:), INTENT(INOUT) :: PRSVS ! Precip. aq. species source
-!
-!* 0.2 Declarations of local variables :
-!
-INTEGER :: JK ! Vertical loop index for the rain sedimentation
-INTEGER :: JN ! Temporal loop index for the rain sedimentation
-INTEGER :: IIB ! Define the domain where is
-INTEGER :: IIE ! the microphysical sources have to be computed
-INTEGER :: IJB !
-INTEGER :: IJE !
-INTEGER :: IKB !
-INTEGER :: IKE !
-!
-REAL :: ZTSPLITR ! Small time step for rain sedimentation
-!
-INTEGER :: ISEDIM ! Case number of sedimentation
-LOGICAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: GSEDIM ! where to compute the SED processes
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZRRS ! rain water m.r.source for sedim
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZZCRS ! rain water C source for sedim
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRRS ! Rain water m.r. source phys.tendency (*dt)
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZCRS ! Rain water C source phys.tendency
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZW ! work array
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZMVRR, ZVRR ! sedimentation velocity for rain
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZWSED ! sedimentation fluxes
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZRR_SEDIM ! Drain/Dt sur ZTSPLIT
-REAL, DIMENSION(SIZE(PZZ,1),SIZE(PZZ,2),SIZE(PZZ,3)) &
- :: ZSV_SEDIM_FACT ! Cumul des Dsv/DT
-REAL, DIMENSION(:), ALLOCATABLE :: ZZZRRS ! Rain water m.r. source
-!
-REAL, DIMENSION(:), ALLOCATABLE :: ZRHODREF, & ! RHO Dry REFerence
- ZZVRR, & ! sedimentation velocity for rain
- ZZW1 ! Work array
-REAL, SAVE :: ZRTMIN, ZCTMIN
-!
-REAL :: ZVTRMAX, ZDZMIN, ZT
-LOGICAL, SAVE :: GSFIRSTCALL = .TRUE.
-INTEGER, SAVE :: ISPLITR
-!
-INTEGER , DIMENSION(SIZE(GSEDIM)) :: I1,I2,I3 ! Used to replace the COUNT
-INTEGER :: JL ! and PACK intrinsics
-!
-!-------------------------------------------------------------------------------
-!
-!* 1. COMPUTE THE LOOP BOUNDS
-! -----------------------
-!
-CALL GET_INDICE_ll (IIB,IJB,IIE,IJE)
-IKB=1+JPVEXT
-IKE=SIZE(PZZ,3) - JPVEXT
-!
-!-------------------------------------------------------------------------------
-!
-!!* 2. TRANSFORMATION INTO PHYSICAL TENDENCIES
-! ---------------------------------------
-!
-ZRRS(:,:,:) = PRRS(:,:,:) / PRHODJ(:,:,:)
-ZCRS(:,:,:) = PCRS(:,:,:) / PRHODJ(:,:,:)
-!
-!-------------------------------------------------------------------------------
-!
-!* 3. COMPUTE THE SEDIMENTATION (RS) SOURCE
-! -------------------------------------
-!
-!* 3.1 splitting factor for high Courant number C=v_fall*(del_Z/del_T)
-!
-firstcall : IF (GSFIRSTCALL) THEN
- GSFIRSTCALL = .FALSE.
- ZVTRMAX = 30. !cf. ini_rain_c2r2.f90
- ZDZMIN = MINVAL(PZZ(IIB:IIE,IJB:IJE,IKB+1:IKE+1)-PZZ(IIB:IIE,IJB:IJE,IKB:IKE))
- ISPLITR = 1
- SPLIT : DO
- ZT = PTSTEP / FLOAT(ISPLITR)
- IF ( ZT * ZVTRMAX / ZDZMIN .LT. 1.) EXIT SPLIT
- ISPLITR = ISPLITR + 1
- END DO SPLIT
- ZRTMIN = XRTMIN(3) / PTSTEP
- ZCTMIN = XCTMIN(3) / PTSTEP
-END IF firstcall
-!
-!* 3.2 compute the sedimentation velocities for rain
-!
-ZMVRR(:,:,:) = 0.
-ZVRR(:,:,:) = 0.
-WHERE (PCRT(:,:,:) > XCTMIN(3) .and. PRRT(:,:,:)>XRTMIN(3) )
- ZMVRR(:,:,:) = ((3. * PRHODREF(:,:,:)*PRRT(:,:,:))/ &
- (4. * XPI *XRHOLW*PCRT(:,:,:)))**0.333 ! in m
- ZVRR(:,:,:) = 0.012 * 1.0E6 * ZMVRR(:,:,:) - 0.2 ! velocity for mixing ratio
-END WHERE
-WHERE (ZVRR(:,:,:) .lt. 0.0)
- ZVRR(:,:,:) = 0.0
-END WHERE
-!
-!* 3.3 time splitting loop initialization
-!
-ZTSPLITR = PTSTEP / FLOAT(ISPLITR) ! Small time step
-!
-!* 3.4 compute the fluxes
-!
-! optimization by looking for locations where
-! the precipitating fields are larger than a minimal value only !!!
-!
-ZZRRS(:,:,:) = 0.0
-ZZRRS(:,:,:) = ZRRS(:,:,:) - PRRT(:,:,:) / PTSTEP
-ZRRS(:,:,:) = PRRT(:,:,:) / PTSTEP
-ZZCRS(:,:,:) = 0.0
-ZZCRS(:,:,:) = ZCRS(:,:,:) - PCRT(:,:,:) / PTSTEP
-ZCRS(:,:,:) = PCRT(:,:,:) / PTSTEP
-ZSV_SEDIM_FACT(:,:,:) = 1.0
-DO JN = 1 , ISPLITR
-!
- GSEDIM(:,:,:) = .FALSE.
- GSEDIM(IIB:IIE,IJB:IJE,IKB:IKE) = ZRRS(IIB:IIE,IJB:IJE,IKB:IKE) > ZRTMIN .AND. &
- ZCRS(IIB:IIE,IJB:IJE,IKB:IKE) > ZCTMIN
- ISEDIM = COUNTJV( GSEDIM(:,:,:),I1(:),I2(:),I3(:))
- IF( ISEDIM >= 1 ) THEN
- IF( JN==1 ) THEN
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZZRRS(:,:,:) / ISPLITR
- ZRRS(:,:,:) = ZRRS(:,:,:) * PTSTEP
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZZCRS(:,:,:) / ISPLITR
- ZCRS(:,:,:) = ZCRS(:,:,:) * PTSTEP
- ZW(:,:,:) = 0.0
- DO JK = IKB , IKE-1
- ZW(:,:,JK) =ZTSPLITR*2./(PRHODREF(:,:,JK)*(PZZ(:,:,JK+2)-PZZ(:,:,JK)))
- END DO
- ZW(:,:,IKE) =ZTSPLITR/(PRHODREF(:,:,IKE)*(PZZ(:,:,IKE+1)-PZZ(:,:,IKE)))
- ELSE
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZZRRS(:,:,:) * ZTSPLITR
- ZCRS(:,:,:) = ZCRS(:,:,:) + ZZCRS(:,:,:) * ZTSPLITR
- END IF
- ALLOCATE(ZRHODREF(ISEDIM))
- ALLOCATE(ZZZRRS(ISEDIM))
- ALLOCATE(ZZVRR(ISEDIM))
- DO JL=1,ISEDIM
- ZRHODREF(JL) = PRHODREF(I1(JL),I2(JL),I3(JL))
- ZZZRRS(JL) = ZRRS(I1(JL),I2(JL),I3(JL))
- ZZVRR(JL) = ZVRR(I1(JL),I2(JL),I3(JL))
- ENDDO
- ALLOCATE(ZZW1(ISEDIM)) ; ZZW1(:) = 0.0
-!
-!* for drizzle
-!
- ZZW1(:) = ZZVRR(:) * ZZZRRS(:) * ZRHODREF(:)
- ZWSED(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
- END DO
- ZRRS(:,:,:) = ZRRS(:,:,:) + ZRR_SEDIM(:,:,:)
-!
- ZZW1(:) = ZZVRR(:) * ZRHODREF(:)
- ZWSED(:,:,:) = UNPACK( ZZW1(:),MASK=GSEDIM(:,:,:),FIELD=0.0 )
- ZRR_SEDIM(:,:,:) = 0.0
- DO JK = IKB , IKE
- ZRR_SEDIM(:,:,JK) = ZW(:,:,JK)*(ZWSED(:,:,JK+1)-ZWSED(:,:,JK))
- END DO
- DEALLOCATE(ZRHODREF)
- DEALLOCATE(ZZZRRS)
- DEALLOCATE(ZZVRR)
- DEALLOCATE(ZZW1)
- ZSV_SEDIM_FACT(:,:,:) = ZSV_SEDIM_FACT(:,:,:) * (1.0 + ZRR_SEDIM(:,:,:))
-!! (1.0 + ZRR_SEDIM(:,:,:)/MAX(ZZRRS(:,:,:),XRTMIN_AQ))
- END IF
-END DO
-!
-! Apply the rain sedimentation rate to the WR_xxx aqueous species
-!
-DO JL= 1, SIZE(PRSVS,4)
- PRSVS(:,:,:,JL) = MAX( 0.0,ZSV_SEDIM_FACT(:,:,:)*PRSVS(:,:,:,JL) )
-END DO
-!
-CONTAINS
-!
-!-------------------------------------------------------------------------------
-!
- FUNCTION COUNTJV(LTAB,I1,I2,I3) RESULT(IC)
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-!* 0.2 declaration of local variables
-!
-!
-LOGICAL, DIMENSION(:,:,:) :: LTAB ! Mask
-INTEGER, DIMENSION(:) :: I1,I2,I3 ! Used to replace the COUNT and PACK
-INTEGER :: IC
-INTEGER :: JI,JJ,JK
-!
-!-------------------------------------------------------------------------------
-!
-IC = 0
-DO JK = 1,SIZE(LTAB,3)
- DO JJ = 1,SIZE(LTAB,2)
- DO JI = 1,SIZE(LTAB,1)
- IF( LTAB(JI,JJ,JK) ) THEN
- IC = IC +1
- I1(IC) = JI
- I2(IC) = JJ
- I3(IC) = JK
- END IF
- END DO
- END DO
-END DO
-!
-END FUNCTION COUNTJV
-!
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE CH_AQUEOUS_SEDIMKHKO
diff --git a/src/MNH/modd_ch_const.f90 b/src/MNH/modd_ch_const.f90
deleted file mode 100644
index 6fdc9bb01..000000000
--- a/src/MNH/modd_ch_const.f90
+++ /dev/null
@@ -1,53 +0,0 @@
-!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$
-! MASDEV4_7 modd 2006/05/18 13:07:25
-!-----------------------------------------------------------------
-! #####################
- MODULE MODD_CH_CONST
-! ######################
-!
-!!
-!! PURPOSE
-!! -------
-!
-!
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!
-!! AUTHOR
-!! ------
-!! P. Tulet (16/01/01) *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!-------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-IMPLICIT NONE
-!
-
-REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XSREALMASSMOLVAL ! final molecular
- ! diffusivity value
-REAL, SAVE, DIMENSION(:), ALLOCATABLE :: XSREALREACTVAL ! final chemical
- ! reactivity factor
- ! with biologie
-REAL, SAVE, DIMENSION(:,:), ALLOCATABLE :: XSREALHENRYVAL ! chemical Henry
- ! constant value
-REAL, SAVE :: XCONVERSION ! emission unit
- ! conversion factor
-!
-END MODULE MODD_CH_CONST
-
-
diff --git a/src/MNH/modd_ch_depn.f90 b/src/MNH/modd_ch_depn.f90
deleted file mode 100644
index c5bcab16e..000000000
--- a/src/MNH/modd_ch_depn.f90
+++ /dev/null
@@ -1,100 +0,0 @@
-!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$
-! MASDEV4_7 modd 2006/06/27 14:05:40
-!-----------------------------------------------------------------
-! #####################
- MODULE MODD_CH_DEP_n
-! ######################
-!
-!!
-!! PURPOSE
-!! -------
-!
-!
-!
-!!
-!!** IMPLICIT ARGUMENTS
-!! ------------------
-!! None
-!!
-!
-!! AUTHOR
-!! ------
-!! P. Tulet *Meteo France*
-!!
-!! MODIFICATIONS
-!! -------------
-!! 16/01/01 (P. Tulet) restructured
-!------------------------------------------------------------------------------
-!
-!* 0. DECLARATIONS
-! ------------
-!
-USE MODD_PARAMETERS, ONLY: JPMODELMAX
-IMPLICIT NONE
-
-TYPE CH_DEP_t
-!
- REAL :: XRCSANDSO2 ! SO2 sand surface resistance
- REAL :: XRCSANDO3 ! O3 sand surface resistance
- REAL :: XRCCLAYSO2 ! SO2 clay surface resistance
- REAL :: XRCCLAYO3 ! O3 clay surface resistance
- REAL :: XRCSNOWSO2 ! SO2 snow surface resistance
- REAL :: XRCSNOWO3 ! O3 snow surface resistance
- REAL :: XLANDREXT ! land type for external leaf resistance
- REAL, DIMENSION(:,:), POINTER :: XDIFFMOLH2O=>NULL() ! H2O molecular diffusivity
-
- REAL, DIMENSION(:,:,:), POINTER :: XHENRYVALCOR=>NULL() ! temperature correction for
- ! chemical Henry constant value
- REAL, DIMENSION(:,:,:), POINTER :: XVDEPT=>NULL() ! final dry deposition velocity at t
-!
-!
-!
-
-
-END TYPE CH_DEP_t
-
-TYPE(CH_DEP_t), DIMENSION(JPMODELMAX), TARGET, SAVE :: CH_DEP_MODEL
-
-REAL, POINTER :: XRCSANDSO2=>NULL()
-REAL, POINTER :: XRCSANDO3=>NULL()
-REAL, POINTER :: XRCCLAYSO2=>NULL()
-REAL, POINTER :: XRCCLAYO3=>NULL()
-REAL, POINTER :: XRCSNOWSO2=>NULL()
-REAL, POINTER :: XRCSNOWO3=>NULL()
-REAL, POINTER :: XLANDREXT=>NULL()
-REAL, DIMENSION(:,:), POINTER :: XDIFFMOLH2O=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XHENRYVALCOR=>NULL()
-REAL, DIMENSION(:,:,:), POINTER :: XVDEPT=>NULL()
-
-CONTAINS
-
-SUBROUTINE CH_DEP_GOTO_MODEL(KFROM, KTO)
-INTEGER, INTENT(IN) :: KFROM, KTO
-!
-! Save current state for allocated arrays
-CH_DEP_MODEL(KFROM)%XDIFFMOLH2O=>XDIFFMOLH2O
-CH_DEP_MODEL(KFROM)%XHENRYVALCOR=>XHENRYVALCOR
-CH_DEP_MODEL(KFROM)%XVDEPT=>XVDEPT
-!
-! Current model is set to model KTO
-XRCSANDSO2=>CH_DEP_MODEL(KTO)%XRCSANDSO2
-XRCSANDO3=>CH_DEP_MODEL(KTO)%XRCSANDO3
-XRCCLAYSO2=>CH_DEP_MODEL(KTO)%XRCCLAYSO2
-XRCCLAYO3=>CH_DEP_MODEL(KTO)%XRCCLAYO3
-XRCSNOWSO2=>CH_DEP_MODEL(KTO)%XRCSNOWSO2
-XRCSNOWO3=>CH_DEP_MODEL(KTO)%XRCSNOWO3
-XLANDREXT=>CH_DEP_MODEL(KTO)%XLANDREXT
-XDIFFMOLH2O=>CH_DEP_MODEL(KTO)%XDIFFMOLH2O
-XHENRYVALCOR=>CH_DEP_MODEL(KTO)%XHENRYVALCOR
-XVDEPT=>CH_DEP_MODEL(KTO)%XVDEPT
-
-END SUBROUTINE CH_DEP_GOTO_MODEL
-
-END MODULE MODD_CH_DEP_n
diff --git a/src/SURFEX/readwrite_emis_fieldn.F90 b/src/SURFEX/readwrite_emis_fieldn.F90
deleted file mode 100644
index 1ed1aab62..000000000
--- a/src/SURFEX/readwrite_emis_fieldn.F90
+++ /dev/null
@@ -1,190 +0,0 @@
-!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 READWRITE_EMIS_FIELD_n ( DTCO, DGU, U, &
- HPROGRAM)
-! #######################################################################
-!
-!-----------------------------------------------------------------------------
-!! MODIFICATIONS
-!! -------------
-!! J.Escobar : 20/04/2016 : Pb IOZ/NETCDF , replace READ/WRITE_SURF by READ/WRITE_SURF_FIELD2D
-!
-!* 0. DECLARATIONS
-!
-!
-!
-USE MODD_DATA_COVER_n, ONLY : DATA_COVER_t
-USE MODD_DIAG_SURF_ATM_n, ONLY : DIAG_SURF_ATM_t
-USE MODD_SURF_ATM_n, ONLY : SURF_ATM_t
-!
-!
-USE MODI_GET_LUOUT
-USE MODI_INIT_IO_SURF_n
-USE MODI_END_IO_SURF_n
-USE MODI_READ_SURF
-USE MODI_WRITE_SURF
-!
-!
-!
-USE YOMHOOK ,ONLY : LHOOK, DR_HOOK
-USE PARKIND1 ,ONLY : JPRB
-!
-USE MODI_ABOR1_SFX
-USE MODI_READ_SURF_FIELD2D
-USE MODI_WRITE_SURF_FIELD2D
-!
-IMPLICIT NONE
-!
-!
-TYPE(DATA_COVER_t), INTENT(INOUT) :: DTCO
-TYPE(DIAG_SURF_ATM_t), INTENT(INOUT) :: DGU
-TYPE(SURF_ATM_t), INTENT(INOUT) :: U
-!
- CHARACTER(LEN=6) :: HPROGRAM
-!
-!* 0.2 declarations of local variables
-!
-INTEGER :: IRESP ! I/O error code
- CHARACTER (LEN=16) :: YRECFM ! article name
- CHARACTER (LEN=100) :: YCOMMENT ! comment
- CHARACTER(LEN=100) :: YCOMMENTUNIT ! Comment string : unit of the datas in the field to write
-INTEGER :: ILUOUT ! Unit number for prints
-INTEGER :: JSPEC ! Loop index for emission species
-INTEGER :: IEMISPEC_NBR ! number of emitted chemical species
- CHARACTER(LEN=40) :: YEMISPEC_NAME ! species name
-INTEGER :: IEMISPEC_NTIMES ! number of emission times
- CHARACTER(LEN=3) :: YSURF ! surface type
-INTEGER,DIMENSION(:),ALLOCATABLE :: ITIMES ! emission times for a species
-REAL, DIMENSION(:,:),ALLOCATABLE :: ZWORK ! work array read in the file
-!
-INTEGER :: IVERSION ! version of surfex file being read
-REAL(KIND=JPRB) :: ZHOOK_HANDLE
-!-------------------------------------------------------------------------------
-!
-IF (LHOOK) CALL DR_HOOK('READWRITE_EMIS_FIELD_N',0,ZHOOK_HANDLE)
- CALL GET_LUOUT(HPROGRAM,ILUOUT)
-!
-!-------------------------------------------------------------------------------
-!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','READ ')
-!* ascendant compatibility
-YRECFM='VERSION'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IVERSION,IRESP)
-!
-YRECFM='EMISFILE_NBR'
-IF (IVERSION<4) YRECFM='EMISFILE_GR_NBR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,YCOMMENT)
- CALL END_IO_SURF_n(HPROGRAM)
-!
-IF (IRESP/=0) THEN
- CALL ABOR1_SFX('READWRITE_EMIS_FIELDN: PROBLEM READING NUMBER OF 2D CHEMICAL EMISSION FIELDS')
-END IF
-!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','WRITE')
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,YCOMMENT)
- CALL END_IO_SURF_n(HPROGRAM)
-!
-!-------------------------------------------------------------------------------
-!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','READ ')
-YRECFM='EMISPEC_NBR'
-IF (IVERSION<4) YRECFM='EMISPEC_GR_NBR'
- CALL READ_SURF(&
- HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,YCOMMENT)
- CALL END_IO_SURF_n(HPROGRAM)
-!
-IF (IRESP/=0) THEN
- CALL ABOR1_SFX('READWRITE_EMIS_FIELDN: PROBLEM READING NUMBER OF EMITTED CHEMICAL SPECIES')
-END IF
-!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','WRITE')
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,IEMISPEC_NBR,IRESP,YCOMMENT)
- CALL END_IO_SURF_n(HPROGRAM)
-!
-!-------------------------------------------------------------------------------
-!
-DO JSPEC=1,IEMISPEC_NBR
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','READ ')
- WRITE(YRECFM,'("EMISNAME",I3.3)') JSPEC
- CALL READ_SURF(&
- HPROGRAM,YRECFM,YEMISPEC_NAME,IRESP,YCOMMENT)
- CALL END_IO_SURF_n(HPROGRAM)
-!
- IF (IRESP/=0) THEN
- CALL ABOR1_SFX('READWRITE_EMIS_FIELDN: PROBLEM WHEN READING THE NAME OF EMITTED CHEMICAL SPECIES '//YRECFM)
- END IF
- READ(YCOMMENT,'(A3,24x,I5)') YSURF, IEMISPEC_NTIMES
- !
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','WRITE')
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,YEMISPEC_NAME,IRESP,YCOMMENT)
- CALL END_IO_SURF_n(HPROGRAM)
-!
-!-------------------------------------------------------------------------------
-!
- ALLOCATE(ITIMES(IEMISPEC_NTIMES))
- ALLOCATE(ZWORK(U%NSIZE_FULL,IEMISPEC_NTIMES))
-!
-!-------------------------------------------------------------------------------
-!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','READ ')
- YRECFM='E_'//TRIM(YEMISPEC_NAME)
- CALL READ_SURF_FIELD2D(&
- HPROGRAM,ZWORK,YRECFM,HCOMMENT=YCOMMENT,KRESP=IRESP)
- CALL END_IO_SURF_n(HPROGRAM)
- !
- IF (IRESP/=0) THEN
- CALL ABOR1_SFX('READWRITE_EMIS_FIELDN: PROBLEM WHEN READING THE EMISSION DATA '//YRECFM)
- END IF
- !
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','WRITE')
- YCOMMENTUNIT=''
- CALL WRITE_SURF_FIELD2D(DGU, U, &
- HPROGRAM,ZWORK,YRECFM,YCOMMENT,YCOMMENTUNIT)
- CALL END_IO_SURF_n(HPROGRAM)
-!
-!-------------------------------------------------------------------------------
-!
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','READ ')
- WRITE(YRECFM,'("EMISTIMES",I3.3)') JSPEC
- CALL READ_SURF(&
- HPROGRAM,YRECFM,ITIMES,IRESP,YCOMMENT,'-')
- CALL END_IO_SURF_n(HPROGRAM)
-
- IF (IRESP/=0) THEN
- CALL ABOR1_SFX('READWRITE_EMIS_FIELDN: PROBLEM WHEN READING THE EMISSION TIMES '//YRECFM)
- END IF
-
- CALL INIT_IO_SURF_n(DTCO, DGU, U, &
- HPROGRAM,'FULL ','SURF ','WRITE')
- CALL WRITE_SURF(DGU, U, &
- HPROGRAM,YRECFM,ITIMES,IRESP,YCOMMENT,'-')
- CALL END_IO_SURF_n(HPROGRAM)
-!
-!-------------------------------------------------------------------------------
-!
- DEALLOCATE(ITIMES)
- DEALLOCATE(ZWORK)
-!
-!-------------------------------------------------------------------------------
-END DO
-IF (LHOOK) CALL DR_HOOK('READWRITE_EMIS_FIELD_N',1,ZHOOK_HANDLE)
-!-------------------------------------------------------------------------------
-!
-END SUBROUTINE READWRITE_EMIS_FIELD_n
--
GitLab