Skip to content
Snippets Groups Projects
Commit 64831ce6 authored by Gaelle TANGUY's avatar Gaelle TANGUY
Browse files

M.Leriche 11/2016 : Chemistry

parent ea5c67b5
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/ch_aqueous_sedimc2r2.f90 deleted 100644 → 0
+ 0
− 348
View file @ ea5c67b5
!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
src/MNH/ch_aqueous_sedimkhko.f90 deleted 100644 → 0
+ 0
− 316
View file @ ea5c67b5
!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
src/MNH/modd_ch_const.f90 deleted 100644 → 0
+ 0
− 53
View file @ ea5c67b5
!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
src/MNH/modd_ch_depn.f90 deleted 100644 → 0
+ 0
− 100
View file @ ea5c67b5
!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
src/SURFEX/readwrite_emis_fieldn.F90 deleted 100644 → 0
+ 0
− 190
View file @ ea5c67b5
!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
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment

Documentation | Mentions légales | CGU | Accessibilité : non conforme