Skip to content
Snippets Groups Projects
Commit 4c016f61 authored by WAUTELET Philippe's avatar WAUTELET Philippe
Browse files

Philippe 03/06/2019: simplify code (remove always true masks) + replace PACK intrinsics

parent 963f906b
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
src/MNH/shallow_convection.f90
+ 54
− 104
View file @ 4c016f61
!MNH_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier !MNH_LIC Copyright 1996-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 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 version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt
!MNH_LIC for details. version 1. !MNH_LIC for details. version 1.
!----------------------------------------------------------------- !-----------------------------------------------------------------
!--------------- special set of characters for RCS information
!-----------------------------------------------------------------
! $Source$ $Revision$
! MASDEV4_7 conv 2006/05/18 13:07:25
!-----------------------------------------------------------------
! ###################### ! ######################
MODULE MODI_SHALLOW_CONVECTION MODULE MODI_SHALLOW_CONVECTION
! ###################### ! ######################
...@@ -158,7 +153,7 @@ END MODULE MODI_SHALLOW_CONVECTION ...@@ -158,7 +153,7 @@ END MODULE MODI_SHALLOW_CONVECTION
!! " 01/01/02 Apply conservation correction !! " 01/01/02 Apply conservation correction
!! F Bouyssel 05/11/08 Modifications for reproductibility !! F Bouyssel 05/11/08 Modifications for reproductibility
!! E. Bazile 20/07/09 Input of TKECLS. !! E. Bazile 20/07/09 Input of TKECLS.
!! Juan 24/09/2012: for BUG Pgi rewrite PACK function on mode_pack_pgi ! P. Wautelet 03/06/2019: simplify code (remove always true masks) + replace PACK intrinsics
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
!* 0. DECLARATIONS !* 0. DECLARATIONS
...@@ -174,10 +169,6 @@ USE MODI_CONVECT_UPDRAFT_SHAL ...@@ -174,10 +169,6 @@ USE MODI_CONVECT_UPDRAFT_SHAL
USE MODI_CONVECT_CLOSURE_SHAL USE MODI_CONVECT_CLOSURE_SHAL
USE MODI_CONVECT_CHEM_TRANSPORT USE MODI_CONVECT_CHEM_TRANSPORT
! !
#ifdef MNH_PGI
USE MODE_PACK_PGI
#endif
!
IMPLICIT NONE IMPLICIT NONE
! !
!* 0.1 Declarations of dummy arguments : !* 0.1 Declarations of dummy arguments :
...@@ -229,7 +220,7 @@ REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency ...@@ -229,7 +220,7 @@ REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency
! !
!* 0.2 Declarations of local fixed memory variables : !* 0.2 Declarations of local fixed memory variables :
! !
INTEGER :: ITEST, ICONV ! number of convective columns INTEGER :: ICONV ! number of convective columns
INTEGER :: IIB, IIE ! horizontal loop bounds INTEGER :: IIB, IIE ! horizontal loop bounds
INTEGER :: IKB, IKE ! vertical loop bounds INTEGER :: IKB, IKE ! vertical loop bounds
INTEGER :: IKS ! vertical dimension INTEGER :: IKS ! vertical dimension
...@@ -240,8 +231,6 @@ INTEGER :: IFTSTEPS ! only used for chemical tracers ...@@ -240,8 +231,6 @@ INTEGER :: IFTSTEPS ! only used for chemical tracers
REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
REAL :: ZRDOCP ! R_d/C_p REAL :: ZRDOCP ! R_d/C_p
! !
LOGICAL, DIMENSION(KLON, KLEV) :: GTRIG3 ! 3D logical mask for convection
LOGICAL, DIMENSION(KLON) :: GTRIG ! 2D logical mask for trigger test
REAL, DIMENSION(KLON,KLEV) :: ZTHT, ZSTHV, ZSTHES ! grid scale theta, theta_v REAL, DIMENSION(KLON,KLEV) :: ZTHT, ZSTHV, ZSTHES ! grid scale theta, theta_v
REAL, DIMENSION(KLON) :: ZWORK2, ZWORK2B ! work array REAL, DIMENSION(KLON) :: ZWORK2, ZWORK2B ! work array
REAL :: ZW1 ! work variable REAL :: ZW1 ! work variable
...@@ -317,9 +306,8 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZRCC ! conv. adj. grid scale r_c ...@@ -317,9 +306,8 @@ REAL, DIMENSION(:,:), ALLOCATABLE :: ZRCC ! conv. adj. grid scale r_c
REAL, DIMENSION(:,:), ALLOCATABLE :: ZRIC ! conv. adj. grid scale r_i REAL, DIMENSION(:,:), ALLOCATABLE :: ZRIC ! conv. adj. grid scale r_i
REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSUB ! envir. compensating subsidence (Pa/s) REAL, DIMENSION(:,:), ALLOCATABLE :: ZWSUB ! envir. compensating subsidence (Pa/s)
! !
LOGICAL, DIMENSION(:),ALLOCATABLE :: GTRIG1 ! logical mask for convection LOGICAL, DIMENSION(:),ALLOCATABLE :: GTRIG1 ! logical mask for convection
LOGICAL, DIMENSION(:),ALLOCATABLE :: GWORK ! logical work array INTEGER, DIMENSION(:),ALLOCATABLE :: IJINDEX ! hor.index
INTEGER, DIMENSION(:),ALLOCATABLE :: IINDEX, IJINDEX, IJSINDEX, IJPINDEX!hor.index
REAL, DIMENSION(:), ALLOCATABLE :: ZCPH ! specific heat C_ph REAL, DIMENSION(:), ALLOCATABLE :: ZCPH ! specific heat C_ph
REAL, DIMENSION(:), ALLOCATABLE :: ZLV, ZLS! latent heat of vaporis., sublim. REAL, DIMENSION(:), ALLOCATABLE :: ZLV, ZLS! latent heat of vaporis., sublim.
REAL :: ZES ! saturation vapor mixng ratio REAL :: ZES ! saturation vapor mixng ratio
...@@ -328,7 +316,6 @@ REAL :: ZES ! saturation vapor mixng ratio ...@@ -328,7 +316,6 @@ REAL :: ZES ! saturation vapor mixng ratio
REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1 ! grid scale chemical specy (kg/kg) REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1 ! grid scale chemical specy (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1C ! conv. adjust. chemical specy 1 REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1C ! conv. adjust. chemical specy 1
REAL, DIMENSION(:,:), ALLOCATABLE:: ZWORK3 ! conv. adjust. chemical specy 1 REAL, DIMENSION(:,:), ALLOCATABLE:: ZWORK3 ! conv. adjust. chemical specy 1
LOGICAL, DIMENSION(:,:,:),ALLOCATABLE::GTRIG4 ! logical mask
! !
!------------------------------------------------------------------------------- !-------------------------------------------------------------------------------
! !
...@@ -343,44 +330,23 @@ IKB = 1 + JCVEXB ...@@ -343,44 +330,23 @@ IKB = 1 + JCVEXB
IKS = KLEV IKS = KLEV
JCVEXT = MAX( 0, KTDIA - 1) JCVEXT = MAX( 0, KTDIA - 1)
IKE = IKS - JCVEXT IKE = IKS - JCVEXT
!
!
!* 0.5 Update convective counter ( where KCOUNT > 0
! convection is still active ).
! ---------------------------------------------
!
GTRIG(:) = .FALSE.
GTRIG(IIB:IIE) = .TRUE.
ITEST = COUNT( GTRIG(:) )
IF ( ITEST == 0 ) THEN
RETURN
ENDIF
! !
! !
!* 0.7 Reset convective tendencies to zero if convective !* 0.7 Reset convective tendencies to zero if convective
! counter becomes negative ! counter becomes negative
! ------------------------------------------------- ! -------------------------------------------------
! !
GTRIG3(:,:) = SPREAD( GTRIG(:), DIM=2, NCOPIES=IKS ) PTTEN(:,:) = 0.
WHERE ( GTRIG3(:,:) ) PRVTEN(:,:) = 0.
PTTEN(:,:) = 0. PRCTEN(:,:) = 0.
PRVTEN(:,:) = 0. PRITEN(:,:) = 0.
PRCTEN(:,:) = 0.
PRITEN(:,:) = 0.
! PUTEN(:,:) = 0. ! PUTEN(:,:) = 0.
! PVTEN(:,:) = 0. ! PVTEN(:,:) = 0.
PUMF(:,:) = 0. PUMF(:,:) = 0.
END WHERE KCLTOP(:) = 0
WHERE ( GTRIG(:) ) KCLBAS(:) = 0
KCLTOP(:) = 0
KCLBAS(:) = 0
END WHERE
IF ( OCH1CONV ) THEN IF ( OCH1CONV ) THEN
ALLOCATE( GTRIG4(KLON,KLEV,KCH1) ) PCH1TEN(:,:,:) = 0.
GTRIG4(:,:,:) = SPREAD( GTRIG3(:,:), DIM=3, NCOPIES=KCH1 )
WHERE( GTRIG4(:,:,:) ) PCH1TEN(:,:,:) = 0.
DEALLOCATE( GTRIG4 )
END IF END IF
! !
! !
...@@ -429,47 +395,38 @@ END DO ...@@ -429,47 +395,38 @@ END DO
! at the moment. ! at the moment.
! -------------------------------------------------------------- ! --------------------------------------------------------------
! !
ALLOCATE( ZPRES(ITEST,IKS) ) ALLOCATE( ZPRES(KLON,IKS) )
ALLOCATE( ZZ(ITEST,IKS) ) ALLOCATE( ZZ(KLON,IKS) )
ALLOCATE( ZW(ITEST,IKS) ) ALLOCATE( ZW(KLON,IKS) )
ALLOCATE( ZTH(ITEST,IKS) ) ALLOCATE( ZTH(KLON,IKS) )
ALLOCATE( ZTHV(ITEST,IKS) ) ALLOCATE( ZTHV(KLON,IKS) )
ALLOCATE( ZTHEST(ITEST,IKS) ) ALLOCATE( ZTHEST(KLON,IKS) )
ALLOCATE( ZRV(ITEST,IKS) ) ALLOCATE( ZRV(KLON,IKS) )
ALLOCATE( ZSTHLCL(ITEST) ) ALLOCATE( ZSTHLCL(KLON) )
ALLOCATE( ZSTLCL(ITEST) ) ALLOCATE( ZSTLCL(KLON) )
ALLOCATE( ZSRVLCL(ITEST) ) ALLOCATE( ZSRVLCL(KLON) )
ALLOCATE( ZSWLCL(ITEST) ) ALLOCATE( ZSWLCL(KLON) )
ALLOCATE( ZSZLCL(ITEST) ) ALLOCATE( ZSZLCL(KLON) )
ALLOCATE( ZSTHVELCL(ITEST) ) ALLOCATE( ZSTHVELCL(KLON) )
ALLOCATE( ISDPL(ITEST) ) ALLOCATE( ISDPL(KLON) )
ALLOCATE( ISPBL(ITEST) ) ALLOCATE( ISPBL(KLON) )
ALLOCATE( ISLCL(ITEST) ) ALLOCATE( ISLCL(KLON) )
ALLOCATE( ZSDXDY(ITEST) ) ALLOCATE( ZSDXDY(KLON) )
ALLOCATE( GTRIG1(ITEST) ) ALLOCATE( GTRIG1(KLON) )
ALLOCATE( IINDEX(KLON) )
ALLOCATE( IJSINDEX(ITEST) )
DO JI = 1, KLON
IINDEX(JI) = JI
END DO
IJSINDEX(:) = PACK( IINDEX(:), MASK=GTRIG(:) )
! !
DO JK = IKB, IKE DO JK = IKB, IKE
DO JI = 1, ITEST DO JI = 1, KLON
JL = IJSINDEX(JI) JL = JI
ZPRES(JI,JK) = PPABST(JL,JK) ZPRES(JI,JK) = PPABST(JI,JK)
ZZ(JI,JK) = PZZ(JL,JK) ZZ(JI,JK) = PZZ(JI,JK)
ZTH(JI,JK) = ZTHT(JL,JK) ZTH(JI,JK) = ZTHT(JI,JK)
ZTHV(JI,JK) = ZSTHV(JL,JK) ZTHV(JI,JK) = ZSTHV(JI,JK)
ZTHEST(JI,JK) = ZSTHES(JL,JK) ZTHEST(JI,JK) = ZSTHES(JI,JK)
ZRV(JI,JK) = MAX( 0., PRVT(JL,JK) ) ZRV(JI,JK) = MAX( 0., PRVT(JI,JK) )
ZW(JI,JK) = PWT(JL,JK) ZW(JI,JK) = PWT(JI,JK)
END DO
END DO END DO
DO JI = 1, ITEST
JL = IJSINDEX(JI)
ZSDXDY(JI) = XA25
END DO END DO
ZSDXDY(:) = XA25
! !
!* 2.2 Compute environm. enthalpy and total water = r_v + r_i + r_c !* 2.2 Compute environm. enthalpy and total water = r_v + r_i + r_c
! and envir. saturation theta_e ! and envir. saturation theta_e
...@@ -483,7 +440,7 @@ ISLCL(:) = MAX( IKB, 2 ) ! initialize DPL PBL and LCL ...@@ -483,7 +440,7 @@ ISLCL(:) = MAX( IKB, 2 ) ! initialize DPL PBL and LCL
ISDPL(:) = IKB ISDPL(:) = IKB
ISPBL(:) = IKB ISPBL(:) = IKB
! !
CALL CONVECT_TRIGGER_SHAL( ITEST, KLEV, & CALL CONVECT_TRIGGER_SHAL( KLON, KLEV, &
ZPRES, ZTH, ZTHV, ZTHEST, & ZPRES, ZTH, ZTHV, ZTHEST, &
ZRV, ZW, ZZ, ZSDXDY, PTKECLS, & ZRV, ZW, ZZ, ZSDXDY, PTKECLS, &
ZSTHLCL, ZSTLCL, ZSRVLCL, ZSWLCL, ZSZLCL, & ZSTHLCL, ZSTLCL, ZSRVLCL, ZSWLCL, ZSZLCL, &
...@@ -518,8 +475,6 @@ IF ( ICONV == 0 ) THEN ...@@ -518,8 +475,6 @@ IF ( ICONV == 0 ) THEN
DEALLOCATE( ISDPL ) DEALLOCATE( ISDPL )
DEALLOCATE( ISPBL ) DEALLOCATE( ISPBL )
DEALLOCATE( GTRIG1 ) DEALLOCATE( GTRIG1 )
DEALLOCATE( IINDEX )
DEALLOCATE( IJSINDEX )
RETURN ! no convective column has been found, exit DEEP_CONVECTION RETURN ! no convective column has been found, exit DEEP_CONVECTION
ENDIF ENDIF
! !
...@@ -569,7 +524,6 @@ ALLOCATE( ZCAPE(ICONV) ) ...@@ -569,7 +524,6 @@ ALLOCATE( ZCAPE(ICONV) )
! work variables ! work variables
! !
ALLOCATE( IJINDEX(ICONV) ) ALLOCATE( IJINDEX(ICONV) )
ALLOCATE( IJPINDEX(ICONV) )
ALLOCATE( ZCPH(ICONV) ) ALLOCATE( ZCPH(ICONV) )
ALLOCATE( ZLV(ICONV) ) ALLOCATE( ZLV(ICONV) )
ALLOCATE( ZLS(ICONV) ) ALLOCATE( ZLS(ICONV) )
...@@ -579,8 +533,13 @@ ALLOCATE( ZLS(ICONV) ) ...@@ -579,8 +533,13 @@ ALLOCATE( ZLS(ICONV) )
! arrays using mask GTRIG ! arrays using mask GTRIG
! --------------------------------------------------- ! ---------------------------------------------------
! !
GTRIG(:) = UNPACK( GTRIG1(:), MASK=GTRIG, FIELD=.FALSE. ) JL = 1
IJINDEX(:) = PACK( IINDEX(:), MASK=GTRIG(:) ) DO JI = 1, KLON
IF ( GTRIG1(JI) ) THEN
IJINDEX(JL) = JI
JL = JL +1
END IF
END DO
! !
DO JK = IKB, IKE DO JK = IKB, IKE
DO JI = 1, ICONV DO JI = 1, ICONV
...@@ -597,12 +556,8 @@ DO JI = 1, ICONV ...@@ -597,12 +556,8 @@ DO JI = 1, ICONV
END DO END DO
END DO END DO
! !
DO JI = 1, ITEST
IJSINDEX(JI) = JI
END DO
IJPINDEX(:) = PACK( IJSINDEX(:), MASK=GTRIG1(:) )
DO JI = 1, ICONV DO JI = 1, ICONV
JL = IJPINDEX(JI) JL = IJINDEX(JI)
IDPL(JI) = ISDPL(JL) IDPL(JI) = ISDPL(JL)
IPBL(JI) = ISPBL(JL) IPBL(JI) = ISPBL(JL)
ILCL(JI) = ISLCL(JL) ILCL(JI) = ISLCL(JL)
...@@ -614,14 +569,11 @@ DO JI = 1, ICONV ...@@ -614,14 +569,11 @@ DO JI = 1, ICONV
ZTHVELCL(JI) = ZSTHVELCL(JL) ZTHVELCL(JI) = ZSTHVELCL(JL)
ZDXDY(JI) = ZSDXDY(JL) ZDXDY(JI) = ZSDXDY(JL)
END DO END DO
ALLOCATE( GWORK(ICONV) )
GWORK(:) = PACK( GTRIG1(:), MASK=GTRIG1(:) )
DEALLOCATE( GTRIG1 ) DEALLOCATE( GTRIG1 )
ALLOCATE( GTRIG1(ICONV) ) ALLOCATE( GTRIG1(ICONV) )
GTRIG1(:) = GWORK(:) GTRIG1(:) = .true.
!
DEALLOCATE( GWORK )
DEALLOCATE( IJPINDEX )
DEALLOCATE( ISDPL ) DEALLOCATE( ISDPL )
DEALLOCATE( ISPBL ) DEALLOCATE( ISPBL )
DEALLOCATE( ISLCL ) DEALLOCATE( ISLCL )
...@@ -1014,9 +966,7 @@ DEALLOCATE( ZCAPE ) ...@@ -1014,9 +966,7 @@ DEALLOCATE( ZCAPE )
! !
! work arrays ! work arrays
! !
DEALLOCATE( IINDEX )
DEALLOCATE( IJINDEX ) DEALLOCATE( IJINDEX )
DEALLOCATE( IJSINDEX )
DEALLOCATE( GTRIG1 ) DEALLOCATE( GTRIG1 )
! !
! !
......
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