Skip to content
Snippets Groups Projects
Commit 1603c5f5 authored by RODIER Quentin's avatar RODIER Quentin
Browse files

Merge commit '0ae538e2' into QR_MNH

parents a3af077d 0ae538e2
No related branches found
No related tags found
No related merge requests found
Showing
with 31 additions and 740 deletions
SUBROUTINE MASK_COMPRESS
END SUBROUTINE MASK_COMPRESS
......@@ -76,3 +76,8 @@ phyex/micro/modi_rzcolx.F90
phyex/micro/rrcolss.F90
phyex/micro/rscolrg.F90
phyex/micro/rzcolx.F90
mpa/dummy/mask_compress.F90
phyex/micro/cart_compress.F90
phyex/micro/modi_add_bounds.F90
phyex/micro/modi_cart_compress.F90
phyex/micro/modi_mask_compress.F90
! ######spl
FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS)
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
! ###############################################
!
!!**** *CART_COMPRESS* - function to compress the Source in CART case.
!!
!!
!! PURPOSE
!! -------
! This function compresses or not the Source XVARS of the VARiable
! VAR whose budget is analysed. This compression is controlled by 3
! logical switches for the budget in I,J and K directions (LBU_ICP,
! LBU_JCP, LBU_KCP), in the budget box described by the lowest and
! highest values of the I,J and K indices.
!
!!** METHOD
!! ------
!! The source PVARS is first transfered in a local array whose
!! dimensions correspond to the budget box. Then compressions
!! are or aren't achieved depending on the logical switches.
!!
!! EXTERNAL
!! --------
!! NONE
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_BUDGET
!! LBU_ICP : switch for compression in I direction
!! LBU_JCP : switch for compression in J direction
!! LBU_KCP : switch for compression in K direction
!! NBUIL : lowest I indice value of the budget box
!! NBUJL : lowest J indice value of the budget box
!! NBUKL : lowest K indice value of the budget box
!! NBUIH : highest I indice value of the budget box
!! NBUJH : highest J indice value of the budget box
!! NBUKH : highest K indice value of the budget box
!! NBUIMAX : dimension along I of the budget tabular
!! NBUJMAX : dimension along J of the budget tabular
!! NBUKMAX : dimension along K of the budget tabular
!!
!!
!!
!! REFERENCE
!! ---------
!! Book2 of MESO-NH documentation (function CART_COMPRESS)
!!
!!
!! AUTHOR
!! ------
!! J. Nicolau * Meteo France *
!!
!! MODIFICATIONS
!! -------------
!! Original 27/02/95
!! JP Pinty & J Escobar 12/10/98 Enable vectorization and remove
!! SUM functions
!! V. Ducrocq 4/06/99 //
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_BUDGET
!
!
IMPLICIT NONE
!
!
!* 0.1 Declarations of arguments and result :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result
!
!* 0.2 Declarations of local variables :
!
!
REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZVARS ! 3D Work
! array
REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUKH-NBUKL+1) :: ZWORKIK ! 2D Work array
REAL, DIMENSION (NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZWORKJK ! 2D Work array
REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1) :: ZWORKIJ ! 2D Work array
!
INTEGER :: JJ,JK ! loop indexes
!
!
!-------------------------------------------------------------------------------
!
!* 1. SOURCE TRANSFERT IN A LOCAL ARRAY
! ---------------------------------
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!JUAN
IF (SIZE (PCOMPRESS) .EQ. 0 ) RETURN
!JUAN
!
IF (LHOOK) CALL DR_HOOK('CART_COMPRESS',0,ZHOOK_HANDLE)
ZVARS(1:NBUSIH-NBUSIL+1,1:NBUSJH-NBUSJL+1,1:NBUKH-NBUKL+1) = &
PVARS(NBUSIL:NBUSIH,NBUSJL:NBUSJH,NBUKL:NBUKH)
!
!-------------------------------------------------------------------------------
!
!* 2. COMPRESSIONS IN I,J AND K DIRECTIONS
! ------------------------------------
!
!
IF (LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN
PCOMPRESS(1,1,1)=SUM(ZVARS)
!
ELSE IF (LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN
ZWORKJK(:,:) =SUM(ZVARS,1)
PCOMPRESS(1,1,:)=SUM(ZWORKJK,1)
!
ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN
ZWORKIJ(:,:)=0.0
DO JK = 1,NBUKH-NBUKL+1
ZWORKIJ(:,:) = ZWORKIJ(:,:) + ZVARS(:,:,JK)
END DO
PCOMPRESS(1,:,1)=SUM(ZWORKIJ,1)
!
ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN
ZWORKIK(:,:)=0.0
DO JJ = 1,NBUSJH-NBUSJL+1
ZWORKIK(:,:) = ZWORKIK(:,:) + ZVARS(:,JJ,:)
END DO
PCOMPRESS(:,1,1)=SUM(ZWORKIK,2)
!
ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND..NOT.LBU_KCP) THEN
PCOMPRESS(1,:,:)=SUM(ZVARS,1)
!
ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN
PCOMPRESS(:,1,:)=SUM(ZVARS,2)
!
ELSE IF (.NOT.LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN
PCOMPRESS(:,:,1)=SUM(ZVARS,3)
!
ELSE
PCOMPRESS=ZVARS
!
END IF
!
!
IF (LHOOK) CALL DR_HOOK('CART_COMPRESS',1,ZHOOK_HANDLE)
END FUNCTION CART_COMPRESS
! ######spl
MODULE MODD_NEB
! #############################
!
!!**** *MODD_NEB* - Declaration of nebulosity constants
!!
!! PURPOSE
!! -------
!! The purpose of this declarative module is to declare some
!! constants for nebulosity calculation
!
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
!! None
!!
!! REFERENCE
!! ---------
!!
!!
!! AUTHOR
!! ------
!! S. Riette (Meteo France)
!!
!! MODIFICATIONS
!! -------------
!! Original 24 Aug 2011
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
IMPLICIT NONE
!
REAL,SAVE :: XTMINMIX ! minimum temperature of mixed phase
REAL,SAVE :: XTMAXMIX ! maximum temperature of mixed phase
!
!
END MODULE MODD_NEB
! ######spl
MODULE MODD_RAIN_ICE_PARAM
! ##########################
!
!!**** *MODD_RAIN_ICE_PARAM* - declaration of some microphysical factors
!! extensively used in the warm and cold schemes.
!!
!! PURPOSE
!! -------
! The purpose of this declarative module is to declare some precomputed
! microphysical paramters directly used in routine RAIN_ICE.
!
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
!! None
!!
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (MODD_RAIN_ICE_PARAM)
!!
!! AUTHOR
!! ------
!! J.-P. Pinty *Laboratoire d'Aerologie*
!!
!! MODIFICATIONS
!! -------------
!! Original 04/12/95
!! J.-P. Pinty 29/11/02 add ICE4
!! S. Riette 11/2016: new ICE3/ICE4 processes
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
IMPLICIT NONE
!
REAL,DIMENSION(2),SAVE :: XFSEDC ! Constants for sedimentation fluxes of C
REAL,SAVE :: XFSEDR,XEXSEDR, & ! Constants for sedimentation
XFSEDI,XEXCSEDI,XEXRSEDI, & ! fluxes of R, I, S and G
XFSEDS,XEXSEDS, &
XFSEDG,XEXSEDG
!
REAL,SAVE :: XNU10,XALPHA1,XBETA1, & ! Constants for heterogeneous
XNU20,XALPHA2,XBETA2, & ! ice nucleation : HEN
XMNU0 ! mass of nucleated ice crystal
!
REAL,SAVE :: XALPHA3,XBETA3, & ! Constants for homogeneous
XHON ! ice nucleation : HON
!
REAL,SAVE :: XSCFAC, & ! Constants for raindrop
X0EVAR,X1EVAR,XEX0EVAR,XEX1EVAR, & ! evaporation: EVA and for
X0DEPI,X2DEPI, & ! deposition : DEP on I,
X0DEPS,X1DEPS,XEX0DEPS,XEX1DEPS, & ! on S and
X0DEPG,X1DEPG,XEX0DEPG,XEX1DEPG ! on G
!
REAL,SAVE :: XTIMAUTI,XTEXAUTI,XCRIAUTI, & ! Constants for pristine ice
XT0CRIAUTI,XACRIAUTI,XBCRIAUTI ! autoconversion : AUT
!
REAL,SAVE :: XCOLIS,XCOLEXIS, & ! Constants for snow
XFIAGGS, & ! aggregation : AGG
XEXIAGGS
!
REAL,SAVE :: XTIMAUTC, & ! Constants for cloud droplet
XCRIAUTC ! autoconversion : AUT
!
REAL,SAVE :: XFCACCR, & ! Constants for cloud droplet
XEXCACCR ! accretion on raindrops : ACC
!
REAL,SAVE :: XDCSLIM,XCOLCS, & ! Constants for the riming of
XEXCRIMSS,XCRIMSS, & ! the aggregates : RIM
XEXCRIMSG,XCRIMSG, & !
XEXSRIMCG,XSRIMCG, & !
XEXSRIMCG2,XSRIMCG2, & !
XSRIMCG3, & !
XGAMINC_BOUND_MIN, & ! Min val. of Lbda_s for RIM
XGAMINC_BOUND_MAX, & ! Max val. of Lbda_s for RIM
XRIMINTP1,XRIMINTP2 ! Csts for lin. interpol. of
! the tab. incomplete Gamma law
INTEGER,SAVE :: NGAMINC ! Number of tab. Lbda_s
REAL, DIMENSION(:), SAVE, ALLOCATABLE &
:: XGAMINC_RIM1, & ! Tab. incomplete Gamma funct.
XGAMINC_RIM2, & ! for XDS+2 and for XBS
XGAMINC_RIM4 ! and for 2+XDS+XBS-XBG
!
REAL,SAVE :: XFRACCSS, & ! Constants for the accretion
XLBRACCS1,XLBRACCS2,XLBRACCS3, & ! raindrops onto the aggregates
XFSACCRG, & ! ACC (processes RACCSS and
XLBSACCR1,XLBSACCR2,XLBSACCR3, & ! SACCRG)
XACCLBDAS_MIN, & ! Min val. of Lbda_s for ACC
XACCLBDAS_MAX, & ! Max val. of Lbda_s for ACC
XACCLBDAR_MIN, & ! Min val. of Lbda_r for ACC
XACCLBDAR_MAX, & ! Max val. of Lbda_r for ACC
XACCINTP1S,XACCINTP2S, & ! Csts for bilin. interpol. of
XACCINTP1R,XACCINTP2R ! Lbda_s and Lbda_r in the
! XKER_RACCSS and XKER_SACCRG
! tables
INTEGER,SAVE :: NACCLBDAS, & ! Number of Lbda_s values and
NACCLBDAR ! of Lbda_r values in the
! XKER_RACCSS and XKER_SACCRG
! tables
REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
:: XKER_RACCSS, & ! Normalized kernel for RACCSS
XKER_RACCS, & ! Normalized kernel for RACCS
XKER_SACCRG ! Normalized kernel for SACCRG
REAL,SAVE :: XFSCVMG ! Melting-conversion factor of
! the aggregates
!
REAL,SAVE :: XCOLIR, & ! Constants for rain contact
XEXRCFRI,XRCFRI, & ! freezing : CFR
XEXICFRR,XICFRR !
!
REAL,SAVE :: XFCDRYG, & ! Constants for the dry growth
XCOLIG,XCOLEXIG,XFIDRYG, & ! of the graupeln : DRY
XFIDRYG2, XEXFIDRYG, &
XCOLSG,XCOLEXSG,XFSDRYG, & ! processes RCDRYG
XLBSDRYG1,XLBSDRYG2,XLBSDRYG3, & ! RIDRYG
XFRDRYG, & ! RSDRYG
XLBRDRYG1,XLBRDRYG2,XLBRDRYG3, & ! RRDRYG
XDRYLBDAR_MIN, & ! Min val. of Lbda_r for DRY
XDRYLBDAR_MAX, & ! Max val. of Lbda_r for DRY
XDRYLBDAS_MIN, & ! Min val. of Lbda_s for DRY
XDRYLBDAS_MAX, & ! Max val. of Lbda_s for DRY
XDRYLBDAG_MIN, & ! Min val. of Lbda_g for DRY
XDRYLBDAG_MAX, & ! Max val. of Lbda_g for DRY
XDRYINTP1R,XDRYINTP2R, & ! Csts for bilin. interpol. of
XDRYINTP1S,XDRYINTP2S, & ! Lbda_r, Lbda_s and Lbda_g in
XDRYINTP1G,XDRYINTP2G ! the XKER_SDRYG and XKER_RDRYG
! tables
INTEGER,SAVE :: NDRYLBDAR, & ! Number of Lbda_r,
NDRYLBDAS, & ! of Lbda_s and
NDRYLBDAG ! of Lbda_g values in
! the XKER_SDRYG and XKER_RDRYG
! tables
REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
:: XKER_SDRYG, & ! Normalized kernel for SDRYG
XKER_RDRYG ! Normalized kernel for RDRYG
!
! addition of Hail category
!
REAL,SAVE :: XFSEDH,XEXSEDH ! Constants for sedimentation
!
!
REAL,SAVE :: X0DEPH,X1DEPH,XEX0DEPH,XEX1DEPH ! Constants for deposition
!
REAL,SAVE :: XCOLIH, XCOLEXIH, & ! Constants for the dry growth
& XCOLSH, XCOLEXSH, & ! of the hail
& XCOLGH, XCOLEXGH !
!
REAL,SAVE :: XFWETH,XFSWETH, & ! Constants for the wet growth
XLBSWETH1,XLBSWETH2,XLBSWETH3, & ! of the hailstones : WET
XFGWETH, & ! processes RSWETH
XLBGWETH1,XLBGWETH2,XLBGWETH3, & ! RGWETH
XFRWETH, & ! RRWETH
XLBRWETH1,XLBRWETH2,XLBRWETH3, & !
XWETLBDAS_MIN, & ! Min val. of Lbda_s for WET
XWETLBDAS_MAX, & ! Max val. of Lbda_s for WET
XWETLBDAG_MIN, & ! Min val. of Lbda_g for WET
XWETLBDAG_MAX, & ! Max val. of Lbda_g for WET
XWETLBDAR_MIN, & ! Min val. of Lbda_r for WET
XWETLBDAR_MAX, & ! Max val. of Lbda_r for WET
XWETLBDAH_MIN, & ! Min val. of Lbda_h for WET
XWETLBDAH_MAX, & ! Max val. of Lbda_h for WET
XWETINTP1S,XWETINTP2S, & ! Csts for bilin. interpol. of
XWETINTP1G,XWETINTP2G, & ! Lbda_r, Lbda_s, Lbda_g
XWETINTP1R,XWETINTP2R, & ! and Lbda_h in
XWETINTP1H,XWETINTP2H ! the XKER_SWETH, XKER_GWETH
! and XKER_RWETH tables
INTEGER,SAVE :: NWETLBDAS, & ! Number of Lbda_s,
NWETLBDAG, & ! of Lbda_g,
NWETLBDAR, & ! of Lbda_r and
NWETLBDAH ! of Lbda_h values in
! the XKER_SWETH, XKER_GWETH
! and XKER_RWETH tables
REAL,DIMENSION(:,:), SAVE, ALLOCATABLE &
:: XKER_SWETH, & ! Normalized kernel for SWETH
XKER_GWETH, & ! Normalized kernel for GWETH
XKER_RWETH ! Normalized kernel for RWETH
!
END MODULE MODD_RAIN_ICE_PARAM
MODULE MODI_ADD_BOUNDS
! dead code
END MODULE MODI_ADD_BOUNDS
! ######spl
MODULE MODI_CART_COMPRESS
!#########################
!
INTERFACE
!
FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS)
!
USE MODD_BUDGET
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result
!
END FUNCTION CART_COMPRESS
!
END INTERFACE
!
END MODULE MODI_CART_COMPRESS
! ######spl
MODULE MODI_MASK_COMPRESS
!#########################
!
INTERFACE
!
FUNCTION MASK_COMPRESS(PVARS) RESULT(PCOMPRESS)
!
USE MODD_BUDGET
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
REAL, DIMENSION(NBUKMAX,NBUMASK) :: PCOMPRESS ! result
!
END FUNCTION MASK_COMPRESS
!
END INTERFACE
!
END MODULE MODI_MASK_COMPRESS
!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.
! ######spl
SUBROUTINE INI_NEB
! #######################
......
File moved
! ######spl
!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 MODD_RAIN_ICE_DESCR
! ##########################
!
......@@ -41,6 +45,7 @@
!! -------------
!! Original 04/12/95
!! J.-P. Pinty 29/11/02 add ICE4
!! C. LAC 26/01/2012 : suppression de XCONC qui n'était pas utilisé
!!
!-------------------------------------------------------------------------------
!
......@@ -69,7 +74,6 @@ REAL,SAVE :: XLBDAR_MAX,XLBDAS_MAX,XLBDAG_MAX ! Max values allowed for the shape
! parameters (rain,snow,graupeln)
!
REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN ! Min values allowed for the mixing ratios
REAL,DIMENSION(:,:,:), SAVE, ALLOCATABLE :: XCONC ! Concentration of cloud droplet
REAL,SAVE :: XCONC_SEA ! Diagnostic concentration of droplets over sea
REAL,SAVE :: XCONC_LAND ! Diagnostic concentration of droplets over land
REAL,SAVE :: XCONC_URBAN ! Diagnostic concentration of droplets over urban area
......
!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.
! ######spl
MODULE MODI_INI_NEB
! #####################
......
!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 BUG2 2007/06/29 16:52:14
!-----------------------------------------------------------------
!#########################
MODULE MODI_CART_COMPRESS
!#########################
!
INTERFACE
!
FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS)
!
USE MODD_BUDGET
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result
!
END FUNCTION CART_COMPRESS
!
END INTERFACE
!
END MODULE MODI_CART_COMPRESS
! ###############################################
FUNCTION CART_COMPRESS(PVARS) RESULT(PCOMPRESS)
! ###############################################
!
!!**** *CART_COMPRESS* - function to compress the Source in CART case.
!!
!!
!! PURPOSE
!! -------
! This function compresses or not the Source XVARS of the VARiable
! VAR whose budget is analysed. This compression is controlled by 3
! logical switches for the budget in I,J and K directions (LBU_ICP,
! LBU_JCP, LBU_KCP), in the budget box described by the lowest and
! highest values of the I,J and K indices.
!
!!** METHOD
!! ------
!! The source PVARS is first transfered in a local array whose
!! dimensions correspond to the budget box. Then compressions
!! are or aren't achieved depending on the logical switches.
!!
!! EXTERNAL
!! --------
!! NONE
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_BUDGET
!! LBU_ICP : switch for compression in I direction
!! LBU_JCP : switch for compression in J direction
!! LBU_KCP : switch for compression in K direction
!! NBUIL : lowest I indice value of the budget box
!! NBUJL : lowest J indice value of the budget box
!! NBUKL : lowest K indice value of the budget box
!! NBUIH : highest I indice value of the budget box
!! NBUJH : highest J indice value of the budget box
!! NBUKH : highest K indice value of the budget box
!! NBUIMAX : dimension along I of the budget tabular
!! NBUJMAX : dimension along J of the budget tabular
!! NBUKMAX : dimension along K of the budget tabular
!!
!!
!!
!! REFERENCE
!! ---------
!! Book2 of MESO-NH documentation (function CART_COMPRESS)
!!
!!
!! AUTHOR
!! ------
!! J. Nicolau * Meteo France *
!!
!! MODIFICATIONS
!! -------------
!! Original 27/02/95
!! JP Pinty & J Escobar 12/10/98 Enable vectorization and remove
!! SUM functions
!! V. Ducrocq 4/06/99 //
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_BUDGET
USE MODD_PARAMETERS , ONLY : JPVEXT
!
!
IMPLICIT NONE
!
!
!* 0.1 Declarations of arguments and result :
!
REAL, DIMENSION(:,:,:), INTENT(IN) :: PVARS ! Source
REAL, DIMENSION(NBUIMAX,NBUJMAX,NBUKMAX) :: PCOMPRESS ! result
!
!* 0.2 Declarations of local variables :
!
!
REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZVARS ! 3D Work
! array
REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUKH-NBUKL+1) :: ZWORKIK ! 2D Work array
REAL, DIMENSION (NBUSJH-NBUSJL+1,NBUKH-NBUKL+1) :: ZWORKJK ! 2D Work array
REAL, DIMENSION (NBUSIH-NBUSIL+1,NBUSJH-NBUSJL+1) :: ZWORKIJ ! 2D Work array
!
INTEGER :: JJ,JK ! loop indexes
!
!
!-------------------------------------------------------------------------------
!
!* 1. SOURCE TRANSFERT IN A LOCAL ARRAY
! ---------------------------------
!JUAN
IF (SIZE (PCOMPRESS) .EQ. 0 ) RETURN
!JUAN
!
ZVARS(1:NBUSIH-NBUSIL+1,1:NBUSJH-NBUSJL+1,1:NBUKH-NBUKL+1) = &
PVARS(NBUSIL:NBUSIH,NBUSJL:NBUSJH,NBUKL+JPVEXT:NBUKH+JPVEXT)
!
!-------------------------------------------------------------------------------
!
!* 2. COMPRESSIONS IN I,J AND K DIRECTIONS
! ------------------------------------
!
!
IF (LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN
PCOMPRESS(1,1,1)=SUM(ZVARS)
!
ELSE IF (LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN
ZWORKJK(:,:) =SUM(ZVARS,1)
PCOMPRESS(1,1,:)=SUM(ZWORKJK,1)
!
ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN
ZWORKIJ(:,:)=0.0
DO JK = 1,NBUKH-NBUKL+1
ZWORKIJ(:,:) = ZWORKIJ(:,:) + ZVARS(:,:,JK)
END DO
PCOMPRESS(1,:,1)=SUM(ZWORKIJ,1)
!
ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND.LBU_KCP) THEN
ZWORKIK(:,:)=0.0
DO JJ = 1,NBUSJH-NBUSJL+1
ZWORKIK(:,:) = ZWORKIK(:,:) + ZVARS(:,JJ,:)
END DO
PCOMPRESS(:,1,1)=SUM(ZWORKIK,2)
!
ELSE IF (LBU_ICP.AND..NOT.LBU_JCP.AND..NOT.LBU_KCP) THEN
PCOMPRESS(1,:,:)=SUM(ZVARS,1)
!
ELSE IF (.NOT.LBU_ICP.AND.LBU_JCP.AND..NOT.LBU_KCP) THEN
PCOMPRESS(:,1,:)=SUM(ZVARS,2)
!
ELSE IF (.NOT.LBU_ICP.AND..NOT.LBU_JCP.AND.LBU_KCP) THEN
PCOMPRESS(:,:,1)=SUM(ZVARS,3)
!
ELSE
PCOMPRESS=ZVARS
!
END IF
!
!
END FUNCTION CART_COMPRESS
!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.
! ######spl
MODULE MODI_INI_NEB
! #####################
!
INTERFACE
!
SUBROUTINE INI_NEB
END SUBROUTINE INI_NEB
!
END INTERFACE
!
END MODULE MODI_INI_NEB
! ######spl
SUBROUTINE INI_NEB
! #######################
!
!!**** *INI_NEB* - routine to initialize the nebulosity computation
!! constants.
!!
!! PURPOSE
!! -------
! The purpose of this routine is to initialize
! constants used for nebulosity computation
!
!! METHOD
!! ------
!! The constants are set to their numerical values
!!
!! EXTERNAL
!! --------
!! NONE
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_NEB
!!
!! REFERENCE
!! ---------
!!
!! AUTHOR
!! ------
!! S. Riette (Meteo France)
!!
!! MODIFICATIONS
!! -------------
!! Original 24 Aug 2011
!! --------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_NEB
USE PARKIND1, ONLY : JPRB
USE YOMHOOK , ONLY : LHOOK, DR_HOOK
!
IMPLICIT NONE
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!
! ---------------------------------------------------------------------------
!
! 1. SETTING THE NUMERICAL VALUES
!
IF (LHOOK) CALL DR_HOOK('INI_NEB',0,ZHOOK_HANDLE)
!Freezing between 0 and -20. Other possibilities are 0/-40 or -5/-25
XTMAXMIX = 273.16
XTMINMIX = 253.16
IF (LHOOK) CALL DR_HOOK('INI_NEB',1,ZHOOK_HANDLE)
END SUBROUTINE INI_NEB
!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/10/16 14:23:23
!-----------------------------------------------------------------
! ##########################
MODULE MODD_RAIN_ICE_DESCR
! ##########################
!
!!**** *MODD_RAIN_ICE_DESCR* - declaration of the microphysical descriptive
!! constants for use in the warm and cold schemes.
!!
!! PURPOSE
!! -------
! The purpose of this declarative module is to declare the microphysical
! constants. This includes the descriptive parameters for the raindrop and
! the ice crystal habits and the parameters relevant of the dimensional
! distributions.
!
! m(D) = XAx * D**XBx : Mass-MaxDim relationship
! v(D) = XCx * D**XDx : Fallspeed-MaxDim relationship
! N(Lbda) = XCCx * Lbda**XCXx : NumberConc-Slopeparam relationship
! XF0x, XF1x, XF2x : Ventilation factors
! XC1x : Shape parameter for deposition
!
! and
!
! XALPHAx, XNUx : Generalized GAMMA law
! Lbda = XLBx * (r_x*rho_dref)**XLBEXx : Slope parameter of the
! distribution law
!
!!
!!** IMPLICIT ARGUMENTS
!! ------------------
!! None
!!
!! REFERENCE
!! ---------
!! Book2 of documentation of Meso-NH (MODD_RAIN_ICE_DESCR)
!!
!! AUTHOR
!! ------
!! J.-P. Pinty *Laboratoire d'Aerologie*
!!
!! MODIFICATIONS
!! -------------
!! Original 04/12/95
!! J.-P. Pinty 29/11/02 add ICE4
!! C. LAC 26/01/2012 : suppression de XCONC qui n'était pas utilisé
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
IMPLICIT NONE
REAL,SAVE :: XCEXVT ! air density fall speed correction
!
REAL,SAVE :: XAC,XBC,XCC,XDC ! Cloud droplet charact.
REAL,SAVE :: XAR,XBR,XCR,XDR,XCCR ,XF0R,XF1R,XC1R ! Raindrop charact.
REAL,SAVE :: XAI,XBI,XC_I,XDI ,XF0I,XF2I,XC1I ! Cloud ice charact.
REAL,SAVE :: XAS,XBS,XCS,XDS,XCCS,XCXS,XF0S,XF1S,XC1S ! Snow/agg. charact.
REAL,SAVE :: XAG,XBG,XCG,XDG,XCCG,XCXG,XF0G,XF1G,XC1G ! Graupel charact.
REAL,SAVE :: XAH,XBH,XCH,XDH,XCCH,XCXH,XF0H,XF1H,XC1H ! Hail charact.
!
REAL,SAVE :: XALPHAC,XNUC,XALPHAC2,XNUC2, XLBEXC ! Cloud droplet distribution parameters
REAL,DIMENSION(2), SAVE :: XLBC ! Cloud droplet distribution parameters
REAL,SAVE :: XALPHAR,XNUR,XLBEXR,XLBR ! Raindrop distribution parameters
REAL,SAVE :: XALPHAI,XNUI,XLBEXI,XLBI ! Cloud ice distribution parameters
REAL,SAVE :: XALPHAS,XNUS,XLBEXS,XLBS ! Snow/agg. distribution parameters
REAL,SAVE :: XALPHAG,XNUG,XLBEXG,XLBG ! Graupel distribution parameters
REAL,SAVE :: XALPHAH,XNUH,XLBEXH,XLBH ! Hail distribution parameters
!
REAL,SAVE :: XLBDAR_MAX,XLBDAS_MAX,XLBDAG_MAX ! Max values allowed for the shape
! parameters (rain,snow,graupeln)
!
REAL,DIMENSION(:),SAVE,ALLOCATABLE :: XRTMIN ! Min values allowed for the mixing ratios
REAL,SAVE :: XCONC_SEA ! Diagnostic concentration of droplets over sea
REAL,SAVE :: XCONC_LAND ! Diagnostic concentration of droplets over land
REAL,SAVE :: XCONC_URBAN ! Diagnostic concentration of droplets over urban area
!
END MODULE MODD_RAIN_ICE_DESCR
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment